Index: branches/publications/ORCHIDEE_CN_CAN_r5698/AA_make
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/AA_make	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/AA_make	(revision 6412)
@@ -0,0 +1,51 @@
+#- $Id$
+all_lib : libioipsl libparallel libparameters liborglob libstomate libsechiba
+
+libioipsl:
+	(cd ../IOIPSL/src; $(M_K) -f Makefile)
+
+libparameters :
+	(cd src_parameters ; $(M_K) -f Makefile)
+
+libparallel :
+	(cd ../../modeles/ORCHIDEE/src_parallel ; $(M_K) -f Makefile)
+
+liborglob :
+	(cd src_global ; $(M_K) -f Makefile)
+
+libstomate :
+	(cd src_stomate ; $(M_K) -f Makefile)
+
+libsechiba :
+	(cd src_sechiba ; $(M_K) -f Makefile)
+
+driver : all_lib
+	(cd src_driver ; $(M_K) -f Makefile)
+
+config : 
+	(cd src_parameters; $(M_K) -f Makefile config)
+	(cd src_sechiba; $(M_K) -f Makefile config)
+	(cd src_stomate; $(M_K) -f Makefile config)
+
+clean : 
+	(cd src_parameters; $(M_K) -f Makefile clean)
+	(cd src_parallel; $(M_K) -f Makefile clean)
+	(cd src_global; $(M_K) -f Makefile clean)
+	(cd src_sechiba; $(M_K) -f Makefile clean)
+	(cd src_stomate; $(M_K) -f Makefile clean)
+	(cd src_driver; $(M_K) -f Makefile clean)
+	(rm -f ../../lib/*)
+
+doc:
+	doxygen Doxyfile_ORCHIDEE
+	export TEXINPUTS="${TEXINPUTS}:${PWD}/DOC//"; export BIBINPUTS="${BIBINPUTS}:${PWD}/DOC/BIB//"; cd docs/latex ; latex refman.tex 
+
+bib:
+	export TEXINPUTS="${TEXINPUTS}:${PWD}/DOC//"; export BIBINPUTS="${BIBINPUTS}:${PWD}/DOC/BIB//"; cd docs/latex ; bibtex refman 
+
+index:
+	export TEXINPUTS="${TEXINPUTS}:${PWD}/DOC//"; export BIBINPUTS="${BIBINPUTS}:${PWD}/DOC/BIB//"; cd docs/latex ; makeindex refman 
+
+toc:
+	export TEXINPUTS="${TEXINPUTS}:${PWD}/DOC//"; export BIBINPUTS="${BIBINPUTS}:${PWD}/DOC/BIB//"; cd docs/latex ; latex refman.tex 
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/AA_make.ldef
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/AA_make.ldef	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/AA_make.ldef	(revision 6412)
@@ -0,0 +1,3 @@
+#- $Id$
+#---------------------------------------------------------------------
+#-
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/BIB/orchidee.bib
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/BIB/orchidee.bib	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/BIB/orchidee.bib	(revision 6412)
@@ -0,0 +1,37 @@
+@Article{Chalita_94,
+  author = 	 {{Chalita, S.} and {Le Treut, H.}},
+  title = 	 {``{The albedo of temperate and boreal forest and the Northern Hemisphere climate: a sensitivity experiment using the LMD GCM}''},
+  journal = 	 {Climate Dynamics},
+  year = 	 {1994},
+  volume = 	 {10},
+  pages = 	 {231-240},
+}
+
+
+@Article{Chuine_00,
+  author = 	 {{Chuine, I.}},
+  title = 	 {``{A unified model for budburst of trees}''},
+  journal = 	 {Journal of Theoretical Biology},
+  volume = 	 {207},
+  year = 	 {2000},
+  pages = 	 {337-347}
+}
+
+
+@Article{Bott-Viov-Ciais-Frie-Monf_00,
+  author = 	 {{Botta, A.} and {Viovy, N.} and {Ciais, P.} and {Friedlingstein, P.} and {Monfray, P.}},
+  title = 	 {``{A global prognostic scheme of leaf onset using satellite data.}''},
+  journal = 	 {Global Change Biology},
+  year = 	 {2000},
+  volume = 	 {6},
+  pages = 	 {709-725},
+}
+
+@Article{Orla-Garc-Ezqu-Roma-Domi-Gala-Forn_04,
+  author = 	 {{Orlandi, F.} and {Garcia-Mozo, H.} and {Ezquerra, L.V.} and {Romano, B.} and {Dominguez, E.} and {Galan, C.} and {Fornaciari, M.}},
+  title = 	 {``{Phenological olive chilling requirements in Umbria (Italy) and Andalusia (Spain)}''},
+  journal = 	 {Plant Biosystems},
+  year = 	 {2004},
+  volume = 	 {138},
+  pages = 	 {111-116},
+}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex	(revision 6412)
@@ -0,0 +1,12 @@
+We calculate the deviation of the saturated humidity with the temperature and the pressure.
+\begin{equation}
+\delta q_{sat}(T) = \frac{(q_s(\lfloor T+\frac{1}{2}\rfloor + 1) - 2.q_s(\lfloor T +\frac{1}{2} \rfloor) + q_s(\lfloor T+\frac{1}{2} \rfloor -1))(\lbrace T + \frac{1}{2}\rbrace -1 ) + q_s(\lfloor T+\frac{1}{2} \rfloor +1) - q_s(\lfloor T+\frac{1}{2} \rfloor)}{P}
+\end{equation}
+
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T + \frac{1}{2} \rfloor $ represents the largest integer not greater than $T + \frac{1}{2} $. 
+ \item  $ \lbrace T + \frac{1}{2} \rbrace = T + \frac{1}{2} -\lfloor T + \frac{1}{2} \rfloor $ is the fractional part of $T + \frac{1}{2} $.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex	(revision 6412)
@@ -0,0 +1,14 @@
+We calculate the deviation of the saturated humidity with the temperature and the pressure for a given pixel $x$.
+\begin{multline}
+\delta q_{sat}(x,T) = \\
+\frac{(q_s(x,\lfloor T+\frac{1}{2}\rfloor + 1) - 2.q_s(x,\lfloor T +\frac{1}{2} \rfloor) + q_s(x,\lfloor T+\frac{1}{2} \rfloor -1))(\lbrace T + \frac{1}{2}\rbrace -1 )} {P}+ 
+\\ \frac{q_s(x,\lfloor T+\frac{1}{2} \rfloor +1) - q_s(x, \lfloor T+\frac{1}{2} \rfloor)}{P}
+\end{multline}
+
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T + \frac{1}{2} \rfloor $ represents the largest integer not greater than $T + \frac{1}{2} $. 
+ \item  $ \lbrace T + \frac{1}{2} \rbrace = T + \frac{1}{2} -\lfloor T + \frac{1}{2} \rfloor $ is the fractional part of $T + \frac{1}{2} $.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex	(revision 6412)
@@ -0,0 +1,30 @@
+The subroutine qsfrict\_init uses modified Goff-Gratch equations (1946). The original formulations are : \\
+\begin{multline}
+\log e_w = \\ -7.90298 \left( \frac{T_s}{T} - 1 \right) + 5.02808 \log \left( \frac{T_s}{T} \right) 
+- 1.3816 \times 10^{-7}(10^{11.344 \left( 1-\frac{T_s}{T} \right)}-1) 
++ 8.1328 \times 10^{-3}(10^{-3.49149 \left( \frac{T_s}{T}-1 \right)}
+-1) \\ + \log e_{ws}
+\end{multline}
+where : \\
+\begin{itemize}
+ \item  $ \log(x) = \frac{\ln x}{\ln 10} $. 
+ \item  $e_w$ is the saturation water vapor pressure over a plane surface of pure ordinary liquid water (hPa).
+ \item  $T$ is the absolute air temperature in Kelvin.
+ \item  $T_s$ is the steam point temperature (373.16 K).
+ \item  $e_{ws}$ is the saturation pressure of pure ordinary liquid water at steam-point temperature (at 1 atm = 1013.25 hPa).
+\end{itemize}
+
+\begin{multline}
+\log e_i = \\ -9.09718 \times \left( \frac{T_0}{T} - 1 \right) - 3.56654 \times \log \left( \frac{T_0}{T} \right) 
++ 0.876793 \times \left( 1-\frac{T_0}{T} \right) 
++ \log e_{i0}
+\end{multline}
+where : \\
+\begin{itemize}
+ \item  $ \log(x) = \frac{\ln x}{\ln 10} $. 
+ \item  $e_i$ is the saturation water vapor pressure over a plane surface of pure ordinary water ice (hPa).
+ \item  $T$ is the absolute air temperature in Kelvin (K).
+ \item  $T_0$ is the boiling point at 1 atmosphere temperature (273.16 K).
+ \item  $e^{*}_{i0}$  is the saturation pressure of pure ordinary water ice at ice-point temperature (6.1173 hPa).
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex	(revision 6412)
@@ -0,0 +1,12 @@
+The interpolation the saturated humidity depends on the temperature $T$ (in Kelvin). 
+It is set by the following equation :
+\begin{equation}
+q_{sat}(T)= \dfrac{q_s(\lfloor T \rfloor +1) - q_s(\lfloor T \rfloor).\lbrace T \rbrace + q_s(\lfloor T \rfloor)}{P}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T \rfloor $ represents the largest integer not greater than $T$. 
+ \item  $ \lbrace T \rbrace = T -\lfloor T \rfloor $ is the fractional part of $T$.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex	(revision 6412)
@@ -0,0 +1,12 @@
+The interpolation the saturated humidity on one pixel $x$  depends on the temperature $T$ (in Kelvin). 
+It is set by the following equation :
+\begin{equation}
+q_{sat}(x,T)= \dfrac{q_s(x,\lfloor T \rfloor +1) - q_s(x,\lfloor T \rfloor).\lbrace T \rbrace + q_s(x,\lfloor T \rfloor)}{P}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T \rfloor $ represents the largest integer not greater than $T$. 
+ \item  $ \lbrace T \rbrace = T -\lfloor T \rfloor $ is the fractional part of $T$.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex	(revision 6412)
@@ -0,0 +1,17 @@
+The specific humidity  $q_s$ is a function of temperature $T$. Its values are : 
+\begin{equation}
+q_s(T) = 
+\begin{cases}
+0 & \text{if} \quad T < 100K \\
+\dfrac{M_{air}}{M_{vapor}} \cdot 10^{2.07203 - 0.0032099T - \frac{2484.896}{T} + 3.56654\log{T}} & \text{if} \quad 100K \leq T < 273K \\
+\dfrac{M_{air}}{M_{vapor}} \cdot 10^{23.819 - \frac{2948.964}{T} -
+  5.028\log{T} - 29910.16\exp(-0.0699832\times T) + 25.21935\exp(-\frac{2999.924}{T}) } & \text{if} \quad 273K \leq T \leq 370K \\
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $\dfrac{M_{air}}{M_{vapor}} = \dfrac{18.02 \times 10^{-3}}{28.964 \times 10^{-3}} \simeq 0.622 $ is the ratio between the molecular weight of dry air and \\ 
+the molecular weight of water vapor.
+ \item  $\log(T) = \dfrac{\ln T}{\ln 10}$
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex	(revision 6412)
@@ -0,0 +1,18 @@
+%\documentclass{article}
+%\usepackage[english]{babel}
+%\usepackage{amsmath}
+%\begin{document}
+\begin{equation}
+f(T) = 
+\begin{cases}
+0 & \text{if} \quad T < 273K \\
+1 - \dfrac{(T_{max} - T)^2}{(T_{max} - T_{min})^2} & \text{if} \quad 273K \leq T \leq 293K \\
+1 & \text{if} \quad T > 293K
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ T_{min} = 273K$ 
+ \item  $ T_{max} = 293K$
+\end{itemize}
+%\end{document}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+snowAlb=snowaIni+snowaDec \times \exp{\frac{-snowAge}{tsctSnowa}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+fracSnow=\frac{snow}{snow+10}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+C = [\frac{1}{\kappa} ln(\frac{z}{z0})]^2 
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex	(revision 6412)
@@ -0,0 +1,100 @@
+%
+% \documentclass[11pt]{amsart}
+% \usepackage{helvet}
+% \usepackage{geometry}    
+% \geometry{a4paper} 
+% \usepackage[parfill]{parskip}  \usepackage{graphicx}
+% \usepackage{amssymb}
+% \usepackage{epstopdf}
+% 
+% 
+% 
+% \begin{document}
+
+As is outlined in Guimberteau (2010), evaporation in ORCHIDEE is calculated as a function of evaporation potential $E_{pot}$, limited by the resistances. Evaporation potential is defined as below:
+
+ \hspace{0.5cm}    \lefteqn{E_{pot} = \frac{\rho}{r_a}(q_{sat}(T_s)-q_{air})}
+
+{\it where $q_{sat}(T_s)$ is the saturation humidity corresponding to a particular surface temperature and $q_{air}$ is the specific humidity in the atmosphere immediately above the surface.}
+
+A conventional way to describe evaporation in surface layer modelling is via the means of the resistance analogy. Below we demonstrate how the $\beta$ coefficients within ORCHIDEE may be re-written in terms of this analogy.
+
+{\bf Evaporation of water intercepted by canopy}
+
+In ORCHIDEE, $\beta_2$, the water interception resistance, is defined as:
+
+\hspace{0.5cm} \lefteqn{E=\beta_{2} E_{pot}}
+
+\hspace{0.5cm} \lefteqn{\beta_{2} = \frac{1}{1+\frac{r_{s_v}}{r_a}}}
+
+{\it where E represents the evapotranspiration, $r_{s_v}$ is the structural resistance of the canopy and $r_a$ is the aerodynamic resistance. }
+
+This can be reformulated in terms of the 'traditional' circuitry analogy, where evapotranspiration represents (in the analogy) the current and the voltage (or potential difference) is represented by the difference in humidity between the saturated surface and the atmosphere just above the ground.
+
+ \hspace{0.5cm} \lefteqn{E\left( 1+\frac{r_{s_v}}{r_a}  \right) = \frac{\rho}{r_a}(q_{sat}(T_s) - q_{air})}
+
+ \hspace{0.5cm} \lefteqn{     \overbrace{   E}^I  \overbrace{ (r_a+r_{s_v})}^R = \overbrace { \rho (q_{sat}(T_s) - q_{air})  }^V }
+
+
+\includegraphics[scale=0.45]{diffuco_schematic2.png}
+
+{\bf Figure 1:} resistance chain for the evaporation of intercepted water
+
+
+\vspace{1cm}
+
+{\bf Transpiration of the canopy}
+
+
+$\beta_3$, the canopy transpiration resistance, is defined as:
+
+
+\hspace{0.5cm} \lefteqn{E=\beta_{3} E_{pot}}
+
+\hspace{0.5cm} \lefteqn{\beta_{3} = \left(  \frac{1}{1+\frac{r_{s_v} + r_{sto_v}}{r_a}}  \right) U_{s_v} }
+
+{\it where E represents the evapotranspiration, $U_{S_v}$ is the potential for extraction from the plant roots, $r_{s_v}$ is the structural resistance of the canopy, $r_{sto_v}$ is the stomatal resistance of the surface cover and $r_a$ is the aerodynamic resistance. }
+
+so:
+
+ \hspace{0.5cm}  \lefteqn{ \frac{E}{\beta_{3}} = \frac{\rho}{r_a}(q_{sat}(T_s)-q_{air})}
+
+\hspace{0.5cm}   \lefteqn{E\left( 1+   \frac{r_{s_v}+r_{sto_v}}{r_a}   \right) U_{sv} = \frac{\rho}{r_a}(q_{sat}(T_s) - q_{air})}
+
+\hspace{0.5cm}   \lefteqn{   \overbrace {  E  }^I   \overbrace{ (r_a + (r_{s_v}+ r_{sto_v}))U_{s_v} }  ^R =   \overbrace { \rho (q_{sat}(T_s) - q_{air}   )   } ^V  }
+
+\includegraphics[scale=0.5]{diffuco_schematic1.png}
+
+{\bf Figure 2:} resistance chain for canopy transpiration
+
+
+\vspace{1cm}
+
+{\bf Evaporation of the bare soil}
+
+$\beta_4$, the bare soil evaporation resistance, is defined as:
+
+
+\hspace{0.5cm} \lefteqn{E=\beta_{4} E_{pot}}
+
+\hspace{0.5cm} \lefteqn{\beta_{4} = \left(  \frac{1}{1+\frac{r_1}{r_a}}  \right) U_{s_1} }
+
+{\it where E represents the evapotranspiration, $U_{S_1}$ is the relative humidity in equilibrium with the bare soil, $r_{1}$ is the resistance of bare soil to evaporation and $r_a$ is the aerodynamic resistance. }
+
+so we can again convert the expression to the resistance analogy:
+
+ \hspace{0.5cm}  \lefteqn{\frac{E}{\beta_{4}} = \frac{\rho}{r_a}(q_{sat}(T_s)-q_{air})}
+
+ \hspace{0.5cm} \lefteqn{E\left( 1+   \frac{r_1}{r_a}   \right) U_{s_1} = \frac{\rho}{r_a}(q_{sat}(T_s) - q_{air})}
+
+ \hspace{0.5cm} \lefteqn{   \overbrace {E}^I    \overbrace  {(r_a + r_1)U_{s_1}}^R = \overbrace {\rho (q_{sat}(T_s) - q_{air}   )} ^V }
+
+
+\includegraphics[scale=0.45]{diffuco_schematic3.png}
+
+{\bf Figure 3:} resistance chain for bare soil evaporation
+
+% 
+% 
+% 
+% \end{document}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex	(revision 6412)
@@ -0,0 +1,122 @@
+
+\documentclass[11pt]{amsart}
+\usepackage{helvet}
+\usepackage{geometry}    
+\geometry{a4paper} 
+\usepackage[parfill]{parskip}  \usepackage{graphicx}
+\usepackage{amssymb}
+\usepackage{epstopdf}
+
+
+
+\begin{document}
+
+\renewcommand{\arraystretch}{1.5}
+
+\begin{tabular}{|c|l|r|}
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+\hline
+ $ps^{old}$ & psold & surface static energy at old timestep (J/kg) \\
+ $ps^{new}$ & psnew & surface static energy at new timestep (J/kg)\\
+ $q_s$ & qsurf & surface specific humidity (kg/kg) \\
+ $q_{s, sat}$ & qsol\_sat & saturated surface humidity (kg/kg) \\
+ $q_{air}$ & qair & lowest level specific humidity at 'old' timestep (kg/kg) \\
+ $q_{air}^{new}$ & qair\_new & lowest level specific humidity at 'new' timestep (kg/kg) \\
+ $\frac{\delta q_s^{old}}{\delta t}$ & pdqsold & derivative of saturated specific humidity at old temperature (kg/(kg s)) \\ 
+ $p_l$ & pb & lowest level air pressure (Pa) \\
+ \hline
+ $C_p^{air}$ & cp\_air & lowest level atmospheric heat capacity (J/(K kg)) \\   
+ \hline
+ $\chi_{CO_2}^{canopy}$ & ccanopy & $CO_2$ concentration in the canopy (?? ppm)  \\
+ $\bar{Ci}$ & cimean & mean intercellular ci (from STOMATE) $(\mu mole/m^2/s)$\\  
+ \hline
+ $R^{LW}_{\uparrow}$ & lwup & long-wave upwelling radiation $(W/m^2)$ \\  
+ $ R^{LW}_{\downarrow}$ & lwdown & downwelling long-wave radiation flux $(W/m^2)$ \\
+ $R^{LW}_{abs}$ & lwabs  & LW radiation absorbed by the surface $(W/m^2)$ \\ 
+ $R^{SW}_{net}$ & swnet & net shortwave radiation flux $(W/m^2)$ \\
+ $R^{net}_{sns}$ & netrad\_sns & sensitivity of net radiation $(W/m^2)$ \\
+ $R_{net}$ & netrad & net radiation at surface layer $(W/m^2)$ \\
+ \hline
+ $\Delta \theta$ & dtradia & Time step (s) \\
+ $\epsilon$ & emis & emissivity (fraction) \\
+ $\sigma$ & c\_stefan & Stefan-Boltzmann constant $(W / (m^2 K^4))$\\
+ $q_{c}$ & q\_cdrag & surface drag coefficient (m/s) \\
+ $\rho_{air}$ & rau & density of air $(kg/m^3)$ \\
+\hline
+\end{tabular}
+
+
+\begin{tabular}{|c|l|r|}
+
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+
+
+ \hline
+ 
+ $z_0$     &  z0 & Surface roughness Length (m) \\
+ roughheight  & roughheight   & Effective roughness height (m) \\
+ zlev  &  zlev & Height of first atmospheric layer (m) \\
+ veget\_max  & veget\_max & Fraction of vegetation type (-) \\
+ temp\_sol & temp\_sol &  Ground temperature (K) \\
+ temp\_air & temp\_air  &     !! Lowest level temperature (K) \\
+ qsurf  & qsurf & near surface specific air humidity (kg/kg) \\
+ qair  & qair & Lowest level specific air humidity (kg/kg) \\
+ 
+ \hline
+ 
+ veget    & veget & vegetation fraction for each type (fraction) \\
+ qsintveg & qsintveg & Water on vegetation due to interception $(kg/m^2)$ \\
+ qsintmax & qsintmax & Maximum water on vegetation $(kg/m^2)$ \\
+ rstruct  & rstruct & architectural resistance (s/m) \\
+ humrel & humrel & Soil moisture stress (within range 0 to 1 \\
+ veget  & veget & Type of vegetation (-) \\
+ veget\_max  & veget\_max &  Max. vegetation fraction (LAI to infinity) (fraction) \\
+ lai  & lai & Leaf\ area\ index $(m^2/m^2)$ \\
+ qsintveg & qsintveg & Water on vegetation due to interception $(kg/m^2)$ \\
+ 
+ \hline
+ 
+ $r_a$    & raero & aerodynamic resistance (s/m) \\
+ $r_{soil}$    & rsol & bare soil evaporation resistance (s/m) \\
+ $\delta _c$ & zdefconc & water vapour concentration deficit $(kg/m^3)$\\
+ \hline
+  
+\end{tabular}
+
+
+
+\begin{tabular}{|c|l|r|}
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+
+
+ \hline
+ $T_{air}$ & tair & air temperature (K) \\
+ $T_{dgnc}^{2m}$ & t2mdiag & diagnostic temperature at 2m above ground (K) \\  
+ $T^{2m}$ & t2m & 2m air temperature (K) \\  
+ $q^{2m}$ & q2m & 2m specific humidity (kg/kg) \\  
+ $T_S$ & temp\_sol & surface temperature (K) \\  
+ \hline
+
+ $\alpha_v $ & valpha & total $\alpha$ resistance coefficient (fraction) \\
+ $\beta_v$ & vbeta & total resistance coefficient (fraction) \\
+ $\beta_{v1}$ & vbeta1 & snow resistance (fraction) \\  
+ $\beta_{v2}$ & vbeta2 & interception resistance (fraction)\\  
+ $\beta_{v3}$ & vbeta3 & vegetation resistance (fraction)\\  
+ $\beta_{v4}$ & vbeta4 & bare soil resistance (fraction)\\
+ $\beta_{v23}$ & vbeta23 & portion of wetted foliage that will transpire (fraction)\\ 
+ $\beta_{v,CO_2}$ & vbetaco2 & vegetation resistance to $CO_2$ \\ 
+ \hline
+ $U$ & speed & lowest level wind speed (m/s) \\
+ $u$ & u & lowest level wind velocity,  Eastward component  (m/s) \\
+ $v$ & v & lowest level wind volocity, Northward component  (m/s) \\
+ \hline
+ $z_{ikt}$ & zikt & aerodynamic resistance / density of air (kg s $m^{-4}$) \\
+ $z_{ikq}$ & zikq & aerodynamic resistance / density of air (kg s $m^{-4}$)  \\
+\hline
+\end{tabular}
+
+
+\end{document}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex	(revision 6412)
@@ -0,0 +1,15 @@
+% \documentclass{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+The integration at the canopy level is done over nlai=20 fixed levels $l$.
+
+nlai is a local constant of the diffuco module.
+
+laimax is a local constant of the diffuco\_trans\_co2 subroutine independent of the PFT equal to 12. 
+
+\begin{equation}
+{{{LAI}}(l)={{lai}}{max}\frac{e^{{0{.}{15}\cdot (l-1)}}-1}{e^{{0{.}{15}\cdot {{nlai}}}}-1}}\nonumber
+\end{equation}
+% \end{document}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex	(revision 6412)
@@ -0,0 +1,9 @@
+% \documentclass[onecolumn,a4paper]{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+\begin{equation}
+{{{light}}=e^{{-k\cdot {{LAI}}(l)}}}\nonumber
+\end{equation}
+% \end{document}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex	(revision 6412)
@@ -0,0 +1,17 @@
+% \documentclass{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+$Q$ surface specific humidity
+
+$Q_{sat}$ saturated surface humidity (calculated in constant\_veg:qsatcalc)
+
+$P$ surface pressure
+
+$h_r$ relative humidity of air
+
+\begin{equation}
+{h_{{r}}=\frac{Q\cdot P/{(0{.}{622}+0{.}{378}\cdot Q)}}{Q_{{{{sat}}}}\cdot P/{(0{.}{622}+0{.}{378}\cdot Q_{{{{sat}}}})}}}
+\end{equation}
+% \end{document}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex	(revision 6412)
@@ -0,0 +1,12 @@
+% \documentclass{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+$f_w$ soil relative humidity calculated in hydrolc:hydrolc\_soil
+
+$W_{lim}$ soil water limitation factor
+\begin{equation}
+{W_{{{lim}}}={{MIN}}(2f_{{w}},1)}\nonumber
+\end{equation}
+% \end{document}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex	(revision 6412)
@@ -0,0 +1,24 @@
+% \documentclass[onecolumn,a4paper]{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+$T_0$ (tp\_00) = 273.15 0 degree Celsius expressed in degree Kelvin defined in constantes.f90
+
+$k_T$ temperature-dependent pseudo-first-order rate constant of assimilation response to CO2
+
+\begin{equation}
+{k_{{T}}=0{.}7\cdot 0{.}{177}\cdot e^{{0{.}{069}\cdot (T_{{{{air}}}}-T_{{0}})}}\cdot {10}^{6}}\nonumber
+\end{equation}
+
+$R_T$ temperature-dependent non-photosynthetic respiration
+
+\begin{equation}
+{R_{{T}}=0{.}8\cdot {\frac{0{.}{177}\cdot e^{{0{.}{069}\cdot (T_{{{{air}}}}-T_{{0}})}}}{(1+e^{1{.}3(T_{{{{air}}}}-T_{{{max}}})}{)}}}}\nonumber
+\end{equation}
+
+\begin{equation}
+{V_{{c}}=V_{{c{max}}}\cdot 0{.}{39}\frac{0{.}{177}\cdot e^{{0{.}{069}\cdot (T_{{{{air}}}}-T_{{0}})}}}{(1+e^{0{.}3\cdot (T_{{{min}}}-T_{{{{air}}}})}{)(1+e^{0{.}3\cdot (T_{{{{air}}}}-T_{{{{opt}}}})}}{)}}W_{{lim}}}\nonumber
+\end{equation}
+
+% \end{document}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex	(revision 6412)
@@ -0,0 +1,26 @@
+Tlim temperature limitation factor
+
+\begin{equation}
+{T_{{{lim}}}=\frac{(T_{{{{air}}}}-T_{{{min}}})\cdot (T_{{{{air}}}}-T_{{{max}}})}{(T_{{{{air}}}}-T_{{{min}}})\cdot (T_{{{{air}}}}-T_{{{max}}})-(T_{{{{air}}}}-T_{{{{opt}}}})^{{2}}}}
+\end{equation}
+Tmin, Tmax and Topt are local variables that are initialized through the assim\_param array.
+
+Kc Michaelis-Menten constant for the rubisco enzyme catalytic activity for CO2 (ppm)
+
+\begin{equation}
+{K_{{c}}={39}{.}{09}\cdot e^{{0{.}{085}\cdot (T_{{{{air}}}}-T_{{0}})}}}
+\end{equation}
+Ko Michaelis-Menten constant for the rubisco enzyme catalytic activity for O2 (ppm)
+
+\begin{equation}
+{K_{{o}}=\frac{2{.}{412}\cdot {210000}\cdot e^{{0{.}{085}\cdot (T_{{{{air}}}}-T_{{{min}}})}}}{(T_{{{air}}}{-T_{{min}}}{)}}}
+\end{equation}
+\begin{equation}
+{\Gamma ^{{?}}={42}\cdot e^{{9{.}{46}\frac{T_{{{{air}}}}-T_{{0}}-{25}}{T_{{{{air}}}}}}}}
+\end{equation}
+\begin{equation}
+{V_{{c}}=V_{{c{max}}}\cdot T_{{{lim}}}\cdot W_{{{lim}}}}
+\end{equation}
+\begin{equation}
+{V_{{j}}=V_{{j{max}}}\cdot T_{{{lim}}}\cdot W_{{{lim}}}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex	(revision 6412)
@@ -0,0 +1,6 @@
+\begin{equation}
+{V_{{c}}(l)=V_{{c}}\cdot (1-0.7\cdot (1-e^{{-k\cdot LAI(l)}}))}
+\end{equation}
+\begin{equation}
+{V_{{j}}(l)=V_{{j}}\cdot (1-0.7\cdot (1-e^{{-k\cdot LAI(l)}}))}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex	(revision 6412)
@@ -0,0 +1,36 @@
+The photosynthesis is defined by a pair of nested quadratic equations:
+
+M flux determined by the Rubisco and light limited capacities
+
+${\Phi}$ fixed equal to 0.83
+
+${\beta}$ fixed equal to 0.93
+
+M smaller root of
+
+\begin{equation}
+{\Phi \cdot M^{{2}}-M\cdot (V_{{c}}(l)+\alpha \cdot Q)+V_{{c}}(l)\cdot \alpha \cdot Q=0}
+\end{equation}
+Ci(l) (leaf\_ci) global variable declared in diffuco module
+
+W smaller root of
+
+\begin{equation}
+{\beta \cdot W^{{2}}-W\cdot (M+k_{{T}}\cdot C_{{i}}(l)\cdot {10}^{{-6}})+M\cdot k_{{T}}\cdot C_{{i}}(l)\cdot {10}^{{-6}}=0}
+\end{equation}
+${\alpha}$ quantum efficiency
+
+\begin{equation}
+{\alpha \cdot Q=0{.}{092}\cdot 2{.}3\cdot {{SWdown}}\cdot k\cdot e^{{-k\cdot {{LAI}}(l)}}}
+\end{equation}
+
+\begin{equation}
+{M=\frac{V_{{c}}(l)+\alpha \cdot Q-\sqrt{(V_{{c}}(l)+\alpha \cdot Q)^{{2}}-4\cdot \Phi \cdot V_{{c}}(l)\cdot \alpha \cdot Q}}{2\cdot \Phi }}
+\end{equation}
+
+\begin{equation}
+{W=\frac{M+k_{{T}}\cdot C_{{i}}(l){.}{10}^{{-6}}-\sqrt{(M+k_{{T}}\cdot C_{{i}}(l){.}{10}^{{-6}})^{{2}}-4\cdot \beta \cdot M\cdot k_{{T}}\cdot C_{{i}}(l){.}{10}^{{-6}}}}{2\cdot \beta }}
+\end{equation}
+\begin{equation}
+{A=W-R_{{T}}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex	(revision 6412)
@@ -0,0 +1,43 @@
+Wc rubisco-limited carboxylation rate
+
+Oi partial pressure of O2 (fixed to 210000 ppm)
+
+\begin{equation}
+{W_{{c}}=\frac{V_{{c}}(l)\cdot C_{{i}}(l)}{C_{{i}}(l)+K_{{c}}\cdot (1+O_{{i}}/{K_{{o}}})}}
+\end{equation}
+Vj potential rate of RuBP regeneration
+
+I incident photon flux
+
+${\alpha}$j quantum yield of RuBP regeneration 
+
+\begin{equation}
+{\alpha_{{j}}\cdot I=0{.}{8855}\cdot {{SW}}_{{{{down}}}}\cdot k\cdot e^{{-k\cdot {{LAI}}(l)}}}
+\end{equation}
+${\Theta}$ curvature of the quantum response (fixed equal to 0.7)
+
+\begin{equation}
+{V_{{j}}=\frac{\alpha_{{j}}\cdot I+V_{{j}}(l)-\sqrt{(\alpha_{{j}}\cdot I+V_{{j}}(l))^{{2}}-4\cdot \Theta \cdot \alpha_{{j}}\cdot I\cdot V_{{j}}(l)}}{2\cdot \Theta }}
+\end{equation}
+Wj RuBP regeneration-limited rate
+
+${\Gamma}$* CO2 compensation point (ppm)
+
+\begin{equation}
+{W_{{j}}=\frac{V_{{j}}\cdot C_{{i}}(l)}{4{.}5\cdot C_{{i}}(l)+{10}{.}5\cdot \Gamma ^{{?}}}}
+\end{equation}
+
+\begin{equation}
+{W={{MIN}}(W_{{c}},W_{{j}})}
+\end{equation}
+
+Rd dark respiration
+
+fdr fraction of dark respiration (fixed equal to 0.011)
+
+\begin{equation}
+{R_{{d}}=f_{{{{dr}}}}\cdot V_{{c}}(l)}
+\end{equation}
+\begin{equation}
+{A=W\cdot \left(1-\frac{\Gamma ^{{?}}}{C_{{i}}(l)}\right)-R_{{d}}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{equation}
+{g_{{s}}(l)={{mA}}(l)\frac{h_{{r}}}{C_{{a}}}+b}
+\end{equation}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex	(revision 6412)
@@ -0,0 +1,7 @@
+\begin{equation}
+{A=A+A(l)\cdot({{LAI}}(l+1)-{{LAI}}(l))}
+\end{equation}
+\begin{equation}
+{g_{{s}}=g_{{s}}+g_{{s}}(l)\cdot({{LAI}}(l+1)-{{LAI}}(l))}
+\end{equation}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = U_{wind}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    zscf = \sqrt{(1 + cd |Ri_{z}|)}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+     cd_{tmp}=\frac {cd_{neut}}{1+3 c_b Ri_z zscf}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+     zscf = \frac {1}  {1+ 3 cc * cc * cd_{neut}  *\sqrt{|Ri_z| \frac{ (z_{lev}   +  roughheight) }  {z_0} }}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+     cd_{tmp} = cd_{neut} (1-3 cb* Ri_{z} * zscf)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+      q_{cdrag} = max   \left\{  cd_{tmp}, \frac{1 \times 10^{-4}}{max \left\{ U, (U_{wind})_{min} \right\} }  \right\}    
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Z_g = Z_{lev} g_0
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Z_d^\phi = \left( \frac{Z_g} {C_{p,air}} \right)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{V, a, surf} = T_a + \frac {Z_d^\phi} {(1 + rv_{tmp2} q_{air})(1+retv q_{air}) }
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{V, surf} = T_g (1 + retv q_{surf})
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \left( {\frac{\delta u}{\delta z}} \right) ^2 = max \{ (0.1)^2, U^2  \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Ri_{z} = z_g \frac {T_{V, a, surf}-T_{V, surf}}{\left( {\frac{\delta u}{\delta z}} \right) ^2  * T_{V, a, surf}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Ri_{z} = max \{   min   \{Ri_z, 5    \}, -5  \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    cd_{neut} = \left(  \frac{  \kappa }  {\frac{LOG(zlev + roughheight)}{z_0} }               \right)^2
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    r_{a} = \frac{1}{q_{c,drag}U}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,4} \equiv  \left(  \frac{1}{1+\frac{r_1}{r_a}}  \right) U_{s_1} = \left( \frac{1}{1+ \frac {r_{soil}}{r_a}} \right) VEG
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,4} = evap_{bare, lim}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \sum_1^{nvm} (\beta_{v,2}); \  \sum_1^{nvm} (\beta_{v,3})   
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_v = 1; \ \alpha_v = 1    
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_v = \beta_{v,4} +  \sum_1^{nvm} (\beta_{v,2}) + \sum_1^{nvm} (\beta_{v,3})   
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \sum_1^{nvm} (veget); \  \sum_2^{nvm} (veget)   
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{eqnarray}
+    IF \ (q_{sat} < q_{air}) \ THEN \ (IF \ (T_a > 0) \ THEN \ toveg=TRUE, \ tosnow = FALSE ) \\
+    IF \ (q_{sat} < q_{air}) \ THEN \ (IF \ (T_a < 0) \ THEN \ toveg= FALSE, \ tosnow=TRUE )  
+\end{eqnarray}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{eqnarray}
+    IF \ (toveg) \ THEN: \ \beta_{v,1}=0, \ \beta_{v,4} = (veget), \ \beta_v = \beta_{v,4}, \ \alpha_v = 1 \\
+    IF \ (tosnow) \ THEN: \ \beta_{v,1}=1, \ \beta_{v,4} = 0, \ \beta_v =1, \ \alpha_v = 1       
+\end{eqnarray}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{eqnarray}
+    \chi^{dew, veg}= \chi^{d,v}_6(LAI)^5 - \chi^{d,v}_5(LAI)^4 + \chi^{d,v}_4(LAI)^3 
+    - \chi^{d,v}_3(LAI)^2 + \chi^{d,v}_2(LAI) + \chi^{d,v}_1
+\end{eqnarray}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{eqnarray}
+    \beta_{v,3} = 0; \ RH = 0     
+\end{eqnarray}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{eqnarray}
+    \beta_{v,2} = 0       
+\end{eqnarray}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    zqs_{veg}^{rap} = max \left\{ 0, \left( \frac {qs_{int}^{veg} } { qs_{int}^{max} } \right) \right\}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,2} = VEG zqs_{veg}^{rap} \left( \frac{1}{1 + U q_{c,drag} r_{sv} }   \right) \equiv VEG zqs_{veg}^{rap} \left( \frac{1}{1 + \frac{r_{sv}}{r_a} }   \right)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{equation}
+    ziltest = \Delta t \beta_{v,2} U q_{c,drag} \rho (q_{sat}-q_{air}) \equiv \Delta t \beta_{v,2} E_{pot} 
+\end{equation}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    z_{rapp} = \frac{qs_{int}^{veg}}{ziltest}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,23} = max \left\{  \beta_{v,2} - \beta_{v,2}z_{rapp} , 0 \right\}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,2} = \beta_{v,2} z_{rapp}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \delta _c = \rho . max\{ (q_{sat} - q_{a}), 0 \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    zqs_{veg}^{rap} = max \left\{ 0 , \frac{q_{s,int}^{veg}}{q_{s,int}^{max}}  \right\}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    r_{veg} = \left( \frac{1}{LAI} \right) \left( \frac{R_{SW}^{net} + {R}_{0}}{R_{SW}^{net}} \right) \left( \frac{a+ \lambda \delta_c}{k_0} \right) 
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v3} = VEG (1 - zqs^{rap}_{veg} RH) \frac {1} {1 + \frac {r_{veg}^{pft} (r_{veg}^{et} + r_{sv})}{r_a} }
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,3} = \beta_{v,3} + min \left\{ \beta_{v,23}, VEG zqs_{veg}^{rap} RH \frac {1} {1 + \frac{ r_{veg}^{pft} (r_{veg}^{et} + r_{sv}) }{r_a}} \right\}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex	(revision 6412)
@@ -0,0 +1,72 @@
+% 
+% \documentclass[11pt]{amsart}
+% \usepackage{helvet}
+% \usepackage{geometry}    
+% \geometry{a4paper} 
+% \usepackage[parfill]{parskip}  \usepackage{graphicx}
+% \usepackage{amssymb}
+% \usepackage{epstopdf}
+%
+%
+%
+% \begin{document}
+% 
+{\bf Introduction to the coupled energy budget scheme}
+ 
+The coupled energy balance scheme in ORCHIDEE is described most extensively in Dufresne \& Ghattas (2009) with further context in Best et al. (2004). The key principles are summarised here. 
+
+Figure 1 depicts how the surface layer model interacts with the atmospheric model. The model is depicted as running from left to right. The coefficients A, B, C and D are derived for each variable as a means to solve the diffusivity equation for the four state variables of windspeeds 'u' and 'v', temperature and specific humidity (we here concentrate on the latter two variables, denoted together in Figure 1 as 'X'). This diffusivity equation (with a counter-gradient term for the temperature and specific humidity versions) is differenced in such a way that it can be solved implicitly - i.e. the system is solved using information both from the system at the current time and in the next timestep (in an explicit scheme only information from the current time step is used).
+
+\includegraphics[scale=0.5]{iterative_diagram3.png}
+
+{\bf {Figure 1}: Simple schematic of coupling scheme}
+
+The end result is that the diffusivity equation in LMDZ is solved using an 'offset' varient of the Tri-Diagonal Matrix Algorithm. This differencing scheme is as described by Richtmyer et al. (1967). The scheme allows for terms of the equation to be solved in sequence, as depicted, starting from the top of the model. It takes place by deriving coefficients A, B, C, D for each layer in terms of the preceding, higher, layer on a 'downwards' sweep. ORCHIDEE assumes the place of the lower surface layer boundary condition, and provides the state variables for the lowest level of the atmospheric model. On the 'upwards' sweep, the state variables for each layer are calculated in terms of the respective coefficients and of the state variable from the preceding, lower layer.
+
+
+The key information is passed down from the atmospheric model to the surface model are the sensitivity coefficients $A_S, B_S, A_q$ and $B_q$ where, according to the lower boundary conditions of the atmospheric model, where the surface interaction takes place (Best et al., 2004):
+
+\begin{eqnarray}
+  S_1^{new} = A_S(H) + B_S \\
+  q_1^{new} = A_q(\lambda E) + B_q
+\end{eqnarray}
+
+$S^{new}_1$ is the lowest atmospheric model dry static energy and $q^{new}_1$ is the lowest atmospheric model specific humidity, both for the 'new' time step. The A, B, C and D coefficients (which are recalculated for every time step) are a function of the state variables from the old last time step (specific humidity and surface static energy), as well as an intermediate variable (S) that includes the diffusivity coefficient (k), the atmospheric pressure at the height (P) and a 'counter-gradient term' ($\gamma$). The B coefficient is also a function of P, S and g. As part of the differencing scheme, each coefficient A,B,C and D is also a function of the coefficient above, so they are calculated by 'working down' the column, as depicted.
+
+Now, although the coefficients A and B in equations (1) and (2) are known quantities, $S^{new}$, $q^{new}$, H and $\lambda E$ are not.
+
+In order to determine these quantities, we need to make use of a further set of assumptions:
+
+a) We assume that surface fluxes for a given timestep are written as below (shown here for the 'new' timestep):
+\begin{eqnarray}
+   H = k_1^h (S_1^{new}-S_s^{new}) \\
+   \lambda E =\beta k_1^q (q_1^{new} - q_s ^{new}) =\beta k_1^q (q_1^{new} - q_0 ^{new} (T_s^{new}))
+\end{eqnarray}
+
+These equations are implicit because they have been formulated for the 'new' timestep. $q_0^{new}$ is the saturated humidity that corresponds to the surface temperature $T_s^{new}$. We make the saturated humidity assumption: i.e. the air within cavities in the surface vegetation is completely saturated. This means that the vapour pressure of the vegetation may be calculated as the saturated vapour pressure at the vegetation temperature.
+
+b) We assume, by first-order Taylor series expansion, that:
+
+\begin{eqnarray}
+    q_0(T_s^{new}) = q_{sat}(T_s^{old}) + \frac {\delta q_{sat}} {\delta T}|_{T_t} (T^{new}_s - T^{old}_s)
+\end{eqnarray}
+
+c) We assume that the energy budget is obeyed over the timestep $\Delta t$ such that a change in the balance of fluxes for the surface layer corresponds exactly to the change in surface temperature:
+
+\begin{eqnarray}
+   T_s^{new}=T^{old}_s + \frac{\delta t}{C_0} \sum F
+\end{eqnarray}
+
+where:
+
+\begin{eqnarray}
+    \sum F = H + \lambda E + R_{LW} + R_{SW} + F_G
+\end{eqnarray}
+
+Combining this set of equations, as is conducted by Dufresne \& Ghattas (2009) results in the sequence of operations that is carried out in the 'enerbil' module, and is outlined below.
+
+%
+%
+%
+%
+% \end{document}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex	(revision 6412)
@@ -0,0 +1,135 @@
+%
+% \documentclass[11pt]{amsart}
+% \usepackage{helvet}
+% \usepackage{geometry}    
+% \geometry{a4paper} 
+% \usepackage[parfill]{parskip}  \usepackage{graphicx}
+% \usepackage{amssymb}
+% \usepackage{epstopdf}
+%
+%
+%
+% \begin{document}
+
+\renewcommand{\arraystretch}{1.5}
+
+\begin{tabular}{|c|l|r|}
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+\hline
+ $ps^{old}$ & psold & surface static energy at old timestep (J/kg) \\
+ $ps^{new}$ & psnew & surface static energy at new timestep (J/kg)\\
+ $q_s$ & qsurf & surface specific humidity (kg/kg) \\
+ $q_{s, sat}$ & qsol\_sat & saturated surface humidity (kg/kg) \\
+ $q_{air}$ & qair & lowest level specific humidity at 'old' timestep (kg/kg) \\
+ $q_{air}^{new}$ & qair\_new & lowest level specific humidity at 'new' timestep (kg/kg) \\
+ $\frac{\delta q_s^{old}}{\delta t}$ & pdqsold & derivative of saturated specific humidity at old temperature (kg/(kg s)) \\ 
+ $p_l$ & pb & lowest level air pressure (Pa) \\
+ \hline
+ $C_p^{air}$ & cp\_air & lowest level atmospheric heat capacity (J/(K kg)) \\   
+ \hline
+ $\chi_{CO_2}^{canopy}$ & ccanopy & $CO_2$ concentration in the canopy (?? ppm)  \\
+ $\bar{Ci}$ & cimean & mean intercellular ci (from STOMATE) $(\mu mole/m^2/s)$\\  
+ \hline
+ $R^{LW}_{\uparrow}$ & lwup & long-wave upwelling radiation $(W/m^2)$ \\  
+ $ R^{LW}_{\downarrow}$ & lwdown & downwelling long-wave radiation flux $(W/m^2)$ \\
+ $R^{LW}_{abs}$ & lwabs  & LW radiation absorbed by the surface $(W/m^2)$ \\ 
+ $R^{SW}_{net}$ & swnet & net shortwave radiation flux $(W/m^2)$ \\
+ $R^{net}_{sns}$ & netrad\_sns & sensitivity of net radiation $(W/m^2)$ \\
+ $R_{net}$ & netrad & net radiation at surface layer $(W/m^2)$ \\
+ \hline
+ $\Delta \theta$ & dtradia & Time step (s) \\
+ $\epsilon$ & emis & emissivity (fraction) \\
+ $\sigma$ & c\_stefan & Stefan-Boltzmann constant $(W / (m^2 K^4))$\\
+ $q_{c}$ & q\_cdrag & surface drag coefficient (m/s) \\
+ $\rho_{air}$ & rau & density of air $(kg/m^3)$ \\
+\hline
+\end{tabular}
+
+
+\begin{tabular}{|c|l|r|}
+
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+
+\hline
+
+ $\lambda E_{evap}^0$ & chalev0 & latent heat of evaporation (J/kg) \\
+ $\lambda E_{sub}^0$ & chalsu0 & latent heat of sublimination (J/kg) \\ 
+ $\lambda E_{fsn}^0$ & chalfu0 & latent heat of fusion (J/kg) \\
+
+ $H^{old}$ & sensfl\_old & sensible heat flux at 'old' timestep $(W/m^2)$ \\ 
+ $H^{sns}$ & sensfl\_sns & sensitivity of sensible heat flux $(W/m^2)$\\
+ $H^{new}$ & fluxsens & sensible heat flux at 'new' timestep $(W/m^2)$\\
+
+ ${\lambda E}_{evap}^{old}$ & lareva\_old  & evaporation latent heat flux at old timestep $(W/m^2)$ \\
+ ${\lambda E}_{evap}^{sns}$ & lareva\_sns  & sensitivity of latent heat flux $(W/m^2)$ \\
+  ${\lambda E}_{evap}^{new}$ & fluxsens  & sensitivity of latent heat flux at 'new' time step $(W/m^2)$ \\
+
+ $\lambda E_{sub}^{old}$ & larsub\_old & sublimation latent heat flux at 'old' time step $(W/m^2)$ \\
+ $\lambda E^{sns}_{sub}$ & larsub\_sns & sensitivity of sublimination latent heat flux $(W/m^2)$ \\
+ $\lambda E_{new}^{sub}$ & fluxsubli & sens. of subn. latent heat flux at 'new' time step $(W/m^2)$ \\
+
+ $\Sigma (\lambda E^{old})$ & sum\_old & total latent heat flux at 'old' time step $(W/m^2)$\\
+
+ $\Sigma (\lambda E^{sns})$ & sum\_sns & total latent heat flux sensitivity at 'old' time step $(W/m^2)$\\
+ $E_{pot}^{air,new}$ & epot\_air & air potential energy (?? J) \\
+
+ $G$ & soilflx & sensible heat flux from soil $(W/m^2)$ \\
+
+ \hline
+
+ $E^{snow}$ & vevapsno & snow evaporation (mm/day)\\  
+ $E^{soil}$ & vevapnu & bare soil evaporation  (mm/day)\\ 
+ 
+  $(melt)_{tot}$ & tot\_melt & total melt \\  
+ $vev_{app}$ & vevapp & total of evaporation (mm/d) \\  
+ 
+
+ 
+\hline
+\end{tabular}
+
+
+
+\begin{tabular}{|c|l|r|}
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+
+ \hline
+
+ $A_q^{orc}$ & peqAcoef & ORCHIDEE humidity coefficient 'A' \\
+ $B_q^{orc}$ & peqBcoef & ORCHIDEE humidity coefficient 'B'\\
+ $A_T^{orc}$  &  petAcoef & ORCHIDEE temperature coefficient 'A' \\
+ $B_T^{orc} $ & petBcoef & ORCHIDEE temperature coefficient 'B' \\    
+ $A_q^{lmdz}$ & ... & LMDZ humidity coefficient 'A' \\  
+ $B_T^{lmdz}$ & ... & LMDZ temperature coefficient 'A' \\  
+ $B_q^{lmdz}$ & ... & LMDZ humidity coefficient 'B' \\  
+ $B_T^{lmdz}$ & ... & LMDZ temperature coefficient 'B' \\  
+ \hline
+ $T_{air}$ & tair & air temperature (K) \\
+ $T_{dgnc}^{2m}$ & t2mdiag & diagnostic temperature at 2m above ground (K) \\  
+ $T_S$ & temp\_sol & surface temperature (K) \\  
+ \hline
+
+ $\alpha_v $ & valpha & total $\alpha$ resistance coefficient (fraction) \\
+ $\beta_v$ & vbeta & total resistance coefficient (fraction) \\
+ $\beta_{v1}$ & vbeta1 & snow resistance (fraction) \\  
+ $\beta_{v2}$ & vbeta2 & interception resistance (fraction)\\  
+ $\beta_{v3}$ & vbeta3 & vegetation resistance (fraction)\\  
+ $\beta_{v4}$ & vbeta4 & bare soil resistance (fraction)\\
+ $\beta_{v,CO_2}$ & vbetaco2 & vegetation resistance to $CO_2$ \\ 
+ \hline
+ $U$ & speed & lowest level wind speed (m/s) \\
+ $u$ & u & lowest level wind velocity,  Eastward component  (m/s) \\
+ $v$ & v & lowest level wind volocity, Northward component  (m/s) \\
+ \hline
+ $z_{ikt}$ & zikt & aerodynamic resistance / density of air (kg s $m^{-4}$) \\
+ $z_{ikq}$ & zikq & aerodynamic resistance / density of air (kg s $m^{-4}$)  \\
+\hline
+\end{tabular}
+
+%
+%
+%
+%\end{document}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    ps^{old} = T_S C_p
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \frac{\delta q_s^{old}}{\delta t} = \delta q_s 
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R^{LW}_{abs} = \epsilon R^{LW}_{\downarrow}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R_{net} = R^{LW}_{\downarrow} + S^{SW}_{net} - \epsilon \sigma T^4 (1-\epsilon) R^{LW}_{\downarrow}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   E^{snow} = \beta_{v1} \Delta t \rho U q_c^{drag} (q_{sol,s}^{new}- q_{air})
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   E^{soil} = (1-\beta_{v1})\beta_{v4} \Delta t \rho U q_c^{drag} (q_{sol,s}^{new} - q_{air})
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   xx = \Delta t (1-\beta_{v1}) (q_{s,sat}^{new} - q_{a}) \rho S q_c^{drag}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   (Interception) = xx \beta_{v2}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   (Transpiration) = xx \beta_{v3}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   U = max \{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   (Assimilation) = \beta_{v,CO_2} \Delta t \rho S q_c^{drag} (\chi_{CO_2}^{canopy} - \bar{Ci})
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U=max\{U_{min}, \sqrt{u^2+v^2} \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   H=\lambda E_0^{sub}(\rho)q_c(\beta_{v,1})(q_{s,sat}^{new}-q_{air}+\lambda E_0^{evap}(\rho)q_c(1-\beta_{v,1})\beta_v(\alpha_v)q_{s,sat}^{new}-q_{air})
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \lambda E^{sub}=\lambda E_0^{sub} (\rho)q_c\beta_{v,1}(q_{s,sat}^{new}-q_{air})
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H = \rho q_c (ps^{new}- E^{pot}_{air})
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   R^{LW}_{net} = R^{LW}_{\downarrow}-R^{LW}_{\uparrow}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   E^{pot}_{air} = max \{0, \Delta t \rho q_c (q_{s,sat}^{new} -q_{air}) \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T_{air}= \frac{E^{pot}_{air}}{c_{p, air}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_c=|v|q_{c, drag}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R^{LW}_{\uparrow}=\epsilon \sigma T_{sol}^4+\epsilon 4 \sigma T_{sol}^3(T_{s}^{new}-T_{s})
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{equation}
+    R^{LW}_{\uparrow}=R^{LW}_{\uparrow}+(1-\epsilon)R^{LW}_{\downarrow}
+\end{equation}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{rad}=\epsilon \sigma T_{s}^4 + R^{LW}_{\uparrow}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_{surf}=\beta_{v,1} (q_{s,sat}^{new})+(1-\beta_{v,1})\beta_v\alpha_v(q_{s,sat}^{new})
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_s = max \{q_s, q_{air} \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R_{net}=R^{LW}_{\downarrow}+R^{SW}_{net}-R^{LW}_{\uparrow}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    vev_{app} = \Delta t (\rho)q_c \beta_{v,1}(q_{s,sat}^{new}-q_{air})+\Delta t(\rho)q_c(1-\beta_{1,v}\beta_v(\alpha_v)q_{s,sat}^{new}-q_{air})
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    (fusion) = (melt)_{tot} \frac {\lambda E_{sub}^0}{\Delta t}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{new} = T_{s}^{new} - \frac {(melt)_{tot} \lambda E_{sub}^0}{(soilcap)}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max \{ U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \Sigma E^{old} = R_{net} + H^{old} + {\lambda E}_{sub}^{old} + {\lambda E}_{evap}^{old} + G
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \Sigma E^{sns} = R^{sns} + H^{sns} + {\lambda E}_{sub}^{sns} + {\lambda E}_{evap}^{sns} + G
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \Delta \theta = \frac {\Delta t (\Sigma E^{old})} {\left( \frac {1}{C_p^{air}} (C_p^{soil} + \Delta T) (\Sigma E^{sns}) \right)}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    ps^{new} = ps^{old} + \Delta \theta
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_{s,sat}^{new} = q_{s,sat} + \left( \left( \frac{1}{C_p^{air}} \right) \left( \frac{\delta q_s^{old}}{\delta t} \right) \delta\theta \right)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{new} = \frac {ps^{new}}{C_p^{air}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    E_{pot}^{air,new} = z_{ikt} (H^{old} - H^{sns} \Delta \theta) + ps^{new}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{equation}
+    {\lambda E} ^{evap} = ({\lambda E}_{evap}^{old} - {\lambda E} _{evap} ^{sns} \Delta \theta) + ({\lambda E}_{sub}^{old} - {\lambda E}_{sub}^{sns} \Delta \theta)
+\end{equation}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_{air}^{new}(ji) = q_{air}(ji)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   q_{air}^{new} = z_{ikq} \frac {1} {(\lambda E^{evap}_0  (1 - \beta_{v1}) \beta_1 \alpha_v + \lambda E^{sub}_0 \beta_{v1})} {\lambda E} ^{evap} + q_{s,sat}^{new} 
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    z_{ikt}=\frac{1}{\rho_{air} U q_{c}}; \quad z_{ikq}=\frac{1}{\rho_{air} U q_{c}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H^{old} = \frac{B_T^{orc} - ps^{old}}{z_{ikt} - A_T^{orc}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \lambda E _{sub}^{old} = \lambda E_{sub}^0 \frac{B_q^{orc} - q_{s, sat}}{z_{ikq}-A_q^{orc}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \lambda E _{evap}^{old} = \lambda E_{evap}^0  \left( 1-\beta_{v1} \beta_v \left( \frac {  B_q^{orc} - \alpha_v q_{s, sat}  }{  z_{ikq} - A_q^{orc}  }  \right) \right)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R^{net}_{sns} = \left( \frac{1}{C_p} \right) 4 \epsilon \sigma \left( \left( \frac{1}{C_p} \right) ps_{t} ^3 \right)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H_{sns} = \frac{1} { \left( \frac{1}{\rho_{air} S q_{c}} - A_T^{orc} \right)}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \lambda E_{sns}^{sub} = \lambda E_{sub}^0 \beta_{v1} \frac{1}{C_p} \left( \frac{ ({\delta q_s^{t}}/{\delta t}) } {z_{ikq} - A_q^{orc} } \right)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \lambda E_{sns}^{evap} = \lambda E_{evap}^0 (1-\beta_{v1}) \beta_v \alpha_v \frac{1}{C_p} \left( \frac{ ({\delta q_s^{t}}/{\delta t}) } {z_{ikq} - A_q^{orc} } \right)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilt2mdiag1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilt2mdiag1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilt2mdiag1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{dgnc}^{2m} = T_{air} 
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex	(revision 6412)
@@ -0,0 +1,392 @@
+\documentclass{article}
+\begin{document}
+
+
+{ \bf enerbil.f90 equations }
+
+\vspace {10mm}
+{ \bf enerbil\_begin }
+
+\vspace {10mm}
+enerbilbegin1.tex
+
+\begin{equation}
+    ps^{t} = T_S C_p
+\end{equation}
+
+\vspace {10mm}
+enerbilbegin2.tex
+
+\begin{equation}
+    \frac{\delta q_s^{t}}{\delta t} = \delta q_s \frac{(p_l)^\kappa}{C_p^{air}}
+\end{equation}
+
+\vspace {10mm}
+enerbilbegin3.tex
+
+\begin{equation}
+    R^{LW}_{abs} = \epsilon R^{LW}_{\downarrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilbegin4.tex
+
+\begin{equation}
+    R_{net} = R^{LW}_{\downarrow} + S^{SW}_{net} - \epsilon \sigma T^4 (1-\epsilon) R^{LW}_{\downarrow}
+\end{equation}
+
+\vspace {10mm}
+{ \bf enerbil\_surftemp }
+
+\vspace {10mm}
+enerbilsurftemp1.tex
+
+\begin{equation}
+    U = max \{ U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp2.tex
+
+\begin{equation}
+    z_{ikt}=\frac{1}{\rho_{air} U q_{c}}; \quad z_{ikq}=\frac{1}{\rho_{air} U q_{c}}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp3.tex
+
+\begin{equation}
+    H^{t} = \frac{B_T^{orc} - ps^{t}}{z_{ikt} - A_T^{orc}}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp4.tex
+
+\begin{equation}
+    \lambda E _{sub}^{t} = \lambda E_{sub}^0 \frac{B_q^{orc} - q_{s, sat}}{z_{ikq}-A_q^{orc}}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp5.tex
+
+\begin{equation}
+    \lambda E _{evap}^{t} = \lambda E_{evap}^0  \left( 1-\beta_{v1} \beta_v \left( \frac {  B_q^{orc} - \alpha_v q_{s, sat}  }{  z_{ikq} - A_q^{orc}  }  \right) \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp6.tex
+
+\begin{equation}
+    R^{net}_{sns} = \left( \frac{1}{C_p} \right) 4 \epsilon \sigma \left( \left( \frac{1}{C_p} \right) ps_{t} ^3 \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp7.tex
+
+\begin{equation}
+    H_{sns} = \frac{1} { \left( \frac{1}{\rho_{air} S q_{c}} - A_T^{orc} \right)}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp8.tex
+
+\begin{equation}
+    \lambda E_{sns}^{sub} = \lambda E_{sub}^0 \beta_{v1} \frac{1}{C_p} \left( \frac{ ({\delta q_s^{t}}/{\delta t}) } {z_{ikq} - A_q^{orc} } \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp9.tex
+
+\begin{equation}
+    \lambda E_{sns}^{evap} = \lambda E_{evap}^0 (1-\beta_{v1}) \beta_v \alpha_v \frac{1}{C_p} \left( \frac{ ({\delta q_s^{t}}/{\delta t}) } {z_{ikq} - A_q^{orc} } \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp10.tex
+
+\begin{equation}
+    \Sigma E^{t} = R_{net} + H^{t} + {\lambda E}_{sub}^{t} + {\lambda E}_{evap}^{t} + G
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp11.tex
+
+\begin{equation}
+    \Sigma E^{sns} = R^{sns} + H^{sns} + {\lambda E}_{sub}^{sns} + {\lambda E}_{evap}^{sns} + G
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp12.tex
+
+\begin{equation}
+    \Delta \theta = \frac {\Delta t (\Sigma E^{t})} {\left( \frac {1}{C_p^{air}} (C_p^{soil} + \Delta T) (\Sigma E^{sns}) \right)}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp13.tex
+
+\begin{equation}
+    ps_{t+\Delta t} = ps_{t} + \Delta \theta
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp14.tex
+
+\begin{equation}
+    q_{s,sat}^{t+\Delta t} = q_{s,sat} + \left( \left( \frac{1}{C_p^{air}} \right) \left( \frac{\delta q_s^{t}}{\delta t} \right) \delta\theta \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp15.tex
+
+\begin{equation}
+    T_{s}^{t+\Delta t} = \frac {ps^{t+\Delta t}}{C_p^{air}}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp16.tex
+
+\begin{equation}
+    E_{pot}^{air,t+\Delta t} = z_{ikt} (H^{t} - H^{sns} \Delta \theta) + ps^{t+\Delta t}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp17.tex
+
+\begin{equation}
+    {\lambda E} ^{evap} = ({\lambda E}_{evap}^{t} - {\lambda E} _{evap} ^{sns} \Delta \theta) + ({\lambda E}_{sub}^{t} - {\lambda E}_{sub}^{sns} \Delta \theta)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp18.tex
+
+\begin{equation}
+    q_{air}^{t+\Delta t}(ji) = q_{air}(ji)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp19.tex
+
+\begin{equation}
+   q_{air}^{t+\Delta t} = z_{ikq} \frac {1} {(\lambda E^{evap}_0  (1 - \beta_{v1}) \beta_1 \alpha_v + \lambda E^{sub}_0 \beta_{v1})} {\lambda E} ^{evap} + q_{s,sat}^{t+\Delta t} 
+\end{equation}
+
+\vspace {10mm}
+{ \bf surf\_land\_orchidee (links from LMDZ to ORCHIDEE)} 
+
+\vspace {10mm}
+surflandLMDZ1.tex
+
+\begin{equation}
+    A_T^{orc} = B_T^{lmdz} \Delta t
+\end{equation}
+
+\vspace {10mm}
+surflandLMDZ2.tex
+
+\begin{equation}
+    B_T^{orc} = A_T^{lmdz}
+\end{equation}
+
+\vspace {10mm}
+surflandLMDZ3.tex
+
+\begin{equation}
+    A_q^{orc} = B_q^{lmdz} \Delta t
+\end{equation}
+
+\vspace {10mm}
+surflandLMDZ4.tex
+
+\begin{equation}
+    B_q^{orc} = A_q^{lmdz}
+\end{equation}
+
+\vspace {10mm}
+{ \bf enerbil\_flux} 
+
+\vspace {10mm}
+enerbilflux1.tex
+
+\begin{equation}
+    U=max\{U_{min}, \sqrt{u^2+v^2} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux2.tex
+
+\begin{equation}
+    q_c=|v|q_{c, drag}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux3.tex
+
+\begin{equation}
+    R^{LW}_{\uparrow}=\epsilon \sigma T_{sol}^4+\epsilon 4 \sigma T_{sol}^3(T_{s}^{t+\Delta t}-T_{s})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux4.tex
+
+\begin{equation}
+    R^{LW}_{\uparrow}=R^{LW}_{\uparrow}+(1-\epsilon)R^{LW}_{\downarrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux5.tex
+
+\begin{equation}
+    T_{s}^{rad}=\epsilon \sigma T_{s}^4 + R^{LW}_{\uparrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux6.tex
+
+\begin{equation}
+    q_{surf}=\beta_{v,1} (q_{s,sat}^{t+\Delta t})+(1-\beta_{v,1})\beta_v\alpha_v(q_{s,sat}^{t+\Delta t})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux7.tex
+
+\begin{equation}
+    q_s = max \{q_s, q_{air} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux8.tex
+
+\begin{equation}
+    R_{net}=R^{LW}_{\downarrow}+R^{SW}_{net}-R^{LW}_{\uparrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux9.tex
+
+\begin{equation}
+    vev_{app} = dt(\rho)q_c \beta_{v,1}(q_{s,sat}^{t+\Delta t}-q_{air})+\Delta t(\rho)q_c(1-\beta_{1,v}\beta_v(\alpha_v)q_{s,sat}^{t+\Delta t}-q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux10.tex
+
+\begin{equation}
+   H=\lambda E_0^{sub}(\rho)q_c(\beta_{v,1})(q_{s,sat}^{t+\Delta t}-q_{air}+\lambda E_0^{evap}(\rho)q_c(1-\beta_{v,1})\beta_v(\alpha_v)q_{s,sat}^{t+\Delta t}-q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux11.tex
+
+\begin{equation}
+   \lambda E^{sub}=\lambda E_0^{sub} (\rho)q_c\beta_{v,1}(q_{s,sat}^{t+\Delta t}-q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux12.tex
+
+\begin{equation}
+    H = \rho q_c (ps^{t+\Delta t}- E^{pot}_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux13.tex
+
+\begin{equation}
+   R^{LW}_{net} = R^{LW}_{\downarrow}-R^{LW}_{\uparrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux14.tex
+
+\begin{equation}
+   E^{pot}_{air} = max \{0, \Delta t \rho q_c (q_{s,sat}^{t+\Delta t} -q_{air}) \}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux15.tex
+
+\begin{equation}
+   T_{air}= \frac{E^{pot}_{air}}{c_{p, air}}
+\end{equation}
+
+
+
+
+
+
+
+
+
+{\bf enerbil\_evapveg.f90}
+
+\vspace {10mm}
+enerbilevapveg1.tex
+
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg2.tex
+
+\begin{equation}
+   E^{snow} = \beta_{v1} \Delta t \rho U q_c^{drag} (q_{sol,s}^{t+\Delta t}- q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg3.tex
+
+\begin{equation}
+   E^{soil} = (1-\beta_{v1})\beta_{v4} \Delta t \rho U q_c^{drag} (q_{sol,s}^{t+\Delta t} - q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg4.tex
+
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg5.tex
+
+\begin{equation}
+   xx = \Delta t (1-\beta_{v1}) (q_{s,sat}^{t+\Delta t} - q_{a}) \rho S q_c^{drag}
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg6.tex
+
+\begin{equation}
+   (Interception) = xx \beta_{v2}
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg7.tex
+
+\begin{equation}
+   (Transpiration) = xx \beta_{v3}
+\end{equation}
+
+
+\vspace {10mm}
+enerbilevapveg8.tex
+
+\begin{equation}
+   U = max \{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
+
+
+\vspace {10mm}
+enerbilevapveg9.tex
+
+\begin{equation}
+   (Assimilation) = \beta_{v,CO_2} \Delta t \rho S q_c^{drag} (\chi_{CO_2}^{canopy} - \bar{Ci})
+\end{equation}
+
+
+
+
+
+\end{document}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{equation}
+    A_T^{orc} = B_T^{lmdz} \Delta t
+\end{equation}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    B_T^{orc} = A_T^{lmdz}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    A_q^{orc} = B_q^{lmdz} \Delta t
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    B_q^{orc} = A_q^{lmdz}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}\label{eq:bdiff}
+W_{b_j} = \frac{\sum_j a_j W_{b_j}}{\sum_j a_j}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{eqnarray}\label(eq:drs}
+R_s & = & 0.05 R \\
+D & = & 0.95 R
+\end{eqnarray}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex	(revision 6412)
@@ -0,0 +1,10 @@
+It is slower when the top soil moisture $W_t$ is low, and accelerates above a threshold moisture $W_t^\mathrm{lim}$: 
+\begin{equation}\label{eq:dr1}
+D_t = D_t^\mathrm{min}\frac{W_t}{W_t^\mathrm{max}}, \,\, \mathrm{if} \,\, W_t < W_t^\mathrm{lim},
+\end{equation}
+\begin{equation}\label{eq:dr2}
+D_t = D_t^\mathrm{min}\frac{W_t}{W_t^\mathrm{max}} + (D_t^\mathrm{max} - D_t^\mathrm{min})\left(
+\frac{W_t \,-\, W_t^\mathrm{lim}}{W_t^\mathrm{max}\, - \,W_t^\mathrm{lim}} \right)^{\alpha_t},
+\,\, \mathrm{if}\,\,W_i \geq W_i^{lim}
+\end{equation}
+where $D_t^\mathrm{min}$, $D_t^\mathrm{max}$, and $\alpha_t$ are specific parameters.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex	(revision 6412)
@@ -0,0 +1,4 @@
+For three variables (top and bottom soil moisture, $W_t$ and $W_b$; dry soil height at the top, $h_t^d$), we describe a linear relaxation of the values $X_j$ within each soil column towards their grid-cell average $X_j$, with a timescale $\tau_h$ of one day:
+\begin{equation}\label{eq:hdiff}
+\Delta X_j = - \frac{\Delta t}{\tau_h}(X_j-\overline{X}).
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel.tex	(revision 6412)
@@ -0,0 +1,15 @@
+If only one soil layer is present, then  $h_t^d = h_b^d$, and we define: 
+\begin{equation}\label{eq:us1}
+U_s=  \exp (-c_j \, h_t^d )
+\end{equation}
+If there are two soil layers, we compute $U_s$ as the average of the values defined by the two dry soil depths $h_t^d$ and  $h_b^d$. The weights depend on $a_j^\mathrm{sat}$, which defines the "transpiring" fraction of the top soil layer:
+\begin{equation}\label{eq:us2}
+U_s= a_j^\mathrm{sat} \exp (-c_j \, h_t^d ) + (\mathrm{1}-a_j^\mathrm{sat})  \exp (-c_j \, h_b^d )
+\end{equation}
+
+The "transpiring" fraction is defined by redistributing the top layer's moisture $W_t$ in a virtual layer of depth $h_t^\mathrm{sub}$ (set to 1 mm in hydrolc), what defines a totally dry and a totally saturated fraction ($a_j^\mathrm{sat}$):
+\begin{itemize}
+\item if  $W_t > h_t^\mathrm{sub} \, \theta^\mathrm{max}$, then $a_j^\mathrm{sat}$=1, and $U_s$ depends on $h_t^d$ only (Eq. \ref{eq:us1}), % $U_s=\exp (-c_j \, h_t^d )$,
+\item if $W_t$ is very small, $a_j^\mathrm{sat}$ decreases from 1 to 0 as the top layer's moisture vanishes, and it serves to describe a smooth transition to the case where the top soil layer has vanished and $U_s$ depends on  $h_t^d = h_b^d$.
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}\label{eq:us1}
+U_s=  \exp (-c_j \, h_t^d )
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}\label{eq:us2}
+U_s= a_j^\mathrm{sat} \exp (-c_j \, h_t^d ) + (\mathrm{1}-a_j^\mathrm{sat})  \exp (-c_j \, h_b^d )
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+snowmelt=\frac{(temp\_sol\_new - tp\_00)*soilcap}{chalfu0}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+d\_age=(age-(1- \frac{age}{max\_snow\_age})*\frac{dt\_radia}{one\_day})*\exp(-\frac{precip\_snow}{snow\_trans}))-age
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+d\_age\_nobio=\frac{d\_age}{1+(\frac{tp\_00-T}{7.})^4}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex	(revision 6412)
@@ -0,0 +1,14 @@
+These calculations are only performed in the non bare soil PFTs ($j>1$), over the vegetated fraction $a_j$. 
+The maximum amount of water that can be added to the interception reservoir is:
+\begin{equation}\label{eq:interc1}
+I^\mathrm{add} = I^\mathrm{max} - [I]_\mathrm{old} - E_i \Delta t.
+\end{equation}
+The intercepted water amount $I$ is therefore updated with:
+\begin{equation}\label{eq:interc2}
+[I]_\mathrm{new} = [I]_\mathrm{old} - E_i \Delta t + \min (a_j P_L (1-f_j) \Delta t, I^\mathrm{add}),
+\end{equation}
+where $f_j$ is the fraction of rainfall that cannot be intercepted and necessarily falls to the ground.
+The throughfall $P_T$ is then calculated with:
+\begin{equation}\label{eq:interc3}
+P_T \Delta t = P_L (1-f_j) \Delta t - ([I]_\mathrm{new} - [I]_\mathrm{old}).
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex	(revision 6412)
@@ -0,0 +1,10 @@
+It non linearly increases with the height of top dry soil $h_\mathrm{dry}$, and becomes very large when $h_\mathrm{dry}$ gets close to the total soil depth, $h_\mathrm{tot}$:
+\begin{equation}\label{eq:rsol}
+r_\mathrm{soil} = r_\mathrm{soil}^\mathrm{m} \left( h_\mathrm{dry} + \frac{\mathrm{1}}{\mathrm{100}(h_\mathrm{tot}-h_\mathrm{dry})^2}  \right).
+%r_\mathrm{soil} = r_\mathrm{soil}^r_\mathrm{m}  
+\end{equation}
+The top dry soil height  $h_\mathrm{dry}$ depends on both $h_t^d$ and $h_t^d$ in the bare soil fraction. As for the soil moisture stress factor on transpiration and bare soil evaporation ($U_s$), we use $a_j^\mathrm{sat}$ to describe a smooth transition between cases when the top layer's moisture  $W_t > h_t^\mathrm{sub} \theta^\mathrm{max}$ (then $h_\mathrm{dry}=h_t^d$),  and cases when the top layer's has vanished (then  $h_\mathrm{dry}=h_t^d=h_b^d$):
+\begin{equation}\label{eq:hdry}
+h_\mathrm{dry} = a_1^\mathrm{sat} h_{t_1}^d + (\mathrm{1} - a_1^\mathrm{sat})  h_{b_1}^d.
+\end{equation}
+% hdry(:) = a_subgrd(:,1)*dss(:,1) + (un-a_subgrd(:,1))*dsp(:,1) 
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsat.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsat.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsat.tex	(revision 6412)
@@ -0,0 +1,12 @@
+We calculate the deviation of the saturated humidity with the temperature and the pressure.
+\begin{equation}
+\delta q_{sat}(T) = \frac{(q_s(\lfloor T+\frac{1}{2}\rfloor + 1) - 2.q_s(\lfloor T +\frac{1}{2} \rfloor) + q_s(\lfloor T+\frac{1}{2} \rfloor -1))(\lbrace T + \frac{1}{2}\rbrace -1 ) + q_s(\lfloor T+\frac{1}{2} \rfloor +1) - q_s(\lfloor T+\frac{1}{2} \rfloor)}{P}
+\end{equation}
+
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T + \frac{1}{2} \rfloor $ represents the largest integer not greater than $T + \frac{1}{2} $. 
+ \item  $ \lbrace T + \frac{1}{2} \rbrace = T + \frac{1}{2} -\lfloor T + \frac{1}{2} \rfloor $ is the fractional part of $T + \frac{1}{2} $.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsatcalc.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsatcalc.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsatcalc.tex	(revision 6412)
@@ -0,0 +1,14 @@
+We calculate the deviation of the saturated humidity with the temperature and the pressure for a given pixel $x$.
+\begin{multline}
+\delta q_{sat}(x,T) = \\
+\frac{(q_s(x,\lfloor T+\frac{1}{2}\rfloor + 1) - 2.q_s(x,\lfloor T +\frac{1}{2} \rfloor) + q_s(x,\lfloor T+\frac{1}{2} \rfloor -1))(\lbrace T + \frac{1}{2}\rbrace -1 )} {P}+ 
+\\ \frac{q_s(x,\lfloor T+\frac{1}{2} \rfloor +1) - q_s(x, \lfloor T+\frac{1}{2} \rfloor)}{P}
+\end{multline}
+
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T + \frac{1}{2} \rfloor $ represents the largest integer not greater than $T + \frac{1}{2} $. 
+ \item  $ \lbrace T + \frac{1}{2} \rbrace = T + \frac{1}{2} -\lfloor T + \frac{1}{2} \rfloor $ is the fractional part of $T + \frac{1}{2} $.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/goff_gratch.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/goff_gratch.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/goff_gratch.tex	(revision 6412)
@@ -0,0 +1,30 @@
+The subroutine qsfrict\_init uses modified Goff-Gratch equations (1946). The original formulations are : \\
+\begin{multline}
+\log e_w = \\ -7.90298 \left( \frac{T_s}{T} - 1 \right) + 5.02808 \log \left( \frac{T_s}{T} \right) 
+- 1.3816 \times 10^{-7}(10^{11.344 \left( 1-\frac{T_s}{T} \right)}-1) 
++ 8.1328 \times 10^{-3}(10^{-3.49149 \left( \frac{T_s}{T}-1 \right)}
+-1) \\ + \log e_{ws}
+\end{multline}
+where : \\
+\begin{itemize}
+ \item  $ \log(x) = \frac{\ln x}{\ln 10} $. 
+ \item  $e_w$ is the saturation water vapor pressure over a plane surface of pure ordinary liquid water (hPa).
+ \item  $T$ is the absolute air temperature in Kelvin.
+ \item  $T_s$ is the steam point temperature (373.16 K).
+ \item  $e_{ws}$ is the saturation pressure of pure ordinary liquid water at steam-point temperature (at 1 atm = 1013.25 hPa).
+\end{itemize}
+
+\begin{multline}
+\log e_i = \\ -9.09718 \times \left( \frac{T_0}{T} - 1 \right) - 3.56654 \times \log \left( \frac{T_0}{T} \right) 
++ 0.876793 \times \left( 1-\frac{T_0}{T} \right) 
++ \log e_{i0}
+\end{multline}
+where : \\
+\begin{itemize}
+ \item  $ \log(x) = \frac{\ln x}{\ln 10} $. 
+ \item  $e_i$ is the saturation water vapor pressure over a plane surface of pure ordinary water ice (hPa).
+ \item  $T$ is the absolute air temperature in Kelvin (K).
+ \item  $T_0$ is the boiling point at 1 atmosphere temperature (273.16 K).
+ \item  $e^{*}_{i0}$  is the saturation pressure of pure ordinary water ice at ice-point temperature (6.1173 hPa).
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsat.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsat.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsat.tex	(revision 6412)
@@ -0,0 +1,12 @@
+The interpolation the saturated humidity depends on the temperature $T$ (in Kelvin). 
+It is set by the following equation :
+\begin{equation}
+q_{sat}(T)= \dfrac{q_s(\lfloor T \rfloor +1) - q_s(\lfloor T \rfloor).\lbrace T \rbrace + q_s(\lfloor T \rfloor)}{P}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T \rfloor $ represents the largest integer not greater than $T$. 
+ \item  $ \lbrace T \rbrace = T -\lfloor T \rfloor $ is the fractional part of $T$.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsatcalc.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsatcalc.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsatcalc.tex	(revision 6412)
@@ -0,0 +1,12 @@
+The interpolation the saturated humidity on one pixel $x$  depends on the temperature $T$ (in Kelvin). 
+It is set by the following equation :
+\begin{equation}
+q_{sat}(x,T)= \dfrac{q_s(x,\lfloor T \rfloor +1) - q_s(x,\lfloor T \rfloor).\lbrace T \rbrace + q_s(x,\lfloor T \rfloor)}{P}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T \rfloor $ represents the largest integer not greater than $T$. 
+ \item  $ \lbrace T \rbrace = T -\lfloor T \rfloor $ is the fractional part of $T$.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsfrict_init.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsfrict_init.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsfrict_init.tex	(revision 6412)
@@ -0,0 +1,17 @@
+The specific humidity  $q_s$ is a function of temperature $T$. Its values are : 
+\begin{equation}
+q_s(T) = 
+\begin{cases}
+0 & \text{if} \quad T < 100K \\
+\dfrac{M_{air}}{M_{vapor}} \cdot 10^{2.07203 - 0.0032099T - \frac{2484.896}{T} + 3.56654\log{T}} & \text{if} \quad 100K \leq T < 273K \\
+\dfrac{M_{air}}{M_{vapor}} \cdot 10^{23.819 - \frac{2948.964}{T} -
+  5.028\log{T} - 29910.16\exp(-0.0699832\times T) + 25.21935\exp(-\frac{2999.924}{T}) } & \text{if} \quad 273K \leq T \leq 370K \\
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $\dfrac{M_{air}}{M_{vapor}} = \dfrac{18.02 \times 10^{-3}}{28.964 \times 10^{-3}} \simeq 0.622 $ is the ratio between the molecular weight of dry air and \\ 
+the molecular weight of water vapor.
+ \item  $\log(T) = \dfrac{\ln T}{\ln 10}$
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/tempfunc.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/tempfunc.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/qsat_moisture/tempfunc.tex	(revision 6412)
@@ -0,0 +1,18 @@
+%\documentclass{article}
+%\usepackage[english]{babel}
+%\usepackage{amsmath}
+%\begin{document}
+\begin{equation}
+f(T) = 
+\begin{cases}
+0 & \text{if} \quad T < 273K \\
+1 - \dfrac{(T_{max} - T)^2}{(T_{max} - T_{min})^2} & \text{if} \quad 273K \leq T \leq 293K \\
+1 & \text{if} \quad T > 293K
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ T_{min} = 273K$ 
+ \item  $ T_{max} = 293K$
+\end{itemize}
+%\end{document}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+\frac{\partial T}{\partial t}=\frac{\partial ^2 T}{\partial z^2}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+C_p\frac{\partial T}{\partial t}=K\frac{\partial ^2 T}{\partial z^2}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex	(revision 6412)
@@ -0,0 +1,5 @@
+\begin{equation}
+D = \Bigl[\frac{4 \times (C_{sapwood} + C_{heartwood})}{WD.\pi.k_{allom2}}\Bigr]^{\frac{1}{(2+k_{allom3})}} 
+H = k_{allom2} \times D^{k_{allom3}} 
+CA =\min(k_{allom1} \times D^{k_{rp}},CA_{max})
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    D = \Bigl[\frac{4 \times (C_{sapwood} + C_{heartwood})}{WD.\pi.k_{allom2}}\Bigr]^{\frac{1}{(2+k_{allom3})}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H = k_{allom2} \times D^{k_{allom3}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+    CA =\min(k_{allom1} \times D^{k_{rp}},CA_{max})
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex	(revision 6412)
@@ -0,0 +1,37 @@
+\begin{equation}
+FPC = \frac{CN \cdot IND}{FRAC} \cdot \left[ 1 - \exp \left( -1 \cdot 
+    LM_{\rm max} \cdot SLA \cdot coff \right) \right]
+\end{equation}
+where $FPC$ is foliage projective cover (``fpc\_nat'' in source code),
+$CN$ crown area (cn\_ind; m$^{2}$), $IND$ number of individuals (ind;
+m$^{-2}$), $FRAC$ total fraction occupied by natual vegetation
+(fracnat), $LM_{\rm max}$ maximum leaf mass in last year
+(lm\_lastyearmax; g C m$^{-2}$), $SLA$ specific leaf area (sla;
+m$^{2}$ (g C)$^{-1}$), and $coff$ coefficient (ext\_coeff).
+
+\begin{equation}
+  EST_{\rm tree} = EST_{clm} \left[1 - \exp \left( -5 \cdot (1 - FPC_{\rm woody}) 
+    \right) \right] \cdot (1 - FPC_{\rm woody})
+\end{equation}
+where $EST_{\rm tree}$ is maximum tree establishment rate
+(estab\_rate\_max\_tree), $EST_{clm}$ maximum tree establishment rate
+controled by climate (estab\_rate\_\\max\_climate\_tree), $FPC_{\rm
+  woody}$ total woody FPC (sumfpc\_wood).
+
+\begin{equation}
+  EST_{\rm grass} = \max \left[  \min \left[ EST_{clm}, 0.98 - FPC_{\rm sum} \right], 
+    0 \right]
+\end{equation}
+where $EST_{\rm grass}$ is maximum grass establishment rate
+(estab\_rate\_max\_grass) and $FPC_{\rm sum}$ total natural fpc
+(sumfpc).
+
+\begin{equation}
+FPC = \min \left[ 1, CN \right] \cdot IND \cdot \max \left[ 1 - \exp 
+  \left( -coff \cdot LAI \right), MIN_{\rm cover} \right]
+\end{equation}
+where $MIN_{\rm cover}$ is fraction of crown area invaded by other
+trees (min\_cover = 0.05)
+
+
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex	(revision 6412)
@@ -0,0 +1,6 @@
+\begin{equation}
+p(m)=e^{-\pi*\left(\frac{m}{m_e}\right)^{2}}
+\end{equation}
+
+
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex	(revision 6412)
@@ -0,0 +1,6 @@
+\begin{equation}
+A(s)=s*e^{(\frac{s-1}{0.45*(s-1)^{3}+2.83*(s-1)^{2}+2.96*(s-1)+1.04})}
+\end{equation}
+
+
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{equation}
+greff=\frac{\Delta}{C_{leaf}*SLA}
+\end{equation}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+mort_{greff}=\frac{k_{mort1}}{1+k_{mort2}*greff}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{equation}
+FPC = \frac{CN \cdot IND}{FRAC} \cdot \left[ 1 - \exp \left( -1 \cdot 
+    LM_{\rm max} \cdot SLA \cdot coff \right) \right]
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+A\propto \frac{\sum X_{i}}{\sum X_{i}+\sum Y_{j}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{rpc}=\frac{1}{1-e^{-{\frac{\mathit{z_soil}\left(nbdl\right)}{\mathit{z_nitrogen}}}}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{equation}
+\mathit{t_{nitrogen}}=\sum_{l=1}^\mathit{nbdl} \mathit{tsoil_{month}} \cdot \mathit{rpc} \cdot \left( e^{  -\frac{\mathit{z_{soil}(l-1)}}{\mathit{z_{nitrogen}}}  } 
+- e^{  -\frac{\mathit{z_{soil}(l)}}{\mathit{z_{nitrogen}}}  } \right)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{h_{nitrogen}}=\sum_{l=1}^\mathit{nbdl} \left(\mathit{soil\_hum\_month} \cdot \mathit{rpc} \cdot \left(e^{-{\frac{\mathit{z_{soil}}\left(l-1\right)}{\mathit{z_{nitrogen}}}}}-e^{-{\frac{\mathit{z_{soil}}(l)}{\mathit{z_{nitrogen}}}}}\right)\right)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{equation}
+\mathit{use\_reserve}=\mathit{min}\left(\mathit{biomass}\left(\mathit{carbres}\right),2 \cdot \frac{\mathit{dt}}{\mathit{tau_{leafinit}}}\cdot\frac{\mathit{lai_{happy}}}{\mathit{sla}}\right)
+
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex	(revision 6412)
@@ -0,0 +1,6 @@
+\begin{equation}
+
+
+\mathit{transloc\_leaf}=\frac{\mathit{L0}}{\mathit{L0}+\mathit{R0}}\cdot \mathit{use\_reserve}
+
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{alloc\_sap_{above}}=\mathit(alloc\_min)+\left(\mathit{alloc\_max}-{\mathit{alloc\_min}}\right)\left(1-e^{-{\frac{\mathit{age}}{\mathit{demi\_alloc}}}}  \right)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex	(revision 6412)
@@ -0,0 +1,8 @@
+\begin{equation}
+\mathit{falloc_{leaf}}=\mathit{LtoLSR} \cdot \left( 1-\mathit{falloc_{fruit}} \right) \cdot \mathit{carb\_rescale}
+\mathit{falloc_{sapabove}}=\mathit{StoLSR}\cdot \mathit{alloc\_sap_{above}} \cdot \left( 1-\mathit{falloc_{fruit}} \right)\cdot \mathit{carb\_rescale}
+\mathit{falloc_{sapbelow}}=\mathit{StoLSR}\cdot \left( 1- \mathit{alloc\_sap_{above}} \right) \cdot \left( 1-\mathit{falloc_{fruit}} \right)\cdot \mathit{carb\_rescale}
+\mathit{falloc_{root}}=\mathit{RtoLSR}\cdot\left( 1-\mathit{falloc_{fruit}} \right)\cdot \mathit{carb\_rescale}
+\mathit{falloc_{carbres}}=\left( 1-\mathit{carb\_rescale}\right)\left( 1-\mathit{falloc_{fruit}} \right)
+
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex	(revision 6412)
@@ -0,0 +1,13 @@
+The SLA is calculated for each different PFT by the following equation :
+\begin{equation}
+SLA =
+\begin{cases}
+ 2.10^{-4}\times 10^{2.29 - 0.4\log(\frac{12}{a_{leaf}})} & \text{if PFT needle-leaf} \\
+ 2.10^{-4}\times 10^{2.41 - 0.38\log(\frac{12}{a_{leaf}})}
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $a_{leaf}$ is a PFT-specific value for leaf longevity in days.
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex	(revision 6412)
@@ -0,0 +1,9 @@
+The SLA is calculated in Reich et al. 97 by :
+\begin{equation} 
+SLA = \exp (5.615 - 0.46 \cdot \ln (a_{leaf}))
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $a_{leaf}$ is a PFT-specific value for leaf longevity in months.
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex	(revision 6412)
@@ -0,0 +1,43 @@
+Sapling biomass for grasses : \\
+
+\begin{equation}
+\alpha_{grass} = 0.5
+\end{equation}
+
+\begin{equation}
+SAPL_{leaf}
+\begin{cases}
+\dfrac{0.1}{SLA} & \\
+\dfrac{1}{SLA} & \text{if PFT crop}
+\end{cases} %\]
+\end{equation}
+
+\begin{equation}
+SAPL_{sapabove} = 0
+\end{equation}
+
+\begin{equation}
+SAPL_{sapbelow} = 0
+\end{equation}
+
+
+\begin{equation}
+SAPL_{heartabove} = 0
+\end{equation}
+
+\begin{equation}
+SAPL_{heartbelow} = 0
+\end{equation}
+
+\begin{equation}
+SAPL_{root} = 0.1 \cdot \frac{1}{\alpha_{grass}} \cdot SAPL_{leaf} 
+\end{equation}
+
+\begin{equation}
+SAPL_{fruit} = 0.3 \cdot SAPL_{leaf} 
+\end{equation}
+
+\begin{equation}
+SAPL_{reserve} = 5 \cdot SAPL_{leaf}  
+\end{equation}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex	(revision 6412)
@@ -0,0 +1,55 @@
+Sapling biomass for trees : \\
+
+\begin{equation}
+\alpha_{tree} = 1
+\end{equation}
+
+\begin{equation}
+SAPL_{leaf} =  \left( \frac {4 \cdot k_{allom1} \cdot \left( \dfrac{4 \cdot r_{hs:s} \cdot SLA }{\pi .k_{la:sa}}\right)^{0.8} }{SLA} \right)^5
+\end{equation}
+
+\begin{equation}
+SAPL_{sapabove} = 0.5 \cdot P \cdot \frac{SAPL_{leaf}}{\left( \dfrac
+  {k_{la:sa}}{SLA} \right) } \cdot k_{allom2} \cdot \left(
+  \sqrt{4.\frac{r_{hs:s}}{\pi} \frac{SAPL_{leaf}}{ \left( \dfrac {k_{la:sa}}{SLA} \right) }} \right) ^{k_{allom3}} 
+\end{equation}
+
+\begin{equation}
+SAPL_{sapbelow} = SAPL_{sapabove}
+\end{equation}
+
+
+\begin{equation}
+SAPL_{heartabove} = 2.SAPL_{sapabove}
+\end{equation}
+
+\begin{equation}
+SAPL_{heartbelow} = 2.SAPL_{sapbelow}
+\end{equation}
+
+\begin{equation}
+SAPL_{root} = 0.1 \cdot \frac{1}{\alpha_{tree}} \cdot SAPL_{leaf} 
+\end{equation}
+
+\begin{equation}
+SAPL_{fruit} = 0.3 \cdot SAPL_{leaf} 
+\end{equation}
+
+\begin{equation}
+SAPL_{reserve} = 
+\begin{cases}
+5 \cdot SAPL_{leaf} & \text{if PFT not evergreen} \\
+0 & \text{if PFT evergreen}
+\end{cases} %\]
+\end{equation}
+
+where : \\
+\begin{itemize}
+ \item  $k_{allom1}= 100$; \quad $ k_{allom2} = 40$; \quad  $k_{allom3}= 0.5$.
+ \item  $r_{hs:s}$ is the ratio between the sum of the mass of sapwood and heartwood over sapwood.
+ \item  $k_{la:sa} = 8000 $
+ \item  $P = 200000$ is the pipe density. 
+\end{itemize}
+
+
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex	(revision 6412)
@@ -0,0 +1,10 @@
+Critical stem diameter for trees : beyond this diameter, the crown area no longer increases.
+\begin{equation}
+D_{max} = 0.01 .\left( \frac{k_{allom4}}{\dfrac{k_{allom2}.k_{allom3}}{100^{k_{allom3}}}} \right)^{\dfrac{1}{k_{allom3} - 1}}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $D_{max}$ is the maximum stem diameter.
+ \item  $ k_{allom2} = 40$; \quad  $k_{allom3}= 0.5$; \quad  $k_{allom4}= 0.3$
+\end{itemize}
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   M=MAX(0.25,MIN(1,M)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=e^{0.69*(\frac{temp-303}{10})}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=MIN(1,T)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=MIN(1,T)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   DLC=1-e^{(-0.5*LAI)}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   M=-1.1*soilmoisture^2+2.4*soilmoisture-0.29
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   F=0.85-0.018*L*CN
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   k=\frac{1}{litter tau}*T*M
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dDL}{dt}=DL*(1-k)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dInput}{dt}=f*C*(1-L)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dLAI}{dt}=DL*sla*vegetmax
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex	(revision 6412)
@@ -0,0 +1,5 @@
+\begin{equation}
+gdd_{crit}(i) =  GDD_{crit1,j} + GDD_{crit2,j} \times T_{l} + GDD_{crit3,j} \times T_{l}^{2}
+\end{equation}
+where GDD$_{crit1,2,3}$ are the PFT-dependent threshold parameters defined by the ::$pheno_crit$\%$gdd$, and $T_{l}$ is the long-term
+reference temperature (::$tlong_ref$ - calculated in ::$stomate_constants$) in degrees C. i and j are the grid cell and PFT respectively.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex	(revision 6412)
@@ -0,0 +1,7 @@
+\begin{equation}
+LM_{min}(i) = \frac{LAI_{init,min}(j)}{SLA(j)} 
+\end{equation}
+where $LM_{min}$ is the minimum leaf biomass, $LAI_{init\_min}$ is the minimum initial LAI, which is
+PFT-dependent and specified by the parameter ::pheno_crit\%lai\_initmin, which is defined in 
+::stomate\_constants. SLA, the specific leaf area, is also PFT-dependent and defined in
+::stomate\_constants. i and j are the grid cell number and PFT respectively.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex	(revision 6412)
@@ -0,0 +1,5 @@
+\begin{equation}
+avail_{crit}(i) = min_{moi,ly}(i,j) + hum_{frac}(j) * ( max_{moi,ly}(i,j) - min_{moi,ly}(i,j))
+\end{equation}
+where $min_{moi,ly}$ and $max_{moi,ly}$ are last year's minimum and maximum moisture availability, and $hum_{frac}$ is the 
+parameter ::$pheno_crit\%hum\_frac$.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex	(revision 6412)
@@ -0,0 +1,5 @@
+\begin{equation}
+A_{moi} = max(\, 0.1, \frac{\sum_{i=1}^{n} H_{i}e^{-z_{i}/\zeta}\Delta_{i}}{ \sum_{i=1}^{n} e^{-z_{i}/\zeta}\Delta_{i}} \,)
+\end{equation}
+where $A_{moi}$ is the plant available moisture, $H_{i}$ is the soil humidity (relative soil moisture) of the $i$-th layer, $z_{i}$ is the depth of the layer, and $\Delta$ is its thickness. $\zeta$ is the root density profile, which is 1.5m for trees and 0.3m for grasses (Krinner et al., 2005).
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex	(revision 6412)
@@ -0,0 +1,4 @@
+\begin{equation}
+gdd_{min} = \frac{603}{\exp(0.0091*NCD(i,j))} - 64. 
+\end{equation}
+where i and j are the grid cell and PFT, respectively. 
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex	(revision 6412)
@@ -0,0 +1,5 @@
+The equation to calculate tree crown area from its diameter:
+\begin{equation}
+CA=k_{allom1}*Diameter^{k_{rp}}
+\end{equation}
+Where $CA$ is tree crown area, $Diameter$ is tree diameter, $k_{allom1}$ and $k_{rp}$ are parameters.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex	(revision 6412)
@@ -0,0 +1,5 @@
+The equation to calculate tree height from its diameter:
+\begin{equation}
+Height=k_{allom2}*Diameter^{k_{allom3}}
+\end{equation}
+Where $Height$ is tree height, $Diameter$ is tree diameter, $k_{allom2}$ and $k_{allom3}$ are parameters.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{rpc}=\frac{1}{1-e^{-{\frac{\mathit{z\_soil}\left(nbdl\right)}{\mathit{rprof}}}}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{t\_root}=\sum_{l=1}^\mathit{nbdl} (\mathit{stempdiag} \cdot \mathit{rpc} \cdot \left(e^{-{\frac{\mathit{z\_soil}\left(l-1\right)}{\mathit{rprof}}}}-e^{-{\frac{\mathit{z\_soil}(l)}{\mathit{rprof}}}}\right))
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{slope}=\mathit{maint\_resp\_slope1}+\mathit{maint\_resp\_slope2}\cdot \mathit{tl}+\mathit{maint\_resp\_slope3}\cdot \mathit{tl}\cdot \mathit{tl}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{coeff\_maint}=\mathit{coeff\_maint\_zero}\cdot \left(\frac{\mathit{dt}}{\mathit{one\_day}}\right)\cdot \left(1+\mathit{slope}\cdot \mathit{t\_maint\_radia}\right)
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{resp\_maint\_leaf}=\mathit{coeff\_maint(leaf)}\cdot \mathit{leaf\_biomass}\cdot\frac{ (0.3\cdot \mathit{LAI}+1.4\cdot (1.0-e^{-0.5\cdot \mathit{LAI}}))}{\mathit{LAI}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex	(revision 6412)
@@ -0,0 +1,6 @@
+\begin{equation}
+consumption = hvc1 \times NPPleaf_{long}^{hvc2}
+\end{equation}
+
+\noindent where hvc1 and hvc2 are herbivore activity constants which are set at the beginning of this module to
+0.019 and 1.38 respectively. NPPleaf_{long} is the mean, long-term leaf NPP.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex	(revision 6412)
@@ -0,0 +1,5 @@
+\begin{equation}
+herbivore = \frac{Tres_{green} \times NPPleaf_{long}}{consumption} 
+\end{equation}
+
+\noindent where Tres_{green} is the mean residence time of the green tissue.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex	(revision 6412)
@@ -0,0 +1,5 @@
+\begin{equation}
+X_{l} = \frac{X_{l} \, (\tau - {\Delta}t) + X_{s} \, {\Delta}t}{\tau}
+\end{equation}
+
+\noindent where X$_{l}$ is the long-term variable (e.g. monthly temperature/moisture availability), X$_{s}$ is the short-term variable (e.g. daily temperature/moisture availability), $\Delta$t is the time step, and $\tau$ is the time constant (in days) which varies according to the length of time represented by the long-term variable (equation (3) in Krinner et al., 2005). Values for tau set are based on calibration against observations CHECK.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+moist_{avail} = \frac{moist_{avail} \times (tau_{hum} - \Delta t) + moist_{avail,daily} \times \Delta t}{tau_{hum}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+ncd_{max} = 3. * one\_year 
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+soilhum_{month} = \frac{soilhum_{month} \times (tau_{soilhum} - \Delta t) + soilhum_{daily} * \Delta t}{tau_{soilhum}}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex	(revision 6412)
@@ -0,0 +1,10 @@
+\begin{equation}
+Tl_{ref} = MAX(\, Tl_{ref-min}, \, MIN( \, Tl_{ref-max}, \, Tl \,) \,)
+\end{equation}
+
+\noindent where Tl$_{ref}$ is the long-term reference 2-meter temperature, 
+Tl$_{ref-min}$ and Tl$_{ref-max}$ are the reference minimum and maximum
+ long-term 2-meter temperature which CHECK should be set at the beginning of this 
+subroutine, and Tl is the "long-term" 2-meter reference temperature, previously
+calculated.
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+f_{active\rightarrow slow}=1-(0.85-0.68\times clay)-f_{active\rightarrow passive}.
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex	(revision 6412)
@@ -0,0 +1,13 @@
+\begin{equation}
+Flux_{pool}=
+\left\{
+  \begin{array}{ll}
+	C_{pool}\times\frac{\Delta t}{\tau_{pool}}\times\epsilon_T\times\epsilon_H & \textrm{(natural vegetation)} \\
+	C_{pool}\times\frac{\Delta t}{\tau_{pool}}\times\epsilon_T\times\epsilon_H\times 1.2 & \textrm{(C3 crops)} \\
+	C_{pool}\times\frac{\Delta t}{\tau_{pool}}\times\epsilon_T\times\epsilon_H\times 1.4 & \textrm{(C4 crops)}
+  \end{array}
+\right. \nonumber
+\end{equation}
+,where $C_{pool}$, $\Delta t$, $\tau_{pool}$, $\epsilon_T$ and $\epsilon_H$ are respectively the pool carbon
+stock, the time step, the pool turnover time, and two control coefficients
+(temperature and humidity) defined in the ::stomate\_litter module
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+Flux_{active}=Flux_{active}\cdot(1-0.75\times clay) . \nonumber
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+C_{pool} = C_{pool}-Flux_{pool}
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex	(revision 6412)
@@ -0,0 +1,3 @@
+\begin{equation}
+Resp_{soil}=\sum_{pool}(f_{pool\rightarrow atmosphere}\times Flux_{pool}).
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex	(revision 6412)
@@ -0,0 +1,9 @@
+\begin{equation}
+\left\{
+  \begin{array}{lcll}
+	C_{active}&=&C_{active}&+\sum_{pool}(f_{pool\rightarrow active}\times Flux_{pool})\\
+	C_{slow}   &=&C_{slow}&+\sum_{pool}(f_{pool\rightarrow slow}\times Flux_{pool})\\
+	C_{passive}&=&C_{passive}&+\sum_{pool}(f_{pool\rightarrow passive}\times Flux_{pool})
+  \end{array}
+\right.
+\end{equation}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex	(revision 6412)
@@ -0,0 +1,5 @@
+\begin{equation}
+\Delta B   = B \times MIN(0.99,\frac{\Delta t}{a_c}\times (\frac{a}{a_c})^4)
+\end{equation}
+where $B$ is the biomass, $\Delta B$ is the fraction of biomass lost, $\Delta t$ is the times step (1 day)
+and $a_c$ is the critical leaf age, a PFT-dependend parameter.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex	(revision 6412)
@@ -0,0 +1,5 @@
+\begin{equation}
+\Delta B = B \times \frac{\Delta t} {tau_leaffall}
+\end{equation}
+where $B$ is the biomass, $\Delta B$ is the fraction of biomass lost, $\Delta t$ is the times step (1 day)
+and $tau_leaffall$ is the time constant of meteorological determined turnover.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex	(revision 6412)
@@ -0,0 +1,5 @@
+\begin{equation}
+A = A + A_{i} \cdot f_{i}
+\end{equation}
+where $A$ is the mean leaf age, $A_{i}$ is the leaf age in leaf age class $i$ and $f_{i}$
+is the fraction of leaves in that class.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex	(revision 6412)
@@ -0,0 +1,8 @@
+\begin{equation}
+moist_{c}=MIN(MAX(moist_{min}+0.5(moist_{max}-moist_{min}),moist_{Senesc}),moist_{noSenesc})
+\end{equation}
+where $moist_{c}$ is the moisture availability critical level, $moist_{min}$ and 
+$moist_{max}$ are the last years moisture availability extrema for this location. 
+$moist_{Senesc}$ is the PFT dependend critical moisture level for which there is senescence and 
+$moist_{noSenesc}$ the PFT dependend critical moisture level above which there is no humidity 
+related senescence.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex	(revision 6412)
@@ -0,0 +1,6 @@
+\begin{equation}
+T_{crit}   = a\cdot T^{2}+b\cdot T+c
+\end{equation}
+where $T_{crit}$ is the critical temperature for senescence, $T$ is 
+the long term annual mean temperature and $a$,$b$ and $c$ are PFT-dependent 
+empirical parameters.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex	(revision 6412)
@@ -0,0 +1,5 @@
+\begin{equation}
+LAI = SLA \cdot B_{leaf}
+\end{equation} 
+where LAI is the Leaf Area Index, SLA is the Specific Leaf Are and B_{leaf} is
+the leaf biomass.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex	(revision 6412)
@@ -0,0 +1,7 @@
+\begin{equation}
+f_{t} = \frac {f_{t-1}\cdot B_{leaf,t-1} + \Delta lm} {B_{leaf,t}}
+\end{equation}
+where $f_{t}$ is the new leaf fraction, $f_{t-1}$ is the old leaf fraction, $B_{leaf,t}$ is the new total leaf biomass
+and $B_{leaf,t-1}$ is the old total leaf biomass. $\Delta lm$ is the change in leaf biomass in the considered class due to 
+senescence.
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/TOOLS/codealgo.awk
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/TOOLS/codealgo.awk	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/TOOLS/codealgo.awk	(revision 6412)
@@ -0,0 +1,169 @@
+# codealgo.awk - filter of ORCHIDEE f90 files
+# command : gawk -f codealgo.awk [-d] file.f90
+# create a file.f90_preproc_codealgo filtered with algo comments inside each routine all group 
+# in the Doxygen comment just before its beginning.  
+
+#**************************************************************
+# Author: Martial.Mancip
+# Contact: Martial.Mancip__at__ipsl.jussieu.fr
+# $Revision::                                          $ Revision of last commit
+# $Author::                                            $ Author of last commit
+# $Date:: 
+# IPSL (2006)
+#  This software is governed by the CeCILL licence see libIGCM/libIGCM_CeCILL.LIC
+# Modification: 
+#
+#**************************************************************
+#==========================
+function debugprint(str) {
+  if (debug) {
+     print str  | "cat 1>&2"
+  }
+}
+function myprint(str) {
+    print str >> output_file
+}
+
+
+function flush_line() {
+    if ( nblc > 0 ) {
+	if ( inside_algo == 1 ) {
+	    myprint(" !> </ul>")
+	}
+	for ( i=1; i < nblc+1; i++ ) {
+	      myprint(line[i]) 	    
+	}
+	nblc=0
+    }
+}
+
+
+#==========================
+BEGIN {
+
+    nbarg=ARGC
+    if (ARGV[1] == "-d") {
+	debug=1
+	file=ARGV[2]
+	delete ARGV[1] 
+	nbarg--
+    } else {
+	debug=0
+	file=ARGV[1]
+    }
+    output_file=file "_preproc_codealgo"
+    if (debug) {
+	lscommand=("ls " output_file)
+	outsys=system(lscommand)
+	debugprint("output of ls : " outsys)
+	if ( outsys == 0 ) {
+	    debugprint("Already find " output_file)
+	    outsys=system("rm " output_file)
+	    debugprint("output of rm : " outsys)
+	    system("touch " output_file)
+	}
+    }
+
+# When exit statement, 'END' rule is always executed, so defined a exit_value to manage this
+    exit_value=0
+    if (nbarg != 2) {
+	debugprint("Usage: codealgo.awk [-d] file.f90")
+	debugprint("")
+	debugprint("Args:")
+	debugprint("      file.f90 = source code to be parsed")
+	debugprint("") 
+	debugprint("Options:" )
+	debugprint("       -d = debug mode")
+	debugprint("") 
+	exit_value=1
+	exit 2
+    }
+    debugprint("filter " file " in " output_file) 
+
+    # Number of previous lines commented
+    nblc=0
+    # Flag indicates inside a routine
+    routine = 0
+    routine_name = ""
+    # detect begin of algo liste
+    inside_algo=0
+
+    IGNORECASE=1
+}
+
+#==========================
+{
+  debugprint($0)
+
+  if ( match($0, "^[^!('\"]*subroutine") || match($0, "^[^!('\"]*function") ) {
+
+      debugprint("routine line.")
+
+      nblc++
+      line[nblc]=$0
+
+      # Begin of algo search
+      if ( match(line[nblc],"^[[:space:]]*end") ) {
+	  debugprint("End of the routine.")
+	  if ( routine == 0 ) {
+	      # error !
+	      debugprint("error ! End of routine has been detected but no routine was opened.")
+	      exit 1
+	  } else {
+	      if ( match(line[nblc],routine_name) ) {
+		  # here we flush the whole routine
+		  debugprint("Normal End of a routine : flush previous lines.")
+		  flush_line()
+		  routine = 0
+		  inside_algo = 0
+		  nblc = 0
+	      } else {
+		  debugprint("Error in a routine : routine_name " routine_name " doesn't match.")
+		  exit 3
+	      }
+	  }
+      } else {
+	  debugprint("Begining of a new routine.")
+
+	  if ( routine == 1 ) {
+	      if ( match(line[nblc],routine_name) ) {
+		  debugprint("routine : " routine_name " detect two times. Precompilation ? OK.")
+	      } else {
+		  # error !
+		  debugprint("error ! Already find a routine not closed.")
+		  exit 1
+	      }
+	  } else {
+	      routine_name=$2
+	      sub(/\(.*/,"",routine_name)
+	      debugprint("routine : " routine_name)
+	      routine = 1
+	  }
+      }
+
+  } else if ( routine == 1 ) {
+
+      nblc++
+      line[nblc]=$0
+
+      if (match(line[nblc], "^[[:space:]]+\\!+>*[[:space:]]+[[:digit:]]+\\.*"))
+      {
+	  debugprint("New algo line.")
+	  if ( inside_algo == 0 ) {
+	      myprint(" !> ")
+	      myprint(" !> ALGORITHM : ")
+	      myprint(" !> <ul>")
+	      debugprint("ALGORITHM.")
+	      inside_algo = 1
+	  }
+	  sub(/\!+>*/,"!> <li> ")
+	  myprint($0)
+      }
+  } else if ( routine == 0 ) {
+	  myprint($0)
+  }
+}
+
+END {
+    close(output_file)
+}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/TOOLS/codedox.awk
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/TOOLS/codedox.awk	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/TOOLS/codedox.awk	(revision 6412)
@@ -0,0 +1,366 @@
+# codedox.awk - filter of ORCHIDEE f90 files
+# command : gawk -f codedox.awk [-d] file.f90
+# create a file.f90_preproc_codedox filtered
+
+#**************************************************************
+# Author: Martial.Mancip
+# Contact: Martial.Mancip__at__ipsl.jussieu.fr
+# $Revision::                                          $ Revision of last commit
+# $Author::                                            $ Author of last commit
+# $Date:: 
+# IPSL (2006)
+#  This software is governed by the CeCILL licence see libIGCM/libIGCM_CeCILL.LIC
+# Modification: 
+#
+#**************************************************************
+#==========================
+function debugprint(str) {
+  if (debug) {
+      if ( ldebug ) { 
+	  print "-> " str  | "cat 1>&2"
+      } else {
+	  print str  | "cat 1>&2"
+      }
+  }
+}
+function myprint(str) {
+    if ( ldebug ) { 
+	print str  | "cat 1>&2"
+    } else {
+	print str >> output_file
+    }
+}
+
+
+function flush_line() {
+    if ( nblc > 0 ) {
+	debugprint("==> flush")
+	for ( i=0; i < nblc; i++ ) {
+	      myprint(line[i]) 	    
+	}
+	nblc=0
+	iblc=0
+    }
+}
+
+function code_intent(iblc) {
+    debugprint("line with intent")
+    if (match(line[iblc], "intent *\\(in\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in]",line[iblc])
+    } else if (match(line[iblc], "intent *\\(out\\)")) {
+	sub(/.*\!+>*\-*/, " !> [out]",line[iblc])
+    } else if (match(line[iblc], "intent *\\(inout\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in,out]",line[iblc])
+    } else {        
+        print "unknown intent error : " line[iblc]
+	debugprint("unknown intent error : " line[iblc])
+	exit 1
+    } 
+    if ( icont == 1 ) {
+	line[iblc]=line[iblc]  "\\n"
+    }
+    debugprint("line after Doxygen intent :" line[iblc])
+
+    sub(/\!.*/, "")
+    line[nblc]=$0
+    nblc++
+    debugprint("Only code intent :" $0)
+}
+
+function code_INTENT_ (iblc) {
+    debugprint("line with INTENT")
+    if (match(line[iblc], "INTENT *\\(in\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(out\\)")) {
+	sub(/.*\!+>*\-*/, " !> [out]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(inout\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in,out]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(IN\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(OUT\\)")) {
+	sub(/.*\!+>*\-*/, " !> [out]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(INOUT\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in,out]",line[iblc])
+    } else {	
+        print "unknown INTENT error : " line[iblc]
+	debugprint("unknown INTENT error : " line[iblc])
+	exit 1
+    } 
+    if ( icont == 1 ) {
+	line[iblc]=line[iblc]  "\\n"
+    }
+    debugprint("line after Doxygen INTENT :" line[iblc])
+
+    sub(/\!.*/, "")
+    line[nblc]=$0
+    nblc++
+    debugprint("Only code intent :" $0)
+}
+
+#==========================
+BEGIN {
+    ldebug=0
+    debug=0
+    if (ARGV[1] == "-d") {
+	debug=1
+	file=ARGV[2]
+ 	delete ARGV[1] 
+    } else if (ARGV[1] == "-dd") {
+	debug=1
+	ldebug=1
+	file=ARGV[2]
+	delete ARGV[1] 
+    } else {
+	file=ARGV[1]
+    }
+    debugprint("traitement de " file)
+
+    output_file=file "_preproc_codedox"
+    if (debug) {
+	if ( ! ldebug ) {
+	    lscommand=("ls " output_file)
+	    outsys=system(lscommand)
+	    debugprint("output of ls : " outsys)
+	    if ( outsys == 0 ) {
+		debugprint("Already find " output_file)
+		outsys=system("rm " output_file)
+		debugprint("output of rm : " outsys)
+		system("touch " output_file)
+	    }
+	}
+    }
+
+# When exit statement, 'END' rule is always executed, so defined a exit_value to manage this
+    exit_value=0
+    if ( ARGV[1] == "-h" ) {
+	debugprint("Usage: codedox.awk [-h] [-d|-dd] file.f90")
+	debugprint("")
+	debugprint("Args:")
+	debugprint("      file.f90 = source code to be parsed")
+	debugprint("") 
+	debugprint("Options:" )
+	debugprint("       -h = this usage")
+	debugprint("       -d = debug mode")
+	debugprint("       -dd = debug mode stdout")
+	debugprint("") 
+	exit_value=1
+	exit
+    }
+    # Number of previous lines commented
+    nblc=0
+
+    # Flag to point indented declaration
+    idecl=0
+    # index of first declaration comment 
+    icdecl=0
+    # Flag to point a continuation line inside a declaration
+    icont=0
+    # Number of the first line of declaration group inside line tab
+    nicont=0
+}
+
+#==========================
+{
+  debugprint($0)
+
+  # Divers modification de la ligne pour la compatibilitÃ© Doxygen
+  if (match($0, "!+")) {
+      
+      if (match($0, "!\\?")) {
+	  debugprint("Wrong comment")
+	  sub(/\!\?/, "!")
+	  debugprint("Correct wrong comment" $0)
+      } else if (match($0, "f90doc")) {
+	  debugprint("suppression de la ligne")
+	  next
+      } else if (match($0, "@call")) {
+	  debugprint("line with @call")
+	  sub(/@call/, "@see",$0)
+	  debugprint("line after correct call :" $0)
+      } else if (match($0, "@Version")) {
+          debugprint("line with @Version")
+          sub(/@Version/, "@version")
+          debugprint("line after Doxygen @version :" $0)
+      } else if (match($0, "@tex")) {
+	  match($0,"@tex([^@]+)@endtex",math)
+          debugprint("line with formula :" math[1])
+	  $0 = substr($0,1,match($0,"@tex")-1) "@htmlonly" math[1] "@endhtmlonly @latexonly" math[1] "@endlatexonly" substr($0,match($0,"@endtex")+7)
+      }
+
+      # traitement des simples cotes
+      if (match($0, "'") && ! match($0, "'.*'") ) {
+          debugprint("line with single cote")
+          sub(/'/, "''",$0)
+          debugprint("line without single cote : " $0)
+      }
+  }
+
+  if (match($0, "!+")) {
+      debugprint("line with comment")
+      
+      if ( idecl == 1 ) {
+	  debugprint("inside a decl " (match($0,"^[[:space:]]+!")) " " match($0,"!") " " icdecl ".")
+	  if ( (match($0,"^[[:space:]]+!")) && (match($0,"!") == icdecl) ) { 	
+	      line[nblc]=line[nblc-1]
+	      sub(/^[[:space:]]+\!+>*/," !>")
+	      # on Ã©crit le nouveau commentaire avant le prÃ©cÃ©dant
+	      line[nblc-1]=$0 "\\n"
+	      nblc++
+	      debugprint("continuation of declaration")
+	      next
+	  } else if ( icont == 1 ) {
+	      if (match($0,"!")) { 
+		  debugprint("continuation of declaration with &" nicont) 
+		  for ( i=nblc; i > nicont; i-- ) {
+		      line[i]=line[i-1]
+		  }
+		  nblc++
+
+		  line[nblc]=substr($0,1,icdecl-1)
+		  nblc++
+
+		  line[nicont+1]=line[nicont]
+
+		  line[nicont]=substr($0,icdecl)
+		  sub(/^\!+>*/," !>",line[nicont])
+		  line[nicont]=line[nicont] "\\n"
+		  for ( i=nicont-1; i < nblc; i++ ) {
+		      debugprint(":" i line[i])
+		  }
+	      } else {
+		  line[nblc]=$0
+		  nblc++
+		  debugprint("no comment in continuation of declaration with &") 
+	      }
+	      
+	      if ( match(line[nblc-1], "&") ) {
+		  if ( match(line[nblc-1], "&.*&") ) {
+		      icont = 1
+		      nicont=nicont+1
+		      debugprint("next line with &") 
+		  } else if ( match(line[nblc-1], "^[[:space:]]*&") ) {
+		      icont = 0
+		      nicont = 0
+		      debugprint("next line without &") 
+		  } else {
+		      icont = 1
+		      nicont=nicont+1
+		      debugprint("next line with &") 
+		  }
+	      } else {
+		  icont = 0
+		  nicont = 0
+		  debugprint(match(line[nblc-1], "^[[:space:]]+&*[^!]+&") match(line[nblc-1], "^[[:space:]]+[^!]+&[[:space:]]*!*"))
+	      }
+	      next
+	  } else {
+	      idecl=0
+	      icont = 0
+	      nicont = 0
+	      flush_line()
+	  }
+      }
+
+      iblc=nblc
+      line[nblc]=$0
+      nblc++
+
+      # commentary after a parameter documentation : need flush previous lines without Doxygen doc
+      if (match(line[iblc], "^[^!]+intent *\\(.*\\).*::")) {
+	  idecl=1
+	  icdecl=match($0,"!")
+	  if ( match(line[iblc], "[^!]*::[^!]*&") ) {
+	      icont = 1
+	      nicont=nblc
+	      debugprint("next line with &") 
+	  }
+	  code_intent(iblc)
+
+      } else if (match(line[iblc], "^[^!]+INTENT *\\(.*\\).*::")) {
+	  idecl=1
+	  icdecl=match($0,"!")
+	  if ( match(line[iblc], "[^!]*::[^!]*&") ) {
+	      icont = 1
+	      nicont=nblc
+	      debugprint("next line with &") 
+	  }
+	  code_INTENT_(iblc)
+
+      } else if (match(line[iblc], "^[^!]+::")) {
+	  debugprint("line with declaration")
+
+	  idecl=1
+	  icdecl=match($0,"!")
+	  if ( match(line[iblc], "[^!]*::[^!]*&") ) {
+	      icont = 1
+	      nicont=nblc
+	      debugprint("next line with &") 
+	  }
+
+	  sub(/.*\!+>*/, " !>",line[iblc])
+	  debugprint("line after Doxygen declaration :" line[iblc])
+
+	  sub(/\!.*/, "")
+	  debugprint("Only code declaration :" $0)
+	  line[nblc]=$0
+	  nblc++
+
+      }
+      next
+  } else if (match($0, "^[^!]*subroutine.*\\(.*") || match($0, "^[^!]*SUBROUTINE.*\\(.*") || 
+	     ( match($0, "^[^!]*subroutine ") && ! (match($0, "^[[:space:]]+end ")) ) || 
+	     ( match($0, "^[^!]*SUBROUTINE ") && ! (match($0, "^[[:space:]]+END ")) ) || 
+	     match($0, "^[^!]*function.*\\(.*") || match($0, "^[^!]*FUNCTION.*\\(.*") || 
+	     match($0, "^[^!]*module *") || match($0, "^[^!]*MODULE *") || 
+	     match($0, "^[^!]*interface *") || match($0, "^[^!]*INTERFACE *") ||
+	     match($0, "^[^!]+::")) {
+
+      debugprint("f90 declaration")
+
+      if ( idecl == 1 ) {
+	  idecl=0
+	  icont=0
+	  flush_line()
+      } 
+      if (nblc > 0 && ( match($0, "^[^!]+intent *\\(.*\\).*::") ||
+			match($0, "^[^!]+INTENT *\\(.*\\).*::") )) {
+	  if (match($0, "\\(in\\)") || match($0, "\\(IN\\)")) {
+	      sub(/.*\!+>*\-*/, " !> [in]",line[iblc])
+	  } else if (match($0, "\\(out\\)") || match($0, "\\(OUT\\)")) {
+	      sub(/.*\!+>*\-*/, " !> [out]",line[iblc])
+	  } else if (match($0, "\\(inout\\)") || match($0, "\\(INOUT\\)")) {
+	      sub(/.*\!+>*\-*/, " !> [in,out]",line[iblc])
+	  } else {	
+	      print "unknown INTENT error : " $0
+	      debugprint("unknown INTENT error : " $0)
+	      exit 1
+	  }
+      } else {
+
+	  for ( i=0; i < nblc; i++ ) {
+	      #  : ajout des commentaires Doxygen
+	      if (match(line[i], "!<")) {
+		  sub(/\^ *\!+</, " !>",line[i])
+	      } else {
+		  sub(/^ *\!\!/, " !>",line[i])
+	      }
+
+	      debugprint("traitement des lignes prÃ©cÃ©dentes : " line[i])
+	  }
+      }
+      flush_line()
+      myprint($0)
+      next
+  } else {
+      debugprint("normal line")
+
+      if ( idecl == 1 ) idecl=0
+
+      flush_line()
+      myprint($0)
+  }
+}
+
+END {
+    if ( ! ldebug ) close(output_file)
+}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/TOOLS/codeinc.awk
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/TOOLS/codeinc.awk	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/TOOLS/codeinc.awk	(revision 6412)
@@ -0,0 +1,121 @@
+# codeinc.awk - filter of ORCHIDEE f90 files
+# command : gawk -f codeinc.awk [-d] file.f90
+# create a file.f90_preproc_codeinc filtered
+
+#**************************************************************
+# Author: Martial.Mancip
+# Contact: Martial.Mancip__at__ipsl.jussieu.fr
+# $Revision::                                          $ Revision of last commit
+# $Author::                                            $ Author of last commit
+# $Date:: 
+# IPSL (2006)
+#  This software is governed by the CeCILL licence see libIGCM/libIGCM_CeCILL.LIC
+# Modification: 
+#
+#**************************************************************
+#==========================
+function debugprint(str) {
+  if (debug) {
+     print str  | "cat 1>&2"
+  }
+}
+function myprint(str) {
+    print str >> output_file
+}
+
+
+#==========================
+BEGIN {
+    debugprint("traitement de " ARGV[1])
+
+    nbarg=ARGC
+    if (ARGV[1] == "-d") {
+	debug=1
+	file=ARGV[2]
+	delete ARGV[1] 
+	nbarg--
+    } else {
+	debug=0
+	file=ARGV[1]
+    }
+    output_file=file "_preproc_codeinc"
+    if (debug) {
+	lscommand=("ls " output_file)
+	outsys=system(lscommand)
+	debugprint("output of ls : " outsys)
+	if ( outsys == 0 ) {
+	    debugprint("Already find " output_file)
+	    outsys=system("rm " output_file)
+	    debugprint("output of rm : " outsys)
+	    system("touch " output_file)
+	}
+    }
+
+# When exit statement, 'END' rule is always executed, so defined a exit_value to manage this
+    exit_value=0
+    if (nbarg != 2) {
+	debugprint("Usage: codeinc.awk [-d] file.f90")
+	debugprint("")
+	debugprint("Args:")
+	debugprint("      file.f90 = source code to be parsed")
+	debugprint("") 
+	debugprint("Options:" )
+	debugprint("       -d = debug mode")
+	debugprint("") 
+	exit_value=1
+	exit
+    }
+    codeinc=0
+    linecodeinc[1]=""
+    line[1]=""
+}
+
+#==========================
+{
+  debugprint($0)
+
+# Get information with MPI Program Information output on NEC
+  if (match($0, " *!> @codeinc *")) 
+  {
+      codeinc=1
+      nblines=0
+      Length=(match($0,"!>")-1)
+      spaces=substr($0,1,Length)
+      debugprint("Find @codeinc !" spaces Length)
+      myprint(spaces "!> @code")
+      next
+  } 
+  else if ( codeinc == 1 )
+  {
+      if (match($0, " *!> @endcodeinc *")) 
+      {
+	  codeinc=0
+	  debugprint("Find @endcodeinc !")
+	  for (i=0; i<nblines; i++) {  
+	      myprint(spaces "!> " linecodeinc[i])
+	  }
+ 	  myprint(spaces "!> @endcode")
+	  for (i=0; i<nblines; i++) {  
+	      myprint(line[i])
+	  }
+	  nblines=0
+      }
+      else
+      {
+	  line[nblines]=$0
+	  debugprint(nblines " | " line[nblines])
+	  linecodeinc[nblines]=substr(line[nblines],Length+1)
+	  debugprint(linecodeinc[nblines])
+	  nblines++
+      }
+  }
+  else
+  {
+      myprint($0)
+  }
+
+}
+
+END {
+    close(output_file)
+}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/footer.tex
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/footer.tex	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/footer.tex	(revision 6412)
@@ -0,0 +1,72 @@
+
+% \addcontentsline{toc}{chapter}{ANNEXE B : Table des notations} 
+% \markboth{\uppercase{\ Title Notations}}
+% {\uppercase{\ Notations}} \thispagestyle{empty} \input{./notation} %
+% \thispagestyle{empty} \newpage \thispagestyle{empty} \null \newpage \newpage 
+% {\pagestyle{empty}\cleardoublepage}
+
+\part{Annexes}
+
+\chapter{Index}
+\label{chap:index}
+
+\printindex
+
+\newpage
+\clearemptydoublepage
+
+\bibliographystyle{alpha}
+\bibliography{orchidee}
+\setcounter{chapter}{17}
+\addcontentsline{toc}{chapter}{Bibliography}
+\label{chap:biblio}
+
+\clearemptydoublepage
+
+This scientific documentation is the result of a huge effort led by the ORCHIDEE community,
+which reached a peak at the now famous ORCHIDEE summit, held at Saint-Lambert-Des-Bois (France), on 
+January, 19-20, 2012.
+
+Citation: To Be Defined
+
+List of Contributors:
+\begin{itemize}
+\item Bellassen Valentin, CDC Climat
+\item Cadule Patricia, IPSL
+\item Campoy AurÃ©lien, Sisyphe/UPMC
+\item Ciais Philippe, LSCE/IPSL
+\item de Noblet Nathalie, LSCE/IPSL
+\item de Weirdt Marjolein, UGent
+\item Ducharne AgnÃšs, Sisyphe/UPMC
+\item Gouttevin Isabelle, LGGE
+\item Guenet Betrand, LSCE/IPSL
+\item Guimberteau Mathieu, LOCEAN/IPSL
+\item Kato Tomomichi, LSCE/IPSL
+\item Koffi Ernest, LSCE/IPSL
+\item Kuppel Sylvain, LSCE/IPSL
+\item LathiÃšre Juliette, LSCE/IPSL
+\item Launois Thomas, LSCE/IPSL
+\item Luyssaert Sebastiaan, LSCE/IPSL
+\item MacBean Natasha, LSCE/IPSL
+\item Maignan Fabienne, LSCE/IPSL
+\item Mancip Martial, IPSL
+\item OttlÃ© Catherine, LSCE/IPSL
+\item Otto Juliane, LSCE/IPSL
+\item Peylin Philippe, LSCE/IPSL
+\item Polcher Jan, LMD/IPSL
+\item Poulter Benjamin, LSCE/IPSL
+\item Ryder James, LSCE/IPSL
+\item Saito Makoto, LSCE/IPSL
+\item Solyga Didier, LSCE/IPSL
+\item Tan Kun, LSCE/IPSL
+\item Valade Aude, LSCE/IPSL
+\item Verbecke Thomas, LSCE/IPSL
+\item Viovy Nicolas, LSCE/IPSL
+\item Vuichard Nicolas, LSCE/IPSL
+\item Wang Tao, LSCE/IPSL
+\item Yue Chao, LSCE/IPSL
+\end{itemize}
+
+
+
+\end{document}
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/header.tex.init
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/header.tex.init	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/DOC/header.tex.init	(revision 6412)
@@ -0,0 +1,252 @@
+\batchmode
+\documentclass[a4paper]{book}
+\usepackage{a4wide}
+\usepackage{makeidx}
+\usepackage[pdftex]{graphicx}
+\newcommand\textsubscript[1]{\ensuremath{{}_{\text{#1}}}}
+\usepackage{multicol}
+\usepackage{float}
+\usepackage{listings}
+\usepackage{color}
+\usepackage{ifthen}
+\usepackage[table]{xcolor}
+\usepackage{textcomp}
+\usepackage{alltt}
+\usepackage{times}
+\usepackage{ifpdf}
+\usepackage{hyperref}
+\hypersetup{pdftex,
+            pagebackref=true,
+            colorlinks=true,
+            linkcolor=blue,
+            citecolor=blue, 
+            filecolor=blue,
+            urlcolor=blue,
+            unicode,
+            pdftitle=ORCHIDEE Documentation,
+            pdfauthor=IPSL,
+            pdfsubject=Documentation,
+            pdfkeywords=ORCHIDEE Documentation Scientific Development}
+% Text styles
+\newcommand\textstyleInternetlink[1]{\textcolor[rgb]{0.0,0.0,0.5019608}{#1}}
+\newcommand\textstyleCitationHTML[1]{\textit{#1}}
+\makeatletter
+\newcommand\arraybslash{\let\\\@arraycr}
+\makeatother
+
+\usepackage[utf8]{inputenc}
+\usepackage[T1]{fontenc}
+\usepackage[english]{babel}
+%\usepackage[french]{babel}
+
+\usepackage{pifont}
+\usepackage{eurosym}
+\usepackage{amsmath}
+\usepackage{wasysym}
+\usepackage{amssymb,amsfonts,textcomp}
+\usepackage[top=2.54cm,bottom=2.54cm,left=3.175cm,right=3.175cm]{geometry}
+
+\usepackage{array}
+\usepackage{supertabular}
+\usepackage{hhline}
+% \newcommand\arraybslash{\let\\\@arraycr}
+\makeatother
+% Footnote rule
+\setlength{\skip\footins}{0.119cm}
+\renewcommand\footnoterule{\vspace*{-0.018cm}\setlength\leftskip{0pt}\setlength\rightskip{0pt plus 1fil}\noindent\textcolor{black}{\rule{0.25\columnwidth}{0.018cm}}\vspace*{0.101cm}}
+% Pages styles
+\makeatletter
+\newcommand\ps@Standard{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{}
+  \renewcommand\thepage{\arabic{page}}
+}
+\makeatother
+\pagestyle{Standard}
+\setlength\tabcolsep{1mm}
+\renewcommand\arraystretch{1.3}
+
+% Pages styles
+\makeatletter
+\newcommand\ps@Conversionvi{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionv{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversioniv{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+% \newcommand\ps@Standard{
+%   \renewcommand\@oddhead{}
+%   \renewcommand\@evenhead{}
+%   \renewcommand\@oddfoot{}
+%   \renewcommand\@evenfoot{}
+%   \renewcommand\thepage{\arabic{page}}
+% }
+\newcommand\ps@Conversioniii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\roman{page}}
+}
+\newcommand\ps@Conversionii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversioni{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\roman{page}}
+}
+\newcommand\ps@Conversionxv{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionxiv{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionxiii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionxii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionxi{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionx{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionix{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionviii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionvii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+
+\usepackage{doxygen}
+\lstset{language=C++,inputencoding=utf8,basicstyle=\footnotesize,breaklines=true,breakatwhitespace=true,tabsize=8,numbers=left }
+\usepackage{indentfirst}
+\makeindex
+\setcounter{tocdepth}{3}
+\renewcommand{\footrulewidth}{0.4pt}
+\hfuzz=15pt
+\setlength{\emergencystretch}{15pt}
+\hbadness=750
+\tolerance=750
+
+\usepackage{minitoc}
+\setcounter{minitocdepth}{5}
+%\renewcommand{\mtctitle}{\em Plan du chapitre}
+
+\renewcommand{\chaptermark}[1]{\markboth{#1}{}}
+\renewcommand{\sectionmark}[1]{\markright{\thesection \ #1}}
+
+% Les headers (tÃªtes de page)
+% \usepackage{fancyhdr}
+% \pagestyle{fancy}
+% \fancyhf{}
+% \fancyhead[LE,RO]{\bfseries\thepage}
+% \fancyhead[LO]{\bfseries\rightmark}
+% \fancyhead[RE]{\bfseries\leftmark}
+% \fancypagestyle{plain}
+% \fancyhead{}
+\renewcommand{\headrulewidth}{1pt}
+ 
+
+\begin{document}
+\hypersetup{pageanchor=false,citecolor=blue}
+\begin{titlepage}
+\vspace*{7cm}
+\begin{center}
+\leavevmode
+\includegraphics[scale=1]{logo_orchidee.png}
+{ \\[1ex]\large MYTAG revision MYREV}\\
+\vspace*{0.5cm}
+{\Large IPSL (Pierre Simon Laplace Institute)}\\
+\vspace*{1cm}
+{\-ORCHIDEE is the land-surface scheme of the IPSL.\\
+This scheme is the result of the coupling of the SECHIBA land-surface
+scheme, \\
+which is dedicated to the surface energy and water balances, \\
+and the carbon and vegetation model STOMATE.}\\
+\vspace*{0.5cm}
+{\Large \today}
+\end{center}
+\end{titlepage}
+
+\dominitoc
+
+\part{Table Of Contents}
+\clearemptydoublepage
+\pagenumbering{roman}
+\tableofcontents
+%\clearemptydoublepage
+
+\pagenumbering{arabic}
+\hypersetup{pageanchor=true,citecolor=blue}
+
+\part{Documentation}
+\label{part:doc}
+
+
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/Doxyfile_ORCHIDEE.init
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/Doxyfile_ORCHIDEE.init	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/Doxyfile_ORCHIDEE.init	(revision 6412)
@@ -0,0 +1,288 @@
+# Doxyfile 1.7.3
+
+#---------------------------------------------------------------------------
+# Project related configuration options
+#---------------------------------------------------------------------------
+DOXYFILE_ENCODING      = UTF-8
+PROJECT_NAME           = ORCHIDEE
+PROJECT_NUMBER         = "MYTAG rev MYREV"
+PROJECT_BRIEF          = "The land-surface scheme of IPSL."
+PROJECT_LOGO           = MYPATH/ORCHIDEE/DOC/logo_orchidee.png
+OUTPUT_DIRECTORY       = MYPATH/ORCHIDEE/docs
+CREATE_SUBDIRS         = YES
+OUTPUT_LANGUAGE        = English
+BRIEF_MEMBER_DESC      = YES
+REPEAT_BRIEF           = YES
+ABBREVIATE_BRIEF       =
+ALWAYS_DETAILED_SEC    = YES
+INLINE_INHERITED_MEMB  = YES
+FULL_PATH_NAMES        = YES
+STRIP_FROM_PATH        = MYPATH/modeles_doc
+STRIP_FROM_INC_PATH    = MYPATH/ORCHIDEE/DOC
+SHORT_NAMES            = NO
+JAVADOC_AUTOBRIEF      = NO
+QT_AUTOBRIEF           = NO
+MULTILINE_CPP_IS_BRIEF = NO
+INHERIT_DOCS           = YES
+SEPARATE_MEMBER_PAGES  = YES
+TAB_SIZE               = 12
+ALIASES                = 
+OPTIMIZE_OUTPUT_FOR_C  = NO
+OPTIMIZE_OUTPUT_JAVA   = NO
+OPTIMIZE_FOR_FORTRAN   = YES
+OPTIMIZE_OUTPUT_VHDL   = NO
+EXTENSION_MAPPING      =
+BUILTIN_STL_SUPPORT    = NO
+CPP_CLI_SUPPORT        = NO
+SIP_SUPPORT            = NO
+IDL_PROPERTY_SUPPORT   = NO
+DISTRIBUTE_GROUP_DOC   = YES
+SUBGROUPING            = YES
+TYPEDEF_HIDES_STRUCT   = YES
+SYMBOL_CACHE_SIZE      = 9
+#---------------------------------------------------------------------------
+# Build related configuration options
+#---------------------------------------------------------------------------
+EXTRACT_ALL            = YES
+EXTRACT_PRIVATE        = YES
+EXTRACT_STATIC         = YES
+EXTRACT_LOCAL_CLASSES  = YES
+EXTRACT_LOCAL_METHODS  = YES
+EXTRACT_ANON_NSPACES   = YES
+HIDE_UNDOC_MEMBERS     = NO
+HIDE_UNDOC_CLASSES     = NO
+HIDE_FRIEND_COMPOUNDS  = NO
+HIDE_IN_BODY_DOCS      = NO
+INTERNAL_DOCS          = YES
+CASE_SENSE_NAMES       = NO
+HIDE_SCOPE_NAMES       = YES
+SHOW_INCLUDE_FILES     = YES
+FORCE_LOCAL_INCLUDES   = YES
+INLINE_INFO            = YES
+SORT_MEMBER_DOCS       = YES
+SORT_BRIEF_DOCS        = NO
+SORT_MEMBERS_CTORS_1ST = NO
+SORT_GROUP_NAMES       = NO
+SORT_BY_SCOPE_NAME     = NO
+STRICT_PROTO_MATCHING  = NO
+GENERATE_TODOLIST      = YES
+GENERATE_TESTLIST      = YES
+GENERATE_BUGLIST       = YES
+GENERATE_DEPRECATEDLIST= YES
+ENABLED_SECTIONS       = 
+MAX_INITIALIZER_LINES  = 30
+SHOW_USED_FILES        = YES
+SHOW_DIRECTORIES       = YES
+SHOW_FILES             = YES
+SHOW_NAMESPACES        = YES
+FILE_VERSION_FILTER    = 
+LAYOUT_FILE            =
+#---------------------------------------------------------------------------
+# configuration options related to warning and progress messages
+#---------------------------------------------------------------------------
+QUIET                  = NO
+WARNINGS               = YES
+WARN_IF_UNDOCUMENTED   = YES
+WARN_IF_DOC_ERROR      = YES
+WARN_NO_PARAMDOC       = YES
+WARN_FORMAT            = "$file:$line: $text"
+WARN_LOGFILE           = doxygen.log
+#---------------------------------------------------------------------------
+# configuration options related to the input files
+#---------------------------------------------------------------------------
+INPUT                  = SRCPATH/ORCHIDEE \
+                         SRCPATH/ORCHIDEE_OL
+# \
+#                         SRCPATH/IOIPSL/src/
+INPUT_ENCODING         = UTF-8
+FILE_PATTERNS          = *.f90 \
+                         *.F90 \
+                         *.h
+RECURSIVE              = YES
+EXCLUDE                = 
+EXCLUDE_SYMLINKS       = YES
+EXCLUDE_PATTERNS       = 
+EXCLUDE_SYMBOLS        = 
+EXAMPLE_PATH           = MYPATH/ORCHIDEE/DOC
+EXAMPLE_PATTERNS       = *
+EXAMPLE_RECURSIVE      = NO
+IMAGE_PATH             = MYPATH/ORCHIDEE/DOC
+INPUT_FILTER           = 
+FILTER_PATTERNS        = 
+FILTER_SOURCE_FILES    = NO
+FILTER_SOURCE_PATTERNS =
+#---------------------------------------------------------------------------
+# configuration options related to source browsing
+#---------------------------------------------------------------------------
+SOURCE_BROWSER         = YES
+INLINE_SOURCES         = YES
+STRIP_CODE_COMMENTS    = NO
+REFERENCED_BY_RELATION = YES
+REFERENCES_RELATION    = YES
+REFERENCES_LINK_SOURCE = YES
+USE_HTAGS              = NO
+VERBATIM_HEADERS       = YES
+#---------------------------------------------------------------------------
+# configuration options related to the alphabetical class index
+#---------------------------------------------------------------------------
+ALPHABETICAL_INDEX     = YES
+COLS_IN_ALPHA_INDEX    = 5
+IGNORE_PREFIX          = 
+#---------------------------------------------------------------------------
+# configuration options related to the HTML output
+#---------------------------------------------------------------------------
+GENERATE_HTML          = YES
+HTML_OUTPUT            = html
+HTML_FILE_EXTENSION    = .html
+HTML_HEADER            = 
+# MYPATH/ORCHIDEE/DOC/header.html
+HTML_FOOTER            = 
+# MYPATH/ORCHIDEE/DOC/footer.html
+HTML_STYLESHEET        = 
+HTML_EXTRA_FILES       =
+HTML_COLORSTYLE_HUE    = 220
+HTML_COLORSTYLE_SAT    = 100
+HTML_COLORSTYLE_GAMMA  = 80
+HTML_TIMESTAMP         = YES
+HTML_ALIGN_MEMBERS     = YES
+HTML_DYNAMIC_SECTIONS  = YES
+GENERATE_DOCSET        = YES
+DOCSET_FEEDNAME        = "IPSL model"
+DOCSET_BUNDLE_ID       = fr.orchidee.ipsl.jussieu
+DOCSET_PUBLISHER_ID    = org.doxygen.Publisher
+DOCSET_PUBLISHER_NAME  = Publisher
+GENERATE_HTMLHELP      = NO
+CHM_FILE               = 
+HHC_LOCATION           = 
+GENERATE_CHI           = NO
+CHM_INDEX_ENCODING     =
+BINARY_TOC             = YES
+TOC_EXPAND             = YES
+GENERATE_QHP           = YES
+QCH_FILE               =
+QHP_NAMESPACE          = fr.orchidee.ipsl.jussieu
+QHP_VIRTUAL_FOLDER     = docs
+QHP_CUST_FILTER_NAME   =
+QHP_CUST_FILTER_ATTRS  =
+QHP_SECT_FILTER_ATTRS  =
+QHG_LOCATION           =
+GENERATE_ECLIPSEHELP   = YES
+ECLIPSE_DOC_ID         = org.doxygen.Project
+DISABLE_INDEX          = NO
+ENUM_VALUES_PER_LINE   = 4
+GENERATE_TREEVIEW      = YES
+USE_INLINE_TREES       = YES
+TREEVIEW_WIDTH         = 250
+EXT_LINKS_IN_WINDOW    = YES
+FORMULA_FONTSIZE       = 10
+FORMULA_TRANSPARENT    = YES
+USE_MATHJAX            = YES
+MATHJAX_RELPATH        = http://www.mathjax.org/mathjax
+SEARCHENGINE           = YES
+SERVER_BASED_SEARCH    = NO
+#---------------------------------------------------------------------------
+# configuration options related to the LaTeX output
+#---------------------------------------------------------------------------
+GENERATE_LATEX         = YES
+LATEX_OUTPUT           = latex
+LATEX_CMD_NAME         = latex
+MAKEINDEX_CMD_NAME     = makeindex
+COMPACT_LATEX          = NO
+EXTRA_PACKAGES         = 
+LATEX_HEADER           = MYPATH/ORCHIDEE/DOC/header.tex
+LATEX_FOOTER           = MYPATH/ORCHIDEE/DOC/footer.tex
+PDF_HYPERLINKS         = YES
+LATEX_HIDE_INDICES     = NO
+LATEX_SOURCE_CODE      = NO 
+#---------------------------------------------------------------------------
+# configuration options related to the RTF output
+#---------------------------------------------------------------------------
+GENERATE_RTF           = NO
+RTF_OUTPUT             = rtf
+COMPACT_RTF            = NO
+RTF_HYPERLINKS         = NO
+RTF_STYLESHEET_FILE    = 
+RTF_EXTENSIONS_FILE    = 
+#---------------------------------------------------------------------------
+# configuration options related to the man page output
+#---------------------------------------------------------------------------
+GENERATE_MAN           = NO
+MAN_OUTPUT             = man
+MAN_EXTENSION          = .3
+MAN_LINKS              = NO
+#---------------------------------------------------------------------------
+# configuration options related to the XML output
+#---------------------------------------------------------------------------
+GENERATE_XML           = NO
+XML_OUTPUT             = xml
+XML_SCHEMA             = 
+XML_DTD                = 
+XML_PROGRAMLISTING     = YES
+#---------------------------------------------------------------------------
+# configuration options for the AutoGen Definitions output
+#---------------------------------------------------------------------------
+GENERATE_AUTOGEN_DEF   = NO
+#---------------------------------------------------------------------------
+# configuration options related to the Perl module output
+#---------------------------------------------------------------------------
+GENERATE_PERLMOD       = NO
+PERLMOD_LATEX          = NO
+PERLMOD_PRETTY         = YES
+PERLMOD_MAKEVAR_PREFIX = 
+#---------------------------------------------------------------------------
+# Configuration options related to the preprocessor   
+#---------------------------------------------------------------------------
+ENABLE_PREPROCESSING   = YES
+MACRO_EXPANSION        = NO
+EXPAND_ONLY_PREDEF     = NO
+SEARCH_INCLUDES        = YES
+INCLUDE_PATH           = 
+INCLUDE_FILE_PATTERNS  = 
+PREDEFINED             = 
+EXPAND_AS_DEFINED      = 
+SKIP_FUNCTION_MACROS   = YES
+#---------------------------------------------------------------------------
+# Configuration::additions related to external references   
+#---------------------------------------------------------------------------
+TAGFILES               = 
+GENERATE_TAGFILE       = ORCHIDEE_tags
+ALLEXTERNALS           = NO
+EXTERNAL_GROUPS        = NO
+PERL_PATH              = /usr/bin/perl
+#---------------------------------------------------------------------------
+# Configuration options related to the dot tool   
+#---------------------------------------------------------------------------
+CLASS_DIAGRAMS         = YES
+MSCGEN_PATH            = 
+HIDE_UNDOC_RELATIONS   = NO
+HAVE_DOT               = YES
+DOT_NUM_THREADS        = 0
+DOT_FONTNAME           = Helvetica
+DOT_FONTSIZE           = 10
+DOT_FONTPATH           =
+CLASS_GRAPH            = YES
+COLLABORATION_GRAPH    = YES
+GROUP_GRAPHS           = YES
+UML_LOOK               = YES
+TEMPLATE_RELATIONS     = YES
+INCLUDE_GRAPH          = YES
+INCLUDED_BY_GRAPH      = YES
+CALL_GRAPH             = YES
+CALLER_GRAPH           = YES
+GRAPHICAL_HIERARCHY    = YES
+DIRECTORY_GRAPH        = YES
+DOT_IMAGE_FORMAT       = png
+DOT_PATH               = 
+DOTFILE_DIRS           = MYPATH/ORCHIDEE/DOC/DOT
+MSCFILE_DIRS           =
+DOT_GRAPH_MAX_NODES    = 50
+MAX_DOT_GRAPH_DEPTH    = 1000
+DOT_TRANSPARENT        = NO
+DOT_MULTI_TARGETS      = YES
+GENERATE_LEGEND        = YES
+DOT_CLEANUP            = YES
+#---------------------------------------------------------------------------
+#- ALIAS ORCHDIEE
+#---------------------------------------------------------------------------
+ALIASES += Bold{1}="<b>\1</b>"
+ALIASES += Emph{1}="<em>\1</em>"
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/ORCHIDEE_CeCILL.LIC
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/ORCHIDEE_CeCILL.LIC	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/ORCHIDEE_CeCILL.LIC	(revision 6412)
@@ -0,0 +1,40 @@
+The following licence information concerns ONLY the ORCHIDEE MODEL
+==================================================================
+
+Copyright © Centre National de la Recherche Scientifique CNRS  
+            Commissariat à l'Énergie Atomique CEA
+
+ORCHIDEE : Organizing Carbon and Hydrology In Dynamic EcosystEms. 
+
+The purpose of this software is to simulate a number of exchanges
+occurring at the interface between the continental biosphere and the
+atmosphere, as well as the state of the biosphere (soil water and
+carbon content, living biomass, fluxes of latent, sensible heat, net
+CO2 flux, .....). It includes physical, biogeochemical and chemical
+processes at varying time scales (minutes to centuries).
+
+This software is governed by the CeCILL  license under French law and
+abiding by the rules of distribution of free software.  You can  use, 
+modify and/ or redistribute the software under the terms of the CeCILL
+license as circulated by CEA, CNRS and INRIA at the following URL
+"http://www.cecill.info". 
+
+As a counterpart to the access to the source code and  rights to copy,
+modify and redistribute granted by the license, users are provided only
+with a limited warranty  and the software's author,  the holder of the
+economic rights,  and the successive licensors  have only  limited
+liability. 
+
+In this respect, the user's attention is drawn to the risks associated
+with loading,  using,  modifying and/or developing or reproducing the
+software by the user in light of its specific status of free software,
+that may mean  that it is complicated to manipulate,  and  that  also
+therefore means  that it is reserved for developers  and  experienced
+professionals having in-depth computer knowledge. Users are therefore
+encouraged to load and test the software's suitability as regards their
+requirements in conditions enabling the security of their systems and/or 
+data to be ensured and,  more generally, to use and operate it in the 
+same conditions as regards security. 
+
+The fact that you are presently reading this means that you have had
+knowledge of the CeCILL license and that you accept its terms.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_ADA.fcm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_ADA.fcm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_ADA.fcm	(revision 6412)
@@ -0,0 +1,16 @@
+%COMPILER            mpiifort
+%LINK                mpiifort
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF              
+%BASE_FFLAGS         -integer-size 32 -real-size 64 -align all -shared-intel -mcmodel=large -fp-model precise 
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+%DEBUG_FFLAGS        -fpe0 -O0 -g -traceback -fp-stack-check -ftrapuv -check bounds -check all
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp -openmp-threadprivate compat
+%BASE_LD             -shared-intel -mcmodel=large -Wl,-rpath=/smplocal/pub/NetCDF/4.1.3/mpi/lib:/smplocal/pub/HDF5/1.8.9/par/lib 
+%MPI_LD
+%OMP_LD              -openmp
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_ADA.path
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_ADA.path	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_ADA.path	(revision 6412)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="${NETCDF_LDFLAGS:-/smplocal/pub/NetCDF/4.1.3/mpi/lib -lnetcdff -lnetcdf -lstdc++ -L/smplocal/pub/HDF5/1.8.9/par/lib -Bstatic -lhdf5_hl -lhdf5_fortran -lhdf5 -Bdynamic -lz}"
+NETCDF_INCDIR="${NETCDF_FFLAGS:-/smplocal/pub/HDF5/1.8.9/par/include -I/smplocal/pub/NetCDF/4.1.3/mpi/include}"
+IOIPSL_INCDIR=${ORCHDIR}/../../lib
+IOIPSL_LIBDIR=${ORCHDIR}/../../lib
+XIOS_INCDIR=${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="${ORCHDIR}/../XIOS/lib -lxios"
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_CURIE.fcm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_CURIE.fcm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_CURIE.fcm	(revision 6412)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINK                mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF              
+%BASE_FFLAGS         -i4 -r8 -auto -align all -fp-model precise 
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+%DEBUG_FFLAGS        -fpe0 -O0 -g -traceback -fp-stack-check -ftrapuv -check bounds -check all
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp -openmp-threadprivate compat
+%BASE_LD             -i4 -r8
+%MPI_LD
+%OMP_LD              -openmp
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_CURIE.path
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_CURIE.path	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_CURIE.path	(revision 6412)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="$NETCDF_LIBDIR -lnetcdff -lnetcdf -lstdc++"
+NETCDF_INCDIR=$NETCDF_INCDIR
+IOIPSL_INCDIR=${ORCHDIR}/../../lib
+IOIPSL_LIBDIR=${ORCHDIR}/../../lib
+XIOS_INCDIR=${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="${ORCHDIR}/../XIOS/lib -lxios"
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_IRENE.fcm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_IRENE.fcm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_IRENE.fcm	(revision 6412)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINK                mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF             CPP_FLUSH 
+%BASE_FFLAGS         -i4 -r8 -auto -align all -fp-model precise 
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+%DEBUG_FFLAGS        -fpe0 -O0 -g -traceback -fp-stack-check -ftrapuv -check bounds -check all -check noarg_temp_created
+%MPI_FFLAGS
+%OMP_FFLAGS          -qopenmp -qopenmp-threadprivate compat
+%BASE_LD             -i4 -r8
+%MPI_LD
+%OMP_LD              -qopenmp
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_IRENE.path
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_IRENE.path	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_IRENE.path	(revision 6412)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="$NETCDF_LIBDIR -lnetcdf -L$NETCDFFORTRAN_LIBDIR -lnetcdff -lstdc++"
+NETCDF_INCDIR="$NETCDF_INCDIR -I$NETCDFFORTRAN_INCDIR"
+IOIPSL_INCDIR=${ORCHDIR}/../../lib
+IOIPSL_LIBDIR=${ORCHDIR}/../../lib
+XIOS_INCDIR=${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="${ORCHDIR}/../XIOS/lib -lxios"
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_OCCIGEN.fcm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_OCCIGEN.fcm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_OCCIGEN.fcm	(revision 6412)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINK                mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF              
+%BASE_FFLAGS         -i4 -r8 -auto -align all -fp-model precise -xCORE-AVX2
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -p -g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+%DEBUG_FFLAGS        -p -g -traceback -fp-stack-check -ftrapuv -check bounds
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp -openmp-threadprivate compat
+%BASE_LD             -i4 -r8
+%MPI_LD
+%OMP_LD              -openmp
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_OCCIGEN.path
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_OCCIGEN.path	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-X64_OCCIGEN.path	(revision 6412)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="$NETCDF_LIB_DIR $NETCDFF_LIBDIR -lnetcdff -lnetcdf -lstdc++"
+NETCDF_INCDIR="$NETCDF_INC_DIR -I$NETCDFF_INCDIR"
+IOIPSL_INCDIR=${ORCHDIR}/../../lib
+IOIPSL_LIBDIR=${ORCHDIR}/../../lib
+XIOS_INCDIR=${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="${ORCHDIR}/../XIOS/lib -lxios"
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-gfortran.fcm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-gfortran.fcm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-gfortran.fcm	(revision 6412)
@@ -0,0 +1,15 @@
+%COMPILER            gfortran
+%LINK                gfortran
+%AR                  ar
+%MAKE                make
+%FPP_FLAGS           -P -C -traditional
+%FPP_DEF             
+%BASE_FFLAGS         -fdefault-real-8
+%PROD_FFLAGS         -O3 -funroll-all-loops
+%DEV_FFLAGS          -O
+%DEBUG_FFLAGS        -ffpe-trap=invalid,zero,overflow -Wall -fbounds-check -g3 -O0 -fstack-protector-all
+%MPI_FFLAGS
+%OMP_FFLAGS          
+%BASE_LD      
+%MPI_LD
+%OMP_LD              
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-gfortran.path
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-gfortran.path	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-gfortran.path	(revision 6412)
@@ -0,0 +1,4 @@
+NETCDF_LIBDIR=/usr/local/lib
+NETCDF_INCDIR=/usr/local/include
+IOIPSL_INCDIR=${ORCHDIR}/../../lib
+IOIPSL_LIBDIR=${ORCHDIR}/../../lib
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-ifort_CICLAD.fcm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-ifort_CICLAD.fcm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-ifort_CICLAD.fcm	(revision 6412)
@@ -0,0 +1,15 @@
+%COMPILER            /usr/lib64/openmpi/1.4.5-ifort/bin/mpif90 
+%LINK                /usr/lib64/openmpi/1.4.5-ifort/bin/mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF              
+%BASE_FFLAGS         -i4 -r8 -fp-model precise  
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+%DEBUG_FFLAGS        -fpe0 -O0 -g -traceback -fp-stack-check -ftrapuv -check bounds -check all
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp -openmp-threadprivate compat
+%BASE_LD             -i4 -r8
+%MPI_LD
+%OMP_LD              -openmp
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-ifort_CICLAD.path
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-ifort_CICLAD.path	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-ifort_CICLAD.path	(revision 6412)
@@ -0,0 +1,6 @@
+NETCDF_LIBDIR="/opt/netcdf42/ifort/lib -lnetcdf -lnetcdff -lstdc++"
+NETCDF_INCDIR=/opt/netcdf42/ifort/include
+IOIPSL_INCDIR=../../../lib
+IOIPSL_LIBDIR=../../../lib
+XIOS_INCDIR=${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="${ORCHDIR}/../XIOS/lib -lxios"
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-ifort_LSCE.fcm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-ifort_LSCE.fcm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-ifort_LSCE.fcm	(revision 6412)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINK                mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF              
+%BASE_FFLAGS         -i4 -r8 -fp-model precise  
+%PROD_FFLAGS         -O3 -p -g
+%DEV_FFLAGS          -g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+%DEBUG_FFLAGS        -fpe0 -O0 -g -traceback -fp-stack-check -ftrapuv -check bounds -check all
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp -openmp-threadprivate compat
+%BASE_LD             -i4 -r8
+%MPI_LD
+%OMP_LD              -openmp
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-ifort_LSCE.path
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-ifort_LSCE.path	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/arch/arch-ifort_LSCE.path	(revision 6412)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="/usr/local/install/netcdf-4.3.2p/lib -lnetcdff -lnetcdf -L/usr/local/install/hdf5-1.8.9p/lib -lhdf5_hl -lhdf5 -lhdf5 -lz -lcurl -lstdc++"
+NETCDF_INCDIR=/usr/local/install/netcdf-4.3.2p/include
+IOIPSL_INCDIR=${ORCHDIR}/../../lib
+IOIPSL_LIBDIR=${ORCHDIR}/../../lib
+XIOS_INCDIR=${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="${ORCHDIR}/../XIOS/lib -lxios"
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/bld.cfg
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/bld.cfg	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/bld.cfg	(revision 6412)
@@ -0,0 +1,85 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+
+inc arch.fcm
+inc config.fcm
+
+%ROOT_PATH         $PWD
+%CONFIG_PATH       %ROOT_PATH/.config
+%SRC_PATH          %ROOT_PATH
+
+
+src::global       %SRC_PATH/src_global
+src::parallel     %SRC_PATH/src_parallel
+src::sechiba      %SRC_PATH/src_sechiba
+src::stomate      %SRC_PATH/src_stomate
+src::parameters   %SRC_PATH/src_parameters
+src::orchidee_ol  %SRC_PATH/src_driver
+src::orchoasis    %SRC_PATH/src_oasisdriver
+src::ext_src      %EXT_SRC
+
+bld::lib::global         orglob
+bld::lib::parallel       parallel
+bld::lib::sechiba        sechiba
+bld::lib::stomate        stomate
+bld::lib::parameters     parameters
+bld::lib::orchidee_ol    orchidee_ol
+bld::lib::orchoasis    	 orchoasis
+bld::lib                 orchidee
+
+bld::target              liborglob.a libparallel.a libsechiba.a libstomate.a libparameters.a liborchidee.a liborchoasis.a
+bld::target              %EXEC
+bld::exe_dep             ext_src global parallel sechiba stomate parameters orchidee_ol orchoasis
+
+dir::root            %CONFIG_PATH
+dir::lib             %ROOT_PATH/lib
+dir::bin             %ROOT_PATH/bin
+dir::inc             %ROOT_PATH/lib
+dir::tmp             %ROOT_PATH/tmp_src
+
+#search_src           1
+
+bld::tool::fc        %COMPILER 
+bld::tool::ld        %LINK
+bld::tool::ar        %AR
+bld::tool::make      %MAKE
+bld::tool::fflags    %FFLAGS %INCDIR
+bld::tool::ldflags   %LD_FFLAGS %LIBDIR -lioipsl -lnetcdf   
+
+bld::tool::cppflags  %FPP_FLAGS %INCDIR
+bld::tool::fppflags  %FPP_FLAGS %INCDIR
+bld::tool::fppkeys   %CPP_KEY
+
+
+# Pre-process code before analysing dependencies
+bld::pp              1
+infile_ext::f90 fpp::fpp9x::source
+
+# Ignore the following dependencies
+bld::excl_dep        inc::netcdf.inc
+bld::excl_dep        use::netcdf
+bld::excl_dep        h::netcdf.inc
+bld::excl_dep        h::mpif.h
+bld::excl_dep        inc::mpif.h
+bld::excl_dep        use::ioipsl
+bld::excl_dep        USE::defprec
+bld::excl_dep        USE::calendar
+bld::excl_dep        USE::xios
+bld::excl_dep        USE::mod_oasis
+
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".inc" as an extension for CPP include files
+bld::infile_ext::inc  CPP::INCLUDE
+
+# extension for module output
+bld::outfile_ext::mod .mod
+bld::tool::SHELL   /bin/bash
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/makeorchidee_fcm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/makeorchidee_fcm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/makeorchidee_fcm	(revision 6412)
@@ -0,0 +1,512 @@
+#!/bin/bash
+
+#==============================================================================================================================\n
+#  MODULE 	: makeorchidee_fcm
+# 
+#  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+#
+#  LICENCE      : IPSL (2006)
+#  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+#
+# SVN     :
+# $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/trunk/ORCHIDEE/makeorchidee_fcm $ 
+# $Date: $
+# $Revision: $
+# \n
+####################################################################################################
+#
+# This script has several possible functions :
+#   1. Compiling ORCHIDEE
+#   2. Building of the documentation
+#
+#***************************************************************************************************
+#
+# Command lines :
+#
+#   1) makeorchidee_fcm   [ -parallel  PARALLEL_TYPE ]
+#                         [ -driver ]
+#                         [ -arch XXX ]
+#                         [ -prod | -dev | -debug ]
+#
+#   2) makeorchidee_fcm   [ -clean ]
+#
+#   3) makeorchidee_fcm   [ -doc | -doc_para ] ## actually doc_para is commented
+#                         [ -rmdoc ]
+#                         [ -doc_tree ]
+#
+
+########################################################################
+#
+# 1) Set default values. Some of them can be specified using environnement variables.
+#
+
+is_driver_opt=FALSE
+is_other_opt=FALSE
+clean=FALSE
+compile_flags="%PROD_FFLAGS"
+xios=FALSE
+full=""
+ext_src=""
+export P_P=""
+export SECTIONS_PARA=""
+ORCHDIR=`/bin/pwd`
+fcm_path=$ORCHDIR/tools/FCM_V1.2/bin
+compile_doc=FALSE
+
+# Following variables can be set as environement variables if wanted
+if [ -n "$FCM_ARCH" ]; then
+    arch="$FCM_ARCH"
+else
+    arch=NONE
+fi
+if [ -n "$FCM_PARA" ]; then
+    parallel_mode="$FCM_PARA"
+else
+    parallel_mode=seq
+fi
+if [ -n "$FCM_JOBS" ]; then
+    job="$FCM_JOBS"
+else
+    job=1
+fi
+
+# Determine if also need to compile the OASIS driver. This is only the case if the
+# path for the libraries is provided and exists
+if [ -n "$OASIS_LIBDIR" ] ; then
+    is_oasisdriver_opt=TRUE
+    # Check also if the provided path also exist. If not, delete the option.
+    if [ ! -d ${OASIS_LIBDIR} ]; then
+	is_oasisdriver_opt=FALSE
+    fi
+else
+    is_oasisdriver_opt=FALSE
+fi
+
+
+#########################################################################
+# 2. Read arguments
+#
+while (($# > 0)) ; do
+
+  case $1 in
+    "-h")
+        print_help=TRUE ; shift ;; 
+
+    "-parallel")
+        parallel_mode=$2 ; shift ; shift ;; 
+
+    "-p")
+        parallel_mode=$2 ; shift ; shift ;; 
+                       
+    "-driver")
+        is_driver_opt=TRUE ; shift ;;
+
+    "-otherexec")
+        is_other_opt=TRUE
+        is_driver_opt=TRUE ; shift ;;
+
+    "-arch")
+        arch="$2" ; shift ; shift ;;
+
+    "-xios")
+         xios=TRUE
+        shift ;;
+
+    "-xios2") 
+ 	 xios=TRUE
+        shift ;;
+
+    "-noxios")
+         xios=FALSE
+        shift ;;
+
+    "-prod")
+        compile_flags="%PROD_FFLAGS" ; shift ;;
+
+    "-dev")
+        compile_flags="%DEV_FFLAGS" ; shift ;;
+
+    "-debug")
+        compile_flags="%DEBUG_FFLAGS" ; shift ;;
+
+     "-j")
+        job="$2" ; shift ; shift ;;
+      
+     "-full")
+        full='-full' ; shift ;;
+
+     "-clean")
+        clean=TRUE ; shift ;;
+
+     "-ext_src")
+        ext_src=$2 ; shift ; shift ;;
+
+#    "-doc_para")
+#        setenv P_P -DCPP_PARA
+#	setenv SECTIONS_PARA "-e s&ENABLED_SECTIONS\ *= &ENABLED_SECTIONS       = CPP_PARA&g"
+#	goto doc
+
+     "-doc")
+	  compile_doc=TRUE ; shift ;;
+
+     "-rmdoc")
+	  \rm -rf docs
+          shift ;;
+
+     "-doc_tree") 
+          cd ..
+	find ORCHIDEE \( -not -path '*.svn*' \
+			-a \( -name '*.f90' -o -name "*.F90" -o -name "*.h" \) \) \
+		    -exec bash -c 'mkdir -p ORCHIDEE/DOC/$( dirname {} )/$( echo $( basename {} ) | sed -e "s/\..*//" )' \;
+	cd ORCHIDEE
+        shift ;;
+
+    *)
+        echo "unknown option "$1" , exiting..."
+        exit 
+   esac
+done
+
+#########################################################################
+# 3. Print help documentation and exit
+#
+if [[ "$print_help" == "TRUE" ]] ; then
+  cat <<fin
+
+########################################################################
+# Usage of the script makeorchidee_fcm
+#
+# makeorchidee_fcm compiles ORCHIDEE using the Fcm a software developed
+# by the Hadley Centre. Fcm is stored in tools directory. 
+# Platform specific compile options are found in the arch directory. 
+########################################################################
+
+./makeorchidee_fcm [Options] 
+
+Main options
+[ -h ]        : show this help
+
+[ -arch XXX ] : name of the archicture file containg platform dependent compile options. 
+                The files arch/arch-XXX.fcm and arch/arch-XXX.path must exist. 
+
+[ -parallel|-p PARALLEL_TYPE ] : choose parallelization mode for ORCHIDEE : 
+    PARALLEL_TYPE =
+    ( mpi | MPI )              : only MPI (Message Passing Interface)
+    ( omp | OMP )              : only OpenMP
+    ( mpi_omp | MPI_OMP )      : hybrid MPI/OpenMP mode
+    ( none | NONE | seq )      : sequential mode (default)
+
+[ -driver ]      : compilation of ORCHIDEE offline standard driver
+[ -otherexec ]   : compilation of other programs: teststomate, forcesoil, orchideedriver, testrouting. 
+                   Warning! All these programs are not fully validated or maintained.
+
+Options related to cleaning
+| -clean ]       : delete all files produceed during previous compilation
+| -full ]        : activate full recompiling 
+
+Options for XIOS, only choose one of the following
+[ -xios | -xios2 ] : linking with XIOS 2.0 (it is no longer possible to use XIOS1)
+[ -noxios ]        : compilation without XIOS (default)
+
+Options for optimization, choose only one of the following
+[ -prod ]        : compilation for production (all optimization)
+[ -dev ]         : compilation for development (low optimization and -g)
+[ -debug ]       : compilation for debugging (no optmization and all debug options)
+
+Option to optimize the compilation time
+[ -j x ]         : activate parallel compiling on x task, default 1 task
+
+Option to add extra source to compile
+[ -ext_src path] : path to an additional directory with fortran routines to compile with the model
+
+Options for compiling the documentation :
+[ -doc ]         : generate documentation with Doxygen (exit after doc computation)
+[ -doc_para ]    : generate documentation with Doxygen with parallelization calls
+[ -rmdoc ]       : remove documentation directory (before generate new documentation with Doxygen ?)
+[ -doc_tree ]    : generate tree of ORCHIDEE directories for each file
+
+
+Example 1 : compile at curie(TGCC) for MPI parallel run mode
+   ./makeorchidee_fcm -parallel mpi -arch X64_CURIE -driver
+
+Example 2 : compile at ada(IDRIS) for MPI-OpenMP parallel run mode
+   ./makeorchidee_fcm -parallel mpi_omp -arch X64_ADA -driver
+
+Example 3 : compile at obelix(LSCE)
+   ./makeorchidee_fcm -arch ifort_LSCE -driver
+
+Example 4 : compile using gfortran compiler for sequential run mode 
+First make sure that the files arch/gfortran.fcm and arch/gfortran.path are suitable for 
+your environement especially the path to netcdf library. 
+   ./makeorchidee_fcm -parallel seq -arch gfortran -driver
+
+Example 5 : clean files created during previous compilation
+   ./makeorchidee_fcm -clean
+
+fin
+
+  exit
+fi
+#
+#
+#####################################################################################################
+# 4. Building the documentation: 
+# ------------------------------
+# We assume to start in the ORCHIDEE directory
+#
+#****  Directory structure:
+#
+# ..                       : parent of the start dir.
+#   -- ORCHIDEE            : ($MODELPATH), start directory
+#       - src_sechiba
+#       - src_stomate
+#       + DOC
+#       + webdoc
+#   -- IOIPSL
+#       - src
+#   ++ modeles_doc         : ($SRCPATH), source files for the documentation, emptied at start, temporary
+#
+#****  gawk scripts called :
+#
+# codeinc.awk              : encaspulates code parts in Doxygen documentation
+# codedox.awk              : transforms almost all comments in Doxygen comments for documentation
+# codealgo.awk             : emphasizes main algorithm description of each routine in their Doxygen documentation
+#
+#****
+if [[ "$comple_doc" == "TRUE" ]] ; then
+
+    unalias cd
+
+    export REV=`svn info | grep vision | sed -e 's&.*vision.*: \([0-9]*\)&\1&' | head -n 1`
+    export TAG=`svn info | grep URL | sed -e 's&.*URL.*: svn://forge.ipsl.jussieu.fr/orchidee/\(.*\)&\1&' | head -n 1 | xargs dirname`
+    cd ..
+    
+    \rm -rf modeles_doc
+    export MODELPATH=${PWD}
+    \mkdir modeles_doc
+    export SRCPATH=${MODELPATH}/modeles_doc
+    
+    find IOIPSL/src \( -not -path '*.svn*' \
+	-a \( -name '*.f90' -o -name "*.F90" -o -name "*.h" \) \) \
+	-exec bash -c 'mkdir -p '${SRCPATH}'/$( dirname {} ); cp -p {} '${SRCPATH}'/$( dirname {} )' \;
+	    
+    find ORCHIDEE \( -not -path '*.svn*' \
+	-a \( -name '*.f90' -o -name "*.F90" -o -name "*.h" \) \) \
+	-exec bash -c 'mkdir -p '${SRCPATH}'/$( dirname {} ); cp -p {} '${SRCPATH}'/$( dirname {} )' \;
+    cd ${SRCPATH}
+    # Use standard preprocessor to suppress all preproc directives
+    \find . -name "*.f90" -exec cpp -P -C -traditional -x assembler-with-cpp ${P_P} '{}' '{}'_ \;
+    \find . -name "*.f90" -print -exec mv -f '{}'_ '{}' \;
+
+    # use codeinc script to encaspulate code parts in Doxygen documentation
+    \find . -name "*.f90" -exec gawk -f ${MODELPATH}/ORCHIDEE/DOC/TOOLS/codeinc.awk '{}' \; > /dev/null
+    \find . -name "*.f90" -print -exec mv -f '{}'_preproc_codeinc '{}' \;
+    # use codedox script to transform almost all comments in Doxygen comments for documentation (use with care !)
+    \find . -name "*.f90" -exec gawk -f ${MODELPATH}/ORCHIDEE/DOC/TOOLS/codedox.awk '{}' \; > /dev/null
+    \find . -name "*.f90" -print -exec mv -f '{}'_preproc_codedox '{}' \;
+    
+    # use codealgo script to emphasize main algorithm description of each routine in their Doxygen documentation
+    \find . -name "*.f90" -exec gawk -f ${MODELPATH}/ORCHIDEE/DOC/TOOLS/codealgo.awk '{}' \; > /dev/null
+    \find . -name "*.f90" -print -exec mv -f '{}'_preproc_codealgo '{}' \;
+    cd ../ORCHIDEE
+    \rm -f ${MODELPATH}/ORCHIDEE/Doxyfile_ORCHIDEE
+    sed -e 's&MYPATH&'${MODELPATH}'&g' -e 's&SRCPATH&'${SRCPATH}'&g' \
+        -e 's&MYTAG&'${TAG}'&' -e 's&MYREV&'${REV}'&' ${SECTIONS_PARA} \
+        ${MODELPATH}/ORCHIDEE/Doxyfile_ORCHIDEE.init > ${MODELPATH}/ORCHIDEE/Doxyfile_ORCHIDEE
+    \rm -f ${MODELPATH}/ORCHIDEE/DOC/header.tex
+    sed -e "s&MYTAG&${TAG}&" -e "s&MYREV&${REV}&" \
+        ${MODELPATH}/ORCHIDEE/DOC/header.tex.init > ${MODELPATH}/ORCHIDEE/DOC/header.tex
+    ln -s /home/orchidee01/maignan/ORCHIDEE/DOC/IMAGES ${MODELPATH}/ORCHIDEE/DOC/IMAGES
+    gmake doc
+    gmake bib
+    gmake toc
+    \rm -rf ${MODELPATH}/ORCHIDEE/webdoc
+    \mv ${MODELPATH}/ORCHIDEE/docs/html ${MODELPATH}/ORCHIDEE/webdoc
+    gmake index
+    gmake toc
+    \rm -rf ${SRCPATH}
+    cp ${MODELPATH}/ORCHIDEE/docs/latex/refman.pdf ${MODELPATH}/ORCHIDEE/documentation.pdf
+    exit
+fi
+
+#####################################################################################################
+# 5. Clean directory from files produced during previous compilation
+# --------------------------------------
+if [[ "$clean" == "TRUE" ]] ; then
+    rm -fr .config
+    rm -fr lib
+    rm -fr bin
+    rm -fr tmp_src
+    rm -f ../../lib/intersurf.mod
+    rm -f ../../lib/chemistry.mod
+    rm -f ../../lib/liborglob.a 
+    rm -f ../../lib/libparallel.a 
+    rm -f ../../lib/libsechiba.a 
+    rm -f ../../lib/libstomate.a 
+    rm -f ../../lib/libparameters.a 
+    rm -f ../../lib/liborchidee_ol.a
+    rm -f ../../lib/liborchidee.a
+
+    exit
+fi
+
+#########################################################################
+# 6. Prepare compilation
+#
+# Add fcm in environement path
+export PATH=${fcm_path}:${PATH}
+
+# Define architecture files
+if [[ "$arch" != "NONE" ]] ; then
+  if [[ -e arch/arch-${arch}.fcm ]] ; then
+    rm -f arch.fcm
+    ln -s arch/arch-${arch}.fcm arch.fcm
+  else
+    echo "architecture file : << arch/arch-${arch}.fcm >> is missing, exiting...."
+    exit
+  fi
+  
+  if [[ -e arch/arch-${arch}.path ]] ; then
+    rm -f arch.path
+    ln -s arch/arch-${arch}.path arch.path
+  else
+    echo "architecture file : << arch/arch-${arch}.path >> is missing, exiting...."
+    exit
+  fi
+else
+  echo "Warning : architecture not specified, taking default file <<arch.fcm>> and <<arch.path>>" 
+  if [[ ! -e arch.fcm ]] ; then
+    echo "architecture file : << arch.fcm >> is missing, exiting...."
+    exit
+  fi
+
+  if [[ ! -e arch.fcm ]] ; then
+    echo "architecture file : << arch.path >> is missing, exiting...."
+    exit
+  fi
+fi
+#
+# set compiler flags
+FFLAGS="%BASE_FFLAGS"
+LD_FFLAGS="%BASE_LD"
+CPP_KEY="%FPP_DEF"
+
+# set compiler flags for optimisation
+FFLAGS=${FFLAGS}" "$compile_flags
+LD_FFLAGS=${LD_FFLAGS}" "$compile_flags
+
+# set compiler flags for parallelism
+echo "parallel_mode = "${parallel_mode}
+
+if [[ "$parallel_mode" == "mpi" ]] || [[ "$parallel_mode" == "MPI" ]] ; then 
+    FFLAGS="${FFLAGS} %MPI_FFLAGS"
+    LD_FFLAGS="%MPI_LD ${LD_FFLAGS}"
+    CPP_KEY="CPP_PARA ${CPP_KEY}"
+elif [[ "$parallel_mode" == "omp" ]] || [[ "$parallel_mode" == "OMP" ]] ; then
+    FFLAGS="${FFLAGS} %OMP_FFLAGS"
+    LD_FFLAGS="%OMP_LD ${LD_FFLAGS}"
+    CPP_KEY="CPP_OMP CPP_PARA ${CPP_KEY}"
+elif [[ "$parallel_mode" == "mpi_omp" ]] || [[ "$parallel_mode" == "MPI_OMP" ]] ; then
+    FFLAGS="${FFLAGS} %MPI_FFLAGS %OMP_FFLAGS"
+    LD_FFLAGS="%MPI_LD %OMP_LD ${LD_FFLAGS}"
+    CPP_KEY="CPP_OMP CPP_PARA ${CPP_KEY}"
+elif [[ "$parallel_mode" == "none" ]] || [[ "$parallel_mode" == "NONE" ]] || [[ "$parallel_mode" == "seq" ]] ; then
+    echo "Compiling for sequential mode"
+else
+    echo "This option for parallel_mode is not implemeted. Choose between mpi, omp, mpi_omp and none."
+    exit
+fi
+
+#
+# Get all the variables set in the path file for the current architecture
+#
+source ./arch.path
+#
+# Create some temporary variable to which we add as needed
+#
+INCDIR="-I$NETCDF_INCDIR -I$IOIPSL_INCDIR"
+LIBDIR="-L$NETCDF_LIBDIR -L$IOIPSL_LIBDIR"
+
+# Do we need to link with XIOS
+#
+if [[ "$xios" == "TRUE" ]] ; then
+    CPP_KEY="XIOS ${CPP_KEY}"
+    INCDIR="${INCDIR} -I$XIOS_INCDIR"
+    LIBDIR="${LIBDIR} -L$XIOS_LIBDIR"
+fi
+
+# set target
+TARGET=liborchidee.a
+if [[ "$is_driver_opt" == "TRUE" ]] ; then
+    TARGET="liborchidee_ol.a dim2_driver.exe"
+fi
+if [[ "$is_other_opt" == "TRUE" ]] ; then
+    TARGET="${TARGET} orchideedriver.exe testrouting.exe"
+fi
+
+if [[ "$is_oasisdriver_opt" == "TRUE" ]] ; then
+    CPP_KEY="OASIS ${CPP_KEY}"
+    TARGET="${TARGET} driver2oasis.exe orchideeoasis.exe"
+    INCDIR="${INCDIR} -I${OASIS_INCDIR}/psmile.MPI1 -I${OASIS_INCDIR}/scrip  -I${OASIS_INCDIR}/mct"
+    LIBDIR="${LIBDIR} -L${OASIS_LIBDIR} -lpsmile.MPI1 -lmct -lmpeu -lscrip"
+    echo "OASIS : ${INCDIR}"
+fi
+
+# build config file
+config_fcm="config.fcm"
+rm -f $config_fcm
+touch $config_fcm
+
+echo "%ARCH          $arch"                             >> $config_fcm 
+echo "%FFLAGS        $FFLAGS"                           >> $config_fcm 
+echo "%CPP_KEY       $CPP_KEY"                          >> $config_fcm
+echo "%EXEC          $TARGET"                           >> $config_fcm
+echo "%LD_FFLAGS     $LD_FFLAGS"                        >> $config_fcm
+echo "%INCDIR        ${INCDIR}"                         >> $config_fcm
+echo "%LIBDIR        ${LIBDIR}"                         >> $config_fcm
+echo "%EXT_SRC       $ext_src"                          >> $config_fcm
+
+
+# Delete interface module from modipsl/lib directory
+rm -f ../../lib/intersurf.mod
+rm -f ../../lib/sechiba.mod
+
+# Check if compiling is locked
+if [ -f .config/fcm.bld.lock ] ; then
+    echo "WARNING : build lock file exists"
+    echo "This means that either someone else is compiling this directory right now "
+    echo "or the previous compiling was interrupt abnormally."
+    echo ""
+    echo "Do you whant to remove this file and start compiling? [answer yes/no]"  
+    read answer
+    if [ $answer = "yes" ] || [ $answer = "y" ] ; then
+	rm -f .config/fcm.bld.lock
+    else
+	echo "Exit now!!!"
+	exit 1
+    fi
+fi
+
+#########################################################################
+# 7. Do the compiling
+fcm build -j $job $full
+err=$?
+if [ $err != 0 ] ; then  
+  # ERROR IN COMPILING 
+  echo ERROR IN COMPILING ORCHIDEE : $err  
+  exit 1 
+fi 
+
+# Copy into modipsl/lib directory libraries and interface module needed by LMDZ
+cp lib/lib*a ../../lib/.
+cp lib/intersurf.mod ../../lib/.
+cp lib/sechiba.mod ../../lib/.
+
+# Move created executables to modipsl/bin directory
+if [ -f bin/dim2_driver.exe ]    ; then mv bin/dim2_driver.exe ../../bin/orchidee_ol ; fi
+if [ -f bin/teststomate.exe ]    ; then mv bin/teststomate.exe ../../bin/teststomate ; fi
+if [ -f bin/forcesoil.exe ]      ; then mv bin/forcesoil.exe ../../bin/forcesoil ; fi
+if [ -f bin/orchideedriver.exe ] ; then mv bin/orchideedriver.exe ../../bin/orchideedriver ; fi
+if [ -f bin/testrouting.exe ]    ; then mv bin/testrouting.exe ../../bin/testrouting ; fi
+if [ -f bin/friver2oasis.exe ]   ; then mv bin/driver2oasis.exe ../../bin/driver2oasis ; fi
+if [ -f bin/orchideeoasis.exe ]  ; then mv bin/orchideeoasis.exe ../../bin/orchideeoasis ; fi
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/orchidee.default
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/orchidee.default	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/orchidee.default	(revision 6412)
@@ -0,0 +1,1769 @@
+#
+#
+#  WARNING !!! 
+#  DO NOT MODIFY THIS FILE.
+#  THIS FILE IS ONLY PROVIDING INFORMATION ABOUT DEFAULT PARAMETER SETTINGS IN ORCHIDEE. 
+#
+#*******************************************************************************************
+#                    Namelist for ORCHIDEE 
+#*******************************************************************************************
+#
+#  For more details, see : http://forge.ipsl.jussieu.fr/orchidee/wiki/Documentation/OrchideeParameters 
+#
+#  Note : [m] : meters; [K] : Kelvin degrees; [C] : Celsius degrees
+#
+
+#*******************************************************************************************
+#          ORCHIDEE driver parameters (read in Off-line mode only) 
+#*******************************************************************************************
+
+# FORCING_FILE ([FILE] ) :  Name of file containing the forcing data 	{[-]}
+FORCING_FILE =  forcing_file.nc 
+
+# DT_SECHIBA ([seconds]) :  Time-step of the SECHIBA component 	{NOT(WEATHERGEN)}
+DT_SECHIBA =  1800. 
+
+# RESTART_FILEIN ([FILE]) :  Name of restart to READ for initial conditions 	{[-]}
+RESTART_FILEIN =  NONE 
+
+# RESTART_FILEOUT ([FILE]) :  Name of restart files to be created by the driver 	{[-]}
+RESTART_FILEOUT =  driver_rest_out.nc 
+
+# DRIVER_reset_time ([FLAG]) :  Overwrite time values from the driver restart file 	{[-]}
+DRIVER_reset_time =  n 
+
+# TIME_SKIP ([seconds, days, months, years]) :  Time in the forcing file at which the model is started. 	{[-]}
+TIME_SKIP =  0 
+
+# TIME_LENGTH ([seconds, days, months, years]) :  Length of the integration in time. 	{[-]}
+TIME_LENGTH =  Full length of the forcing file  
+
+# RELAXATION ([FLAG]) :  method of forcing 	{[-]}
+RELAXATION =  n 
+
+# RELAX_A ([days?]) :  Time constant of the relaxation layer 	{RELAXATION}
+RELAX_A =  1.0 
+
+# NO_INTER  ([FLAG]) :  No interpolation IF split is larger than 1 	{[-]}
+NO_INTER  =  y 
+
+# INTER_LIN ([FLAG]) :  Interpolation IF split is larger than 1 	{[-]}
+INTER_LIN =  n 
+
+# SPRED_PREC ([-]) :  Spread the precipitation. 	{[-]}
+SPRED_PREC =  Half of the forcing time step or uniform, depending on dt_force and dt_sechiba 
+
+# NETRAD_CONS ([FLAG]) :  Conserve net radiation in the forcing 	{INTER_LIN}
+NETRAD_CONS =  y 
+
+# ATM_CO2 ([ppm]) :  Value for atm CO2 	{[-]}
+ATM_CO2 =  350. 
+
+# ALLOW_WEATHERGEN ([FLAG]) :  Allow weather generator to create data 	{[-]}
+ALLOW_WEATHERGEN =  n 
+
+# DT_WEATHGEN ([seconds]) :  Calling frequency of weather generator 	{ALLOW_WEATHERGEN}
+DT_WEATHGEN =  1800. 
+
+# LIMIT_WEST ([Degrees] ) :  Western limit of region 	{[-]}
+LIMIT_WEST =  -180. 
+
+# LIMIT_EAST ([Degrees] ) :  Eastern limit of region 	{[-]}
+LIMIT_EAST =  180. 
+
+# LIMIT_NORTH ([Degrees]) :  Northern limit of region 	{[-]}
+LIMIT_NORTH =  90. 
+
+# LIMIT_SOUTH ([Degrees]) :  Southern limit of region 	{[-]}
+LIMIT_SOUTH =  -90. 
+
+# MERID_RES ([Degrees]) :  North-South Resolution 	{ALLOW_WEATHERGEN}
+MERID_RES =  2. 
+
+# ZONAL_RES ([Degrees] ) :  East-West Resolution 	{ALLOW_WEATHERGEN}
+ZONAL_RES =  2. 
+
+# HEIGHT_LEV1 ([m]) :  Height at which T and Q are given 	{offline mode}
+HEIGHT_LEV1 =  2.0 
+
+# HEIGHT_LEVW ([m]) :  Height at which the wind is given 	{offline mode}
+HEIGHT_LEVW =  10.0 
+
+# NBUFF (-) :  Number of time steps of data to buffer between each reading of the forcing file 	{OFF_LINE}
+NBUFF =  1 
+
+# IPPREC ([-] ) :  Use prescribed values 	{ALLOW_WEATHERGEN}
+IPPREC =  0 
+
+# WEATHGEN_PRECIP_EXACT ([FLAG]) :  Exact monthly precipitation 	{ALLOW_WEATHERGEN}
+WEATHGEN_PRECIP_EXACT =  n 
+
+# DUMP_WEATHER ([FLAG]) :  Write weather from generator into a forcing file 	{ALLOW_WEATHERGEN  }
+DUMP_WEATHER =  n 
+
+# DUMP_WEATHER_FILE ([FILE]) :  Name of the file that contains the weather from generator 	{DUMP_WEATHER}
+DUMP_WEATHER_FILE =  weather_dump.nc 
+
+# DUMP_WEATHER_GATHERED ([FLAG]) :  Dump weather data on gathered grid 	{DUMP_WEATHER}
+DUMP_WEATHER_GATHERED =  y 
+
+# HEIGHT_LEV1_DUMP ([m]) :   	{DUMP_WEATHER}
+HEIGHT_LEV1_DUMP =  10. 
+
+#*******************************************************************************************
+#          ORCHIDEE parameters  
+#*******************************************************************************************
+
+# SOILTYPE_CLASSIF ([-]) :  Type of classification used for the map of soil types  	{!IMPOSE_VEG}
+SOILTYPE_CLASSIF =  zobler 
+
+# RIVER_ROUTING ([FLAG]) :  Decides if we route the water or not 	{OK_SECHIBA}
+RIVER_ROUTING =  n 
+
+# HYDROL_CWRR ([FLAG]) :  Allows to switch on the multilayer hydrology of CWRR 	{OK_SECHIBA}
+HYDROL_CWRR =  n 
+
+# DO_IRRIGATION ([FLAG]) :  Should we compute an irrigation flux  	{RIVER_ROUTING }
+DO_IRRIGATION =  n 
+
+# DO_FLOODPLAINS ([FLAG]  ) :  Should we include floodplains  	{RIVER_ROUTING }
+DO_FLOODPLAINS =  n 
+
+# CHECK_WATERBAL ([FLAG]  ) :  Should we check the global water balance  	{OK_SECHIBA}
+CHECK_WATERBAL =  n 
+
+# OK_EXPLICITSNOW ([FLAG]) :  Activate explict snow scheme 	{OK_SECHIBA}
+OK_EXPLICITSNOW =  FALSE 
+
+# STOMATE_OK_STOMATE ([FLAG]) :  Activate STOMATE? 	{OK_SECHIBA}
+STOMATE_OK_STOMATE =  n 
+
+# STOMATE_OK_CO2 ([FLAG]) :  Activate CO2? 	{OK_SECHIBA }
+STOMATE_OK_CO2 =  y if OK_STOMATE else n 
+
+# STOMATE_OK_DGVM ([FLAG]) :  Activate DGVM? 	{OK_STOMATE}
+STOMATE_OK_DGVM =  n 
+
+# CHEMISTRY_BVOC ([FLAG]) :  Activate calculations for BVOC 	{OK_SECHIBA}
+CHEMISTRY_BVOC =  n 
+
+# CHEMISTRY_LEAFAGE ([FLAG]) :  Activate LEAFAGE? 	{CHEMISTRY_BVOC}
+CHEMISTRY_LEAFAGE =  n 
+
+# CANOPY_EXTINCTION  ([FLAG]) :  Use canopy radiative transfer model? 	{CHEMISTRY_BVOC }
+CANOPY_EXTINCTION  =  n 
+
+# CANOPY_MULTILAYER ([FLAG]) :  Use canopy radiative transfer model with multi-layers 	{CANOPY_EXTINCTION }
+CANOPY_MULTILAYER =  n 
+
+# NOx_RAIN_PULSE ([FLAG]) :  Calculate NOx emissions with pulse? 	{CHEMISTRY_BVOC }
+NOx_RAIN_PULSE =  n 
+
+# NOx_BBG_FERTIL ([FLAG]) :  Calculate NOx emissions with bbg fertilizing effect? 	{CHEMISTRY_BVOC }
+NOx_BBG_FERTIL =  n 
+
+# NOx_FERTILIZERS_USE ([FLAG] ) :  Calculate NOx emissions with fertilizers use? 	{CHEMISTRY_BVOC }
+NOx_FERTILIZERS_USE =  n 
+
+# NVM ([-]) :  number of PFTs   	{OK_SECHIBA or OK_STOMATE}
+NVM =  13 
+
+# IMPOSE_PARAM ([FLAG]) :  Do you impose the values of the parameters? 	{OK_SECHIBA or OK_STOMATE}
+IMPOSE_PARAM =  y 
+
+# THERMOSOIL_NBLEV (m) :  Number of soil level 	{HDYROL_CWRR=FALSE}
+THERMOSOIL_NBLEV =  Number of soil level 
+
+# DEPTH_MAX_T (m) :  Maximum depth of the soil thermodynamics 	{}
+DEPTH_MAX_T =  10.0 
+
+# DEPTH_MAX_H (m) :  Maximum depth of soil moisture 	{}
+DEPTH_MAX_H =  2.0 or 4.0 depending on hydrol_cwrr 
+
+# DEPTH_TOPTHICK (m) :  Thickness of upper most Layer  	{}
+DEPTH_TOPTHICK =  9.77517107e-04 
+
+# DEPTH_CSTTHICK (m) :  Depth at which constant layer thickness start 	{}
+DEPTH_CSTTHICK =  DEPTH_MAX_H  
+
+# REFINEBOTTOM (-) :  Depth at which the hydrology layers will be refined towards the bottom. 	{}
+REFINEBOTTOM =  .FALSE. 
+
+# DEPTH_GEOM (m) :  Depth at which we resume geometrical increases for temperature 	{}
+DEPTH_GEOM =  DEPTH_MAX_H  
+
+# RATIO_GEOM_BELOW (-) :  Ratio of the geometrical series defining the thickness below DEPTH_GEOM 	{}
+RATIO_GEOM_BELOW =  2 
+
+# ALMA_OUTPUT ([FLAG]) :  Should the output follow the ALMA convention 	{OK_SECHIBA}
+ALMA_OUTPUT =  n 
+
+# OUTPUT_FILE ([FILE]) :  Name of file in which the output is going to be written 	{OK_SECHIBA}
+OUTPUT_FILE =  sechiba_history.nc 
+
+# WRITE_STEP ([seconds]) :  Frequency in seconds for sechiba_history.nc file with IOIPSL 	{OK_SECHIBA, NOT XIOS_ORCHIDEE_OK}
+WRITE_STEP =  86400. 
+
+# SECHIBA_HISTLEVEL ([-]) :  SECHIBA history output level (0..10) 	{OK_SECHIBA and HF}
+SECHIBA_HISTLEVEL =  5 
+
+# SECHIBA_HISTFILE2 ([FLAG]) :  Flag to switch on histfile 2 for SECHIBA (hi-frequency ?) 	{OK_SECHIBA}
+SECHIBA_HISTFILE2 =  n 
+
+# WRITE_STEP2 ([seconds]) :  Frequency in seconds at which to WRITE output 	{SECHIBA_HISTFILE2}
+WRITE_STEP2 =  1800.0 
+
+# SECHIBA_OUTPUT_FILE2 ([FILE]) :  Name of file in which the output number 2 is going to be written 	{SECHIBA_HISTFILE2}
+SECHIBA_OUTPUT_FILE2 =  sechiba_out_2.nc 
+
+# SECHIBA_HISTLEVEL2 ([-] ) :  SECHIBA history 2 output level (0..10) 	{SECHIBA_HISTFILE2}
+SECHIBA_HISTLEVEL2 =  1 
+
+# STOMATE_OUTPUT_FILE ([FILE]) :  Name of file in which STOMATE's output is going to be written 	{OK_STOMATE}
+STOMATE_OUTPUT_FILE =  stomate_history.nc 
+
+# STOMATE_HIST_DT ([days]) :  STOMATE history time step 	{OK_STOMATE}
+STOMATE_HIST_DT =  10. 
+
+# STOMATE_IPCC_OUTPUT_FILE ([FILE]) :  Name of file in which STOMATE's output is going to be written 	{OK_STOMATE}
+STOMATE_IPCC_OUTPUT_FILE =  stomate_ipcc_history.nc 
+
+# STOMATE_IPCC_HIST_DT ([days]) :  STOMATE IPCC history time step 	{OK_STOMATE}
+STOMATE_IPCC_HIST_DT =  0. 
+
+# OK_HISTSYNC ([FLAG]) :  Syncronize and write IOIPSL output files at each time step 	{}
+OK_HISTSYNC =  FALSE 
+
+# STOMATE_HISTLEVEL ([-]) :  STOMATE history output level (0..10) 	{OK_STOMATE}
+STOMATE_HISTLEVEL =  10 
+
+# SECHIBA_restart_in ([FILE]) :  Name of restart to READ for initial conditions 	{OK_SECHIBA }
+SECHIBA_restart_in =  NONE 
+
+# SECHIBA_rest_out ([FILE]) :  Name of restart files to be created by SECHIBA 	{OK_SECHIBA}
+SECHIBA_rest_out =  sechiba_rest_out.nc 
+
+# STOMATE_RESTART_FILEIN ([FILE]) :  Name of restart to READ for initial conditions of STOMATE 	{STOMATE_OK_STOMATE}
+STOMATE_RESTART_FILEIN =  NONE 
+
+# STOMATE_RESTART_FILEOUT ([FILE]) :  Name of restart files to be created by STOMATE 	{STOMATE_OK_STOMATE}
+STOMATE_RESTART_FILEOUT =  stomate_rest_out.nc 
+
+# FORCE_CO2_VEG ([FLAG]) :  Flag to force the value of atmospheric CO2 for vegetation. 	{Only in coupled mode}
+FORCE_CO2_VEG =  FALSE 
+
+# ATM_CO2 ([ppm]) :  Value for atm CO2  	{FORCE_CO2_VEG (only in coupled mode)}
+ATM_CO2 =  350. 
+
+# ECCENTRICITY ([-]) :  Use prescribed values 	{ALLOW_WEATHERGEN}
+ECCENTRICITY =  0.016724 
+
+# PERIHELIE ([-]) :  Use prescribed values 	{ALLOW_WEATHERGEN}
+PERIHELIE =  102.04 
+
+# OBLIQUITY ([Degrees]) :  Use prescribed values 	{ALLOW_WEATHERGEN}
+OBLIQUITY =  23.446 
+
+# PFT_TO_MTC ([-]) :  correspondance array linking a PFT to MTC 	{OK_SECHIBA or OK_STOMATE}
+PFT_TO_MTC =  1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 
+
+# PFT_NAME ([-]) :  Name of a PFT 	{OK_SECHIBA or OK_STOMATE}
+PFT_NAME =  bare ground, tropical broad-leaved evergreen, tropical broad-leaved raingreen, temperate needleleaf evergreen, temperate broad-leaved evergreen, temperate broad-leaved summergreen,  boreal needleleaf evergreen, boreal broad-leaved summergreen, boreal needleleaf summergreen,  C3 grass, C4 grass, C3 agriculture, C4 agriculture  
+
+# LEAF_TAB ([-] ) :  leaf type : 1 	{OK_STOMATE}
+LEAF_TAB =  4, 1, 1, 2, 1, 1, 2, 1, 2, 3, 3, 3, 3  
+
+# PHENO_MODEL ([-] ) :  which phenology model is used? (tabulated)  	{OK_STOMATE}
+PHENO_MODEL =  none, none, moi, none, none, ncdgdd, none, ncdgdd, ngd, moigdd, moigdd, moigdd, moigdd 
+
+# SECHIBA_LAI ([m^2/m^2]) :  laimax for maximum lai(see also type of lai interpolation) 	{OK_SECHIBA or IMPOSE_VEG}
+SECHIBA_LAI =  0., 8., 8., 4., 4.5, 4.5, 4., 4.5, 4., 2., 2., 2., 2. 
+
+# LLAIMIN ([m^2/m^2]) :  laimin for minimum lai(see also type of lai interpolation) 	{OK_SECHIBA or IMPOSE_VEG}
+LLAIMIN =  0., 8., 0., 4., 4.5, 0., 4., 0., 0., 0., 0., 0., 0. 
+
+# SLOWPROC_HEIGHT ([m] ) :  prescribed height of vegetation  	{OK_SECHIBA}
+SLOWPROC_HEIGHT =  0., 30., 30., 20., 20., 20., 15., 15., 15., .5, .6, 1., 1. 
+
+# Z0_OVER_HEIGHT ([-] ) :  factor to calculate roughness height from height of canopy  	{OK_SECHIBA}
+Z0_OVER_HEIGHT =  0., 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625 
+
+# RATIO_Z0M_Z0H ([-]) :  Ratio between z0m and z0h 	{OK_SECHIBA}
+RATIO_Z0M_Z0H =  1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0  
+
+# TYPE_OF_LAI ([-]) :  Type of behaviour of the LAI evolution algorithm  	{OK_SECHIBA}
+TYPE_OF_LAI =  inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter 
+
+# NATURAL ([BOOLEAN]) :  natural?  	{OK_SECHIBA, OK_STOMATE}
+NATURAL =  y, y, y, y, y, y, y, y, y, y, y, n, n  
+
+# IS_C4 ([BOOLEAN]) :  flag for C4 vegetation types 	{OK_SECHIBA or OK_STOMATE}
+IS_C4 =  n, n, n, n, n, n, n, n, n, n, n, y, n, y 
+
+# VCMAX_FIX ([micromol/m^2/s] ) :  values used for vcmax when STOMATE is not activated 	{OK_SECHIBA and NOT(OK_STOMATE)}
+VCMAX_FIX =  0., 40., 50., 30., 35., 40.,30., 40., 35., 60., 60., 70., 70. 
+
+# DOWNREG_CO2 ([-]) :  coefficient for CO2 downregulation (unitless) 	{OK_CO2}
+DOWNREG_CO2 =  0., 0.38, 0.38, 0.28, 0.28, 0.28, 0.22, 0.22, 0.22, 0.26, 0.26, 0.26, 0.26 
+
+# E_KmC ([J mol-1]) :  Energy of activation for KmC 	{OK_CO2}
+E_KmC =  -9999.,  79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430. 
+
+# E_KmO ([J mol-1]) :  Energy of activation for KmO 	{OK_CO2}
+E_KmO =  -9999., 36380.,  36380.,  36380.,  36380.,  36380., 36380., 36380., 36380., 36380., 36380., 36380., 36380. 
+
+# E_Sco ([J mol-1]) :  Energy of activation for Sco     {OK_CO2} 
+E_Sco =  -9999., -24460., -24460., -24460., -24460., -24460., -24460., -24460., -24460., -24460., -24460., -24460., -24460.
+
+# E_gamma_star ([J mol-1]) :  Energy of activation for gamma_star 	{OK_CO2}
+E_gamma_star =  -9999., 37830.,  37830.,  37830.,  37830.,  37830., 37830., 37830., 37830., 37830., 37830., 37830., 37830. 
+
+# E_Vcmax ([J mol-1]) :  Energy of activation for Vcmax 	{OK_CO2}
+E_Vcmax =  -9999., 71513., 71513., 71513., 71513., 71513., 71513., 71513., 71513., 71513., 67300., 71513., 67300. 
+
+# E_Jmax ([J mol-1]) :  Energy of activation for Jmax 	{OK_CO2}
+E_Jmax =  -9999., 49884., 49884., 49884., 49884., 49884., 49884., 49884., 49884., 49884., 77900., 49884., 77900.  
+
+# aSV ([J K-1 mol-1]) :  a coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax 	{OK_CO2}
+aSV =  -9999., 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 641.64, 668.39, 641.64  
+
+# bSV ([J K-1 mol-1 Â°C-1]) :  b coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax 	{OK_CO2}
+bSV =  -9999., -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, 0., -1.07, 0.  
+
+# TPHOTO_MIN ([-]) :  minimum photosynthesis temperature (deg C) 	{OK_STOMATE}
+TPHOTO_MIN =  -9999.,  -4., -4., -4., -4.,-4.,-4., -4., -4., -4., -4., -4., -4. 
+
+# TPHOTO_MAX ([-]) :  maximum photosynthesis temperature (deg C) 	{OK_STOMATE}
+TPHOTO_MAX =  -9999., 55., 55., 55., 55., 55., 55., 55., 55., 55., 55., 55., 55. 
+
+# aSJ ([J K-1 mol-1]) :  a coefficient of the linear regression (a+bT) defining the Entropy term for Jmax 	{OK_CO2}
+aSJ =  -9999., 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 630., 659.70, 630.  
+
+# bSJ ([J K-1 mol-1 Â°C-1]) :  b coefficient of the linear regression (a+bT) defining the Entropy term for Jmax 	{OK_CO2}
+bSJ =  -9999., -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, 0., -0.75, 0.  
+
+# D_Vcmax ([J mol-1]) :  Energy of deactivation for Vcmax 	{OK_CO2}
+D_Vcmax =  -9999., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 192000., 200000., 192000. 
+
+# D_Jmax ([J mol-1]) :  Energy of deactivation for Jmax 	{OK_CO2}
+D_Jmax =  -9999., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 192000., 200000., 192000. 
+
+# E_gm  ([J mol-1] ) :  Energy of activation for gm     {OK_CO2 } 
+E_gm  =  -9999., 49600., 49600., 49600., 49600., 49600., 49600., 49600., 49600., 49600., -9999., 49600., -9999.   
+ 
+# S_gm  ([J K-1 mol-1] ) :  Entropy term for gm         {OK_CO2 } 
+S_gm  =  -9999., 1400., 1400., 1400., 1400., 1400., 1400., 1400., 1400., 1400., -9999., 1400., -9999.   
+	 
+# D_gm  ([J mol-1] ) :  Energy of deactivation for gm   {OK_CO2 } 
+D_gm  =  -9999., 437400., 437400., 437400., 437400., 437400., 437400., 437400., 437400., 437400., -9999., 437400., -9999.
+
+# E_Rd ([J mol-1]) :  Energy of activation for Rd 	{OK_CO2}
+E_Rd =  -9999., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390. 
+
+# VCMAX25 ([micromol/m^2/s]) :  Maximum rate of Rubisco activity-limited carboxylation at 25Â°C 	{OK_STOMATE}
+VCMAX25 =  -9999., 65., 65., 35., 45., 55., 35., 45., 35., 70., 70., 70., 70. 
+
+# ARJV ([mu mol e- (mu mol CO2)-1]) :  a coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio  	{OK_STOMATE}
+ARJV =  -9999., 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 1.715, 2.59, 1.715 
+
+# BRJV ([(mu mol e- (mu mol CO2)-1) (Â°C)-1]) :  b coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio  	{OK_STOMATE}
+BRJV =  -9999., -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, 0., -0.035, 0. 
+
+# KmC25 ([ubar]) :  MichaelisâMenten constant of Rubisco for CO2 at 25Â°C 	{OK_CO2}
+KmC25 =  -9999., 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 650., 404.9, 650. 
+
+# KmO25 ([ubar]) :  MichaelisâMenten constant of Rubisco for O2 at 25Â°C 	{OK_CO2}
+KmO25 =  -9999., 278400., 278400., 278400., 278400., 278400., 278400., 278400., 278400., 278400., 450000., 278400., 450000. 
+
+# Sco25 ([bar bar-1]) :  Relative CO2 /O2 specificity factor for Rubisco at 25ÃÂÃÂ°C     {OK_CO2} 
+Sco25 =  -9999., 2800., 2800., 2800., 2800., 2800., 2800., 2800., 2800., 2800., 2590., 2800., 2590.  
+
+# gm25  ([mol m-2 s-1 bar-1] ) :  Mesophyll diffusion conductance at 25ÃÂÃÂÃÂÃÂ°C        {OK_CO2 } 
+gm25  =  -9999., 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, -9999., 0.4, -9999.
+
+# gamma_star25 ([ubar]) :  Ci-based CO2 compensation point in the absence of Rd at 25Â°C (ubar) 	{OK_CO2}
+gamma_star25 =  -9999., 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75 
+
+# a1 ([-]) :  Empirical factor involved in the calculation of fvpd 	{OK_CO2}
+a1 =  -9999., 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.72, 0.85, 0.72 
+
+# b1 ([-]) :  Empirical factor involved in the calculation of fvpd 	{OK_CO2}
+b1 =  -9999., 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.20, 0.14, 0.20 
+
+# g0 ([mol mâ2 sâ1 barâ1]) :  Residual stomatal conductance when irradiance approaches zero  	{OK_CO2}
+g0 =  -9999., 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.01875, 0.00625, 0.01875  
+
+# h_protons ([mol mol-1]) :  Number of protons required to produce one ATP 	{OK_CO2}
+h_protons =  -9999., 4., 4., 4., 4., 4., 4., 4., 4., 4., 4., 4., 4.  
+
+# fpsir ([-]) :  Fraction of PSII eâ transport rate partitioned to the C4 cycle 	{OK_CO2}
+fpsir =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0.4, -9999., 0.4  
+
+# fQ ([-]) :  Fraction of electrons at reduced plastoquinone that follow the Q-cycle 	{OK_CO2}
+fQ =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 1., -9999., 1. 
+
+# fpseudo ([-]) :  Fraction of electrons at PSI that follow pseudocyclic transport  	{OK_CO2}
+fpseudo =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0.1, -9999., 0.1 
+
+# kp ([mol mâ2 sâ1 barâ1]) :  Initial carboxylation efficiency of the PEP carboxylase 	{OK_CO2}
+kp =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0.7, -9999., 0.7 
+
+# alpha ([-]) :  Fraction of PSII activity in the bundle sheath 	{OK_CO2}
+alpha =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0.1, -9999., 0.1 
+
+# gbs ([mol mâ2 sâ1 barâ1]) :  Bundle-sheath conductance 	{OK_CO2}
+gbs =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0.003, -9999., 0.003 
+
+# theta ([â]) :  Convexity factor for response of J to irradiance 	{OK_CO2}
+theta =  -9999., 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7 
+
+# alpha_LL ([mol eâ (mol photon)â1]) :  Conversion efficiency of absorbed light into J at strictly limiting light 	{OK_CO2}
+alpha_LL =  -9999., 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372 
+
+# STRESS_VCMAX ([-]) :  Stress on vcmax         {OK_SECHIBA or OK_STOMATE} 
+STRESS_VCMAX =  1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.  
+	 
+# STRESS_GS ([-]) :  Stress on gs       {OK_SECHIBA or OK_STOMATE} 
+STRESS_GS =  0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.  
+
+# STRESS_GM ([-]) :  Stress on gm       {OK_SECHIBA or OK_STOMATE} 
+STRESS_GM =  0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.
+
+# EXT_COEFF ([-]) :  extinction coefficient of the Monsi&Seaki relationship (1953) 	{OK_SECHIBA or OK_STOMATE}
+EXT_COEFF =  .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5 
+
+# EXT_COEFF_VEGETFRAC ([-]) :  extinction coefficient used for the calculation of the bare soil fraction  	{OK_SECHIBA or OK_STOMATE}
+EXT_COEFF_VEGETFRAC =  1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1. 
+
+# HYDROL_HUMCSTE ([m]) :  Root profile 	{OK_SECHIBA}
+HYDROL_HUMCSTE =  humcste_ref2m or humcste_ref4m depending on zmaxh 
+
+# PREF_SOIL_VEG ([-]        ) :  The soil tile number for each vegetation 	{OK_SECHIBA or OK_STOMATE}
+PREF_SOIL_VEG =  1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3 
+
+# RSTRUCT_CONST ([s/m]) :  Structural resistance  	{OK_SECHIBA}
+RSTRUCT_CONST =  0.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0,  2.5,  2.0,  2.0,  2.0 
+
+# KZERO ([kg/m^2/s]) :  A vegetation dependent constant used in the calculation of the surface resistance. 	{OK_SECHIBA}
+KZERO =  0.0, 12.E-5, 12.E-5, 12.e-5, 12.e-5, 25.e-5, 12.e-5,25.e-5, 25.e-5, 30.e-5, 30.e-5, 30.e-5, 30.e-5  
+
+# RVEG_PFT ([-]) :  Artificial parameter to increase or decrease canopy resistance. 	{OK_SECHIBA}
+RVEG_PFT =  1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1. 
+
+# WMAX_VEG ([kg/m^3]) :  Maximum field capacity for each of the vegetations (Temporary): max quantity of water 	{OK_SECHIBA}
+WMAX_VEG =  150., 150., 150., 150., 150., 150., 150.,150., 150., 150., 150., 150., 150. 
+
+# PERCENT_THROUGHFALL_PFT ([%]) :  Percent by PFT of precip that is not intercepted by the canopy. Default value depend on run mode. 	{OK_SECHIBA}
+PERCENT_THROUGHFALL_PFT =  Case offline+CWRR [0. 0. 0....] else [30. 30. 30.....] 
+
+# SNOWA_AGED_VIS ([-]) :  Minimum snow albedo value for each vegetation type after aging (dirty old snow), visible albedo 	{OK_SECHIBA}
+SNOWA_AGED_VIS =  0.5, 0., 0., 0.15, 0.14, 0.14, 0.15, 0.14, 0.22, 0.35, 0.35, 0.35, 0.35 
+
+# SNOWA_AGED_NIR ([-]) :  Minimum snow albedo value for each vegetation type after aging (dirty old snow), near infrared albedo 	{OK_SECHIBA}
+SNOWA_AGED_NIR =  0.35, 0., 0., 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.18, 0.18, 0.18, 0.18 
+
+# SNOWA_DEC_VIS ([-]) :  Decay rate of snow albedo value for each vegetation type as it will be used in condveg_snow, visible albedo 	{OK_SECHIBA}
+SNOWA_DEC_VIS =  0.45, 0., 0., 0.1, 0.06, 0.11, 0.10, 0.11, 0.18, 0.60, 0.60, 0.60, 0.60 
+
+# SNOWA_DEC_NIR ([-]) :  Decay rate of snow albedo value for each vegetation type as it will be used in condveg_snow, near infrared albedo 	{OK_SECHIBA}
+SNOWA_DEC_NIR =  0.45, 0.,  0., 0.06, 0.06, 0.11, 0.06, 0.11, 0.11, 0.52 ,0.52, 0.52, 0.52 
+
+# ALB_LEAF_VIS ([-]) :  leaf albedo of vegetation type, visible albedo 	{OK_SECHIBA}
+ALB_LEAF_VIS =  .0, .0397, .0474, .0386, .0484, .0411, .041, .0541, .0435, .0524, .0508, .0509, .0606 
+
+# ALB_LEAF_NIR ([-]) :  leaf albedo of vegetation type, near infrared albedo 	{OK_SECHIBA}
+ALB_LEAF_NIR =  .0, .227, .214, .193, .208, .244, .177, .218, .213, .252, .265, .272, .244 
+
+# ISO_ACTIVITY ([-]) :  Biogenic activity for each age class : isoprene 	{CHEMISTRY_BVOC}
+ISO_ACTIVITY =  0.5, 1.5, 1.5, 0.5 
+
+# METHANOL_ACTIVITY ([-]) :  Isoprene emission factor for each age class : methanol 	{CHEMISTRY_BVOC}
+METHANOL_ACTIVITY =  1., 1., 0.5, 0.5 
+
+# EM_FACTOR_ISOPRENE ([ugC/g/h] ) :  Isoprene emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_ISOPRENE =  0., 24., 24., 8., 16., 45., 8., 18., 0.5, 12., 18., 5., 5. 
+
+# EM_FACTOR_MONOTERPENE ([ugC/g/h] ) :  Monoterpene emission factor  	{CHEMISTRY_BVOC }
+EM_FACTOR_MONOTERPENE =  0., 2.0, 2.0, 1.8, 1.4, 1.6, 1.8, 1.4, 1.8, 0.8, 0.8,  0.22, 0.22 
+
+# C_LDF_MONO  ([]) :  Monoterpenes fraction dependancy to light 	{CHEMISTRY_BVOC}
+C_LDF_MONO  =  0.6 
+
+# C_LDF_SESQ  ([]) :  Sesquiterpenes fraction dependancy to light 	{CHEMISTRY_BVOC}
+C_LDF_SESQ  =  0.5 
+
+# C_LDF_METH  ([]) :  Methanol fraction dependancy to light 	{CHEMISTRY_BVOC}
+C_LDF_METH  =  0.8 
+
+# C_LDF_ACET  ([]) :  Acetone fraction dependancy to light 	{CHEMISTRY_BVOC}
+C_LDF_ACET  =  0.2 
+
+# EM_FACTOR_APINENE  ([ugC/g/h] ) :  Alfa pinene  emission factor  	{CHEMISTRY_BVOC }
+EM_FACTOR_APINENE  =  0., 1.35, 1.35, 0.85, 0.95, 0.75, 0.85, 0.60, 1.98, 0.30, 0.30, 0.09, 0.09 
+
+# EM_FACTOR_BPINENE ([ugC/g/h] ) :  Beta pinene  emission factor 	{CHEMISTRY_BVOC }
+EM_FACTOR_BPINENE =  0., 0.30, 0.30, 0.35, 0.25, 0.20, 0.35, 0.12, 0.45, 0.16, 0.12, 0.05, 0.05 
+
+# EM_FACTOR_LIMONENE ([ugC/g/h] ) :  Limonene  emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_LIMONENE =  0., 0.25, 0.25, 0.20, 0.25, 0.14, 0.20, 0.135, 0.11, 0.19, 0.42, 0.03, 0.03 
+
+# EM_FACTOR_MYRCENE ([ugC/g/h] ) :  Myrcene  emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_MYRCENE =  0., 0.20, 0.20, 0.12, 0.11, 0.065, 0.12, 0.036, 0.075, 0.08,  0.085, 0.015, 0.015 
+
+# EM_FACTOR_SABINENE ([ugC/g/h] ) :  Sabinene  emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_SABINENE =  0., 0.20, 0.20, 0.12, 0.17, 0.70, 0.12, 0.50, 0.09, 0.085, 0.075, 0.02, 0.02 
+
+# EM_FACTOR_CAMPHENE  ([ugC/g/h] ) :  Camphene  emission factor  	{CHEMISTRY_BVOC}
+EM_FACTOR_CAMPHENE  =  0., 0.15, 0.15, 0.10, 0.10, 0.01, 0.10, 0.01, 0.07, 0.07, 0.08, 0.01, 0.01 
+
+# EM_FACTOR_3CARENE  ([ugC/g/h] ) :  3-Carene  emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_3CARENE  =  0., 0.13, 0.13, 0.42, 0.02, 0.055, 0.42,0.025, 0.125, 0.085, 0.085, 0.065, 0.065 
+
+# EM_FACTOR_TBOCIMENE ([ugC/g/h] ) :  T-beta-ocimene  emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_TBOCIMENE =  0., 0.25, 0.25, 0.13, 0.09, 0.26, 0.13, 0.20, 0.085, 0.18, 0.18, 0.01, 0.01 
+
+# EM_FACTOR_OTHERMONOT ([ugC/g/h] ) :  Other monoterpenes  emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_OTHERMONOT =  0., 0.17, 0.17, 0.11, 0.11, 0.125, 0.11, 0.274, 0.01, 0.15, 0.155, 0.035, 0.035 
+
+# EM_FACTOR_SESQUITERP  ([ugC/g/h] ) :  Sesquiterpenes  emission factor  	{CHEMISTRY_BVOC}
+EM_FACTOR_SESQUITERP  =  0., 0.45, 0.45, 0.13, 0.3, 0.36, 0.15, 0.3, 0.25, 0.6, 0.6, 0.08, 0.08 
+
+# C_BETA_MONO  ([]) :  Monoterpenes temperature dependency coefficient 	{CHEMISTRY_BVOC}
+C_BETA_MONO  =  0.1 
+
+# C_BETA_SESQ  ([]) :  Sesquiterpenes temperature dependency coefficient 	{CHEMISTRY_BVOC}
+C_BETA_SESQ  =  0.17 
+
+# C_BETA_METH  ([]) :  Methanol temperature dependency coefficient 	{CHEMISTRY_BVOC}
+C_BETA_METH  =  0.08 
+
+# C_BETA_ACET  ([]) :  Acetone temperature dependency coefficient 	{CHEMISTRY_BVOC}
+C_BETA_ACET  =  0.1 
+
+# C_BETA_OXYVOC  ([]) :  Other oxygenated BVOC temperature dependency coefficient 	{CHEMISTRY_BVOC}
+C_BETA_OXYVOC  =  0.13 
+
+# EM_FACTOR_ORVOC ([ugC/g/h]  ) :  ORVOC emissions factor  	{CHEMISTRY_BVOC }
+EM_FACTOR_ORVOC =  0., 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5 
+
+# EM_FACTOR_OVOC ([ugC/g/h]        ) :  OVOC emissions factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_OVOC =  0., 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5 
+
+# EM_FACTOR_MBO ([ugC/g/h]  ) :  MBO emissions factor  	{CHEMISTRY_BVOC }
+EM_FACTOR_MBO =  0., 2.e-5, 2.e-5, 1.4, 2.e-5, 2.e-5, 0.14, 2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5 
+
+# EM_FACTOR_METHANOL ([ugC/g/h]  ) :  Methanol emissions factor  	{CHEMISTRY_BVOC }
+EM_FACTOR_METHANOL =  0., 0.8, 0.8, 1.8, 0.9, 1.9, 1.8, 1.8, 1.8, 0.7, 0.9, 2., 2. 
+
+# EM_FACTOR_ACETONE ([ugC/g/h]     ) :  Acetone emissions factor 	{CHEMISTRY_BVOC }
+EM_FACTOR_ACETONE =  0., 0.25, 0.25, 0.3, 0.2, 0.33, 0.3, 0.25, 0.25, 0.2, 0.2, 0.08, 0.08 
+
+# EM_FACTOR_ACETAL ([ugC/g/h]  ) :  Acetaldehyde emissions factor  	{CHEMISTRY_BVOC}
+EM_FACTOR_ACETAL =  0., 0.2, 0.2, 0.2, 0.2, 0.25, 0.25, 0.16, 0.16, 0.12, 0.12, 0.035, 0.02 
+
+# EM_FACTOR_FORMAL ([ugC/g/h]  ) :  Formaldehyde emissions factor 	{CHEMISTRY_BVOC }
+EM_FACTOR_FORMAL =  0., 0.04, 0.04, 0.08, 0.04, 0.04, 0.04, 0.04, 0.04, 0.025, 0.025, 0.013, 0.013 
+
+# EM_FACTOR_ACETIC ([ugC/g/h]  ) :  Acetic Acid emissions factor 	{CHEMISTRY_BVOC }
+EM_FACTOR_ACETIC =  0., 0.025, 0.025,0.025,0.022,0.08,0.025,0.022,0.013,0.012,0.012,0.008,0.008 
+
+# EM_FACTOR_FORMIC ([ugC/g/h]  ) :  Formic Acid emissions factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_FORMIC =  0., 0.015, 0.015, 0.02, 0.02, 0.025, 0.025, 0.015, 0.015,0.010,0.010,0.008,0.008 
+
+# EM_FACTOR_NO_WET ([ngN/m^2/s]) :  NOx emissions factor wet soil emissions and exponential dependancy factor  	{CHEMISTRY_BVOC}
+EM_FACTOR_NO_WET =  0., 2.6, 0.06, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.36, 0.36, 0.36, 0.36 
+
+# EM_FACTOR_NO_DRY ([ngN/m^2/s] ) :  NOx emissions factor dry soil emissions and exponential dependancy factor  	{CHEMISTRY_BVOC}
+EM_FACTOR_NO_DRY =  0., 8.60, 0.40, 0.22, 0.22, 0.22, 0.22, 0.22, 0.22, 2.65, 2.65, 2.65, 2.65 
+
+# LARCH ([-]  ) :  Larcher 1991 SAI/LAI ratio 	{CHEMISTRY_BVOC }
+LARCH =  0., 0.015, 0.015, 0.003, 0.005, 0.005, 0.003, 0.005, 0.003, 0.005, 0.005, 0.008, 0.008 
+
+# SLA ([m^2/gC]) :  specif leaf area  	{OK_STOMATE}
+SLA =  1.5E-2, 1.53E-2, 2.6E-2, 9.26E-3, 2E-2, 2.6E-2, 9.26E-3, 2.6E-2, 1.9E-2, 2.6E-2, 2.6E-2, 2.6E-2, 2.6E-2 
+
+# AVAILABILITY_FACT  ([-]   ) :  Calculate dynamic mortality in lpj_gap, pft dependent parameter 	{OK_STOMATE }
+AVAILABILITY_FACT  =  -9999., 0.14, 0.14, 0.10, 0.10, 0.10, 0.05, 0.05, 0.05, -9999., -9999., -9999., -9999.  
+
+# R0  ([-]    ) :  Standard root allocation  	{OK_STOMATE }
+R0  =  -9999., .30, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30 
+
+# S0  ([-]    ) :  Standard sapwood allocation  	{OK_STOMATE }
+S0  =  -9999., .25, .25, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30 
+
+# FRAC_GROWTHRESP ([-]) :  fraction of GPP which is lost as growth respiration 	{OK_STOMATE}
+FRAC_GROWTHRESP =  -9999., .28, .28, .28, .28, .28, .28, .28, .28, .28, .28, .28, .28  
+
+# MAINT_RESP_SLOPE_C ([-]) :  slope of maintenance respiration coefficient (1/K), constant c of aT^2+bT+c , tabulated 	{OK_STOMATE}
+MAINT_RESP_SLOPE_C =  -9999., .20, .20, .16, .16, .16, .16, .16, .16, .16, .12, .16, .12  
+
+# MAINT_RESP_SLOPE_B ([-]) :  slope of maintenance respiration coefficient (1/K), constant b of aT^2+bT+c , tabulated 	{OK_STOMATE}
+MAINT_RESP_SLOPE_B =  -9999., .0, .0, .0, .0, .0, .0, .0, .0, -.00133, .0, -.00133, .0  
+
+# MAINT_RESP_SLOPE_A ([-]) :  slope of maintenance respiration coefficient (1/K), constant a of aT^2+bT+c , tabulated 	{OK_STOMATE}
+MAINT_RESP_SLOPE_A =  -9999., .0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0     
+
+# CM_ZERO_LEAF ([g/g/day]) :  maintenance respiration coefficient at 0 deg C, for leaves, tabulated 	{OK_STOMATE}
+CM_ZERO_LEAF =  -9999., 2.35E-3, 2.62E-3, 1.01E-3, 2.35E-3, 2.62E-3, 1.01E-3,2.62E-3, 2.05E-3, 2.62E-3, 2.62E-3, 2.62E-3, 2.62E-3 
+
+# CM_ZERO_SAPABOVE ([g/g/day]) :  maintenance respiration coefficient at 0 deg C,for sapwood above, tabulated 	{OK_STOMATE}
+CM_ZERO_SAPABOVE =  -9999., 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4 
+
+# CM_ZERO_SAPBELOW ([g/g/day]) :  maintenance respiration coefficient at 0 deg C, for sapwood below, tabulated 	{OK_STOMATE}
+CM_ZERO_SAPBELOW =  -9999., 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4  
+
+# CM_ZERO_HEARTABOVE ([g/g/day]) :  maintenance respiration coefficient at 0 deg C, for heartwood above, tabulated 	{OK_STOMATE }
+CM_ZERO_HEARTABOVE =  -9999., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.  
+
+# CM_ZERO_HEARTBELOW ([g/g/day] ) :  maintenance respiration coefficient at 0 deg C,for heartwood below, tabulated 	{OK_STOMATE }
+CM_ZERO_HEARTBELOW =  -9999., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.  
+
+# CM_ZERO_ROOT ([g/g/day] ) :  maintenance respiration coefficient at 0 deg C, for roots, tabulated 	{OK_STOMATE}
+CM_ZERO_ROOT =  -9999.,1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3,1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3 
+
+# CM_ZERO_FRUIT ([g/g/day] ) :  maintenance respiration coefficient at 0 deg C, for fruits, tabulated 	{OK_STOMATE}
+CM_ZERO_FRUIT =  -9999., 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4,1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4     
+
+# CM_ZERO_CARBRES ([g/g/day] ) :  maintenance respiration coefficient at 0 deg C, for carbohydrate reserve, tabulated 	{OK_STOMATE}
+CM_ZERO_CARBRES =  -9999., 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4,1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4 
+
+# FLAM ([-]) :  flamability: critical fraction of water holding capacity 	{OK_STOMATE}
+FLAM =  -9999., .15, .25, .25, .25, .25, .25, .25, .25, .25, .25, .35, .35 
+
+# RESIST ([-]) :  fire resistance 	{OK_STOMATE}
+RESIST =  -9999., .95, .90, .12, .50, .12, .12, .12, .12, .0, .0, .0, .0  
+
+# COEFF_LCCHANGE_1 ([-]) :  Coeff of biomass export for the year 	{OK_STOMATE}
+COEFF_LCCHANGE_1 =  -9999., 0.897, 0.897, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597  
+
+# COEFF_LCCHANGE_10 ([-]) :  Coeff of biomass export for the decade 	{OK_STOMATE}
+COEFF_LCCHANGE_10 =  -9999., 0.103, 0.103, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.403, 0.299, 0.403 
+
+# COEFF_LCCHANGE_100 ([-]) :  Coeff of biomass export for the century 	{OK_STOMATE}
+COEFF_LCCHANGE_100 =  -9999., 0., 0., 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0., 0.104, 0. 
+
+# LAI_MAX_TO_HAPPY ([-]) :  threshold of LAI below which plant uses carbohydrate reserves 	{OK_STOMATE}
+LAI_MAX_TO_HAPPY =  -9999., .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5  
+
+# LAI_MAX ([m^2/m^2]) :  maximum LAI, PFT-specific 	{OK_STOMATE}
+LAI_MAX =  -9999., 7., 7., 5., 5., 5., 4.5, 4.5, 3.0, 2.5, 2.5, 5.,5.  
+
+# PHENO_TYPE ([-]) :  type of phenology, 0 	{OK_STOMATE}
+PHENO_TYPE =  0, 1, 3, 1, 1, 2, 1, 2, 2, 4, 4, 2, 3 
+
+# PHENO_GDD_CRIT_C ([-]) :  critical gdd, tabulated (C), constant c of aT^2+bT+c 	{OK_STOMATE}
+PHENO_GDD_CRIT_C =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 270., 400., 125., 400. 
+
+# PHENO_GDD_CRIT_B ([-]) :  critical gdd, tabulated (C), constant b of aT^2+bT+c 	{OK_STOMATE}
+PHENO_GDD_CRIT_B =  -9999., -9999., -9999., -9999., -9999., -9999., -9999.,-9999., -9999., 6.25, 0., 0., 0. 
+
+# PHENO_GDD_CRIT_A ([-]) :  critical gdd, tabulated (C), constant a of aT^2+bT+c 	{OK_STOMATE}
+PHENO_GDD_CRIT_A =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0.03125,  0., 0., 0. 
+
+# PHENO_MOIGDD_T_CRIT ([C]) :  Average temperature threashold for C4 grass used in pheno_moigdd 	{OK_STOMATE}
+PHENO_MOIGDD_T_CRIT =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 22.0, -9999., -9999. 
+
+# NGD_CRIT ([days]) :  critical ngd, tabulated. Threshold -5 degrees 	{OK_STOMATE}
+NGD_CRIT =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0., -9999., -9999., -9999., -9999., -9999. 
+
+# NCDGDD_TEMP ([C] ) :  critical temperature for the ncd vs. gdd function in phenology 	{OK_STOMATE}
+NCDGDD_TEMP =  -9999., -9999., -9999., -9999., -9999., 5., -9999., 0., -9999., -9999., -9999., -9999., -9999. 
+
+# HUM_FRAC ([%]) :  critical humidity (relative to min/max) for phenology 	{OK_STOMATE}
+HUM_FRAC =  -9999., -9999., .5, -9999., -9999., -9999., -9999., -9999.,  -9999., .5, .5, .5,.5      
+
+# HUM_MIN_TIME ([days]) :  minimum time elapsed since moisture minimum 	{OK_STOMATE}
+HUM_MIN_TIME =  -9999., -9999., 50., -9999., -9999., -9999., -9999., -9999., -9999., 35., 35., 75., 75. 
+
+# TAU_SAP ([days]) :  sapwood -> heartwood conversion time 	{OK_STOMATE}
+TAU_SAP =  -9999., 730., 730., 730., 730., 730., 730., 730., 730., -9999., -9999., -9999., -9999. 
+
+# TAU_LEAFINIT ([days]) :  time to attain the initial foliage using the carbohydrate reserve 	{OK_STOMATE}
+TAU_LEAFINIT =  -9999., 10., 10., 10., 10., 10., 10., 10., 10., 10., 10., 10., 10. 
+
+# TAU_FRUIT ([days]) :  fruit lifetime 	{OK_STOMATE}
+TAU_FRUIT =  -9999., 90., 90., 90., 90., 90., 90., 90., 90., -9999., -9999., -9999., -9999. 
+
+# ECUREUIL ([-]) :  fraction of primary leaf and root allocation put into reserve 	{OK_STOMATE}
+ECUREUIL =  -9999., .0, 1., .0, .0, 1., .0, 1., 1., 1., 1., 1., 1. 
+
+# ALLOC_MIN ([-]) :  minimum allocation above/below  	{OK_STOMATE}
+ALLOC_MIN =  -9999., 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, -9999., -9999., -9999., -9999.  
+
+# ALLOC_MAX ([-]) :  maximum allocation above/below  	{OK_STOMATE}
+ALLOC_MAX =  -9999., 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, -9999., -9999., -9999., -9999. 
+
+# DEMI_ALLOC  ([-]) :  mean allocation above/below  	{OK_STOMATE}
+DEMI_ALLOC  =  -9999., 5., 5., 5., 5., 5., 5., 5., 5., -9999., -9999., -9999., -9999. 
+
+# LEAFLIFE_TAB ([years]) :  leaf longevity 	{OK_STOMATE}
+LEAFLIFE_TAB =  -9999., .5, 2., .33, 1., 2., .33, 2., 2., 2., 2., 2., 2.  
+
+# LEAFFALL ([days]) :  length of death of leaves, tabulated  	{OK_STOMATE}
+LEAFFALL =  -9999., -9999., 10., -9999., -9999., 10., -9999., 10., 10., 10., 10., 10., 10.  
+
+# LEAFAGECRIT ([days]) :  critical leaf age, tabulated 	{OK_STOMATE}
+LEAFAGECRIT =  -9999., 730., 180., 910., 730., 180., 910., 180., 180., 120., 120., 90., 90.   
+
+# SENESCENCE_TYPE ([-]) :  type of senescence, tabulated 	{OK_STOMATE}
+SENESCENCE_TYPE =  none, none, dry, none, none, cold, none, cold, cold, mixed, mixed, mixed, mixed  
+
+# SENESCENCE_HUM ([-] ) :  critical relative moisture availability for senescence 	{OK_STOMATE}
+SENESCENCE_HUM =  -9999., -9999., .3, -9999., -9999., -9999., -9999., -9999., -9999., .2, .2, .3, .2  
+
+# NOSENESCENCE_HUM ([-]) :  relative moisture availability above which there is no humidity-related senescence 	{OK_STOMATE}
+NOSENESCENCE_HUM =  -9999., -9999., .8, -9999., -9999., -9999., -9999., -9999., -9999., .3, .3, .3, .3  
+
+# MAX_TURNOVER_TIME ([days]) :  maximum turnover time for grasse 	{OK_STOMATE}
+MAX_TURNOVER_TIME =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999.,  80.,  80., 80., 80.  
+
+# MIN_TURNOVER_TIME ([days]) :  minimum turnover time for grasse  	{OK_STOMATE}
+MIN_TURNOVER_TIME =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 10., 10., 10., 10.  
+
+# MIN_LEAF_AGE_FOR_SENESCENCE ([days] ) :  minimum leaf age to allow senescence g 	{OK_STOMATE}
+MIN_LEAF_AGE_FOR_SENESCENCE =  -9999., -9999., 90., -9999., -9999., 90., -9999., 60., 60., 30., 30., 30., 30. 
+
+# SENESCENCE_TEMP_C ([-]) :  critical temperature for senescence (C), constant c of aT^2+bT+c, tabulated 	{OK_STOMATE}
+SENESCENCE_TEMP_C =  -9999., -9999., -9999., -9999., -9999., 12., -9999., 7., 2., -1.375, 5., 5., 10. 
+
+# SENESCENCE_TEMP_B ([-]) :  critical temperature for senescence (C), constant b of aT^2+bT+c ,tabulated 	{OK_STOMATE }
+SENESCENCE_TEMP_B =  -9999., -9999., -9999., -9999., -9999., 0., -9999., 0., 0., .1, 0., 0., 0. 
+
+# SENESCENCE_TEMP_A ([-] ) :  critical temperature for senescence (C), constant a of aT^2+bT+c , tabulated 	{OK_STOMATE}
+SENESCENCE_TEMP_A =  -9999., -9999., -9999., -9999., -9999., 0., -9999., 0., 0.,.00375, 0., 0., 0.  
+
+# GDD_SENESCENCE ([days] ) :  minimum gdd to allow senescence of crops   	{OK_STOMATE}
+GDD_SENESCENCE =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 950., 4000. 
+
+# RESIDENCE_TIME ([years]) :  residence time of trees 	{OK_DGVM and NOT(LPJ_GAP_CONST_MORT)}
+RESIDENCE_TIME =  -9999., 30.0, 30.0, 40.0, 40.0, 40.0, 80.0, 80.0, 80.0, 0.0, 0.0, 0.0, 0.0  
+
+# TMIN_CRIT ([C]) :  critical tmin, tabulated 	{OK_STOMATE}
+TMIN_CRIT =  -9999.,  0.0, 0.0, -30.0, -14.0, -30.0, -45.0, -45.0, -9999., -9999., -9999., -9999., -9999. 
+
+# TCM_CRIT ([C]) :  critical tcm, tabulated  	{OK_STOMATE}
+TCM_CRIT =  -9999., -9999., -9999., 5.0, 15.5, 15.5, -8.0, -8.0, -8.0, -9999., -9999., -9999., -9999. 
+
+# HERBIVORES ([FLAG]) :  herbivores allowed? 	{OK_STOMATE }
+HERBIVORES =  n 
+
+# TREAT_EXPANSION ([FLAG]) :  treat expansion of PFTs across a grid cell? 	{OK_STOMATE }
+TREAT_EXPANSION =  n 
+
+# LPJ_GAP_CONST_MORT ([FLAG]) :  Constant mortality 	{OK_STOMATE AND NOT OK_DGVM}
+LPJ_GAP_CONST_MORT =  y/n depending on OK_DGVM 
+
+# HARVEST_AGRI ([FLAG]) :  Harvest model for agricultural PFTs. 	{OK_STOMATE }
+HARVEST_AGRI =  y 
+
+# FIRE_DISABLE ([FLAG]) :  no fire allowed 	{OK_STOMATE }
+FIRE_DISABLE =  n 
+
+# SPINUP_ANALYTIC (BOOLEAN    ) :  Activation of the analytic resolution of the spinup. 	{OK_STOMATE}
+SPINUP_ANALYTIC =  n 
+
+# AGRICULTURE ([FLAG]) :  agriculture allowed? 	{OK_SECHIBA or OK_STOMATE}
+AGRICULTURE =  y 
+
+# IMPOSE_VEG ([FLAG]) :  Should the vegetation be prescribed ? 	{OK_SECHIBA or OK_STOMATE}
+IMPOSE_VEG =  n 
+
+# IMPOSE_SOILT ([FLAG]) :  Should the soil type be prescribed ? 	{IMPOSE_VEG}
+IMPOSE_SOILT =  n 
+
+# LAI_MAP ([FLAG]) :  Read the LAI map 	{OK_SECHIBA or OK_STOMATE}
+LAI_MAP =  n 
+
+# MAP_PFT_FORMAT ([FLAG]) :  Read a land use vegetation map on PFT format 	{OK_SECHIBA or OK_STOMATE}
+MAP_PFT_FORMAT =  y 
+
+# VEGET_REINIT ([FLAG] ) :  booleen to indicate that a new LAND USE file will be used. 	{MAP_PFT_FORMAT}
+VEGET_REINIT =  y 
+
+# VEGET_YEAR ([FLAG] ) :  Year of the vegetation map to be read 	{MAP_PFT_FORMAT}
+VEGET_YEAR =  1 
+
+# MAXMASS_SNOW ([kg/m^2]  ) :  The maximum mass of a snow 	{OK_SECHIBA or HYDROL_CWRR}
+MAXMASS_SNOW =  3000. 
+
+# SNOWCRI ([kg/m^2]  ) :  Sets the amount above which only sublimation occures  	{OK_SECHIBA or HYDROL_CWRR}
+SNOWCRI =  1.5 
+
+# MIN_WIND ([m/s]) :  Minimum wind speed 	{OK_SECHIBA}
+MIN_WIND =  0.1 
+
+# MAX_SNOW_AGE ([days?]) :  Maximum period of snow aging  	{OK_SECHIBA}
+MAX_SNOW_AGE =  50. 
+
+# SNOW_TRANS ([m]   ) :  Transformation time constant for snow 	{OK_SECHIBA}
+SNOW_TRANS =  0.2 
+
+# HEIGHT_DISPLACEMENT ([m]  ) :  Magic number which relates the height to the displacement height. 	{OK_SECHIBA }
+HEIGHT_DISPLACEMENT =  0.75 
+
+# Z0_BARE ([m]   ) :  bare soil roughness length 	{OK_SECHIBA }
+Z0_BARE =  0.01  
+
+# Z0_ICE ([m]   ) :  ice roughness length 	{OK_SECHIBA }
+Z0_ICE =  0.001 
+
+# TCST_SNOWA ([days]) :  Time constant of the albedo decay of snow 	{OK_SECHIBA }
+TCST_SNOWA =  10.0  
+
+# SNOWCRI_ALB ([cm]  ) :  Critical value for computation of snow albedo 	{OK_SECHIBA}
+SNOWCRI_ALB =  10.  
+
+# VIS_DRY ([-]  ) :  The correspondance table for the soil color numbers and their albedo  	{OK_SECHIBA }
+VIS_DRY =  0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.27 
+
+# NIR_DRY ([-]   ) :  The correspondance table for the soil color numbers and their albedo  	{OK_SECHIBA }
+NIR_DRY =  0.48, 0.44, 0.40, 0.36, 0.32, 0.28, 0.24, 0.20, 0.55 
+
+# VIS_WET  ([-]   ) :  The correspondance table for the soil color numbers and their albedo 	{OK_SECHIBA  }
+VIS_WET  =  0.12, 0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05, 0.15 
+
+# NIR_WET ([-]    ) :  The correspondance table for the soil color numbers and their albedo  	{OK_SECHIBA }
+NIR_WET =  0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.31 
+
+# ALBSOIL_VIS ([-]  ) :   	{OK_SECHIBA }
+ALBSOIL_VIS =  0.18, 0.16, 0.16, 0.15, 0.12, 0.105, 0.09, 0.075, 0.25 
+
+# ALBSOIL_NIR  ([-]  ) :   	{OK_SECHIBA }
+ALBSOIL_NIR  =  0.36, 0.34, 0.34, 0.33, 0.30, 0.25, 0.20, 0.15, 0.45 
+
+# ALB_DEADLEAF  ([-]     ) :  albedo of dead leaves, VIS+NIR  	{OK_SECHIBA }
+ALB_DEADLEAF  =  0.12, 0.35 
+
+# ALB_ICE ([-]  ) :  albedo of ice, VIS+NIR 	{OK_SECHIBA}
+ALB_ICE =  0.60, 0.20 
+
+# CONDVEG_SNOWA ([-]) :  The snow albedo used by SECHIBA 	{OK_SECHIBA}
+CONDVEG_SNOWA =  1.E+20 
+
+# ALB_BARE_MODEL ([FLAG]) :  Switch bare soil albedo dependent (if TRUE) on soil wetness 	{OK_SECHIBA}
+ALB_BARE_MODEL =  n 
+
+# ALB_BG_MODIS ([FLAG]) :  Read bare soil albedo from file with background MODIS data 	{OK_SECHIBA}
+ALB_BG_MODIS =  n 
+
+# IMPOSE_AZE ([FLAG]) :  Should the surface parameters be prescribed 	{OK_SECHIBA}
+IMPOSE_AZE =  n 
+
+# CONDVEG_Z0 ([m]) :  Surface roughness 	{IMPOSE_AZE}
+CONDVEG_Z0 =  0.15 
+
+# ROUGHHEIGHT ([m] ) :  Height to be added to the height of the first level 	{IMPOSE_AZE}
+ROUGHHEIGHT =  0.0 
+
+# CONDVEG_ALBVIS ([-]) :  SW visible albedo for the surface 	{IMPOSE_AZE}
+CONDVEG_ALBVIS =  0.25 
+
+# CONDVEG_ALBNIR ([-]  ) :  SW near infrared albedo for the surface 	{IMPOSE_AZE}
+CONDVEG_ALBNIR =  0.25 
+
+# CONDVEG_EMIS ([-] ) :  Emissivity of the surface for LW radiation 	{IMPOSE_AZE}
+CONDVEG_EMIS =  1.0 
+
+# ROUGH_DYN ([FLAG]) :  Account for a dynamic roughness height 	{OK_SECHIBA}
+ROUGH_DYN =  y 
+
+# C1 ([-] ) :  Constant used in the formulation of the ratio of  	{ROUGH_DYN}
+C1 =  0.32 
+
+# C2 ([-] ) :  Constant used in the formulation of the ratio of  	{ROUGH_DYN}
+C2 =  0.264 
+
+# C3 ([-] ) :  Constant used in the formulation of the ratio of  	{ROUGH_DYN}
+C3 =  15.1 
+
+# Cdrag_foliage ([-] ) :  Drag coefficient of the foliage 	{ROUGH_DYN}
+Cdrag_foliage =  0.2 
+
+# Ct ([-] ) :  Heat transfer coefficient of the leaf 	{ROUGH_DYN}
+Ct =  0.01 
+
+# Prandtl ([-] ) :  Prandtl number used in the calculation of Ct* 	{ROUGH_DYN}
+Prandtl =  0.71 
+
+# xansmax  ([-] ) :  maximum snow albedo 	{OK_SECHIBA}
+xansmax  =  0.85 
+
+# xansmin  ([-] ) :  minimum snow albedo 	{OK_SECHIBA}
+xansmin  =  0.50 
+
+# xans_todry  ([S-1] ) :  albedo decay rate for the dry snow  	{OK_SECHIBA}
+xans_todry  =  0.008 
+
+# xans_t  ([S-1] ) :  albedo decay rate for the wet snow  	{OK_SECHIBA}
+xans_t  =  0.24 
+
+# xrhosmax  ([-] ) :  maximum snow density  	{OK_SECHIBA}
+xrhosmax  =  750 
+
+# xwsnowholdmax1 ([-] ) :  snow holding capacity 1 	{OK_SECHIBA}
+xwsnowholdmax1 =  0.03 
+
+# xwsnowholdmax2 ([-] ) :  snow holding capacity 2 	{OK_SECHIBA}
+xwsnowholdmax2 =  0.10 
+
+# xsnowrhohold  ([kg/m3] ) :  snow density  	{OK_SECHIBA}
+xsnowrhohold  =  200.0 
+
+# ZSNOWTHRMCOND1 ([W/m/K] ) :  Thermal conductivity Coef 1 	{OK_SECHIBA}
+ZSNOWTHRMCOND1 =  0.02  
+
+# ZSNOWTHRMCOND2 ([W m5/(kg2 K)] ) :  Thermal conductivity Coef 2 	{OK_SECHIBA}
+ZSNOWTHRMCOND2 =  2.5E-6 
+
+# ZSNOWTHRMCOND_AVAP ([W/m/K] ) :  Thermal conductivity Coef 1 water vapor 	{OK_SECHIBA}
+ZSNOWTHRMCOND_AVAP =  -0.06023 
+
+# ZSNOWTHRMCOND_BVAP ([W/m] ) :  Thermal conductivity Coef 2 water vapor 	{OK_SECHIBA}
+ZSNOWTHRMCOND_BVAP =  -2.5425 
+
+# ZSNOWTHRMCOND_CVAP ([K] ) :  Thermal conductivity Coef 3 water vapor 	{OK_SECHIBA}
+ZSNOWTHRMCOND_CVAP =  -289.99 
+
+# ZSNOWCMPCT_RHOD ([kg/m3]) :  Snow compaction coefficent 	{OK_SECHIBA}
+ZSNOWCMPCT_RHOD =  150.0 
+
+# ZSNOWCMPCT_ACM ([1/s]) :  Coefficent for the thermal conductivity 	{OK_SECHIBA}
+ZSNOWCMPCT_ACM =  2.8e-6 
+
+# ZSNOWCMPCT_BCM ([1/K]) :  Coefficent for the thermal conductivity 	{OK_SECHIBA}
+ZSNOWCMPCT_BCM =  0.04 
+
+# ZSNOWCMPCT_CCM ([m3/kg] ) :  Coefficent for the thermal conductivity 	{OK_SECHIBA}
+ZSNOWCMPCT_CCM =  460. 
+
+# ZSNOWCMPCT_V0 ([Pa/s]) :  Vapor coefficent for the thermal conductivity 	{OK_SECHIBA}
+ZSNOWCMPCT_V0 =  3.7e7 
+
+# ZSNOWCMPCT_VT ([1/K]) :  Vapor coefficent for the thermal conductivity 	{OK_SECHIBA}
+ZSNOWCMPCT_VT =  0.081 
+
+# ZSNOWCMPCT_VR ([m3/kg]) :  Vapor coefficent for the thermal conductivity 	{OK_SECHIBA}
+ZSNOWCMPCT_VR =  0.018 
+
+# CB ([-] ) :  Constant of the Louis scheme  	{OK_SECHIBA}
+CB =  5.0 
+
+# CC ([-] ) :  Constant of the Louis scheme  	{OK_SECHIBA}
+CC =  5.0 
+
+# CD ([-] ) :  Constant of the Louis scheme  	{OK_SECHIBA}
+CD =  5.0 
+
+# RAYT_CSTE ([W.m^{-2}] ) :  Constant in the computation of surface resistance   	{OK_SECHIBA}
+RAYT_CSTE =  125 
+
+# DEFC_PLUS ([K.W^{-1}] ) :  Constant in the computation of surface resistance   	{OK_SECHIBA}
+DEFC_PLUS =  23.E-3 
+
+# DEFC_MULT ([K.W^{-1}] ) :  Constant in the computation of surface resistance   	{OK_SECHIBA}
+DEFC_MULT =  1.5 
+
+# NLAI ([-]  ) :  Number of LAI levels 	{OK_SECHIBA}
+NLAI =  20 
+
+# LAIMAX ([m^2/m^2]   ) :  Maximum LAI 	{OK_SECHIBA}
+LAIMAX =   
+
+# DEW_VEG_POLY_COEFF ([-]   ) :  coefficients of the polynome of degree 5 for the dew 	{OK_SECHIBA}
+DEW_VEG_POLY_COEFF =  0.887773, 0.205673, 0.110112, 0.014843, 0.000824, 0.000017  
+
+# DOWNREGULATION_CO2 ([FLAG]   ) :  Activation of CO2 downregulation 	{OK_SECHIBA}
+DOWNREGULATION_CO2 =  n  
+
+# DOWNREGULATION_CO2_BASELEVEL ([ppm]   ) :  CO2 base level 	{OK_SECHIBA }
+DOWNREGULATION_CO2_BASELEVEL =  280. 
+
+# GB_REF ([s m-1]   ) :  Leaf bulk boundary layer resistance    {OK_CO2}
+GB_REF =  1./25.
+
+# CLAYFRACTION_DEFAULT ([-]   ) :  default fraction of clay 	{OK_SECHIBA }
+CLAYFRACTION_DEFAULT =  0.2  
+
+# MIN_VEGFRAC  ([-]  ) :  Minimal fraction of mesh a vegetation type can occupy  	{OK_SECHIBA }
+MIN_VEGFRAC  =  0.001  
+
+# STEMPDIAG_BID  ([K]) :  only needed for an initial LAI if there is no restart file 	{OK_SECHIBA }
+STEMPDIAG_BID  =  280. 
+
+# LAI_LEVEL_DEPTH ([-]  ) :   	{OK_CO2}
+LAI_LEVEL_DEPTH =  0.15 
+
+# Oi ([ubar]  ) :  Intercellular oxygen partial pressure 	{OK_CO2}
+Oi =  210000. 
+
+# TOO_LONG  ([days]   ) :  longest sustainable time without regeneration (vernalization) 	{OK_STOMATE}
+TOO_LONG  =  5. 
+
+# TAU_FIRE  ([days]    ) :  Time scale for memory of the fire index (days). Validated for one year in the DGVM.  	{OK_STOMATE }
+TAU_FIRE  =  30. 
+
+# LITTER_CRIT ([gC/m^2]  ) :  Critical litter quantity for fire 	{OK_STOMATE }
+LITTER_CRIT =  200. 
+
+# FIRE_RESIST_STRUCT ([-]  ) :   	{OK_STOMATE }
+FIRE_RESIST_STRUCT =  0.5 
+
+# CO2FRAC ([-]  ) :  What fraction of a burned plant compartment goes into the atmosphere 	{OK_STOMATE }
+CO2FRAC =  0.95, 0.95, 0., 0.3, 0., 0., 0.95, 0.95 
+
+# BCFRAC_COEFF ([-]  ) :   	{OK_STOMATE }
+BCFRAC_COEFF =  0.3, 1.3, 88.2  
+
+# FIREFRAC_COEFF  ([-]   ) :   	{OK_STOMATE }
+FIREFRAC_COEFF  =  0.45, 0.8, 0.6, 0.13 
+
+# REF_GREFF ([1/year]  ) :  Asymptotic maximum mortality rate 	{OK_STOMATE }
+REF_GREFF =  0.035 
+
+# OK_MINRES ([FLAG]) :  Do we try to reach a minimum reservoir even if we are severely stressed? 	{OK_STOMATE }
+OK_MINRES =  y 
+
+# RESERVE_TIME_TREE  ([days]    ) :  maximum time during which reserve is used (trees)  	{OK_STOMATE }
+RESERVE_TIME_TREE  =  30. 
+
+# RESERVE_TIME_GRASS  ([days]   ) :  maximum time during which reserve is used (grasses)  	{OK_STOMATE }
+RESERVE_TIME_GRASS  =  20.  
+
+# F_FRUIT ([-]    ) :  Standard fruit allocation 	{OK_STOMATE }
+F_FRUIT =  0.1  
+
+# ALLOC_SAP_ABOVE_GRASS  ([-]   ) :  fraction of sapwood allocation above ground  	{OK_STOMATE }
+ALLOC_SAP_ABOVE_GRASS  =  1.0  
+
+# MIN_LTOLSR  ([-]   ) :  extrema of leaf allocation fraction  	{OK_STOMATE }
+MIN_LTOLSR  =  0.2 
+
+# MAX_LTOLSR ([-]   ) :  extrema of leaf allocation fraction 	{OK_STOMATE }
+MAX_LTOLSR =  0.5 
+
+# Z_NITROGEN ([m]  ) :  scaling depth for nitrogen limitation  	{OK_STOMATE}
+Z_NITROGEN =  0.2  
+
+# NLIM_TREF  ([C]  ) :   	{OK_STOMATE }
+NLIM_TREF  =  25.  
+
+# PIPE_TUNE1 ([-]    ) :  crown area  	{OK_STOMATE }
+PIPE_TUNE1 =  100.0 
+
+# PIPE_TUNE2  ([-]      ) :  height 	{OK_STOMATE }
+PIPE_TUNE2  =  40.0  
+
+# PIPE_TUNE3 ([-]    ) :  height 	{OK_STOMATE }
+PIPE_TUNE3 =  0.5  
+
+# PIPE_TUNE4 ([-]  ) :  needed for stem diameter 	{OK_STOMATE }
+PIPE_TUNE4 =  0.3  
+
+# PIPE_DENSITY  ([-]  ) :  Density 	{OK_STOMATE }
+PIPE_DENSITY  =  2.e5  
+
+# PIPE_K1  ([-]   ) :   	{OK_STOMATE }
+PIPE_K1  =  8.e3  
+
+# PIPE_TUNE_EXP_COEFF  ([-]   ) :  pipe tune exponential coeff  	{OK_STOMATE }
+PIPE_TUNE_EXP_COEFF  =  1.6  
+
+# PRECIP_CRIT  ([mm/year]  ) :  minimum precip 	{OK_STOMATE }
+PRECIP_CRIT  =  100. 
+
+# GDD_CRIT_ESTAB ([-]  ) :  minimum gdd for establishment of saplings 	{OK_STOMATE }
+GDD_CRIT_ESTAB =  150.  
+
+# FPC_CRIT ([-]  ) :  critical fpc, needed for light competition and establishment 	{OK_STOMATE }
+FPC_CRIT =  0.95 
+
+# ALPHA_GRASS ([-]   ) :  sapling characteristics : alpha's 	{OK_STOMATE }
+ALPHA_GRASS =  0.5 
+
+# ALPHA_TREE ([-]   ) :  sapling characteristics : alpha's  	{OK_STOMATE }
+ALPHA_TREE =  1. 
+
+# MASS_RATIO_HEART_SAP ([-]   ) :  mass ratio (heartwood+sapwood)/sapwood 	{OK_STOMATE }
+MASS_RATIO_HEART_SAP =  3. 
+
+# TAU_HUM_MONTH ([days]  ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_HUM_MONTH =  20.  
+
+# TAU_HUM_WEEK ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_HUM_WEEK =  7. 
+
+# TAU_T2M_MONTH ([days]     ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_T2M_MONTH =  20. 
+
+# TAU_T2M_WEEK ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_T2M_WEEK =  7. 
+
+# TAU_TSOIL_MONTH  ([days]     ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_TSOIL_MONTH  =  20.  
+
+# TAU_SOILHUM_MONTH ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_SOILHUM_MONTH =  20.  
+
+# TAU_GPP_WEEK  ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_GPP_WEEK  =  7.  
+
+# TAU_GDD ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_GDD =  40.  
+
+# TAU_NGD ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_NGD =  50. 
+
+# COEFF_TAU_LONGTERM ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+COEFF_TAU_LONGTERM =  3.  
+
+# BM_SAPL_CARBRES  ([-]   ) :   	{OK_STOMATE }
+BM_SAPL_CARBRES  =  5.  
+
+# BM_SAPL_SAPABOVE ([-]    ) :   	{OK_STOMATE}
+BM_SAPL_SAPABOVE =  0.5  
+
+# BM_SAPL_HEARTABOVE  ([-]    ) :   	{OK_STOMATE }
+BM_SAPL_HEARTABOVE  =  2. 
+
+# BM_SAPL_HEARTBELOW  ([-]    ) :   	{OK_STOMATE }
+BM_SAPL_HEARTBELOW  =  2.  
+
+# INIT_SAPL_MASS_LEAF_NAT ([-]    ) :   	{OK_STOMATE }
+INIT_SAPL_MASS_LEAF_NAT =  0.1  
+
+# INIT_SAPL_MASS_LEAF_AGRI ([-]    ) :   	{OK_STOMATE }
+INIT_SAPL_MASS_LEAF_AGRI =  1.  
+
+# INIT_SAPL_MASS_CARBRES ([-]    ) :   	{OK_STOMATE }
+INIT_SAPL_MASS_CARBRES =  5.  
+
+# INIT_SAPL_MASS_ROOT ([-]   ) :   	{OK_STOMATE }
+INIT_SAPL_MASS_ROOT =  0.1  
+
+# INIT_SAPL_MASS_FRUIT ([-]    ) :   	{OK_STOMATE }
+INIT_SAPL_MASS_FRUIT =  0.3  
+
+# CN_SAPL_INIT  ([-]   ) :   	{OK_STOMATE }
+CN_SAPL_INIT  =  0.5  
+
+# MIGRATE_TREE  ([m/year]   ) :   	{OK_STOMATE }
+MIGRATE_TREE  =  10000. 
+
+# MIGRATE_GRASS ([m/year]   ) :   	{OK_STOMATE }
+MIGRATE_GRASS =  10000. 
+
+# LAI_INITMIN_TREE ([m^2/m^2]  ) :   	{OK_STOMATE }
+LAI_INITMIN_TREE =  0.3 
+
+# LAI_INITMIN_GRASS  ([m^2/m^2]    ) :   	{OK_STOMATE }
+LAI_INITMIN_GRASS  =  0.1 
+
+# DIA_COEFF ([-]   ) :   	{OK_STOMATE }
+DIA_COEFF =  4., 0.5 
+
+# MAXDIA_COEFF ([-]   ) :   	{OK_STOMATE }
+MAXDIA_COEFF =  100., 0.01  
+
+# BM_SAPL_LEAF ([-]  ) :   	{OK_STOMATE }
+BM_SAPL_LEAF =  4., 4., 0.8, 5.  
+
+# METABOLIC_REF_FRAC ([-]) :  	{OK_STOMATE }
+METABOLIC_REF_FRAC =  0.85   
+
+# Z_DECOMP ([m]   ) :  scaling depth for soil activity 	{OK_STOMATE }
+Z_DECOMP =  0.2 
+
+# CN ([-]  ) :  C/N ratio 	{OK_STOMATE }
+CN =  40., 40., 40., 40., 40., 40., 40., 40. 
+
+# LC  ([-]   ) :  Lignine/C ratio of the different plant parts 	{OK_STOMATE }
+LC  =  0.22, 0.35, 0.35, 0.35, 0.35, 0.22, 0.22, 0.22 
+
+# FRAC_SOIL_STRUCT_AA ([-]) :  frac_soil(istructural,iactive,iabove) 	{OK_STOMATE }
+FRAC_SOIL_STRUCT_AA =  0.55 
+
+# FRAC_SOIL_STRUCT_A  ([-]) :  frac_soil(istructural,iactive,ibelow) 	{OK_STOMATE }
+FRAC_SOIL_STRUCT_A  =  0.45 
+
+# FRAC_SOIL_STRUCT_SA ([-]   ) :  frac_soil(istructural,islow,iabove) 	{OK_STOMATE}
+FRAC_SOIL_STRUCT_SA =  0.7   
+
+# FRAC_SOIL_STRUCT_SB ([-]   ) :  frac_soil(istructural,islow,ibelow)  	{OK_STOMATE }
+FRAC_SOIL_STRUCT_SB =  0.7   
+
+# FRAC_SOIL_METAB_AA  ([-]   ) :  frac_soil(imetabolic,iactive,iabove)  	{OK_STOMATE }
+FRAC_SOIL_METAB_AA  =  0.45  
+
+# FRAC_SOIL_METAB_AB  ([-]   ) :  frac_soil(imetabolic,iactive,ibelow) 	{OK_STOMATE }
+FRAC_SOIL_METAB_AB  =  0.45   
+
+# METABOLIC_LN_RATIO ([-]   ) :   	{OK_STOMATE }
+METABOLIC_LN_RATIO =  0.018   
+
+# TAU_METABOLIC ([days] ) :   	{OK_STOMATE }
+TAU_METABOLIC =  0.066 
+
+# TAU_STRUCT  ([days]) :   	{OK_STOMATE }
+TAU_STRUCT  =  0.245  
+
+# SOIL_Q10 ([-]) :   	{OK_STOMATE }
+SOIL_Q10 =  0.69 ( 
+
+# TSOIL_REF ([C]   ) :   	{OK_STOMATE }
+TSOIL_REF =  30.  
+
+# LITTER_STRUCT_COEF  ([-]   ) :   	{OK_STOMATE }
+LITTER_STRUCT_COEF  =  3.  
+
+# MOIST_COEFF ([-]   ) :   	{OK_STOMATE }
+MOIST_COEFF =  1.1, 2.4, 0.29 
+
+# MOISTCONT_MIN ([-]) :  minimum soil wetness to limit the heterotrophic respiration 	{OK_STOMATE }
+MOISTCONT_MIN =  0.25 
+
+# FRAC_TURNOVER_DAILY  ([-]) :   	{OK_STOMATE }
+FRAC_TURNOVER_DAILY  =  0.55 
+
+# TAX_MAX ([-]   ) :  maximum fraction of allocatable biomass used for maintenance respiration 	{OK_STOMATE }
+TAX_MAX =  0.8 
+
+# ALWAYS_INIT ([-]   ) :  take carbon from atmosphere if carbohydrate reserve too small?  	{OK_STOMATE }
+ALWAYS_INIT =  n  
+
+# MIN_GROWTHINIT_TIME  ([days]  ) :  minimum time since last beginning of a growing season 	{OK_STOMATE }
+MIN_GROWTHINIT_TIME  =  300.  
+
+# MOIAVAIL_ALWAYS_TREE ([-]   ) :  moisture availability above which moisture tendency doesn't matter  	{OK_STOMATE }
+MOIAVAIL_ALWAYS_TREE =  1.0  
+
+# MOIAVAIL_ALWAYS_GRASS  ([-]   ) :  moisture availability above which moisture tendency doesn't matter 	{OK_STOMATE }
+MOIAVAIL_ALWAYS_GRASS  =  0.6  
+
+# T_ALWAYS_ADD ([C]    ) :  monthly temp. above which temp. tendency doesn't matter  	{OK_STOMATE }
+T_ALWAYS_ADD =  10. 
+
+# GDDNCD_REF  ([-]   ) :   	{OK_STOMATE }
+GDDNCD_REF  =  603.  
+
+# GDDNCD_CURVE ([-]  ) :   	{OK_STOMATE }
+GDDNCD_CURVE =  0.0091  
+
+# GDDNCD_OFFSET ([-]  ) :   	{OK_STOMATE }
+GDDNCD_OFFSET =  64.  
+
+# BM_SAPL_RESCALE  ([-]  ) :   	{OK_STOMATE }
+BM_SAPL_RESCALE  =  40.  
+
+# MAINT_RESP_MIN_VMAX ([-]  ) :   	{OK_STOMATE }
+MAINT_RESP_MIN_VMAX =  0.3 
+
+# MAINT_RESP_COEFF  ([-] ) :   	{OK_STOMATE }
+MAINT_RESP_COEFF  =  1.4  
+
+# FRAC_CARB_AP ([-]) :  frac carb coefficients from active pool: depends on clay content 	{OK_STOMATE }
+FRAC_CARB_AP =  0.004 
+
+# FRAC_CARB_SA ([-]) :  frac_carb_coefficients from slow pool 	{OK_STOMATE }
+FRAC_CARB_SA =  0.42 
+
+# FRAC_CARB_SP ([-] ) :  frac_carb_coefficients from slow pool 	{OK_STOMATE }
+FRAC_CARB_SP =  0.03 
+
+# FRAC_CARB_PA ([-]) :  frac_carb_coefficients from passive pool 	{OK_STOMATE }
+FRAC_CARB_PA =  0.45 
+
+# FRAC_CARB_PS ([-]) :  frac_carb_coefficients from passive pool 	{OK_STOMATE }
+FRAC_CARB_PS =  0.0 
+
+# ACTIVE_TO_PASS_CLAY_FRAC ([-] ) :   	{OK_STOMATE }
+ACTIVE_TO_PASS_CLAY_FRAC =  0.68   
+
+# CARBON_TAU_IACTIVE ( [days] ) :  residence times in carbon pools 	{OK_STOMATE }
+CARBON_TAU_IACTIVE =  0.149 
+
+# CARBON_TAU_ISLOW ([days]) :  residence times in carbon pools 	{OK_STOMATE }
+CARBON_TAU_ISLOW =  5.48 
+
+# CARBON_TAU_IPASSIVE ([days] ) :  residence times in carbon pools 	{OK_STOMATE }
+CARBON_TAU_IPASSIVE =  241. 
+
+# FLUX_TOT_COEFF ([days] ) :  	{OK_STOMATE }
+FLUX_TOT_COEFF =  1.2, 1.4,.75 
+
+# NEW_TURNOVER_TIME_REF ([days]  ) :   	{OK_STOMATE }
+NEW_TURNOVER_TIME_REF =  20.  
+
+# LEAF_AGE_CRIT_TREF ([days]  ) :   	{OK_STOMATE }
+LEAF_AGE_CRIT_TREF =  20.  
+
+# LEAF_AGE_CRIT_COEFF  ([-] ) :   	{OK_STOMATE }
+LEAF_AGE_CRIT_COEFF  =  1.5, 0.75, 10.  
+
+# VMAX_OFFSET  ([-]  ) :  offset (minimum relative vcmax) 	{OK_STOMATE }
+VMAX_OFFSET  =  0.3 
+
+# LEAFAGE_FIRSTMAX ([-] ) :  leaf age at which vmax attains vcmax_opt (in fraction of critical leaf age) 	{OK_STOMATE }
+LEAFAGE_FIRSTMAX =  0.03  
+
+# LEAFAGE_LASTMAX  ([-]  ) :  leaf age at which vmax falls below vcmax_opt (in fraction of critical leaf age)  	{OK_STOMATE }
+LEAFAGE_LASTMAX  =  0.5  
+
+# LEAFAGE_OLD  ([-]  ) :  leaf age at which vmax attains its minimum (in fraction of critical leaf age) 	{OK_STOMATE }
+LEAFAGE_OLD  =  1. 
+
+# GPPFRAC_DORMANCE  ([-]) :  rapport maximal GPP/GGP_max pour dormance 	{OK_STOMATE }
+GPPFRAC_DORMANCE  =  0.2  
+
+# TAU_CLIMATOLOGY ([days]) :  tau for "climatologic variables  	{OK_STOMATE }
+TAU_CLIMATOLOGY =  20 
+
+# HVC1  ([-]  ) :  parameters for herbivore activity 	{OK_STOMATE }
+HVC1  =  0.019 
+
+# HVC2  ([-]  ) :  parameters for herbivore activity  	{OK_STOMATE }
+HVC2  =  1.38 
+
+# LEAF_FRAC_HVC ([-] ) :  parameters for herbivore activity  	{OK_STOMATE }
+LEAF_FRAC_HVC =  0.33 
+
+# TLONG_REF_MAX ([K]  ) :  maximum reference long term temperature  	{OK_STOMATE }
+TLONG_REF_MAX =  303.1 
+
+# TLONG_REF_MIN  ([K]  ) :  minimum reference long term temperature  	{OK_STOMATE }
+TLONG_REF_MIN  =  253.1 
+
+# NCD_MAX_YEAR ([days]) :   	{OK_STOMATE }
+NCD_MAX_YEAR =  3.  
+
+# GDD_THRESHOLD  ([days] ) :   	{OK_STOMATE }
+GDD_THRESHOLD  =  5.  
+
+# GREEN_AGE_EVER  ([-]  ) :   	{OK_STOMATE }
+GREEN_AGE_EVER  =  2.  
+
+# GREEN_AGE_DEC ([-] ) :   	{OK_STOMATE }
+GREEN_AGE_DEC =  0.5  
+
+# ESTAB_MAX_TREE ([-]   ) :  Maximum tree establishment rate  	{OK_DGVM}
+ESTAB_MAX_TREE =  0.12  
+
+# ESTAB_MAX_GRASS ([-]  ) :  Maximum grass establishment rate 	{OK_DGVM}
+ESTAB_MAX_GRASS =  0.12  
+
+# ESTABLISH_SCAL_FACT ([-] ) :   	{OK_DGVM }
+ESTABLISH_SCAL_FACT =  5. 
+
+# MAX_TREE_COVERAGE  ([-] ) :   	{OK_DGVM }
+MAX_TREE_COVERAGE  =  0.98 
+
+# IND_0_ESTAB ([-]  ) :   	{OK_DGVM }
+IND_0_ESTAB =  0.2 
+
+# ANNUAL_INCREASE ([FLAG]) :  for diagnosis of fpc increase, compare today's fpc to last year's maximum (T) or to fpc of last time step (F)? 	{OK_DGVM}
+ANNUAL_INCREASE =  y 
+
+# MIN_COVER  ([-]  ) :  For trees, minimum fraction of crown area occupied  	{OK_DGVM}
+MIN_COVER  =  0.05  
+
+# IND_0  ([-]  ) :  initial density of individuals 	{OK_DGVM}
+IND_0  =  0.02  
+
+# MIN_AVAIL ([-]  ) :  minimum availability 	{OK_DGVM}
+MIN_AVAIL =  0.01 
+
+# RIP_TIME_MIN ([year]  ) :   	{OK_DGVM}
+RIP_TIME_MIN =  1.25  
+
+# NPP_LONGTERM_INIT ([gC/m^2/year]) :   	{OK_DGVM}
+NPP_LONGTERM_INIT =  10. 
+
+# EVERYWHERE_INIT ([-] ) :   	{OK_DGVM}
+EVERYWHERE_INIT =  0.05  
+
+# PRINTLEV ([0, 1, 2, 3, 4]) :  Print level for text output 	{}
+PRINTLEV =  2 
+
+# PRINTLEV_modname ([0, 1, 2, 3, 4]) :  Specific print level of text output for the module "modname". Default as PRINTLEV. 	{}
+PRINTLEV_modname =  PRINTLEV 
+
+# DRY_SOIL_HEAT_CAPACITY ([J.m^{-3}.K^{-1}] ) :  Dry soil Heat capacity of soils 	{OK_SECHIBA }
+DRY_SOIL_HEAT_CAPACITY =  1.80e+6 
+
+# DRY_SOIL_HEAT_COND ([W.m^{-2}.K^{-1}] ) :  Dry soil Thermal Conductivity of soils 	{OK_SECHIBA}
+DRY_SOIL_HEAT_COND =  0.40  
+
+# WET_SOIL_HEAT_CAPACITY ([J.m^{-3}.K^{-1}]) :  Wet soil Heat capacity of soils  	{OK_SECHIBA}
+WET_SOIL_HEAT_CAPACITY =  3.03e+6 
+
+# WET_SOIL_HEAT_COND ([W.m^{-2}.K^{-1}]) :  Wet soil Thermal Conductivity of soils 	{OK_SECHIBA }
+WET_SOIL_HEAT_COND =  1.89  
+
+# SNOW_HEAT_COND ([W.m^{-2}.K^{-1}]) :  Thermal Conductivity of snow 	{OK_SECHIBA  }
+SNOW_HEAT_COND =  0.3 
+
+# SNOW_DENSITY ([-] ) :  Snow density for the soil thermodynamics  	{OK_SECHIBA }
+SNOW_DENSITY =  330.0 
+
+# NOBIO_WATER_CAPAC_VOLUMETRI ([s/m^2]) :   	{OK_SECHIBA and .NOT.(HYDROL_CWRR)}
+NOBIO_WATER_CAPAC_VOLUMETRI =  150. 
+
+# SECHIBA_QSINT  ([m]) :  Interception reservoir coefficient 	{OK_SECHIBA }
+SECHIBA_QSINT  =  0.1 
+
+# CHOISNEL_DIFF_MIN ([kg/m^2/dt]) :  Diffusion constant for the slow regime 	{OK_SECHIBA and .NOT.(HYDROL_CWRR)}
+CHOISNEL_DIFF_MIN =  0.001 
+
+# CHOISNEL_DIFF_MAX ([kg/m^2/dt]) :  Diffusion constant for the fast regime 	{OK_SECHIBA and .NOT.(HYDROL_CWRR)}
+CHOISNEL_DIFF_MAX =  0.1 
+
+# CHOISNEL_DIFF_EXP ([-]) :  The exponential in the diffusion law 	{OK_SECHIBA and .NOT.(HYDROL_CWRR)}
+CHOISNEL_DIFF_EXP =  1.5 
+
+# CHOISNEL_RSOL_CSTE ([s/m^2]) :  Constant in the computation of resistance for bare  soil evaporation  	{OK_SECHIBA and .NOT.(HYDROL_CWRR)}
+CHOISNEL_RSOL_CSTE =  33.E3 
+
+# HCRIT_LITTER ([m]) :  Scaling depth for litter humidity 	{OK_SECHIBA and .NOT.(HYDROL_CWRR) }
+HCRIT_LITTER =  0.08  
+
+# OK_FREEZE ([FLAG]) :  Activate the complet soil freezing scheme 	{OK_SECHIBA }
+OK_FREEZE =  FALSE 
+
+# READ_REFTEMP ([FLAG]) :  Initialize soil temperature using climatological temperature 	{}
+READ_REFTEMP =  True/False depening on OK_FREEZE 
+
+# OK_FREEZE_THERMIX ([FLAG]) :  Activate thermal part of the soil freezing scheme 	{}
+OK_FREEZE_THERMIX =  True if OK_FREEZE else false 
+
+# OK_ECORR ([FLAG]) :  Energy correction for freezing 	{OK_FREEZE_THERMIX}
+OK_ECORR =  True if OK_FREEZE else false 
+
+# POROS ([-] ) :  Soil porosity  	{OK_SECHIBA}
+POROS =  0.41 
+
+# fr_dT ([K] ) :  Freezing window     	{OK_SECHIBA}
+fr_dT =  2.0 
+
+# OK_SNOWFACT ([FLAG]) :  Activates the smoothering of landscapes by snow, 	{}
+OK_SNOWFACT =  True if OK_FREEZE else false 
+
+# OK_FREEZE_CWRR ([FLAG]) :  CWRR freezing scheme by I. Gouttevin 	{}
+OK_FREEZE_CWRR =  True if OK_FREEZE else false 
+
+# OK_THERMODYNAMICAL_FREEZING ([FLAG]) :  Calculate frozen fraction thermodynamically  	{HYDROL_CWRR .AND. OK_FREEZE_CWRR}
+OK_THERMODYNAMICAL_FREEZING =  True 
+
+# CHECK_CWRR ([FLAG]) :  Check detailed CWRR water balance 	{HYDROL_CWRR}
+CHECK_CWRR =  n 
+
+# CHECK_CWRR2 ([FLAG]) :  Caluculate diagnostics to check CWRR water balance 	{HYDROL_CWRR2}
+CHECK_CWRR2 =  n 
+
+# VEGET_UPDATE ([years]) :  Update vegetation frequency 	{MAP_PFT_FORMAT}
+VEGET_UPDATE =  0Y 
+
+# SECHIBA_ZCANOP ([m]) :  Soil level used for canopy development (if STOMATE disactivated) 	{OK_SECHIBA and .NOT. OK_STOMATE  }
+SECHIBA_ZCANOP =  0.5 
+
+# SECHIBA_QSINT  ([m]) :  Interception reservoir coefficient 	{OK_SECHIBA }
+SECHIBA_QSINT  =  0.1 
+
+# DT_STOMATE ([seconds]) :  Time step of STOMATE and other slow processes 	{OK_STOMATE}
+DT_STOMATE =  86400. 
+
+# SECHIBA_VEGMAX ([-]) :  Maximum vegetation distribution within the mesh (0-dim mode) 	{IMPOSE_VEG}
+SECHIBA_VEGMAX =  0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0 
+
+# SECHIBA_FRAC_NOBIO ([-]) :  Fraction of other surface types within the mesh (0-dim mode) 	{IMPOSE_VEG}
+SECHIBA_FRAC_NOBIO =  0.0 
+
+# SECHIBA_LAI ([-]) :  LAI for all vegetation types (0-dim mode) 	{IMPOSE_VEG}
+SECHIBA_LAI =  0., 8., 8., 4., 4.5, 4.5, 4., 4.5, 4., 2., 2., 2., 2. 
+
+# SOIL_FRACTIONS ([-]) :  Fraction of the 3 soil types (0-dim mode) 	{IMPOSE_VEG and IMPOSE_SOILT}
+SOIL_FRACTIONS =  -9999._sechiba 
+
+# CLAY_FRACTION ([-] ) :  Fraction of the clay fraction (0-dim mode) 	{IMPOSE_VEG and IMPOSE_SOIL}
+CLAY_FRACTION =  0.2 
+
+# REINF_SLOPE ([-]) :  Slope coef for reinfiltration  	{IMPOSE_VEG}
+REINF_SLOPE =  0.1 
+
+# SLOWPROC_HEIGHT ([m]) :  Height for all vegetation types  	{OK_SECHIBA}
+SLOWPROC_HEIGHT =  0., 30., 30., 20., 20., 20., 15., 15., 15., .5, .6, 1.0, 1.0 
+
+# GET_SLOPE ([FLAG]) :  Read slopes from file and do the interpolation 	{}
+GET_SLOPE =  n 
+
+# LAI_FILE ([FILE]) :  Name of file from which the vegetation map is to be read 	{LAI_MAP}
+LAI_FILE =  lai2D.nc 
+
+# RENORM_LAI ([FLAG]) :  flag to force LAI renormelization 	{LAI_MAP}
+RENORM_LAI =  n 
+
+# VEGETATION_FILE ([FILE]) :  Name of file from which the vegetation map is to be read 	{MAP_PFT_FORMAT}
+VEGETATION_FILE =  PFTmap.nc 
+
+# VEGETATION_FILE ([FILE]) :  Name of file from which the vegetation map is to be read 	{NOT(IMPOSE_VEG) and NOT(MAP_PFT_FORMAT)}
+VEGETATION_FILE =  carteveg5km.nc 
+
+# SOILCLASS_FILE ([FILE]) :  Name of file from which soil types are read 	{NOT(IMPOSE_VEG)}
+SOILCLASS_FILE =  soils_param.nc 
+
+# SLOPE_NOREINF ([-]) :  See slope_noreinf above 	{}
+SLOPE_NOREINF =  0.5 
+
+# TOPOGRAPHY_FILE ([FILE]) :  Name of file from which the topography map is to be read 	{}
+TOPOGRAPHY_FILE =  cartepente2d_15min.nc 
+
+# SOILALB_FILE ([FILE]) :  Name of file from which the bare soil albedo 	{NOT(IMPOSE_AZE)}
+SOILALB_FILE =  soils_param.nc 
+
+# ALB_BG_FILE ([FILE]) :  Name of file from which the background albedo is read  	{}
+ALB_BG_FILE =  alb_bg.nc 
+
+# CDRAG_FROM_GCM ([FLAG]) :  Keep cdrag coefficient from gcm. 	{OK_SECHIBA}
+CDRAG_FROM_GCM =  y 
+
+# DIFFUCO_LEAFCI ([ppm]) :  Initial leaf CO2 level if not found in restart 	{OK_SECHIBA}
+DIFFUCO_LEAFCI =  233. 
+
+# N_FERTIL_FILE (- ) :  File name 	{CHEMISTRY_BVOC and NOx_FERTILIZERS_USE}
+N_FERTIL_FILE =  orchidee_fertilizer_1995.nc 
+
+# N_FERTIL_FILE (-) :  File name 	{CHEMISTRY_BVOC and NOx_FERTILIZERS_USE}
+N_FERTIL_FILE =  orchidee_fertilizer_1995.nc 
+
+# ENERBIL_TSURF (Kelvin [K]) :  Initial temperature if not found in restart 	{OK_SECHIBA}
+ENERBIL_TSURF =  280. 
+
+# ENERBIL_EVAPOT () :  Initial Soil Potential Evaporation 	{OK_SECHIBA       }
+ENERBIL_EVAPOT =  0.0 
+
+# BEDROCK_FLAG ([FLAG]) :  Flag to consider bedrock at deeper layers. 	{}
+BEDROCK_FLAG =  0 
+
+# THERMOSOIL_TPRO (Kelvin [K]) :  Initial soil temperature profile if not found in restart 	{OK_SECHIBA}
+THERMOSOIL_TPRO =  280. 
+
+# SOIL_REFTEMP_FILE ([FILE]) :  File with climatological soil temperature 	{READ_REFTEMP}
+SOIL_REFTEMP_FILE =  reftemp.nc 
+
+# HYDROL_OK_HDIFF ([FLAG]) :  do horizontal diffusion? 	{OK_SECHIBA and .NOT.(HYDROL_CWRR)  }
+HYDROL_OK_HDIFF =  n 
+
+# HYDROL_SNOW ([kg/m^2]) :  Initial snow mass if not found in restart 	{OK_SECHIBA}
+HYDROL_SNOW =  0.0 
+
+# HYDROL_SNOWAGE ([days]) :  Initial snow age if not found in restart 	{OK_SECHIBA }
+HYDROL_SNOWAGE =  0.0 
+
+# HYDROL_SNOW_NOBIO ([m]) :  Initial snow amount on ice, lakes, etc. if not found in restart 	{OK_SECHIBA }
+HYDROL_SNOW_NOBIO =  0.0 
+
+# HYDROL_SNOW_NOBIO_AGE ([days]) :  Initial snow age on ice, lakes, etc. if not found in restart 	{OK_SECHIBA }
+HYDROL_SNOW_NOBIO_AGE =  0.0 
+
+# HYDROL_HUMR ([-]) :  Initial soil moisture stress if not found in restart 	{OK_SECHIBA }
+HYDROL_HUMR =  1.0 
+
+# HYDROL_BQSB ([kg/m^2]) :  Initial restart deep soil moisture if not found in restart 	{OK_SECHIBA }
+HYDROL_BQSB =  999999.  
+
+# HYDROL_GQSB ([kg/m^2]) :  Initial upper soil moisture if not found in restart 	{OK_SECHIBA }
+HYDROL_GQSB =  0.0 
+
+# HYDROL_DSG ([m]) :  Initial upper reservoir depth if not found in restart 	{OK_SECHIBA }
+HYDROL_DSG =  0.0 
+
+# HYDROL_QSV ([kg/m^2]) :  Initial water on canopy if not found in restart 	{OK_SECHIBA }
+HYDROL_QSV =  0.0 
+
+# HYDROL_DSP ([m]) :  Initial dry soil above upper reservoir if not found in restart 	{OK_SECHIBA }
+HYDROL_DSP =  999999. 
+
+# HYDROL_TAU_HDIFF ([seconds]) :  time scale (s) for horizontal diffusion of water 	{HYDROL_OK_HDIFF}
+HYDROL_TAU_HDIFF =  86400. 
+
+# DO_PONDS ([FLAG]) :  Should we include ponds  	{HYDROL_CWRR}
+DO_PONDS =  n 
+
+# FROZ_FRAC_CORR  ([-]) :  Coefficient for the frozen fraction correction       {HYDROL_CWRR and OK_FREEZE} 
+FROZ_FRAC_CORR  =  1.0
+
+# MAX_FROZ_HYDRO ([-]) :  Coefficient for the frozen fraction correction        {HYDROL_CWRR and OK_FREEZE} 
+MAX_FROZ_HYDRO =  1.0  
+ 
+# SMTOT_CORR ([-]) :  Coefficient for the frozen fraction correction    {HYDROL_CWRR and OK_FREEZE} 
+SMTOT_CORR =  2.0  
+	 
+# DO_RSOIL ([FLAG]) :  Should we reduce soil evaporation with a soil resistance         {HYDROL_CWRR} 
+DO_RSOIL =  n
+
+# OK_DYNROOT ([FLAG]) :  Calculate dynamic root profile to optimize soil moisture usage         {HYDROL_CWRR} 
+OK_DYNROOT =  n
+
+# CWRR_N_VANGENUCHTEN ([-]) :  Van genuchten coefficient n 	{HYDROL_CWRR}
+CWRR_N_VANGENUCHTEN =  1.89, 1.56, 1.31 
+
+# CWRR_A_VANGENUCHTEN ([1/mm]  ) :  Van genuchten coefficient a 	{HYDROL_CWRR}
+CWRR_A_VANGENUCHTEN =  0.0075, 0.0036, 0.0019 
+
+# VWC_RESIDUAL ([m3/m3]  ) :  Residual soil water content 	{HYDROL_CWRR}
+VWC_RESIDUAL =  0.065, 0.078, 0.095 
+
+# VWC_SAT ([m3/m3]  ) :  Saturated soil water content 	{HYDROL_CWRR}
+VWC_SAT =  0.41, 0.43, 0.41 
+
+# CWRR_KS  ([mm/d]   ) :  Hydraulic conductivity Saturation 	{HYDROL_CWRR }
+CWRR_KS  =  1060.8, 249.6, 62.4 
+
+# WETNESS_TRANSPIR_MAX ([-]    ) :  Soil moisture above which transpir is max 	{HYDROL_CWRR}
+WETNESS_TRANSPIR_MAX =  0.5, 0.5, 0.5 
+
+# VWC_FC  ([m3/m3]   ) :  Volumetric water content field capacity 	{HYDROL_CWRR}
+VWC_FC  =  0.32, 0.32, 0.32 
+
+# VWC_WP ([m3/m3]   ) :  Volumetric water content Wilting pt 	{HYDROL_CWRR}
+VWC_WP =  0.10, 0.10, 0.10  
+
+# VWC_MIN_FOR_WET_ALB ([m3/m3]  ) :  Vol. wat. cont. above which albedo is cst 	{HYDROL_CWRR}
+VWC_MIN_FOR_WET_ALB =  0.25, 0.25, 0.25 
+
+# VWC_MAX_FOR_DRY_ALB ([m3/m3]   ) :  Vol. wat. cont. below which albedo is cst 	{HYDROL_CWRR}
+VWC_MAX_FOR_DRY_ALB =  0.1, 0.1, 0.1 
+
+# HYDROL_MOISTURE_CONTENT ([m3/m3]) :  Soil moisture on each soil tile and levels 	{HYDROL_CWRR       }
+HYDROL_MOISTURE_CONTENT =  0.3 
+
+# US_INIT ([-]) :  US_NVM_NSTM_NSLM 	{HYDROL_CWRR       }
+US_INIT =  0.0 
+
+# ZWT_FORCE ([m]) :  Prescribed water depth, dimension nstm 	{HYDROL_CWRR       }
+ZWT_FORCE =  -9999. -9999. -9999. 
+
+# FREE_DRAIN_COEF ([-]) :  Coefficient for free drainage at bottom, dimension nstm 	{HYDROL_CWRR       }
+FREE_DRAIN_COEF =  1.0 1.0 1.0 
+
+# WATER_TO_INFILT ([mm]) :  Water to be infiltrated on top of the soil 	{HYDROL_CWRR    }
+WATER_TO_INFILT =  0.0 
+
+# EVAPNU_SOIL ([mm]) :  Bare soil evap on each soil if not found in restart 	{HYDROL_CWRR  }
+EVAPNU_SOIL =  0.0 
+
+# HYDROL_SNOW () :  Initial snow mass if not found in restart 	{OK_SECHIBA}
+HYDROL_SNOW =  0.0 
+
+# HYDROL_SNOWAGE (***) :  Initial snow age if not found in restart 	{OK_SECHIBA}
+HYDROL_SNOWAGE =  0.0 
+
+# HYDROL_SNOW_NOBIO ([mm]) :  Initial snow amount on ice, lakes, etc. if not found in restart 	{OK_SECHIBA}
+HYDROL_SNOW_NOBIO =  0.0 
+
+# HYDROL_SNOW_NOBIO_AGE (***) :  Initial snow age on ice, lakes, etc. if not found in restart 	{OK_SECHIBA}
+HYDROL_SNOW_NOBIO_AGE =  0.0 
+
+# HYDROL_QSV ([mm]) :  Initial water on canopy if not found in restart 	{OK_SECHIBA}
+HYDROL_QSV =  0.0 
+
+# CWRR_NKS_N0  ([-]) :  fitted value for relation log((n-n0)/(n_ref-n0))  	{HYDROL_CWRR }
+CWRR_NKS_N0  =  0.95 
+
+# CWRR_NKS_POWER ([-]) :  fitted value for relation log((n-n0)/(n_ref-n0))  	{HYDROL_CWRR }
+CWRR_NKS_POWER =  0.34 
+
+# CWRR_AKS_A0  ([1/mm]) :  fitted value for relation log((a-a0)/(a_ref-a0))  	{HYDROL_CWRR }
+CWRR_AKS_A0  =  0.00012 
+
+# CWRR_AKS_POWER ([-]) :  fitted value for relation log((a-a0)/(a_ref-a0))  	{HYDROL_CWRR }
+CWRR_AKS_POWER =  0.53 
+
+# KFACT_DECAY_RATE ([1/m]) :  Factor for Ks decay with depth 	{HYDROL_CWRR }
+KFACT_DECAY_RATE =  2.0 
+
+# KFACT_STARTING_DEPTH ([m]) :  Depth for compacted value of Ks  	{HYDROL_CWRR }
+KFACT_STARTING_DEPTH =  0.3 
+
+# KFACT_MAX ([-]) :  Maximum Factor for Ks increase due to vegetation 	{HYDROL_CWRR }
+KFACT_MAX =  10.0 
+
+# DT_ROUTING  ([seconds]) :  Time step of the routing scheme 	{RIVER_ROUTING}
+DT_ROUTING  =  86400. 
+
+# ROUTING_RIVERS ([-]) :  Number of rivers  	{RIVER_ROUTING}
+ROUTING_RIVERS =  50 
+
+# DO_FLOODINFILT ([FLAG]) :  Should floodplains reinfiltrate into the soil  	{RIVER_ROUTING}
+DO_FLOODINFILT =  n 
+
+# DO_SWAMPS ([FLAG]) :  Should we include swamp parameterization  	{RIVER_ROUTING}
+DO_SWAMPS =  n 
+
+# DO_PONDS ([FLAG]) :  Should we include ponds  	{RIVER_ROUTING}
+DO_PONDS =  n 
+
+# SLOW_TCST ([days]) :  Time constant for the slow reservoir  	{RIVER_ROUTING }
+SLOW_TCST =  n 
+
+# FAST_TCST ([days]) :  Time constant for the fast reservoir  	{RIVER_ROUTING }
+FAST_TCST =  fast_tcst_cwrr or fast_tcst_chois depending on flag HYDROL_CWRR 
+
+# STREAM_TCST ([days]) :  Time constant for the stream reservoir  	{RIVER_ROUTING}
+STREAM_TCST =  stream_tcst_cwrr or stream_tcst_chois depending on flag HYDROL_CWRR 
+
+# FLOOD_TCST ([days]) :  Time constant for the flood reservoir  	{RIVER_ROUTING}
+FLOOD_TCST =  4.0 
+
+# SWAMP_CST ([-]) :  Fraction of the river that flows back to swamps  	{RIVER_ROUTING}
+SWAMP_CST =  0.2 
+
+# FLOOD_BETA ([-] ) :  Parameter to fix the shape of the floodplain   	{RIVER_ROUTING}
+FLOOD_BETA =  2.0 
+
+# POND_BETAP ([-] ) :  Ratio of the basin surface intercepted by ponds and the maximum surface of ponds 	{RIVER_ROUTING}
+POND_BETAP =  0.5 
+
+# FLOOD_CRI ([mm] ) :  Potential height for which all the basin is flooded 	{DO_FLOODPLAINS or DO_PONDS}
+FLOOD_CRI =  2000. 
+
+# POND_CRI ([mm] ) :  Potential height for which all the basin is a pond 	{DO_FLOODPLAINS or DO_PONDS}
+POND_CRI =  2000. 
+
+# MAX_LAKE_RESERVOIR ([kg/m2(routing area)] ) :  Maximum limit of water in lake_reservoir 	{RIVER_ROUTING}
+MAX_LAKE_RESERVOIR =  7000 
+
+# RIVER_DESC ([FLAG]) :  Writes out a description of the rivers 	{RIVER_ROUTING}
+RIVER_DESC =  n 
+
+# RIVER_DESC_FILE ([FILE]) :  Filename in which we write the description of the rivers. If suffix is ".nc" a netCDF file is created 	{RIVER_DESC}
+RIVER_DESC_FILE =  river_desc.nc 
+
+# ROUTING_FILE ([FILE]) :  Name of file which contains the routing information 	{RIVER_ROUTING}
+ROUTING_FILE =  routing.nc 
+
+# IRRIGATION_FILE ([FILE]) :  Name of file which contains the map of irrigated areas 	{DO_IRRIGATION OR DO_FLOODPLAINS}
+IRRIGATION_FILE =  floodplains.nc 
+
+# EPS_CARBON ([%]   ) :  Allowed error on carbon stock 	{SPINUP_ANALYTIC}
+EPS_CARBON =  0.01 
+
+# SPINUP_PERIOD ([years]   ) :  Period to calulcate equilibrium during spinup analytic 	{SPINUP_ANALYTIC}
+SPINUP_PERIOD =  -1 
+
+# STOMATE_FORCING_NAME ([FILE]) :  Name of STOMATE's forcing file 	{OK_STOMATE}
+STOMATE_FORCING_NAME =  NONE 
+
+# STOMATE_FORCING_MEMSIZE ([MegaBytes]) :  Size of STOMATE forcing data in memory  	{OK_STOMATE}
+STOMATE_FORCING_MEMSIZE =  50 
+
+# STOMATE_CFORCING_NAME ([FILE]) :  Name of STOMATE's carbon forcing file 	{OK_STOMATE}
+STOMATE_CFORCING_NAME =  NONE 
+
+# FORCESOIL_STEP_PER_YEAR ([days, months, year]) :  Number of time steps per year for carbon spinup. 	{OK_STOMATE}
+FORCESOIL_STEP_PER_YEAR =  365 
+
+# FORCESOIL_NB_YEAR ([years]) :  Number of years saved for carbon spinup. 	{OK_STOMATE}
+FORCESOIL_NB_YEAR =  1 
+
+# XIOS_ORCHIDEE_OK ([FLAG]) :  Use XIOS for writing diagnostics file 	{}
+XIOS_ORCHIDEE_OK =  y  
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/AA_make
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/AA_make	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/AA_make	(revision 6412)
@@ -0,0 +1,66 @@
+#-
+#- $Id$
+#-
+MODS1 = dim2_driver.f90 \
+        weather.f90 \
+        readdim2.f90 \
+        teststomate.f90 \
+        forcesoil.f90 \
+        getprec.f90
+
+all : orchidee_ol teststomate forcesoil
+
+orchidee_ol:
+	$(M_K) m_orchidee_ol
+	@echo orchidee_ol is OK
+
+m_orchidee_ol: $(BINDIR)/orchidee_ol
+$(BINDIR)/orchidee_ol: \
+  $(SXIOIPSL_LIB) $(SXPARAM_LIB) $(SXPARALLEL_LIB) $(SXORGLOB_LIB) $(SXSTOMATE_LIB) $(SXSECHIBA_LIB) \
+  $(MODEL_LIB)(weather.o) $(MODEL_LIB)(readdim2.o) \
+  $(MODEL_LIB)(dim2_driver.o)
+	$(A_G) $(MODEL_LIB) dim2_driver.o
+	$(F_L) -o $(BINDIR)/orchidee_ol dim2_driver.o $(L_O) \
+          $(SXMODEL_LIB) $(SXSECHIBA_LIB) $(SXSTOMATE_LIB) \
+          $(SXPARALLEL_LIB) $(SXORGLOB_LIB) $(SXPARAM_LIB) $(SXIOIPSL_LIB) $(NCDF_LIB) 
+	$(RM) dim2_driver.o
+
+teststomate:
+	$(M_K) m_teststomate
+	@echo teststomate is OK
+
+m_teststomate: $(BINDIR)/teststomate
+$(BINDIR)/teststomate: \
+  $(SXIOIPSL_LIB) $(SXPARALLEL_LIB) $(SXPARAM_LIB) $(SXORGLOB_LIB) $(SXSTOMATE_LIB) $(SXSECHIBA_LIB) \
+  $(MODEL_LIB)(teststomate.o)
+	$(A_G) $(MODEL_LIB) teststomate.o
+	$(F_L) -o $(BINDIR)/teststomate teststomate.o $(L_O) \
+          $(SXMODEL_LIB) $(SXSECHIBA_LIB) $(SXSTOMATE_LIB) \
+          $(SXPARALLEL_LIB) $(SXORGLOB_LIB) $(SXPARAM_LIB) $(SXIOIPSL_LIB) $(NCDF_LIB)
+	$(RM) teststomate.o
+
+forcesoil:
+	$(M_K) m_forcesoil
+	@echo m_forcesoil is OK
+
+m_forcesoil: $(BINDIR)/forcesoil
+$(BINDIR)/forcesoil: \
+  $(SXIOIPSL_LIB) $(SXPARALLEL_LIB) $(SXPARAM_LIB) $(SXORGLOB_LIB) $(SXSTOMATE_LIB) $(SXSECHIBA_LIB) \
+  $(MODEL_LIB)(forcesoil.o)
+	$(A_G) $(MODEL_LIB) forcesoil.o
+	$(F_L) -o $(BINDIR)/forcesoil forcesoil.o $(L_O) \
+          $(SXMODEL_LIB) $(SXSECHIBA_LIB) $(SXSTOMATE_LIB) \
+          $(SXPARALLEL_LIB) $(SXORGLOB_LIB) $(SXPARAM_LIB) $(SXIOIPSL_LIB) $(NCDF_LIB)
+	$(RM) forcesoil.o
+
+libioipsl:
+	(cd ../../IOIPSL/src; $(M_K) -f Makefile)
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(%.o): %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(RM) $*.o
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/AA_make.ldef
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/AA_make.ldef	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/AA_make.ldef	(revision 6412)
@@ -0,0 +1,49 @@
+#-
+#- $Id$
+#-
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+MODDIR = $(LIBDIR)
+BINDIR = ../../../bin
+SCPDIR = ../../scripts
+ORDIR  = ..
+#---------------------------------------------------------------------
+MODEL_LIB = $(LIBDIR)/liborchidee.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec SXMODEL_LIB = $(LIBDIR)/libsxorchidee.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxorchidee.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxorchidee.a
+#-
+IOIPSL_LIB = $(LIBDIR)/libioipsl.a
+SXIOIPSL_LIB = $(IOIPSL_LIB)
+#-
+PARAM_LIB = $(LIBDIR)/libparameters.a
+SXPARAM_LIB = $(PARAM_LIB)
+#-Q- sxnec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-
+PARALLEL_LIB = $(LIBDIR)/libparallel.a
+SXPARALLEL_LIB = $(PARALLEL_LIB)
+#-Q- sxnec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-
+ORGLOB_LIB = $(LIBDIR)/liborglob.a
+SXORGLOB_LIB = $(ORGLOB_LIB)
+#-Q- sxnec  SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx6nec SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx8brodie SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-
+SECHIBA_LIB = $(LIBDIR)/libsechiba.a
+SXSECHIBA_LIB = $(SECHIBA_LIB)
+#-Q- sxnec SXSECHIBA_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- sx6nec SXSECHIBA_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- sx8brodie SXSECHIBA_LIB = $(LIBDIR)/libsxsechiba.a
+#-
+STOMATE_LIB = $(LIBDIR)/libstomate.a
+SXSTOMATE_LIB = $(STOMATE_LIB)
+#-Q- sxnec SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx6nec SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx8brodie SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/dim2_driver.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/dim2_driver.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/dim2_driver.f90	(revision 6412)
@@ -0,0 +1,1775 @@
+!  ==============================================================================================================================\n
+!  PROGRAM         : driver
+! 
+!  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 program for the offline driver dim2_driver
+!!
+!!\n DESCRIPTION   : This PROGRAM is the driver of the dim2 version of ORCHIDEE.
+!!
+!! The forcing data needs to be in netCDF format and should contain the following variables :
+!! - Incoming SW radiation
+!! - Incoming LW radiation
+!! - Precipitation
+!! - Air temperature at a reference level
+!! - Air humidity at the same level
+!! - wind at the same level
+!! - surface pressure
+!!
+!! RECENT CHANGE(S): None 
+!! 
+!! REFERENCE(S)    : None
+!!   
+!! SVN     :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+PROGRAM driver
+
+  USE netcdf
+  USE ioipsl_para
+  USE grid
+  USE intersurf,  ONLY : intersurf_main_2d, intersurf_initialize_2d, intersurf_clear
+  USE constantes
+  USE readdim2
+  USE mod_orchidee_para
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER :: iim, jjm, llm
+  INTEGER :: im, jm, lm, tm, is, force_id, itest, jtest
+  REAL :: dt, dt_force, dt_rest, date0, date0_rest
+  REAL :: zlflu
+  REAL :: alpha
+
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+ & swdown, coszang, precip_rain, precip_snow, tair_obs, u, v, &
+ & qair_obs, pb, lwdown, &
+ & eair_obs, zlev_vec, zlevuv_vec, relax
+!- Variables which are forcings for SECHIBA
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+ & petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, &
+ & for_u, for_v, for_swnet, for_swdown, for_coszang, for_lwdown, &
+ & for_psurf, for_qair, for_tair, for_eair, &
+ & for_ccanopy, for_rau
+
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+ & for_contfrac, old_zlev, old_qair, old_eair, tsol_rad, vevapp, &
+ & temp_sol_NEW, temp_sol_old, qsurf, dtdt, coastalflow, riverflow, &
+ & fluxsens, fluxlat, emis, z0
+
+  INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: for_neighbours
+
+  REAL, ALLOCATABLE, DIMENSION(:,:,:) :: for_resolution
+
+  REAL, ALLOCATABLE, DIMENSION(:,:,:) :: albedo
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: albedo_vis
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: albedo_nir
+
+  INTEGER, ALLOCATABLE, DIMENSION(:) :: kindex
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: lon, lat
+  REAL, ALLOCATABLE, DIMENSION(:)   :: tmplev
+
+  REAL :: old_tair
+  REAL :: atmco2
+  INTEGER :: nbindex
+  REAL :: julian, ss
+  INTEGER :: yy, mm, dd
+
+  LOGICAL :: relaxation
+
+  CHARACTER(LEN=80) :: filename, driv_restname_in, driv_restname_out
+  CHARACTER(LEN=30) :: time_str, var_name
+
+  INTEGER :: it, istp, istp_old, rest_id, it_force
+
+  INTEGER :: split, split_start, nb_spread, for_offset
+  INTEGER :: itau_dep, itau_dep_rest, itau_fin, itau_skip, itau_len
+
+  INTEGER,DIMENSION(2) :: ml
+
+  LOGICAL :: lstep_init, lstep_last
+  LOGICAL :: no_inter, inter_lin, netrad_cons
+
+  ! to check variables passed to intersurf
+  INTEGER :: ik
+  INTEGER :: i,j
+  !INTEGER :: printlev_loc  !! local write level
+
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+  & fluxsens_g,vevapp_g,old_zlev_g,old_qair_g,old_eair_g,for_rau_g, &
+  & petAcoef_g, petBcoef_g,peqAcoef_g,peqBcoef_g,albedo_g,z0_g
+  LOGICAL :: Flag
+  LOGICAL :: driver_reset_time
+
+  REAL :: fill_init
+
+  fill_init=REAL(nf90_fill_real,r_std)
+  CALL ioconf_expval(val_exp)
+!-
+! Init parallelism
+
+  CALL Init_orchidee_para
+  CALL init_timer
+  CALL start_timer(timer_global)
+  CALL start_timer(timer_mpi)
+
+! Set specific write level to dim2_driver using PRINTLEV_dim2_driver=[0-4] 
+! in run.def. The global printlev is used as default value. 
+printlev_loc=get_printlev('dim2_driver')
+
+!=====================================================================
+!- 1.0 This section defines the general set-up of the experiment :
+!-   - Forcing data to be used with its time step
+!-   - Restart file to be used
+!-   - The time step that will be used
+!-   - The starting date of the simulation
+!-   - Length of integration
+!-   - Basic flags for SSIPSL
+!=====================================================================
+!- 1.1 Initialize the driving variables. It essentialy gets the mode
+!-     used and the size of the driving variables.
+!=====================================================================
+  IF (printlev_loc>=3) WRITE(numout,*) 'Reading name of the forcing file'
+!- 
+ !Config Key   = FORCING_FILE
+ !Config Desc  = Name of file containing the forcing data
+ !Config If    = [-]
+ !Config Def   = forcing_file.nc
+ !Config Help  = This is the name of the file which should be opened
+ !Config         for reading the forcing data of the dim0 model.
+ !Config         The format of the file has to be netCDF and COADS
+ !Config         compliant.
+ !Config Units = [FILE] 
+!- 
+  filename='forcing_file.nc'
+  CALL getin_p('FORCING_FILE',filename)
+!-
+  IF (printlev_loc>=3) WRITE(numout,*) 'Opening forcing file'
+!-
+! We call flininfo to obtain the dimensions
+! of iim, jjm and others.
+! This information will allow us to allocate all the space needed.
+!-
+  CALL forcing_info &
+ &  (filename, iim, jjm, llm, tm, date0, dt_force, force_id) 
+!-
+  WRITE(numout,*) 'Out of flininfo : date0 ', date0, &
+       'iim, jjm, llm, tm',iim,jjm,llm,tm,' dt_force ',dt_force
+!-
+  CALL init_ioipsl_para
+!-
+  IF (printlev_loc>=3) THEN
+    WRITE(numout,*) 'Allocate memory for the driver :', iim, jjm, llm
+  ENDIF
+!-
+  ALLOCATE (tmplev(llm)) 
+  tmplev(:)=0.
+
+  ALLOCATE &
+ & (swdown(iim,jjm), coszang(iim,jjm), precip_rain(iim,jjm), precip_snow(iim,jjm), &
+ &  tair_obs(iim,jjm), u(iim,jjm), v(iim,jjm), qair_obs(iim,jjm), &
+ &  pb(iim,jjm), lwdown(iim,jjm), &
+ &  eair_obs(iim,jjm), zlev_vec(iim,jjm), zlevuv_vec(iim,jjm), relax(iim,jjm))
+!- 
+  ALLOCATE &
+ & (petAcoef(iim,jjm), peqAcoef(iim,jjm), &
+ &  petBcoef(iim,jjm), peqBcoef(iim,jjm), &
+ &  cdrag(iim,jjm), for_u(iim,jjm), for_v(iim,jjm), &
+ &  for_swnet(iim,jjm), for_swdown(iim,jjm), for_coszang(iim,jjm), for_lwdown(iim,jjm), &
+ &  for_psurf(iim,jjm), for_qair(iim,jjm), for_tair(iim,jjm), &
+ &  for_eair(iim,jjm), for_ccanopy(iim,jjm), for_rau(iim,jjm))
+
+  ALLOCATE &
+ & (for_contfrac(iim,jjm), for_neighbours(iim,jjm,8), for_resolution(iim,jjm,2), &
+ &  old_zlev(iim,jjm), old_qair(iim,jjm), old_eair(iim,jjm), &
+ &  tsol_rad(iim,jjm), vevapp(iim,jjm), &
+ &  temp_sol_NEW(iim,jjm), temp_sol_old(iim,jjm), &
+ &  dtdt(iim,jjm), coastalflow(iim,jjm), riverflow(iim,jjm), &
+ &  fluxsens(iim,jjm), fluxlat(iim,jjm), emis(iim,jjm), &
+ &  z0(iim,jjm), qsurf(iim,jjm))
+
+  ALLOCATE(albedo(iim,jjm,2))
+  ALLOCATE(albedo_vis(iim,jjm),albedo_nir(iim,jjm))
+  ALLOCATE(kindex(iim*jjm))
+  ALLOCATE(lon(iim,jjm), lat(iim,jjm))
+
+  swdown(:,:) = fill_init
+  precip_rain(:,:) = 0.0
+  precip_snow(:,:) = 0.0
+  tair_obs(:,:) = 0.0
+  u(:,:) = fill_init
+  v(:,:) = fill_init
+  qair_obs(:,:) = fill_init
+  pb(:,:) = fill_init
+  lwdown(:,:) = fill_init
+  eair_obs(:,:) = fill_init
+  zlev_vec(:,:) = 0.0
+  zlevuv_vec(:,:) = 0.0
+  relax(:,:) = 0.0
+  petAcoef(:,:) = 0.0
+  peqAcoef(:,:) = 0.0
+  petBcoef(:,:) = 0.0
+  peqBcoef(:,:) = 0.0
+  cdrag(:,:) = 0.0
+  for_u(:,:) = fill_init
+  for_v(:,:) = fill_init
+  for_swnet(:,:) = fill_init
+  for_swdown(:,:) = fill_init
+  for_lwdown(:,:) = fill_init
+  for_psurf(:,:) = fill_init
+  for_qair(:,:) = fill_init
+  for_tair(:,:) = fill_init
+  for_eair(:,:) = fill_init
+  for_ccanopy(:,:) = 0.0
+  for_rau(:,:) = fill_init
+  for_contfrac(:,:) = 0.0
+  for_neighbours(:,:,:) = 0
+  for_resolution(:,:,:) = 0.0
+  old_zlev(:,:) = 0.0
+  old_qair(:,:) = 0.0
+  old_eair(:,:) = 0.0
+  tsol_rad(:,:) = 0.0
+  vevapp(:,:) = 0.0
+  temp_sol_NEW(:,:) = fill_init
+  temp_sol_old(:,:) = fill_init
+  dtdt(:,:) = 0.0
+  coastalflow(:,:) = 0.0
+  riverflow(:,:) = 0.0
+  fluxsens(:,:) = fill_init
+  fluxlat(:,:) = fill_init
+  emis(:,:) = 0.0
+  z0(:,:) = fill_init
+  qsurf(:,:) = 0.0
+  albedo(:,:,:) = fill_init
+  albedo_vis(:,:) = fill_init
+  albedo_nir(:,:) = fill_init
+  kindex(:) = 0
+  lon(:,:) = 0.0
+  lat(:,:) = 0.0
+!-
+! We need to know the grid.
+! Then we can initialize the restart files, and then we
+! can give read the restart files in the forcing subroutine.
+!-
+  CALL forcing_grid (iim,jjm,llm,lon,lat,init_f=.FALSE.)
+!=====================================================================
+!- 1.2 Time step to be used.
+!-     This is relative to the time step of the  forcing data
+!=====================================================================
+  IF ( .NOT. weathergen ) THEN
+     !Config Key   = DT_SECHIBA
+     !Config Desc  = Time-step of the SECHIBA component
+     !Config If    = NOT(WEATHERGEN)
+     !Config Def   = 1800.
+     !Config Help  = Determines the time resolution at which
+     !Config         the calculations in the SECHIBA component
+     !Config         are done
+     !Config Units = [seconds]
+     dt = 1800
+     CALL getin_p('DT_SECHIBA', dt)
+     split = INT(dt_force/dt)
+     WRITE(numout,*) 'Time step in forcing file: dt_force=',dt_force
+     WRITE(numout,*) 'Time step in sechiba component: dt_sechiba=',dt
+     WRITE(numout,*) 'Splitting of each forcing time step: split=',split
+     
+     IF ( split .LT. 1. ) THEN
+        CALL ipslerr_p ( 3, 'dim2_driver',&
+             'Time step of the forcing file is higher than the time step in sechiba',&
+             'Please, modify DT_SECHIBA parameter value !','')     
+     END IF
+  ELSE
+     ! Case weathergen: 
+     ! The model time step in sechiba is always the same as the forcing time step
+     dt = dt_force
+     split = 1
+  ENDIF
+
+!=====================================================================
+!- 1.3 Initialize the restart file for the driver
+!=====================================================================
+  !Config Key   = RESTART_FILEIN
+  !Config Desc  = Name of restart to READ for initial conditions
+  !Config If    = [-]
+  !Config Def   = NONE
+  !Config Help  = This is the name of the file which will be opened
+  !Config         to extract the initial values of all prognostic
+  !Config         values of the model. This has to be a netCDF file.
+  !Config         Not truly COADS compliant. NONE will mean that
+  !Config         no restart file is to be expected.
+  !Config Units = [FILE]
+!-
+  driv_restname_in = 'NONE'
+  CALL getin_p('RESTART_FILEIN',driv_restname_in)
+  if (printlev_loc>=3) WRITE(numout,*) 'INPUT RESTART_FILE : ',TRIM(driv_restname_in)
+!-
+  !Config Key   = RESTART_FILEOUT
+  !Config Desc  = Name of restart files to be created by the driver
+  !Config If    = [-]
+  !Config Def   = driver_rest_out.nc
+  !Config Help  = This variable give the  name for
+  !Config         the restart files. The restart software within
+  !Config         IOIPSL will add .nc if needed
+  !Config Units = [FILE]
+!-
+  driv_restname_out = 'driver_rest_out.nc'
+  CALL getin_p('RESTART_FILEOUT', driv_restname_out)
+  if (printlev_loc>=3) WRITE(numout,*) 'OUTPUT RESTART_FILE : ',TRIM(driv_restname_out)
+!-
+! Set default values for the start and end of the simulation
+! in the forcing chronology.
+
+  CALL gather2D_mpi(lon,lon_g)
+  CALL gather2D_mpi(lat,lat_g)
+
+
+  !Config Key   = DRIVER_reset_time
+  !Config Desc  = Overwrite time values from the driver restart file
+  !Config If    = [-]
+  !Config Def   = n
+  !Config Units = [FLAG]
+
+  driver_reset_time=.FALSE.
+  CALL getin_p('DRIVER_reset_time', driver_reset_time)
+  IF (printlev_loc>=3) WRITE(numout,*) 'driver_reset_time=',driver_reset_time
+
+  IF (is_root_prc) THEN
+     ! Set default values for the time variables
+     itau_dep_rest = 0
+     date0_rest = date0
+     dt_rest = dt
+
+     IF (printlev_loc>=3) WRITE(numout,*) &
+          'Before driver restart file initialization : itau_dep_rest, date0_rest, dt_rest = ', &
+          itau_dep_rest, date0_rest, dt_rest
+
+     CALL restini &
+          (driv_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, tmplev, &
+          driv_restname_out, itau_dep_rest, date0_rest, dt_rest, rest_id, driver_reset_time)
+
+     IF (printlev_loc>=3) WRITE(numout,*) &
+          'After driver restart file initialization : itau_dep_rest, date0_rest, dt_rest = ', &
+          itau_dep_rest, date0_rest, dt_rest
+
+     IF (itau_dep_rest == 0 .OR. driver_reset_time) THEN
+        ! Restart file did not exist or we decide to overwrite time values in it.
+        ! Set time values to read the begining of the forcing file.
+        itau_dep=0
+        itau_fin=tm
+        date0_rest = date0
+     ELSE
+        ! Take time values from restart file
+        itau_dep = itau_dep_rest
+        itau_fin = itau_dep+tm
+     ENDIF
+
+     WRITE(numout,*) &
+          'Restart file initialized : itau_dep, itau_fin, date0_rest, dt_rest = ', &
+          itau_dep, itau_fin, date0_rest, dt_rest
+  ENDIF
+
+  ! Communicate values from root_prc to all the others
+  CALL bcast (itau_dep_rest)
+  CALL bcast (itau_dep)
+  CALL bcast (itau_fin)
+  CALL bcast (date0_rest)
+  CALL bcast (dt_rest)
+
+
+!=====================================================================
+!- 1.4 Here we do the first real reading of the driving. It only
+!-     gets a few variables.
+!=====================================================================
+
+! prepares kindex table from the information obtained
+! from the forcing data and reads some initial values for
+! temperature, etc.
+!- 
+  kindex(1) = 1
+!-
+  CALL forcing_READ &
+ &  (filename, rest_id, .TRUE., .FALSE., &
+ &   0, itau_dep, 0, split, nb_spread, netrad_cons, &
+ &   date0, dt_force, iim, jjm, lon, lat, zlev_vec, zlevuv_vec, tm, &
+ &   swdown, coszang, precip_rain, precip_snow, tair_obs, &
+ &   u, v, qair_obs, pb, lwdown, for_contfrac, for_neighbours, for_resolution, &
+ &   for_swnet, eair_obs, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, for_ccanopy, &
+ &   kindex, nbindex, force_id)
+!-
+  IF (printlev_loc .GT. 2) WRITE (numout,*) ">> Number of land points =",nbindex
+  IF (nbindex == 0) THEN
+     WRITE(numout,*) "Limits : (W,E / N,S)", limit_west, limit_east, &
+          &                             limit_north, limit_south
+     CALL ipslerr_p ( 3, 'dim2_driver','number of land points error.', &
+          &         ' is zero !','stop driver')
+  ENDIF
+!-
+  DO ik=1,nbindex
+     jlandindex(ik) = (((kindex(ik)-1)/iim) + 1)
+     ilandindex(ik) = (kindex(ik) - (jlandindex(ik)-1)*iim)
+  ENDDO
+  IF (printlev_loc>=4) THEN
+     WRITE(numout,*) "kindex of land points : ", kindex(1:nbindex)
+     WRITE(numout,*) "index i of land points : ", ilandindex
+     WRITE(numout,*) "index j of land points : ", jlandindex 
+  ENDIF
+
+  im = iim; jm = jjm; lm = llm;
+  IF ( (iim > 1).AND.(jjm > 1) ) THEN
+    jtest = INT((kindex(INT(nbindex/2))-1)/iim)+1
+    itest = MAX( 1, kindex(INT(nbindex/2))-(jtest-1)*iim )
+  ELSE
+    jtest = 1
+    itest = 1
+  ENDIF
+  IF (printlev_loc>=3) WRITE(numout,*) "test point in dim2_driver : ",itest,jtest
+!-
+  IF ((im /= iim) .AND. (jm /= jjm) .AND. (lm /= llm))  THEN
+    WRITE(numout,*) ' dimensions are not good. Verify FILE :'
+    WRITE(numout,*) ' filename = ',filename
+    WRITE(numout,*) ' im, jm, lm lus         = ', im, jm, lm
+    WRITE(numout,*) ' iim, jjm, llm demandes = ', iim, jjm, llm
+    CALL ipslerr_p(3,'dim2_driver','Pb in dimensions','','')
+  ENDIF  
+!=====================================================================
+!- 1.5  Configures the time-steps and other parameters 
+!-      of the run.
+!=====================================================================
+!-
+! If the time steping of the restart is different from the one
+! of the forcing we need to convert the itau_dep into the
+! chronology of the forcing. This ensures that the forcing will
+! start at the date of the restart file. Obviously the itau_fin
+! needs to be shifted as well !
+!-
+  IF ( (dt_rest /= dt_force).AND.(itau_dep > 1) ) THEN
+    itau_dep = NINT((itau_dep*dt_rest )/dt_force)
+    itau_fin = itau_dep+tm
+    if (printlev_loc>=3) WRITE(numout,*) &
+ & 'The time steping of the restart is different from the one ',&
+ & 'of the forcing we need to convert the itau_dep into the ',&
+ & 'chronology of the forcing. This ensures that the forcing will ',&
+ & 'start at the date of the restart file. Obviously the itau_fin ',&
+ & 'needs to be shifted as well : itau_dep, itau_fin ', &
+ & itau_dep, itau_fin
+  ENDIF
+!-
+! Same things if the starting dates are not the same.
+! Everything should look as if we had only one forcing file !
+!-
+  IF (date0 /= date0_rest) THEN
+    WRITE(numout,*) 'date0_rest , date0 : ',date0_rest , date0
+    for_offset = NINT((date0_rest-date0)*one_day/dt_force)
+  ELSE
+    for_offset = 0
+  ENDIF
+  WRITE(numout,*) 'OFFSET FOR THE data read :', for_offset
+
+  CALL ioconf_startdate(date0_rest)
+!-
+  !Config Key   = TIME_SKIP
+  !Config Desc  = Time in the forcing file at which the model is started.
+  !Config If    = [-]
+  !Config Def   = 0
+  !Config Help  = This time give the point in time at which the model
+  !Config         should be started. If exists, the date of the restart file is use.
+  !Config         The FORMAT of this date can be either of the following :
+  !Config         n   : time step n within the forcing file
+  !Config         nS  : n seconds after the first time-step in the file
+  !Config         nD  : n days after the first time-step
+  !Config         nM  : n month after the first time-step (year of 365 days)
+  !Config         nY  : n years after the first time-step (year of 365 days)
+  !Config         Or combinations :
+  !Config         nYmM: n years and m month
+  !Config Units = [seconds, days, months, years]
+!-
+  itau_skip = 0
+  WRITE(time_str,'(I10)') itau_skip
+  CALL getin_p('TIME_SKIP', time_str)
+!-
+! Transform into itau
+!-
+  CALL tlen2itau (time_str, dt_force, date0, itau_skip)
+!-
+  itau_dep = itau_dep+itau_skip
+!-
+! We need to select the right position of the splited time steps.
+!-
+  istp = itau_dep*split+1
+  IF (MOD(istp-1,split) /= 0) THEN
+    split_start = MOD(istp-1,split)+1
+  ELSE
+    split_start = 1
+  ENDIF
+  istp_old = itau_dep_rest
+  itau_len = itau_fin-itau_dep
+
+  !Config Key   = TIME_LENGTH
+  !Config Desc  = Length of the integration in time.
+  !Config If    = [-]
+  !Config Def   = Full length of the forcing file 
+  !Config Help  = Length of integration. By default the entire length
+  !Config         of the forcing is used. The FORMAT of this date can
+  !Config         be either of the following :
+  !Config         n   : time step n within the forcing file
+  !Config         nS  : n seconds after the first time-step in the file
+  !Config         nD  : n days after the first time-step
+  !Config         nM  : n month after the first time-step (year of 365 days)
+  !Config         nY  : n years after the first time-step (year of 365 days)
+  !Config         Or combinations :
+  !Config         nYmM: n years and m month
+  !Config Units = [seconds, days, months, years]
+!-
+  WRITE(time_str,'(I10)') itau_len
+  CALL getin_p('TIME_LENGTH', time_str)
+!-
+! Transform into itau
+!-
+  CALL tlen2itau (time_str, dt_force, date0, itau_len)
+!-
+  itau_fin = itau_dep+itau_len
+!-
+  WRITE(numout,*) '>> Time origine in the forcing file :', date0
+  WRITE(numout,*) '>> Time origine in the restart file :', date0_rest
+  WRITE(numout,*) '>> Simulate starts at forcing time-step : ', itau_dep
+  WRITE(numout,*) '>> The splited time-steps start at (Sets the '
+  WRITE(numout,*) '>>  chronology for the history and restart files):',istp
+  WRITE(numout,*) '>> The time spliting starts at :', split_start
+  WRITE(numout,*) '>> Simulation ends at forcing time-step: ', itau_fin
+  WRITE(numout,*) '>> Length of the simulation is thus :', itau_len
+  WRITE(numout,*) '>> Length of the forcing data is in time-steps : ', tm
+  IF (tm < itau_len) THEN
+     CALL ipslerr_p ( 2, 'dim2_driver','Length of the simulation is greater than.', &
+ &         ' Length of the forcing data is in time-steps','verify TIME_LENGTH parameter.')
+  ENDIF
+  WRITE(numout,*) '>> Time steps : true, forcing and restart : ', dt,dt_force,dt_rest
+
+!=====================================================================
+!- 2.0 This section is going to define the details by which
+!-     the input data is going to be used to force the
+!-     land-surface scheme. The tasks are the following :
+!-   - Is the coupling going to be explicit or implicit
+!-   - Type of interpolation to be used.
+!-   - At which height are the atmospheric forcings going to be used ?
+!-   - Is a relaxation method going to be used on the forcing
+!-   - Does net radiation in the interpolated data need to be conserved
+!-   - How do we distribute precipitation.
+!=====================================================================
+  !Config Key   = RELAXATION
+  !Config Desc  = method of forcing
+  !Config If    = [-]
+  !Config Def   = n
+  !Config Help  = A method is proposed by which the first atmospheric
+  !Config         level is not directly forced by observations but
+  !Config         relaxed with a time constant towards observations.
+  !Config         For the moment the methods tends to smooth too much
+  !Config         the diurnal cycle and introduces a time shift.
+  !Config         A more sophisticated method is needed.
+  !Config Units = [FLAG]
+!-
+  relaxation = .FALSE.
+  CALL getin_p('RELAXATION', relaxation)  
+  IF ( relaxation ) THEN
+     WRITE(numout,*) 'dim2_driver : The relaxation option is temporarily disabled as it does not'
+     WRITE(numout,*) '              produce energy conservation in ORCHIDEE. If you intend to use it'
+     WRITE(numout,*) '              you should validate it.'
+     CALL ipslerr_p(3,'dim2_driver','relaxation option is not activated.','This option needs to be validated.','')
+
+     !Config Key   = RELAX_A
+     !Config Desc  = Time constant of the relaxation layer
+     !Config If    = RELAXATION
+     !Config Def   = 1.0
+     !Config Help  = The time constant associated to the atmospheric
+     !Config         conditions which are going to be computed
+     !Config         in the relaxed layer. To avoid too much
+     !Config         damping the value should be larger than 1000.
+     !Config Units = [days?]
+!-
+     alpha = 1000.0
+     CALL getin_p('RELAX_A', alpha)
+  ENDIF
+!-
+  no_inter = .TRUE.
+  inter_lin = .FALSE.
+
+  !Config Key   = NO_INTER 
+  !Config Desc  = No interpolation IF split is larger than 1
+  !Config If    = [-]
+  !Config Def   = y
+  !Config Help  = Choose IF you do not wish to interpolate linearly.
+  !Config Units = [FLAG]
+  CALL getin_p('NO_INTER', no_inter)
+
+  !Config Key   = INTER_LIN
+  !Config Desc  = Interpolation IF split is larger than 1
+  !Config If    = [-]
+  !Config Def   = n
+  !Config Help  = Choose IF you wish to interpolate linearly.
+  !Config Units = [FLAG]
+  CALL getin_p('INTER_LIN', inter_lin)
+!-
+  IF (inter_lin) THEN
+     no_inter = .FALSE.
+  ELSE
+     no_inter = .TRUE.
+  ENDIF
+!-
+  IF (split == 1) THEN
+    no_inter = .TRUE.
+    inter_lin = .FALSE.
+  ENDIF
+!-
+  !Config Key   = SPRED_PREC
+  !Config Desc  = Spread the precipitation.
+  !Config If    = [-]
+  !Config Def   = Half of the forcing time step or uniform, depending on dt_force and dt_sechiba
+  !Config Help  = Spread the precipitation over SPRED_PREC steps of the splited forcing 
+  !Config         time step. This ONLY applied if the forcing time step has been splited.
+  !Config         If the value indicated is greater than SPLIT_DT, SPLIT_DT is used for it.
+  !Config Units = [-]
+!-
+  IF ( dt_force >= 3*one_hour) THEN
+     ! Distribut the precipitations over the half of the forcing time step 
+     nb_spread = INT(0.5 * (dt_force/dt))
+  ELSE
+     ! Distribut the precipitations uniformly over the forcing time step
+     nb_spread = dt_force/dt
+  END IF
+
+  CALL getin_p('SPRED_PREC', nb_spread)  
+  IF (nb_spread > split) THEN
+    WRITE(numout,*) 'WARNING : nb_spread is too large it will be '
+    WRITE(numout,*) '          set to the value of split'
+    nb_spread = split
+  ELSE IF (split == 1) THEN
+    nb_spread = 1
+  ENDIF
+
+  IF (inter_lin) THEN
+     !Config Key   = NETRAD_CONS
+     !Config Desc  = Conserve net radiation in the forcing
+     !Config Def   = y
+     !Config If    = INTER_LIN
+     !Config Help  = When the interpolation is used the net radiation
+     !Config         provided by the forcing is not conserved anymore.
+     !Config         This should be avoided and thus this option should
+     !Config         be TRUE (y).
+     !Config         This option is not used for short-wave if the
+     !Config         time-step of the forcing is longer than an hour.
+     !Config         It does not make sense to try and reconstruct
+     !Config         a diurnal cycle and at the same time conserve the 
+     !Config         incoming solar radiation.
+     !Config Units = [FLAG]
+     !-
+     netrad_cons = .TRUE.
+     CALL getin_p('NETRAD_CONS', netrad_cons)
+  ELSE
+     netrad_cons = .FALSE.
+  ENDIF
+!=====================================================================
+!- 3.0 Finaly we can prepare all the variables before launching
+!-     the simulation !
+!=====================================================================
+! Initialize LOGICAL and the length of the integration
+!-
+  lstep_init = .TRUE.
+  lstep_last = .FALSE.
+
+  temp_sol_NEW(:,:) = tp_00
+!-  
+  !Config Key   = ATM_CO2
+  !Config Desc  = Value for atm CO2
+  !Config If    = [-]
+  !Config Def   = 350.
+  !Config Help  = Value to prescribe the atm CO2.
+  !Config         For pre-industrial simulations, the value is 286.2 .
+  !Config         348. for 1990 year.
+  !Config Units = [ppm]
+!-
+  atmco2=350.
+  CALL getin_p('ATM_CO2',atmco2)
+  for_ccanopy(:,:)=atmco2
+!-
+! Preparing for the implicit scheme.
+! This means loading the prognostic variables from the restart file.
+!-
+  Flag=.FALSE.
+  IF (is_root_prc) THEN
+     ALLOCATE(fluxsens_g(iim_g,jjm_g))
+     var_name= 'fluxsens'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., fluxsens_g)
+     IF (ALL(fluxsens_g(:,:) == val_exp)) THEN
+        Flag=.TRUE.
+     ELSE
+        Flag=.FALSE.
+     ENDIF
+  ELSE
+     ALLOCATE(fluxsens_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF (.NOT. Flag) THEN
+     CALL scatter2D_mpi(fluxsens_g,fluxsens)
+  ELSE
+     fluxsens(:,:) = zero
+  ENDIF
+  DEALLOCATE(fluxsens_g)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(vevapp_g(iim_g,jjm_g))
+     var_name= 'vevapp'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., vevapp_g)
+     IF (ALL(vevapp_g(:,:) == val_exp)) THEN
+        Flag=.TRUE.
+     ELSE
+        Flag=.FALSE.
+     ENDIF
+  ELSE
+     ALLOCATE(vevapp_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF (.NOT. Flag) THEN
+     CALL scatter2D_mpi(vevapp_g,vevapp)
+  ELSE
+     vevapp(:,:) = zero
+  ENDIF
+  DEALLOCATE(vevapp_g)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(old_zlev_g(iim_g,jjm_g))
+     var_name= 'zlev_old'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., old_zlev_g)
+     IF (ALL(old_zlev_g(:,:) == val_exp)) THEN
+        Flag=.TRUE.
+     ELSE
+        Flag=.FALSE.
+     ENDIF
+  ELSE
+     ALLOCATE(old_zlev_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF ( .NOT. Flag ) THEN
+     CALL scatter2D_mpi(old_zlev_g,old_zlev)
+  ELSE
+     old_zlev(:,:)=zlev_vec(:,:)
+  ENDIF
+  DEALLOCATE(old_zlev_g)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(old_qair_g(iim_g,jjm_g))
+     var_name= 'qair_old'
+     CALL restget &
+ &       (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., old_qair_g)
+    IF (ALL(old_qair_g(:,:) == val_exp)) THEN
+      Flag=.TRUE.
+    ELSE
+      Flag=.FALSE.
+    ENDIF
+  ELSE
+     ALLOCATE(old_qair_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF ( .NOT. Flag ) THEN
+     CALL scatter2D_mpi(old_qair_g,old_qair)
+  ELSE
+     old_qair(:,:) = qair_obs(:,:)
+  ENDIF
+  DEALLOCATE(old_qair_g)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(old_eair_g(iim_g,jjm_g))
+     var_name= 'eair_old'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., old_eair_g)
+    IF (ALL(old_eair_g(:,:) == val_exp)) THEN
+      Flag=.TRUE.
+    ELSE
+      Flag=.FALSE.
+    ENDIF
+  ELSE
+     ALLOCATE(old_eair_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF ( .NOT. Flag ) THEN
+     CALL scatter2D_mpi(old_eair_g,old_eair)
+  ELSE
+     DO ik=1,nbindex
+        i=ilandindex(ik)
+        j=jlandindex(ik)
+        old_eair(i,j) = cp_air * tair_obs(i,j) + cte_grav*zlev_vec(i,j)
+     ENDDO
+  ENDIF
+  DEALLOCATE(old_eair_g)
+!-
+! old density is also needed because we do not yet have the right pb
+!-
+!=> obsolète ??!! (tjrs calculé après forcing_read) 
+  IF (is_root_prc) THEN
+     ALLOCATE(for_rau_g(iim_g,jjm_g))
+     var_name= 'rau_old'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., for_rau_g)
+    IF (ALL(for_rau_g(:,:) == val_exp)) THEN
+      Flag=.TRUE.
+    ELSE
+      Flag=.FALSE.
+    ENDIF
+  ELSE
+     ALLOCATE(for_rau_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF ( .NOT. Flag ) THEN
+     CALL scatter2D_mpi(for_rau_g,for_rau)
+  ELSE
+     DO ik=1,nbindex
+        i=ilandindex(ik)
+        j=jlandindex(ik)
+        for_rau(i,j) = pb(i,j)/(cte_molr*(tair_obs(i,j)))
+     ENDDO
+  ENDIF
+  DEALLOCATE(for_rau_g)
+!-
+! For this variable the restart is extracted by SECHIBA
+!-
+  temp_sol_NEW(:,:) = tair_obs(:,:)
+!- 
+  if (.NOT. is_watchout) THEN
+!-
+!   This does not yield a correct restart in the case of relaxation
+!-
+     IF (is_root_prc) THEN
+        ALLOCATE(petAcoef_g(iim_g,jjm_g))
+        var_name= 'petAcoef'
+        CALL restget &
+ &           (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., petAcoef_g)
+        IF (ALL(petAcoef_g(:,:) == val_exp)) THEN
+           Flag=.TRUE.
+        ELSE
+           Flag=.FALSE.
+        ENDIF
+     ELSE
+        ALLOCATE(petAcoef_g(0,1))
+     ENDIF
+     CALL bcast(Flag)
+     IF ( .NOT. Flag ) THEN
+        CALL scatter2D_mpi(petAcoef_g,petAcoef)
+     ELSE
+        petAcoef(:,:) = zero
+     ENDIF
+     DEALLOCATE(petAcoef_g)
+!--
+     IF (is_root_prc) THEN
+        ALLOCATE(petBcoef_g(iim_g,jjm_g))
+        var_name= 'petBcoef'
+        CALL restget &
+ &           (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., petBcoef_g)
+        IF (ALL(petBcoef_g(:,:) == val_exp)) THEN
+           Flag=.TRUE.
+        ELSE
+           Flag=.FALSE.
+        ENDIF
+     ELSE
+        ALLOCATE(petBcoef_g(0,1))
+     ENDIF
+     CALL bcast(Flag)
+     IF ( .NOT. Flag ) THEN
+        CALL scatter2D_mpi(petBcoef_g,petBcoef)
+     ELSE
+        petBcoef(:,:) = old_eair(:,:)
+     ENDIF
+     DEALLOCATE(petBcoef_g)
+!--
+     IF (is_root_prc) THEN
+        ALLOCATE(peqAcoef_g(iim_g,jjm_g))
+        var_name= 'peqAcoef'
+        CALL restget &
+ &           (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., peqAcoef_g)
+        IF (ALL(peqAcoef_g(:,:) == val_exp)) THEN
+           Flag=.TRUE.
+        ELSE
+           Flag=.FALSE.
+        ENDIF
+     ELSE
+        ALLOCATE(peqAcoef_g(0,1))
+     ENDIF
+     CALL bcast(Flag)
+     IF ( .NOT. Flag ) THEN
+        CALL scatter2D_mpi(peqAcoef_g,peqAcoef)
+     ELSE
+        peqAcoef(:,:) = zero
+     ENDIF
+     DEALLOCATE(peqAcoef_g)
+!--
+     IF (is_root_prc) THEN
+        ALLOCATE(peqBcoef_g(iim_g,jjm_g))
+        var_name= 'peqBcoef'
+        CALL restget &
+ &           (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., peqBcoef_g)
+        IF (ALL(peqBcoef_g(:,:) == val_exp)) THEN
+           Flag=.TRUE.
+        ELSE
+           Flag=.FALSE.
+        ENDIF
+     ELSE
+        ALLOCATE(peqBcoef_g(0,1))
+     ENDIF
+     CALL bcast(Flag)
+     IF ( .NOT. Flag ) THEN
+        CALL scatter2D_mpi(peqBcoef_g,peqBcoef)
+     ELSE
+        peqBcoef(:,:) = old_qair(:,:)
+     ENDIF
+     DEALLOCATE(peqBcoef_g)
+  ENDIF
+!-
+! And other variables which need initial variables. These variables
+! will get properly initialized by ORCHIDEE when it is called for 
+! the first time.
+!-
+  albedo(:,:,:) = 0.13
+  emis(:,:) = 1.0
+  z0(:,:) = 0.1
+!--
+!=====================================================================
+!- 4.0 START THE TIME LOOP
+!=====================================================================
+
+  it = itau_dep+1
+  DO WHILE ( it <= itau_fin )
+!----
+    it_force = it+for_offset
+    IF (it_force < 0) THEN
+      WRITE(numout,*) 'The day is not in the forcing file :', &
+ &               it_force, it, for_offset
+      CALL ipslerr_p(3,'dim2_driver','Pb in forcing file','','')
+    ENDIF
+    is=split_start
+    DO WHILE ( is <= split )
+!-----
+      julian = itau2date(istp, date0_rest, dt)
+      CALL ju2ymds(julian, yy, mm, dd, ss)
+      IF (printlev_loc>=3) THEN
+         WRITE(numout,*) "=============================================================="
+         WRITE(numout,"('New iteration at date : ',I4,'-',I2.2,'-',I2.2,':',F8.4)") &
+              &               yy,mm,dd,ss/3600.
+#ifdef CPP_PARA
+         IF (is_root_prc) THEN
+            WRITE(*,*) "=============================================================="
+            WRITE(*,"('New iteration at date : ',I4,'-',I2.2,'-',I2.2,':',F8.4)") &
+              &               yy,mm,dd,ss/3600.
+         ENDIF
+#endif
+      ENDIF
+!----- 
+      IF ( (it == itau_fin).AND.(is == split) ) THEN
+        lstep_last = .TRUE.
+      ENDIF
+!-----
+      IF (printlev_loc>=3) WRITE(numout,*) 'Into forcing_read'
+!-----
+      CALL forcing_READ &
+ &      (filename, rest_id, .FALSE., lstep_last, &
+ &       it_force, istp, is, split, nb_spread, netrad_cons, &
+ &       date0_rest, dt_force, iim, jjm, lon, lat, zlev_vec, zlevuv_vec, tm, &
+ &       swdown, coszang, precip_rain, precip_snow, tair_obs, &
+ &       u, v, qair_obs, pb, for_lwdown, for_contfrac, for_neighbours, for_resolution, &
+ &       for_swnet, eair_obs, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, for_ccanopy, &
+ &       kindex, nbindex, force_id)
+
+!-----
+!---- SECHIBA expects surface pressure in hPa
+!-----
+      for_psurf(:,:)  = pb(:,:)/100.
+
+      IF (printlev_loc>=4) THEN
+         WRITE(numout,*) "dim2_driver 0 ",it_force 
+         WRITE(numout,*) ">> Index of land points =",kindex(1:nbindex)
+         WRITE(numout,*) "Lowest level wind speed North = ", &
+              & (/ ( u(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level wind speed East = ", &
+              & (/ ( v(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "z0            ; Surface roughness = ", &
+              & (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Height of first layer = ", &
+              & (/ ( zlev_vec(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level specific humidity = ", &
+              & (/ ( qair_obs(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Rain precipitation = ", &
+              & (/ ( precip_rain(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+         WRITE(numout,*) "Snow precipitation = ", &
+              & (/ ( precip_snow(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+         WRITE(numout,*) "Down-welling long-wave flux = ", &
+              & (/ ( for_lwdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Net surface short-wave flux = ", &
+              & (/ ( for_swnet(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Downwelling surface short-wave flux = ", &
+              & (/ ( swdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Air temperature in Kelvin = ", &
+              & (/ ( tair_obs(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Air potential energy = ", &
+              & (/ ( eair_obs(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "CO2 concentration in the canopy = ", &
+              & (/ ( for_ccanopy(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Coeficients A from the PBL resolution = ", &
+              & (/ ( petAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "One for T and another for q = ", &
+              & (/ ( peqAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Coeficients B from the PBL resolution = ", &
+              & (/ ( petBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "One for T and another for q = ", &
+              & (/ ( peqBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Cdrag = ", &
+              & (/ ( cdrag(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /) 
+         WRITE(numout,*) "CO2 concentration in the canopy = ", &
+              & (/ ( for_ccanopy(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /) 
+         WRITE(numout,*) "Lowest level pressure = ", &
+              & (/ ( for_psurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Geographical coordinates lon = ", &
+              & (/ (  lon(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Geographical coordinates lat = ", &
+              & (/ (  lat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Fraction of continent in the grid = ", &
+              & (/ ( for_contfrac(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+      ENDIF
+!-----
+!---- Prepare : tmp_qair, tmp_eair, tmp_tair, tmp_pb
+!---- and     : for_u, for_v, for_lwdown, for_swnet, for_swdown
+!---- All the work is done in forcing_read
+!---- We do not need the no_inter options as we will
+!---- allways interpolate
+!----- 
+      IF (printlev_loc>=3) WRITE(numout,*) 'Prepare the atmospheric forcing'
+!----- 
+      IF (.NOT. is_watchout) THEN
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            eair_obs(i,j) = cp_air*tair_obs(i,j)+cte_grav*zlev_vec(i,j)
+            for_swnet(i,j) = (1.-(albedo(i,j,1)+albedo(i,j,2))/2.)*swdown(i,j)
+         ENDDO
+      ENDIF
+      DO ik=1,nbindex
+         i=ilandindex(ik)
+         j=jlandindex(ik)
+         for_swdown(i,j) = swdown(i,j)
+         for_coszang(i,j) = coszang(i,j)
+      ENDDO
+!----- 
+!---- Computing the buffer zone !
+!----- 
+      IF (relaxation) THEN
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_qair(i,j) = peqAcoef(i,j)*(-1.) * vevapp(i,j)*dt+peqBcoef(i,j)
+!-------
+            for_eair(i,j) = petAcoef(i,j)*(-1.) * fluxsens(i,j)+petBcoef(i,j)
+!-------
+         ENDDO
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_tair(i,j) = (for_eair(i,j) - cte_grav*zlev_vec(i,j))/cp_air
+!-------
+!!$        if (.NOT. is_watchout) &
+!!$             epot_sol(:,:) = cp_air*temp_sol_NEW(:,:)
+!-------
+         ENDDO
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_rau(i,j) = pb(i,j) / (cte_molr*for_tair(i,j))
+!-------
+            relax(i,j) = for_rau(i,j)*alpha 
+         ENDDO
+
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            zlflu = zlev_vec(i,j)/2.0*dt
+            peqAcoef(i,j) = 1.0/(zlflu+relax(i,j))
+            peqBcoef(i,j) = (relax(i,j) * qair_obs(i,j)/(zlflu+relax(i,j))) + & 
+                 & for_qair(i,j)/(1.0+relax(i,j)/zlflu)
+         ENDDO
+!-------
+!        relax(:,:) = for_rau(:,:)*alpha 
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            petAcoef(i,j) = 1.0/(zlflu+relax(i,j))
+            petBcoef(i,j) = ( relax(i,j) * eair_obs(i,j) / (zlflu+relax(i,j)) ) &
+                 & + for_eair(i,j)/(1.0+relax(i,j)/zlflu)
+         ENDDO
+      ELSE
+         for_qair(:,:) = fill_init
+         for_eair(:,:) = fill_init
+         for_tair(:,:) = fill_init
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_qair(i,j) = qair_obs(i,j)
+            for_eair(i,j) = eair_obs(i,j)
+            for_tair(i,j) = tair_obs(i,j)
+         ENDDO
+!-------
+!!$        if (.NOT. is_watchout) &
+!!$             epot_sol(:,:) =  cp_air*temp_sol_NEW(:,:)
+!-------
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_rau(i,j) = pb(i,j) / (cte_molr*for_tair(i,j))
+         ENDDO
+!-------
+         IF (.NOT. is_watchout) THEN
+           petAcoef(:,:) = 0.0
+           peqAcoef(:,:) = 0.0
+           DO ik=1,nbindex
+              i=ilandindex(ik)
+              j=jlandindex(ik)
+              petBcoef(i,j) = eair_obs(i,j)
+              peqBcoef(i,j) = qair_obs(i,j)
+           ENDDO
+        ENDIF
+      ENDIF
+!-----
+      IF (.NOT. is_watchout) &
+           cdrag(:,:)  = 0.0
+      for_ccanopy(:,:)=atmco2
+!-----
+!---- SECHIBA expects wind, temperature and humidity at the same height.
+!---- If this is not the case then we need to correct for that.
+!-----
+      DO ik=1,nbindex
+         i=ilandindex(ik) 
+         j=jlandindex(ik)
+         for_u(i,j) = u(i,j)*LOG(zlev_vec(i,j)/z0(i,j)) / &
+              LOG(zlevuv_vec(i,j)/z0(i,j)) 
+         for_v(i,j) = v(i,j)*LOG(zlev_vec(i,j)/z0(i,j)) / &
+              LOG(zlevuv_vec(i,j)/z0(i,j))
+      END DO
+            
+!-----
+!---- Prepare the other variables WITH the special CASE
+!---- of splited time steps
+!----
+!---- PRINT input value for printlev_loc>=3
+!-----
+      IF (printlev_loc>=3) THEN
+        WRITE(numout,*) ' >>>>>> time step it_force = ',it_force
+        WRITE(numout,*) &
+ &       ' tair, qair, eair = ', &
+ &       for_tair(itest,jtest),for_qair(itest,jtest), &
+ &       for_eair(itest,jtest)
+        WRITE(numout,*) &
+ &       ' OBS : tair, qair, eair = ', &
+ &       tair_obs(itest,jtest),qair_obs(itest,jtest), &
+ &       eair_obs(itest,jtest)
+        WRITE(numout,*) ' u et v = ',for_u(itest,jtest),for_v(itest,jtest)
+        WRITE(numout,*) ' precip rain et snow = ', &
+        & precip_rain(itest,jtest),precip_snow(itest,jtest)
+        WRITE(numout,*) ' lwdown et swnet = ', &
+        & for_lwdown(itest,jtest),for_swnet(itest,jtest)
+        WRITE(numout,*) ' petAcoef et peqAcoef = ', &
+        & petAcoef(itest,jtest), peqAcoef(itest,jtest)
+        WRITE(numout,*) ' petBcoef et peqAcoef = ', &
+        & petBcoef(itest,jtest),peqBcoef(itest,jtest)
+        WRITE(numout,*) ' zlev = ',zlev_vec(itest,jtest)
+      ENDIF
+!-----
+
+      IF (lstep_init) THEN
+
+        DO ik=1,nbindex
+           i=ilandindex(ik)
+           j=jlandindex(ik)
+           for_swdown(i,j) = swdown(i,j)
+           for_coszang(i,j) = coszang(i,j)
+        ENDDO
+        IF (printlev_loc>=4) THEN
+           WRITE(numout,*) "dim2_driver lstep_init ",it_force 
+           WRITE(numout,*) ">> Index of land points =",kindex(1:nbindex)
+           WRITE(numout,*) "Lowest level wind speed North = ", &
+             &     (/ ( for_u(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Lowest level wind speed East = ", &
+             &     (/ ( for_v(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "z0            ; Surface roughness = ", &
+             &     (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Height of first layer = ", &
+             &     (/ ( zlev_vec(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Lowest level specific humidity = ", &
+             &     (/ ( for_qair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Rain precipitation = ", &
+             &     (/ ( precip_rain(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+           WRITE(numout,*) "Snow precipitation = ", &
+             &     (/ ( precip_snow(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+           WRITE(numout,*) "Down-welling long-wave flux = ", &
+             &     (/ ( for_lwdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Net surface short-wave flux = ", &
+             &     (/ ( for_swnet(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Downwelling surface short-wave flux = ", &
+             &     (/ ( for_swdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Air temperature in Kelvin = ", &
+             &     (/ ( for_tair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Air potential energy = ", &
+             &     (/ ( for_eair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "CO2 concentration in the canopy = ", &
+             &     (/ ( for_ccanopy(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Coeficients A from the PBL resolution = ", &
+             &     (/ ( petAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "One for T and another for q = ", &
+             &     (/ ( peqAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Coeficients B from the PBL resolution = ", &
+             &     (/ ( petBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "One for T and another for q = ", &
+             &     (/ ( peqBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Cdrag = ", &
+             &     (/ ( cdrag(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Lowest level pressure = ", &
+             &     (/ ( for_psurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Geographical coordinates lon = ", &
+             &     (/ (  lon(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Geographical coordinates lat = ", &
+             &     (/ (  lat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Fraction of continent in the grid = ", &
+             &     (/ ( for_contfrac(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+        ENDIF
+!-------
+!------ CALL sechiba to initialize fields
+!------ and have some initial results: emis, albedo, z0
+!-------
+        CALL intersurf_initialize_2d &
+ &        (istp_old, iim, jjm, nbindex, kindex, dt, &
+ &         lstep_init, .FALSE., lon, lat, for_contfrac, for_resolution, date0_rest, &
+!       first level conditions
+ &         zlev_vec, for_u, for_v, &
+ &         for_qair, for_tair, for_eair, for_ccanopy, &
+!       Variables for the implicit coupling
+ &         cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+!       Rain, snow, radiation and surface pressure
+ &         precip_rain, precip_snow, &
+ &         for_lwdown, for_swnet, for_swdown, for_psurf, &
+!       Output : Fluxes
+ &         vevapp, fluxsens, fluxlat, coastalflow, riverflow,  &
+!       Surface temperatures and surface properties
+ &         tsol_rad, temp_sol_NEW, qsurf, albedo, emis, z0, &
+!       cosine to solar zenith angle
+ &         coszang )
+
+        CALL Stop_timer(timer_global)
+        CALL Stop_timer(timer_mpi)
+        CALL Start_timer(timer_global)
+        CALL Start_timer(timer_mpi)
+        !
+        lstep_init = .FALSE.
+        !
+        ! Get Restart values for albedo and z0, 
+        ! as they modify forcing variables swnet and wind.
+!-------
+        ! albedo 
+        IF (is_root_prc) THEN
+           ALLOCATE(albedo_g(iim_g,jjm_g))
+        ELSE
+           ALLOCATE(albedo_g(0,1))
+        ENDIF
+        !
+        IF (is_root_prc) THEN
+           var_name= 'albedo_vis'
+           CALL restget &
+                &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., albedo_g)
+           IF (ALL(albedo_g(:,:) == val_exp)) THEN
+              Flag=.TRUE.
+           ELSE
+              Flag=.FALSE.
+           ENDIF
+        ENDIF
+        CALL bcast(Flag)
+        IF ( .NOT. Flag ) THEN
+           CALL scatter2D_mpi(albedo_g,albedo_vis)
+           albedo(:,:,1)=albedo_vis(:,:)
+        ELSE
+           albedo_vis(:,:)=albedo(:,:,1)
+        ENDIF
+        !
+        IF (is_root_prc) THEN
+           var_name= 'albedo_nir'
+           CALL restget &
+                &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., albedo_g)
+           IF (ALL(albedo_g(:,:) == val_exp)) THEN
+              Flag=.TRUE.
+           ELSE
+              Flag=.FALSE.
+           ENDIF
+        ENDIF
+        CALL bcast(Flag)
+        IF ( .NOT. Flag ) THEN
+           CALL scatter2D_mpi(albedo_g,albedo_nir)
+           albedo(:,:,2)=albedo_nir(:,:)
+        ELSE
+           albedo_nir(:,:)=albedo(:,:,2)
+        ENDIF
+        !
+        DEALLOCATE(albedo_g)
+        !--
+        ! z0 
+        IF (is_root_prc) THEN
+           ALLOCATE(z0_g(iim_g,jjm_g))
+           var_name= 'z0'
+           CALL restget &
+                &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., z0_g)
+           IF (ALL(z0_g(:,:) == val_exp)) THEN
+              Flag=.TRUE.
+           ELSE
+              Flag=.FALSE.
+           ENDIF
+        ELSE
+           ALLOCATE(z0_g(0,1))
+        ENDIF
+        CALL bcast(Flag)
+        IF (.NOT. Flag) &
+             CALL scatter2D_mpi(z0_g,z0)
+        DEALLOCATE(z0_g)
+!-------
+        DO ik=1,nbindex
+           i=ilandindex(ik)
+           j=jlandindex(ik)
+           temp_sol_old(i,j) = temp_sol_NEW(i,j)
+           for_swnet(i,j) = (1.- (albedo(i,j,1)+albedo(i,j,2))/2.)*swdown(i,j)
+           for_swdown(i,j) = swdown(i,j)
+           for_coszang(i,j) = coszang(i,j)
+        ENDDO
+!
+!     MM : z0 have been modified then we must lower the wind again
+!-----
+!---- SECHIBA expects wind, temperature and humidity at the same height.
+!---- If this is not the case then we need to correct for that.
+!-----
+        DO ik=1,nbindex 
+           i=ilandindex(ik) 
+           j=jlandindex(ik) 
+           for_u(i,j) = u(i,j) * LOG(zlev_vec(i,j)/z0(i,j)) / & 
+                LOG(zlevuv_vec(i,j)/z0(i,j)) 
+           for_v(i,j) = v(i,j) * LOG(zlev_vec(i,j)/z0(i,j)) / &
+                LOG(zlevuv_vec(i,j)/z0(i,j)) 
+        END DO
+        
+!-----
+!---- PRINT input value after lstep_init for printlev_loc>=3
+!-----
+        IF (printlev_loc>=3) THEN
+           WRITE(numout,*) ' >>>>>> after lstep_init = ',lstep_init
+           WRITE(numout,*) ' u et v = ',for_u(itest,jtest),for_v(itest,jtest)
+           WRITE(numout,*) ' swnet = ', for_swnet(itest,jtest)
+        ENDIF
+!-------
+        IF (printlev_loc>=4) THEN
+           WRITE(numout,*) "dim2_driver lstep_init outputs"
+           !       Output : Fluxes
+           WRITE(numout,*) "vevapp        ; Total of evaporation = ", &
+             &     (/ ( vevapp(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Sensible heat flux = ", &
+             &     (/ ( fluxsens(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Latent heat flux = ", &
+             &     (/ ( fluxlat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "coastalflow   ; Diffuse flow of water into the ocean (m^3/dt) = ", &
+             &     (/ ( coastalflow(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "riverflow     ; Largest rivers flowing into the ocean (m^3/dt) = ", &
+             &     (/ ( riverflow(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           !       Surface temperatures and surface properties
+           WRITE(numout,*) "tsol_rad      ; Radiative surface temperature = ", &
+             &     (/ ( tsol_rad(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "temp_sol_new  ; New soil temperature = ", &
+             &     (/ ( temp_sol_NEW(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "qsurf         ; Surface specific humidity = ", &
+             &     (/ ( qsurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "albedoVIS = ", &
+             &     (/ ( albedo(ilandindex(ik), jlandindex(ik), 1),ik=1,nbindex ) /)
+           WRITE(numout,*) "albedoNIR = ", &
+             &     (/ ( albedo(ilandindex(ik), jlandindex(ik), 2),ik=1,nbindex ) /)
+           WRITE(numout,*) "emis          ; Emissivity = ", &
+             &     (/ ( emis(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "z0            ; Surface roughness = ", &
+             &     (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+        ENDIF
+!-------
+        IF (printlev_loc>=3) THEN
+          WRITE(numout,*) &
+ &         ' OUT rest : z0, albedoVIS, albedoNIR, emis = ', &
+ &         z0(itest,jtest),albedo(itest,jtest,1), &
+ &                         albedo(itest,jtest,2),emis(itest,jtest)
+          WRITE(numout,*) ' OUT rest : coastal and river flow = ', &
+ &         coastalflow(itest,jtest), riverflow(itest,jtest)
+          WRITE(numout,*) ' OUT rest : tsol_rad, vevapp = ', &
+ &         tsol_rad(itest,jtest), vevapp(itest,jtest)
+          WRITE(numout,*) ' OUT rest : temp_sol_new =', &
+ &         temp_sol_NEW(itest,jtest)
+        ENDIF
+    
+      ENDIF ! lstep_init
+!-----
+!---- Calling SECHIBA and doing the number crunching.
+!---- Note that for the first time step SECHIBA is called twice.
+!----
+!---- All H_2O fluxes are now in Kg/m^2s
+!-----
+      IF (printlev_loc>=4) THEN
+         WRITE(numout,*) "dim2_driver ",it_force 
+         WRITE(numout,*) ">> Index of land points =",kindex(1:nbindex)
+         WRITE(numout,*) "Lowest level wind speed North = ", &
+           &     (/ ( for_u(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level wind speed East = ", &
+           &     (/ ( for_v(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "z0            ; Surface roughness = ", &
+           &     (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Height of first layer = ", &
+           &     (/ ( zlev_vec(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level specific humidity = ", &
+           &     (/ ( for_qair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Rain precipitation = ", &
+           &     (/ ( precip_rain(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+         WRITE(numout,*) "Snow precipitation = ", &
+           &     (/ ( precip_snow(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+         WRITE(numout,*) "Down-welling long-wave flux = ", &
+           &     (/ ( for_lwdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Net surface short-wave flux = ", &
+           &     (/ ( for_swnet(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Downwelling surface short-wave flux = ", &
+           &     (/ ( for_swdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Air temperature in Kelvin = ", &
+           &     (/ ( for_tair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Air potential energy = ", &
+           &     (/ ( for_eair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "CO2 concentration in the canopy = ", &
+           &     (/ ( for_ccanopy(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Coeficients A from the PBL resolution = ", &
+           &     (/ ( petAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "One for T and another for q = ", &
+           &     (/ ( peqAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Coeficients B from the PBL resolution = ", &
+           &     (/ ( petBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "One for T and another for q = ", &
+           &     (/ ( peqBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Cdrag = ", &
+           &     (/ ( cdrag(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level pressure = ", &
+           &     (/ ( for_psurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Geographical coordinates lon = ", &
+           &     (/ (  lon(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Geographical coordinates lat = ", &
+           &     (/ (  lat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Fraction of continent in the grid = ", &
+           &     (/ ( for_contfrac(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+      ENDIF
+      
+      CALL intersurf_main_2d &
+ &      (istp, iim, jjm, nbindex, kindex, dt, &
+ &       lstep_init, lstep_last, lon, lat, for_contfrac, for_resolution, date0_rest, &
+!     first level conditions
+ &       zlev_vec, for_u, for_v, &
+ &       for_qair, for_tair, for_eair, for_ccanopy, &
+!     Variables for the implicit coupling
+ &       cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+!     Rain, snow, radiation and surface pressure
+ &       precip_rain, precip_snow, &
+ &       for_lwdown, for_swnet, for_swdown, for_psurf, &
+!     Output : Fluxes
+ &       vevapp, fluxsens, fluxlat, coastalflow, riverflow,  &
+!     Surface temperatures and surface properties
+ &       tsol_rad, temp_sol_NEW, qsurf, albedo, emis, z0, &
+!       VOC : radiation
+ &       for_coszang)
+
+!-------
+      IF (printlev_loc>=4) THEN
+         WRITE(numout,*) "dim2_driver outputs"
+         !       Output : Fluxes
+         WRITE(numout,*) "vevapp        ; Total of evaporation = ", &
+           &     (/ ( vevapp(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Sensible heat flux = ", &
+           &     (/ ( fluxsens(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Latent heat flux = ", &
+           &     (/ ( fluxlat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "coastalflow   ; Diffuse flow of water into the ocean (m^3/dt) = ", &
+           &     (/ ( coastalflow(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "riverflow     ; Largest rivers flowing into the ocean (m^3/dt) = ", &
+           &     (/ ( riverflow(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         !       Surface temperatures and surface properties
+         WRITE(numout,*) "tsol_rad      ; Radiative surface temperature = ", &
+           &     (/ ( tsol_rad(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "temp_sol_new  ; New soil temperature = ", &
+           &     (/ ( temp_sol_NEW(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "qsurf         ; Surface specific humidity = ", &
+           &     (/ ( qsurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "albedoVIS = ", &
+           &     (/ ( albedo(ilandindex(ik), jlandindex(ik), 1),ik=1,nbindex ) /)
+         WRITE(numout,*) "albedoNIR = ", &
+           &     (/ ( albedo(ilandindex(ik), jlandindex(ik), 2),ik=1,nbindex ) /)
+         WRITE(numout,*) "emis          ; Emissivity = ", &
+           &     (/ ( emis(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "z0            ; Surface roughness = ", &
+           &     (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+      ENDIF
+!-----
+      dtdt(:,:) = zero
+      DO ik=1,nbindex
+         i=ilandindex(ik)
+         j=jlandindex(ik)
+         dtdt(i,j) = ABS(temp_sol_NEW(i,j)-temp_sol_old(i,j))/dt
+      ENDDO
+!-----
+!---- Test if the point with the largest change has more than 5K per dt
+!-----
+      IF (printlev_loc .GT. 2) THEN
+         IF (MAXVAL(dtdt(:,:)) > 5./dt) THEN
+             ml = MAXLOC(dtdt)
+             CALL ju2ymds(julian, yy, mm, dd, ss)
+             WRITE(numout,"('ATT :',I5,' big temperature jumps on ', &
+ &            I4,'-',I2.2,'-',I2.2,':',F8.4)") &
+ &            COUNT(dtdt(:,:) > 5./dt),yy,mm,dd,ss/3600.
+             WRITE(numout,*) &
+ &            'Maximum change of surface temperature located at :', &
+ &            lon(ml(1),ml(2)),lat(ml(1),ml(2))
+             WRITE(numout,*) 'Coordinates in grid space: ',ml(1),ml(2)
+             WRITE(numout,*) 'Change from ',temp_sol_old(ml(1),ml(2)), &
+ &            ' to ',temp_sol_new(ml(1),ml(2)),&
+ &            'with sw_in = ',for_swnet(ml(1),ml(2))
+             old_tair = &
+ &             (old_eair(ml(1),ml(2))-cte_grav*old_zlev(ml(1),ml(2)))/cp_air
+             WRITE(numout,*) 'Air temperature change from ',old_tair, &
+ &            ' to ',for_tair(ml(1),ml(2))
+             WRITE(numout,*) 'Max of dtdt : ',dtdt(ml(1),ml(2)),' with dt = ',dt
+         ENDIF
+      ENDIF
+!-----
+      temp_sol_old(:,:) = temp_sol_NEW(:,:)
+!-----
+!---- PRINT output value for printlev_loc>=3
+!-----
+      IF (printlev_loc>=3) THEN
+        WRITE(numout,*) ' OUT : z0, albedoVIS, albedoNIR, emis = ', &
+ &       z0(itest,jtest),albedo(itest,jtest,1), &
+ &                       albedo(itest,jtest,2),emis(itest,jtest)
+        WRITE(numout,*) ' OUT : coastal and river flow = ',&
+ &       coastalflow(itest,jtest), riverflow(itest,jtest)
+        WRITE(numout,*) ' OUT : tsol_rad, vevapp = ', &
+ &       tsol_rad(itest,jtest), vevapp(itest,jtest)
+        WRITE(numout,*) ' OUT : temp_sol_new =', temp_sol_NEW(itest,jtest)
+      ENDIF
+!-----
+!---- Give some variables to the output package
+!---- for saving on the history tape
+!-----
+      IF (printlev_loc>=3) WRITE(numout,*) 'history written for ', istp
+!-----
+      istp_old = istp
+      istp = istp+1
+!-----
+      old_zlev(:,:) = zlev_vec(:,:)
+      old_qair(:,:) = for_qair(:,:)
+      old_eair(:,:) = for_eair(:,:)
+!-----
+      is = is + 1
+   ENDDO ! DO WHILE (is <= split)
+    split_start = 1
+    IF (it==itau_fin-1) THEN
+     
+     CALL Write_Load_Balance(REAL(Get_cpu_time(timer_mpi),r_std))
+
+    ENDIF
+    it = it + 1
+  ENDDO  ! DO WHILE (it <= itau_fin)
+!-
+! Archive in restart file the prognostic variables
+!-
+  IF (printlev_loc>=3) WRITE(numout,*) 'Write the restart for the driver', istp_old
+!-
+  var_name = 'fluxsens'
+  IF (is_root_prc) THEN
+     ALLOCATE(fluxsens_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(fluxsens_g(0,1))
+  ENDIF
+  CALL gather2D_mpi(fluxsens , fluxsens_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, fluxsens_g)
+  DEALLOCATE(fluxsens_g)
+  
+  var_name = 'vevapp'
+  IF (is_root_prc) THEN
+     ALLOCATE(vevapp_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(vevapp_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( vevapp, vevapp_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, vevapp_g)
+  DEALLOCATE(vevapp_g)
+  
+  var_name = 'zlev_old'
+  IF (is_root_prc) THEN
+     ALLOCATE(old_zlev_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(old_zlev_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( old_zlev, old_zlev_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, old_zlev_g)
+  DEALLOCATE(old_zlev_g)
+  
+  var_name = 'qair_old'
+  IF (is_root_prc) THEN
+     ALLOCATE(old_qair_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(old_qair_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( old_qair, old_qair_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, old_qair_g)
+  DEALLOCATE(old_qair_g)
+  
+  var_name = 'eair_old'
+  IF (is_root_prc) THEN
+     ALLOCATE(old_eair_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(old_eair_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( old_eair, old_eair_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, old_eair_g)
+  DEALLOCATE(old_eair_g)
+  
+  var_name = 'rau_old'
+  IF (is_root_prc) THEN
+     ALLOCATE(for_rau_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(for_rau_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( for_rau, for_rau_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, for_rau_g)
+  DEALLOCATE(for_rau_g)
+  
+  IF (is_root_prc) THEN
+     ALLOCATE(albedo_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(albedo_g(0,1))
+  ENDIF
+  var_name= 'albedo_vis'
+  albedo_vis(:,:)=albedo(:,:,1)
+  CALL gather2D_mpi(albedo_vis,albedo_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, albedo_g)  
+  !
+  var_name= 'albedo_nir'
+  albedo_nir(:,:)=albedo(:,:,2)
+  CALL gather2D_mpi(albedo_nir,albedo_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, albedo_g)  
+  DEALLOCATE(albedo_g)
+
+  IF (is_root_prc) THEN
+     ALLOCATE(z0_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(z0_g(0,1))
+  ENDIF
+  var_name= 'z0'
+  CALL gather2D_mpi(z0,z0_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, z0_g)  
+  DEALLOCATE(z0_g)
+
+  if (.NOT. is_watchout) THEN
+     var_name = 'petAcoef'
+     IF (is_root_prc) THEN
+        ALLOCATE(petAcoef_g(iim_g,jjm_g))
+     ELSE
+        ALLOCATE(petAcoef_g(0,1))
+     ENDIF
+     CALL gather2D_mpi( petAcoef, petAcoef_g)
+     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, petAcoef_g)
+     DEALLOCATE(petAcoef_g)
+  
+     var_name = 'petBcoef'
+     IF (is_root_prc) THEN
+        ALLOCATE(petBcoef_g(iim_g,jjm_g))
+     ELSE
+        ALLOCATE(petBcoef_g(0,1))
+     ENDIF
+     CALL gather2D_mpi( petBcoef, petBcoef_g)
+     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, petBcoef_g)
+     DEALLOCATE(petBcoef_g)
+  
+     var_name = 'peqAcoef'
+     IF (is_root_prc) THEN
+        ALLOCATE(peqAcoef_g(iim_g,jjm_g))
+     ELSE
+        ALLOCATE(peqAcoef_g(0,1))
+     ENDIF
+     CALL gather2D_mpi( peqAcoef, peqAcoef_g)
+     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, peqAcoef_g)
+     DEALLOCATE(peqAcoef_g)
+  
+     var_name = 'peqBcoef'
+     IF (is_root_prc) THEN
+        ALLOCATE(peqBcoef_g(iim_g,jjm_g))
+     ELSE
+        ALLOCATE(peqBcoef_g(0,1))
+     ENDIF
+     CALL gather2D_mpi( peqBcoef, peqBcoef_g)
+     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, peqBcoef_g)
+     DEALLOCATE(peqBcoef_g)
+  ENDIF
+!-
+  IF (printlev_loc>=3) WRITE(numout,*) 'Restart for the driver written'
+!=====================================================================
+!- 5.0 Closing all files
+!=====================================================================
+  CALL flinclo(force_id)
+  IF ( printlev_loc>=3 )  WRITE(numout,*) 'FLIN CLOSED'
+  CALL histclo
+  IF ( printlev_loc>=3 )   WRITE(numout,*) 'HIST CLOSED'      
+    
+  IF(is_root_prc) THEN
+     CALL restclo
+     IF ( printlev_loc>=3 )  WRITE(numout,*) 'REST CLOSED'
+     CALL getin_dump
+     IF ( printlev_loc>=3 )  WRITE(numout,*) 'GETIN CLOSED'
+  ENDIF
+
+  
+
+  WRITE(numout,*) '-------------------------------------------'
+  WRITE(numout,*) '------> CPU Time Global ',Get_cpu_Time(timer_global)
+  WRITE(numout,*) '------> CPU Time without mpi ',Get_cpu_Time(timer_mpi)
+  WRITE(numout,*) '------> Real Time Global ',Get_real_Time(timer_global)
+  WRITE(numout,*) '------> real Time without mpi ',Get_real_Time(timer_mpi)
+  WRITE(numout,*) '-------------------------------------------'
+
+  ! Call driver_clear for deallocation and reset of initialization variables
+  CALL driver_clear
+
+  CALL Finalize_mpi
+
+
+  WRITE(numout,*) 'END of dim2_driver'
+
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : driver_clear
+!!
+!>\BRIEF          Clear driver main program and call clear funcions for underlaying module intersurf
+!!
+!! DESCRIPTION  : Deallocate memory and reset initialization variables to there original values
+!!                This subroutine call intersurf_clear which will call sechiba_clear.
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE driver_clear
+    
+    CALL intersurf_clear
+
+  END SUBROUTINE driver_clear
+  
+END PROGRAM driver
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/forcesoil.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/forcesoil.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/forcesoil.f90	(revision 6412)
@@ -0,0 +1,643 @@
+! =================================================================================================================================
+! PROGRAM       : forcesoil
+!
+! CONTACT	: orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This subroutine runs the soilcarbon submodel using specific initial conditions 
+!! and driving variables in order to obtain soil carbon stocks closed to the steady-state values 
+!! quicker than when using the ''full'' ORCHIDEE.  
+!!	
+!!\n DESCRIPTION: None
+!! This subroutine computes the soil carbon stocks by calling the soilcarbon routine at each time step. \n
+!! The aim is to obtain soil carbon stocks closed to the steady-state values and ultimately to create  
+!! an updated stomate restart file for the stomate component. The state variables of the subsystem are the clay content 
+!! (fixed value) and the soil carbon stocks. Initial conditions for the state variables are read in an  
+!! input stomate restart file. Driving variables are Soil carbon input, Water and Temperature stresses on 
+!! Organic Matter decomposition. Driving variables are read from a specific forcing file produced by a former run of ORCHIDEE
+!! (SECHIBA+STOMATE). \n 
+!! The FORCESOIL program first consists in reading a set of input files, allocating variables and 
+!! preparing output stomate restart file. \n                                                             
+!! Then, a loop over time is performed in which the soilcarbon routine is called at each time step. \n
+!! Last, final values of the soil carbon stocks are written into the output stomate restart file. \n
+!! No flag is associated with the use of the FORCESOIL program. \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) : None    
+!!
+!! FLOWCHART    : None
+!!
+!! SVN		:
+!! $HeadURL: $ 
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ =================================================================================================================================
+
+PROGRAM forcesoil
+ 
+  USE netcdf
+  !-
+  USE defprec
+  USE constantes
+  USE constantes_mtc
+  USE pft_parameters 
+  USE stomate_data
+  USE ioipsl_para
+  USE mod_orchidee_para
+  USE stomate_soilcarbon
+
+  !-
+  IMPLICIT NONE
+  !-
+  CHARACTER(LEN=80)                          :: sto_restname_in,sto_restname_out
+  INTEGER(i_std)                             :: iim,jjm                !! Indices (unitless)
+
+  INTEGER(i_std),PARAMETER                   :: llm = 1                !! Vertical Layers (requested by restini routine) (unitless)
+  INTEGER(i_std)                             :: kjpindex               !! Domain size (unitless)
+
+  INTEGER(i_std)                             :: itau_dep,itau_len      !! Time step read in the restart file (?) 
+                                                                       !! and number of time steps of the simulation (unitless) 
+  CHARACTER(LEN=30)                          :: time_str               !! Length of the simulation (year)
+  REAL(r_std)                                :: dt_files               !! time step between two successive itaus (?) 
+                                                                       !! (requested by restini routine) (seconds)
+  REAL(r_std)                                :: date0                  !! Time at which itau = 0 (requested by restini routine) (?)
+  INTEGER(i_std)                             :: rest_id_sto            !! ID of the input restart file (unitless)
+  CHARACTER(LEN=20), SAVE                    :: thecalendar = 'noleap' !! Type of calendar defined in the input restart file 
+                                                                       !! (unitless)
+  !-
+  CHARACTER(LEN=100)                         :: Cforcing_name          !! Name of the forcing file (unitless)
+  INTEGER                                    :: Cforcing_id            !! ID of the forcing file (unitless)
+  INTEGER                                    :: v_id                   !! ID of the variable 'Index' stored in the forcing file 
+                                                                       !! (unitless)
+  REAL(r_std)                                :: dt_forcesoil           !! Time step at which soilcarbon routine is called (days) 
+  INTEGER                                    :: nparan                 !! Number of values stored per year in the forcing file 
+                                                                       !! (unitless)
+  INTEGER                                    :: nbyear
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE    :: indices                !! Grid Point Index used per processor (unitless)
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE    :: indices_g              !! Grid Point Index for all processor (unitless)
+  REAL(r_std),DIMENSION(:),ALLOCATABLE       :: x_indices_g            !! Grid Point Index for all processor (unitless)
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE     :: lon, lat               !! Longitude and Latitude of each grid point defined 
+                                                                       !! in lat/lon (2D) (degrees)
+  REAL(r_std),DIMENSION(llm)                 :: lev                    !! Number of level (requested by restini routine) (unitless)
+
+
+  INTEGER                                    :: i,m,iatt,iv,iyear  !! counters (unitless)
+
+  CHARACTER(LEN=80)                          :: var_name
+  CHARACTER(LEN=800)                         :: taboo_vars         !! string used for storing the name of the variables 
+                                                                   !! of the stomate restart file that are not automatically 
+                                                                   !! duplicated from input to output restart file (unitless)
+  REAL(r_std),DIMENSION(1)                   :: xtmp               !! scalar read/written in restget/restput routines (unitless)
+  INTEGER(i_std),PARAMETER                   :: nbvarmax=300       !! maximum # of variables assumed in the stomate restart file 
+                                                                   !! (unitless)
+  INTEGER(i_std)                             :: nbvar              !! # of variables effectively present 
+                                                                   !! in the stomate restart file (unitless)
+  CHARACTER(LEN=50),DIMENSION(nbvarmax)      :: varnames           !! list of the names of the variables stored 
+                                                                   !! in the stomate restart file (unitless)
+  INTEGER(i_std)                             :: varnbdim           !! # of dimensions of a given variable 
+                                                                   !! of the stomate restart file
+  INTEGER(i_std),PARAMETER                   :: varnbdim_max=20    !! maximal # of dimensions assumed for any variable 
+                                                                   !! of the stomate restart file 
+  INTEGER,DIMENSION(varnbdim_max)            :: vardims            !! length of each dimension of a given variable 
+                                                                   !! of the stomate restart file
+  LOGICAL                                    :: l1d                !! boolean : TRUE if all dimensions of a given variable 
+                                                                   !! of the stomate restart file are of length 1 (ie scalar) 
+                                                                   !! (unitless)
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE     :: var_3d             !! matrix read/written in restget/restput routines (unitless)
+  REAL(r_std)                                :: x_tmp              !! temporary variable used to store return value 
+                                                                   !! from nf90_get_att (unitless)
+  CHARACTER(LEN=10)  :: part_str                                   !! string suffix indicating the index of a PFT 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)  :: clay_g             !! clay fraction (nbpglo) (unitless)
+  REAL(r_std),DIMENSION(:,:,:,:),ALLOCATABLE :: soilcarbon_input_g !! soil carbon input (nbpglob,ncarb,nvm,time) 
+                                                                   !! (\f$gC m^{-2} dt_forcesoil^{-1}\f$) 
+  REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE   :: control_temp_g     !! Temperature control (nbp_glo,above/below,time) on OM decomposition 
+                                                                   !! (unitless)
+  REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE   :: control_moist_g    !! Moisture control (nbp_glo,abo/below,time) on OM decomposition 
+                                                                   !! ?? Should be defined per PFT as well (unitless)
+  REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE   :: carbon_g           !! Soil carbon stocks (nbp_glo,ncarb,nvm) (\f$gC m^{-2}\f$)
+
+  REAL(r_std),ALLOCATABLE :: clay(:)                   !! clay fraction (nbp_loc) (unitless)
+  REAL(r_std),ALLOCATABLE :: soilcarbon_input(:,:,:,:) !! soil carbon input (nbp_loc,ncarb,nvm,time) 
+                                                       !! (\f$gC m^{-2} dt_forcesoil^{-1}\f$) 
+  REAL(r_std),ALLOCATABLE :: control_temp(:,:,:)       !! Temperature control (nbp_loc,above/below,time) on OM decomposition 
+                                                       !! (unitless)
+  REAL(r_std),ALLOCATABLE :: control_moist(:,:,:)      !! Moisture control (nbp_loc,abo/below,time) on OM decomposition 
+                                                       !! ?? Should be defined per PFT as well (unitless)
+  REAL(r_std),ALLOCATABLE :: carbon(:,:,:)             !! Soil carbon stocks (nbp_loc,ncarb,nvm) (\f$gC m^{-2}\f$)
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE     :: resp_hetero_soil  !! Heterotrophic respiration (\f$gC m^{-2} dt_forcesoil^{-1}\f$) 
+                                                                  !! (requested by soilcarbon routine but not used here) 
+
+  !INTEGER(i_std)                             :: printlev_loc      !! Local write level
+  INTEGER(i_std)                             :: ier,iret          !! Used for hangling errors 
+
+  CHARACTER(LEN=30) :: temp_name 
+  LOGICAL :: l_error                                              !! boolean for memory allocation
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: matrixA         !! Carbon fluxes matrix 
+
+!_ =================================================================================================================================
+ 
+  CALL Init_orchidee_para
+  CALL init_timer
+
+! Set specific write level to forcesoil using PRINTLEV_forcesoil=[0-4] in run.def. 
+! The global printlev is used as default value. 
+!  printlev_loc=get_printlev('forcesoil')
+
+!-
+! Configure the number of PFTS 
+!-
+  
+  ! 1. Read the number of PFTs
+  !
+  !Config Key   = NVM
+  !Config Desc  = number of PFTs  
+  !Config If    = OK_SECHIBA or OK_STOMATE
+  !Config Def   = 13
+  !Config Help  = The number of vegetation types define by the user
+  !Config Units = [-]
+  CALL getin_p('NVM',nvm)
+
+  ! 2. Allocation
+  l_error = .FALSE.
+  ALLOCATE(pft_to_mtc(nvm),stat=ier)
+  l_error = l_error .OR. (ier .NE. 0)
+  IF (l_error) THEN
+     STOP 'pft_to_mtc (forcesoil only) : error in memory allocation'
+  ENDIF
+
+  ! 3. Initialisation of the correspondance table
+  pft_to_mtc(:) = undef_int
+  
+  ! 4.Reading of the conrrespondance table in the .def file
+  !
+  !Config Key   = PFT_TO_MTC
+  !Config Desc  = correspondance array linking a PFT to MTC
+  !Config if    = OK_SECHIBA or OK_STOMATE
+  !Config Def   = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13
+  !Config Help  =
+  !Config Units = [-]
+  CALL getin_p('PFT_TO_MTC',pft_to_mtc)
+
+  ! 4.1 if nothing is found, we use the standard configuration
+  IF(nvm == nvmc ) THEN
+     IF(pft_to_mtc(1) == undef_int) THEN
+        WRITE(numout,*) 'Note to the user : we will use ORCHIDEE to its standard configuration'
+        pft_to_mtc(:) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 /)
+     ENDIF
+  ELSE   
+     IF(pft_to_mtc(1) == undef_int) THEN
+        WRITE(numout,*)' The array PFT_TO_MTC is empty : we stop'
+     ENDIF
+  ENDIF
+  
+  ! 4.2 What happened if pft_to_mtc(j) > nvmc (if the mtc doesn't exist)?
+  DO i = 1, nvm
+     IF(pft_to_mtc(i) > nvmc) THEN
+        WRITE(numout,*) "the MTC you chose doesn't exist"
+        STOP 'we stop reading pft_to_mtc'
+     ENDIF
+  ENDDO
+  
+  ! 4.3 Check if pft_to_mtc(1) = 1 
+  IF(pft_to_mtc(1) /= 1) THEN
+     WRITE(numout,*) 'the first pft has to be the bare soil'
+     STOP 'we stop reading next values of pft_to_mtc'
+  ELSE
+     DO i = 2,nvm
+        IF(pft_to_mtc(i) == 1) THEN
+           WRITE(numout,*) 'only pft_to_mtc(1) has to be the bare soil'
+           STOP 'we stop reading pft_to_mtc'
+        ENDIF
+     ENDDO
+  ENDIF
+  
+  ! 5. Allocate and initialize natural ans is_c4
+  
+  ! 5.1 Memory allocation
+  l_error = .FALSE.
+  ALLOCATE(natural(nvm),stat=ier)
+  l_error = l_error .OR. (ier .NE. 0)
+  ALLOCATE(is_c4(nvm),stat=ier)
+
+  IF (l_error) THEN
+     STOP 'natural or is_c4 (forcesoil only) : error in memory allocation'
+  ENDIF
+
+  ! 5.2 Initialisation
+  DO i = 1, nvm
+     natural(i) = natural_mtc(pft_to_mtc(i))
+     is_c4(i) = is_c4_mtc(pft_to_mtc(i))
+  ENDDO
+
+  !!- 
+  !! 1. Initialisation stage
+  !! Reading a set of input files, allocating variables and preparing output restart file.     
+  !!-
+  ! Define restart file name
+  ! for reading initial conditions (sto_restname_in var) and for writting final conditions (sto_restname_out var). 
+  ! User values are used if present in the .def file.
+  ! If not present, default values (stomate_start.nc and stomate_rest_out.c) are used.
+  !-
+  IF (is_root_prc) THEN
+     sto_restname_in = 'stomate_start.nc'
+     CALL getin ('STOMATE_RESTART_FILEIN',sto_restname_in)
+     WRITE(numout,*) 'STOMATE INPUT RESTART_FILE: ',TRIM(sto_restname_in)
+     sto_restname_out = 'stomate_rest_out.nc'
+     CALL getin ('STOMATE_RESTART_FILEOUT',sto_restname_out)
+     WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE: ',TRIM(sto_restname_out)
+     !-
+     ! Open the input file and Get some Dimension and Attributes ID's 
+     !-
+     iret = NF90_OPEN (sto_restname_in, NF90_NOWRITE, rest_id_sto)
+     iret = NF90_INQUIRE_DIMENSION (rest_id_sto,1,len=iim_g)
+     iret = NF90_INQUIRE_DIMENSION (rest_id_sto,2,len=jjm_g)
+     iret = NF90_INQ_VARID (rest_id_sto, "time", iv)
+     iret = NF90_GET_ATT (rest_id_sto, iv, 'calendar',thecalendar)
+     iret = NF90_CLOSE (rest_id_sto)
+     i=INDEX(thecalendar,ACHAR(0))
+     IF ( i > 0 ) THEN
+        thecalendar(i:20)=' '
+     ENDIF
+     !-
+     ! Allocate longitudes and latitudes
+     !-
+     ALLOCATE (lon(iim_g,jjm_g))
+     ALLOCATE (lat(iim_g,jjm_g))
+     lon(:,:) = zero
+     lat(:,:) = zero
+     lev(1)   = zero
+     !-
+     CALL restini &
+          & (sto_restname_in, iim_g, jjm_g, lon, lat, llm, lev, &
+          &  sto_restname_out, itau_dep, date0, dt_files, rest_id_sto)
+  ENDIF
+
+  CALL bcast(date0)
+  CALL bcast(thecalendar)
+  WRITE(numout,*) "calendar = ",thecalendar
+  !-
+  ! calendar
+  !-
+  CALL ioconf_calendar (thecalendar)
+  CALL ioget_calendar  (one_year,one_day)
+  CALL ioconf_startdate(date0)
+  !
+  !! For master process only
+  !
+  IF (is_root_prc) THEN
+     !-
+     ! define forcing file's name (Cforcing_name var)
+     ! User value is used if present in the .def file
+     ! If not, default (NONE) is used
+     !-
+     Cforcing_name = 'NONE'
+     CALL getin ('STOMATE_CFORCING_NAME',Cforcing_name)
+     !-
+     ! Open FORCESOIL's forcing file to read some basic info (dimensions, variable ID's)
+     ! and allocate variables.
+     !-
+     iret = NF90_OPEN (TRIM(Cforcing_name),NF90_NOWRITE,Cforcing_id)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'forcesoil', &
+             &        'Could not open file : ', &
+             &          Cforcing_name,'(Do you have forget it ?)')
+     ENDIF
+     !-
+     ! Total Domain size is stored in nbp_glo variable
+     !-
+     ier = NF90_GET_ATT (Cforcing_id,NF90_GLOBAL,'kjpindex',x_tmp)
+     nbp_glo = NINT(x_tmp)
+     !-
+     ! Number of values stored per year in the forcing file is stored in nparan var.
+     !-
+     ier = NF90_GET_ATT (Cforcing_id,NF90_GLOBAL,'nparan',x_tmp)
+     nparan = NINT(x_tmp)
+     ier = NF90_GET_ATT (Cforcing_id,NF90_GLOBAL,'nbyear',x_tmp)
+     nbyear = NINT(x_tmp)
+     !-
+     ALLOCATE (indices_g(nbp_glo))
+     ALLOCATE (clay_g(nbp_glo))
+     !-
+     ALLOCATE (x_indices_g(nbp_glo),stat=ier)
+     ier = NF90_INQ_VARID (Cforcing_id,'index',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,x_indices_g)
+     indices_g(:) = NINT(x_indices_g(:))
+     WRITE(numout,*) mpi_rank,"indices globaux : ",indices_g
+     DEALLOCATE (x_indices_g)
+     !-
+     ier = NF90_INQ_VARID (Cforcing_id,'clay',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,clay_g)
+     !-
+     ! time step of forcesoil program (in days)
+     !-
+     dt_forcesoil = one_year / FLOAT(nparan)
+     ! Initialize dt_sechiba in module constantes_var. This is needed in carbonsoil.
+     dt_sechiba=dt_forcesoil*one_day
+     WRITE(numout,*) 'time step (d): ',dt_forcesoil
+     WRITE(numout,*) 'nparan: ',nparan
+     WRITE(numout,*) 'nbyear: ',nbyear    
+     !-
+     ! read and write the variables in the output restart file we do not modify within the Forcesoil program
+     ! ie all variables stored in the input restart file except those stored in taboo_vars
+     !-
+     taboo_vars ='$lon$ $lat$ $lev$ $nav_lon$ $nav_lat$ $nav_lev$ $time$ $time_steps$ '// &
+          &             '$day_counter$ $dt_days$ $date$ '
+     !-
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+     !-
+     CALL ioget_vname(rest_id_sto, nbvar, varnames)
+     !-
+     ! read and write some special variables (1D or variables that we need)
+     !-
+     var_name = 'day_counter'
+     CALL restget (rest_id_sto, var_name, 1, 1, 1, itau_dep, .TRUE., xtmp)
+     CALL restput (rest_id_sto, var_name, 1, 1, 1, itau_dep, xtmp)
+     !-
+     var_name = 'dt_days'
+     CALL restget (rest_id_sto, var_name, 1, 1, 1, itau_dep, .TRUE., xtmp)
+     CALL restput (rest_id_sto, var_name, 1, 1, 1, itau_dep, xtmp)
+     !-
+     var_name = 'date'
+     CALL restget (rest_id_sto, var_name, 1, 1, 1, itau_dep, .TRUE., xtmp)
+     CALL restput (rest_id_sto, var_name, 1, 1, 1, itau_dep, xtmp)
+     !-
+     DO iv=1,nbvar
+        !-- check if the variable is to be written here
+        IF (INDEX(taboo_vars,'$'//TRIM(varnames(iv))//'$') == 0 ) THEN
+           !---- get variable dimensions, especially 3rd dimension
+           CALL ioget_vdim &
+                &      (rest_id_sto, varnames(iv), varnbdim_max, varnbdim, vardims)
+           l1d = ALL(vardims(1:varnbdim) == 1)
+           !---- read it
+           IF (l1d) THEN
+              CALL restget &
+                   &        (rest_id_sto, TRIM(varnames(iv)), 1, vardims(3), &
+                   &         1, itau_dep, .TRUE., xtmp)
+           ELSE
+              ALLOCATE( var_3d(nbp_glo,vardims(3)), stat=ier)
+              IF (ier /= 0) STOP 'ALLOCATION PROBLEM'
+              !----
+              CALL restget &
+                   &        (rest_id_sto, TRIM(varnames(iv)), nbp_glo, vardims(3), &
+                   &         1, itau_dep, .TRUE., var_3d, "gather", nbp_glo, indices_g)
+           ENDIF
+           !---- write it
+           IF (l1d) THEN
+              CALL restput &
+                   &        (rest_id_sto, TRIM(varnames(iv)), 1, vardims(3), &
+                   &         1, itau_dep, xtmp)
+           ELSE
+              CALL restput &
+                   &        (rest_id_sto, TRIM(varnames(iv)), nbp_glo, vardims(3), &
+                   &         1, itau_dep, var_3d, 'scatter',  nbp_glo, indices_g)
+              !----
+              DEALLOCATE(var_3d)
+           ENDIF
+        ENDIF
+     ENDDO
+     !-
+     ! read soil carbon stocks values stored in the input restart file
+     !-
+     ALLOCATE(carbon_g(nbp_glo,ncarb,nvm))
+     carbon_g(:,:,:) = 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 &
+             &    (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+             &     .TRUE., carbon_g(:,:,m), 'gather', nbp_glo, indices_g)
+        IF (ALL(carbon_g(:,:,m) == val_exp)) carbon_g(:,:,m) = zero
+        !-- do not write this variable: it will be modified.
+     ENDDO
+     WRITE(numout,*) "date0 : ",date0, itau_dep
+     !-
+     ! Analytical spinup is set to false
+     !
+     spinup_analytic = .FALSE.
+
+     ! Length of the run (in Years)
+     ! User value is used if present in the .def file
+     ! If not, default value (10000 Years) is used
+     !-
+     WRITE(time_str,'(a)') '10000Y'
+     CALL getin('TIME_LENGTH', time_str)
+     write(numout,*) 'Number of years for carbon spinup : ',time_str
+     ! transform into itau
+     CALL tlen2itau(time_str, dt_forcesoil*one_day, date0, itau_len)
+     write(numout,*) 'Number of time steps to do: ',itau_len
+     !-
+     ! read soil carbon inputs, water and temperature stresses on OM decomposition 
+     ! into the forcing file - We read an average year.
+     !-
+     ALLOCATE(soilcarbon_input_g(nbp_glo,ncarb,nvm,nparan*nbyear))
+     ALLOCATE(control_temp_g(nbp_glo,nlevs,nparan*nbyear))
+     ALLOCATE(control_moist_g(nbp_glo,nlevs,nparan*nbyear))
+     !-
+     ier = NF90_INQ_VARID (Cforcing_id,'soilcarbon_input',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,soilcarbon_input_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'control_moist',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,control_moist_g)
+     ier = NF90_INQ_VARID (Cforcing_id,    'control_temp',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,control_temp_g)
+     !-
+     ier = NF90_CLOSE (Cforcing_id)
+     !-
+  ENDIF
+  CALL bcast(nparan)
+  CALL bcast(nbyear)
+  CALL bcast(dt_forcesoil)
+  CALL bcast(iim_g)
+  CALL bcast(jjm_g)
+  CALL bcast(nbp_glo)
+  CALL bcast(itau_dep)
+  CALL bcast(itau_len)
+  IF (.NOT. ALLOCATED(indices_g)) ALLOCATE (indices_g(nbp_glo))
+  CALL bcast(indices_g)
+ 
+  !
+  ! We must initialize data_para :
+  CALL init_orchidee_data_para_driver(nbp_glo,indices_g)
+
+  kjpindex=nbp_loc
+  jjm=jj_nb
+  iim=iim_g
+  IF (printlev_loc>=3) WRITE(numout,*) "Local grid : ",kjpindex,iim,jjm
+
+  !---
+  !--- Create the index table
+  !---
+  !--- This job returns a LOCAL kindex.
+  !---
+  ALLOCATE (indices(kjpindex),stat=ier)
+  !
+  !! scattering to all processes in parallel mode
+  !
+  CALL scatter(indices_g,indices)
+  indices(1:kjpindex)=indices(1:kjpindex)-(jj_begin-1)*iim_g
+  IF (printlev_loc>=3) WRITE(numout,*) mpi_rank,"indices locaux = ",indices(1:kjpindex)
+  !-
+  ! Allocation of the variables for a processor
+  !-
+  ALLOCATE(clay(kjpindex))
+  ALLOCATE(soilcarbon_input(kjpindex,ncarb,nvm,nparan*nbyear))
+  ALLOCATE(control_temp(kjpindex,nlevs,nparan*nbyear))
+  ALLOCATE(control_moist(kjpindex,nlevs,nparan*nbyear))
+  ALLOCATE(carbon(kjpindex,ncarb,nvm))
+  ALLOCATE(resp_hetero_soil(kjpindex,nvm))
+  ALLOCATE(matrixA(kjpindex,nvm,nbpools,nbpools))
+  DO i = 1,nbpools
+     matrixA(:,:,i,i) = un
+  ENDDO
+  iatt = 0
+
+  !-
+  ! Initialization of the variables for a processor
+  !-
+  CALL Scatter(clay_g,clay)
+  CALL Scatter(soilcarbon_input_g,soilcarbon_input)
+  CALL Scatter(control_temp_g,control_temp)
+  CALL Scatter(control_moist_g,control_moist)
+  CALL Scatter(carbon_g,carbon)  
+
+!-
+! Configuration of the parameters
+!-
+
+  !Config Key   = FRAC_CARB_AP
+  !Config Desc  = frac carb coefficients from active pool: depends on clay content
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.004
+  !Config Help  = fraction of the active pool going to the passive pool
+  !Config Units = [-]
+  CALL getin_p('FRAC_CARB_AP',frac_carb_ap)  
+  !
+  !Config Key   = FRAC_CARB_SA
+  !Config Desc  = frac_carb_coefficients from slow pool
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.42
+  !Config Help  = fraction of the slow pool going to the active pool
+  !Config Units = [-] 
+  CALL getin_p('FRAC_CARB_SA',frac_carb_sa)
+  !
+  !Config Key   = FRAC_CARB_SP
+  !Config Desc  = frac_carb_coefficients from slow pool
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.03
+  !Config Help  = fraction of the slow pool going to the passive pool
+  !Config Units = [-] 
+  CALL getin_p('FRAC_CARB_SP',frac_carb_sp)
+  !
+  !Config Key   = FRAC_CARB_PA
+  !Config Desc  = frac_carb_coefficients from passive pool
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.45
+  !Config Help  = fraction of the passive pool going to the passive pool
+  !Config Units = [-] 
+  CALL getin_p('FRAC_CARB_PA',frac_carb_pa)
+  !
+  !Config Key   = FRAC_CARB_PS
+  !Config Desc  = frac_carb_coefficients from passive pool
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.0
+  !Config Help  = fraction of the passive pool going to the passive pool
+  !Config Units = [-]
+  CALL getin_p('FRAC_CARB_PS',frac_carb_ps)
+  !
+  !Config Key   = ACTIVE_TO_PASS_CLAY_FRAC
+  !Config Desc  = 
+  !Config if    = OK_STOMATE 
+  !Config Def   =  .68  
+  !Config Help  =
+  !Config Units = [-]
+  CALL getin_p('ACTIVE_TO_PASS_CLAY_FRAC',active_to_pass_clay_frac)
+  !
+  !Config Key   = CARBON_TAU_IACTIVE
+  !Config Desc  = residence times in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.149
+  !Config Help  =
+  !Config Units = [days] 
+  CALL getin_p('CARBON_TAU_IACTIVE',carbon_tau_iactive)
+  !
+  !Config Key   = CARBON_TAU_ISLOW
+  !Config Desc  = residence times in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 5.48
+  !Config Help  =
+  !Config Units = [days]
+  CALL getin_p('CARBON_TAU_ISLOW',carbon_tau_islow)
+  !
+  !Config Key   = CARBON_TAU_IPASSIVE
+  !Config Desc  = residence times in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 241.
+  !Config Help  =
+  !Config Units = [days]
+  CALL getin_p('CARBON_TAU_IPASSIVE',carbon_tau_ipassive)
+  !
+  !Config Key   = FLUX_TOT_COEFF
+  !Config Desc  =
+  !Config if    = OK_STOMATE 
+  !Config Def   = 1.2, 1.4,.75
+  !Config Help  =
+  !Config Units = [days]
+  CALL getin_p('FLUX_TOT_COEFF',flux_tot_coeff)
+
+  !!-
+  !! 2. Computational step
+  !! Loop over time - Call of soilcarbon routine at each time step 
+  !! Updated soil carbon stocks are stored into carbon variable
+  !! We only keep the last value of carbon variable (no time dimension).
+  !!-
+  iyear=1
+  DO i=1,itau_len
+     iatt = iatt+1
+     IF (iatt > nparan*nbyear) THEN
+        IF (printlev_loc>=3) WRITE(numout,*) iyear
+        iatt = 1
+        iyear=iyear+1
+     ENDIF
+     CALL soilcarbon &
+          &    (kjpindex, clay, &
+          &     soilcarbon_input(:,:,:,iatt), &
+          &     control_temp(:,:,iatt), control_moist(:,:,iatt), &
+          &     carbon, resp_hetero_soil, &
+          &     matrixA)
+  ENDDO
+  WRITE(numout,*) "End of soilcarbon LOOP."
+
+  !
+  !! Gathering of variables towards main processor in parallel mode
+  !
+  CALL Gather(carbon,carbon_g)
+  !!-
+  !! 3. write new carbon stocks into the ouput restart file
+  !!-
+  IF (is_root_prc) THEN
+     DO m=1,nvm
+        WRITE (part_str, '(I2)') m
+        IF (m<10) part_str(1:1)='0'
+        var_name = 'carbon_'//part_str(1:LEN_TRIM(part_str))
+        CALL restput &
+             &    (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+             &     carbon_g(:,:,m), 'scatter', nbp_glo, indices_g)
+     ENDDO
+     !-
+     CALL getin_dump
+     CALL restclo
+  ENDIF
+#ifdef CPP_PARA
+  CALL MPI_FINALIZE(ier)
+#endif
+  WRITE(numout,*) "End of forcesoil."
+  !--------------------
+END PROGRAM forcesoil
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/forcing_tools.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/forcing_tools.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/forcing_tools.f90	(revision 6412)
@@ -0,0 +1,4155 @@
+!  ==============================================================================================================================\n
+!  MODULE forcing_tools	: This module concentrates on the temporal interpolation of the forcing for ORCHIDEE. 
+!                         It provides basic service for the grid when this is provided in the forcing file. The main
+!                         work for the grid is done in glogrid.f90. The approach of forcing_tools to handle the time
+!                         aspect of the forcing is to read as many time steps as possible in memory and then
+!                         interpolate that to the time interval requested by the calling program.
+!                         The data is read on root_proc but then distributed over all processors according to the
+!                         domain decomposition of ORCHIDEE. This allows to be more efficient in the temporal interpolation.
+!                         It is important to keep in mind that forcing_tools works on time intervals. So the request for data 
+!                         of ORCHIDEE as to be for an interval and the forcing file needs to have a description of the time interval
+!                         over which the forcing is valid.
+!                         The general description of how the attributes needed in the netCDF file for describing the cell_methods
+!                         for time are provided in this document :
+!                          https://forge.ipsl.jussieu.fr/orchidee/attachment/wiki/Documentation/Forcings/Description_Forcing_Files.pdf
+!
+!                         The most important routines of foring_tools are forcing_open and forcing_getvalues
+!
+!                       forcing_integration_time : Computes the interval over which the simulation should be carried out.
+!                       forcing_open : Opens the forcing files and extract the main information.
+!                       forcing_getvalues : Gets the forcing data for a time interval.
+!                       forcing_close : Closes the forcing file
+!                       forcing_printdate : A tool to print the dates in human readable form.
+!                       forcing_printpoint : Print the values for a given point in time.
+!                       forcing_givegridsize : Allows other programs to get the dimensions of the forcing grid.
+!                       forcing_getglogrid : Allows other programs to get the spatial grid of the forcing.
+!                       forcing_givegrid : Returns the description of the grid.
+!                       forcing_zoomgrid : Extract a sub-region of the forcing grid.
+!
+!  CONTACT      : jan.polcher@lmd.jussieu.fr
+!
+!  LICENCE      : IPSL (2016)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        
+!! 
+!! RECENT CHANGE(S): None 
+!! 
+!! REFERENCE(S) : None
+!! 
+!_ ================================================================================================================================
+!!
+MODULE forcing_tools
+  !
+  USE defprec
+  USE netcdf
+  !
+  USE ioipsl
+  USE constantes
+  USE solar
+  !
+  USE mod_orchidee_para
+  !
+  IMPLICIT NONE
+  ! 
+  PRIVATE
+  PUBLIC :: forcing_open, forcing_close, forcing_printdate, forcing_getvalues, forcing_printpoint,&
+       &    forcing_getglogrid, forcing_givegridsize, forcing_givegrid, forcing_zoomgrid, forcing_integration_time
+  PUBLIC :: forcing_tools_clear
+  !
+  !
+  !
+  INTERFACE forcing_reindex
+     MODULE PROCEDURE forcing_reindex3d, forcing_reindex2dt, forcing_reindex2d, forcing_reindex1d, &
+          &           forcing_reindex2to1, forcing_reindex1to2
+  END INTERFACE forcing_reindex
+  !
+  INTERFACE forcing_printpoint
+     MODULE PROCEDURE forcing_printpoint_forgrid, forcing_printpoint_gen
+  END INTERFACE forcing_printpoint
+  !
+  ! This PARAMETER essentially manages the memory usage of the module as it
+  ! determines how much of the forcing will be uploaded from the netCDF file into
+  ! memory.
+  !
+  INTEGER(i_std), PARAMETER :: slab_size_max=1500
+  !
+  ! Time variables, all in Julian days
+  !
+  INTEGER(i_std), PARAMETER :: nbtmethods=4
+  INTEGER(i_std), SAVE :: nbtax
+  INTEGER(i_std), SAVE :: nb_forcing_steps
+  REAL(r_std), SAVE :: global_start_date, global_end_date, forcing_tstep_ave
+  REAL(r_std), SAVE :: dt_sechiba_keep
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)     :: time
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:)   :: time_bounds
+  CHARACTER(LEN=20), SAVE, ALLOCATABLE, DIMENSION(:) :: time_axename, time_cellmethod
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)       :: preciptime
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:)    :: time_sourcefile
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:,:)  :: time_id
+  LOGICAL, SAVE :: end_of_file
+  !
+  ! Forcing file information
+  !
+  INTEGER(i_std), SAVE                                :: nb_forcefile=0
+  CHARACTER(LEN=100), SAVE, ALLOCATABLE, DIMENSION(:) :: forfilename
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: force_id, id_unlim
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: nb_atts, ndims, nvars
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)        :: convtosec
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: nbtime_perfile
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)      :: date0_file
+  REAL(r_std), SAVE                                   :: startdate, forcingstartdate
+  !
+  ! Descrition of global grid
+  !
+  INTEGER(i_std), SAVE :: iim_glo, jjm_glo, nbland_glo
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)   :: lon_glo, lat_glo
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:,:):: mask_glo
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:)  :: lindex_glo
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: contfrac_glo
+  LOGICAL, SAVE                                    :: compressed
+  !
+  ! Descrition of zoomed grid
+  !
+  LOGICAL, SAVE :: zoom_forcing = .FALSE.
+  INTEGER(i_std), SAVE :: iim_loc, jjm_loc, nbland_loc
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: lon_loc, lat_loc
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:)   :: lindex_loc
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_loc
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: area_loc
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)      :: contfrac_loc
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:):: corners_loc
+  ! Number of land points per proc
+  INTEGER(i_std), SAVE :: nbland_proc
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:) :: glolindex_proc
+  !-
+  !- Heigh controls and data 
+  !- 
+  LOGICAL, SAVE                            :: zfixed, zsigma, zhybrid, zlevels, zheight 
+  LOGICAL, SAVE                            :: zsamelev_uv 
+  REAL, SAVE                               :: zlev_fixed, zlevuv_fixed 
+  REAL, SAVE                               :: zhybrid_a, zhybrid_b 
+  REAL, SAVE                               :: zhybriduv_a, zhybriduv_b
+  LOGICAL, SAVE                            :: lwdown_cons
+  !
+  ! Forcing variables to be read and stored 
+  !
+  ! At 3000 we can fit in the slab an entire year of 3 hourly forcing.
+  INTEGER(i_std), SAVE :: slab_size=-1
+  INTEGER(i_std), SAVE :: current_offset=1
+  INTEGER(i_std), SAVE :: position_slab(2)
+  CHARACTER(LEN=20), SAVE :: calendar
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: tair_slab, qair_slab
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)      :: time_tair, time_qair
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: timebnd_tair, timebnd_qair
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: rainf_slab, snowf_slab
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)      :: time_precip
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: timebnd_precip
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)      :: preciptime_slab             !! Variable needed to keep track of how much rainfall was already distributed
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: swdown_slab, lwdown_slab
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)      :: time_swdown, time_lwdown
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: timebnd_swdown, timebnd_lwdown
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: u_slab, v_slab, ps_slab
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)      :: time_u, time_v, time_ps
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: timebnd_u, timebnd_v, timebnd_ps
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: ztq_slab, zuv_slab
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:)   :: reindex_glo, reindex_loc
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: reindex2d_loc
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: origind
+  !
+  INTEGER(i_std), SAVE                              :: ncdfstart, ncdfcount
+  !
+  ! Flags to activate initialization phase
+  LOGICAL, SAVE        :: first_call_readslab=.TRUE.   !! Activate initialization phase in forcing_readslab_root
+  LOGICAL, SAVE        :: first_call_solarint=.TRUE.   !! Activate initialization phase in forcing_solarint
+  LOGICAL, SAVE        :: first_call_spreadprec=.TRUE. !! Activate initialization phase in forcing_spreadprec
+
+
+CONTAINS
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_integration_time
+!!
+!>\BRIEF   Computes the interval over which the simulation should be carried out   
+!!
+!! DESCRIPTION:	 This routing will get the following parameters from the run.def : 'START_DATE', 'END_DATE' and 'DT_SECHIBA'.
+!!               It allows to define the integration time of ORCHIDEE and later it will be used to verify that we have
+!!               the needed data in the forcing files to perform this simulation.
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE forcing_integration_time(date_start, dt, nbdt)
+    !
+    !
+    ! This subroutine gets the start date of the simulation, the time step and the number 
+    ! of time steps we need to do until the end of the simulations.
+    !
+    !
+    !
+    REAL(r_std), INTENT(out)                     :: date_start     !! The date at which the simulation starts
+    REAL(r_std), INTENT(out)                     :: dt             !! Time step length in seconds
+    INTEGER(i_std), INTENT(out)                  :: nbdt           !! Number of timesteps to be executed
+    !
+    ! Local
+    !
+    CHARACTER(LEN=20) :: str_sdate(2), str_edate(2), tmpstr
+    INTEGER(i_std) :: s_year, s_month, s_day, e_year, e_month, e_day
+    INTEGER(i_std) :: seci, hours, minutes
+    REAL(r_std) :: s_sec, e_sec, dateend, diff_sec, date_end
+    INTEGER(i_std) :: i, ic
+    !
+    !Config Key  = START_DATE
+    !Config Desc = Date at which the simulation starts
+    !Config Def  = NONE
+    !Config Help = The format is the same as in the CF convention : 1999-09-13 12:0:0
+    str_sdate = " "
+    CALL getin('START_DATE',str_sdate)
+    !
+    IF ( (INDEX(str_sdate(1),"-") .NE. INDEX(str_sdate(1),"-", .TRUE.)) .AND. &
+         &  (INDEX(str_sdate(2),":") .NE. INDEX(str_sdate(2),":", .TRUE.)) ) THEN
+       DO i=1,2
+          tmpstr = str_sdate(1)
+          ic = INDEX(tmpstr,"-")
+          tmpstr(ic:ic) = " "
+          str_sdate(1) = tmpstr
+          tmpstr = str_sdate(2)
+          ic = INDEX(tmpstr,":")
+          tmpstr(ic:ic) = " "
+          str_sdate(2) = tmpstr
+       ENDDO
+       READ (str_sdate(1),*) s_year, s_month, s_day
+       READ (str_sdate(2),*) hours, minutes, seci
+       s_sec = hours*3600. + minutes*60. + seci
+    ELSE
+       CALL ipslerr(3, "forcing_integration_time", "START_DATE incorrectly specified in run.def", str_sdate(1), str_sdate(2))
+    ENDIF
+    CALL ymds2ju (s_year, s_month, s_day, s_sec, date_start)
+    CALL forcing_printdate(date_start, "This is after reading the start date")
+    !
+    !Config Key  = END_DATE
+    !Config Desc = Date at which the simulation ends
+    !Config Def  = NONE
+    !Config Help =  The format is the same as in the CF convention : 1999-09-13 12:0:0
+    str_edate = " "
+    CALL getin('END_DATE',str_edate)
+    !
+    IF ( (INDEX(str_edate(1),"-") .NE. INDEX(str_edate(1),"-", .TRUE.)) .AND. &
+         &  (INDEX(str_edate(2),":") .NE. INDEX(str_edate(2),":", .TRUE.)) ) THEN
+       DO i=1,2
+          tmpstr = str_edate(1)
+          ic = INDEX(tmpstr,"-")
+          tmpstr(ic:ic) = " "
+          str_edate(1) = tmpstr
+          tmpstr = str_edate(2)
+          ic = INDEX(tmpstr,":")
+          tmpstr(ic:ic) = " "
+          str_edate(2) = tmpstr
+       ENDDO
+       READ (str_edate(1),*) e_year, e_month, e_day
+       READ (str_edate(2),*) hours, minutes, seci
+       e_sec = hours*3600. + minutes*60. + seci
+    ELSE
+       CALL ipslerr(3, "forcing_integration_time", "END_DATE incorrectly specified in run.def", str_edate(1), str_edate(2))
+    ENDIF
+    CALL ymds2ju (e_year, e_month, e_day, e_sec, date_end)
+    !
+    CALL time_diff (s_year,s_month,s_day,s_sec,e_year,e_month,e_day,e_sec,diff_sec)
+    !
+    !Config Key  = DT_SECHIBA
+    !Config Desc = Time step length in seconds for sechiba component
+    !Config Def  = 1800
+    !Config Help = 
+    !Config Units = [seconds]
+    dt = 1800
+    CALL getin('DT_SECHIBA', dt)
+    dt_sechiba_keep = dt
+    !
+    nbdt = NINT(diff_sec/dt)
+    !
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !
+    ! Read the configuration options for the time interpolations.
+    !
+    !Config Key   = LWDOWN_CONS
+    !Config Desc  = Conserve the longwave downward radiation of the forcing
+    !Config Def   = n
+    !Config Help  = This flag allows to conserve the downward longwave radiation
+    !               provided in the forcing. It will do this by taking the closest
+    !               neighbour in time from the forcing. This assumes that the forcing
+    !               contains average fluxes. The default setting (LWDOWN_CONS=n) will
+    !               force the model to perform a linear interpolation of the fluxes.
+    !Config Units = [FLAG]
+    !-
+    lwdown_cons = .FALSE.
+    CALL getin('LWDOWN_CONS', lwdown_cons)
+    !
+  END SUBROUTINE forcing_integration_time
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_open
+!!
+!>\BRIEF      Opens the forcing files and extract the main information.
+!!
+!! DESCRIPTION:	 This routine opens all the forcing files provided in the list and verifies that the grid corresponds
+!!               to the coordinates provided (and which was obtained by the model from glogrid.f90.). It then zooms
+!!               into the forcing as requested by the user, extracts the vertical coordinates and final reads the time axis.
+!!               Some basic consistency checks are performed as for instance ensuring the that all the forcing data is available
+!!               to simulate the desired period.
+!!               All that information is also broadcasted to all processors.
+!!               Actual forcing data is not read at this stage.
+!!
+!! \n
+!_ ==============================================================================================================================
+!
+  SUBROUTINE forcing_open(filenames_in, iim, jjm, lon, lat, nbland_in, drvzoom_lon, drvzoom_lat, &
+       &                  kindex, nbindex_perproc, wunit)
+    !
+    ! Opens the forcing file and reads some key information and stores them in the shared variables of the
+    ! module.
+    !
+    ! Lon, lat should come from the grid file we read before. This will give indication of the grid
+    ! file is consistant with the forcing file and if we need to zoom into the forcing file.
+    !
+    ! Time interval of the simulation is also determined.
+    !
+    ! ARGUMENTS
+    !
+    CHARACTER(LEN=*), INTENT(in) :: filenames_in(:)
+    INTEGER(i_std), INTENT(in) :: iim, jjm, nbland_in
+    REAL(r_std), INTENT(in) :: lon(iim,jjm), lat(iim,jjm)
+    REAL(r_std), DIMENSION(2), INTENT(in) :: drvzoom_lon, drvzoom_lat
+    INTEGER(i_std), INTENT(in) :: kindex(nbland_in)
+    INTEGER(i_std), INTENT(in) :: nbindex_perproc
+    INTEGER(i_std), OPTIONAL :: wunit
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: iim_tmp, jjm_tmp, nbland_tmp, nb_files    
+    INTEGER(i_std) :: iv, it
+    INTEGER(i_std) :: inl, ii, jj, ik
+    INTEGER(i_std) :: land_id
+    REAL(r_std)    :: dt
+    INTEGER(i_std) :: nbdt
+    !
+    ! How many files do we have to open ?
+    !
+    ! Number of points per processor
+    nbland_proc = nbindex_perproc
+    !
+    ! All the meta information from the forcing file is ojnly needed on the root processor.
+    !
+    IF ( is_root_prc ) THEN
+       !
+       CALL forcing_filenamecheck(filenames_in, nb_files)
+       IF ( PRESENT(wunit) ) THEN
+          DO it=1,nb_files
+             WRITE(wunit,*) "Files to be used for forcing the simulation :", it, TRIM(forfilename(it))
+          ENDDO
+       ENDIF
+       !
+       ! 0.0 Check if variables are allocated to the right size on root_proc
+       !
+       IF (nb_files > nb_forcefile) THEN
+          IF ( ALLOCATED(force_id) ) DEALLOCATE(force_id)
+          ALLOCATE(force_id(nb_files))
+          IF ( ALLOCATED(id_unlim) )  DEALLOCATE(id_unlim)
+          ALLOCATE(id_unlim(nb_files))
+          IF ( ALLOCATED(nb_atts) ) DEALLOCATE(nb_atts)
+          ALLOCATE(nb_atts(nb_files))
+          IF ( ALLOCATED(ndims) ) DEALLOCATE(ndims)
+          ALLOCATE(ndims(nb_files))
+          IF ( ALLOCATED(nvars) ) DEALLOCATE(nvars)
+          ALLOCATE( nvars(nb_files))
+          IF ( ALLOCATED(nbtime_perfile) ) DEALLOCATE(nbtime_perfile)
+          ALLOCATE(nbtime_perfile(nb_files))
+          IF ( ALLOCATED(convtosec) ) DEALLOCATE(convtosec)
+          ALLOCATE(convtosec(nb_files))
+       ENDIF
+       nb_forcefile = nb_files
+       !
+       ! Get the global grid size from the forcing file. The output is in temporary variables as in this
+       ! module the values are shared.
+       !
+       IF ( PRESENT(wunit) ) THEN
+          WRITE(wunit,*) "Getting global grid from ",  nb_forcefile, "files."
+          CALL FLUSH(wunit)
+       ENDIF
+       CALL forcing_getglogrid(nb_forcefile, forfilename, iim_tmp, jjm_tmp, nbland_tmp, .FALSE.)
+       ! 
+       IF ( PRESENT(wunit) ) THEN
+          WRITE(wunit,*) "Getting the zoomed grid", nbland_tmp
+          CALL FLUSH(wunit)
+       ENDIF
+       CALL forcing_zoomgrid(drvzoom_lon, drvzoom_lat, forfilename(1), .FALSE.)
+       IF ( PRESENT(wunit) ) THEN
+          WRITE(wunit,*) "Out of the zoomed grid operation"
+          CALL FLUSH(wunit)
+       ENDIF
+       !
+       ! Verification that the grid sizes coming from the calling program are consistant with what we get 
+       ! from the forcing file.
+       !
+       IF ( (iim_loc .NE. iim) .OR. (jjm_loc .NE. jjm) ) THEN
+          CALL ipslerr (3,'forcing_open',"At least one of the dimensions of the grid obtained from the",&
+               &        "grid file is different from the one in the forcing file.",&
+               &        "Run driver2oasis -init to generate a new grid file.")
+       ENDIF
+       ! Special treatment for the number of land point, as we could have a case where the forcing
+       ! file does not include the land/sea mask.
+       !
+       IF ( nbland_loc .NE. nbland_in ) THEN
+          ! We trust the number of land points obtained from the gridfile. It has the land/sea mask.
+          nbland_loc = nbland_in
+       ENDIF
+       !
+       ! Treat the time dimension now :
+       !
+       IF ( PRESENT(wunit) ) THEN
+          WRITE(wunit,*) "Getting forcing time"
+          CALL FLUSH(wunit)
+       ENDIF
+       CALL forcing_time(nb_forcefile, forfilename)
+       !
+       ! Now that we know how much time steps are in the forcing we can set some realistic slab_size
+       !
+       slab_size=MIN(nb_forcing_steps, slab_size_max)
+       !
+       !
+       ! Get the vertical information from the file
+       !
+       CALL forcing_vertical(force_id(1))
+       !
+       !
+       IF ( PRESENT(wunit) ) THEN
+          WRITE(wunit,*) "Getting integration time"
+          CALL FLUSH(wunit)
+       ENDIF
+       CALL forcing_integration_time(startdate, dt, nbdt)
+       !
+       ! Test that the time interval requested by the user correspond to the time available in the 
+       ! forcing file.
+       !
+       IF ( startdate < time_bounds(1,1,1) .OR. startdate > time_bounds(nb_forcing_steps,1,2) ) THEN
+          CALL ipslerr (3,'forcing_open', 'Start time requested by the user is outside of the time interval',&
+               & "covered by the forcing file.","Please verify the configuration in the run.def file.")
+       ENDIF
+       !
+       IF ( startdate+(dt/one_day)*nbdt > time_bounds(nb_forcing_steps,1,2) .OR. &
+            & startdate+(dt/one_day)*nbdt < time_bounds(1,1,1)) THEN
+          CALL forcing_printdate(time_bounds(nb_forcing_steps,1,2), "Outer bound of forcing file.")
+          CALL forcing_printdate(startdate+(dt/one_day)*nbdt, "Last date to be simulated.")
+          WRITE(*,*) "ERROR : Final date of forcing needed is : ", startdate+(dt/one_day)*nbdt
+          WRITE(*,*) "ERROR : The outer bound of the last forcing time step is :", time_bounds(nb_forcing_steps,1,2)
+          CALL ipslerr (3,'forcing_open', 'End time requested by the user is outside of the time interval',&
+               & "covered by the forcing file.","Please verify the configuration in the run.def file.")
+       ENDIF
+       !
+    ENDIF
+    !
+    ! Broadcast the local grid (i.e. the one resulting from the zoom) to all processors
+    !
+    CALL bcast(iim_loc)
+    CALL bcast(jjm_loc)
+    CALL bcast(nbland_loc)
+    ! Time variables needed by all procs
+    CALL bcast(slab_size)
+    CALL bcast(startdate)
+    CALL bcast(forcingstartdate)
+    CALL bcast(forcing_tstep_ave)
+    !
+    ! On the slave processes we need to allocate the memory for the data on root_prc to be bcast
+    ! On the root_proc these allocations were done with CALL forcing_zoomgrid
+    !
+    ALLOCATE(glolindex_proc(nbland_proc))
+    IF ( .NOT. is_root_prc ) THEN
+       ALLOCATE(lon_loc(iim_loc,jjm_loc))
+       ALLOCATE(lat_loc(iim_loc,jjm_loc))
+       ALLOCATE(lindex_loc(nbland_loc)) 
+       ALLOCATE(mask_loc(iim_loc,jjm_loc))
+       ALLOCATE(area_loc(iim_loc,jjm_loc))
+       ALLOCATE(contfrac_loc(nbland_loc))
+       ALLOCATE(corners_loc(iim_loc,jjm_loc,4,2))
+    ENDIF
+    !
+    ! Keep on each processor the index of each land point on the *_loc grid
+    !
+    CALL scatter(kindex, glolindex_proc)
+    !
+    CALL bcast(lon_loc)
+    CALL bcast(lat_loc)
+    CALL bcast(lindex_loc)
+    CALL bcast(mask_loc)
+    CALL bcast(area_loc)
+    CALL bcast(contfrac_loc)
+    CALL bcast(corners_loc)
+    !
+  END SUBROUTINE forcing_open
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_getvalues
+!!
+!>\BRIEF   Gets the forcing data for a time interval.   
+!!
+!! DESCRIPTION:	The routine will get the forcing valid for the time interval provided by the caller.
+!!              First it will check that the data is already in memory for that time interval. If not
+!!              it will first read the data from the netCDF file.
+!!              Then the forcing date will be interpolated to the requested time interval.
+!!              The code calls linear interpolation for most variables except for SWdown and precipitation.
+!!              These temporal interpolations can be improved later.
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE forcing_getvalues(time_int, dt, zlev_tq, zlev_uv, tair, qair, rainf, snowf, &
+       &                       swdown, lwdown, solarang, u, v, ps)
+    !
+    ! ARGUMENTS
+    !
+    REAL(r_std), INTENT(in)  :: time_int(2)                            !! The time interval over which the forcing is needed.
+    REAL(r_std), INTENT(in)  :: dt                                     !! timestep, i.e. distance in seconds between time_int(1) and time_int(2)
+    REAL(r_std), INTENT(out) :: zlev_tq(:), zlev_uv(:)
+    REAL(r_std), INTENT(out) :: tair(:), qair(:), rainf(:), snowf(:)
+    REAL(r_std), INTENT(out) :: swdown(:), lwdown(:), solarang(:)
+    REAL(r_std), INTENT(out) :: u(:), v(:), ps(:)
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: i
+    !
+    ! Test that we have the time interval within our slab of data else we need to update it.
+    ! Att : the tests are done here on time_tair as an exemple. This might need to have to be generalized.
+    !
+    ! First case the time axis of the variable are not even yet allocated !
+    IF ( .NOT. ALLOCATED(time_tair) ) THEN
+       CALL forcing_readslab(time_int)
+       CALL forcing_printdate(timebnd_tair(1,1), "Start of time slab just read")
+       CALL forcing_printdate(timebnd_tair(slab_size,2), "End of time slab just read")
+    ELSE
+       ! If we have time axis (for TAIR here) we test that it is long enough in time to allow for an interpolation.
+       !
+       IF ( time_int(2)+forcing_tstep_ave/one_day > time_tair(slab_size) .AND. (.NOT. end_of_file) ) THEN
+          CALL forcing_readslab(time_int)
+          CALL forcing_printdate(timebnd_tair(1,1), "Start of time slab just read")
+          CALL forcing_printdate(timebnd_tair(slab_size,2), "End of time slab just read")
+       ENDIF
+    ENDIF
+    !
+    ! Interpolate the dynamical variables to the time step at which the driver is for the moment.
+    !
+    CALL forcing_interpol(time_int, dt, time_u, u_slab, u)
+    CALL forcing_interpol(time_int, dt, time_v, v_slab, v)
+    CALL forcing_interpol(time_int, dt, time_ps, ps_slab, ps)
+    !
+    ! Compute the height of the first level (a routine will be needed for that !)
+    ! ATT : we assume that the time axis for the height of the scalar variable is the one of TAIR
+    ! and for the height of wind is the same as U.
+    CALL forcing_interpol(time_int, dt, time_tair, ztq_slab, zlev_tq)
+    CALL forcing_interpol(time_int, dt, time_u, zuv_slab, zlev_uv)
+     !
+    ! Interpolate the state variables of the lower atmospheric level
+    !
+    CALL forcing_interpol(time_int, dt, time_tair, tair_slab, tair)
+    CALL forcing_interpol(time_int, dt, time_qair, qair_slab, qair)
+    !
+    ! Spread the precipitation as requested by the user
+    !
+    CALL forcing_spreadprec(time_int, dt, timebnd_precip, time_precip, rainf, snowf)
+    !
+    ! Deal with the interpolate of the radiative fluxes.
+    !
+    CALL forcing_solarint(time_int, dt, timebnd_swdown, time_swdown, iim_loc, jjm_loc, lon_loc, lat_loc, swdown, solarang)
+    !
+    ! We have the option here to conserve LWdown by taking the closest point in the forcing.
+    ! So no interpolation is done.
+    !
+    IF ( lwdown_cons ) THEN
+       CALL forcing_closest(time_int, dt, time_lwdown, lwdown_slab, lwdown)
+    ELSE
+       CALL forcing_interpol(time_int, dt, time_lwdown, lwdown_slab, lwdown)
+    ENDIF
+
+  END SUBROUTINE forcing_getvalues
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_closest
+!!
+!>\BRIEF   This routine does not interpolate and simply uses the closes value in time. It is useful for preserving
+!!         variables which are averaged in the forcing file.
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE forcing_closest(time_int_in, dt, time_central_in, var_slab, var)
+    !
+    ! ARGUMENTS
+    !
+    REAL(r_std), INTENT(in)  :: time_int_in(2)
+    REAL(r_std), INTENT(in)  :: dt
+    REAL(r_std), INTENT(in)  :: time_central_in(:)
+    REAL(r_std), INTENT(in)  :: var_slab(:,:)
+    REAL(r_std), INTENT(out) :: var(:)
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: slabind_a, slabind_b, imin(1), i
+    REAL(r_std) :: time_int(2), time_central(slab_size_max)
+    REAL(r_std) :: mid_int, wa, wb, wt, wab, wae, tmp_mid_int
+    LOGICAL :: mask(slab_size_max)=.FALSE.
+    !
+    ! Shift the input dates in order to gain in precision for the calculations 
+    !
+    time_int(:) = time_int_in(:)-INT(forcingstartdate)
+    time_central(1:slab_size) = time_central_in(1:slab_size)-INT(forcingstartdate)
+    !
+    ! Create a mask so that MINLOC does not look outside of the valid interval of time_central
+    !
+    mask(1:slab_size) = .TRUE.
+    !
+    ! Select the forcing interval for which the center date is the closest to the time of 
+    ! the model.
+    !
+    mid_int = time_int(1) + (dt/2.0)/one_day
+    imin = MINLOC( ABS(time_central(1:slab_size) - mid_int), mask )
+    !
+    ! Verify that this is a possible date
+    !
+    IF ( imin(1) > 0 .AND. imin(1) <= slab_size ) THEN
+       !
+       slabind_a = imin(1)
+       !
+    ELSE
+       WRITE(*,*) "imin(1) = ", imin(1), (time_int_in(1) + (dt/2.0)/one_day)
+       CALL forcing_printdate(time_int_in(1), "===> Start of target time interval.")
+       CALL forcing_printdate(time_int_in(2), "===> End of target time interval.")
+       CALL forcing_printdate(time_central_in(imin(1)), "===> Center of forcing time interval.")
+       CALL ipslerr (3,'forcing_closest', 'The target time interval has no acceptable closest',&
+            & "time in the forcing slab.","")
+    ENDIF
+    !
+    ! Transfer the data from the sloest time of the forcing data slab.
+    !
+    DO i=1, nbland_proc
+       !
+       var(i) = var_slab(i,slabind_a)
+       !
+    ENDDO
+    !
+    !
+  END SUBROUTINE forcing_closest
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_interpol
+!!
+!>\BRIEF   Perform linear interpolation for the time interval requested.
+!!
+!! DESCRIPTION:	  
+!! The code gets an interval over which the model will integrate (time_int_in) but only uses the centre. It also gets 
+!! the times representative of the forcing data for the variable at hand (time_central_in). Using this data we will  
+!! determine which 2 forcing times will need to be used for the interpolation. Once this is established the weights 
+!! are computed and used in order to interpolate the variable between the 2 times which bracket the model integration time. 
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE forcing_interpol(time_int_in, dt, time_central_in, var_slab, var)
+    !
+    ! ARGUMENTS
+    !
+    REAL(r_std), INTENT(in)  :: time_int_in(2)             !! The time interval over which the forcing is needed by the model.
+    REAL(r_std), INTENT(in)  :: dt                         !! Time step of the model
+    REAL(r_std), INTENT(in)  :: time_central_in(:)         !! Representative time for the interval of validity of the forcing data
+    REAL(r_std), INTENT(in)  :: var_slab(:,:)              !! The slab of forcing data read from the file.
+    REAL(r_std), INTENT(out) :: var(:)                     !! Result of the time interpolation.
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: slabind_a, slabind_b, imin(1), i
+    REAL(r_std) :: time_int(2), time_central(slab_size_max)
+    REAL(r_std) :: mid_int, wa, wb, wt, wab, wae, tmp_mid_int
+    LOGICAL :: mask(slab_size_max)=.FALSE.
+    !
+    ! Shift the input dates in order to gain in precision for the calculations 
+    !
+    time_int(:) = time_int_in(:)-INT(forcingstartdate)
+    time_central(1:slab_size) = time_central_in(1:slab_size)-INT(forcingstartdate)
+    !
+    ! Create a mask so that MINLOC does not look outside of the valid interval of time_central
+    !
+    mask(1:slab_size) = .TRUE.
+    !
+    ! Select the type of interpolation to be done.
+    !
+    ! Compute the central time of the model integration time.
+    !
+    mid_int = time_int(1) + (dt/2.0)/one_day
+    ! Locate that time on the time axis of the forcing.
+    imin = MINLOC( ABS(time_central(1:slab_size) - mid_int), mask )
+    !
+    ! Determine which indices are to the left (slabind_a) and right (slabind_b) of the model time and will be used
+    ! for the linear interpolation.
+    !
+    IF ( imin(1) > 1 .AND. imin(1) < slab_size ) THEN
+       !
+       ! Determine if the model time is to the left or right of the representative time
+       ! of the forcing data. This allows to determine with which other position in the
+       ! forcing data we need to interpolate.
+       !
+       IF ( mid_int < time_central(imin(1)) ) THEN
+          slabind_a = imin(1) - 1
+          slabind_b = imin(1)
+       ELSE
+          slabind_a = imin(1)
+          slabind_b = imin(1) + 1
+       ENDIF
+       !
+    ELSE IF ( imin(1) == 1 ) THEN
+       !
+       ! If we are at the first time step of the forcing data we need to take care as there is 
+       ! no data earlier.
+       !
+       slabind_a = 1
+       slabind_b = 2
+       IF ( mid_int < time_central(slabind_a) ) THEN
+          IF ( time_int(2) < time_central(slabind_a) ) THEN
+             WRITE(*,*) "imin(1) = ", imin(1), (time_int_in(1) + (dt/2.0)/one_day)
+             CALL forcing_printdate(time_int_in(1), "===> Start of target time interval.")
+             CALL forcing_printdate(time_int_in(2), "===> End of target time interval.")
+             CALL forcing_printdate(time_central_in(slabind_a), "===> Center of forcing time interval.")
+             CALL ipslerr (3,'forcing_interpol', 'The target time interval lies before the first date of the slab.',&
+                  & "","")
+          ELSE
+             mid_int = time_central(slabind_a) 
+          ENDIF
+       ENDIF
+    ELSE IF ( imin(1) == slab_size ) THEN
+       !
+       ! If we are at the end of the forcing data we need to pay attention as we have no data later in time.
+       !
+       slabind_a = slab_size - 1
+       slabind_b = slab_size
+       IF ( mid_int > time_central(slabind_b) ) THEN
+          IF ( time_int(1) > time_central(slabind_b) ) THEN
+             WRITE(*,*) "imin(1) = ", imin(1), (time_int_in(1) + (dt/2.0)/one_day)
+             CALL forcing_printdate(time_int_in(1), "===> Start of target time interval.")
+             CALL forcing_printdate(time_int_in(2), "===> End of target time interval.")
+             CALL forcing_printdate(time_central_in(slabind_b), "===> Center of forcing time interval.")
+             CALL ipslerr (3,'forcing_interpol', 'The target time interval lies after the last date of the slab.',&
+                  & "","")
+          ELSE
+             mid_int = time_central(slabind_b) 
+          ENDIF
+       ENDIF
+    ENDIF
+    !
+    ! Compute the weights between the values at slabind_a and slabind_b. As with the time
+    ! representation we are at the limit of precision we use 2 days to compute the distance
+    ! in time between the first value (slabind_a) and the middle of the target interval.
+    !
+    wab = time_int(1) - time_central(slabind_a) + (dt/2.0)/one_day
+    wae = time_int(2) - time_central(slabind_a) - (dt/2.0)/one_day
+    wa = (wab+wae)/2.0
+    wb = time_central(slabind_b) - time_central(slabind_a)
+    wt = wa/wb
+    !
+    ! Do the weighted average of all land points with the time indices and weights computed above.
+    !
+    DO i=1, nbland_proc
+       var(i) = var_slab(i,slabind_a) + wt*(var_slab(i,slabind_b) - var_slab(i,slabind_a))
+    ENDDO
+
+  END SUBROUTINE forcing_interpol
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_spreadprec
+!!
+!>\BRIEF      Spreads the precipitation over the interval chosen based on the interval chosen by the user.
+!!
+!! DESCRIPTION:	The behaviour of this routine is controlled by the parameter SPRED_PREC_SEC in the run.def.
+!!              The time in second specified by the user will be the one over which the precipitation will last
+!!              where the forcing interval has rain or snow.
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE forcing_spreadprec(time_int, tlen, timebnd_central, time_central, rainf, snowf)
+    !
+    ! ARGUMENTS
+    !
+    REAL(r_std), INTENT(in)  :: time_int(2)         ! Time interval to which we will spread precip
+    REAL(r_std), INTENT(in)  :: tlen                ! size of time interval in seconds (time step !)
+    REAL(r_std), INTENT(in)  :: timebnd_central(:,:)    ! Time interval over which the read data is valid
+    REAL(r_std), INTENT(in)  :: time_central(:)     ! Center of the time interval
+    REAL(r_std), INTENT(out) :: rainf(:), snowf(:)
+    !
+    ! LOCAL
+    !
+    REAL(r_std), SAVE :: time_to_spread=3600.0
+    INTEGER(i_std) :: imin(1), i, tind(3)
+    REAL(r_std) :: ft(3), dt, left, right
+    INTEGER(i_std) :: offset, nb_spread
+    LOGICAL :: mask(slab_size_max)=.FALSE.
+    !
+    IF ( first_call_spreadprec ) THEN
+       !Config Key   = SPRED_PREC
+       !Config Desc  = Spread the precipitation.
+       !Config If    = [-]
+       !Config Def   = Half of the forcing time step or uniform, depending on dt_force and dt_sechiba
+       !Config Help  = Spread the precipitation over SPRED_PREC steps of the splited forcing 
+       !Config         time step. This ONLY applied if the forcing time step has been splited.
+       !Config         If the value indicated is greater than SPLIT_DT, SPLIT_DT is used for it.
+       !Config Units = [-]
+       !-
+       nb_spread = -1
+       CALL getin_p('SPRED_PREC', nb_spread)
+       !
+       ! Test if we have read the number of time steps to spread in run.def
+       ! If not, then probably the time was given in seconds.
+       !
+       IF ( nb_spread < 0 ) THEN
+          !Config Key   = SPRED_PREC_SEC
+          !Config Desc  = Spread the precipitation over an interval in seconds.
+          !Config Def   = 3600
+          !Config Help  = Spread the precipitation over n seconds of the forcing time step
+          !Config         interval. This ONLY applies when the SPRED_PREC_SEC is smaller than
+          !Config         the forcing time step. Should the user set SPRED_PREC_SEC=0 we will 
+          !Config         assume that the rainfall is uniformely distributed over the forcing interval.
+          !Config Units = seconds
+          !
+          ! This is the default should 'SPRED_PREC' not be present in the run.def
+          !
+          time_to_spread = forcing_tstep_ave/2.0
+          !
+          CALL getin_p('SPRED_PREC_SEC', time_to_spread)
+       ELSE
+          time_to_spread = dt_sechiba_keep * nb_spread
+       ENDIF
+       !
+       ! Do some verifications on the information read from run.def
+       !
+       IF ( time_to_spread > forcing_tstep_ave) THEN
+          time_to_spread = forcing_tstep_ave
+       ELSE IF ( time_to_spread <= 0 ) THEN
+          time_to_spread = forcing_tstep_ave
+       ENDIF
+       !
+       first_call_spreadprec = .FALSE.
+       !
+    ENDIF
+    !
+    ! First test that we have the right time interval from the forcing to spread the precipitation
+    !
+    IF ( time_int(1) >= timebnd_central(1,1) .AND. time_int(2) <= timebnd_central(slab_size,2)) THEN
+       !
+       ! Create a mask so that MINLOC does not look outside of the valid interval of time_central
+       !
+       mask(1:slab_size) = .TRUE.
+       !
+       ! To get better precision on the time difference we get a common offset to substract 
+       !
+       offset = INT(forcingstartdate)
+       !
+       ! In principle 3 time steps can contribute to the time step closest to the center of the forcing interval
+       !
+       imin = MINLOC( ABS(time_central(1:slab_size)-(time_int(1)+time_int(2))/2.0), mask )
+       tind(1) = MAX(imin(1)-1,1)
+       tind(2) = imin(1)
+       tind(3) = MIN(imin(1)+1,slab_size)
+       IF (imin(1)+1 > slab_size) THEN
+          WRITE(*,*) "We have a problem here imin(1)+1,slab_size ", imin(1)+1,slab_size
+          WRITE(*,*) "Interval : ", time_int(1),time_int(2)
+       ENDIF
+       !
+       !
+       !
+       ! Do we need to take some rain from the previous time step ?
+       !
+       !! Time computation is not better than 1/1000 seconds
+       IF ( time_int(1) < timebnd_central(tind(2),1) .AND. preciptime_slab(tind(1)) < (time_to_spread-0.001) ) THEN
+          dt = ((timebnd_central(tind(2),1)-offset)-(time_int(1)-offset))*one_day
+          ft(1) = MIN(time_to_spread - preciptime_slab(tind(1)), dt)/tlen
+       ELSE
+          ft(1) = zero
+       ENDIF
+       !
+       ! Is there still some rain to spread from the current forcing time step ?
+       !
+       !! Time computation is not better than 1/1000 seconds
+       IF (preciptime_slab(tind(2)) < (time_to_spread-0.001) ) THEN
+          left = MAX(time_int(1), timebnd_central(tind(2),1))
+          right = MIN(time_int(2),timebnd_central(tind(2),2))
+          dt = ((right-offset)-(left-offset))*one_day
+          ft(2) = MIN(time_to_spread - preciptime_slab(tind(2)), dt)/tlen
+       ELSE
+          ft(2) = zero
+       ENDIF
+       !
+       ! Do we need to take some rain from the next time step ?
+       !
+       !! Time computation is not better than 1/1000 seconds
+       IF ( time_int(2) > timebnd_central(tind(2),2) .AND. preciptime_slab(tind(3)) < (time_to_spread-0.001) ) THEN
+          dt = ((time_int(2)-offset)-(timebnd_central(tind(2),2)-offset))*one_day
+          ft(3) = MIN(time_to_spread - preciptime_slab(tind(3)), dt)/tlen
+       ELSE
+          ft(3) = zero
+       ENDIF
+       !
+       ! Do the actual calculation
+       !
+       DO i=1, nbland_proc
+          rainf(i) = (rainf_slab(i,tind(1)) * forcing_tstep_ave * ft(1) + &
+                  &  rainf_slab(i,tind(2)) * forcing_tstep_ave * ft(2) + &
+                  &  rainf_slab(i,tind(3)) * forcing_tstep_ave * ft(3))*tlen/time_to_spread
+  
+          snowf(i) = (snowf_slab(i,tind(1)) * forcing_tstep_ave * ft(1) + &
+                  &  snowf_slab(i,tind(2)) * forcing_tstep_ave * ft(2) + &
+                  &  snowf_slab(i,tind(3)) * forcing_tstep_ave * ft(3))*tlen/time_to_spread
+       ENDDO
+       !
+       ! Update the time over which we have already spread the rainf
+       !
+       preciptime_slab(tind(1)) = preciptime_slab(tind(1)) + tlen * ft(1)
+       preciptime_slab(tind(2)) = preciptime_slab(tind(2)) + tlen * ft(2)
+       preciptime_slab(tind(3)) = preciptime_slab(tind(3)) + tlen * ft(3)
+       !
+    ELSE
+       WRITE(numout,*) "Time interval toward which we will interpolate : ", time_int
+       WRITE(numout,*) "Limits of the time slab we have : ", timebnd_central(1,1), timebnd_central(slab_size,2)
+       CALL forcing_printdate(time_int(1), "Start of target time interval.")
+       CALL forcing_printdate(time_int(2), "End of target time interval.")
+       CALL forcing_printdate(timebnd_central(1,1), "Start of time slab we have.")
+       CALL forcing_printdate(timebnd_central(slab_size,2), "End of time slab we have.")
+       CALL ipslerr (3,'forcing_spreadprec', 'The sitation should not occur Why are we here ?',&
+            & "","")
+    ENDIF
+
+  END SUBROUTINE forcing_spreadprec
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_solarint
+!!
+!>\BRIEF      Interpolates incoming solar radiation to the interval requested.
+!!
+!! DESCRIPTION:	The interpolation here takes into account the variation of the solar zenith angle
+!!              to ensure the diurnal cycle of solar radiation is as well represented as possible.
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE forcing_solarint(time_int_in, tlen, timebnd_in, time_cent_in, iim, jjm, lon, lat, swdown, solarangle)
+    !
+    ! ARGUMENTS
+    !
+    REAL(r_std), INTENT(in)    :: time_int_in(2)             ! Time interval for which we will compute radiation
+    REAL(r_std), INTENT(in)    :: tlen                       ! size of time interval in seconds (time step !)
+    REAL(r_std), INTENT(in)    :: timebnd_in(:,:)            ! Time interval over which the read data is valid
+    REAL(r_std), INTENT(in)    :: time_cent_in(:)            ! Center of the time interval
+    INTEGER(i_std), INTENT(in) :: iim, jjm                   ! Size of 2D domain
+    REAL(r_std), INTENT(in)    :: lon(iim,jjm), lat(iim,jjm) ! Longitude and latitude
+    REAL(r_std), INTENT(out)   :: swdown(:), solarangle(:)   ! interpolated downward solar radiation and corresponding
+    !                                                        ! solar angle.
+    !
+    ! LOCAL SAVED
+    !
+    REAL(r_std), SAVE    :: solaryearstart
+    INTEGER(i_std), SAVE :: split, split_max
+    REAL(r_std), SAVE    :: last_time
+    !
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)   :: mean_sinang
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: sinangles
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: time_angles
+    ! Dusk-dawn management
+    REAL(r_std), SAVE   :: dusk_angle
+    !
+    ! LOCAL - temporary
+    !
+    REAL(r_std) :: time_int(2)
+    REAL(r_std) :: timebnd(slab_size_max,2)
+    REAL(r_std) :: time_cent(slab_size_max)
+    INTEGER(i_std) :: year, month, day, hours, minutes
+    REAL(r_std) :: sec
+    !
+    REAL(r_std) :: mean_sol, split_time
+    REAL(r_std) :: julian, julian_tmp
+    REAL(r_std) :: sinang(iim,jjm)
+    INTEGER(i_std) :: is, i, ii, jj, imin(1), tmin(1)
+    LOGICAL :: mask(slab_size_max)=.FALSE.
+    !
+    IF ( first_call_solarint ) THEN
+       !
+       ! Ensure the offset is on the 1st of Januray of the current years so that we do not
+       ! perturbe the solar angle calculations.
+       !
+       CALL ju2ymds (startdate, year, month, day, sec)
+       CALL ymds2ju (year, 1, 1, 0.0, solaryearstart)
+       !
+       last_time = -9999.0
+       !
+       ALLOCATE(mean_sinang(iim,jjm))
+       mean_sinang(:,:) = 0.0
+       !
+       split = NINT(forcing_tstep_ave/tlen)
+       !
+       ! Allow for more space than estimated with the size of the first time step.
+       !
+       ALLOCATE(time_angles(split*2))
+       time_angles(:) = 0.0
+       !
+       ALLOCATE(sinangles(iim,jjm,split*2))
+       sinangles(:,:,:) = 0.0
+       !
+       dusk_angle=0.01
+       !
+       first_call_solarint = .FALSE.
+       split = 0
+       !
+    ENDIF
+    !
+    ! Shift the input dates in order to gain in precision for the time calculations 
+    !
+    time_int(:) = time_int_in(:)-INT(solaryearstart)
+    time_cent(1:slab_size) = time_cent_in(1:slab_size)-INT(solaryearstart)
+    timebnd(1:slab_size,1) = timebnd_in(1:slab_size,1)-INT(solaryearstart)
+    timebnd(1:slab_size,2) = timebnd_in(1:slab_size,2)-INT(solaryearstart)
+    !
+    ! Create a mask so that MINLOC does not look outside of the valid interval of time_central
+    !
+    mask(1:slab_size) = .TRUE.
+    !
+    ! Locate the time step in the SLAB at hand
+    !
+    imin = MINLOC( ABS(time_cent(1:slab_size)-(time_int(1)+time_int(2))/2.0), mask )
+    !
+    ! Compute all the angels we will encounter for the current forcing interval
+    !
+    IF ( last_time .NE. timebnd(imin(1),1) ) THEN
+       !
+       ! Verify that we have used all the angles of the previous decomposition of the forcing
+       ! time step.
+       !
+       IF ( split .NE. 0 ) THEN
+          !
+          WRITE(numout,*) "The forcing has a time step of : ", forcing_tstep_ave
+          WRITE(numout,*) "The model is configured to run with a time step of : ", tlen
+          WRITE(numout,*) "We are left with split = ", split, " starting from ", split_max
+          !
+          CALL ipslerr (3,'forcing_solarint',"The decomposition of solar downward radiation of the forcing file over the model",&
+               &        "has failed. This means the average of the solar radiation over the forcing time step is not conserved.",&
+               &        "This can be caused by a time step repeated twice.")
+       ENDIF
+       !
+       ! Compute the number of time steps the model will put in the current interval of forcing data. 
+       !
+       split = 0
+       julian_tmp = (time_int(1)+time_int(2))/2.0
+       split_time = julian_tmp+split*tlen/one_day
+       tmin = MINLOC( ABS(time_cent(1:slab_size) - split_time), mask)
+       DO WHILE (  tmin(1) .EQ. imin(1) .AND. split_time .LE. timebnd(slab_size,2) )
+          split = split + 1
+          split_time = julian_tmp+split*tlen/one_day
+          tmin = MINLOC( ABS(time_cent(1:slab_size) - split_time), mask)
+       ENDDO
+       !
+       mean_sinang(:,:) = 0.0
+       time_angles(:) = 0.0
+       !
+       DO is = 1,split
+          !
+          julian = julian_tmp + (is-1)*tlen/one_day
+          !
+          ! This call should be better at it allows to compute the difference between the
+          ! current date and a reference time to higher precision. But it produces noisy
+          ! SWdown fluxes !
+!!          CALL solarang (julian, solaryearstart, iim, jjm, lon, lat, sinang)
+          ! The old approach.
+          CALL solarang (julian+INT(solaryearstart), solaryearstart, iim, jjm, lon, lat, sinang)
+          !
+          ! During the dusk,dawn period maintain a minimum angle to take into account the
+          ! diffuse radiation which starts before the sun is over the horizon.
+          !
+          DO ii=1,iim
+             DO jj=1,jjm
+                IF ( sinang(ii,jj) > zero .AND.  sinang(ii,jj) < dusk_angle ) THEN
+                   sinang(ii,jj) = dusk_angle
+                ENDIF
+                mean_sinang(ii,jj) = mean_sinang(ii,jj)+sinang(ii,jj)
+             ENDDO
+          ENDDO
+          !
+          ! Save the solar angle information for later use. That is when we have the target time we will
+          ! look in this table the angle we have forseen.
+          !
+          time_angles(is) = julian
+          sinangles(:,:,is) = sinang(:,:)
+          !
+       ENDDO
+       !
+       mean_sinang(:,:) = mean_sinang(:,:)/split
+       last_time =  timebnd(imin(1),1)
+       split_max = split
+       !
+    ENDIF
+    !
+    ! For the current timle step get the time of the closest pre-computed solar angle.
+    !
+    julian = (time_int(1)+time_int(2))/2.0
+    tmin =  MINLOC(ABS(julian-time_angles(1:split_max)), mask)
+    sinang(:,:) = sinangles(:,:,tmin(1))
+    ! Remember that we have taken one value of the table for later verification
+    split = split - 1
+    !
+    DO i=1, nbland_proc
+       !
+       jj = ((glolindex_proc(i)-1)/iim)+1
+       ii = (glolindex_proc(i)-(jj-1)*iim)
+       !
+       IF ( mean_sinang(ii,jj) > zero ) THEN
+          swdown(i) = swdown_slab(i,imin(1))*sinang(ii,jj)/mean_sinang(ii,jj)
+       ELSE
+          swdown(i) = zero
+       ENDIF
+       !
+       ! Why is this ??? Should we not take the angle corresponding to this time step ?? (Jan)
+       !
+       solarangle(i) = mean_sinang(ii,jj)
+       !
+    ENDDO
+    !
+  END SUBROUTINE forcing_solarint
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_readslab
+!!
+!>\BRIEF Interface routine to read the data. This routine prepares the memory on each procesor and scatters the read data.
+!!
+!! DESCRIPTION:
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE forcing_readslab(time_int)
+    !
+    ! This routine serves to interface with forcing_readslab_root and ensure that
+    ! the data is distributed correctly on all processors.
+    !
+    REAL(r_std), INTENT(in)  :: time_int(2)                            !! The time interval over which the forcing is needed.
+    !
+    ! Local
+    !
+    INTEGER(i_std)  :: is
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: tair_full, qair_full
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: rainf_full, snowf_full
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: swdown_full, lwdown_full
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: u_full, v_full
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: ps_full, ztq_full, zuv_full
+    !
+    ! 1.0 Verify that for the slabs the memory is allocated for the variable
+    ! as well as its time axis.
+    !
+    IF ( .NOT. ALLOCATED(tair_slab) ) ALLOCATE(tair_slab(nbland_proc,slab_size))
+    IF ( .NOT. ALLOCATED(time_tair) ) ALLOCATE(time_tair(slab_size))
+    IF ( .NOT. ALLOCATED(timebnd_tair) ) ALLOCATE(timebnd_tair(slab_size,2))
+    !
+    IF ( .NOT. ALLOCATED(qair_slab) ) ALLOCATE(qair_slab(nbland_proc,slab_size))
+    IF ( .NOT. ALLOCATED(time_qair) ) ALLOCATE(time_qair(slab_size))
+    IF ( .NOT. ALLOCATED(timebnd_qair) ) ALLOCATE(timebnd_qair(slab_size,2))
+    !
+    IF ( .NOT. ALLOCATED(rainf_slab) ) ALLOCATE(rainf_slab(nbland_proc,slab_size))
+    IF ( .NOT. ALLOCATED(snowf_slab) ) ALLOCATE(snowf_slab(nbland_proc,slab_size))
+    IF ( .NOT. ALLOCATED(time_precip) ) ALLOCATE(time_precip(slab_size))
+    IF ( .NOT. ALLOCATED(timebnd_precip) ) ALLOCATE(timebnd_precip(slab_size,2))
+    IF ( .NOT. ALLOCATED(preciptime_slab) ) ALLOCATE(preciptime_slab(slab_size))
+    !
+    IF ( .NOT. ALLOCATED(swdown_slab) ) ALLOCATE(swdown_slab(nbland_proc,slab_size))
+    IF ( .NOT. ALLOCATED(time_swdown) ) ALLOCATE(time_swdown(slab_size))
+    IF ( .NOT. ALLOCATED(timebnd_swdown) ) ALLOCATE(timebnd_swdown(slab_size,2))
+    !
+    IF ( .NOT. ALLOCATED(lwdown_slab) ) ALLOCATE(lwdown_slab(nbland_proc,slab_size))
+    IF ( .NOT. ALLOCATED(time_lwdown) ) ALLOCATE(time_lwdown(slab_size))
+    IF ( .NOT. ALLOCATED(timebnd_lwdown) ) ALLOCATE(timebnd_lwdown(slab_size,2))
+    !
+    IF ( .NOT. ALLOCATED(u_slab) ) ALLOCATE(u_slab(nbland_proc,slab_size))
+    IF ( .NOT. ALLOCATED(time_u) ) ALLOCATE(time_u(slab_size))
+    IF ( .NOT. ALLOCATED(timebnd_u) ) ALLOCATE(timebnd_u(slab_size,2))
+    !
+    IF ( .NOT. ALLOCATED(v_slab) ) ALLOCATE(v_slab(nbland_proc,slab_size))
+    IF ( .NOT. ALLOCATED(time_v) ) ALLOCATE(time_v(slab_size))
+    IF ( .NOT. ALLOCATED(timebnd_v) ) ALLOCATE(timebnd_v(slab_size,2))
+    !
+    IF ( .NOT. ALLOCATED(ps_slab) ) ALLOCATE(ps_slab(nbland_proc,slab_size))
+    IF ( .NOT. ALLOCATED(time_ps) ) ALLOCATE(time_ps(slab_size))
+    IF ( .NOT. ALLOCATED(timebnd_ps) ) ALLOCATE(timebnd_ps(slab_size,2))
+    !
+    IF ( .NOT. ALLOCATED(ztq_slab) ) ALLOCATE(ztq_slab(nbland_proc,slab_size))
+    IF ( .NOT. ALLOCATED(zuv_slab) ) ALLOCATE(zuv_slab(nbland_proc,slab_size))
+    !    
+    !
+    IF ( is_root_prc) THEN
+       !
+       ! Allocate ont he root processor the memory to receive the data from the file
+       !
+       ALLOCATE(tair_full(nbland_loc,slab_size))
+       ALLOCATE(qair_full(nbland_loc,slab_size))
+       ALLOCATE(rainf_full(nbland_loc,slab_size))
+       ALLOCATE(snowf_full(nbland_loc,slab_size))
+       ALLOCATE(swdown_full(nbland_loc,slab_size))
+       ALLOCATE(lwdown_full(nbland_loc,slab_size))
+       ALLOCATE(u_full(nbland_loc,slab_size))
+       ALLOCATE(v_full(nbland_loc,slab_size))
+       ALLOCATE(ps_full(nbland_loc,slab_size))
+       ALLOCATE(ztq_full(nbland_loc,slab_size))
+       ALLOCATE(zuv_full(nbland_loc,slab_size))
+       !
+       CALL forcing_readslab_root(time_int, &
+            &                     tair_full, time_tair, timebnd_tair, &
+            &                     qair_full, time_qair, timebnd_qair, &
+            &                     rainf_full, snowf_full, time_precip, timebnd_precip, preciptime_slab, &
+            &                     swdown_full, time_swdown, timebnd_swdown, &
+            &                     lwdown_full, time_lwdown, timebnd_lwdown, &
+            &                     u_full, time_u, timebnd_u, &
+            &                     v_full, time_v, timebnd_v, &
+            &                     ps_full, time_ps, timebnd_ps, &
+            &                     ztq_full, zuv_full)
+       !
+    ELSE
+       !
+       ALLOCATE(tair_full(1,1))
+       ALLOCATE(qair_full(1,1))
+       ALLOCATE(rainf_full(1,1))
+       ALLOCATE(snowf_full(1,1))
+       ALLOCATE(swdown_full(1,1))
+       ALLOCATE(lwdown_full(1,1))
+       ALLOCATE(u_full(1,1))
+       ALLOCATE(v_full(1,1))
+       ALLOCATE(ps_full(1,1))
+       ALLOCATE(ztq_full(1,1))
+       ALLOCATE(zuv_full(1,1))
+       !
+    ENDIF
+    !
+    ! Broadcast the time information to all procs.
+    !
+    CALL bcast(slab_size)
+    CALL bcast(time_tair)
+    CALL bcast(timebnd_tair)
+    CALL bcast(time_qair)
+    CALL bcast(timebnd_qair)
+    CALL bcast(time_precip)
+    CALL bcast(timebnd_precip)
+    CALL bcast(preciptime_slab)
+    CALL bcast(time_swdown)
+    CALL bcast(timebnd_swdown)
+    CALL bcast(time_lwdown)
+    CALL bcast(timebnd_lwdown)
+    CALL bcast(time_u)
+    CALL bcast(timebnd_u)
+    CALL bcast(time_v)
+    CALL bcast(timebnd_v)
+    CALL bcast(time_ps)
+    CALL bcast(timebnd_ps)
+    !
+    ! Scatter the slabs of data to all processors
+    !
+    CALL scatter(tair_full, tair_slab)
+    CALL scatter(qair_full, qair_slab)
+    CALL scatter(rainf_full, rainf_slab)
+    CALL scatter(snowf_full, snowf_slab)
+    CALL scatter(swdown_full, swdown_slab)
+    CALL scatter(lwdown_full, lwdown_slab)
+    CALL scatter(u_full, u_slab)
+    CALL scatter(v_full, v_slab)
+    CALL scatter(ps_full, ps_slab)
+    CALL scatter(ztq_full, ztq_slab)
+    CALL scatter(zuv_full, zuv_slab)
+    !
+    ! Clean-up to free the memory on the root processor.
+    !
+    IF ( ALLOCATED(tair_full) ) DEALLOCATE(tair_full)
+    IF ( ALLOCATED(qair_full) ) DEALLOCATE(qair_full)
+    IF ( ALLOCATED(rainf_full) ) DEALLOCATE(rainf_full)
+    IF ( ALLOCATED(snowf_full) ) DEALLOCATE(snowf_full)
+    IF ( ALLOCATED(swdown_full) ) DEALLOCATE(swdown_full)
+    IF ( ALLOCATED(lwdown_full) ) DEALLOCATE(lwdown_full)
+    IF ( ALLOCATED(u_full) ) DEALLOCATE(u_full)
+    IF ( ALLOCATED(v_full) ) DEALLOCATE(v_full)
+    IF ( ALLOCATED(ps_full) ) DEALLOCATE(ps_full)
+    IF ( ALLOCATED(ztq_full) ) DEALLOCATE(ztq_full)
+    IF ( ALLOCATED(zuv_full) ) DEALLOCATE(zuv_full)
+    !
+  END SUBROUTINE forcing_readslab
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_readslab_root
+!!
+!>\BRIEF Routine which reads a slab of data from the netCDF file and writes it onto the memory.
+!!
+!! DESCRIPTION:	It is important to read the next slab of data while still keeping an overlap so that
+!!              interpolation can continue.
+!!              It also attributes a time axis to each variable.
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_readslab_root(time_int, &
+            &                     tair, t_tair, tbnd_tair, &
+            &                     qair, t_qair, tbnd_qair, &
+            &                     rainf, snowf, t_prec, tbnd_prec, prectime, &
+            &                     swdown, t_swdown, tbnd_swdown, &
+            &                     lwdown, t_lwdown, tbnd_lwdown, &
+            &                     u, t_u, tbnd_u, &
+            &                     v, t_v, tbnd_v, &
+            &                     ps, t_ps, tbnd_ps, &
+            &                     ztq, zuv)
+    !
+    ! Arguments
+    !
+    REAL(r_std), INTENT(in)  :: time_int(2)                            !! The time interval over which the forcing is needed.
+    !
+    REAL(r_std), INTENT(out) :: tair(:,:)
+    REAL(r_std), INTENT(out) :: t_tair(:)
+    REAL(r_std), INTENT(out) :: tbnd_tair(:,:)
+    !
+    REAL(r_std), INTENT(out) :: qair(:,:)
+    REAL(r_std), INTENT(out) :: t_qair(:)
+    REAL(r_std), INTENT(out) :: tbnd_qair(:,:)
+    !
+    REAL(r_std), INTENT(out) :: rainf(:,:)
+    REAL(r_std), INTENT(out) :: snowf(:,:)
+    REAL(r_std), INTENT(out) :: t_prec(:)
+    REAL(r_std), INTENT(out) :: tbnd_prec(:,:)
+    REAL(r_std), INTENT(out) :: prectime(:)
+    !
+    REAL(r_std), INTENT(out) :: swdown(:,:)
+    REAL(r_std), INTENT(out) :: t_swdown(:)
+    REAL(r_std), INTENT(out) :: tbnd_swdown(:,:)
+    !
+    REAL(r_std), INTENT(out) :: lwdown(:,:)
+    REAL(r_std), INTENT(out) :: t_lwdown(:)
+    REAL(r_std), INTENT(out) :: tbnd_lwdown(:,:)
+    !
+    REAL(r_std), INTENT(out) :: u(:,:)
+    REAL(r_std), INTENT(out) :: t_u(:)
+    REAL(r_std), INTENT(out) :: tbnd_u(:,:)
+    !
+    REAL(r_std), INTENT(out) :: v(:,:)
+    REAL(r_std), INTENT(out) :: t_v(:)
+    REAL(r_std), INTENT(out) :: tbnd_v(:,:)
+    !
+    REAL(r_std), INTENT(out) :: ps(:,:)
+    REAL(r_std), INTENT(out) :: t_ps(:)
+    REAL(r_std), INTENT(out) :: tbnd_ps(:,:)
+    !
+    REAL(r_std), INTENT(out) :: ztq(:,:)
+    REAL(r_std), INTENT(out) :: zuv(:,:)
+    !
+    ! Local
+    !
+    INTEGER(i_std) :: iret, varid
+    INTEGER(i_std) :: if, it
+    INTEGER(i_std) :: tstart(3), tcount(3)
+    INTEGER(i_std) :: imin(1), imax(1), firstif(1)
+    INTEGER(i_std) :: nctstart, nctcount, inslabpos
+    INTEGER(i_std) :: start_globtime, end_globtime
+    INTEGER(i_std) :: timeid_tair, timeid_qair, timeid_precip, timeid_swdown
+    INTEGER(i_std) :: timeid_lwdown, timeid_u, timeid_v, timeid_ps, timeid_tmp
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: time_tmp
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: rau
+    CHARACTER(LEN=80) :: cellmethod
+    !
+    !
+    ALLOCATE(time_tmp(slab_size,nbtax))
+    ALLOCATE(rau(nbland_loc,slab_size))
+    !
+    ! Catch any stupid utilisation of this routine.
+    !
+    IF ( .NOT. is_root_prc) THEN
+       CALL ipslerr (3,'forcing_readslab_root',"Cannot run this routine o other procs than root.",&
+            &        "All the information on the forcing files is only lated on the root processor."," ")
+    ENDIF
+    !
+    !Set some variables to zero
+    !
+    IF ( first_call_readslab ) THEN
+       !
+       preciptime(:) = 0
+       !
+       ! If the first file is only there to provide the last time step of the previous year, we
+       ! do not need to read all. We will start 2 forcing time steps before the start of the first
+       ! time interval requested.
+       !
+       imin=MINLOC(ABS(time(:,1)-time_int(1)))
+       current_offset = MAX(imin(1)-2,1)
+       !
+       first_call_readslab = .FALSE.
+       !
+    ELSE       
+       !
+       ! Put back the cummulated time of rainfall into the global array
+       !
+       preciptime(position_slab(1):position_slab(2)) = preciptime(position_slab(1):position_slab(2)) + &
+            &    prectime(1:slab_size)
+       !
+       ! Compute new offset
+       !
+       current_offset = position_slab(2)-2
+       !
+    ENDIF
+    !
+    ! Check that the slab size is not too large
+    !
+    IF ( (current_offset-1)+slab_size > nb_forcing_steps) THEN
+       slab_size = nb_forcing_steps - (current_offset-1)
+    ENDIF
+    !
+    ! 1.1 Check that the slab we have to read exists
+    !
+    IF ( slab_size > 0 ) THEN
+       !
+       start_globtime = current_offset
+       end_globtime = (current_offset-1)+slab_size
+       inslabpos=1
+       WRITE(*,*) ">> Reading from global position ", start_globtime, "up to ", end_globtime
+       !
+       DO IF=MINVAL(time_sourcefile(start_globtime:end_globtime)),MAXVAL(time_sourcefile(start_globtime:end_globtime))
+          !
+          ! Get position of the part of the global time axis we need to read from this file
+          !
+          firstif = MINLOC(ABS(time_sourcefile-if))
+          ! start = distance of start_globtime or nothing + 1 to follow netCDF convention.
+          nctstart =  MAX((start_globtime-firstif(1)), 0)+1
+          ! count = end index - start index + 1 
+          nctcount = MIN((firstif(1)-1)+nbtime_perfile(if),end_globtime)-MAX(firstif(1),start_globtime)+1
+          !
+          !
+          ! Read time over the indexes computed above in order to position the slab correctly
+          ! 
+          WRITE(*,*) ">> From file ", if," reading from position ", nctstart, "up to ", (nctstart-1)+nctcount
+          !
+          DO it =1,nbtax
+             tstart(1) = nctstart
+             tcount(1) = nctcount
+             iret = NF90_GET_VAR(force_id(if), time_id(if,it), time_tmp(inslabpos:inslabpos+nctcount-1,it), tstart, tcount)
+             IF (iret /= NF90_NOERR) THEN
+                WRITE(*,*) TRIM(NF90_STRERROR(iret))
+                WRITE(*,*) "Working on file ", IF," starting at ",tstart(1)," counting ",tcount(1)
+                WRITE(*,*) "The data was to be written in to section ", inslabpos,":",inslabpos+nctcount-1," of time_tmp"
+                CALL ipslerr (3,'forcing_readslab_root',"Could not read the time for the current interval."," "," ")
+             ENDIF
+             time_tmp(inslabpos:inslabpos+nctcount-1,it) = date0_file(if,it) + &
+                  time_tmp(inslabpos:inslabpos+nctcount-1,it)*convtosec(if)/one_day
+          ENDDO
+          !
+          ! 2.0 Find and read variables.
+          !
+          ! 2.1 Deal with air temperature and humidity as the fist and basic case
+          !
+          ! 
+          !
+          CALL forcing_varforslab(if, "Tair", nctstart, nctcount, inslabpos, tair, cellmethod)
+          CALL forcing_attributetimeaxe(cellmethod, timeid_tair)
+          !
+          CALL forcing_varforslab(if, "Qair", nctstart, nctcount, inslabpos, qair, cellmethod)
+          CALL forcing_attributetimeaxe(cellmethod, timeid_qair)
+          !
+          ! 2.2 Deal with rainfall and snowfall.
+          !
+          CALL forcing_varforslab(if, "Rainf", nctstart, nctcount, inslabpos, rainf, cellmethod)
+          CALL forcing_attributetimeaxe(cellmethod, timeid_precip)
+          !
+          CALL forcing_varforslab(if, "Snowf", nctstart, nctcount, inslabpos, snowf, cellmethod)
+          CALL forcing_attributetimeaxe(cellmethod, timeid_tmp)
+          IF ( timeid_precip .NE. timeid_tmp) THEN
+             CALL ipslerr(3, 'forcing_readslab_root','Rainf and Snwof have different time axes.', &
+                  &         'Please check the forcing file to ensure both variable have the same cell_method.','')
+          ENDIF
+          !
+          !
+          ! 2.3 Deal with downward shorwave and longwave radiation
+          !     The SW radiation can have 2 names SWdown_aerosol or SWdown. The first one is
+          !     given priority
+          !
+          CALL forcing_varforslab(if, "SWdown", nctstart, nctcount, inslabpos, swdown, cellmethod)
+          CALL forcing_attributetimeaxe(cellmethod, timeid_swdown)
+          !
+          CALL forcing_varforslab(if, "LWdown", nctstart, nctcount, inslabpos, lwdown, cellmethod)
+          CALL forcing_attributetimeaxe(cellmethod, timeid_lwdown)
+          !
+          !
+          ! 2.4 Deal with wind and pressure
+          !
+          CALL forcing_varforslab(if, "PSurf", nctstart, nctcount, inslabpos, ps, cellmethod)
+          CALL forcing_attributetimeaxe(cellmethod, timeid_ps)
+          !
+          CALL forcing_varforslab(if, "Wind_E", nctstart, nctcount, inslabpos, u, cellmethod)
+          CALL forcing_attributetimeaxe(cellmethod, timeid_u)
+          !
+          CALL forcing_varforslab(if, "Wind_N", nctstart, nctcount, inslabpos, v, cellmethod)
+          CALL forcing_attributetimeaxe(cellmethod, timeid_v)
+          !
+          !
+          ! Do the height of the variables T&Q and U&V
+          !
+          ! First the T&Q level
+          !
+          IF ( zheight ) THEN
+             ztq(:,:) = zlev_fixed
+          ELSE IF ( zsigma .OR. zhybrid ) THEN
+             rau(:,:) = ps(:,:)/(cte_molr*tair(:,:))
+             ztq(:,:) = (ps(:,:) - (zhybrid_a + zhybrid_b*ps(:,:)))/(rau(:,:) * cte_grav)
+          ELSE IF ( zlevels ) THEN
+             CALL forcing_varforslab(IF, "Levels", nctstart, nctcount, inslabpos, ztq, cellmethod)
+          ELSE
+             CALL ipslerr(3, 'forcing_readslab_root','No case for the vertical levels was specified.', &
+                  &         'We cannot determine the height for T and Q.','')
+          ENDIF
+          !
+          ! Now the U&V level
+          !
+          IF ( zsamelev_uv ) THEN
+             zuv(:,:) = ztq(:,:)
+          ELSE
+             IF ( zheight ) THEN
+                zuv(:,:) = zlevuv_fixed
+             ELSE IF ( zsigma .OR. zhybrid ) THEN
+                rau(:,:) = ps(:,:)/(cte_molr*tair(:,:))
+                zuv(:,:) = (ps(:,:) - (zhybriduv_a + zhybriduv_b*ps(:,:)))/(rau(:,:) * cte_grav)
+             ELSE IF ( zlevels ) THEN
+                CALL forcing_varforslab(IF, "Levels_uv", nctstart, nctcount, inslabpos, zuv, cellmethod)
+             ELSE
+                CALL ipslerr(3, 'forcing_readslab_root','No case for the vertical levels was specified.', &
+                     &         'We cannot determine the height for U and V.','stop readdim2')
+             ENDIF
+          ENDIF
+          
+          inslabpos = inslabpos+nctcount
+          
+       ENDDO
+       !
+       ! Use the read time of the slab to place it in the global variables. We consider 
+       ! that we can do that on the first axis.
+       !
+       imin = MINLOC(ABS(time(:,1)-time_tmp(1,1)))
+       position_slab(1) = imin(1)
+       imax = MINLOC(ABS(time(:,1)-time_tmp(slab_size,1)))
+       position_slab(2) = imax(1)
+       !
+       !
+       IF ( position_slab(2)-position_slab(1) .GT. slab_size ) THEN
+          WRITE(*,*) "Postition_slab =",  position_slab
+          WRITE(*,*) "Interval read : ", position_slab(2)-position_slab(1)
+          WRITE(*,*) "Time start and end : ", time(1,1), time(slab_size,1)
+          DO it =1,nbtax
+             WRITE(*,*) "Checking time_tmp on idex : ", it
+             WRITE(*,*) "Time_tmp start and end : ",time_tmp(1,it), time_tmp(slab_size,it)
+             imin = MINLOC(ABS(time(:,1)-time_tmp(1,it)))
+             imax = MINLOC(ABS(time(:,1)-time_tmp(slab_size,it)))
+             WRITE(*,*) "Interval read : ", imax(1)-imin(1)+1
+          ENDDO
+          WRITE(*,*) "current_offset, slab_size =", current_offset, slab_size
+          CALL ipslerr (3,'forcing_readslab_root',"The time slab read does not fit the number of variables read.",&
+               &        "Could there be an error in the time axis ?"," ")
+       ENDIF
+       !
+       ! Transfer the global time axis into the time variables approriate for each variable. This way
+       ! the time axis for each variable will be centered on the interval of validity. This is an essential assumption 
+       ! the time interpolation to be done later.
+       !
+       WRITE(*,*) "We have found the following axes : ", time_axename(:)
+       WRITE(*,*) "For Tair we are using time axis '",TRIM(time_axename(timeid_tair)),&
+            &     "' with cell method ",TRIM(time_cellmethod(timeid_tair)),"."
+       t_tair(1:slab_size) = time(position_slab(1):position_slab(2), timeid_tair)
+       tbnd_tair(1:slab_size,:) = time_bounds(position_slab(1):position_slab(2),timeid_tair,:)
+       !
+       WRITE(*,*) "For Qair we are using time axis '",TRIM(time_axename(timeid_qair)),&
+            &     "' with cell method ",TRIM(time_cellmethod(timeid_qair)),"."
+       t_qair(1:slab_size) = time(position_slab(1):position_slab(2), timeid_qair)
+       tbnd_qair(1:slab_size,:) = time_bounds(position_slab(1):position_slab(2),timeid_qair,:)
+       !
+       WRITE(*,*) "For Rainf and Snowf we are using time axis '",TRIM(time_axename(timeid_precip)),&
+            &     "' with cell method ",TRIM(time_cellmethod(timeid_precip)),"."
+       t_prec(1:slab_size) = time(position_slab(1):position_slab(2), timeid_precip)
+       tbnd_prec(1:slab_size,:) = time_bounds(position_slab(1):position_slab(2),timeid_precip,:)
+       prectime(1:slab_size) = preciptime(position_slab(1):position_slab(2))
+       !
+       WRITE(*,*) "For SWdown we are using time axis '",TRIM(time_axename(timeid_swdown)),&
+            &     "' with cell method ",TRIM(time_cellmethod(timeid_swdown)),"."
+       t_swdown(1:slab_size) = time(position_slab(1):position_slab(2), timeid_swdown)
+       tbnd_swdown(1:slab_size,:) = time_bounds(position_slab(1):position_slab(2),timeid_swdown,:)
+       !
+       WRITE(*,*) "For LWdown we are using time axis '",TRIM(time_axename(timeid_lwdown)),&
+            &     "' with cell method ",TRIM(time_cellmethod(timeid_lwdown)),"."
+       t_lwdown(1:slab_size) = time(position_slab(1):position_slab(2), timeid_lwdown)
+       tbnd_lwdown(1:slab_size,:) = time_bounds(position_slab(1):position_slab(2),timeid_lwdown,:)
+       !
+       WRITE(*,*) "For Wind_E we are using time axis '",TRIM(time_axename(timeid_u)),&
+            &     "' with cell method ",TRIM(time_cellmethod(timeid_u)),"."
+       t_u(1:slab_size) = time(position_slab(1):position_slab(2), timeid_u)
+       tbnd_u(1:slab_size,:) = time_bounds(position_slab(1):position_slab(2),timeid_u,:)
+       !
+       WRITE(*,*) "For Wind_N we are using time axis '",TRIM(time_axename(timeid_v)),&
+            &     "' with cell method ",TRIM(time_cellmethod(timeid_v)),"."
+       t_v(1:slab_size) = time(position_slab(1):position_slab(2), timeid_v)
+       tbnd_v(1:slab_size,:) = time_bounds(position_slab(1):position_slab(2),timeid_v,:)
+       !
+       WRITE(*,*) "For PSurf we are using time axis '",TRIM(time_axename(timeid_ps)),&
+            &     "' with cell method ",TRIM(time_cellmethod(timeid_ps)),"."
+       t_ps(1:slab_size) = time(position_slab(1):position_slab(2), timeid_ps)
+       tbnd_ps(1:slab_size,:) = time_bounds(position_slab(1):position_slab(2),timeid_ps,:)
+       !
+    ELSE
+       CALL ipslerr (2,'forcing_readslab_root',"We have reached the end of the slabs we can read.",&
+            &          "The calling program needs to manage this situation"," ")
+    ENDIF
+    !
+    ! Have we read to the end of the files ?
+    ! 
+    IF ( current_offset+slab_size >= nb_forcing_steps ) THEN
+       end_of_file = .TRUE.
+    ELSE
+       end_of_file = .FALSE.
+    ENDIF
+    !
+    IF ( ALLOCATED(rau) ) DEALLOCATE(rau)
+    IF ( ALLOCATED(time_tmp) ) DEALLOCATE(time_tmp)
+    !
+  END SUBROUTINE forcing_readslab_root
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_reindex3d
+!!
+!>\BRIEF      
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE forcing_reindex3d(nbi, nbj, tin, slab_in, nbout, tout, slab_out, tstart, reindex)
+    !
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in) :: nbi, nbj, tin, nbout, tout
+    REAL(r_std), INTENT(in)    :: slab_in(nbi,nbj,tin)
+    REAL(r_std), INTENT(out)   :: slab_out(nbout,tout)
+    INTEGER(i_std), INTENT(in) :: tstart
+    INTEGER(i_std), INTENT(in) :: reindex(nbout,2)
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: is, in
+    !
+    DO is=1,tin
+       DO in=1,nbout
+          slab_out(in,tstart+(is-1)) = slab_in(reindex(in,1),reindex(in,2),is)
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE forcing_reindex3d
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_reindex2d
+!!
+!>\BRIEF      
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE forcing_reindex2d(nbi, nbj, slab_in, nbout, slab_out, reindex)
+    !
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in) :: nbi, nbj, nbout
+    REAL(r_std), INTENT(in)    :: slab_in(nbi,nbj)
+    REAL(r_std), INTENT(out)   :: slab_out(nbout)
+    INTEGER(i_std), INTENT(in) :: reindex(nbout,2)
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: in
+    !
+    DO in=1,nbout
+       slab_out(in) = slab_in(reindex(in,1),reindex(in,2))
+    ENDDO
+    !
+  END SUBROUTINE forcing_reindex2d
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_reindex2dt
+!!
+!>\BRIEF      
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_reindex2dt(nbin, tin, slab_in, nbout, tout, slab_out, tstart, reindex)
+    !
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in) :: nbin, tin, nbout, tout
+    REAL(r_std), INTENT(in)    :: slab_in(nbin,tin)
+    REAL(r_std), INTENT(out)   :: slab_out(nbout,tout)
+    INTEGER(i_std), INTENT(in) :: tstart
+    INTEGER(i_std), INTENT(in) :: reindex(nbout)
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: is, in
+    !
+    DO is=1,tin
+       DO in=1,nbout
+          slab_out(in,tstart+(is-1)) = slab_in(reindex(in),is)
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE forcing_reindex2dt
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_reindex1d
+!!
+!>\BRIEF      
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_reindex1d(nbin, slab_in, nbout, slab_out, reindex)
+    !
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in) :: nbin, nbout
+    REAL(r_std), INTENT(in)    :: slab_in(nbin)
+    REAL(r_std), INTENT(out)   :: slab_out(nbout)
+    INTEGER(i_std), INTENT(in) :: reindex(nbout)
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: is
+    !
+    DO is=1,nbout
+       slab_out(is) = slab_in(reindex(is))
+    ENDDO
+    !
+  END SUBROUTINE forcing_reindex1d
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_reindex2to1
+!!
+!>\BRIEF      
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_reindex2to1(nbi, nbj, slab_in, nbout, slab_out, reindex)
+    !
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in) :: nbi, nbj, nbout
+    REAL(r_std), INTENT(in)    :: slab_in(nbi,nbj)
+    REAL(r_std), INTENT(out)   :: slab_out(nbout)
+    INTEGER(i_std), INTENT(in) :: reindex(nbout)
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: i, j, is
+    !
+    DO is=1,nbout
+       j = INT((reindex(is)-1)/nbi)+1
+       i = (reindex(is)-(j-1)*nbi)
+       slab_out(is) = slab_in(i,j)
+    ENDDO
+    !
+  END SUBROUTINE forcing_reindex2to1
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_reindex1to2
+!!
+!>\BRIEF      
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_reindex1to2(nbin, slab_in, nbi, nbj, slab_out, reindex)
+    !
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in) :: nbin, nbi, nbj
+    REAL(r_std), INTENT(in)    :: slab_in(nbin)
+    REAL(r_std), INTENT(out)   :: slab_out(nbi, nbj)
+    INTEGER(i_std), INTENT(in) :: reindex(nbin)
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: i, j, is
+    !
+    DO is=1,nbin
+       j = INT((reindex(is)-1)/nbi)+1
+       i = (reindex(is)-(j-1)*nbi)
+       slab_out(i,j) = slab_in(is)
+    ENDDO
+    !
+  END SUBROUTINE forcing_reindex1to2
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_close
+!!
+!>\BRIEF  Close all forcing files
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE forcing_close()
+
+    INTEGER(i_std) :: ierr, if
+
+    DO if=1,nb_forcefile
+       ierr = NF90_CLOSE(force_id(if))
+    ENDDO
+
+  END SUBROUTINE forcing_close
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_printdate
+!!
+!>\BRIEF    Print the date in a human readable format.  
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_printdate(julian_day, message, wunit)
+    !
+    REAL(r_std), INTENT(in) :: julian_day
+    CHARACTER(len=*), INTENT(in) :: message
+    INTEGER, INTENT(in), OPTIONAL :: wunit
+    !
+    !
+    !
+    INTEGER(i_std) :: year, month, day, hours, minutes, seci
+    REAL(r_std) :: sec
+    !
+    CALL ju2ymds (julian_day, year, month, day, sec)
+    hours = INT(sec/3600)
+    sec = sec - 3600 * hours
+    minutes = INT(sec / 60)
+    sec = sec - 60 * minutes
+    seci = INT(sec)
+    !
+    IF (PRESENT(wunit)) THEN
+       WRITE(wunit,'(I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2," > ", A60)') &
+            &            year, month, day, hours, minutes, seci, message
+    ELSE
+       WRITE(*,'(I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2," > ", A60)') &
+            &            year, month, day, hours, minutes, seci, message
+    ENDIF
+    !
+  END SUBROUTINE forcing_printdate
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_printpoint_forgrid
+!!
+!>\BRIEF     Together with the date print some sample values. Useful for checking the forcing. 
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_printpoint_forgrid(julian_day, lon_pt, lat_pt, var, message)
+    !
+    REAL(r_std), INTENT(in) :: julian_day
+    REAL(r_std), INTENT(in) :: lon_pt, lat_pt
+    REAL(r_std), INTENT(in) :: var(:)
+    CHARACTER(len=*), INTENT(in) :: message
+    !
+    !
+    !
+    INTEGER(i_std) :: year, month, day, hours, minutes, seci
+    REAL(r_std) :: sec
+    INTEGER(i_std) :: lon_ind, lat_ind, ind
+    INTEGER(i_std), DIMENSION(1) :: i,j,k
+    !
+    ! Check if there is anything to be done
+    !
+    IF ( MAX(lon_pt, lat_pt) > 360.0 ) THEN
+       RETURN
+    ENDIF
+    !
+    ! Convert time first
+    !
+    CALL ju2ymds (julian_day, year, month, day, sec)
+    hours = INT(sec/3600)
+    sec = sec - 3600 * hours
+    minutes = INT(sec / 60)
+    sec = sec - 60 * minutes
+    seci = INT(sec)
+    !
+    ! Get the local to be analysed
+    !
+    i = MINLOC(ABS(lon_loc(:,1)-lon_pt))
+    j = MINLOC(ABS(lat_loc(1,:)-lat_pt))
+    ind = (j(1)-1)*iim_loc+i(1)
+    k = MINLOC(ABS(lindex_loc(:)-ind))
+    !
+    WRITE(*,"(I2.2,':',I2.2,':',I2.2,' Loc : ', F5.1,',', F5.1,'(i=',I6,') Value = ',F12.4,A40)") &
+         & hours, minutes, seci, lon_loc(i(1),1), lat_loc(1,j(1)), k(1), var(k(1)), message
+    
+  END SUBROUTINE forcing_printpoint_forgrid
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_printpoint_gen
+!!
+!>\BRIEF       Together with the date print some sample values. Useful for checking the forcing. 
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_printpoint_gen(julian_day, lon_pt, lat_pt, nbind, lalo_in, var, message, ktest)
+    !
+    REAL(r_std), INTENT(in) :: julian_day
+    REAL(r_std), INTENT(in) :: lon_pt, lat_pt
+    INTEGER(i_std), INTENT(in) :: nbind
+    REAL(r_std), INTENT(in) :: lalo_in(:,:)
+    REAL(r_std), INTENT(in) :: var(:)
+    CHARACTER(len=*), INTENT(in) :: message
+    INTEGER(i_std), OPTIONAL, INTENT(out) :: ktest
+    !
+    !
+    !
+    INTEGER(i_std) :: year, month, day, hours, minutes, seci
+    REAL(r_std) :: sec, mindist
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: dist, refdist
+    INTEGER(i_std) :: lon_ind, lat_ind, ind
+    INTEGER(i_std) :: i, imin(1)
+    REAL(r_std), PARAMETER :: mincos  = 0.0001
+    REAL(r_std), PARAMETER :: pi = 3.141592653589793238
+    REAL(r_std), PARAMETER :: R_Earth = 6378000.
+    !
+    ! Check if there is anything to be done
+    !
+    IF ( MAX(lon_pt, lat_pt) > 360.0 ) THEN
+       IF ( PRESENT(ktest) ) ktest = -1
+       RETURN
+    ENDIF
+    !
+    ! Allocate memory
+    !
+    ALLOCATE(dist(nbind))
+    ALLOCATE(refdist(nbind))
+    !
+    ! Convert time first
+    !
+    CALL ju2ymds (julian_day, year, month, day, sec)
+    hours = INT(sec/3600)
+    sec = sec - 3600 * hours
+    minutes = INT(sec / 60)
+    sec = sec - 60 * minutes
+    seci = INT(sec)
+    !
+    ! Get the location to be analysed
+    !
+    DO i=1,nbind
+       dist(i) = acos( sin(lat_pt*pi/180)*sin(lalo_in(i,1)*pi/180) + &
+            &    cos(lat_pt*pi/180)*cos(lalo_in(i,1)*pi/180)*&
+            &    cos((lalo_in(i,2)-lon_pt)*pi/180) ) * R_Earth
+    ENDDO
+    !
+    ! Look for the next grid point closest to the one with the smalest distance.
+    !
+    imin = MINLOC(dist)
+    DO i=1,nbind
+       refdist(i) = acos( sin(lalo_in(imin(1),1)*pi/180)*sin(lalo_in(i,1)*pi/180) + &
+            &       cos(lalo_in(imin(1),1)*pi/180)*cos(lalo_in(i,1)*pi/180) * &
+            &       cos((lalo_in(i,2)-lalo_in(imin(1),2))*pi/180) ) * R_Earth
+    ENDDO
+    refdist(imin(1)) =  MAXVAL(refdist)
+    mindist = MINVAL(refdist)
+    !
+    ! Are we closer than the closest points ?
+    !
+    IF ( PRESENT(ktest) ) ktest = -1
+    IF ( dist(imin(1)) <= mindist ) THEN
+       !
+       WRITE(*,"(I2.2,':',I2.2,':',I2.2,' Loc : ', F6.1,',', F6.1,'(i=',I6,') Value = ',F12.4,A38)") &
+            & hours, minutes, seci, lalo_in(imin(1),2), lalo_in(imin(1),1), imin(1), var(imin(1)), message
+       !
+       IF ( PRESENT(ktest) ) ktest = imin(1)
+    ENDIF
+    !
+  END SUBROUTINE forcing_printpoint_gen
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_getglogrid
+!!
+!>\BRIEF       Routine to read the full grid of the forcing file.
+!!
+!! DESCRIPTION: The data is stored in the saved variables of the module and serve all other routines. 	  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_getglogrid (nbfiles, filename, iim_tmp, jjm_tmp, nbland_tmp, closefile)
+    !
+    ! This routine reads the global grid information from the forcing file and generates all the 
+    ! information needed for this grid.
+    ! 
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in)   :: nbfiles
+    CHARACTER(LEN=*), INTENT(in) :: filename(:)
+    INTEGER(i_std), INTENT(out)  :: iim_tmp, jjm_tmp, nbland_tmp
+    LOGICAL, INTENT(in)          :: closefile
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: iret, iv, if, lll
+    CHARACTER(LEN=20) :: dimname, varname
+    CHARACTER(LEN=60) :: lon_units, lat_units, units
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: dimids, londim_ids, latdim_ids
+    INTEGER(i_std) :: lon_id, lat_id, land_id, lon_nbdims, lat_nbdims, land_nbdims
+    INTEGER(i_std) :: lonvar_id, latvar_id, landvar_id
+    LOGICAL :: dump_mask
+    INTEGER(i_std) :: ik, i, j, iff, ndimsvar
+    ! Read a test variabe
+    CHARACTER(len=8) :: testvarname='tair'
+    INTEGER(i_std)   :: testvar_id, contfrac_id
+    REAL(r_std) :: testvar_missing, contfrac_missing
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)   :: testvar
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: testvar2d, contfrac2d
+    !
+    ! 0.0 Check variables are allocated
+    !
+    IF ( .NOT. ALLOCATED(force_id)) ALLOCATE(force_id(nbfiles))
+    IF ( .NOT. ALLOCATED(id_unlim)) ALLOCATE(id_unlim(nbfiles))
+    IF ( .NOT. ALLOCATED(nb_atts)) ALLOCATE(nb_atts(nbfiles))
+    IF ( .NOT. ALLOCATED(ndims)) ALLOCATE(ndims(nbfiles))
+    IF ( .NOT. ALLOCATED(nvars)) ALLOCATE( nvars(nbfiles))
+    !
+    ! 0.1 Are we one the root proc ?
+    !
+    IF ( .NOT. is_root_prc ) THEN
+       CALL ipslerr (3,'forcing_getglogrid'," This routine can only be called on the root processor.", " ", " ")
+    ENDIF
+    !
+    ! 1.0 Open the netCDF file and get basic dimensions
+    !
+    DO iff=1,nbfiles
+       !
+       iret = NF90_OPEN(filename(iff), NF90_NOWRITE, force_id(iff))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'forcing_getglogrid',"Error opening the forcing file :", filename(iff), " ")
+       ENDIF
+       !
+       iret = NF90_INQUIRE (force_id(iff), nDimensions=ndims(iff), nVariables=nvars(iff), &
+            nAttributes=nb_atts(iff), unlimitedDimId=id_unlim(iff))
+       !
+       !
+       ! 2.0 Read the dimensions found in the forcing file. Only deal with the spatial dimension as
+       !     time is an unlimited dimension.
+       !
+       DO iv=1,ndims(iff)
+          !
+          iret = NF90_INQUIRE_DIMENSION (force_id(iff), iv, name=dimname, len=lll)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'forcing_getglogrid',"Could not get size of dimensions in file : ", filename(iff), " ")
+          ENDIF
+          !
+          SELECT CASE(dimname)
+             !
+          CASE("west_east")
+             CALL forcing_checkdim(iff, filename, iim_glo, lon_id, lll, iv)
+          CASE("south_north")
+             CALL forcing_checkdim(iff, filename, jjm_glo, lat_id, lll, iv)
+          CASE("lon")
+             CALL forcing_checkdim(iff, filename, iim_glo, lon_id, lll, iv)
+          CASE("lat")
+             CALL forcing_checkdim(iff, filename, jjm_glo, lat_id, lll, iv)
+          CASE("nav_lon")
+             CALL forcing_checkdim(iff, filename, iim_glo, lon_id, lll, iv)
+          CASE("nav_lat")
+             CALL forcing_checkdim(iff, filename, jjm_glo, lat_id, lll, iv)
+          CASE("x")
+             CALL forcing_checkdim(iff, filename, iim_glo, lon_id, lll, iv)
+          CASE("y")
+             CALL forcing_checkdim(iff, filename, jjm_glo, lat_id, lll, iv)
+          CASE("land")
+             CALL forcing_checkdim(iff, filename, nbland_glo, land_id, lll, iv)
+          END SELECT
+          !
+       ENDDO
+    ENDDO
+    !
+    ! 3.0 Read the spatial coordinate variables found in the first file.
+    !
+    ALLOCATE(dimids(NF90_MAX_VAR_DIMS), londim_ids(NF90_MAX_VAR_DIMS), latdim_ids(NF90_MAX_VAR_DIMS))
+    lonvar_id = -1
+    latvar_id = -1
+    landvar_id = -1
+    testvar_id = -1
+    contfrac_id = -1
+    ! Count the number of time axis we have
+    nbtax = 0
+    !
+    DO iv=1,nvars(1)
+       !
+       iret = NF90_INQUIRE_VARIABLE(force_id(1), iv, name=varname, ndims=ndimsvar, dimids=dimids)
+       iret = NF90_GET_ATT(force_id(1), iv, 'units', units)
+       !
+       ! Check that we have the longitude
+       !
+       IF ( INDEX(lowercase(varname), 'lon') > 0 .AND. INDEX(lowercase(units), 'east') > 0 ) THEN
+          lonvar_id = iv
+          lon_units=units
+          lon_nbdims = ndimsvar
+          londim_ids = dimids
+       ENDIF
+       !
+       ! Check that we have the latitude
+       !
+       IF ( INDEX(lowercase(varname), 'lat') > 0 .AND. INDEX(lowercase(units), 'north') > 0) THEN
+          latvar_id = iv
+          lat_units=units
+          lat_nbdims = ndimsvar
+          latdim_ids = dimids
+       ENDIF
+       !
+       ! Check that we have the land re-indexing table
+       !
+       IF ( INDEX(lowercase(varname), 'land') > 0 ) THEN
+          landvar_id = iv
+          land_nbdims = ndimsvar
+          latdim_ids = dimids
+       ENDIF
+       !
+       ! Check if we have the contfrac variable
+       !
+       IF ( INDEX(lowercase(varname), 'contfrac') > 0 ) THEN
+          contfrac_id = iv
+          iret = NF90_GET_ATT(force_id(1), iv, "missing_value", contfrac_missing)
+          IF (iret /= NF90_NOERR) THEN
+             contfrac_missing=0.0
+          ENDIF
+       ENDIF
+       !
+       ! Find the test variable
+       !
+       IF ( INDEX(lowercase(varname), TRIM(testvarname)) > 0 ) THEN
+          testvar_id = iv
+          iret = NF90_GET_ATT(force_id(1), iv, "missing_value", testvar_missing)
+          IF (iret /= NF90_NOERR) THEN
+             testvar_missing=-1
+          ENDIF
+       ENDIF
+       !
+       ! If we come across time get the calendar and archive it.
+       !
+       IF ( INDEX(lowercase(units),'seconds since') > 0 .OR. &
+          &  INDEX(lowercase(units),'minutes since') > 0 .OR. &
+          &  INDEX(lowercase(units),'hours since') > 0) THEN 
+          !
+          ! Get calendar used for the time axis
+          !
+          iret = NF90_GET_ATT(force_id(1), iv, "calendar", calendar)
+          IF (iret == NF90_NOERR) THEN
+             WRITE(*,*) ">> Setting the calendar to ",calendar
+          ELSE 
+             WRITE(*,*) ">> Keeping proleptic Gregorian calendar" 
+             calendar="proleptic_gregorian"
+          ENDIF
+          !
+          nbtax = nbtax + 1
+          !
+       ENDIF
+    ENDDO
+    !
+    ! 4.0 Verification that we have found both coordinate variables and the land point index
+    !
+    IF ( ( lonvar_id < 0 ) .AND. ( INDEX(lowercase(lon_units), 'east') <= 0 ) ) THEN
+       CALL ipslerr (3,'forcing_getglogrid',"Have not found a valid longitude. Units = ", lon_units, " ")
+    ENDIF
+    IF ( ( latvar_id < 0 ) .AND. ( INDEX(lowercase(lat_units), 'north') <= 0 ) ) THEN
+       CALL ipslerr (3,'forcing_getglogrid',"Have not found a valid latitude. Units = : ", lat_units, " ")
+    ENDIF
+    IF ( landvar_id < 0 ) THEN
+       CALL ipslerr (1,'forcing_getglogrid',"No reindexing table was found. ", &
+            &           "This forcing file is not compressed by gathering.", " ")
+    ENDIF
+    !
+    ! 5.0 Allocate the space for the global variables and read them.
+    !
+    IF ( .NOT. ALLOCATED(lon_glo)) ALLOCATE(lon_glo(iim_glo, jjm_glo))
+    IF ( .NOT. ALLOCATED(lat_glo)) ALLOCATE(lat_glo(iim_glo, jjm_glo))
+    !
+    IF ( lon_nbdims == 2 .AND. lat_nbdims == 2 ) THEN
+       iret = NF90_GET_VAR(force_id(1), lonvar_id, lon_glo)
+       iret = NF90_GET_VAR(force_id(1), latvar_id, lat_glo)
+    ELSE IF ( lon_nbdims == 1 .AND. lat_nbdims == 1 ) THEN
+       DO iv=1,jjm_glo
+          iret = NF90_GET_VAR(force_id(1), lonvar_id, lon_glo(:,iv))
+       ENDDO
+       DO iv=1,iim_glo
+          iret = NF90_GET_VAR(force_id(1), latvar_id, lat_glo(iv,:))
+       ENDDO
+    ELSE
+       WRITE(*,*) "Found dimensions for lon and lat :", lon_nbdims, lat_nbdims
+       CALL ipslerr (3,'forcing_getglogrid',"Longitude and Latitude variables do not have the right dimensions.", " ", " ")
+    ENDIF
+    !
+    ! If we have a indexing variable then the data is compressed by gathering, else we have to construct it.
+    !
+    compressed = .FALSE.
+    IF ( landvar_id > 0 ) THEN
+       IF ( .NOT. ALLOCATED(lindex_glo)) ALLOCATE(lindex_glo(nbland_glo))
+       iret = NF90_GET_VAR(force_id(1), landvar_id, lindex_glo)
+       compressed = .TRUE.
+    ENDIF
+    !
+    IF ( .NOT. ALLOCATED(mask_glo)) ALLOCATE(mask_glo(iim_glo, jjm_glo)) 
+    !
+    ! Get the land/sea mask and contfrac based on a test variable, if contfract is not available. Else
+    ! we use the contfrac variable.
+    !
+    IF ( compressed ) THEN
+       IF ( .NOT. ALLOCATED(contfrac_glo)) ALLOCATE(contfrac_glo(nbland_glo))
+       IF ( .NOT. ALLOCATED(testvar)) ALLOCATE(testvar(nbland_glo))
+       CALL forcing_contfrac1d(force_id(1), testvar_id, contfrac_id, testvar)
+    ELSE
+       IF ( .NOT. ALLOCATED(testvar2d)) ALLOCATE(testvar2d(iim_glo, jjm_glo))
+       IF ( .NOT. ALLOCATED(contfrac2d)) ALLOCATE(contfrac2d(iim_glo, jjm_glo))
+       CALL forcing_contfrac2d(force_id(1), testvar_id, contfrac_id, testvar2d, contfrac2d, &
+            & testvar_missing, contfrac_missing, nbland_glo)
+       !
+       ! We have found a variable on which we can count the number of land points. We can build
+       ! the indexing table and gather the information needed.
+       !
+       IF ( .NOT. ALLOCATED(lindex_glo)) ALLOCATE(lindex_glo(nbland_glo))
+       IF ( .NOT. ALLOCATED(contfrac_glo)) ALLOCATE(contfrac_glo(nbland_glo))
+       IF ( .NOT. ALLOCATED(testvar)) ALLOCATE(testvar(nbland_glo))
+       IF ( contfrac_id > 0 ) THEN
+          CALL forcing_buildindex(contfrac2d, contfrac_missing, lindex_glo, contfrac_glo)
+          CALL forcing_reindex(iim_glo, jjm_glo, testvar2d, nbland_glo, testvar, lindex_glo)
+       ELSE
+          CALL forcing_buildindex(testvar2d, testvar_missing, lindex_glo, testvar)
+          contfrac_glo(:) = 1.0
+       ENDIF
+       !
+    ENDIF
+    !
+    ! We assume that if the forcing file is closed at the end of this subroutine this is a test
+    ! or initialisation of the grids. So we will dump the mask in a netCDF file for the user to 
+    ! check.
+    !
+    dump_mask = closefile 
+    CALL forcing_checkindex(dump_mask, testvarname, testvar)
+    !
+    !
+    ! 8.0 Close file if needed
+    !
+    IF ( closefile ) THEN
+       CALL forcing_close()
+    ENDIF
+    !
+    ! Prepare variables to be returnned to calling subroutine.
+    !
+    iim_tmp = iim_glo
+    jjm_tmp = jjm_glo
+    nbland_tmp = nbland_glo
+    !
+    ! Clean up !
+    !
+    IF ( ALLOCATED(dimids) ) DEALLOCATE(dimids)
+    IF ( ALLOCATED(londim_ids) ) DEALLOCATE(londim_ids)
+    IF ( ALLOCATED(latdim_ids) ) DEALLOCATE(latdim_ids)
+    IF ( ALLOCATED(testvar) ) DEALLOCATE(testvar)
+    IF ( ALLOCATED(testvar2d) ) DEALLOCATE(testvar2d)
+    IF ( ALLOCATED(contfrac2d) ) DEALLOCATE(contfrac2d)
+    !
+  END SUBROUTINE forcing_getglogrid
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_buildindex
+!!
+!>\BRIEF      
+!!
+!! DESCRIPTION:	When the forcing file does not contain compressed variables we need
+!!              to build the land index variable from the mask defined by missing variables in 
+!!              a test variable.  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_buildindex(var2d, var_missing, lindex, var)
+    !
+    ! When the forcing file does not contain compressed variables we need
+    ! to build the land index variable from the mask defined by missing variables in 
+    ! a test variable.
+    !
+    ! Arguments
+    !
+    REAL(r_std), INTENT(in) :: var2d(:,:)
+    REAL(r_std), INTENT(in) :: var_missing
+    INTEGER(i_std), INTENT(out) :: lindex(:)
+    REAL(r_std), INTENT(out) :: var(:)
+    !
+    ! Local
+    !
+    INTEGER(i_std) :: i,j,k
+    !
+    k=0
+    DO i=1,iim_glo
+       DO j=1,jjm_glo
+          IF (var2d(i,j) /= var_missing ) THEN
+             k = k + 1
+             lindex(k) = (j-1)*iim_glo+i 
+             var(k) = var2d(i,j)
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE forcing_buildindex
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_contfrac1d
+!!
+!>\BRIEF      
+!!
+!! DESCRIPTION:	 This routine build the land/mask if needed and gets the contfrac variable from forcing file.
+!!               Here we treat the case where the variables are compressed by gathering. Thus only
+!!               land points are available in the file. 
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_contfrac1d(ifile, testvar_id, contfrac_id, testvar)
+    !
+    ! This routine build the land/mask if needed and gets the contfrac variable from forcing file.
+    ! Here we treat the case where the variables are compressed by gathering. Thus only
+    ! land points are available in the file.
+    ! 
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in)               :: ifile
+    INTEGER(i_std), INTENT(in)               :: testvar_id, contfrac_id
+    REAL(r_std), DIMENSION(:), INTENT(inout) :: testvar 
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std)                           :: it, iret
+    INTEGER(i_std), DIMENSION(3)             :: start, count
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: contfrac2d
+    !
+    ! First determine the contfrac variable
+    !
+    IF ( contfrac_id > 0 ) THEN
+       iret = NF90_INQUIRE_VARIABLE(ifile, contfrac_id, ndims=it)
+       IF ( it == 1 ) THEN
+          start = (/1,1,0/)
+          count = (/nbland_glo,1,0/)
+          iret = NF90_GET_VAR(ifile, contfrac_id, contfrac_glo, start, count)
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) TRIM(nf90_strerror(iret))
+             CALL ipslerr (3,'forcing_contfrac1d',"Error reading contfrac ", " ", " ")
+          ENDIF
+       ELSE IF ( it == 2 ) THEN
+          ALLOCATE(contfrac2d(iim_glo,jjm_glo))
+          start = (/1,1,0/)
+          count = (/iim_glo,jjm_glo,0/)
+          iret = NF90_GET_VAR(ifile, contfrac_id, contfrac2d)
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) TRIM(nf90_strerror(iret))
+             CALL ipslerr (3,'forcing_contfrac1d',"Error reading contfrac ", " ", " ")
+          ENDIF
+          CALL forcing_reindex(iim_glo, jjm_glo, contfrac2d, nbland_glo, contfrac_glo, lindex_glo)
+          DEALLOCATE(contfrac2d)
+       ELSE
+          CALL ipslerr (3,'forcing_contfrac1d',"Contfrac has a dimension larger than 2. ", &
+               "We do not know how to handle this.", " ")
+       ENDIF
+    ELSE
+       contfrac_glo(:) = 1.0
+    ENDIF
+    !
+    ! Read our test variable 
+    !
+    iret = NF90_INQUIRE_VARIABLE(ifile, testvar_id, ndims=it)
+    IF ( it == 2 ) THEN
+       start = (/1,1,0/)
+       count = (/nbland_glo,1,0/)
+    ELSE IF ( it == 3 ) THEN
+       start = (/1,1,1/)
+       count = (/nbland_glo,1,1/)
+    ELSE
+       CALL ipslerr (3,'forcing_contfrac1d',"Testvar has a dimension larger than 3.", &
+            "We do not know how to handle this", " ")
+    ENDIF
+    iret = NF90_GET_VAR(ifile, testvar_id, testvar, start, count)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(*,*) TRIM(nf90_strerror(iret))
+       CALL ipslerr (3,'forcing_contfrac1d',"Error reading testvar.", " ", " ")
+    ENDIF
+    !
+  END SUBROUTINE forcing_contfrac1d
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_contfrac2d
+!!
+!>\BRIEF      
+!!
+!! DESCRIPTION: This routine build the land/mask if needed and gets the contfrac variable from forcing file.
+!!              Here we treat the case where the variables is 2D. Thus we also need to identify the land points.
+!!              For this we can either use the contfrac variable or the test variable.	  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_contfrac2d(ifile, testvar_id, contfrac_id, testvar, contfrac, testvar_missing, contfrac_missing, nbland)
+    !
+    ! This routine build the land/mask if needed and gets the contfrac variable from forcing file.
+    ! Here we treat the case where the variables is 2D. Thus we also need to identify the land points.
+    ! For this we can either use the contfrac variable or the test variable.
+    ! 
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in)                 :: ifile
+    INTEGER(i_std), INTENT(in)                 :: testvar_id, contfrac_id
+    REAL(r_std), DIMENSION(:,:), INTENT(inout) :: testvar 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout) :: contfrac
+    REAL(r_std), INTENT(in)                    :: testvar_missing
+    REAL(r_std), INTENT(in)                    :: contfrac_missing
+    INTEGER(i_std), INTENT(out)                :: nbland
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std)                           :: i, j, it, iret
+    INTEGER(i_std), DIMENSION(4)             :: start, count
+    !
+    !
+    nbland = 0
+    !
+    IF ( contfrac_id > 0 ) THEN
+       !
+       iret = NF90_INQUIRE_VARIABLE(ifile, contfrac_id, ndims=it)
+       IF ( it == 2 ) THEN
+          start = (/1,1,0,0/)
+          count = (/iim_glo,jjm_glo,0,0/)
+          iret = NF90_GET_VAR(ifile, contfrac_id, contfrac, start, count)
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) TRIM(nf90_strerror(iret))
+             CALL ipslerr (3,'forcing_contfrac2d',"Error reading contfrac.", " ", " ")
+          ENDIF
+       ELSE
+          CALL ipslerr (3,'forcing_contfrac2d',"Contfrac has a dimension different of 1.", &
+               "We do not know how to handle this.", " ")
+       ENDIF
+       !
+       ! Count the number of land points.
+       !
+       DO i=1,iim_glo
+          DO j=1,jjm_glo
+             IF ( contfrac(i,j) /= contfrac_missing ) THEN
+                nbland = nbland + 1
+             ENDIF
+          ENDDO
+       ENDDO
+       !
+       ! If we did not find any land points on the map (i.e. iim_glo > 1 and jjm_glo > 1) then we
+       ! look for fractions larger then 0.
+       !
+       IF ( iim_glo > 1 .AND. jjm_glo > 1 .AND. nbland < 1 ) THEN
+          DO i=1,iim_glo
+             DO j=1,jjm_glo
+                IF ( contfrac(i,j) > 0.0 ) THEN
+                   nbland = nbland + 1
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDIF
+       !
+       ! Did we get a result ?
+       !
+       IF ( iim_glo > 1 .AND. jjm_glo > 1 .AND. nbland < 1 ) THEN
+          CALL ipslerr (3,'forcing_contfrac2d',"Contfrac was used to count the number of land points.", &
+               &          "We still have not found any land points when we looked for contfrac > 0.", " ")
+       ENDIF
+       !
+    ELSE
+       ! Just so that we have no un-initialized variable
+       contfrac(:,:) = 0.0
+    ENDIF
+    !
+    IF ( testvar_id > 0 ) THEN
+       !
+       iret = NF90_INQUIRE_VARIABLE(ifile, testvar_id, ndims=it)
+       IF ( it == 2 ) THEN
+          start = (/1,1,0,0/)
+          count = (/iim_glo,jjm_glo,0,0/)
+       ELSE IF ( it == 3 ) THEN
+          start = (/1,1,1,0/)
+          count = (/iim_glo,jjm_glo,1,0/)
+       ELSE IF ( it == 4 ) THEN
+          start = (/1,1,1,1/)
+          count = (/iim_glo,jjm_glo,1,1/)
+       ELSE
+          CALL ipslerr (3,'forcing_contfrac2d',"testvar has a dimension of 1 or larger than 4.", &
+               "We do not know how to handle this.", " ")
+       ENDIF
+       iret = NF90_GET_VAR(ifile, testvar_id, testvar, start, count)
+       IF (iret /= NF90_NOERR) THEN
+          WRITE(*,*) TRIM(nf90_strerror(iret))
+          CALL ipslerr (3,'forcing_contfrac2d',"Error reading testvar.", " ", " ")
+       ENDIF
+       !
+       ! IF with count frac we did not get the number of land points, let us try it here
+       !
+       IF ( nbland < 1 ) THEN
+          DO i=1,iim_glo
+             DO j=1,jjm_glo
+                IF ( testvar(i,j) /= testvar_missing ) THEN
+                   nbland = nbland + 1
+                   ! Add infor to contfrac
+                   IF ( contfrac_id < 0 ) THEN
+                      contfrac(i,j) = 1.0
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDIF
+       !
+       !
+       ! Did we get a result here ?
+       !
+       IF ( iim_glo > 1 .AND. jjm_glo > 1 .AND. nbland < 1 ) THEN
+          CALL ipslerr (3,'forcing_contfrac2d',"Contfrac and testvar were used to count the number", &
+               &          "of land points. We have not found any land points.", " ")
+       ENDIF
+       !
+    ENDIF
+    !
+  END SUBROUTINE forcing_contfrac2d
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_checkindex
+!!
+!>\BRIEF      
+!!
+!! DESCRIPTION:	 For ORCHIDEE its paralelisation requires that the land points are ordered
+!!               in such a way that the longitude runs fastest. That means that we go over the
+!!               globle filling one line after the other.
+!!               As this might not be the case in a compressed vector of land points, we need to 
+!!               put all the points on the 2d grid and then scan them in the right order. 
+!!               The reindexing is prepared here.  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_checkindex(dump_mask, testvarname, testvar)
+    !
+    ! For ORCHIDEE its paralelisation requires that the land points are ordered
+    ! in such a way that the longitude runs fastest. That means that we go over the
+    ! globle filling one line after the other.
+    ! As this might not be the case in a compressed vector of land points, we need to 
+    ! put all the points on the 2d grid and then scan them in the right order. 
+    ! The reindexing is prepared here.
+    !
+    LOGICAL          :: dump_mask
+    CHARACTER(LEN=*) :: testvarname
+    REAL(r_std)      :: testvar(:)
+    !
+    INTEGER(i_std) :: j, i, ik
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)   :: testvar_reind
+    !
+    !
+    !
+    ! Get the indices of the land points in the focing file
+    !
+    IF ( .NOT. ALLOCATED(reindex_glo)) ALLOCATE(reindex_glo(nbland_glo))
+    IF ( .NOT. ALLOCATED(origind)) ALLOCATE(origind(iim_glo,jjm_glo))
+    !
+    ! Find the origine of each point in the gathered vector on the xy grid.
+    !
+    origind(:,:) = -1
+    mask_glo(:,:) = 0
+    DO ik=1,nbland_glo
+       j = INT((lindex_glo(ik)-1)/iim_glo)+1
+       i = (lindex_glo(ik)-(j-1)*iim_glo)
+       origind(i,j) = ik
+       mask_glo(i,j) = 1
+    ENDDO
+    !
+    ! Prepare a reindexing array so that the vector goes in the right order : longitude runs
+    ! faster than the latitude. Put then also the right information into lindex_glo.
+    !
+    ik=0
+    DO j=1,jjm_glo
+       DO i=1,iim_glo
+          IF ( origind(i,j) > zero ) THEN
+             ik = ik+1
+             reindex_glo(ik) = origind(i,j)
+             lindex_glo(ik) = (j-1)*iim_glo+i
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    !
+    ! Write the mask and a test variable to a file so that the user can check that all is OK
+    !
+    IF ( dump_mask) THEN
+       !
+       ! Scatter the test variable and save it in the file
+       !
+       WRITE(*,*) MINVAL(testvar), "<< test variable ", TRIM(testvarname), " <<", MAXVAL(testvar) 
+       ALLOCATE(testvar_reind(nbland_glo))
+       !
+       CALL forcing_reindex(nbland_glo, testvar, nbland_glo, testvar_reind, reindex_glo)
+       !
+       CALL forcing_writetestvar("forcing_mask_glo.nc", iim_glo, jjm_glo, nbland_glo, &
+            &                    lon_glo(:,1), lat_glo(1,:), lindex_glo, mask_glo, &
+            &                    testvarname, testvar_reind)
+       !
+    ENDIF
+    !
+    ! Clean up !
+    !
+    IF ( ALLOCATED(testvar_reind) ) DEALLOCATE(testvar_reind)
+    !
+  END SUBROUTINE forcing_checkindex
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_writetestvar
+!!
+!>\BRIEF Write the mask and a test variable to a netCDF file.     
+!!
+!! DESCRIPTION:	This routine allows to test if the variables read from the forcing files is well read.
+!!              Typically the forcing is compressed by gathering and thus it is a safe practice
+!!              to verify that the un-compression is done correctly and that all points end-up in the
+!!              right place on the global lat/lon grid.
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_writetestvar(ncdffile, iim, jjm, nbland, lon, lat, lindex, mask, varname, var)
+    !
+    ! Write the mask and a test variable to a netCDF file
+    !
+    ! ARGUMENTS
+    !
+    CHARACTER(LEN=*), INTENT(in) :: ncdffile
+    INTEGER(i_std), INTENT(in)   :: iim, jjm, nbland
+    REAL(r_std), INTENT(in)      :: lon(iim), lat(jjm)
+    INTEGER(i_std), INTENT(in)   :: lindex(nbland)
+    INTEGER(i_std), INTENT(in)   :: mask(iim,jjm)
+    CHARACTER(LEN=*), INTENT(in) :: varname
+    REAL(r_std), INTENT(in)      :: var(nbland)
+    !
+    ! Local
+    !
+    INTEGER(i_std) :: ik, i, j
+    INTEGER(i_std) :: iret, nlonid, nlatid, varid, fid, ierr, iland
+    INTEGER(i_std) :: testid
+    INTEGER(i_std), DIMENSION(2) :: lolaid
+    REAL(r_std) :: test_scat(iim,jjm)
+    !
+    WRITE(*,*) "Working on file ", TRIM(ncdffile)
+    !
+    test_scat(:,:) = NF90_FILL_REAL
+    CALL forcing_reindex(nbland, var, iim, jjm, test_scat, lindex)
+    !
+    iret = NF90_CREATE(ncdffile, NF90_WRITE, fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'forcing_writetestvar',"Error opening the output file : ", ncdffile, " ")
+    ENDIF
+    !
+    ! Define dimensions
+    !
+    iret = NF90_DEF_DIM(fid,'lon',iim,lolaid(1))
+    iret = NF90_DEF_DIM(fid,'lat',jjm,lolaid(2))
+    !
+    !
+    iret = NF90_DEF_VAR(fid,"lon",NF90_REAL4,lolaid(1),nlonid)
+    iret = NF90_PUT_ATT(fid,nlonid,'axis',"X")
+    iret = NF90_PUT_ATT(fid,nlonid,'standard_name',"longitude")
+    iret = NF90_PUT_ATT(fid,nlonid,'units',"degree_east")
+    iret = NF90_PUT_ATT(fid,nlonid,'valid_min',MINVAL(lon_glo))
+    iret = NF90_PUT_ATT(fid,nlonid,'valid_max',MAXVAL(lon_glo))
+    iret = NF90_PUT_ATT(fid,nlonid,'long_name',"Longitude")
+    !
+    iret = NF90_DEF_VAR(fid,"lat",NF90_REAL4,lolaid(2),nlatid)
+    iret = NF90_PUT_ATT(fid,nlatid,'axis',"Y")
+    iret = NF90_PUT_ATT(fid,nlatid,'standard_name',"latitude")
+    iret = NF90_PUT_ATT(fid,nlatid,'units',"degree_north")
+    iret = NF90_PUT_ATT(fid,nlatid,'valid_min',MINVAL(lat_glo))
+    iret = NF90_PUT_ATT(fid,nlatid,'valid_max',MAXVAL(lat_glo))
+    iret = NF90_PUT_ATT(fid,nlatid,'long_name',"Latitude")
+    !
+    iret = NF90_DEF_VAR(fid,"mask",NF90_REAL4,lolaid,varid)
+    !
+    iret = NF90_DEF_VAR(fid,TRIM(varname),NF90_REAL4,lolaid,testid)
+    iret = NF90_PUT_ATT(fid,testid,'_FillValue',NF90_FILL_REAL)
+    iret = NF90_PUT_ATT(fid,testid,'missing_value',NF90_FILL_REAL)
+    !
+    iret = NF90_ENDDEF (fid)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(*,*) TRIM(nf90_strerror(iret))
+       CALL ipslerr (3,'forcing_writetestvar',"Error ending definitions in file : ", ncdffile, " ")
+    ENDIF
+    !
+    ! Write variables
+    !
+    iret = NF90_PUT_VAR(fid,nlonid,lon)
+    iret = NF90_PUT_VAR(fid,nlatid,lat)
+    iret = NF90_PUT_VAR(fid,varid,REAL(mask))
+    iret = NF90_PUT_VAR(fid,testid,test_scat)
+    !
+    ! Close file
+    !
+    iret = NF90_CLOSE(fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'forcing_writetestvar',"Error closing the output file : ", ncdffile, " ")
+    ENDIF
+    !
+  END SUBROUTINE forcing_writetestvar
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_zoomgrid 
+!!
+!>\BRIEF      We zoom into the region requested by the user.
+!!
+!! DESCRIPTION:	Get the area to be zoomed and the sizes of arrays we will need.
+!!              This subroutine fills the *_loc variables.
+!!              If requested it will dump a test vraible into a netCDF file.  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_zoomgrid (zoom_lon, zoom_lat, filename, dumpncdf)
+    !
+    ! Get the area to be zoomed and the sizes of arrays we will need.
+    ! This subroutine fills the *_loc variables.
+    ! If requested it will dump a test vraible into a netCDF file.
+    !
+    ! ARGUMENTS
+    !
+    REAL(r_std), DIMENSION(2), INTENT(in) :: zoom_lon, zoom_lat
+    CHARACTER(LEN=*), INTENT(in) :: filename
+    LOGICAL, INTENT(in) :: dumpncdf
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: i, j, ic, jc, ik, ig
+    REAL(r_std) :: dx, dy, coslat
+    REAL(r_std) :: lon_tmp(iim_glo), lat_tmp(jjm_glo)
+    REAL(r_std) :: longlo_tmp(iim_glo,jjm_glo)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lon_val, lat_val
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: zoom_index
+    !
+    INTEGER(i_std) :: iret, force_id, iv
+    INTEGER(i_std), DIMENSION(1) :: imin, jmin
+    INTEGER(i_std), DIMENSION(2) :: start, count
+    INTEGER(i_std), DIMENSION(3) :: start2d, count2d
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: readvar, zoomedvar
+     REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: readvar2d
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: index_glotoloc
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lalo
+    CHARACTER(LEN=8) :: testvarname="Tair"
+    !
+    ! 0.0 Verify we are on the root processor
+    !
+    IF ( .NOT. is_root_prc ) THEN
+       CALL ipslerr (3,'forcing_zoomgrid'," This routine can only be called on the root processor.", " ", " ")
+    ENDIF
+    !
+    ! 0.1 Inform the user
+    !
+    WRITE(*,*) "Zoom forcing : lon = ", zoom_lon
+    WRITE(*,*) "Zoom forcing : lat = ", zoom_lat
+    !
+    ! Some forcing files have longitudes going from 0 to 360. This code works on the
+    ! -180 to 180 longitude grid. So if needed we transform the longitudes of the global grid.
+    !
+    IF ( MAXVAL(lon_glo) <= 180.0 ) THEN
+       longlo_tmp=lon_glo
+    ELSE
+       DO i=1,iim_glo
+          DO j=1,jjm_glo
+             IF ( lon_glo(i,j) <= 180.0 ) THEN
+                longlo_tmp(i,j) = lon_glo(i,j)
+             ELSE
+                longlo_tmp(i,j) = lon_glo(i,j)-360
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDIF
+    !
+    ! See if we need to zoom
+    !
+    IF (MINVAL(zoom_lon) > MINVAL(longlo_tmp) .OR. MAXVAL(zoom_lon) < MAXVAL(longlo_tmp) .OR.&
+         & MINVAL(zoom_lat) > MINVAL(lat_glo) .OR. MAXVAL(zoom_lat) < MAXVAL(lat_glo) ) THEN
+       zoom_forcing = .TRUE.
+    ENDIF
+    !
+    ! Determine the size in x and y of the zoom
+    !
+    IF ( zoom_forcing ) THEN
+       !
+       ! Working with the hypothesis it is a regular global grid and bring it back to the -180 to 180 interval
+       ! if needed.
+       !
+       lon_tmp(:) = longlo_tmp(:,1)
+       lat_tmp(:) = lat_glo(1,:)
+       !
+       DO i=1,iim_glo
+          IF ( lon_tmp(i) <= MINVAL(zoom_lon) .OR.  lon_tmp(i) >= MAXVAL(zoom_lon) ) THEN
+             lon_tmp(i) = 0.0
+          ELSE
+             lon_tmp(i) = 1.0
+          ENDIF
+       ENDDO
+       DO j=1,jjm_glo
+          IF ( lat_tmp(j) <= MINVAL(zoom_lat) .OR. lat_tmp(j) >= MAXVAL(zoom_lat) ) THEN
+             lat_tmp(j) = 0.0
+          ELSE 
+             lat_tmp(j) = 1.0
+          ENDIF
+       ENDDO
+       iim_loc = NINT(SUM(lon_tmp))
+       jjm_loc = NINT(SUM(lat_tmp))
+    ELSE
+       iim_loc = iim_glo
+       jjm_loc = jjm_glo
+       lon_tmp(:) = 1.0
+       lat_tmp(:) = 1.0
+    ENDIF
+    !
+    ! Determine the number of land points in the zoom
+    !
+    IF ( .NOT. ALLOCATED(lon_loc) ) ALLOCATE(lon_loc(iim_loc,jjm_loc))
+    IF ( .NOT. ALLOCATED(lat_loc) ) ALLOCATE(lat_loc(iim_loc,jjm_loc))
+    IF ( .NOT. ALLOCATED(mask_loc) ) ALLOCATE(mask_loc(iim_loc,jjm_loc))
+    IF ( .NOT. ALLOCATED(zoom_index) ) ALLOCATE(zoom_index(iim_loc,jjm_loc,2))
+    !
+    IF ( .NOT. ALLOCATED(lon_val)) ALLOCATE(lon_val(iim_loc))
+    IF ( .NOT. ALLOCATED(lat_val)) ALLOCATE(lat_val(jjm_loc))
+    !
+    ! Create our new lat/lon system which is in the -180/180 range and South to North and West to East
+    !
+    ic=0
+    DO i=1,iim_glo
+       IF ( lon_tmp(i) > 0 ) THEN
+          ic = ic+1
+          lon_val(ic) = longlo_tmp(i,1)
+       ENDIF
+    ENDDO
+    jc=0
+    DO j=1,jjm_glo
+       IF ( lat_tmp(j) > 0 ) THEN
+          jc = jc+1
+          lat_val(jc) = lat_glo(1,j)
+       ENDIF
+    ENDDO
+    CALL sort(lon_val, iim_loc)
+    CALL sort(lat_val, jjm_loc)
+    !
+    ! Now find the correspondance between the zoomed & re-ordered grid and the global one.
+    !
+    DO i=1,iim_loc
+       DO j=1,jjm_loc
+          !
+          imin=MINLOC(ABS(longlo_tmp(:,1)-lon_val(i)))
+          jmin=MINLOC(ABS(lat_glo(1,:)-lat_val(j)))
+          !
+          lon_loc(i,j) = longlo_tmp(imin(1),jmin(1))
+          lat_loc(i,j) = lat_glo(imin(1),jmin(1))
+          mask_loc(i,j) = mask_glo(imin(1),jmin(1))
+          !
+          zoom_index(i,j,1) = imin(1)
+          zoom_index(i,j,2) = jmin(1)
+          !
+       ENDDO
+    ENDDO
+    !
+    nbland_loc = SUM(mask_loc)
+    IF ( .NOT. zoom_forcing .AND. nbland_loc .NE. nbland_glo) THEN
+       WRITE(*,*) "We have not zoomed into the forcing file still we get a number of"
+       WRITE(*,*) "land points that is different from what we have in the forcing file."
+       STOP "forcing_zoomgrid"
+    ENDIF
+    !
+    IF ( .NOT. ALLOCATED(lindex_loc)) ALLOCATE(lindex_loc(nbland_loc))
+    IF ( .NOT. ALLOCATED(reindex_loc)) ALLOCATE(reindex_loc(nbland_loc))
+    IF ( .NOT. ALLOCATED(contfrac_loc)) ALLOCATE(contfrac_loc(nbland_loc))
+    !
+    IF ( .NOT. ALLOCATED(reindex2d_loc)) ALLOCATE(reindex2d_loc(nbland_loc,2))
+    IF ( .NOT. ALLOCATED(index_glotoloc)) ALLOCATE(index_glotoloc(nbland_glo))
+    IF ( .NOT. ALLOCATED(lalo)) ALLOCATE(lalo(nbland_loc,2))
+    !
+    ! Do the actual zoom on the grid
+    !
+    ! Set indices of all points as non existant so that we can fill in as we zoom the 
+    ! indices of the points which exist.
+    index_glotoloc(:) = -1
+    !
+    ik = 0
+    !
+    ! Loop only over the zoomed grid
+    !
+    ! Why does the inner loop need to be ic for the pralalisation ????
+    !
+    DO jc=1,jjm_loc
+       DO ic=1,iim_loc
+          !
+          ! Point back from the local to the original global i*j grid
+          !
+          i = zoom_index(ic,jc,1)
+          j = zoom_index(ic,jc,2)
+          !
+          IF ( origind(i,j) > 0 ) THEN
+             ik = ik+1
+             ! index of the points in the local grid
+             lindex_loc(ik) = (jc-1)*iim_loc+ic
+             !
+             ! For land points, the index of global grid is saved for the this point on the local grid 
+             reindex_loc(ik) = origind(i,j)
+             !
+             ! Keep also the i and j of the global grid for this land point on the local grid
+             reindex2d_loc(ik,1) = i
+             reindex2d_loc(ik,2) = j
+             !
+             ! Keep the reverse : on the global grid the location where we put the value of the local grid.
+             index_glotoloc(origind(i,j)) = ik
+             !
+             contfrac_loc(ik) = contfrac_glo(origind(i,j))
+             !
+             lalo(ik,1) = lat_glo(i,j)
+             lalo(ik,2) = longlo_tmp(i,j)
+             !
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    !
+    !
+    ncdfstart = MINVAL(reindex_loc)
+    reindex_loc(:) = reindex_loc(:)-ncdfstart+1
+    ncdfcount =  MAXVAL(reindex_loc)
+    !
+    ! Compute the areas and the corners on the grid over which we will run ORCHIDEE.
+    ! As this module is dedicated for regular lat/lon forcing we know that we can compute these
+    ! variables without further worries.
+    !
+    IF ( .NOT. ALLOCATED(area_loc)) ALLOCATE(area_loc(iim_loc,jjm_loc))
+    IF ( .NOT. ALLOCATED(corners_loc)) ALLOCATE(corners_loc(iim_loc,jjm_loc,4,2))
+    !
+    ! Treat first the longitudes
+    !
+    DO j=1,jjm_loc
+       dx = zero
+       DO i=1,iim_loc-1
+          dx = dx+ABS(lon_loc(i,j)-lon_loc(i+1,j))
+       ENDDO
+       dx = dx/(iim_loc-1)
+       DO i=1,iim_loc
+          corners_loc(i,j,1,1) = lon_loc(i,j)-dx/2.0
+          corners_loc(i,j,2,1) = lon_loc(i,j)+dx/2.0
+          corners_loc(i,j,3,1) = lon_loc(i,j)+dx/2.0
+          corners_loc(i,j,4,1) = lon_loc(i,j)-dx/2.0
+       ENDDO
+    ENDDO
+    !
+    ! Now treat the latitudes
+    !
+    DO i=1,iim_loc
+       dy = zero
+       DO j=1,jjm_loc-1
+          dy = dy + ABS(lat_loc(i,j)-lat_loc(i,j+1))
+       ENDDO
+       dy = dy/(jjm_loc-1)
+       DO j=1,jjm_loc
+          corners_loc(i,j,1,2) = lat_loc(i,j)+dy/2.0
+          corners_loc(i,j,2,2) = lat_loc(i,j)+dy/2.0
+          corners_loc(i,j,3,2) = lat_loc(i,j)-dy/2.0
+          corners_loc(i,j,4,2) = lat_loc(i,j)-dy/2.0
+       ENDDO
+    ENDDO
+    !
+    ! Compute the areas of the grid (using the simplification that the grid is regular in lon/lat).
+    !
+    DO i=1,iim_loc
+       DO j=1,jjm_loc
+          coslat = MAX( COS(lat_loc(i,j) * pi/180. ), mincos )
+          dx = ABS(corners_loc(i,j,2,1) - corners_loc(i,j,1,1)) * pi/180. * R_Earth * coslat
+          dy = ABS(corners_loc(i,j,1,2) - corners_loc(i,j,3,2)) * pi/180. * R_Earth
+          area_loc(i,j) = dx*dy
+       ENDDO
+    ENDDO
+    !
+    ! If requested we read a variable, zoomin and dump the result into a test file.
+    !
+    IF ( dumpncdf ) THEN
+       iret = NF90_OPEN (filename, NF90_NOWRITE, force_id)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'forcing_zoomgrid',"Error opening the forcing file :", filename, " ")
+       ENDIF
+       !
+       ALLOCATE(readvar(ncdfcount), readvar2d(iim_glo,jjm_glo), zoomedvar(nbland_loc))
+       !
+       iret = NF90_INQ_VARID(force_id, TRIM(testvarname), iv)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'forcing_zoomgrid',"Could not find variable Tair in file."," "," ")
+       ENDIF
+
+       IF ( compressed ) THEN
+          !
+          start(1) = ncdfstart
+          start(2) = 1
+          count(1) = ncdfcount
+          count(2) = 1
+          !
+          iret = NF90_GET_VAR(force_id, iv, readvar, start, count)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'forcing_zoomgrid',"Could not read compressed variable Tair from file."," "," ")
+          ENDIF
+          CALL forcing_reindex(ncdfcount, readvar, nbland_loc, zoomedvar, reindex_loc)
+          !
+       ELSE
+          !
+          start2d(1) = 1
+          start2d(2) = 1
+          start2d(3) = 1
+          count2d(1) = iim_glo
+          count2d(2) = jjm_glo
+          count2d(3) = 1
+          !
+          iret = NF90_GET_VAR(force_id, iv, readvar2d, start2d, count2d)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'forcing_zoomgrid',"Could not read variable Tair from file."," "," ")
+          ENDIF
+          CALL forcing_reindex(iim_glo, jjm_glo, readvar2d, nbland_loc, zoomedvar, reindex2d_loc)
+          !
+       ENDIF
+       !
+       CALL forcing_writetestvar("forcing_mask_loc.nc", iim_loc, jjm_loc, nbland_loc, &
+            &                    lon_loc(:,1), lat_loc(1,:), lindex_loc, mask_loc, &
+            &                    TRIM(testvarname), zoomedvar)
+       !
+    ENDIF
+    !
+    ! Clean up
+    !
+    IF ( ALLOCATED(readvar) ) DEALLOCATE(readvar)
+    IF ( ALLOCATED(readvar2d) ) DEALLOCATE(readvar2d)
+    IF ( ALLOCATED(zoomedvar) ) DEALLOCATE(zoomedvar)
+    IF ( ALLOCATED(index_glotoloc) ) DEALLOCATE(index_glotoloc)
+    IF ( ALLOCATED(lalo) ) DEALLOCATE(lalo)
+    !
+  END SUBROUTINE forcing_zoomgrid
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_givegridsize
+!!
+!>\BRIEF      Routine which exports the size of the grid on which the model will run, i.e. the zoomed grid.
+!!
+!! DESCRIPTION:	This is needed to transfer the grid information from this module to the glogrid.f90 module.  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_givegridsize (iim, jjm, nblindex)
+    !
+    ! Provides the size of the grid to be used to the calling program
+    !
+    ! Size of the x and y direction of the zoomed area
+    INTEGER(i_std), INTENT(out) :: iim, jjm
+    ! Number of land points in the zoomed area 
+    INTEGER(i_std), INTENT(out) :: nblindex
+    !
+    IF ( .NOT. is_root_prc ) THEN
+       CALL ipslerr (3,'forcing_givegridsize'," This routine can only be called on the root processor.", &
+            &          "The information requested is only available on root processor.", " ")
+    ENDIF
+    !
+    iim = iim_loc
+    jjm = jjm_loc
+    nblindex = nbland_loc
+    !
+  END SUBROUTINE forcing_givegridsize
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_
+!!
+!>\BRIEF      
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_vertical(force_id)
+    !
+    !- This subroutine explores the forcing file to decide what information is available
+    !- on the vertical coordinate.
+    !
+    INTEGER, INTENT(IN) :: force_id
+    !
+    INTEGER(i_std) :: iret, ireta, iretb
+    !
+    INTEGER(i_std) :: sigma_id = -1, sigma_uv_id = -1
+    INTEGER(i_std) :: hybsiga_id = -1, hybsiga_uv_id = -1
+    INTEGER(i_std) :: hybsigb_id = -1, hybsigb_uv_id = -1
+    INTEGER(i_std) :: levels_id = -1, levels_uv_id = -1
+    INTEGER(i_std) :: height_id = -1, height_uv_id = -1
+    INTEGER(i_std) :: lev_id = -1
+    !
+    LOGICAL :: var_exists, vara_exists, varb_exists, varuv_exists
+    LOGICAL :: foundvar
+    LOGICAL :: levlegacy
+    !
+    !- Set all the defaults
+    !
+    zfixed=.FALSE.
+    zsigma=.FALSE.
+    zhybrid=.FALSE.
+    zlevels=.FALSE.
+    zheight=.FALSE.
+    zsamelev_uv = .TRUE.
+    levlegacy = .FALSE.
+    !
+    foundvar = .FALSE.
+    !
+    !- We have a forcing file to explore so let us see if we find any of the conventions
+    !- which allow us to find the height of T,Q,U and V.
+    !
+    IF ( force_id > 0 ) THEN
+       !
+       ! Case for sigma levels
+       !
+       IF ( .NOT. foundvar ) THEN
+          ireta = NF90_INQ_VARID(force_id, 'Sigma', sigma_id)
+          IF ( (sigma_id >= 0) .AND. (ireta == NF90_NOERR) ) THEN
+             foundvar = .TRUE.
+             zsigma = .TRUE.
+             iretb = NF90_INQ_VARID(force_id, 'Sigma_uv', sigma_uv_id)
+             IF ( (sigma_uv_id >= 0) .OR. (iretb == NF90_NOERR) ) zsamelev_uv = .FALSE.
+          ENDIF
+       ENDIF
+       !
+       ! Case for Hybrid levels
+       !
+       IF ( .NOT. foundvar ) THEN
+          var_exists = .FALSE.
+          ireta = NF90_INQ_VARID(force_id, 'HybSigA', hybsiga_id)
+          IF ( (hybsiga_id >= 0 ) .AND. (ireta == NF90_NOERR) ) THEN
+             iretb = NF90_INQ_VARID(force_id, 'HybSigB', hybsigb_id)
+             IF ( (hybsigb_id >= 0 ) .AND. (iretb == NF90_NOERR) ) THEN
+                var_exists=.TRUE.
+             ELSE
+                CALL ipslerr ( 3, 'forcing_vertical','Missing the B coefficient for', &
+                     &         'Hybrid vertical levels for T and Q','stop')
+             ENDIF
+          ENDIF
+          ireta = NF90_INQ_VARID(force_id, 'HybSigA_uv', hybsiga_uv_id)
+          IF ( (hybsiga_uv_id >= 0 ) .AND. (ireta == NF90_NOERR) ) THEN
+             iretb = NF90_INQ_VARID(force_id, 'HybSigB_uv', hybsigb_uv_id)
+             IF ( (hybsigb_uv_id >= 0 ) .AND. (iretb == NF90_NOERR) ) THEN
+                varuv_exists=.TRUE.
+             ELSE
+                CALL ipslerr ( 3, 'forcing_vertical','Missing the B coefficient for', &
+                     &         'Hybrid vertical levels for U and V','stop')
+             ENDIF
+          ENDIF
+          IF ( var_exists ) THEN
+             foundvar = .TRUE.
+             zhybrid = .TRUE.
+             IF ( varuv_exists ) zsamelev_uv = .FALSE.
+          ENDIF
+       ENDIF
+       !
+       ! Case for levels (i.e. a 2d time varying field with the height in meters)
+       !
+       IF ( .NOT. foundvar ) THEN
+          ireta = NF90_INQ_VARID(force_id, 'Levels', levels_id)
+          IF ( (levels_id >= 0 ) .AND. (ireta == NF90_NOERR) ) THEN
+             foundvar = .TRUE.
+             zlevels = .TRUE.
+             iretb = NF90_INQ_VARID(force_id, 'Levels_uv', levels_uv_id)
+             IF ( (levels_uv_id >= 0 ) .AND. (iretb == NF90_NOERR) ) zsamelev_uv = .FALSE.
+          ENDIF
+       ENDIF
+       !
+       ! Case where a fixed height is provided in meters
+       !
+       IF ( .NOT. foundvar ) THEN
+          ireta = NF90_INQ_VARID(force_id, 'Height_Lev1', height_id)
+          IF ( (height_id >= 0 ) .AND. (ireta == NF90_NOERR) ) THEN
+             foundvar = .TRUE.
+             zheight = .TRUE.        
+             iretb = NF90_INQ_VARID(force_id, 'Height_Levuv', height_uv_id)
+             IF ( (height_uv_id >= 0 ) .AND. (iretb == NF90_NOERR) ) zsamelev_uv = .FALSE.
+          ENDIF
+       ENDIF
+       !
+       ! Case where a fixed height is provided in meters in the lev variable
+       !
+       IF ( .NOT. foundvar ) THEN
+          ireta = NF90_INQ_VARID(force_id, 'lev', lev_id)
+          IF ( (lev_id >= 0 ) .AND. (ireta == NF90_NOERR) ) THEN
+             foundvar = .TRUE.
+             zheight = .TRUE.
+             levlegacy = .TRUE.
+          ENDIF
+       ENDIF
+       !
+    ENDIF
+    !
+    ! We found forcing variables so we need to extract the values if we are dealing with constant values (i.e. all
+    ! except the case zlevels
+    !
+    IF ( foundvar .AND. .NOT. zlevels ) THEN
+       !
+       IF ( zheight ) THEN
+          !
+          ! Constant height
+          !
+          IF ( levlegacy ) THEN
+             iret = NF90_GET_VAR(force_id, lev_id, zlev_fixed)
+             IF ( iret /= NF90_NOERR ) THEN
+                CALL ipslerr ( 3, 'forcing_vertical','Attempted to read variable lev from forcing file in legacy mode', &
+                     &         'NF90_GET_VAR failed.','stop')
+             ENDIF
+          ELSE
+             iret = NF90_GET_VAR(force_id, height_id, zlev_fixed)
+             IF ( iret /= NF90_NOERR ) THEN
+                CALL ipslerr ( 3, 'forcing_vertical','Attempted to read variable Height_Lev1 from forcing file', &
+                     &         'NF90_GET_VAR failed.','stop')
+             ENDIF
+             IF ( .NOT. zsamelev_uv ) THEN
+                iret = NF90_GET_VAR(force_id, height_uv_id, zlevuv_fixed)
+                IF ( iret /= NF90_NOERR ) THEN
+                   CALL ipslerr ( 3, 'forcing_vertical','Attempted to read variable Height_Levuv from forcing file', &
+                        &         'NF90_GET_VAR failed.','stop')
+                ENDIF
+             ENDIF
+          ENDIF
+          WRITE(*,*) "forcing_vertical : case ZLEV : Read from forcing file :", zlev_fixed, zlevuv_fixed
+          !
+       ELSE IF ( zsigma .OR. zhybrid ) THEN
+          !
+          ! Sigma or hybrid levels
+          !
+          IF ( zsigma ) THEN
+             iret = NF90_GET_VAR(force_id, sigma_id, zhybrid_b)
+             zhybrid_a = zero
+             IF ( .NOT. zsamelev_uv ) THEN
+                iret = NF90_GET_VAR(force_id, sigma_uv_id, zhybriduv_b)
+                zhybriduv_a = zero
+             ENDIF
+          ELSE
+             ireta = NF90_GET_VAR(force_id, hybsigb_id, zhybrid_b)
+             iretb = NF90_GET_VAR(force_id, hybsiga_id, zhybrid_a)
+             IF ( ireta /= NF90_NOERR .OR. iretb /= NF90_NOERR) THEN
+                CALL ipslerr ( 3, 'forcing_vertical','Attempted to read variable HybSigA and HybSigB from forcing file', &
+                     &         'NF90_GET_VAR failed.','stop')
+             ENDIF
+             IF ( .NOT. zsamelev_uv ) THEN
+                ireta = NF90_GET_VAR(force_id, hybsigb_uv_id, zhybriduv_b)
+                iretb = NF90_GET_VAR(force_id, hybsiga_uv_id, zhybriduv_a)
+                IF ( ireta /= NF90_NOERR .OR. iretb /= NF90_NOERR) THEN
+                   CALL ipslerr ( 3, 'forcing_vertical',&
+                        &        'Attempted to read variable HybSigA_uv and HybSigB_uv from forcing file', &
+                        &        'NF90_GET_VAR failed.','stop')
+                ENDIF
+             ENDIF
+          ENDIF
+          WRITE(*,*) "forcing_vertical : case Pressure coordinates : "
+          WRITE(*,*) "Read from forcing file :", zhybrid_b, zhybrid_a, zhybriduv_b, zhybriduv_a
+       ELSE
+          !
+          ! Why are we here ???
+          !
+          CALL ipslerr ( 3, 'forcing_vertical','What is the option used to describe the height of', &
+               &         'the atmospheric forcing ?','Please check your forcing file.')
+       ENDIF
+    ENDIF
+    !
+    !- We have no forcing file to explore or we did not find anything. So revert back to the run.def and
+    !- read what has been specified by the user.
+    !
+    IF ( force_id < 0 .OR. .NOT. foundvar ) THEN
+       !
+       !-
+       !Config  Key  = HEIGHT_LEV1
+       !Config  Desc = Height at which T and Q are given
+       !Config  Def  = 2.0
+       !Config  Help = The atmospheric variables (temperature and specific
+       !Config         humidity) are measured at a specific level.
+       !Config         The height of this level is needed to compute
+       !Config         correctly the turbulent transfer coefficients.
+       !Config         Look at the description of the forcing
+       !Config         DATA for the correct value.
+       !-
+       zlev_fixed = 2.0
+       CALL getin('HEIGHT_LEV1', zlev_fixed)
+       !-
+       !Config  Key  = HEIGHT_LEVW
+       !Config  Desc = Height at which the wind is given
+       !Config  Def  = 10.0
+       !Config  Help = The height at which wind is needed to compute
+       !Config         correctly the turbulent transfer coefficients.
+       !-
+       zlevuv_fixed = 10.0
+       CALL getin('HEIGHT_LEVW', zlevuv_fixed)
+
+       zheight = .TRUE.
+
+       IF ( ABS(zlevuv_fixed-zlev_fixed) > EPSILON(zlev_fixed)) THEN
+          zsamelev_uv = .FALSE.
+       ELSE
+          zsamelev_uv = .TRUE.
+       ENDIF
+
+       CALL ipslerr ( 2, 'forcing_vertical','The height of the atmospheric forcing variables', &
+            &         'was not found in the netCDF file.','Thus the values in run.def were used ... or their defaults.')
+    ENDIF
+
+  END SUBROUTINE forcing_vertical
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_givegrid
+!!
+!>\BRIEF      Routine which exports the grid (longitude, latitude, land indices) on which the model will run, i.e. the zoomed grid.
+!!
+!! DESCRIPTION:	This is needed to transfer the grid information from this module to the glogrid.f90 module.  
+!!
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_givegrid (lon, lat, mask, area, corners, lindex, contfrac, calendar_tmp)
+    !
+    ! This subroutine will return to the caller the grid which has been extracted from the
+    ! the forcing file. It is assumed that the caller has called forcing_givegridsize before
+    ! and knows the dimensions of the fields and thus has done the correct allocations.
+    !
+    !
+    REAL(r_std), INTENT(out) :: lon(iim_loc,jjm_loc), lat(iim_loc,jjm_loc)
+    REAL(r_std), INTENT(out) :: mask(iim_loc,jjm_loc)
+    REAL(r_std), INTENT(out) :: area(iim_loc,jjm_loc)
+    REAL(r_std), INTENT(out) :: corners(iim_loc,jjm_loc,4,2)
+    INTEGER(i_std), INTENT(out) :: lindex(nbland_loc)
+    REAL(r_std), INTENT(out) :: contfrac(nbland_loc)
+    CHARACTER(LEN=20), INTENT(out) :: calendar_tmp
+    !
+    IF ( .NOT. is_root_prc ) THEN
+       CALL ipslerr (3,'forcing_givegrid'," This routine can only be called on the root processor.", &
+            &          "The information requested is only available on root processor.", " ")
+    ENDIF
+    !
+    lon(:,:) = lon_loc(:,:)
+    lat(:,:) = lat_loc(:,:)
+    !
+    mask(:,:) = mask_loc(:,:)
+    area(:,:) = area_loc(:,:)
+    corners(:,:,:,:) = corners_loc(:,:,:,:)
+    !
+    !
+    lindex(:) = lindex_loc(:)
+    contfrac(:) = contfrac_loc(:)
+    !
+    calendar_tmp = calendar
+    !
+  END SUBROUTINE forcing_givegrid
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_checkdim
+!!
+!>\BRIEF      
+!!
+!! DESCRIPTION:	Save the dimension or check that it is equal to the previous value.
+!!              Should one of the spatial dimensions be different between 2 files, then we have a big problem.
+!!              They probably do not belong to the same set of forcing files.  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+SUBROUTINE forcing_checkdim(ifile, filenames, out_dim, out_id, in_dim, in_id)
+  !
+  ! Save the dimension or check that it is equal to the previous value.
+  ! Should one of the spatial dimensions be different between 2 files, then we have a big problem.
+  ! They probably do not belong to the same set of forcing files.
+  !
+  INTEGER(i_std), INTENT(in) :: ifile
+  CHARACTER(LEN=*), INTENT(in) :: filenames(:)
+  INTEGER(i_std), INTENT(out) :: out_dim, out_id
+  INTEGER(i_std), INTENT(in) :: in_dim, in_id
+  !
+  IF ( ifile == 1 ) THEN
+     out_dim = in_dim
+     out_id = in_id
+  ELSE
+     IF ( out_dim /= in_dim ) THEN
+        CALL ipslerr (3,'forcing_ocheckdim', 'The dimension of the file is not the same of the first file opened.', &
+             &        'The offending file is : ', filenames(ifile))
+     ENDIF
+  ENDIF
+  !
+END SUBROUTINE forcing_checkdim
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_time
+!!
+!>\BRIEF Read the time from each file and create the time axis to be the basis for the simulation.     
+!!
+!! DESCRIPTION:	This is an important routine which analyses the time axis of the forcing files and
+!!              stores the main information in the SAVED variables of this routine. 
+!!              As this module manages a list of forcing files we also need to check that the time
+!!              axis of all these files is continuous and homogeneous.
+!!              The bounds are also build for all the time axes so that we know how to interpret the
+!!              various variables. 
+!!
+!! \n
+!_ ==============================================================================================================================
+
+SUBROUTINE forcing_time(nbfiles, filenames)
+  !
+  ! Read the time from each file and create the time axis to be the basis
+  ! for the simulation.
+  !
+  INTEGER(i_std) :: nbfiles
+  CHARACTER(LEN=*) :: filenames(nbfiles)
+  !
+  INTEGER(i_std) :: iv, it, iff, tcnt, itbase, itbasetmp, ittmp
+  INTEGER(i_std) :: tstart, maxtime_infile
+  REAL(r_std), ALLOCATABLE, DIMENSION(:) :: timeint, time_read
+  REAL(r_std), ALLOCATABLE, DIMENSION(:)   :: time_infiles
+  CHARACTER(LEN=20) :: axname, calendar, timevarname
+  CHARACTER(LEN=60) :: timestamp, tmpatt
+  INTEGER(i_std) :: tncstart(3), tnccount(3)
+  !
+  INTEGER(i_std) :: iret, year0, month0, day0, hours0, minutes0, seci
+  INTEGER(i_std), DIMENSION(1) :: imax, imin
+  REAL(r_std) :: sec0, date_int, date0_tmp
+  CHARACTER :: strc
+  LOGICAL :: check=.FALSE.
+  !
+  ! Check that we are working on the root proc.
+  !
+  IF ( .NOT. is_root_prc) THEN
+     CALL ipslerr (3,'forcing_time',"Cannot run this routine o other procs than root.",&
+          &        "All the information on the forcing files is only lated on the root processor."," ")
+  ENDIF
+  !
+  ! Size of unlimited dimension added up through the files. If variable not allocated before by another
+  ! subroutine, it needs to be done here.
+  !
+  IF ( .NOT. ALLOCATED(nbtime_perfile) ) ALLOCATE(nbtime_perfile(nbfiles))
+  IF ( .NOT. ALLOCATED(date0_file) ) ALLOCATE(date0_file(nbfiles,nbtax))
+  !
+  ! Go through all files in the list in order to get the total number of time steps we have
+  ! in the nbfiles files to be read
+  !
+  nb_forcing_steps = 0
+  maxtime_infile = 0
+  DO iff=1,nbfiles
+     !
+     iret = NF90_INQUIRE_DIMENSION(force_id(iff), id_unlim(iff), name=axname, len=nbtime_perfile(iff))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'forcing_time',"Could not get size of dimension of unlimited axis"," "," ")
+     ENDIF
+     nb_forcing_steps =  nb_forcing_steps + nbtime_perfile(iff)
+     IF ( nbtime_perfile(iff) > maxtime_infile ) maxtime_infile = nbtime_perfile(iff)
+  ENDDO
+  !
+  ! Allocate the variables needed with the time length just calculated.
+  ! These variables are saved in the module
+  !
+  ALLOCATE(time_infiles(nb_forcing_steps))
+  ALLOCATE(time(nb_forcing_steps, nbtax*nbtmethods), time_bounds(nb_forcing_steps,nbtax*nbtmethods,2))
+  ALLOCATE(time_axename(nbtax*nbtmethods), time_cellmethod(nbtax*nbtmethods))
+  ALLOCATE(preciptime(nb_forcing_steps))
+  ALLOCATE(time_sourcefile(nb_forcing_steps))
+  ALLOCATE(time_id(nb_forcing_steps, nbtax))
+  ! Allocate local variables
+  ALLOCATE(time_read(nb_forcing_steps))
+  ALLOCATE(timeint(nb_forcing_steps))
+  !
+  ! Get through all variables to find time_id
+  ! The key variables to filled up here are time (the time stamps read in the file) and
+  ! time_bounds which give the validity interval for the variables.
+  !
+  tstart=0
+  !
+  IF ( check ) WRITE(*,*) "forcing_time : going through ", nbfiles, " files to get the time."
+  !
+  DO iff=1,nbfiles
+     !
+     time_id(iff,:)=-1
+     !
+     ! Go through the variables in the file and find the one which is a time axis.
+     !
+     tcnt=1
+     DO iv=1,nvars(iff)
+        iret = NF90_GET_ATT(force_id(iff), iv, "units", tmpatt)
+        IF ( INDEX(lowercase(tmpatt),'seconds since') > 0) THEN
+           time_id(iff,tcnt)=iv
+           tcnt=tcnt+1
+           convtosec(iff)=1.0
+        ELSE IF ( INDEX(lowercase(tmpatt),'minutes since') > 0) THEN
+           time_id(iff,tcnt)=iv
+           tcnt=tcnt+1
+           convtosec(iff)=60.0
+        ELSE IF ( INDEX(lowercase(tmpatt),'hours since') > 0) THEN
+           time_id(iff,tcnt)=iv
+           tcnt=tcnt+1
+           convtosec(iff)=3600.0
+        ENDIF
+     ENDDO
+     IF ( ANY(time_id(iff,:) < 0) ) THEN
+        CALL ipslerr (3,'forcing_time',"Incorrect numer of time axes. A time axis is missing ",&
+             &        "in file :", filenames(iff))
+     ENDIF
+     !
+     IF ( check ) WRITE(*,*) "forcing_time : Looking at time axis for file ", force_id(iff)
+     !
+     ! Looping through the time axes and read them.
+     !
+     DO tcnt=1,nbtax
+        !
+        iret = NF90_INQUIRE_VARIABLE(force_id(iff), time_id(iff,tcnt), name=timevarname)
+        IF ( check ) WRITE(*,*) "forcing_time : in ", iff, " found variable ", timevarname
+        !
+        ! Get units of time axis
+        !
+        iret = NF90_GET_ATT(force_id(iff), time_id(iff,tcnt), "units", timestamp) 
+        IF ( check ) WRITE(*,*) "forcing_time : has time stamp ", timestamp
+        !
+        ! Transform the start date of the netCDF file into a julian date for the model
+        !
+        timestamp = TRIM(timestamp(INDEX(timestamp,'since')+6:LEN_TRIM(timestamp)))
+        !
+        ! Temporary fix. We need a more general method to find the right format for reading
+        ! the elements of the start date.
+        IF (  LEN_TRIM(timestamp) == 14 ) THEN
+           READ (timestamp,'(I4.4,5(a,I1))') &
+                year0, strc, month0, strc, day0, &
+                strc, hours0, strc, minutes0, strc, seci
+        ELSE
+           READ (timestamp,'(I4.4,5(a,I2.2))') &
+                year0, strc, month0, strc, day0, &
+                strc, hours0, strc, minutes0, strc, seci
+        ENDIF
+        sec0 = hours0*3600. + minutes0*60. + seci
+        CALL ymds2ju (year0, month0, day0, sec0, date0_tmp)
+        date0_file(iff,tcnt) = date0_tmp
+        !
+        ! Now get the actual dates
+        !
+        tncstart(1) = 1
+        tnccount(1) = nbtime_perfile(iff)
+        IF ( check ) WRITE(*,*) "forcing_time : number of values read : ", tnccount(1)
+        iret = NF90_GET_VAR(force_id(iff), time_id(iff,tcnt), time_read, tncstart, tnccount)
+        IF (iret /= NF90_NOERR) THEN
+           CALL ipslerr (3,'forcing_time',"An error occured while reading time from the file."," "," ")
+        ENDIF
+        !
+        ! Convert the variable time from seconds since to julian days
+        !
+        DO it=1,nbtime_perfile(iff)
+           time_infiles(tstart+it) = date0_file(iff,tcnt) + time_read(it)*convtosec(iff)/one_day
+        ENDDO
+        if ( check ) WRITE(*,*) "File ", iff, "goes from ",  time_infiles(tstart+1), " to ", &
+             time_infiles(tstart+nbtime_perfile(iff))
+        !
+        ! Estimate the bounds as this information is not yet in the forcing file.
+        !
+        date_int = (time_infiles(tstart+nbtime_perfile(iff)) - time_infiles(tstart+1))/(nbtime_perfile(iff)-1)
+        forcing_tstep_ave = date_int*one_day
+        !
+        ! If this is the first file then simply keep the name of the time axis. Else search the same name 
+        ! in what has already been read
+        !
+        IF ( iff == 1 ) THEN
+           itbase = (tcnt-1)*nbtmethods
+           time_axename(itbase+1:itbase+4) = timevarname
+           time_cellmethod(itbase+1) = "reference"
+           time_cellmethod(itbase+2) = "start"
+           time_cellmethod(itbase+3) = "cent"
+           time_cellmethod(itbase+4) = "end"
+        ELSE
+           !
+           ! If this is not the first file then we need to find the correct axis to add to.
+           ! All information have already been saved with the first file.
+           !
+           DO ittmp=1,nbtax
+              itbasetmp=(ittmp-1)*nbtmethods
+              IF ( time_axename(itbasetmp+1) == timevarname ) THEN
+                 itbase = itbasetmp
+              ENDIF
+           ENDDO
+
+        ENDIF
+        !
+        !
+        ! Keep for future usage the various information on the time axis we have just read. This time axis can
+        ! be understood in 3 different ways and each variable might use a different cell method for this time
+        ! axis.
+        !
+        ! time(:,(tcnt-1)*nbtmethods+1) : corresponds to the reference time axis as it has been read from the file
+        ! time(:,(tcnt-1)*nbtmethods+2) : is the time axis with a cell method which place the value at the 
+        !                                beginning of the time interval
+        ! time(:,(tcnt-1)*nbtmethods+3) : is the time axis corresponding to variables placed at the center of the 
+        !                                time interval
+        ! time(:,(tcnt-1)*nbtmethods+4) : for variables put at the end of the time interval over which they aere 
+        !                                for instance averaged.
+        !
+        ! In variable time_cellmethod we will write the type of cell method as descirbed above so that the selection
+        ! of the right axis for each variable can be made automaticaly.
+        !
+        ! We also keep the name of the time axis read in preparation of file where we might have to read more than one
+        ! time axis.
+        !
+        DO it=tstart+1,tstart+nbtime_perfile(iff)
+           !
+           ! Reference time
+           !
+           time(it,itbase+1) = time_infiles(it)
+           time_bounds(it,itbase+1,1) = time_infiles(it)-date_int/2.0
+           time_bounds(it,itbase+1,2) = time_infiles(it)+date_int/2.0
+           !
+           ! Start cell method
+           time(it,itbase+2) = time_infiles(it)+date_int/2.0
+           time_bounds(it,itbase+2,1) = time_infiles(it)
+           time_bounds(it,itbase+2,2) = time_infiles(it)+date_int
+           !
+           ! Centered cell method
+           time(it,itbase+3) = time_infiles(it)
+           time_bounds(it,itbase+3,1) = time_infiles(it)+date_int/2.0
+           time_bounds(it,itbase+3,2) = time_infiles(it)+date_int/2.0
+           !
+           ! End cell method
+           time(it,itbase+4) = time_infiles(it)-date_int/2.0
+           time_bounds(it,itbase+4,1) = time_infiles(it)-date_int
+           time_bounds(it,itbase+4,2) = time_infiles(it)
+           !
+        ENDDO
+        !
+        ! Keep the number of the file from which we read this time.
+        !
+        time_sourcefile(tstart+1:tstart+nbtime_perfile(iff))=iff
+        !
+        IF ( check ) WRITE(*,*) "forcing_time : finished file ", iff
+        !
+     ENDDO
+     !
+     ! Before moving to the next file advance the pointer in the time arrays.
+     !
+     tstart=tstart+nbtime_perfile(iff)
+     !
+  ENDDO
+  !
+  IF ( check ) WRITE(*,*) "forcing_time : All files have been processed"
+  !
+  ! Verify that the forcing comes in regular time intervals. If not, many of the 
+  ! interpolation schemes will fail.
+  ! This is only done on the first time axis ... is it enough ?
+  !
+  DO ittmp=1,nbtax
+     itbase=(ittmp-1)*nbtmethods
+     !
+     date_int = (time(nb_forcing_steps,itbase+1) - time(1,itbase+1))/(nb_forcing_steps-1)
+     forcing_tstep_ave = date_int*one_day
+     !
+     timeint(:) = 0
+     DO it=1, nb_forcing_steps-1
+        timeint(it) = time(it+1,itbase+1)-time(it,itbase+1)
+     ENDDO
+     !
+     IF (  MAXVAL(timeint(1:nb_forcing_steps-1)) > date_int+0.1*date_int .OR.&
+          & MINVAL(timeint(1:nb_forcing_steps-1)) < date_int-0.1*date_int) THEN
+        WRITE(*,*) "The time steping of the forcing files does not seem to be regular on axis",time_axename(itbase+1),":"
+        WRITE(*,*) "Average time step : ", date_int, "days = ", date_int*one_day, "sec."
+        imax = MAXLOC(timeint(1:nb_forcing_steps-1))
+        imin = MINLOC(timeint(1:nb_forcing_steps-1))
+        WRITE(*,*) "Maximum time step : ", MAXVAL(timeint(1:nb_forcing_steps-1)), " at ", imax(1)
+        WRITE(*,*) "Minimum time step : ", MINVAL(timeint(1:nb_forcing_steps-1)), " at ", imin(1)
+        WRITE(*,*) "++++ Values around Maximum"
+        DO it=MAX(imax(1)-5,1),MIN(imax(1)+5,nb_forcing_steps)
+           WRITE(*,*) it, " from file ", time_sourcefile(it), " Value ", time(it,itbase+1)
+           CALL forcing_printdate(time(it,itbase+1), "Time values.")
+        ENDDO
+        WRITE(*,*) "++++ Values around Minimum"
+        DO it=MAX(imin(1)-5,1),MIN(imin(1)+5,nb_forcing_steps)
+           WRITE(*,*) it, " from file ", time_sourcefile(it), " Value ", time(it,itbase+1)
+           CALL forcing_printdate(time(it,itbase+1), "Time values.")
+        ENDDO
+        CALL ipslerr (3,'forcing_time', 'The time handling could be improved to allow the driver',&
+             & "to cope with irregular forcing files."," ")
+     ENDIF
+  ENDDO
+  !
+  ! Print some test values
+  !
+  DO ittmp=1,nbtax
+     itbase=(ittmp-1)*nbtmethods
+     !
+     WRITE(*,*) "Bounds for axis ",time_axename(itbase+1)," :"
+     !
+     CALL forcing_printdate(time_bounds(1,itbase+1,1), "Start time of first forcing interval.")
+     CALL forcing_printdate(time_bounds(1,itbase+1,2), "End time of first forcing interval.")
+     CALL forcing_printdate(time_bounds(nb_forcing_steps,itbase+1,1), "Start time of last forcing interval.")
+     CALL forcing_printdate(time_bounds(nb_forcing_steps,itbase+1,2), "End time of last forcing interval.")
+  ENDDO
+  !
+  ! Set to zero the variable for the cummulated time for rainfall
+  !
+  preciptime(:) = zero
+  !
+  ! Keep the very first date of the time axis for future use
+  ! 
+  forcingstartdate = time(1,1)
+  !
+  ! Clean-up
+  !
+  DEALLOCATE(timeint, time_read)
+  !
+END SUBROUTINE forcing_time
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_varforslab
+!!
+!>\BRIEF      
+!!
+!! DESCRIPTION:	This subroutine will read the named variable and put it in the right place in the 
+!!              slab of data kept in the memory of the driver. 
+!!
+!! \n
+!_ ==============================================================================================================================
+
+SUBROUTINE forcing_varforslab(fileindex, varname, timestart, timecount, inslabpos, data, cellmethod)
+  !
+  ! This subroutine will read the named variable and put it in the right place in the 
+  ! slab of data kept in the memory of the driver.
+  !
+  INTEGER(i_std), INTENT(in) :: fileindex
+  CHARACTER(LEN=*), INTENT(in) :: varname
+  INTEGER(i_std), INTENT(in) :: timestart, timecount, inslabpos
+  REAL(r_std), INTENT(inout) :: data(nbland_loc,slab_size)
+  CHARACTER(LEN=*), INTENT(out) :: cellmethod
+  !
+  ! Local variables
+  !
+  INTEGER(i_std) :: varid, windid, windndims, it, ig, iv
+  INTEGER(i_std) :: iret, ndims
+  INTEGER(i_std), DIMENSION(4) :: start, count
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: tmp_slab
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: tmp_slab2d
+  CHARACTER(LEN=80) :: name
+  LOGICAL :: windzero
+  !
+  ! Allocate the temporary data array if not already available
+  !
+  IF ( compressed ) THEN
+     IF ( .NOT. ALLOCATED(tmp_slab) ) ALLOCATE(tmp_slab(ncdfcount,slab_size))
+  ELSE
+     IF ( .NOT. ALLOCATED(tmp_slab2d) ) ALLOCATE(tmp_slab2d(iim_glo,jjm_glo,slab_size))
+  ENDIF
+  !
+  ! Reset the counters and flags to forget the past !
+  !
+  varid=-1
+  windid=-1
+  windzero=.FALSE.
+  !
+  ! Find the variable in the file
+  !
+  DO iv=1,nvars(fileindex)
+     !
+     iret = NF90_INQUIRE_VARIABLE(force_id(fileindex), iv, name=name, ndims=it)
+     !
+     IF ( INDEX(name, varname) > 0 ) THEN
+        varid = iv
+        ndims = it
+     ENDIF
+     IF ( (INDEX(name, "Wind") > 0) .AND. (LEN_TRIM(name) == LEN_TRIM("Wind")) ) THEN
+        windid = iv
+        windndims = it
+     ENDIF
+     !
+  ENDDO
+  !
+  ! Treat some special cases and catch errors
+  !
+  IF ( varid < 0 ) THEN
+     !
+     ! If we requested a wind component but did not find it, it could be that only the module is available.
+     ! If that is the case, then we use the module (windid) for the U component and set V top zero.
+     !
+     IF ( INDEX(varname, "Wind_E") > 0 ) THEN
+        varid = windid
+        ndims = windndims
+        windzero = .FALSE.
+     ELSE IF ( INDEX(varname, "Wind_N") > 0 ) THEN
+        windzero = .TRUE.
+     ELSE
+        CALL ipslerr (3,'forcing_varforslab',"Could not find variable",varname," in file.")
+     ENDIF
+  ENDIF
+  !
+  ! If there is some variable to be read then do it
+  !
+  IF ( .NOT. windzero ) THEN
+     !
+     ! Get the attributes needed for intepretating the data
+     !
+     ! First get the cell method used for this variable
+     iret = NF90_GET_ATT(force_id(fileindex), varid, 'cell_methods', cellmethod)
+     IF (iret /= NF90_NOERR) THEN
+        ! If the attribute is not found then we set a reasonable default : instantaneous and centered.
+        cellmethod="time: instantaneous"
+     ENDIF
+     !
+     !
+     ! Getsize of data to be read from the netCDF file
+     !
+     !
+     IF ( compressed ) THEN
+        !
+        IF ( ndims == 2 ) THEN
+           start = (/ncdfstart,timestart,0,0/)
+           count = (/ncdfcount,timecount,0,0/)
+        ELSE IF ( ndims == 3 ) THEN
+           start = (/ncdfstart,1,timestart,0/)
+           count = (/ncdfcount,1,timecount,0/)
+        ELSE
+           CALL ipslerr (3,'forcing_varforslab',"Compressed variable : ",varname,&
+                &        " does not have a compatible number of dimensions.")
+        ENDIF
+        !
+        iret = NF90_GET_VAR(force_id(fileindex), varid, tmp_slab, start, count)
+        IF (iret /= NF90_NOERR) THEN
+           CALL ipslerr (3,'forcing_varforslab',"Could not read from file variable : ",varname," Compressed in the file.")
+        ENDIF
+        !
+        ! Zoom into the data and put it in the right place in the slab of data.
+        !
+        CALL forcing_reindex(ncdfcount, timecount, tmp_slab, nbland_loc, slab_size, data, inslabpos, reindex_loc)
+     ELSE
+        !
+        IF ( ndims == 3 ) THEN
+           start = (/1,1,timestart,0/)
+           count = (/iim_glo,jjm_glo,timecount,0/)
+        ELSE IF (ndims == 4 ) THEN
+           start = (/1,1,1,timestart/)
+           count = (/iim_glo,jjm_glo,1,timecount/)
+        ELSE
+           CALL ipslerr (3,'forcing_varforslab',"Full lat Lon variable : ",varname,&
+                &        " does not have a compatible number of dimensions.")
+        ENDIF
+        !
+        iret = NF90_GET_VAR(force_id(fileindex), varid, tmp_slab2d, start, count)
+        IF (iret /= NF90_NOERR) THEN
+           WRITE(*,*) TRIM(NF90_STRERROR(iret))
+           WRITE(*,*) "File =", fileindex, "Size =", SIZE(tmp_slab2d,DIM=1), SIZE(tmp_slab2d,DIM=2), SIZE(tmp_slab2d,DIM=3)
+           WRITE(*,*) "Start :", start(1:3)
+           WRITE(*,*) "Count :", count(1:3)
+           CALL ipslerr (3,'forcing_varforslab',"Could not read from file variable : ",varname," Not compressed.")
+        ENDIF
+        !
+        ! Zoom into the data and put it in the right place in the slab of data.
+        !
+        CALL forcing_reindex(iim_glo, jjm_glo, timecount, tmp_slab2d, nbland_loc, slab_size, data, inslabpos, reindex2d_loc)
+     ENDIF
+  ELSE
+     cellmethod="time: instantaneous"
+     DO it=0,timecount-1
+        data(:,inslabpos+it) = zero
+     ENDDO
+  ENDIF
+  !
+END SUBROUTINE forcing_varforslab
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_attributetimeaxe
+!!
+!>\BRIEF  Find the time axis which corresponds to the variable at hand.    
+!!
+!! DESCRIPTION:	 We interpret the cell_method provided in the netCDF file so that
+!!               we can determine how we need to understand the values we read.
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_attributetimeaxe(cellmethod, timeindex)
+  !
+  ! We will analyse the time axis of the cell method found in the NetCDF file in order to
+  ! attribute the correct time axis to this variable. 
+  !
+  CHARACTER(LEN=*), INTENT(in) :: cellmethod
+  INTEGER(i_std), INTENT(out)  :: timeindex
+  !
+  INTEGER(i_std) :: itax, timepos, pos, lentime, itbase, im
+  CHARACTER(LEN=20) :: TARGET, tmpstr
+  CHARACTER(LEN=80) :: method
+  !
+  ! Clean the string to delete spaces in front of ":" and "("
+  !
+  method = cellmethod
+  DO WHILE ( INDEX(method," :") > 0 )
+     pos = INDEX(method," :")
+     method = method(1:pos-1)//method(pos+1:LEN_TRIM(method))
+  ENDDO
+  DO WHILE ( INDEX(method,"( ") > 0 )
+     pos = INDEX(method,"( ")
+     method = method(1:pos)//method(pos+2:LEN_TRIM(method))
+  ENDDO
+  !
+  ! Go through all the time axes we have to find the right one.
+  !
+  timeindex=0
+  DO itax=1,nbtax
+     !
+     itbase=(itax-1)*nbtmethods
+     ! find the time axis name in the cell method
+     TARGET = TRIM(time_axename(itbase+1))//":"
+     timepos = INDEX(method,TRIM(TARGET))
+     !
+     ! If we found the time axis then we look for the method with a time position description
+     ! which is expected to be between parenthesis. For instance : mean(end)
+     !
+     IF ( timepos > 0 ) THEN
+        !
+        lentime=LEN_TRIM(time_axename(itbase+1))
+        tmpstr = method(lentime+2:LEN_TRIM(method))
+        !
+        ! If there is ":" then there is information for another axis which needs to be deleted
+        !
+        IF ( INDEX(tmpstr,":") > 0 ) THEN
+           tmpstr = tmpstr(1:INDEX(tmpstr,":")-1)
+        ENDIF
+        !
+        ! Now that we have found a time axis see if we have between parenthesis a position
+        ! on that time avis.
+        !
+        ! Look for a "("  
+        IF ( INDEX(tmpstr, "(") > 0 ) THEN
+           DO im=1,nbtmethods
+              TARGET = "("//TRIM(time_cellmethod(itbase+im))
+              timepos = INDEX(tmpstr,TRIM(TARGET))
+              IF ( timepos > 0 ) THEN
+                 timeindex = itbase+im
+              ENDIF
+           ENDDO
+           !
+           ! If there is no "(" then we have to find the centered axis.
+        ELSE 
+           DO im=1,nbtmethods
+              IF ( INDEX(time_cellmethod(itbase+im), "cent") > 0 ) THEN
+                 timeindex = itbase+im
+              ENDIF
+           ENDDO
+        ENDIF
+        !
+        ! The name of the time axis was found bu no method could be identified
+        !
+        IF ( timeindex < 1 ) THEN
+           CALL ipslerr (3,'forcing_attributetimeaxe',"Found a time axis name but could not identify method.", &
+                "This should not happen !"," ")
+        ENDIF
+        !
+     ELSE
+        ! Continue in loop over nbtax
+     ENDIF
+  ENDDO
+  !
+  ! Should no corresponding time axis name be found, 
+  ! then we use the first centered one.
+  !
+  itax=1
+  DO WHILE ( timeindex < 1 ) 
+     IF ( INDEX(time_cellmethod(itax), "cent") > 0 ) THEN
+        timeindex = itax
+     ELSE
+        itax = itax + 1
+     ENDIF
+  ENDDO
+  !
+END SUBROUTINE forcing_attributetimeaxe
+
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_filenamecheck
+!!
+!>\BRIEF   Check the list of files obtained from the calling program.   
+!!
+!! DESCRIPTION:	A small code to check the forcing files. They have to be NetCDF (i.e. .nc termination) and 
+!!              we dont keep files that appear more than once in the list.  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+SUBROUTINE forcing_filenamecheck(filenames_in, nb_files)
+  !
+  ! A small code to check the forcing files. They have to
+  ! be NetCDF (i.e. .nc termination) and we dont keep files 
+  ! that appear more than once in the list.
+  !
+  !
+  ! INPUT
+  !
+  CHARACTER(LEN=*), DIMENSION(:), INTENT(in) :: filenames_in
+  INTEGER(i_std), INTENT(out)                :: nb_files
+  !
+  ! LOCAL
+  !
+  INTEGER(i_std) :: ii, is, sizein
+  LOGICAL        :: notfound
+  !
+  sizein = SIZE(filenames_in)
+  IF ( sizein > 0 ) THEN
+     IF ( ALLOCATED(forfilename) ) THEN
+        DEALLOCATE(forfilename)
+     ENDIF
+     ALLOCATE(forfilename(sizein))
+     nb_files=0
+  ELSE
+     CALL ipslerr (3,'forcing_filenamecheck',"List of forcing files is empty.","Please check your run.def file."," ")
+  ENDIF
+  !
+  DO ii=1,sizein
+     IF ( INDEX(filenames_in(ii), '.nc') > 0 ) THEN
+        IF ( nb_files == 0 ) THEN
+           nb_files = nb_files+1
+           forfilename(nb_files)=TRIM(ADJUSTL(filenames_in(ii)))
+        ELSE
+           notfound=.TRUE.
+           DO is=1,nb_files
+              IF ( INDEX(TRIM(filenames_in(ii)), TRIM(ADJUSTL(forfilename(is)))) > 0 ) notfound=.FALSE.
+           ENDDO
+           IF ( notfound ) THEN
+              nb_files = nb_files+1
+              forfilename(nb_files)=TRIM(adjustl(filenames_in(ii)))
+           ENDIF
+        ENDIF
+     ELSE
+        !!! This is not a NetCDF file, so we ignore it
+     ENDIF
+  ENDDO
+  !
+  !
+END SUBROUTINE forcing_filenamecheck
+
+!!  =============================================================================================================================
+!! FUNCTION: lowercase, FindMinimum, Swap 
+!!
+!>\BRIEF      Help functions for the forcing_tools module.
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+FUNCTION lowercase(strIn) RESULT(strOut)
+! Adapted from http://www.star.le.ac.uk/~cgp/fortran.html (25 May 2012)
+
+     IMPLICIT NONE
+
+     CHARACTER(len=*), INTENT(in) :: strIn
+     CHARACTER(len=LEN(strIn)) :: strOut
+     INTEGER :: i,j
+
+     DO i = 1, LEN(strIn)
+          j = IACHAR(strIn(i:i))
+          IF (j>= IACHAR("A") .AND. j<=IACHAR("Z") ) THEN
+               strOut(i:i) = ACHAR(IACHAR(strIn(i:i))+32)
+          ELSE
+               strOut(i:i) = strIn(i:i)
+          END IF
+     END DO
+
+END FUNCTION lowercase
+!
+! Some help function found on Internet : http://www.cs.mtu.edu/~shene/COURSES/cs201/NOTES/chap08/sorting.f90
+!
+! --------------------------------------------------------------------
+! INTEGER FUNCTION  FindMinimum():
+!    This function returns the location of the minimum in the section
+! between Start and End.
+! --------------------------------------------------------------------
+INTEGER FUNCTION  FindMinimum(x, Start, END)
+  IMPLICIT  NONE
+  REAL(r_std), DIMENSION(1:), INTENT(IN) :: x
+  INTEGER(i_std), INTENT(IN)             :: Start, END
+  REAL(r_std)                            :: Minimum
+  INTEGER(i_std)                         :: Location
+  INTEGER(i_std)                         :: i
+
+  Minimum  = x(Start)		! assume the first is the min
+  Location = Start			! record its position
+  DO i = Start+1, END		! start with next elements
+     IF (x(i) < Minimum) THEN	!   if x(i) less than the min?
+        Minimum  = x(i)		!      Yes, a new minimum found
+        Location = i            !      record its position
+     ENDIF
+  END DO
+  FindMinimum = Location        	! return the position
+END FUNCTION  FindMinimum
+! --------------------------------------------------------------------
+! SUBROUTINE  Swap():
+!    This subroutine swaps the values of its two formal arguments.
+! --------------------------------------------------------------------
+SUBROUTINE  Swap(a, b)
+  IMPLICIT  NONE
+  REAL(r_std), INTENT(INOUT) :: a, b
+  REAL(r_std)                :: Temp
+
+  Temp = a
+  a    = b
+  b    = Temp
+END SUBROUTINE  Swap
+! --------------------------------------------------------------------
+! SUBROUTINE  Sort():
+!    This subroutine receives an array x() and sorts it into ascending
+! order.
+! --------------------------------------------------------------------
+SUBROUTINE  Sort(x, Size)
+  IMPLICIT  NONE
+  REAL(r_std), DIMENSION(1:), INTENT(INOUT) :: x
+  INTEGER(i_std), INTENT(IN)                :: Size
+  INTEGER(i_std)                            :: i
+  INTEGER(i_std)                            :: Location
+
+  DO i = 1, Size-1			! except for the last
+     Location = FindMinimum(x, i, Size)	! find min from this to last
+     CALL  Swap(x(i), x(Location))	! swap this and the minimum
+  END DO
+END SUBROUTINE  Sort
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : forcing_tools_clear
+!!
+!>\BRIEF          Clear forcing_tools module
+!!
+!! DESCRIPTION  : Deallocate memory and reset initialization variables to there original values
+!!
+!_ ================================================================================================================================
+
+SUBROUTINE forcing_tools_clear
+
+  first_call_readslab = .TRUE.
+  first_call_solarint = .TRUE.
+  first_call_spreadprec = .TRUE.
+
+END SUBROUTINE forcing_tools_clear
+
+
+END MODULE forcing_tools
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/getlandseamask.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/getlandseamask.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/getlandseamask.f90	(revision 6412)
@@ -0,0 +1,1089 @@
+MODULE getlandseamask
+  !
+  !================================================================================================================================
+  !! MODULE   : getlandseamask
+  !!
+  !> BRIEF      This module contains a few methods in order to build a land surface mask which can serve
+  !!            to test the routing and its ability to build a river network.
+  !!
+  !! DESCRIPTION  : None
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! MAIN OUTPUT VARIABLE(S):
+  !!
+  !! REFERENCES   : None
+  !!
+  !! FLOWCHART    : This module has 2 possible modes for building the land/sea mask :
+  !!                TOPOFILE : This configuration option contains a file name of the orography file
+  !!                           which will be used in order to build the land/sea mask.
+  !!                IIM_LON, JJM_lon : the number of points the grid should have in longitude and
+  !!                                   latitude. This is only used when we build the mask based on orography.
+  !!                                   Should these parameters not be provided, then the gird of the orography
+  !!                                   file is used.
+  !!                CONTFRACFILE :: File name in which we will find variable "Contfrac". This land/sea mask will be 
+  !!                                used with the associated lat/lon grid.
+  !!                WEST_EAST,  SOUTH_NORTH : The zoom to be performed on the grid so as to retain only this window
+  !!                                          of the land-sea mask.
+  !! \n
+  !_================================================================================================================================
+
+  USE ioipsl_para
+  USE mod_orchidee_para
+  USE control
+  USE constantes_soil_var
+  USE constantes_var
+  USE constantes
+
+  USE netcdf
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: getlandseamask_init, getlandseamask_read
+
+  INTEGER(i_std), SAVE                           :: iim, jjm, nbland
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: lon, lat
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: contfrac, orog
+
+CONTAINS
+  !================================================================================================================================
+  !! SUBROUTINE   : getlandseamask_init
+  !!
+  !> BRIEF         Builds the land/sea mask and returns its size to the calling program.
+  !!
+  !! DESCRIPTION  : None
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! MAIN OUTPUT VARIABLE(S):
+  !!
+  !! REFERENCES   : None
+  !!
+  !! FLOWCHART    : None
+  !! \n
+  !_================================================================================================================================
+  SUBROUTINE getlandseamask_init(iim_out, jjm_out, nbland_out)
+    !
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(out) :: iim_out, jjm_out, nbland_out
+    !
+    ! LOCAL
+    !
+    CHARACTER(LEN=120)                                  :: filename                !! File name for topography (var: ROSE in "etopo20.nc")
+    CHARACTER(LEN=120)                                  :: contfracfile            !! filename for contfrac
+    INTEGER(i_std)                                      :: iim_full, jjm_full      !! Lon/Lat dimensions for ROSE in etopo20.nc 
+    REAL(r_std), ALLOCATABLE, DIMENSION (:,:)           :: lon_full, lat_full      !! Lon/Lat array for ROSE
+    REAL(r_std), ALLOCATABLE, DIMENSION (:,:)           :: etopo, contfrac_full    !! Array for reading ROSE in etopo20.nc
+    INTEGER(i_std), DIMENSION(1)                        :: ibeg, iend
+    INTEGER(i_std), DIMENSION(1)                        :: jbeg, jend
+    INTEGER(i_std)                                      :: fid, i, j
+    REAL(r_std)                                         :: dx, dy
+    !
+    REAL(r_std), DIMENSION(2)                           :: zoom_lon, zoom_lat               !! For crop region when reading
+    !
+    LOGICAL                                             :: buildcontfrac=.FALSE.
+    !
+    !  Read the full topography which we will use to get the land-see mask for all resolutions.
+    !
+    !Config Key   = TOPOFILE
+    !Config Desc  = File containing high resolution topographic informations
+    !Config If    = 
+    !Config Def   = etopo20.nc
+    !Config Help  = This needs to be a netCDF file.
+    !Config Units = [-] 
+    !- 
+    filename = 'NONE'
+    CALL getin('TOPOFILE', filename)
+    WRITE(*,*) "TOPOFILE = ", filename
+    !
+    !Config Key   = CONTFRACFILE
+    !Config Desc  = File containing a contfrac variable as defined in ORCHIDEE.
+    !Config If    = 
+    !Config Def   = NONE
+    !Config Help  = This needs to be a netCDF file and can be any history file ORCHIDEE
+    !               has produced ina previous simulation.
+    !Config Units = [-] 
+    !- 
+    contfracfile = 'NONE'
+    CALL getin('CONTFRACFILE', contfracfile)
+    WRITE(*,*) "CONTFRACFILE = ", contfracfile
+    !
+    ! Initialize Orchidee parameter and calendar
+    !
+    IF ( INDEX(filename,"NONE") <= 0 ) THEN
+       IF ( is_root_prc) THEN
+          CALL topo_getsize(filename, iim_full, jjm_full)
+          !
+          ALLOCATE(lon_full(iim_full,jjm_full),lat_full(iim_full,jjm_full))
+          ALLOCATE(etopo(iim_full,jjm_full))
+          !
+          CALL topo_getvar(filename, iim_full, jjm_full, lon_full, lat_full, etopo)
+          !
+          WRITE(*,*) MINVAL(lon_full), ' < LON_FULL < ', MAXVAL(lon_full)
+          WRITE(*,*) MINVAL(lat_full), ' < LAT_FULL < ', MAXVAL(lat_full)
+          WRITE(*,*) 'ETOPO :', MINVAL(etopo), MAXVAL(etopo)
+          !
+          buildcontfrac=.TRUE.
+          !
+       ENDIF
+    ELSE IF ( INDEX( contfracfile,"NONE") <= 0 ) THEN
+       IF ( is_root_prc) THEN
+          !
+          ! Read lon, lat and contfrac from a netCDF file generated by ORCHIDEE
+          !
+          CALL opencontfrac(contfracfile, iim_full, jjm_full, fid)
+          !
+          ALLOCATE(lon_full(iim_full,jjm_full), lat_full(iim_full,jjm_full), contfrac_full(iim_full,jjm_full))
+          CALL readcontfrac(fid, contfracfile, iim_full, jjm_full, lon_full, lat_full, contfrac_full)
+          !
+          buildcontfrac=.FALSE.
+          !
+       ENDIF
+    ELSE
+       WRITE(*,*) "Neither a orography nore a contfrac file was provided"
+       WRITE(*,*) "CONTFRACFILE = ", contfracfile
+       write(*,*) "TOPOFILE = ", filename
+    ENDIF
+    !
+    !-
+    !- Define the zoom
+    !-
+    zoom_lon=(/-180,180/)
+    zoom_lat=(/-90,90/)
+    !
+    !Config Key   = LIMIT_WEST
+    !Config Desc  = Western limit of region
+    !Config If    = [-]
+    !Config Def   = -180.
+    !Config Help  = Western limit of the region we are 
+    !Config         interested in. Between -180 and +180 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees] 
+    !- 
+    CALL getin_p('LIMIT_WEST',zoom_lon(1))
+    !-
+    !Config Key   = LIMIT_EAST
+    !Config Desc  = Eastern limit of region
+    !Config If    = [-]
+    !Config Def   = 180.
+    !Config Help  = Eastern limit of the region we are
+    !Config         interested in. Between -180 and +180 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees] 
+    !-
+    CALL getin_p('LIMIT_EAST',zoom_lon(2))
+    !-
+    !Config Key   = LIMIT_NORTH
+    !Config Desc  = Northern limit of region
+    !Config If    = [-]
+    !Config Def   = 90.
+    !Config Help  = Northern limit of the region we are
+    !Config         interested in. Between +90 and -90 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees]
+    !-
+    CALL getin_p('LIMIT_NORTH',zoom_lat(2))
+    !-
+    !Config Key   = LIMIT_SOUTH
+    !Config Desc  = Southern limit of region
+    !Config If    = [-]
+    !Config Def   = -90.
+    !Config Help  = Southern limit of the region we are
+    !Config         interested in. Between 90 and -90 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees]
+    !-
+    CALL getin_p('LIMIT_SOUTH',zoom_lat(1))
+    IF ( (zoom_lon(1)+180 < EPSILON(zoom_lon(1))) .AND. (zoom_lon(2)-180 < EPSILON(zoom_lon(2))) .AND.&
+        &(zoom_lat(1)+90 < EPSILON(zoom_lat(1))) .AND. (zoom_lat(2)-90 < EPSILON(zoom_lat(2))) ) THEN
+       !
+       !Config Key   = WEST_EAST
+       !Config Desc  = Longitude interval to use from the forcing data
+       !Config If    = [-]
+       !Config Def   = -180, 180
+       !Config Help  = This function allows to zoom into the forcing data
+       !Config Units = [degrees east] 
+       !- 
+       CALL getin('WEST_EAST', zoom_lon)
+       !
+       !Config Key   = SOUTH_NORTH
+       !Config Desc  = Latitude interval to use from the forcing data
+       !Config If    = [-]
+       !Config Def   = -90, 90
+       !Config Help  = This function allows to zoom into the forcing data
+       !Config Units = [degrees north] 
+       !- 
+       CALL getin('SOUTH_NORTH', zoom_lat)
+    ENDIF
+    !
+    ! Get the finer coarser grid
+    !
+    !
+    ! We see if the user has specified the resolution, in number of
+    ! points he wishes to use.
+    !
+    IF ( buildcontfrac ) THEN
+       IF ( is_root_prc) THEN
+          iim=-1
+          jjm=-1
+          !Config Key   = IIM_LON
+          !Config Desc  = Number of points in longitude
+          !Config If    = [-]
+          !Config Def   = -1
+          !Config Help  = This allows to select the resolution at which the land/sea mask should be built.
+          !Config Units = - 
+          CALL getin('IIM_LON', iim)
+          !Config Key   = IIM_LAT
+          !Config Desc  = Number of points in latitude
+          !Config If    = [-]
+          !Config Def   = -1
+          !Config Help  = This allows to select the resolution at which the land/sea mask should be built.
+          !Config Units = - 
+          CALL getin('JJM_LAT', jjm)
+          !
+          IF (iim > 0 .AND. jjm > 0 ) THEN
+             !
+             ALLOCATE(lon(iim,jjm), lat(iim,jjm), orog(iim,jjm))
+             ! Trung: Calculate resolution
+             dx = (MAXVAL(zoom_lon)-MINVAL(zoom_lon))/REAL(iim, r_std)
+             dy = (MAXVAL(zoom_lat)-MINVAL(zoom_lat))/REAL(jjm, r_std)
+             WRITE (*,*) "Resolution in longitude [degrees] dx = ",dx
+             WRITE (*,*) "Resolution in laltiude [degrees] dy = ",dy
+             !
+             ! Generate lon and lat
+             !
+             DO i=1,iim
+                lon(i,:) = MINVAL(zoom_lon) + (i-1)*dx + dx/2.0 
+             ENDDO
+             DO j=1,jjm
+                lat(:,j) = MINVAL(zoom_lat) + (j-1)*dy + dy/2.0
+             ENDDO
+             !
+             ! Interpolate to new orography
+             !
+             CALL interpol(iim_full, jjm_full, lon_full, lat_full, etopo, iim, jjm, lon, lat, orog)
+             !
+             ! Write orog to netcdf for checking (deleted)
+             !
+          ELSE
+             ! Just transfer the data over the zoomed area
+             ibeg=MINLOC(ABS(lon_full(:,1)-MINVAL(zoom_lon)))
+             iend=MINLOC(ABS(lon_full(:,1)-MAXVAL(zoom_lon)))
+             jbeg=MINLOC(ABS(lat_full(1,:)-MINVAL(zoom_lat)))
+             jend=MINLOC(ABS(lat_full(1,:)-MAXVAL(zoom_lat)))
+             iim = (iend(1)-ibeg(1))+1
+             jjm = (jend(1)-jbeg(1))+1
+             !
+             !
+             ALLOCATE(lon(iim,jjm), lat(iim,jjm), orog(iim,jjm), contfrac(iim,jjm))
+             !
+             DO j=1,jjm
+                lon(:,j) = lon_full(ibeg(1):iend(1),j)
+             ENDDO
+             DO i=1,iim
+                lat(i,:) = lat_full(i,jbeg(1):jend(1))
+             ENDDO
+             ! Some treatment for the orogography
+             orog(:,:) = 0.0
+             DO i=ibeg(1),iend(1)
+                DO j=jbeg(1),jend(1)
+                   orog(i-ibeg(1)+1,j-jbeg(1)+1) = MAX(etopo(i,j), 0.0)
+                ENDDO
+             ENDDO
+             !
+             ! Generate the contfrac field
+             !
+             contfrac(:,:)= 0.0
+             DO i=1,iim
+                DO j=1,jjm
+                   IF ( orog(i,j) > 0 ) THEN
+                      contfrac(i,j) = 1.0
+                   ENDIF
+                ENDDO
+             ENDDO
+          ENDIF
+          !
+       ENDIF
+       !
+    ELSE
+       !
+       ! Just zoom into the contfrac if needed and build a dummy orog
+       !
+       IF ( is_root_prc) THEN
+          IF ( MINVAL(zoom_lon) > -180 .OR. MAXVAL(zoom_lon) < 180 .OR.&
+               & MINVAL(zoom_lat) > -90 .OR. MAXVAL(zoom_lat) < 90 ) THEN
+             ! Just transfer the data over the zoomed area
+             ibeg=MINLOC(ABS(lon_full(:,1)-MINVAL(zoom_lon)))
+             iend=MINLOC(ABS(lon_full(:,1)-MAXVAL(zoom_lon)))
+             jbeg=MINLOC(ABS(lat_full(1,:)-MINVAL(zoom_lat)))
+             jend=MINLOC(ABS(lat_full(1,:)-MAXVAL(zoom_lat)))
+             iim = (iend(1)-ibeg(1))+1
+             jjm = (jend(1)-jbeg(1))+1
+             !
+             !
+             ALLOCATE(lon(iim,jjm), lat(iim,jjm), orog(iim,jjm), contfrac(iim,jjm))
+             !
+             DO j=1,jjm
+                lon(:,j) = lon_full(ibeg(1):iend(1),j)
+             ENDDO
+             DO i=1,iim
+                lat(i,:) = lat_full(i,jbeg(1):jend(1))
+             ENDDO
+             ! Some treatment for the orogography
+             orog(:,:) = 0.0
+             contfrac(:,:) = 0.0
+             DO i=ibeg(1),iend(1)
+                DO j=jbeg(1),jend(1)
+                   orog(i-ibeg(1)+1,j-jbeg(1)+1) = 1.0
+                   contfrac(i-ibeg(1)+1,j-jbeg(1)+1) = contfrac_full(i,j)
+                ENDDO
+             ENDDO
+             !
+          ELSE
+             iim = iim_full
+             jjm = jjm_full
+             ALLOCATE(lon(iim,jjm), lat(iim,jjm), orog(iim,jjm), contfrac(iim,jjm))
+             lon(:,:) = lon_full(:,:)
+             lat(:,:) = lat_full(:,:)
+             contfrac(:,:) = contfrac_full(:,:)
+             orog(:,:) = contfrac_full(:,:)+100
+          ENDIF
+       ENDIF
+       !
+    ENDIF
+    !
+    IF ( is_root_prc) THEN
+       WRITE(*,*) "Dimensions : ", iim, jjm
+       WRITE(*,*) MINVAL(lon), ' < LON < ', MAXVAL(lon)
+       WRITE(*,*) MINVAL(lat), ' < LAT < ', MAXVAL(lat)  
+       WRITE(*,*) MINVAL(orog), " < OROG  < ", MAXVAL(orog)
+       WRITE(*,*) MINVAL(contfrac), " < contfrac  < ", MAXVAL(contfrac)
+    ENDIF
+    !
+    ! Free some memory
+    !
+    IF (ALLOCATED(lon_full)) DEALLOCATE(lon_full)
+    IF (ALLOCATED(lat_full)) DEALLOCATE(lat_full)
+    IF (ALLOCATED(etopo)) DEALLOCATE(etopo)
+    IF (ALLOCATED(contfrac_full)) DEALLOCATE(contfrac_full)
+    !
+    ! Distribute the information to all processors
+    !
+    CALL bcast(iim)
+    CALL bcast(jjm)
+    IF ( .NOT. ALLOCATED(lon)) ALLOCATE(lon(iim,jjm))
+    IF ( .NOT. ALLOCATED(lat)) ALLOCATE(lat(iim,jjm))
+    IF ( .NOT. ALLOCATED(orog)) ALLOCATE(orog(iim,jjm))
+    IF ( .NOT. ALLOCATED(contfrac)) ALLOCATE(contfrac(iim,jjm))
+    CALL bcast(lon)
+    CALL bcast(lat)
+    CALL bcast(orog)
+    CALL bcast(contfrac)
+    !
+    ! Count the number of land points
+    !
+    nbland = COUNT(contfrac > 0.0)
+    !
+    iim_out = iim
+    jjm_out = jjm
+    nbland_out = nbland
+    !
+  END SUBROUTINE getlandseamask_init
+  !!
+  !================================================================================================================================
+  !! SUBROUTINE   : getlandseamask_read
+  !!
+  !> BRIEF         Returns the land/sea mask
+  !!
+  !! DESCRIPTION  : None
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! MAIN OUTPUT VARIABLE(S):
+  !!
+  !! REFERENCES   : None
+  !!
+  !! FLOWCHART    : None
+  !! \n
+  !_================================================================================================================================
+  !!
+  SUBROUTINE getlandseamask_read(lon_out, lat_out, mask_out, orog_out)
+    !
+    ! ARGUMENTS
+    !
+    REAL(r_std), DIMENSION(:,:), INTENT(out) :: lon_out, lat_out
+    REAL(r_std), DIMENSION(:,:), INTENT(out) :: mask_out, orog_out
+    !
+    ! LOCAL
+    !
+    lon_out(:,:) = lon(:,:)
+    lat_out(:,:) = lat(:,:)
+    mask_out(:,:) = contfrac(:,:)
+    orog_out(:,:) = orog(:,:)
+    !
+  END SUBROUTINE getlandseamask_read
+  !!
+  !!
+  !
+  !================================================================================================================================
+  !! SUBROUTINE   : opencontfrac
+  !!
+  !> BRIEF         This subroutine gets the dimensions of the fields in the filename. Lat and lon in particular.
+  !!
+  !! DESCRIPTION  : This routines caters for ORCHIDEE as well as the WRF geo files.
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! MAIN OUTPUT VARIABLE(S):
+  !!
+  !! REFERENCES   : None
+  !!
+  !! FLOWCHART    : None
+  !! \n
+  !_================================================================================================================================
+  SUBROUTINE opencontfrac(filename, iim_full, jjm_full, fid)
+    !
+    ! ARGUMENTS
+    !
+    CHARACTER(LEN=*), INTENT(in) :: filename
+    INTEGER(i_std), INTENT(out) :: iim_full, jjm_full, fid
+    !
+    INTEGER(i_std) :: iret, i, lll, ndims, nvars
+    CHARACTER(LEN=20) :: dimname
+    !
+    iret = NF90_OPEN(filename, NF90_NOWRITE, fid)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(*,*) "==>",trim(nf90_strerror(iret))
+       WRITE(*,*) "Error opening ", filename
+       STOP
+    ENDIF
+    iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars)
+    DO i=1,ndims
+       iret = NF90_INQUIRE_DIMENSION (fid, i, name=dimname, len=lll)
+       CALL change_to_lowercase(dimname)
+       IF ( INDEX(dimname,"lon") > 0 ) THEN
+          iim_full = lll
+       ELSE IF (INDEX(dimname,"west_east") > 0 .AND. LEN_TRIM(dimname) == LEN_TRIM("west_east")) THEN
+          iim_full = lll
+       ELSE IF ( INDEX(dimname,"lat") > 0 ) THEN
+          jjm_full = lll
+       ELSE IF (INDEX(dimname,"south_north") > 0 .AND. LEN_TRIM(dimname) == LEN_TRIM("south_north")) THEN
+          jjm_full = lll
+       ENDIF
+    ENDDO
+    !
+    WRITE(*,*) "XXX iimf, jjmf = ", iim_full, jjm_full
+    !
+  END SUBROUTINE opencontfrac
+
+  !================================================================================================================================
+  !! SUBROUTINE   : readcontfrac
+  !!
+  !> BRIEF         This subroutine gets the topography out of the file
+  !!
+  !! DESCRIPTION  : This routines caters for ORCHIDEE as well as the WRF geo files.
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! MAIN OUTPUT VARIABLE(S):
+  !!
+  !! REFERENCES   : None
+  !!
+  !! FLOWCHART    : None
+  !! \n
+  !_================================================================================================================================
+  SUBROUTINE readcontfrac(fid, filename, iimf, jjmf, lon, lat, contf)
+    !
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in)               :: fid
+    CHARACTER(LEN=*), INTENT(in)             :: filename
+    INTEGER(i_std), INTENT(in)               :: iimf, jjmf
+    REAL(r_std), DIMENSION(:,:), INTENT(out) :: lon, lat
+    REAL(r_std), DIMENSION(:,:), INTENT(out) :: contf
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: iret, ndims, nvars, xid, yid, vid, wid
+    INTEGER(i_std) :: xndims, yndims, vndims, wndims
+    INTEGER(i_std) :: iv, ndimsvar, i, j
+    INTEGER(i_std), DIMENSION(4) :: dimids
+    CHARACTER(LEN=60) :: varname, units
+    CHARACTER(LEN=3)  :: model='ORC'
+    INTEGER(i_std), DIMENSION(3) :: start, count
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: vtmp
+    !
+    iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars)
+    !
+    xid = -1
+    yid = -1
+    vid = -1
+    wid = -1
+    !
+    DO iv=1,nvars
+       !
+       iret = NF90_INQUIRE_VARIABLE(fid, iv, name=varname, ndims=ndimsvar, dimids=dimids)
+       iret = NF90_GET_ATT(fid, iv, 'units', units)
+       CALL change_to_lowercase(units)
+       CALL change_to_lowercase(varname)
+       !
+       IF ( INDEX(units,"east") > 0 .OR. INDEX(varname, "xlong_m") > 0 ) THEN
+          xid = iv
+          xndims = ndimsvar
+          IF ( INDEX(varname, "xlong_m") > 0 ) THEN
+             model='WRF'
+          ENDIF
+       ELSE IF (INDEX(units,"north") > 0 .OR. INDEX(varname, "xlat_m") > 0 ) THEN
+          yid = iv
+          yndims = ndimsvar
+          IF ( INDEX(varname, "xlat_m") > 0 ) THEN
+             model='WRF'
+          ENDIF
+       ENDIF
+       !
+       IF ( INDEX(varname,"contfrac") > 0 ) THEN
+          vid = iv
+          vndims = ndimsvar
+       ENDIF
+       IF ( INDEX(varname,"landmask") > 0 ) THEN
+          wid = iv
+          wndims = ndimsvar
+       ENDIF
+       !
+    ENDDO
+    !
+    ! Get longitude
+    !
+    IF ( xid > 0 ) THEN
+       IF ( xndims == 1 ) THEN
+          ALLOCATE(vtmp(iimf))
+          iret = NF90_GET_VAR(fid, xid, vtmp)
+          DO j=1,jjmf
+             lon(:,j) = vtmp(:)
+          ENDDO
+          DEALLOCATE(vtmp)
+       ELSE IF ( xndims == 2 ) THEN
+          iret = NF90_GET_VAR(fid, xid, lon)
+       ELSE IF ( xndims == 3 ) THEN
+          start = (/1,1,1/)
+          count = (/iimf,jjmf,1/)
+          iret = NF90_GET_VAR(fid, xid, lon, start, count)
+       ELSE
+          WRITE(*,*) "Unforeseen number of dimensions for longitude ", xndims
+          STOP
+       ENDIF
+    ELSE
+       WRITE(*,*) "could not find the longitude in file ", filename
+       STOP
+    ENDIF
+    !
+    ! Get latitude
+    !
+    IF ( yid > 0 ) THEN
+       IF ( yndims == 1 ) THEN
+          ALLOCATE(vtmp(jjmf))
+          iret = NF90_GET_VAR(fid, xid, vtmp)
+          DO i=1,iimf
+             lat(i,:) = vtmp(:)
+          ENDDO
+          DEALLOCATE(vtmp)
+       ELSE IF ( yndims == 2 ) THEN
+          iret = NF90_GET_VAR(fid, yid, lat)
+       ELSE IF ( yndims == 3 ) THEN
+          start = (/1,1,1/)
+          count = (/iimf,jjmf,1/)
+          iret = NF90_GET_VAR(fid, yid, lat, start, count)
+       ELSE
+          WRITE(*,*) "Unforeseen number of dimensions for latitude ", yndims
+          STOP
+       ENDIF
+    ELSE
+       WRITE(*,*) "could not find the latitude in file ", filename
+       STOP
+    ENDIF
+    !
+    ! Get the variable
+    !
+    contf(:,:) = 0.0
+    IF ( model == "ORC" ) THEN
+       IF ( vid > 0 ) THEN
+          iret = NF90_GET_VAR(fid, vid, contf)
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) "==>",trim(nf90_strerror(iret))
+             WRITE(*,*) "Cannot read variable contfrac"
+             STOP
+          ENDIF
+       ELSE
+          WRITE(*,*) "could not find the variable contfrac in file ", filename
+          STOP
+       ENDIF
+    ELSE IF ( model == "WRF" ) THEN
+       !
+       ! This is a time varying variable so start and count needs to be specified
+       !
+       start = (/1,1,1/)
+       count = (/iimf,jjmf,1/)
+       IF ( wid > 0 ) THEN
+          iret = NF90_GET_VAR(fid, wid, contf, start, count)
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) "==>",trim(nf90_strerror(iret))
+             WRITE(*,*) "Cannot read variable landmask"
+             STOP
+          ENDIF
+       ELSE
+          WRITE(*,*) "could not find the variable contfrac in file ", filename
+          STOP
+       ENDIF
+       WRITE(*,*) "XXX", MINVAL(contf), " < contf < ", MAXVAL(contf)
+    ELSE
+       WRITE(*,*) "Unknown model = ", model
+       STOP
+    ENDIF
+    !
+    ! Delete undef values
+    !
+    DO i=1,iimf
+       DO j=1,jjmf
+          IF ( contf(i,j) > 1.0 .OR. contf(i,j) < 0.0 ) THEN
+             contf(i,j) = 0.0
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    iret = NF90_CLOSE(fid)
+    !
+  END SUBROUTINE readcontfrac
+  !!
+  !
+  !================================================================================================================================
+  !! SUBROUTINE   : topo_getsize
+  !!
+  !> BRIEF         This subroutine gets the size of the topography field
+  !!
+  !! DESCRIPTION  : None
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! MAIN OUTPUT VARIABLE(S):
+  !!
+  !! REFERENCES   : None
+  !!
+  !! FLOWCHART    : None
+  !! \n
+  !_================================================================================================================================
+  SUBROUTINE topo_getsize(filename, iim_full, jjm_full)
+    !
+    USE defprec
+    USE netcdf
+    !
+    ! ARGUMENTS
+    !
+    CHARACTER(LEN=*), INTENT(in) :: filename
+    INTEGER(i_std), INTENT(out)  :: iim_full, jjm_full
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: fid, iret, xid, yid, ndims, nvars, i, lll
+    CHARACTER(LEN=20) :: dimname
+    !
+    iret = NF90_OPEN(filename, NF90_NOWRITE, fid)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(*,*) "Error opening ", filename
+       STOP
+    ENDIF
+    iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars)
+    DO i=1,ndims
+       iret = NF90_INQUIRE_DIMENSION (fid, i, name=dimname, len=lll)
+       CALL change_to_lowercase(dimname)
+       IF ( INDEX(dimname,"x") > 0 ) THEN
+          iim_full = lll
+       ELSE IF ( INDEX(dimname,"y") > 0 ) THEN
+          jjm_full = lll
+       ENDIF
+    ENDDO
+    !
+    iret = NF90_CLOSE(fid)
+    !
+  END SUBROUTINE topo_getsize
+  !================================================================================================================================
+  !! SUBROUTINE   : topo_getvar
+  !!
+  !> BRIEF         This subroutine gets the topography out of the file
+  !!
+  !! DESCRIPTION  : None
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! MAIN OUTPUT VARIABLE(S):
+  !!
+  !! REFERENCES   : None
+  !!
+  !! FLOWCHART    : None
+  !! \n
+  !_================================================================================================================================
+  SUBROUTINE topo_getvar(filename, iim, jjm, lon, lat, etopo)
+    !
+    USE defprec
+    USE netcdf
+    !
+    ! ARGUMENTS
+    !
+    CHARACTER(LEN=*), INTENT(in)                 :: filename
+    INTEGER(i_std), INTENT(in)                   :: iim, jjm
+    REAL(r_std), DIMENSION(iim,jjm), INTENT(out) :: lon 
+    REAL(r_std), DIMENSION(iim,jjm), INTENT(out) :: lat
+    REAL(r_std), DIMENSION(iim,jjm), INTENT(out) :: etopo
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: fid, iret, xid, yid, vid
+    INTEGER(i_std) :: i, j, iv, ndimsvar, ndims, nvars
+    CHARACTER(LEN=20) :: varname, units
+    INTEGER(i_std), DIMENSION(1) :: il
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)   :: lon_loc, lon_read, lat_read
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: etopo_loc
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: dimids, londim_ids, latdim_ids
+    !
+    ALLOCATE(lon_loc(iim))
+    ALLOCATE(lon_read(iim))
+    ALLOCATE(lat_read(jjm))
+    ALLOCATE(etopo_loc(iim,jjm))
+    ALLOCATE(dimids(NF90_MAX_VAR_DIMS), londim_ids(NF90_MAX_VAR_DIMS), latdim_ids(NF90_MAX_VAR_DIMS))
+    !
+    iret = NF90_OPEN(filename, NF90_NOWRITE, fid)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(*,*) "Error opening ", filename
+       STOP
+    ENDIF
+    !
+    iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars)
+    !
+    ! Identify the variables
+    !
+    xid = -1
+    yid = -1
+    vid = -1
+    !
+    DO iv=1,nvars
+       iret = NF90_INQUIRE_VARIABLE(fid, iv, name=varname, ndims=ndimsvar, dimids=dimids)
+       iret = NF90_GET_ATT(fid, iv, 'units', units)
+       CALL change_to_lowercase(units)
+       !
+       IF ( INDEX(units,"east") > 0 ) THEN
+          xid = iv
+       ELSE IF (INDEX(units,"north") > 0 ) THEN
+          yid = iv
+       ELSE IF ( INDEX(units,"meters") > 0 ) THEN
+          vid = iv
+       ENDIF
+    ENDDO
+    !
+    ! Get variables now that they have been identified
+    !
+    IF ( xid > 0 ) THEN
+       iret = NF90_GET_VAR(fid, xid, lon_read)
+    ELSE
+       WRITE(*,*) "cound not find the longitude in file ", filename
+       STOP
+    ENDIF
+    IF ( yid > 0 ) THEN
+       iret = NF90_GET_VAR(fid, yid, lat_read)
+    ELSE
+       WRITE(*,*) "cound not find the latitude in file ", filename
+       STOP
+    ENDIF
+    IF ( vid > 0 ) THEN
+       iret = NF90_GET_VAR(fid, vid, etopo_loc)
+    ELSE
+       WRITE(*,*) "cound not find the topography in file ", filename
+       STOP
+    ENDIF
+    iret = NF90_CLOSE(fid)
+    !
+    ! Shift the topography around the longitude to get a -180:180 range 
+    ! Only if needed !
+    !
+    IF ( MAXVAL(lon_read) > 180. ) THEN
+       ! 
+       lon_loc(:) = lon_read(:)
+       !
+       DO i=1,iim
+          IF (lon_loc(i) > 180. ) THEN
+             lon_loc(i) = lon_loc(i)-360.
+          ENDIF
+       ENDDO
+       !
+       DO i=1,iim
+          il = MINLOC(lon_loc)
+          lon_read(i) = lon_loc(il(1))
+          etopo(i,:) = etopo_loc(il(1),:)
+          lon_loc(il(1)) = 9999999.999999
+       ENDDO
+       !
+       DO j=1,jjm
+          lon(:,j) = lon_read(:)
+       ENDDO
+       DO i=1,iim
+          lat(i,:) = lat_read(:)
+       ENDDO
+    ELSE
+       DO j=1,jjm
+          lon(:,j) = lon_read(:)
+       ENDDO
+       DO i=1,iim
+          lat(i,:) = lat_read(:)
+       ENDDO
+       etopo(:,:) = etopo_loc(:,:)
+    ENDIF
+    !
+    !
+    DEALLOCATE(lon_read)
+    DEALLOCATE(lon_loc)
+    DEALLOCATE(lat_read)
+    DEALLOCATE(etopo_loc)
+    !
+  END SUBROUTINE topo_getvar
+  !
+  !================================================================================================================================
+  !! SUBROUTINE   : interpol
+  !!
+  !> BRIEF         This subroutine interpolates topography to new resolution.
+  !!
+  !! DESCRIPTION  : None
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! MAIN OUTPUT VARIABLE(S):
+  !!
+  !! REFERENCES   : None
+  !!
+  !! FLOWCHART    : None
+  !! \n
+  !_================================================================================================================================
+
+  SUBROUTINE interpol(iim_fine, jjm_fine, lon_fine, lat_fine, orog, iim, jjm, lon, lat, neworog)
+    !
+    USE constantes_var
+    USE ioipsl_para
+    !
+    IMPLICIT NONE
+    ! Parameter
+    !INTEGER(i_std), PARAMETER                                  :: nbvmax = 800
+    INTEGER(i_std), PARAMETER                                  :: nbvmax = 30000
+    !
+    INTEGER(i_std)                                             :: iim_fine, jjm_fine, iim, jjm
+    REAL(r_std), DIMENSION (iim_fine,jjm_fine)                 :: lon_fine
+    REAL(r_std), DIMENSION (iim_fine,jjm_fine)                 :: lat_fine
+    REAL(r_std), DIMENSION (iim_fine,jjm_fine)                 :: orog
+    REAL(r_std), DIMENSION (iim,jjm)                           :: lon
+    REAL(r_std), DIMENSION (jjm,iim)                           :: lat
+    REAL(r_std), DIMENSION (iim,jjm)                           :: neworog
+    !
+    REAL(r_std), DIMENSION (nbvmax)                            :: area, topo
+    !
+    INTEGER(i_std)                                             :: ip, jp, ig, jg, i, fopt, lastjp
+    REAL(r_std)                                                :: dx, dy, ax, ay, ox, lon_up, lon_low, lat_up, lat_low, sgn
+    REAL(r_std)                                                :: totarea, landarea, height
+    REAL(r_std), ALLOCATABLE, DIMENSION (:,:)                  :: lon_ful, lat_ful, laup_rel, loup_rel, lalow_rel, lolow_rel
+    REAL(r_std)                                                :: lonrel, lolowrel, louprel, coslat
+    !
+    ! Allocate arrays
+    !
+    ALLOCATE (laup_rel(iim_fine,jjm_fine))
+    ALLOCATE (loup_rel(iim_fine,jjm_fine))
+    ALLOCATE (lalow_rel(iim_fine,jjm_fine))
+    ALLOCATE (lolow_rel(iim_fine,jjm_fine))
+    ALLOCATE (lat_ful(iim_fine+2,jjm_fine+2))
+    ALLOCATE (lon_ful(iim_fine+2,jjm_fine+2))
+    !
+    ! Duplicate the border assuming we have a global grid going from west to east
+    !
+    DO jp=2,jjm_fine+1
+       lon_ful(2:iim_fine+1,jp) = lon_fine(1:iim_fine,jp)
+    ENDDO
+    DO ip=2,iim_fine+1
+       lat_ful(ip,2:jjm_fine+1) = lat_fine(ip,1:jjm_fine)
+    ENDDO
+    !
+    IF ( lon_fine(iim_fine,1) .LT. lon_ful(2,2)) THEN
+       lon_ful(1,2:jjm_fine+1) = lon_fine(iim_fine,:)
+       lat_ful(1,2:jjm_fine+1) = lat_fine(1,1:jjm_fine)
+    ELSE
+       lon_ful(1,2:jjm_fine+1) = lon_fine(iim_fine,:)-360.
+       lat_ful(1,2:jjm_fine+1) = lat_fine(1,1:jjm_fine)
+    ENDIF
+
+    IF ( lon_fine(1,1) .GT. lon_ful(iim_fine+1,2)) THEN
+       lon_ful(iim_fine+2,2:jjm_fine+1) = lon_fine(1,1:jjm_fine)
+       lat_ful(iim_fine+2,2:jjm_fine+1) = lat_fine(iim_fine,1:jjm_fine)
+    ELSE
+       lon_ful(iim_fine+2,2:jjm_fine+1) = lon_fine(1,1:jjm_fine)+360
+       lat_ful(iim_fine+2,2:jjm_fine+1) = lat_fine(iim_fine,1:jjm_fine)
+    ENDIF
+    !
+    sgn = lat_fine(1,1)/ABS(lat_fine(1,1))
+    lat_ful(2:iim_fine+1,1) = sgn*180 - lat_fine(1,1)
+    sgn = lat_fine(iim_fine,jjm_fine)/ABS(lat_fine(iim_fine,jjm_fine))
+    lat_ful(2:iim_fine+1,jjm_fine+2) = sgn*180 - lat_fine(iim_fine,jjm_fine)
+    lat_ful(1,1) = lat_ful(iim_fine+1,1)
+    lat_ful(iim_fine+2,1) = lat_ful(2,1)
+    lat_ful(1,jjm_fine+2) = lat_ful(iim_fine+1,jjm_fine+2)
+    lat_ful(iim_fine+2,jjm_fine+2) = lat_ful(2,jjm_fine+2)
+    !
+    ! Add the longitude lines to the top and bottom
+    !
+    lon_ful(:,1) = lon_ful(:,2) 
+    lon_ful(:,jjm_fine+2) = lon_ful(:,jjm_fine+1) 
+    !
+    ! Get the upper and lower limits of each grid box
+    !
+    DO ip=1,iim_fine
+       DO jp=1,jjm_fine
+          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
+    !
+    dx = ABS(lon(2,1) - lon(1,1))
+    dy = ABS(lat(1,2) - lat(1,1))
+    !
+    DO ig = 1,iim
+       DO jg = 1,jjm
+          !
+          !
+          lon_up = lon(ig,jg) + dx/2.0
+          lon_low = lon(ig,jg) - dx/2.0
+          !
+          !
+          lat_up = lat(ig,jg) + dy/2.0
+          lat_low = lat(ig,jg) - dy/2.0
+          !
+          !  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.
+          !
+          totarea = 0.0
+          landarea = 0.0
+          height = 0.0
+          !
+          fopt = 0
+          lastjp = 1
+          DO ip=1,iim_fine
+             !
+             DO jp = 1, jjm_fine
+                !  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_fine(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
+                   lonrel = MOD( 360. - lon_fine(ip,jp), 360.0)
+                   lolowrel = MOD( 360. - lolow_rel(ip,jp), 360.0)
+                   louprel = MOD( 360. - loup_rel(ip,jp), 360.0)
+                ELSE
+                   lonrel = lon_fine(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_fine(ip,jp) > lat_low .AND. lat_fine(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 .GT. nbvmax) THEN
+                         WRITE(*,*) 'Please increase nbvmax in subroutine interpol', ig, jg
+                         WRITE(*,*) "nbvmax = ", nbvmax
+                         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_fine(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
+                         !
+                         totarea = totarea + ax*ay
+                         IF ( orog(ip, jp) > 0.0 ) THEN
+                            landarea = landarea + ax*ay
+                            height = height + ax*ay*orog(ip,jp)
+                         ENDIF
+                         !
+                      ENDIF
+                   ENDIF
+                   !
+                ENDIF
+                !
+             ENDDO
+             !
+          ENDDO
+          !
+          IF ( landarea > 0 .AND. landarea > 0.1*totarea ) THEN
+             neworog(ig,jg) = height/landarea
+          ELSE
+             neworog(ig,jg) = 0.0
+          ENDIF
+          !
+       ENDDO
+       !
+    ENDDO
+  END SUBROUTINE interpol
+
+  SUBROUTINE change_to_lowercase (str)
+    !---------------------------------------------------------------------
+    !- Converts a string into lowercase letters
+    !---------------------------------------------------------------------
+    IMPLICIT NONE
+    !-
+    CHARACTER(LEN=*) :: str
+    !-
+    INTEGER :: i,ic
+    !---------------------------------------------------------------------
+    DO i=1,LEN_TRIM(str)
+       ic = IACHAR(str(i:i))
+       IF ( (ic >= 65).AND.(ic <= 90) )  str(i:i) = ACHAR(ic+32)
+    ENDDO
+    !--------------------------
+  END SUBROUTINE change_to_lowercase
+
+END MODULE getlandseamask
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/getprec.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/getprec.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/getprec.f90	(revision 6412)
@@ -0,0 +1,56 @@
+!< $HeadURL$ 
+!< $Date$
+!< $Revision$
+!-
+PROGRAM getprec
+!---------------------------------------------------------------------
+!- This program verifies that that the number representation
+!- between the different components of the model are compatible
+!---------------------------------------------------------------------
+  USE defprec
+!-
+  IMPLICIT NONE
+!-
+  INTEGER :: i
+  REAL    :: r
+!-
+  INTEGER :: range_int,range_real,precision_real
+!---------------------------------------------------------------------
+  range_int  = RANGE(i)
+  range_real = RANGE(r)
+  precision_real = PRECISION(r)
+!-
+  WRITE(*,*) 'The following ranges and precisions are standard'
+  WRITE(*,*) 'on this computer with your compiler options :'
+  WRITE(*,*) ' INTEGER range     :',range_int
+  WRITE(*,*) ' REAL    range     :',range_real
+  WRITE(*,*) ' REAL    precision :',precision_real
+!-
+  WRITE(*,*) 'The corresponding kinds are :'
+  WRITE(*,*) ' KIND for integer  :', &
+ & SELECTED_INT_KIND(range_int)
+  WRITE(*,*) ' KIND for real     :', &
+ & SELECTED_REAL_KIND(precision_real,range_real)
+!-
+  WRITE(*,*) 'We test if this corresponds to what is used'
+  WRITE(*,*) 'in various parts of the code :'
+!-
+! Real :
+!-
+  IF (SELECTED_REAL_KIND(precision_real,range_real) /= r_std) THEN
+    WRITE(*,*) ' REAL : ERROR, the wrong kind is specified.'
+    WRITE(*,*) ' Use the value above.'
+  ELSE
+    WRITE(*,*) ' REAL    : OK'
+  ENDIF
+!-
+! Integer :
+!-
+  IF (SELECTED_INT_KIND(range_int) /= i_std) THEN
+    WRITE(*,*) ' INTEGER : ERROR, the wrong kind is specified.'
+    WRITE(*,*) ' Use the value above.'
+  ELSE
+    WRITE(*,*) ' INTEGER : OK'
+  ENDIF
+!------------------
+END PROGRAM getprec
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/globgrd.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/globgrd.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/globgrd.f90	(revision 6412)
@@ -0,0 +1,872 @@
+!  ==============================================================================================================================\n
+!  MODULE globgrd : This module is dedicated to managing the spatial grid of the forcing. It can either read a file
+!                 containing the grid information, as is the case for WRF forcing, or obtain the grid from the forcing files.
+!                 The module has also the possibility to create a grid description files for certain applications like
+!                 for instance in a coupling of ORCHIDEE through OASIS. 
+!                 For this purpose the module provides 4 subroutines :
+!                 globgrd_getdomsz : This routine allows to get the domain size of the forcing based on a file it will explore.
+!                 globgrd_getgrid : This routine extracts the coordinates and land/sea mask from the domain files.
+!                 globgrd_writevar : Writes a variables into a netCDF file which can then be analysed to verify that the
+!                                    forcing grid was well read and interpreted by this module.
+!                 globgrd_writegrid : Write a grid description file which has the WRF flavor. It allows to exchange grid information
+!                                     between an atmospheric model (mostly a driver !) and ORCHIDEE which are coupled through OASIS.
+!
+!  CONTACT      : jan.polcher@lmd.jussieu.fr
+!
+!  LICENCE      : IPSL (2016)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        
+!! 
+!! RECENT CHANGE(S): None 
+!! 
+!! REFERENCE(S) : None
+!! 
+!_ ================================================================================================================================
+MODULE globgrd
+  !
+  !
+  USE defprec
+  USE netcdf
+  !
+  USE ioipsl
+  !
+  USE grid
+  USE forcing_tools
+  !
+  IMPLICIT NONE
+  !
+  PRIVATE
+  PUBLIC :: globgrd_getdomsz, globgrd_getgrid, globgrd_writevar, globgrd_writegrid
+  !
+  !
+  LOGICAL, SAVE  :: is_forcing_file=.FALSE.
+  !
+CONTAINS
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: globgrd_getdomsz
+!!
+!>\BRIEF  This routine allows to get the domain size of the forcing based on a file it will explore.
+!!
+!! DESCRIPTION: The routine opens the file and explores it. It can either be a forcing file or a grid description
+!!              file from WRF. Progressively this should be opened to other ways of describing the grid over which
+!!              the forcing is provided.
+!!              The routing will return the sizes in I and J and the number of land points.
+!!              The zooming interval is also provided so that only the dimensions over the domain used can be computed.
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  !---------------------------------------------------------------------
+  !-
+  !- 
+  !---------------------------------------------------------------------
+  SUBROUTINE globgrd_getdomsz(filename, iim, jjm, nbland, model_guess, fid, forcingfile, zoom_lon, zoom_lat)
+    !
+    ! INPUT
+    !
+    CHARACTER(LEN=*), INTENT(in)  :: filename
+    CHARACTER(LEN=*), INTENT(in), OPTIONAL :: forcingfile(:)
+    REAL(r_std), DIMENSION(2), INTENT(in), OPTIONAL :: zoom_lon, zoom_lat
+    !
+    ! OUTPUT
+    !
+    INTEGER(i_std), INTENT(out)    :: fid
+    INTEGER(i_std), INTENT(out)    :: iim, jjm, nbland
+    CHARACTER(LEN=*), INTENT(out)  :: model_guess
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: iret, ndims, nvars, nb_atts, id_unlim, iv, lll
+    INTEGER(i_std) :: iim_full, jjm_full, nbland_full
+    CHARACTER(LEN=20) :: axname, varname
+    CHARACTER(LEN=120) :: tmpfile
+    REAL(r_std), DIMENSION(2) :: loczoom_lon, loczoom_lat
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    !
+    ! Set default values against which we can test
+    !
+    iim = -1 
+    jjm = -1
+    !
+    ! Verify the grid file name
+    ! 
+    IF ( INDEX(filename,"NONE") >= 1 ) THEN
+       is_forcing_file=.TRUE.
+       IF ( PRESENT(forcingfile) ) THEN
+          tmpfile=forcingfile(1)
+       ELSE
+          CALL ipslerr (3,'globgrd_getdomsz',"Error No grid file provided :",tmpfile, " ")
+       ENDIF
+    ELSE
+       is_forcing_file=.FALSE.
+       tmpfile=filename
+    ENDIF
+    !
+    ! Verify that the zomm is provided. Else choose the entire globe
+    !
+    IF ( PRESENT(zoom_lon) .AND. PRESENT(zoom_lat) ) THEN
+       loczoom_lon = zoom_lon
+       loczoom_lat = zoom_lat
+    ELSE
+       loczoom_lon(1) = -180.0
+       loczoom_lon(2) = 180.0
+       loczoom_lat(1) = -90.0
+       loczoom_lat(2) = 90.0
+    ENDIF
+    !
+    ! Open the correct file
+    !
+    iret = NF90_OPEN (tmpfile, NF90_NOWRITE, fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'globgrd_getdomsz',"Error opening the grid file :",tmpfile, " ")
+    ENDIF
+    !
+    !
+    iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, &
+         nAttributes=nb_atts, unlimitedDimId=id_unlim)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'globgrd_getdomsz',"Error in NF90_INQUIRE :",tmpfile, " ")
+    ENDIF
+    !
+    DO iv=1,ndims
+       !
+       iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'globgrd_getdomsz',"Could not get size of dimension :"," "," ")
+       ENDIF
+       !
+       ! This can be refined by testing the actual grid found in the file.
+       !
+       SELECT CASE(axname)
+          !
+          !! Coordinate variables used by WRF.
+       CASE("west_east")
+          iim = lll
+          model_guess = "WRF"
+       CASE("south_north")
+          jjm = lll
+          model_guess = "WRF"
+          !
+          !! Variables used in WFDEI
+       CASE("lon")
+          iim = lll
+          model_guess = "regular"
+       CASE("lat")
+          jjm = lll
+          model_guess = "regular"
+       CASE("nbland")
+          nbland = lll
+          !
+          !! Variables used by CRU-NCEP
+       CASE("nav_lon")
+          iim = lll
+          model_guess = "regular"
+       CASE("nav_lat")
+          jjm = lll
+          model_guess = "regular"
+       CASE("land")
+          nbland = lll
+       END SELECT
+    ENDDO
+    !
+    ! If we have a WRF file we need to count the number of land points.
+    !
+    IF (  model_guess == "WRF" ) THEN
+
+       ALLOCATE(mask(iim,jjm))
+
+       varname = "LANDMASK"
+       iret = NF90_INQ_VARID (fid, varname, iv)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'globgrd_getdomsz',"Could not find variable ", varname," ")
+       ELSE
+          iret = NF90_GET_VAR (fid,iv,mask)
+       ENDIF
+
+       nbland = COUNT(mask > 0.5)
+
+    ENDIF
+    !
+    !
+    ! If we are in the case of a forcing file a few functions from forcing_tools need to be called
+    ! so that the file is analysed with the tools of the forcing module.
+    !
+    IF ( is_forcing_file ) THEN
+       !
+       ! Because we are re-using routines from the forcing module, we have to
+       ! close the file. It will be opened again by the forcing module.
+       !
+       iret = NF90_CLOSE(fid)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'globgrd_getdomzz',"Error closing the output file :",filename, " ")
+       ENDIF
+       !
+       ! This has to be a regular grid. A more clever clasification of files will be needed.
+       model_guess = "regular"
+       !
+       CALL forcing_getglogrid (1, forcingfile, iim_full, jjm_full, nbland_full, .TRUE.)
+       WRITE(*,*) forcingfile, "Forcing file with dimensions : ", iim_full, jjm_full, nbland_full
+       !
+       CALL forcing_zoomgrid (loczoom_lon, loczoom_lat, forcingfile(1), .TRUE.)
+       !
+       CALL forcing_givegridsize (iim, jjm, nbland)
+       !
+    ENDIF
+    !
+    ! Do a final test to see if we got the information needed.
+    !
+    IF ( iim < 0 .OR. jjm < 0 ) THEN
+       CALL ipslerr (3,'globgrd_getdomsz',"Could not get the horizontal size of the domaine out of the file",&
+            & filename,"Are you sure that the case for this type of file is foreseen ? ")
+    ENDIF
+    !
+    !
+  END SUBROUTINE globgrd_getdomsz
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: globgrd_getgrid
+!!
+!>\BRIEF        This routine extracts the coordinates and land/sea mask from the domain files.     
+!!
+!! DESCRIPTION: The domain size is provided together with the netCDF file ID so that the main information can
+!!              be extracted from the file. We will read the longitude, latitude, land/sea mask and calendar.
+!!              This allows to set-up ORCHIDEE. We also provide the corners of the grid-boxes as this is needed
+!!              for setting-up OASIS but is computed more correctly in grid.f90 for ORCHIDEE. 
+!!              This routine is only an interface to globgrd_getwrf, globgrd_getregular and forcing_givegrid.
+!!              forcing_givegrid is an interface to the forcing_tools.f90 module so that we are certain to have
+!!              the same grid information between both modules.
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  !---------------------------------------------------------------------
+  !-
+  !- 
+  !---------------------------------------------------------------------
+  SUBROUTINE globgrd_getgrid(fid, iim, jjm, nbland, model_guess, lon, lat, mask, area, corners, &
+       &                     lindex, contfrac, calendar)
+    !
+    !
+    ! This subroutine only switched between routines to extract and compte the grid data needed for 
+    ! ORCHIDEE.
+    !
+    !
+    ! INPUT
+    !
+    INTEGER(i_std), INTENT(in)   :: fid
+    INTEGER(i_std), INTENT(in)   :: iim, jjm, nbland
+    CHARACTER(LEN=*), INTENT(in) :: model_guess
+    !
+    ! OUTPUT
+    !
+    REAL(r_std),DIMENSION(iim,jjm), INTENT(out)     :: lon, lat, mask, area
+    REAL(r_std),DIMENSION(iim,jjm,4,2), INTENT(out) :: corners
+    INTEGER(i_std), DIMENSION(nbland), INTENT(out)  :: lindex
+    REAL(r_std),DIMENSION(nbland), INTENT(out)      :: contfrac
+    CHARACTER(LEN=20), INTENT(out)                  :: calendar
+    !
+    SELECT CASE(model_guess)
+
+    CASE("WRF")
+       CALL globgrd_getwrf(fid, iim, jjm, nbland, lon, lat, mask, area, corners, &
+            &               lindex, contfrac, calendar)
+    CASE("regular")
+       IF ( .NOT. is_forcing_file ) THEN
+          CALL globgrd_getregular(fid, iim, jjm, nbland, lon, lat, mask, area, corners, &
+               &                   lindex, contfrac, calendar)
+       ELSE
+          CALL forcing_givegrid(lon, lat, mask, area, corners, lindex, contfrac, calendar)
+          CALL forcing_close()
+       ENDIF
+    CASE DEFAULT
+       CALL ipslerr (3,'globgrd_getgrid',"The model/grid type we guessed is not recognized here. model_guess =",&
+            & model_guess,"Have you used the right file and are you sure that this case is foreseen ? ")
+    END SELECT
+    !
+    !
+  END SUBROUTINE globgrd_getgrid
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: globgrd_regular
+!!
+!>\BRIEF       The routine to obtain regular grids from the file.     
+!!
+!! DESCRIPTION:	  Read the regular grid and its information from the opened file (fid).
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE globgrd_getregular(fid, iim, jjm, nbland, lon, lat, mask, area, corners, &
+       &                     lindex, contfrac, calendar)
+    !
+    USE defprec
+    USE netcdf
+    !
+    ! INPUT
+    !
+    INTEGER(i_std), INTENT(in)   :: fid
+    INTEGER(i_std), INTENT(in)   :: iim, jjm, nbland
+    !
+    ! OUTPUT
+    !
+    REAL(r_std),DIMENSION(iim,jjm), INTENT(out)     :: lon, lat, mask, area
+    REAL(r_std),DIMENSION(iim,jjm,4,2), INTENT(out) :: corners
+    INTEGER(i_std), DIMENSION(nbland), INTENT(out)  :: lindex
+    REAL(r_std),DIMENSION(nbland), INTENT(out)      :: contfrac
+    CHARACTER(LEN=20), INTENT(out)                  :: calendar
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: iret, iv, nvars, varndim
+    INTEGER(i_std) :: i, j
+    CHARACTER(LEN=20) :: varname
+    INTEGER(i_std), DIMENSION(4) :: vardims
+    REAL(r_std) :: dx
+    !
+    ! Set some default values agains which we can check 
+    !
+    lon(:,:) = val_exp
+    lat(:,:) = val_exp
+    mask(:,:) = val_exp
+    area(:,:) = val_exp
+    corners(:,:,:,:) = val_exp
+    !
+    lindex(:) = INT(val_exp)
+    contfrac(:) = val_exp
+    !
+    ! Get the global attributes from grid file
+    !
+    iret = NF90_GET_ATT(fid, NF90_GLOBAL, 'calendar', calendar)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'globgrd_getregular',"Could not read the calendar in grid file.", " ", " ")
+    ENDIF
+    !
+    iret = NF90_INQUIRE (fid, nVariables=nvars)
+    !
+    DO iv = 1,nvars
+       !
+       iret = NF90_INQUIRE_VARIABLE(fid, iv, name=varname, ndims=varndim, dimids=vardims)
+       !
+       !
+       SELECT CASE(varname)
+          !
+       CASE("longitude")
+          IF (varndim == 1 ) THEN
+             DO j=1,jjm
+                iret = NF90_GET_VAR(fid, iv, lon(:,j))
+             ENDDO
+          ELSE IF (varndim == 2 ) THEN
+             iret = NF90_GET_VAR(fid, iv, lon)
+          ELSE
+             CALL ipslerr (3,'globgrd_getregular',"Longitude cannot have more than 2 dimensions","","")
+          ENDIF
+
+       CASE ("latitude")
+          IF (varndim == 1 ) THEN
+             DO i=1,iim
+                iret = NF90_GET_VAR(fid, iv, lat(i,:))
+             ENDDO
+          ELSE IF (varndim == 2 ) THEN
+             iret = NF90_GET_VAR(fid, iv, lon)
+          ELSE
+             CALL ipslerr (3,'globgrd_getregular',"Latitude cannot have more than 2 dimensions","","")
+          ENDIF
+
+       CASE ("mask")
+          IF (varndim /= 2 ) THEN
+             CALL ipslerr (3,'globgrd_getregular',"mask needs to have 2 dimensions","","")
+          ELSE
+             iret = NF90_GET_VAR (fid, iv, mask)
+          ENDIF
+
+       CASE ("areas")
+          IF (varndim /= 2 ) THEN
+             CALL ipslerr (3,'globgrd_getregular',"Areas needs to have 2 dimensions","","")
+          ELSE
+             iret = NF90_GET_VAR (fid, iv, area)
+          ENDIF
+
+       CASE ("corners")
+          IF (varndim /= 4 ) THEN
+             CALL ipslerr (3,'globgrd_getregular',"corners needs to have 4 dimensions","","")
+          ELSE
+             iret = NF90_GET_VAR (fid, iv, corners)
+          ENDIF
+
+       CASE ("landindex")
+          IF (varndim /= 1 ) THEN
+             CALL ipslerr (3,'globgrd_getregular',"landindex is the list of continental points to be gathered", &
+                  &          "Thus it can only have 1 dimensions","")
+          ELSE
+             iret = NF90_GET_VAR (fid, iv, lindex)
+          ENDIF
+
+       CASE ("contfrac")
+          IF (varndim /= 1 ) THEN
+             CALL ipslerr (3,'globgrd_getregular',"Contfrac needs to be a gathered variable", &
+                  &          "thus it needs only 1 dimensions","")
+          ELSE
+             iret = NF90_GET_VAR (fid, iv, contfrac)
+          ENDIF
+
+       END SELECT
+       !
+    ENDDO
+    !
+    !
+    iret = NF90_CLOSE(fid)
+    !
+    ! Verify that we have al the variables needed to describe the ORCHIDEE grid
+    !
+    IF ( ANY( lon(:,:) == val_exp ) ) THEN
+       CALL ipslerr (3,'globgrd_getregular',"The longitude of the ORCHIDEE grid could not be extracted from the",&
+            & "grid definition file","")
+    ENDIF
+    !
+    IF ( ANY( lat(:,:) == val_exp ) ) THEN
+       CALL ipslerr (3,'globgrd_getregular',"The latitude of the ORCHIDEE grid could not be extracted from the",&
+            & "grid definition file","")
+    ENDIF
+    !
+    IF ( ANY( lindex(:) == INT(val_exp) ) ) THEN
+       CALL ipslerr (3,'globgrd_getregular',"The lindex of the ORCHIDEE grid could not be extracted from the",&
+            & "grid definition file","")
+    ENDIF
+    !
+    IF ( ALL( mask(:,:) == val_exp ) ) THEN
+       CALL ipslerr (3,'globgrd_getregular',"The land mask of the ORCHIDEE grid could not be extracted from the",&
+            & "grid definition file","")
+    ELSE IF (MAXVAL(mask) > 1 ) THEN
+       CALL ipslerr (2,'globgrd_getregular',"We have a special case for the mask which needs to be treated.",&
+            & "The field contains the indices of the land points on a compressed grid.","So we replace them with 1 or 0.")
+       DO i=1,iim
+          DO j=1,jjm
+             IF ( mask(i,j) > iim*jjm ) THEN
+                mask(i,j) = 0
+             ELSE
+                mask(i,j) = 1
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDIF
+    !
+    IF ( ANY( contfrac(:) == val_exp ) ) THEN
+       CALL ipslerr (2,'globgrd_getregular',"The continental fraction of the ORCHIDEE grid could not be extracted from the",&
+            & "grid definition file","Thus on all land points it is set to 1.")
+       contfrac(:) = 1.
+    ENDIF
+    !
+    IF ( ANY( corners(:,:,:,:) == val_exp ) ) THEN
+       CALL ipslerr (3,'globgrd_getregular',"The corners for the ORCHIDEE grid could not be extracted from the",&
+            & "grid definition file","As we have to assume a very general grid we cannot do anything !")
+    ENDIF
+    !
+    !
+  END SUBROUTINE globgrd_getregular
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: globgrd_getwrf
+!!
+!>\BRIEF       Routine to read the WRF grid description file.
+!!
+!! DESCRIPTION:	Read the WRF grid and its information from the opened file (fid) and convert
+!!              it to the variables needed by ORCHIDEE.
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE globgrd_getwrf(fid, iim, jjm, nbland, lon, lat, mask, area, corners, &
+       &                     lindex, contfrac, calendar)
+    !
+    USE defprec
+    USE netcdf
+    !
+    ! INPUT
+    !
+    INTEGER(i_std), INTENT(in)   :: fid
+    INTEGER(i_std), INTENT(in)   :: iim, jjm, nbland
+    !
+    ! OUTPUT
+    !
+    REAL(r_std),DIMENSION(iim,jjm), INTENT(out)     :: lon, lat, mask, area
+    REAL(r_std),DIMENSION(iim,jjm,4,2), INTENT(out) :: corners
+    INTEGER(i_std), DIMENSION(nbland), INTENT(out)  :: lindex
+    REAL(r_std),DIMENSION(nbland), INTENT(out)      :: contfrac
+    CHARACTER(LEN=20), INTENT(out)                  :: calendar
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: i, ip, jp, k, iret, iv, nvars, varndim
+    INTEGER(i_std) :: imm1, imp1
+    CHARACTER(LEN=20) :: varname
+    REAL(r_std),DIMENSION(iim,jjm) :: mapfac_x, mapfac_y
+    INTEGER(i_std), DIMENSION(4) :: vardims
+    INTEGER(i_std), DIMENSION(8) :: rose
+    !
+    !
+    ! Set some default values agains which we can check 
+    !
+    lon(:,:) = val_exp
+    lat(:,:) = val_exp
+    mask(:,:) = val_exp
+    area(:,:) = val_exp
+    corners(:,:,:,:) = val_exp
+    !
+    lindex(:) = INT(val_exp)
+    contfrac(:) = val_exp
+    !
+    calendar = 'gregorian'
+    !
+    !
+    !  Init projection in grid.f90 so that it can be used later for projections.
+    !
+    CALL grid_initproj(fid, iim, jjm)
+    !
+    iret = NF90_INQUIRE (fid, nVariables=nvars)
+    !
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'globgrd_getwrf',"Error inquiering variables from WRF grid file."," ", " ")
+    ENDIF
+    !
+    DO iv = 1,nvars
+       !
+       iret = NF90_INQUIRE_VARIABLE(fid, iv, name=varname, ndims=varndim, dimids=vardims)
+       !
+       SELECT CASE(varname)
+       !
+       CASE("XLONG_M")
+          iret = NF90_GET_VAR(fid, iv, lon)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'globgrd_getwrf',"Could not read the longitude from the WRF grid file.", " ", " ")
+          ENDIF
+       CASE("XLAT_M")
+          iret = NF90_GET_VAR(fid, iv, lat)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'globgrd_getwrf',"Could not read the latitude from the WRF grid file.", " ", " ")
+          ENDIF
+       CASE("LANDMASK")
+          iret = NF90_GET_VAR(fid, iv, mask)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'globgrd_getwrf',"Could not read the land mask from the WRF grid file.", " ", " ")
+          ENDIF
+       CASE("MAPFAC_MX")
+          iret = NF90_GET_VAR(fid, iv, mapfac_x)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'globgrd_getwrf',"Could not read the land mask from the WRF grid file.", " ", " ")
+          ENDIF
+       CASE("MAPFAC_MY")
+          iret = NF90_GET_VAR(fid, iv, mapfac_y)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'globgrd_getwrf',"Could not read the land mask from the WRF grid file.", " ", " ")
+          ENDIF
+          !
+       END SELECT
+    ENDDO
+    !
+    ! Compute corners and area on the iimxjjm grid
+    !
+    DO ip=1,iim
+       DO jp=1,jjm
+          ! Corners
+          CALL grid_tolola(ip+0.5, jp+0.5, corners(ip,jp,1,1), corners(ip,jp,1,2))
+          CALL grid_tolola(ip+0.5, jp-0.5, corners(ip,jp,2,1), corners(ip,jp,2,2))
+          CALL grid_tolola(ip-0.5, jp-0.5, corners(ip,jp,3,1), corners(ip,jp,3,2))
+          CALL grid_tolola(ip-0.5, jp-0.5, corners(ip,jp,4,1), corners(ip,jp,4,2))
+          !
+       ENDDO
+    ENDDO
+    !
+    ! Compute resolution and area on the gathered grid
+    !
+    k=0
+    !
+    DO jp=1,jjm
+       DO ip=1,iim
+          IF ( mask(ip,jp) > 0.5 ) THEN
+             !
+             k=k+1
+             lindex(k) = (jp-1)*iim+ip 
+             contfrac(k) = 1.0
+             !
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    iret = NF90_CLOSE (fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'globgrd_getwrf',"Error closing the WRF grid file :", " ", " ")
+    ENDIF
+    !
+  END SUBROUTINE globgrd_getwrf
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: globgrd_writegrid
+!!
+!>\BRIEF      Allows to write the grid to a netDF file for later usage by the glogrid module.
+!!
+!! DESCRIPTION: This routine will write a grid description to a netCDF file. mask is on the iimxjjm grid while other
+!! variables are on the gathered grid. 
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+!
+!
+  SUBROUTINE globgrd_writegrid (gridfilename)
+    !
+    ! This routine will write a grid description to a netCDF file. mask is on the iimxjjm grid while other
+    ! variables are on the gathered grid.
+    !
+    ! ARGUMENTS
+    !
+    CHARACTER(LEN=*), INTENT(in) :: gridfilename
+    !
+    ! LOCAL Grid description
+    !
+    INTEGER(i_std) :: iim, jjm, nblindex
+    !
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: lon, lat
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: area
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:):: corners
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)      :: contfrac
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)   :: lindex
+    CHARACTER(LEN=20) :: calendar
+    !
+    ! LOCAL netCDF and helping variables
+    !
+    INTEGER(i_std) :: iret, fid, i
+    INTEGER(i_std) :: lonid, latid, landdimid, resid, neighid, maskid, nbcornersid
+    INTEGER(i_std) :: londimid, latdimid, contfracid, resolutionid, neighbourid
+    INTEGER(i_std) :: landindexid, areaid, cornerid
+    !
+    ! Get the grid size from the forcing module
+    !
+    CALL forcing_givegridsize (iim, jjm, nblindex)
+    WRITE(*,*) "Dimension of grid for forcing (iim,jjm,nblindex):", iim,jjm,nblindex
+    !
+    ! Allocate fields
+    !
+    ALLOCATE(lon(iim,jjm), lat(iim,jjm))
+    ALLOCATE(mask(iim,jjm))
+    ALLOCATE(area(iim,jjm))
+    ALLOCATE(corners(iim,jjm,4,2))
+    ALLOCATE(lindex(nblindex))
+    ALLOCATE(contfrac(nblindex))
+    !
+    ! Get the actual grid from the forcing module
+    !
+    CALL forcing_givegrid(lon, lat, mask, area, corners, lindex, contfrac, calendar)
+    ! 
+    !
+    iret = NF90_CREATE(gridfilename, NF90_WRITE, fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'globgrd_writegrid',"Error opening the output file :",gridfilename, " ")
+    ENDIF
+    !
+    ! Define dimensions
+    !
+    iret = NF90_DEF_DIM(fid,'lon',iim,londimid)
+    iret = NF90_DEF_DIM(fid,'lat',jjm,latdimid)
+    iret = NF90_DEF_DIM(fid,'nbland',nblindex,landdimid)
+    iret = NF90_DEF_DIM(fid,'nbres',2,resid)
+    iret = NF90_DEF_DIM(fid,'nbcorners',4,nbcornersid)
+    !
+    !
+    ! We need to verify here that we have a regulat grid befor deciding if we write lon and lat in 1D or 2D !
+    !
+    !
+    iret = NF90_DEF_VAR(fid,"longitude",NF90_REAL4,londimid,lonid)
+    iret = NF90_PUT_ATT(fid,lonid,'standard_name',"longitude")
+    iret = NF90_PUT_ATT(fid,lonid,'units',"degrees_east")
+    iret = NF90_PUT_ATT(fid,lonid,'valid_min',MINVAL(lon))
+    iret = NF90_PUT_ATT(fid,lonid,'valid_max',MAXVAL(lon))
+    iret = NF90_PUT_ATT(fid,lonid,'long_name',"Longitude")
+    !
+    iret = NF90_DEF_VAR(fid,"latitude",NF90_REAL4,latdimid,latid)
+    iret = NF90_PUT_ATT(fid,latid,'standard_name',"latitude")
+    iret = NF90_PUT_ATT(fid,latid,'units',"degrees_north")
+    iret = NF90_PUT_ATT(fid,latid,'valid_min',MINVAL(lat))
+    iret = NF90_PUT_ATT(fid,latid,'valid_max',MAXVAL(lat))
+    iret = NF90_PUT_ATT(fid,latid,'long_name',"Latitude")
+    !
+    iret = NF90_DEF_VAR(fid,"mask",NF90_REAL4,(/lonid,latid/),maskid)
+    iret = NF90_PUT_ATT(fid,maskid,'standard_name',"mask")
+    iret = NF90_PUT_ATT(fid,maskid,'units',"-")
+    iret = NF90_PUT_ATT(fid,maskid,'valid_min',MINVAL(mask))
+    iret = NF90_PUT_ATT(fid,maskid,'valid_max',MAXVAL(mask))
+    iret = NF90_PUT_ATT(fid,maskid,'long_name',"Land surface mask")
+    !
+    iret = NF90_DEF_VAR(fid,"area",NF90_REAL4,(/lonid,latid/), areaid)
+    iret = NF90_PUT_ATT(fid,areaid,'standard_name',"area")
+    iret = NF90_PUT_ATT(fid,areaid,'units',"m*m")
+    iret = NF90_PUT_ATT(fid,areaid,'valid_min',MINVAL(area))
+    iret = NF90_PUT_ATT(fid,areaid,'valid_max',MAXVAL(area))
+    iret = NF90_PUT_ATT(fid,areaid,'long_name',"Area of grid box")
+    !
+    iret = NF90_DEF_VAR(fid,"corners",NF90_REAL4,(/lonid,latid,nbcornersid,resid/), cornerid)
+    iret = NF90_PUT_ATT(fid,cornerid,'standard_name',"gridcorners")
+    iret = NF90_PUT_ATT(fid,cornerid,'units',"m*m")
+    iret = NF90_PUT_ATT(fid,cornerid,'valid_min',MINVAL(corners))
+    iret = NF90_PUT_ATT(fid,cornerid,'valid_max',MAXVAL(corners))
+    iret = NF90_PUT_ATT(fid,cornerid,'long_name',"corners of grid boxes")
+    !
+    iret = NF90_DEF_VAR(fid,"landindex",NF90_INT, landdimid, landindexid)
+    iret = NF90_PUT_ATT(fid,landindexid,'standard_name',"landindex")
+    iret = NF90_PUT_ATT(fid,landindexid,'units',"-")
+    iret = NF90_PUT_ATT(fid,landindexid,'valid_min',MINVAL(lindex))
+    iret = NF90_PUT_ATT(fid,landindexid,'valid_max',MAXVAL(lindex))
+    iret = NF90_PUT_ATT(fid,landindexid,'long_name',"Land index on global grid (FORTRAN convention)")
+    !
+    iret = NF90_DEF_VAR(fid,"contfrac",NF90_INT,(/landdimid/), contfracid)
+    iret = NF90_PUT_ATT(fid,contfracid,'standard_name',"contfrac")
+    iret = NF90_PUT_ATT(fid,contfracid,'units',"-")
+    iret = NF90_PUT_ATT(fid,contfracid,'valid_min',MINVAL(contfrac))
+    iret = NF90_PUT_ATT(fid,contfracid,'valid_max',MAXVAL(contfrac))
+    iret = NF90_PUT_ATT(fid,contfracid,'long_name',"Fraction of continent in grid box")
+    !
+    ! Global attributes
+    ! 
+    iret = NF90_PUT_ATT(fid, NF90_GLOBAL,'calendar', calendar)
+    !
+    iret = NF90_ENDDEF (fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'globgrd_writegrid',"Error ending definitions in file :",gridfilename, " ")
+    ENDIF
+    !
+    ! Write variables
+    !
+    iret = NF90_PUT_VAR(fid, lonid, lon(:,1))
+    iret = NF90_PUT_VAR(fid, latid, lat(1,:))
+    iret = NF90_PUT_VAR(fid, maskid, mask)
+    iret = NF90_PUT_VAR(fid, areaid, area)
+    iret = NF90_PUT_VAR(fid, cornerid, corners)
+    !
+    iret = NF90_PUT_VAR(fid, landindexid,lindex)
+    iret = NF90_PUT_VAR(fid, contfracid, contfrac)
+    !
+    ! Close file
+    !
+    iret = NF90_CLOSE(fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'globgrd_writegrid',"Error closing the output file :",gridfilename, " ")
+    ENDIF
+    !
+  END SUBROUTINE globgrd_writegrid
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: globgrd_writevar
+!!
+!>\BRIEF      Writes the grid and a variable to a netCDF file to check if the grid was correctly interpreted by the module.
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+!
+  SUBROUTINE globgrd_writevar(iim, jjm, lon, lat, nbpt, lalo, var, varname, filename)
+    !
+    ! Subroutine used to dump a compressed variable into a full lat/lon grid of a netCDF file
+    !
+    USE netcdf
+    !
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in) :: iim, jjm, nbpt
+    REAL(r_std), INTENT(in)    :: lon(iim,jjm), lat(iim,jjm)
+    REAL(r_std), INTENT(in)    :: lalo(nbpt,2)
+    REAL(r_std), INTENT(in)    :: var(nbpt)
+    CHARACTER(LEN=*), INTENT(in) :: varname
+    CHARACTER(LEN=*), INTENT(in) :: filename
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: iret, fid, i, ii, jj, nlonid, nlatid, varid
+    INTEGER(i_std), DIMENSION(2) :: lolaid 
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: varfull, dist
+    INTEGER(i_std), DIMENSION(2)             :: closest
+    !
+    !
+    WRITE(*,*) "globgrd_writevar WRITE ", TRIM(varname), " into file ", TRIM(filename)
+    !
+    ALLOCATE(varfull(iim,jjm), dist(iim,jjm))
+    varfull(:,:) = nf90_fill_real
+    !
+    ! Locate each point on the global grid
+    !
+    DO i=1,nbpt
+       closest(1) = 99999999
+       closest(2) = 99999999
+       DO ii=1,iim
+          DO jj=1,jjm
+             IF ( ABS(lalo(i,1)-lat(ii,jj)) < 0.25 .AND. ABS(lalo(i,2)-lon(ii,jj)) < 0.25 ) THEN
+                closest(1) = ii
+                closest(2) = jj
+             ENDIF
+          ENDDO
+       ENDDO
+       IF ( closest(1) >  99999998 .OR. closest(2) >  99999998 ) THEN
+          WRITE(*,*) "LALO closest : ", closest
+          STOP "ERROR in globgrd_writevar"
+       ELSE
+          varfull(closest(1),closest(2)) = var(i)
+       ENDIF
+    ENDDO
+    !
+    ! Write the full variable into a NETCDF file
+    !
+    iret = NF90_CREATE(filename, NF90_WRITE, fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'globgrd_writevar',"Error opening the output file :",filename, " ")
+    ENDIF
+    !
+    ! Define dimensions
+    !
+    iret = NF90_DEF_DIM(fid,'Longitude',iim,lolaid(1))
+    iret = NF90_DEF_DIM(fid,'Latitude',jjm,lolaid(2))
+    !
+    iret = NF90_DEF_VAR(fid,"Longitude",NF90_REAL4,lolaid,nlonid)
+    iret = NF90_PUT_ATT(fid,nlonid,'standard_name',"longitude")
+    iret = NF90_PUT_ATT(fid,nlonid,'units',"degrees_east")
+    iret = NF90_PUT_ATT(fid,nlonid,'valid_min',MINVAL(lon))
+    iret = NF90_PUT_ATT(fid,nlonid,'valid_max',MAXVAL(lon))
+    iret = NF90_PUT_ATT(fid,nlonid,'long_name',"Longitude")
+    !
+    iret = NF90_DEF_VAR(fid,"Latitude",NF90_REAL4,lolaid,nlatid)
+    iret = NF90_PUT_ATT(fid,nlatid,'standard_name',"latitude")
+    iret = NF90_PUT_ATT(fid,nlatid,'units',"degrees_north")
+    iret = NF90_PUT_ATT(fid,nlatid,'valid_min',MINVAL(lat))
+    iret = NF90_PUT_ATT(fid,nlatid,'valid_max',MAXVAL(lat))
+    iret = NF90_PUT_ATT(fid,nlatid,'long_name',"Latitude")
+    !
+    iret = NF90_DEF_VAR(fid,varname,NF90_REAL4,lolaid,varid)
+    iret = NF90_PUT_ATT(fid,varid,'_FillValue',NF90_FILL_REAL)
+    !
+    iret = NF90_ENDDEF (fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'globgrd_writevar',"Error ending definitions in file :",filename, " ")
+    ENDIF
+    !
+    ! Write variables
+    !
+    iret = NF90_PUT_VAR(fid,nlonid,lon)
+    iret = NF90_PUT_VAR(fid,nlatid,lat)
+    iret = NF90_PUT_VAR(fid,varid,varfull)
+    !
+    ! Close file
+    !
+    iret = NF90_CLOSE(fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'globgrd_writevar',"Error closing the output file :",filename, " ")
+    ENDIF
+    !
+    DEALLOCATE(varfull,dist)
+    !
+    WRITE(*,*) "globgrd_writevar CLOSE file ", TRIM(filename)
+    !
+  END SUBROUTINE globgrd_writevar
+!
+END MODULE globgrd
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/orchideedriver.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/orchideedriver.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/orchideedriver.f90	(revision 6412)
@@ -0,0 +1,928 @@
+! =================================================================================================================================
+! PROGRAM       : orchideedriver
+!
+! CONTACT       : jan.polcher@lmd.jussieu.fr
+!
+! LICENCE      : IPSL (2016)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF      This is the main program for the new driver. This only organises the data and calls sechiba_main.
+!!            The main work is done in glogrid.f90 and forcing_tools.f90.
+!!
+!!\n DESCRIPTION: Call the various modules to get the forcing data and provide it to SECHIBA. The only complexity
+!!                is setting-up the domain decomposition and distributing the grid information.
+!!                The code is parallel from tip to toe using the domain decomposition inherited from LMDZ.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL:  $
+!! $Date:  $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+! 
+PROGRAM orchidedriver
+  !---------------------------------------------------------------------
+  !-
+  !- 
+  !---------------------------------------------------------------------
+  USE defprec
+  USE netcdf
+  !
+  !
+  USE ioipsl_para
+  USE mod_orchidee_para
+  !
+  USE grid
+  USE timer
+  !
+  USE forcing_tools
+  USE globgrd
+  !
+  USE sechiba
+  USE control
+  USE ioipslctrl
+  !
+  !-
+  IMPLICIT NONE
+  !-
+  CHARACTER(LEN=80) :: gridfilename
+  CHARACTER(LEN=80), DIMENSION(100) :: forfilename
+  INTEGER(i_std) :: nb_forcefile
+  CHARACTER(LEN=8)  :: model_guess
+  INTEGER(i_std)    :: iim_glo, jjm_glo, file_id
+  !- 
+  INTEGER(i_std)    :: nbseg
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lon_glo, lat_glo, area_glo
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: mask_glo
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: corners_glo
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: corners_lon, corners_lat
+  INTEGER(i_std) :: nbindex_g, kjpindex
+  INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: kindex, kindex_g
+  REAL(r_std), DIMENSION(2) :: zoom_lon, zoom_lat
+  !
+  ! Variables for the global grid available on all procs and used
+  ! to fill the ORCHIDEE variable on the root_proc
+  !
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: lalo_glo
+  REAL(r_std), ALLOCATABLE, DIMENSION(:)      :: contfrac_glo
+  CHARACTER(LEN=20)                           :: calendar
+  !-
+  !- Variables local to each processors.
+  !-
+  INTEGER(i_std) :: i, j, ik, nbdt, first_point
+  INTEGER(i_std) :: itau, itau_offset, itau_sechiba
+  REAL(r_std)    :: date0, date0_shifted, dt, julian, julian0
+  REAL(r_std)    :: date0_tmp, dt_tmp
+  INTEGER(i_std) :: nbdt_tmp
+  REAL(r_std)    :: timestep_interval(2), timestep_int_next(2)
+  !
+  INTEGER(i_std) :: rest_id, rest_id_stom
+  INTEGER(i_std) ::  hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lalo_loc
+  INTEGER(i_std) :: iim, jjm, ier
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lon, lat
+  !-
+  !- input fields
+  !-
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: u             !! Lowest level wind speed
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: v             !! Lowest level wind speed 
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: zlev_uv       !! Height of first layer
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: zlev_tq       !! Height of first layer
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: qair          !! Lowest level specific humidity
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: precip_rain   !! Rain precipitation
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: precip_snow   !! Snow precipitation
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: lwdown        !! Down-welling long-wave flux 
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: swdown        !! Downwelling surface short-wave flux
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: sinang        !! cosine of solar zenith angle
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: temp_air      !! Air temperature in Kelvin
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: epot_air      !! Air potential energy
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: ccanopy       !! CO2 concentration in the canopy
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: petAcoef      !! Coeficients A from the PBL resolution
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: peqAcoef      !! One for T and another for q
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: petBcoef      !! Coeficients B from the PBL resolution
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: peqBcoef      !! One for T and another for q
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: cdrag         !! Cdrag
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: coszang       !! Cosine of solar zenith angle
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: pb            !! Lowest level pressure
+  !-
+  !- output fields
+  !-
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: z0m           !! Surface roughness for momentum (m)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: z0h           !! Surface roughness for heat (m)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: coastalflow   !! Diffuse flow of water into the ocean (m^3/dt)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: riverflow     !! Largest rivers flowing into the ocean (m^3/dt)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: tsol_rad      !! Radiative surface temperature
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: vevapp        !! Total of evaporation
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: temp_sol_new  !! New soil temperature
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: qsurf         !! Surface specific humidity
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:)          :: albedo        !! Albedo
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: fluxsens      !! Sensible chaleur flux
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: fluxlat       !! Latent chaleur flux
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: emis          !! Emissivity
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: netco2        !! netco2flux
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: carblu        !! fco2_land_use
+  !-
+  !-
+  !-
+  REAL(r_std) :: atmco2
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)  :: u_tq, v_tq, swnet
+  LOGICAL :: lrestart_read = .TRUE. !! Logical for _restart_ file to read
+  LOGICAL :: lrestart_write = .FALSE. !! Logical for _restart_ file to write'
+  !
+  ! Timer variables
+  !
+  LOGICAL, PARAMETER :: timemeasure=.TRUE.
+  REAL(r_std) :: waitput_cputime=0.0, waitget_cputime=0.0, orchidee_cputime=0.0
+  REAL(r_std) :: waitput_walltime=0.0, waitget_walltime=0.0, orchidee_walltime=0.0
+  !
+  !
+  ! Print point
+  !
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/44.8,-25.3/)
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/44.8,-18.3/)
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/-60.25,-5.25/)
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/46.7,10.3/)
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/0.25,49.25/)
+  ! Case when no ouput is desired.
+  REAL(r_std), DIMENSION(2) :: testpt=(/9999.99,9999.99/)
+  INTEGER(i_std) :: ktest
+  !-
+  !---------------------------------------------------------------------------------------
+  !- 
+  !- Define MPI communicator
+  !- 
+  !---------------------------------------------------------------------------------------
+  !-
+  !
+  ! Set parallel processing in ORCHIDEE
+  !
+  CALL Init_orchidee_para()
+  !
+  !====================================================================================
+  !
+  ! Start timer now that the paralelisation is initialized.
+  !
+  IF ( timemeasure ) THEN
+     CALL init_timer
+     CALL start_timer(timer_global)
+     CALL start_timer(timer_mpi)
+  ENDIF
+  !
+  !
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Start the getconf processes 
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+!!  CALL getin_name("run.def")
+  !-
+  !Config Key   = GRID_FILE
+  !Config Desc  = Name of file containing the forcing data
+  !Config If    = [-]
+  !Config Def   = grid_file.nc
+  !Config Help  = This is the name of the file from which we will read
+  !Config         or write into it the description of the grid from 
+  !Config         the forcing file.
+  !Config         compliant.
+  !Config Units = [FILE] 
+  !- 
+  gridfilename='NONE'
+  CALL getin_p('GRID_FILE', gridfilename)
+  !-
+  forfilename(:)=" "
+  forfilename(1)='forcing_file.nc'
+  CALL getin_p('FORCING_FILE', forfilename)
+  !-
+  !- Define the zoom
+  !-
+  zoom_lon=(/-180,180/)
+  zoom_lat=(/-90,90/)
+  !
+  !Config Key   = LIMIT_WEST
+  !Config Desc  = Western limit of region
+  !Config If    = [-]
+  !Config Def   = -180.
+  !Config Help  = Western limit of the region we are 
+  !Config         interested in. Between -180 and +180 degrees
+  !Config         The model will use the smalest regions from
+  !Config         region specified here and the one of the forcing file.
+  !Config Units = [Degrees] 
+  !- 
+  CALL getin_p('LIMIT_WEST',zoom_lon(1))
+  !-
+  !Config Key   = LIMIT_EAST
+  !Config Desc  = Eastern limit of region
+  !Config If    = [-]
+  !Config Def   = 180.
+  !Config Help  = Eastern limit of the region we are
+  !Config         interested in. Between -180 and +180 degrees
+  !Config         The model will use the smalest regions from
+  !Config         region specified here and the one of the forcing file.
+  !Config Units = [Degrees] 
+  !-
+  CALL getin_p('LIMIT_EAST',zoom_lon(2))
+  !-
+  !Config Key   = LIMIT_NORTH
+  !Config Desc  = Northern limit of region
+  !Config If    = [-]
+  !Config Def   = 90.
+  !Config Help  = Northern limit of the region we are
+  !Config         interested in. Between +90 and -90 degrees
+  !Config         The model will use the smalest regions from
+  !Config         region specified here and the one of the forcing file.
+  !Config Units = [Degrees]
+  !-
+  CALL getin_p('LIMIT_NORTH',zoom_lat(2))
+  !-
+  !Config Key   = LIMIT_SOUTH
+  !Config Desc  = Southern limit of region
+  !Config If    = [-]
+  !Config Def   = -90.
+  !Config Help  = Southern limit of the region we are
+  !Config         interested in. Between 90 and -90 degrees
+  !Config         The model will use the smalest regions from
+  !Config         region specified here and the one of the forcing file.
+  !Config Units = [Degrees]
+  !-
+  CALL getin_p('LIMIT_SOUTH',zoom_lat(1))
+  IF ( (zoom_lon(1)+180 < EPSILON(zoom_lon(1))) .AND. (zoom_lon(2)-180 < EPSILON(zoom_lon(2))) .AND.&
+       &(zoom_lat(1)+90 < EPSILON(zoom_lat(1))) .AND. (zoom_lat(2)-90 < EPSILON(zoom_lat(2))) ) THEN
+     !
+     !Config Key   = WEST_EAST
+     !Config Desc  = Longitude interval to use from the forcing data
+     !Config If    = [-]
+     !Config Def   = -180, 180
+     !Config Help  = This function allows to zoom into the forcing data
+     !Config Units = [degrees east] 
+     !- 
+     CALL getin_p('WEST_EAST', zoom_lon)
+     !
+     !Config Key   = SOUTH_NORTH
+     !Config Desc  = Latitude interval to use from the forcing data
+     !Config If    = [-]
+     !Config Def   = -90, 90
+     !Config Help  = This function allows to zoom into the forcing data
+     !Config Units = [degrees north] 
+     !- 
+     CALL getin_p('SOUTH_NORTH', zoom_lat)
+  ENDIF
+  !-
+  !-
+  !- Get some basic variables from the run.def
+  !-
+  atmco2=350.
+  CALL getin_p('ATM_CO2',atmco2)
+  !
+  !====================================================================================
+  !-
+  !-
+  !- Get the grid on all processors.
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Read the grid, only on the root proc. from the forcing file using tools in the globgrd module. 
+  !- The grid is then broadcast to all other broadcast.
+  !
+  nb_forcefile = 0
+  DO ik=1,100
+     IF ( INDEX(forfilename(ik), '.nc') > 0 ) nb_forcefile = nb_forcefile+1
+  ENDDO
+  !
+  IF ( is_root_prc) THEN
+     CALL globgrd_getdomsz(gridfilename, iim_glo, jjm_glo, nbindex_g, model_guess, file_id, forfilename, zoom_lon, zoom_lat)
+     nbseg = 4
+  ENDIF
+  !
+  CALL bcast(iim_glo)
+  CALL bcast(jjm_glo)
+  CALL bcast(nbindex_g)
+  CALL bcast(nbseg)
+  !-
+  !- Allocation of memory
+  !- variables over the entire grid (thus in x,y)
+  ALLOCATE(lon_glo(iim_glo, jjm_glo))
+  ALLOCATE(lat_glo(iim_glo, jjm_glo))
+  ALLOCATE(mask_glo(iim_glo, jjm_glo))
+  ALLOCATE(area_glo(iim_glo, jjm_glo))
+  ALLOCATE(corners_glo(iim_glo, jjm_glo, nbseg, 2))
+  !
+  ! Gathered variables
+  ALLOCATE(kindex_g(nbindex_g))
+  ALLOCATE(contfrac_glo(nbindex_g))
+  !-
+  IF ( is_root_prc) THEN
+     CALL globgrd_getgrid(file_id, iim_glo, jjm_glo, nbindex_g, model_guess, &
+          &               lon_glo, lat_glo, mask_glo, area_glo, corners_glo,&
+          &               kindex_g, contfrac_glo, calendar)
+  ENDIF
+  !
+  CALL bcast(lon_glo)
+  CALL bcast(lat_glo)
+  CALL bcast(mask_glo)
+  CALL bcast(area_glo)
+  CALL bcast(corners_glo)
+  CALL bcast(kindex_g)
+  CALL bcast(contfrac_glo)
+  CALL bcast(calendar)
+  CALL bcast(model_guess)
+  !
+  ALLOCATE(lalo_glo(nbindex_g,2))
+  DO ik=1,nbindex_g
+     !
+     j = ((kindex_g(ik)-1)/iim_glo)+1
+     i = (kindex_g(ik)-(j-1)*iim_glo)
+     !
+     IF ( i > iim_glo .OR. j > jjm_glo ) THEN
+        WRITE(100+mpi_rank,*) "Error in the indexing (ik, kindex, i, j) : ", ik, kindex(ik), i, j
+        STOP "ERROR in orchideedriver"
+     ENDIF
+     !
+     lalo_glo(ik,1) = lat_glo(i,j)
+     lalo_glo(ik,2) = lon_glo(i,j)
+     !
+  ENDDO
+  !
+  WRITE(*,*) "Rank", mpi_rank, " Before parallel region All land points : ",  nbindex_g
+  WRITE(*,*) "Rank", mpi_rank, " from ", iim_glo, " point in Lon. and ", jjm_glo, "in Lat."
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Now that the grid is distributed on all procs we can start
+  !- initialise the ORCHIDEE domain on each proc (longitude, latitude, indices)
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- init_data_para also transfers kindex_g to index_g (the variable used in ORCHIDEE) 
+  !-
+  CALL grid_set_glo(iim_glo, jjm_glo, nbindex_g)
+  CALL grid_allocate_glo(nbseg)
+  ! Copy the list of indexes of land points into index_g used by ORCHIDEE and then broacast to all
+  ! processors
+  CALL bcast(nbindex_g)
+  IF ( is_root_prc) index_g = kindex_g
+  CALL bcast(index_g)
+  !
+  WRITE(numout,*) "Rank", mpi_rank, "Into Init_orchidee_data_para_driver with ", nbindex_g
+  WRITE(numout,*) "Rank", mpi_rank, "Into ", index_g(1), index_g(nbindex_g)
+  !
+  CALL Init_orchidee_data_para_driver(nbindex_g,index_g)
+  CALL init_ioipsl_para 
+  !
+  WRITE(numout,*) "Rank", mpi_rank, "After init_data_para global size : ",  nbp_glo, SIZE(index_g), iim_g, iim_glo, jjm_g, jjm_glo
+  WRITE(numout,'("After init_data_para local : ij_nb, jj_nb",2I4)') iim_glo, jj_nb
+  !
+  ! Allocate grid on the local processor
+  !
+  IF ( model_guess == "regular") THEN
+     CALL grid_init (nbp_loc, nbseg, "RegLonLat", "ForcingGrid")
+  ELSE IF ( model_guess == "WRF") THEN
+     CALL grid_init (nbp_loc, nbseg, "RegXY", "WRFGrid")
+  ELSE
+     CALL ipslerr(3, "orchidedriver", "The grid found in the GRID_FILE is not supported by ORCHIDEE", "", "")
+  ENDIF
+  !
+  !
+  ! Transfer the global grid variables to the ORCHIDEE version on the root proc
+  ! *_glo -> *_g
+  ! Variables *_g were allocated with the CALL init_grid
+  !
+  IF ( is_root_prc) THEN
+     !
+     lalo_g(:,:) = lalo_glo(:,:)
+     lon_g(:,:) = lon_glo(:,:)
+     lat_g(:,:) = lat_glo(:,:)
+     !
+  ENDIF
+  !
+  !
+  ! Set the local dimensions of the fields
+  !
+  iim = iim_glo
+  jjm = jj_nb
+  kjpindex = nbp_loc
+  !
+  WRITE(numout,*) mpi_rank, "DIMENSIONS of grid on processor : iim, jjm, kjpindex = ", iim, jjm, kjpindex
+  !
+  !  Allocate the local arrays we need :
+  !
+  ALLOCATE(lon(iim,jjm), lat(iim,jjm))
+  ALLOCATE(kindex(kjpindex))
+  !
+  lon=lon_glo(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank))
+  lat=lat_glo(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank))
+  !
+  !
+  ! Redistribute the indeces on all procs (apple distribution of land points) 
+  !
+  CALL bcast(lon_g)
+  CALL bcast(lat_g)
+  CALL scatter(index_g, kindex)
+  ! 
+  !
+  ! Apply the offset needed so that kindex refers to the index of the land point 
+  ! on the current region, i.e. the local lon lat domain.
+  !
+  kindex(1:kjpindex)=kindex(1:kjpindex)-(jj_begin-1)*iim_glo
+  !
+  ! This routine transforms the global grid into a series of polygons for all land
+  ! points identified by index_g.
+  !
+  CALL grid_stuff(nbindex_g, iim_g, jjm_g, lon_g, lat_g, index_g, contfrac_glo)
+  !
+  ! Distribute the global lalo to the local processor level lalo
+  !
+  ALLOCATE(lalo_loc(kjpindex,2))
+  CALL scatter(lalo_glo, lalo_loc)
+  lalo(:,:) = lalo_loc(:,:)
+  !
+  !====================================================================================
+  !-
+  !- Prepare the time for the simulation
+  !-
+  !- Set the calendar and get some information
+  !-
+  CALL ioconf_calendar(calendar)
+  CALL ioget_calendar(one_year, one_day)
+  !-
+  !- get the time period for the run
+  !-
+  CALL forcing_integration_time(date0, dt, nbdt)
+  !
+  !
+  !
+  !====================================================================================
+  !-
+  !- Initialize the forcing files and prepare the time stepping through the data.
+  !-
+  !
+  CALL forcing_open(forfilename, iim_glo,  jjm_glo, lon_glo, lat_glo, nbindex_g, zoom_lon, zoom_lat, &
+       &            index_g, kjpindex, numout)
+  !
+  !
+  ALLOCATE(zlev_tq(kjpindex), zlev_uv(kjpindex))
+  ALLOCATE(u(kjpindex), v(kjpindex), pb(kjpindex))
+  ALLOCATE(temp_air(kjpindex))
+  ALLOCATE(qair(kjpindex))
+  ALLOCATE(petAcoef(kjpindex), peqAcoef(kjpindex), petBcoef(kjpindex), peqBcoef(kjpindex))
+  ALLOCATE(ccanopy(kjpindex))
+  ALLOCATE(cdrag(kjpindex))
+  ALLOCATE(precip_rain(kjpindex))
+  ALLOCATE(precip_snow(kjpindex))
+  ALLOCATE(swdown(kjpindex))
+  ALLOCATE(swnet(kjpindex))
+  ALLOCATE(lwdown(kjpindex))
+  ALLOCATE(sinang(kjpindex))
+  ALLOCATE(vevapp(kjpindex))
+  ALLOCATE(fluxsens(kjpindex))
+  ALLOCATE(fluxlat(kjpindex))
+  ALLOCATE(coastalflow(kjpindex))
+  ALLOCATE(riverflow(kjpindex))
+  ALLOCATE(netco2(kjpindex))
+  ALLOCATE(carblu(kjpindex))
+  ALLOCATE(tsol_rad(kjpindex))
+  ALLOCATE(temp_sol_new(kjpindex))
+  ALLOCATE(qsurf(kjpindex))
+  ALLOCATE(albedo(kjpindex,2))
+  ALLOCATE(emis(kjpindex))
+  ALLOCATE(epot_air(kjpindex))
+  ALLOCATE(u_tq(kjpindex), v_tq(kjpindex))
+  ALLOCATE(z0m(kjpindex))
+  ALLOCATE(z0h(kjpindex))
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Get a first set of forcing data
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Some default values so that the operations before the ORCHIDEE initialisation do not fail.
+  !-
+  z0m(:) = 0.1
+  albedo(:,:) = 0.13
+  !-
+  !====================================================================================
+  !-
+  !- Initialise the ORCHIDEE system in 4 steps :
+  !- 1 The control flags,
+  !- 2 the restart system of IOIPSL
+  !- 3 The history mechanism
+  !- 4 Finally the first call to SECHIBA will initialise all the internal variables
+  !
+  CALL control_initialize(dt)
+  ! 
+  itau = 0
+  !
+  CALL ioipslctrl_restini(itau, date0, dt, rest_id, rest_id_stom, itau_offset, date0_shifted)
+
+  WRITE(numout,*) "itau_offset : ", itau_offset, date0, date0_shifted
+  WRITE(numout,*) "itau_offset diff = ", date0_shifted, date0, date0_shifted-date0
+  !
+  ! To ensure that itau starts with 0 at date0 for the restart, we have to set an off-set to achieve this.
+  ! itau_offset will get used to prduce itau_sechiba.
+  !
+  itau_offset=-itau_offset-1
+  !
+  ! Get the date of the first time step
+  !
+  julian = date0 + 0.5*(dt/one_day)
+  CALL ju2ymds (julian, year, month, day, sec)
+  WRITE(*,*) "itau_offset : date0 : ", year, month, day, sec
+  !
+  CALL xios_orchidee_init( MPI_COMM_ORCH,                &
+       date0,    year,    month,           day,          &
+       lon,      lat,     znt)
+  !
+  !- Initialize IOIPSL sechiba output files
+  itau_sechiba = itau+itau_offset
+  CALL ioipslctrl_history(iim, jjm, lon, lat,  kindex, kjpindex, itau_sechiba, &
+       date0, dt, hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC)
+  WRITE(numout,*) "HISTORY : Defined for ", itau_sechiba, date0, dt
+  !
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Go into the time loop
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  DO itau = 1,nbdt
+     !
+     timestep_interval(1) = date0 + (itau-1)*(dt/one_day)
+     timestep_interval(2) = date0 + itau*(dt/one_day)
+     julian = date0 + (itau-0.5)*(dt/one_day)
+     !
+     ! Get the forcing data
+     !
+     CALL forcing_getvalues(timestep_interval, dt, zlev_tq, zlev_uv, temp_air, qair, &
+          &                 precip_rain, precip_snow, swdown, lwdown, sinang, u, v, pb)
+     !-
+     in_julian = itau2date(itau, date0, dt)
+     CALL ju2ymds (julian, year, month, day, sec)
+     CALL ymds2ju (year,1,1,zero, julian0)
+     julian_diff = in_julian-julian0
+     !
+     IF ( itau == nbdt ) lrestart_write = .TRUE.
+     !
+     ! Adaptation of the forcing data to SECHIBA's needs
+     !
+     ! Contrary to what the documentation says, ORCHIDEE expects surface pressure in hPa.
+     pb(:) = pb(:)/100.
+     epot_air(:) = cp_air*temp_air(:)+cte_grav*zlev_tq(:)
+     ccanopy(:) = atmco2
+     cdrag(:) = 0.0
+     !
+     petBcoef(:) = epot_air(:)
+     peqBcoef(:) = qair(:)
+     petAcoef(:) = zero
+     peqAcoef(:) = zero
+     !
+     ! Interpolate the wind (which is at hight zlev_uv) to the same height 
+     ! as the temperature and humidity (at zlev_tq).
+     !
+     u_tq(:) = u(:)*LOG(zlev_tq(:)/z0m(:))/LOG(zlev_uv(:)/z0m(:))
+     v_tq(:) = v(:)*LOG(zlev_tq(:)/z0m(:))/LOG(zlev_uv(:)/z0m(:))
+     !
+     !
+     swnet(:) =(1.-(albedo(:,1)+albedo(:,2))/2.)*swdown(:)
+     !
+     !
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, temp_air, "RECEIVED Air temperature")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, qair, "RECEIVED Air humidity")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, precip_rain*one_day, "RECEIVED Rainfall")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, precip_snow*one_day, "RECEIVED Snowfall")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, swnet, "RECEIVED net solar")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, lwdown, "RECEIVED lwdown")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, u, "RECEIVED East-ward wind")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, v, "RECEIVED North-ward wind")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, pb*100, "RECEIVED surface pressure")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, zlev_uv, "RECEIVED UV height")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, zlev_tq, "RECEIVED TQ height")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, sinang, "RECEIVED sinang")
+     !
+     IF ( itau .NE. 1 ) THEN
+        IF ( timemeasure ) THEN
+           waitget_cputime = waitget_cputime + Get_cpu_Time(timer_global)
+           waitget_walltime = waitget_walltime + Get_real_Time(timer_global)
+           CALL stop_timer(timer_global)
+           CALL start_timer(timer_global)
+        ENDIF
+     ENDIF
+     !
+     !---------------------------------------------------------------------------------------
+     !-
+     !- IF first time step : Call to SECHIBA_initialize to set-up ORCHIDEE before doing an actual call
+     !- which will provide the first fluxes.
+     !-
+     !---------------------------------------------------------------------------------------
+     !
+     itau_sechiba = itau+itau_offset
+     !
+     ! Update the calendar in xios by sending the new time step
+     CALL xios_orchidee_update_calendar(itau_sechiba)
+     !
+     IF ( itau == 1 ) THEN
+        !
+        IF ( timemeasure ) THEN
+           WRITE(numout,*) '------> CPU Time for start-up of main : ',Get_cpu_Time(timer_global)
+           WRITE(numout,*) '------> Real Time for start-up of main : ',Get_real_Time(timer_global)
+           CALL stop_timer(timer_global)
+           CALL start_timer(timer_global)
+        ENDIF
+        !
+        CALL sechiba_initialize( &
+             itau_sechiba,  iim*jjm,     kjpindex,      kindex,                    &
+             lalo_loc,     contfrac,     neighbours,    resolution,  zlev_tq,      &
+             u_tq,         v_tq,         qair,          temp_air,    temp_air,     &
+             petAcoef,     peqAcoef,     petBcoef,      peqBcoef,                  &
+             precip_rain,  precip_snow,  lwdown,        swnet,       swdown,       &
+             pb,           rest_id,      hist_id,       hist2_id,                  &
+             rest_id_stom, hist_id_stom, hist_id_stom_IPCC,                        &
+             coastalflow,  riverflow,    tsol_rad,      vevapp,      qsurf,        &
+             z0m,          z0h,          albedo,        fluxsens,    fluxlat,   emis, &
+             netco2,       carblu,       temp_sol_new,  cdrag,       coszang)
+        CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, temp_sol_new, "Init temp_sol_new")
+        !
+        ! Net solar and the wind at the right hight are recomputed with the correct values.
+        !
+        swnet(:) =(1.-(albedo(:,1)+albedo(:,2))/2.)*swdown(:)
+        u_tq(:) = u(:)*LOG(zlev_tq(:)/z0m(:))/LOG(zlev_uv(:)/z0m(:))
+        v_tq(:) = v(:)*LOG(zlev_tq(:)/z0m(:))/LOG(zlev_uv(:)/z0m(:))
+        !
+        lrestart_read = .FALSE.
+        !
+        CALL histwrite_p(hist_id, 'LandPoints',  itau+1, (/ REAL(kindex) /), kjpindex, kindex)
+        CALL histwrite_p(hist_id, 'Areas',  itau+1, area, kjpindex, kindex)
+        CALL histwrite_p(hist_id, 'Contfrac',  itau+1, contfrac, kjpindex, kindex)
+        !
+        IF ( timemeasure ) THEN
+           WRITE(numout,*) '------> CPU Time for set-up of ORCHIDEE : ',Get_cpu_Time(timer_global)
+           WRITE(numout,*) '------> Real Time for set-up of ORCHIDEE : ',Get_real_Time(timer_global)
+           CALL stop_timer(timer_global)
+           CALL start_timer(timer_global)
+        ENDIF
+        !
+     ENDIF
+     !
+     !---------------------------------------------------------------------------------------
+     !-
+     !- Main call to SECHIBA  
+     !-
+     !---------------------------------------------------------------------------------------
+     !
+     !
+     CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, &
+          & lrestart_read, lrestart_write, &
+          & lalo_loc, contfrac, neighbours, resolution, &
+          ! First level conditions
+          & zlev_tq, u_tq, v_tq, qair, qair, temp_air, 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, sinang, pb, &
+          ! Output : Fluxes
+          & vevapp, fluxsens, fluxlat, coastalflow, riverflow, netco2, carblu, &
+          ! Surface temperatures and surface properties
+          & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m, z0h, &
+          ! File ids
+          & rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC)
+     !
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, temp_sol_new, "Produced temp_sol_new")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, fluxsens, "Produced fluxsens")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, fluxlat, "Produced fluxlat")
+     !
+     IF ( timemeasure ) THEN
+        orchidee_cputime = orchidee_cputime + Get_cpu_Time(timer_global)
+        orchidee_walltime = orchidee_walltime + Get_real_Time(timer_global)
+        CALL stop_timer(timer_global)
+        CALL start_timer(timer_global)
+     ENDIF
+     !
+     !---------------------------------------------------------------------------------------
+     !-
+     !- Write diagnostics
+     !-
+     !---------------------------------------------------------------------------------------
+     !
+     CALL xios_orchidee_send_field("LandPoints" ,(/ ( REAL(ik), ik=1,kjpindex ) /))
+     CALL xios_orchidee_send_field("Areas", area)
+     CALL xios_orchidee_send_field("Contfrac",contfrac)
+     CALL xios_orchidee_send_field("evap",vevapp*one_day/dt_sechiba)
+     CALL xios_orchidee_send_field("evap_alma",vevapp/dt_sechiba)
+     CALL xios_orchidee_send_field("coastalflow",coastalflow/dt_sechiba)
+     CALL xios_orchidee_send_field("riverflow",riverflow/dt_sechiba)
+     CALL xios_orchidee_send_field("temp_sol_C",temp_sol_new-ZeroCelsius)
+     CALL xios_orchidee_send_field("temp_sol_K",temp_sol_new)
+     CALL xios_orchidee_send_field("fluxsens",fluxsens)
+     CALL xios_orchidee_send_field("fluxlat",fluxlat)
+     CALL xios_orchidee_send_field("tair",temp_air)
+     CALL xios_orchidee_send_field("qair",qair)
+     CALL xios_orchidee_send_field("q2m",qair)
+     CALL xios_orchidee_send_field("t2m",temp_air)
+     CALL xios_orchidee_send_field("swnet",swnet)
+     CALL xios_orchidee_send_field("swdown",swdown)
+     ! zpb in hPa, output in Pa
+     CALL xios_orchidee_send_field("Psurf",pb*100.)
+     !
+     IF ( .NOT. almaoutput ) THEN
+        !
+        !  ORCHIDEE INPUT variables
+        !
+        CALL histwrite_p (hist_id, 'swdown',   itau_sechiba, swdown,   kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'tair',     itau_sechiba, temp_air, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'qair',     itau_sechiba, qair, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'evap',     itau_sechiba, vevapp, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, coastalflow, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, riverflow, kjpindex, kindex)
+        ! 
+        CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, temp_sol_new, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, temp_sol_new, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, temp_sol_new, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, fluxsens, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'fluxlat',  itau_sechiba, fluxlat,  kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'swnet',    itau_sechiba, swnet,    kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'alb_vis',  itau_sechiba, albedo(:,1), kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'alb_nir',  itau_sechiba, albedo(:,2), kjpindex, kindex)
+        !
+        IF ( hist2_id > 0 ) THEN
+           CALL histwrite_p (hist2_id, 'swdown',   itau_sechiba, swdown, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'tair',     itau_sechiba, temp_air, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'qair',     itau_sechiba, qair, kjpindex, kindex)
+           !
+           CALL histwrite_p (hist2_id, 'evap',     itau_sechiba, vevapp, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, coastalflow, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, riverflow, kjpindex, kindex)
+           ! 
+           CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, temp_sol_new, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, temp_sol_new, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, temp_sol_new, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, fluxsens, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'fluxlat',  itau_sechiba, fluxlat,  kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'swnet',    itau_sechiba, swnet,    kjpindex, kindex)
+           !
+           CALL histwrite_p (hist2_id, 'alb_vis',  itau_sechiba, albedo(:,1), kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'alb_nir',  itau_sechiba, albedo(:,2), kjpindex, kindex)
+        ENDIF
+     ELSE
+        !
+        ! Input variables
+        !
+        CALL histwrite_p (hist_id, 'SinAng', itau_sechiba, sinang, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'LWdown', itau_sechiba, lwdown, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'SWdown', itau_sechiba, swdown, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'Tair', itau_sechiba, temp_air, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'Qair', itau_sechiba, qair, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'SurfP', itau_sechiba, pb, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'Windu', itau_sechiba, u_tq, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'Windv', itau_sechiba, v_tq, kjpindex, kindex)
+        !
+        CALL histwrite_p (hist_id, 'Evap', itau_sechiba, vevapp, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'SWnet',    itau_sechiba, swnet, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'Qh', itau_sechiba, fluxsens, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'Qle',  itau_sechiba, fluxlat, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, temp_sol_new, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'RadT', itau_sechiba, temp_sol_new, kjpindex, kindex)
+        !
+        ! There is a mess with the units passed to the coupler. To be checked with Marc
+        !
+        IF ( river_routing ) THEN
+           CALL histwrite_p (hist_id, 'CoastalFlow',itau_sechiba, coastalflow, kjpindex, kindex)
+           CALL histwrite_p (hist_id, 'RiverFlow',itau_sechiba, riverflow, kjpindex, kindex)
+        ENDIF
+        !
+        IF ( hist2_id > 0 ) THEN
+           CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, vevapp, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'SWnet',    itau_sechiba, swnet, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, fluxsens, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'Qle',  itau_sechiba, fluxlat, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, temp_sol_new, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, temp_sol_new, kjpindex, kindex)
+        ENDIF
+     ENDIF
+     !
+     !
+  ENDDO
+  !-
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Close eveything
+  !-
+  !--
+  !
+  CALL histclo
+  IF(is_root_prc) THEN
+     CALL restclo
+     CALL getin_dump
+  ENDIF
+
+  !-
+  !- Deallocate all variables and reset initialization variables
+  !-
+  CALL orchideedriver_clear()
+
+  WRITE(numout,*) "End at proc ", mpi_rank
+  !
+  !
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Get time and close IOIPSL, OASIS and MPI
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  IF ( timemeasure ) THEN
+     WRITE(numout,*) '------> Total CPU Time waiting to get forcing : ',waitget_cputime
+     WRITE(numout,*) '------> Total Real Time waiting to get forcing : ',waitget_walltime
+     WRITE(numout,*) '------> Total CPU Time for ORCHIDEE : ', orchidee_cputime
+     WRITE(numout,*) '------> Total Real Time for ORCHIDEE : ', orchidee_walltime
+     WRITE(numout,*) '------> Total CPU Time waiting to put fluxes : ',waitput_cputime
+     WRITE(numout,*) '------> Total Real Time waiting to put fluxes : ',waitput_walltime
+     WRITE(numout,*) '------> Total CPU Time for closing : ',  Get_cpu_Time(timer_global)
+     WRITE(numout,*) '------> Total Real Time for closing : ', Get_real_Time(timer_global)
+     WRITE(numout,*) '------> Total without MPI : CPU Time  : ', Get_cpu_Time(timer_mpi)
+     WRITE(numout,*) '------> Total without MPI : Real Time : ', Get_real_Time(timer_mpi)
+     CALL stop_timer(timer_global)
+     CALL stop_timer(timer_mpi)
+  ENDIF
+  !
+  CALL Finalize_mpi
+  CONTAINS
+    
+!! ================================================================================================================================
+!! SUBROUTINE   : orchideedriver_clear
+!!
+!>\BRIEF          Clear orchideedriver
+!!
+!! DESCRIPTION  : Deallocate memory and reset initialization variables to there original values
+!!                This subroutine calls forcing_tools_clear and sechiba_clear.
+!!
+!_ ================================================================================================================================
+
+     SUBROUTINE orchideedriver_clear
+
+      !- Deallocate all variables existing on all procs
+
+      IF ( ALLOCATED(lon_glo) ) DEALLOCATE(lon_glo)
+      IF ( ALLOCATED(lat_glo) ) DEALLOCATE(lat_glo)
+      IF ( ALLOCATED(mask_glo) ) DEALLOCATE(mask_glo)
+      IF ( ALLOCATED(area_glo) ) DEALLOCATE(area_glo)
+      IF ( ALLOCATED(corners_glo) ) DEALLOCATE(corners_glo)
+      IF ( ALLOCATED(kindex_g) ) DEALLOCATE(kindex_g)
+      IF ( ALLOCATED(contfrac_glo) ) DEALLOCATE(contfrac_glo)
+      IF ( ALLOCATED(lalo_glo) ) DEALLOCATE(lalo_glo)
+      IF ( ALLOCATED(lon) ) DEALLOCATE(lon)
+      IF ( ALLOCATED(lat) ) DEALLOCATE(lat)
+      IF ( ALLOCATED(kindex) ) DEALLOCATE(kindex)
+      IF ( ALLOCATED(lalo_loc) ) DEALLOCATE(lalo_loc)
+      IF ( ALLOCATED(zlev_tq) ) DEALLOCATE(zlev_tq)
+      IF ( ALLOCATED(zlev_uv) ) DEALLOCATE(zlev_uv)
+      IF ( ALLOCATED(u) ) DEALLOCATE(u)
+      IF ( ALLOCATED(v) ) DEALLOCATE(v)
+      IF ( ALLOCATED(pb) ) DEALLOCATE(pb)
+      IF ( ALLOCATED(temp_air) ) DEALLOCATE(temp_air)
+      IF ( ALLOCATED(qair) ) DEALLOCATE(qair)
+      IF ( ALLOCATED(precip_rain) ) DEALLOCATE(precip_rain)
+      IF ( ALLOCATED(precip_snow) ) DEALLOCATE(precip_snow)
+      IF ( ALLOCATED(swdown) ) DEALLOCATE(swdown)
+      IF ( ALLOCATED(swnet) ) DEALLOCATE(swnet)
+      IF ( ALLOCATED(lwdown) ) DEALLOCATE(lwdown)
+      IF ( ALLOCATED(sinang) ) DEALLOCATE(sinang)
+      IF ( ALLOCATED(epot_air) ) DEALLOCATE(epot_air)
+      IF ( ALLOCATED(ccanopy) ) DEALLOCATE(ccanopy)
+      IF ( ALLOCATED(cdrag) ) DEALLOCATE(cdrag)
+      IF ( ALLOCATED(swnet) ) DEALLOCATE(swnet)
+      IF ( ALLOCATED(petAcoef) ) DEALLOCATE(petAcoef)
+      IF ( ALLOCATED(peqAcoef) ) DEALLOCATE(peqAcoef)
+      IF ( ALLOCATED(petBcoef) ) DEALLOCATE(petBcoef)
+      IF ( ALLOCATED(peqBcoef) ) DEALLOCATE(peqBcoef)
+      IF ( ALLOCATED(u_tq) ) DEALLOCATE(u_tq)
+      IF ( ALLOCATED(v_tq) ) DEALLOCATE(v_tq)
+      IF ( ALLOCATED(vevapp) ) DEALLOCATE(vevapp)
+      IF ( ALLOCATED(fluxsens) ) DEALLOCATE(fluxsens)
+      IF ( ALLOCATED(fluxlat) ) DEALLOCATE(fluxlat)
+      IF ( ALLOCATED(coastalflow) ) DEALLOCATE(coastalflow)
+      IF ( ALLOCATED(riverflow) ) DEALLOCATE(riverflow)
+      IF ( ALLOCATED(netco2) ) DEALLOCATE(netco2)
+      IF ( ALLOCATED(carblu) ) DEALLOCATE(carblu)
+      IF ( ALLOCATED(tsol_rad) ) DEALLOCATE(tsol_rad)
+      IF ( ALLOCATED(temp_sol_new) ) DEALLOCATE(temp_sol_new)
+      IF ( ALLOCATED(qsurf) ) DEALLOCATE(qsurf)
+      IF ( ALLOCATED(albedo) ) DEALLOCATE(albedo)
+      IF ( ALLOCATED(emis) ) DEALLOCATE(emis)
+      IF ( ALLOCATED(z0m) ) DEALLOCATE(z0m)
+      
+      ! Deallocate and reset variables in forcing_tools module
+      CALL forcing_tools_clear()
+
+      ! Deallocate and reset variables in sechiba module and underlaying modules
+      CALL sechiba_clear()
+
+      WRITE(numout,*) "Memory deallocated in orchideedriver_clear"
+      
+    END SUBROUTINE orchideedriver_clear
+
+END PROGRAM orchidedriver
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/readdim2.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/readdim2.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/readdim2.f90	(revision 6412)
@@ -0,0 +1,2663 @@
+!  ==============================================================================================================================\n
+!  MODULE 	    : readdim2
+! 
+!  CONTACT          : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE          : IPSL (2006)
+!                     This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF              This module contains subroutines for reading the forcing file for the dim2_driver.
+!!
+!!
+!!\n DESCRIPTION    : This module contains subroutines for reading the forcing file for the dim2_driver.
+!!                    Following subroutines are public and called from dim2_driver :
+!!                    - forcing_info : Open the forcing file and return information about the grid in the forcing file. 
+!!                                     Prepare for a zoom if needed. 
+!!                                     Initialization of parallelization related to the grid. 
+!!                    - forcing_read : Return the forcing data for the current time step of the model. The forcing file will
+!!                                     be read if it has not already been done for the current time-step in the forcing file.
+!!                    - forcing_grid : Calculate the longitudes and latitudes of the model grid.
+!! 
+!! RECENT CHANGE(S) : None 
+!! 
+!! REFERENCE(S)     : None
+!!   
+!! SVN    :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE readdim2
+
+   USE ioipsl_para
+   USE weather
+   USE TIMER
+   USE constantes
+   USE solar
+   USE grid
+   USE mod_orchidee_para
+
+   IMPLICIT NONE
+
+   PRIVATE
+   PUBLIC  :: forcing_read, forcing_info, forcing_grid
+
+   INTEGER, SAVE                            :: iim_full, jjm_full, llm_full, ttm_full
+   INTEGER, SAVE                            :: iim_zoom, jjm_zoom
+   INTEGER, SAVE                            :: iim_g_begin,jjm_g_begin,iim_g_end,jjm_g_end
+   REAL, SAVE, ALLOCATABLE, DIMENSION(:,:)  :: data_full, lon_full, lat_full
+   REAL, SAVE, ALLOCATABLE, DIMENSION(:)    :: lev_full
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: itau, i_index, j_index,j_index_g
+   INTEGER, SAVE                            :: i_test, j_test
+!   INTEGER, SAVE                            :: printlev_loc   !! Local printlev
+   LOGICAL, SAVE                            :: allow_weathergen, interpol, daily_interpol
+   LOGICAL, SAVE, PUBLIC                    :: weathergen, is_watchout
+   REAL, SAVE                               :: merid_res, zonal_res
+   LOGICAL, SAVE                            :: have_zaxis=.FALSE.
+!-
+!- Heigh controls and data 
+!- 
+   LOGICAL, SAVE                            :: zfixed, zsigma, zhybrid, zlevels, zheight 
+   LOGICAL, SAVE                            :: zsamelev_uv 
+   REAL, SAVE                               :: zlev_fixed, zlevuv_fixed 
+   REAL, SAVE                               :: zhybrid_a, zhybrid_b 
+   REAL, SAVE                               :: zhybriduv_a, zhybriduv_b 
+   ! Trying to find a way that calculates solar angle for driver files
+   ! with high resolution (short timesteps).  3600.0 is what the value
+   ! originally was, but I do not know where that came from.  I tried
+   ! 1799.0 for FLUXNET forcing files, which results in a solar angle,
+   ! but it also caused some problems with SWDown values.  Keeping this 
+   ! at 3600 now, and moving it as a parameter up here to make it clear.
+   REAL, PARAMETER                          :: dt_cutoff=3600.0
+
+CONTAINS
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	   : forcing_info
+!!
+!>\BRIEF             Open the forcing file and return information about the grid in the forcing file. 
+!!
+!!\n DESCRIPTION   : This subroutine will get all the information from the forcing file and prepare for the zoom if needed.
+!!                   It returns to the caller the sizes of the data it will receive at the forcing_read call. 
+!!                   This is important so that the caller can allocate the right space.
+!!
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S)	   : 
+!!
+!_ ================================================================================================================================
+  SUBROUTINE forcing_info(filename, iim, jjm, llm, tm, date0, dt_force, force_id)
+
+    IMPLICIT NONE
+
+!! 0.1 Input variables
+    CHARACTER(LEN=*), INTENT(in) :: filename     !! Name of the file to be opened
+
+!! 0.2 Output variables
+    INTEGER, INTENT(out)         :: iim          !! Size in x of the forcing data
+    INTEGER, INTENT(out)         :: jjm          !! Size in y of the forcing data
+    INTEGER, INTENT(out)         :: llm          !! Number of levels in the forcing data (not yet used)
+    INTEGER, INTENT(out)         :: tm           !! Time dimension of the forcing
+    REAL, INTENT(out)            :: date0        !! The date at which the forcing file starts (julian days)
+    REAL, INTENT(out)            :: dt_force     !! Time-step of the forcing file in seconds
+    INTEGER, INTENT(out)         :: force_id     !! Id of the forcing file
+
+!! 0.3 Local variables
+    CHARACTER(LEN=20)                  :: calendar_str
+    CHARACTER(LEN=200)                 :: printstr       !! temporary character string to contain error message 
+    REAL                               :: juld_1, juld_2
+    REAL, ALLOCATABLE, DIMENSION(:,:)  :: fcontfrac
+    REAL, ALLOCATABLE, DIMENSION(:,:)  :: qair
+    LOGICAL                            :: contfrac_exists=.FALSE.
+    INTEGER                            :: NbPoint
+    INTEGER                            :: i_test,j_test
+    INTEGER                            :: i,j,ind,ttm_part
+    INTEGER, ALLOCATABLE, DIMENSION(:) :: index_l
+    REAL, ALLOCATABLE, DIMENSION(:,:)  :: lon, lat
+    REAL, ALLOCATABLE, DIMENSION(:)    :: lev, levuv
+
+    !-
+    CALL flininfo(filename,  iim_full, jjm_full, llm_full, ttm_full, force_id)
+    !-
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'forcing_info : Details from forcing file :', &
+         iim_full, jjm_full, llm_full, ttm_full
+    !-
+    IF ( llm_full < 1 ) THEN
+       have_zaxis = .FALSE.
+    ELSE
+       have_zaxis = .TRUE.
+    ENDIF
+    WRITE(numout,*) 'have_zaxis : ', llm_full, have_zaxis
+    !-
+    ttm_part = 2
+    ALLOCATE(itau(ttm_part))
+    ALLOCATE(data_full(iim_full, jjm_full),lon_full(iim_full, jjm_full),&
+         & lat_full(iim_full, jjm_full))
+    ALLOCATE(lev_full(llm_full))
+    ALLOCATE(fcontfrac(iim_full,jjm_full))
+    !-
+    lev_full(:) = zero
+    !-
+    dt_force=zero
+    CALL flinopen &
+         &  (filename, .FALSE., iim_full, jjm_full, llm_full, lon_full, lat_full, &
+         &   lev_full, ttm_part, itau, date0, dt_force, force_id)
+    IF ( dt_force == zero ) THEN
+       dt_force = itau(2) - itau(1) 
+       itau(:) = itau(:) / dt_force
+    ENDIF
+    !  WRITE(numout,*) "forcing_info : Forcing time step out of flinopen : ",dt_force
+    !-
+    !- What are the alowed options for the temportal interpolation
+    !-
+    !Config Key   = ALLOW_WEATHERGEN
+    !Config Desc  = Allow weather generator to create data
+    !Config If    = [-]
+    !Config Def   = n
+    !Config Help  = This flag allows the forcing-reader to generate
+    !Config         synthetic data if the data in the file is too sparse
+    !Config         and the temporal resolution would not be enough to
+    !Config         run the model.
+    !Config Units = [FLAG]
+    !-
+    allow_weathergen = .FALSE.
+    CALL getin_p('ALLOW_WEATHERGEN',allow_weathergen)
+    !-
+    !- The calendar was set by the forcing file. If no "calendar" attribute was
+    !- found then it is assumed to be gregorian, 
+    !MM => FALSE !! it is NOT assumed anything !
+    !- else it is what ever is written in this attribute.
+    !-
+    CALL ioget_calendar(calendar_str)
+    i=INDEX(calendar_str,ACHAR(0))
+    IF ( i > 0 ) THEN
+       calendar_str(i:20)=' '
+    ENDIF
+    !  WRITE(numout,*) "forcing_info : Calendar used : ",calendar_str
+    IF ( calendar_str == 'XXXX' ) THEN
+       WRITE(numout,*) "forcing_info : The calendar was not found in the forcing file."
+       IF (allow_weathergen) THEN
+          ! Then change the calendar
+          CALL ioconf_calendar("noleap") 
+       ELSE
+          WRITE(numout,*) "forcing_info : We will force it to gregorian by default."
+          CALL ioconf_calendar("gregorian") !! = 365.2425 ; "noleap" = 365.0; "360d"; "julian"=365.25
+       ENDIF
+    ENDIF
+    WRITE(numout,*) "readdim2 : Calendar used by the model : ",calendar_str
+    IF (ttm_full .GE. 2) THEN
+       juld_1 = itau2date(itau(1), date0, dt_force)
+       juld_2 = itau2date(itau(2), date0, dt_force)
+    ELSE
+       juld_1 = 0
+       juld_2 = 0
+       CALL ipslerr_p ( 3, 'forcing_info','What is that only one time step in the forcing file ?', &
+            &         ' That can not be right.','verify forcing file.')
+    ENDIF
+    !-
+    !- Initialize one_year / one_day
+    CALL ioget_calendar (one_year, one_day)
+    !-
+    !- What is the distance between the two first states. From this we will deduce what is
+    !- to be done.
+    weathergen = .FALSE.
+    interpol = .FALSE.
+    daily_interpol = .FALSE.
+    is_watchout = .FALSE.
+    !-
+    IF ( ABS(ABS(juld_2-juld_1)-30.) .LE. 2.) THEN
+       IF ( allow_weathergen ) THEN
+          weathergen = .TRUE.
+          WRITE(numout,*) 'Using weather generator.' 
+       ELSE
+          CALL ipslerr_p ( 3, 'forcing_info', &
+               &         'This seems to be a monthly file.', &
+               &         'We should use a weather generator with this file.', &
+               &         'This should be allowed in the run.def')
+       ENDIF
+    ELSEIF (( ABS(juld_1-juld_2) .LE. 1./4.) .OR. ( ABS(juld_1-juld_2) .EQ. 1.)) THEN
+       interpol = .TRUE.
+       WRITE(numout,*) 'We will interpolate between the forcing data time steps.' 
+       IF ( ABS(juld_1-juld_2) .EQ. 1.) THEN
+          daily_interpol = .TRUE.
+       ENDIF
+    ELSE
+       ! Using the weather generator with data other than monthly ones probably
+       ! needs some thinking.
+       WRITE(numout,*) 'The time step is not suitable:',ABS(juld_1-juld_2),' days.'
+       CALL ipslerr_p ( 3, 'forcing_info','The time step is not suitable.', &
+            &         '','We cannot do anything with these forcing data.')
+    ENDIF
+    !-
+    !- redefine the forcing time step if the weather generator is activated
+    !-
+    IF ( weathergen ) THEN
+       !Config Key   = DT_WEATHGEN
+       !Config Desc  = Calling frequency of weather generator
+       !Config If    = ALLOW_WEATHERGEN
+       !Config Def   = 1800.
+       !Config Help  = Determines how often the weather generator
+       !Config         is called (time step in s). Should be equal
+       !Config         to or larger than Sechiba's time step (say,
+       !Config         up to 6 times Sechiba's time step or so).
+       !Config Units = [seconds]
+       dt_force = 1800.
+       CALL getin_p('DT_WEATHGEN',dt_force)
+    ENDIF
+    !-
+    !- Define the zoom
+    !-
+    !Config Key   = LIMIT_WEST
+    !Config Desc  = Western limit of region
+    !Config If    = [-]
+    !Config Def   = -180.
+    !Config Help  = Western limit of the region we are 
+    !Config         interested in. Between -180 and +180 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees] 
+    !- 
+    limit_west = -180.
+    CALL getin_p('LIMIT_WEST',limit_west)
+    !-
+    !Config Key   = LIMIT_EAST
+    !Config Desc  = Eastern limit of region
+    !Config If    = [-]
+    !Config Def   = 180.
+    !Config Help  = Eastern limit of the region we are
+    !Config         interested in. Between -180 and +180 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees] 
+    !-
+    limit_east = 180.
+    CALL getin_p('LIMIT_EAST',limit_east)
+    !-
+    !Config Key   = LIMIT_NORTH
+    !Config Desc  = Northern limit of region
+    !Config If    = [-]
+    !Config Def   = 90.
+    !Config Help  = Northern limit of the region we are
+    !Config         interested in. Between +90 and -90 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees]
+    !-
+    limit_north = 90.
+    CALL getin_p('LIMIT_NORTH',limit_north)
+    !-
+    !Config Key   = LIMIT_SOUTH
+    !Config Desc  = Southern limit of region
+    !Config If    = [-]
+    !Config Def   = -90.
+    !Config Help  = Southern limit of the region we are
+    !Config         interested in. Between 90 and -90 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees]
+    !-
+    limit_south = -90.
+    CALL getin_p('LIMIT_SOUTH',limit_south)
+    !- 
+    !- Calculate domain size
+    !-
+    IF ( interpol ) THEN
+       !-
+       !- If we use temporal interpolation, then we cannot change the resolution (yet?)
+       !-
+       ALLOCATE(i_index(iim_full), j_index(jjm_full),j_index_g(jjm_full))
+       IF (is_root_prc) THEN
+
+          CALL domain_size (limit_west, limit_east, limit_north, limit_south,&
+               &         iim_full, jjm_full, lon_full, lat_full, iim_zoom, jjm_zoom,&
+               &         i_index, j_index_g)
+
+          j_index(:)=j_index_g(:)
+
+          ALLOCATE(qair(iim_full,jjm_full))
+          CALL flinget_buffer (force_id,'Qair',iim_full, jjm_full, 1, ttm_full,  1, 1, data_full)
+          CALL forcing_zoom(data_full, qair)
+
+          CALL flinquery_var(force_id, 'contfrac', contfrac_exists)
+          IF ( contfrac_exists ) THEN
+             WRITE(numout,*) "contfrac exist in the forcing file."
+             CALL flinget_buffer (force_id,'contfrac',iim_full, jjm_full, 1, ttm_full,  1, 1, data_full)
+             CALL forcing_zoom(data_full, fcontfrac)
+             !WRITE(numout,*) "fcontfrac min/max :",MINVAL(fcontfrac(1:iim_zoom,1:jjm_zoom)),MAXVAL(fcontfrac(1:iim_zoom,1:jjm_zoom))
+          ELSE
+             fcontfrac(:,:)=1.
+          ENDIF
+
+
+          DO i=1,iim_zoom
+             DO j=1,jjm_zoom
+                IF ( fcontfrac(i,j) <= EPSILON(1.) ) THEN
+                   qair(i,j) = 999999.
+                ENDIF
+             ENDDO
+          ENDDO
+
+          ALLOCATE(index_l(iim_zoom*jjm_zoom))
+          !- In this point is returning the global NbPoint with the global index
+          CALL forcing_landind(iim_zoom,jjm_zoom,qair,.TRUE.,NbPoint,index_l,i_test,j_test)
+          ! 
+          ! Work out the vertical layers to be used 
+          ! 
+          CALL forcing_vertical_ioipsl(force_id) 
+       ELSE
+          ALLOCATE(index_l(1))
+       ENDIF
+
+       ! Initiate global grid and parallelism
+       CALL bcast(iim_zoom)
+       CALL bcast(jjm_zoom)
+       CALL bcast(NbPoint)
+       CALL grid_set_glo(iim_zoom,jjm_zoom,NbPoint)
+       CALL grid_allocate_glo(4)
+
+       ! Check consistency in the number of mpi processors and the number of land points
+       ! in order to prevent an exception  
+       IF (NbPoint < mpi_size) THEN 
+          WRITE(printstr,*) 'The number of landpoints found (', NbPoint, &
+               ') is less than the number of processors selected (', mpi_size,')' 
+          CALL ipslerr_p(3, 'forcing_info', 'Wrong parallelization options', &
+               TRIM(printstr), &  
+               'Decrease the number of processors for the current grid') 
+       ENDIF
+       
+       !
+       !- global index index_g is the index_l of root proc 
+       IF (is_root_prc) index_g(:)=index_l(1:NbPoint)
+
+       DEALLOCATE(index_l)
+
+       ! 
+       ! Distribute to all processors the information on the forcing 
+       ! 
+       CALL bcast(index_g)
+       CALL Init_orchidee_data_para_driver(nbp_glo,index_g)
+       CALL init_ioipsl_para
+
+       ! Initialize printlev_loc
+       !printlev_loc=get_printlev('readdim2')
+       WRITE(numout,*) 'In readdim2, : standard PRINTLEV= ', printlev
+       WRITE(numout,*) 'In readdim2, : local PRINTLEV_readdim2= ', printlev_loc
+
+!     CALL Init_writeField_p
+
+       CALL bcast(jjm_zoom)
+       CALL bcast(i_index)
+       CALL bcast(j_index_g)
+       CALL bcast(zfixed) 
+       CALL bcast(zsigma) 
+       CALL bcast(zhybrid) 
+       CALL bcast(zlevels) 
+       CALL bcast(zheight) 
+       CALL bcast(zsamelev_uv) 
+       CALL bcast(zlev_fixed) 
+       CALL bcast(zlevuv_fixed) 
+       CALL bcast(zhybrid_a) 
+       CALL bcast(zhybrid_b) 
+       CALL bcast(zhybriduv_a)  
+       CALL bcast(zhybriduv_b) 
+       ind=0
+       DO j=1,jjm_zoom
+          IF ( (j >= jj_begin) .AND. (j <= jj_end) ) THEN
+             ind=ind+1
+             j_index(ind)=j_index_g(j)
+          ENDIF
+       ENDDO
+
+       jjm_zoom=jj_nb
+       iim_zoom=iim_g
+
+       !-
+       !- If we use the weather generator, then we read zonal and meridional resolutions
+       !- This should be unified one day...
+       !-
+    ELSEIF ( weathergen ) THEN
+       !-
+       !Config Key   = MERID_RES
+       !Config Desc  = North-South Resolution
+       !Config Def   = 2.
+       !Config If    = ALLOW_WEATHERGEN
+       !Config Help  = North-South Resolution of the region we are
+       !Config         interested in. 
+       !Config Units = [Degrees]
+       !-
+       merid_res = 2.
+       CALL getin_p('MERID_RES',merid_res)
+       !-
+       !Config Key   = ZONAL_RES
+       !Config Desc  = East-West Resolution
+       !Config Def   = 2.
+       !Config If    = ALLOW_WEATHERGEN
+       !Config Help  = East-West Resolution of the region we are
+       !Config         interested in. In degrees
+       !Config Units = [Degrees] 
+       !-
+       zonal_res = 2.
+       CALL getin_p('ZONAL_RES',zonal_res)
+       !-
+       !- Number of time steps is meaningless in this case
+       !-
+       !    ttm_full = HUGE( ttm_full )
+       !MM Number (realistic) of time steps for half hour dt
+       ttm_full = NINT(one_year * 86400. / dt_force)
+       !-
+       IF (is_root_prc) THEN
+
+          !- In this point is returning the global NbPoint with the global index
+          CALL weathgen_domain_size (limit_west,limit_east,limit_north,limit_south, &
+               zonal_res,merid_res,iim_zoom,jjm_zoom)
+          ALLOCATE(index_l(iim_zoom*jjm_zoom))
+       ENDIF
+       CALL bcast(iim_zoom)
+       CALL bcast(jjm_zoom)
+
+       ALLOCATE(lon(iim_zoom,jjm_zoom))
+       ALLOCATE(lat(iim_zoom,jjm_zoom))
+       ALLOCATE(lev(llm_full),levuv(llm_full))
+       
+       ! We need lon and lat now for weathgen_init
+       CALL forcing_grid (iim_zoom,jjm_zoom,llm_full,lon,lat,init_f=.TRUE.)
+       CALL forcing_vertical_ioipsl(-1) 
+
+       IF (is_root_prc) THEN
+          CALL weathgen_init &
+               &        (filename,dt_force,force_id,iim_zoom,jjm_zoom, &
+               &         zonal_res,merid_res,lon,lat,index_l,NbPoint)
+!!$,&
+!!$               &         i_index,j_index_g)
+       ELSE
+          ALLOCATE(index_l(1))
+          index_l(1)=1
+       ENDIF
+
+       CALL bcast(NbPoint)
+       CALL grid_set_glo(iim_zoom,jjm_zoom,NbPoint)
+       CALL grid_allocate_glo(4)
+
+       !
+       !- global index index_g is the index_l of root proc 
+       IF (is_root_prc) index_g(:)=index_l(1:NbPoint)
+
+       DEALLOCATE(index_l)
+
+     CALL bcast(index_g)
+     CALL Init_orchidee_data_para_driver(nbp_glo,index_g)
+     CALL init_ioipsl_para
+!     CALL Init_writeField_p
+     CALL bcast(jjm_zoom)
+!!$       CALL bcast(i_index)
+!!$       CALL bcast(j_index_g)
+
+!!$       ind=0
+!!$       DO j=1,jjm_zoom
+!!$          IF ( (j >= jj_begin) .AND. (j <= jj_end) ) THEN
+!!$             ind=ind+1
+!!$             j_index(ind)=j_index_g(j)
+!!$          ENDIF
+!!$       ENDDO
+
+       jjm_zoom=jj_nb
+       iim_zoom=iim_g
+       !
+       CALL weathgen_read_file(force_id,iim_zoom,jjm_zoom)
+
+       !-
+    ELSE
+       !-
+       CALL ipslerr_p(3,'forcing_info','Neither interpolation nor weather generator is specified.','','')
+       !-
+    ENDIF
+    !-
+    !- Transfer the right information to the caller
+    !-
+    iim = iim_zoom
+    jjm = jjm_zoom
+    llm = 1
+    tm = ttm_full
+    !-
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'forcing_info : end : ', iim,jjm, llm,tm
+    !-
+  END SUBROUTINE forcing_info
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	   : forcing_read
+!!
+!>\BRIEF             Return forcing data for the current time step
+!!
+!!\n DESCRIPTION   : Return the forcing data for the current time step of the model. The forcing file will
+!!                   be read if it has not already been done for the current time-step in the forcing file. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S)	   : 
+!!
+!_ ================================================================================================================================
+SUBROUTINE forcing_read &
+  & (filename, rest_id, lrstread, lrstwrite, &
+  &  itauin, istp, itau_split, split, nb_spread, netrad_cons, date0,   &
+  &  dt_force, iim, jjm, lon, lat, zlev, zlevuv, ttm, &
+  &  swdown, coszang, precip, snowf, tair, u, v, qair, pb, lwdown, &
+  &  fcontfrac, fneighbours, fresolution, &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+  &  kindex, nbindex, force_id)
+
+  IMPLICIT NONE
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+   CHARACTER(LEN=*), INTENT(IN) :: filename   !! name of the file to be opened
+   INTEGER, INTENT(IN) :: force_id            !! FLINCOM file id. It is used to close the file at the end of the run.
+   INTEGER, INTENT(IN) :: rest_id             !! ID of restart file
+   LOGICAL, INTENT(IN) :: lrstread            !! read restart file?
+   LOGICAL, INTENT(IN) :: lrstwrite           !! write restart file?
+   INTEGER, INTENT(IN) :: itauin              !! time step for which we need the data
+   INTEGER, INTENT(IN) :: istp                !! time step for restart file
+   INTEGER, INTENT(IN) :: itau_split          !! Current step between 2 forcing times-step (it decides if it is time to read)
+   INTEGER, INTENT(IN) :: split               !! The number of time steps between two time-steps of the forcing
+   INTEGER, INTENT(IN) :: nb_spread           !! Over how many time steps do we spread the precipitation
+   LOGICAL, INTENT(IN) :: netrad_cons         !! flag that decides if net radiation should be conserved
+   REAL, INTENT(IN)    :: date0               !! The date at which the forcing file starts (julian days)
+   REAL, INTENT(IN)    :: dt_force            !! time-step of the forcing file in seconds
+   INTEGER, INTENT(IN) :: iim                 !! Size of the grid in x
+   INTEGER, INTENT(IN) :: jjm                 !! Size of the grid in y
+   INTEGER, INTENT(IN) :: ttm                 !! number of time steps in all in the forcing file
+   REAL,DIMENSION(iim,jjm), INTENT(IN) :: lon !! Longitudes
+   REAL,DIMENSION(iim,jjm), INTENT(IN) :: lat !! Latitudes
+
+    !! 0.2 Output variables
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: zlev        !! First Levels if it exists (ie if watchout file)
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: zlevuv      !! First Levels of the wind (equal precedent, if it exists)
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: swdown      !! Downward solar radiation (W/m^2)
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: coszang     !! Cosine of the solar zenith angle (unitless)
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: precip      !! Precipitation (Rainfall) (kg/m^2s) 
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: snowf       !! Snowfall (kg/m^2s)
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: tair        !! 1st level (2m ? in off-line) air temperature (K)
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: u           !! 1st level (2m/10m ? in off-line) (in theory !) wind speed (m/s)
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: v           !! 1st level (2m/10m ? in off-line) (in theory !) wind speed (m/s)
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: qair        !! 1st level (2m ? in off-line) humidity (kg/kg)
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: pb          !! Surface pressure (Pa)
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: lwdown      !! Downward long wave radiation (W/m^2)
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: fcontfrac   !! Continental fraction (no unit)
+   REAL,DIMENSION(iim,jjm,2), INTENT(OUT) :: fresolution     !! resolution in x and y dimensions for each points
+   INTEGER,DIMENSION(iim,jjm,8), INTENT(OUT) :: fneighbours  !! land neighbours
+
+   !! From a WATCHOUT file :
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: SWnet       !! Net surface short-wave flux
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: Eair        !! Air potential energy
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: petAcoef    !! Coeficients A from the PBL resolution for T
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: peqAcoef    !! Coeficients A from the PBL resolution for q
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: petBcoef    !! Coeficients B from the PBL resolution for T
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: peqBcoef    !! Coeficients B from the PBL resolution for q
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: cdrag       !! Surface drag
+   REAL,DIMENSION(iim,jjm), INTENT(OUT) :: ccanopy     !! CO2 concentration in the canopy
+
+    !! 0.3 Modified variable
+   INTEGER, INTENT(INOUT) :: nbindex                   !! Number of land points
+   INTEGER,DIMENSION(iim*jjm), INTENT(INOUT) :: kindex !! Index of all land-points in the data (used for the gathering)
+
+    !! 0.4 Local variables
+   INTEGER :: ik,i,j
+
+   IF ( interpol ) THEN
+
+     CALL forcing_read_interpol &
+         (filename, itauin, itau_split, split, nb_spread, netrad_cons, date0,   &
+          dt_force, iim, jjm, lon, lat, zlev, zlevuv, ttm, &
+          swdown, coszang, precip, snowf, tair, u, v, qair, pb, lwdown, &
+          fcontfrac, fneighbours, fresolution, &
+          SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+          kindex, nbindex, force_id)
+
+   ELSEIF ( weathergen ) THEN
+
+      IF (lrstread) THEN
+         fcontfrac(:,:) = 1.0
+         WRITE(numout,*) 'contfrac : ', MINVAL(fcontfrac), MAXVAL(fcontfrac)
+      ENDIF
+
+      IF ( (itauin == 0).AND.(itau_split == 0) ) THEN
+         CALL weathgen_main (istp, istp, filename, force_id, iim, jjm, 1, &
+              rest_id, lrstread, lrstwrite, &
+              limit_west, limit_east, limit_north, limit_south, &
+              zonal_res, merid_res, lon, lat, date0, dt_force, &
+              kindex, nbindex, &
+              swdown, precip, snowf, tair, u, v, qair, pb, lwdown)
+      ELSE
+         CALL weathgen_main (itauin, istp, filename, force_id, iim, jjm, 1, &
+              rest_id, lrstread, lrstwrite, &
+              limit_west, limit_east, limit_north, limit_south, &
+              zonal_res, merid_res, lon, lat, date0, dt_force, &
+              kindex, nbindex, &
+              swdown, precip, snowf, tair, u, v, qair, pb, lwdown)
+      ENDIF
+
+      IF ( (itauin == 0).AND.(itau_split == 0) ) THEN
+         !---
+         !--- Allocate grid stuff
+         !---
+         CALL grid_init ( nbindex, 4, "RegLonLat", "ForcingGrid" )
+         !---
+         !--- Compute
+         !---
+         CALL grid_stuff(nbp_glo, iim_g, jjm_g, lon_g, lat_g, index_g)
+         !CALL grid_stuff (nbindex, iim, jjm, lon, lat, kindex)
+         DO ik=1,nbindex
+         
+            j = ((kindex(ik)-1)/iim) + 1
+            i = (kindex(ik) - (j-1)*iim)
+            !-
+            !- Store variable to help describe the grid
+            !- once the points are gathered.
+            !-
+            fneighbours(i,j,:) = neighbours(ik,:)
+            !
+            fresolution(i,j,:) = resolution(ik,:)
+         ENDDO
+      ENDIF
+   ELSE
+
+      CALL ipslerr_p(3,'forcing_read','Neither interpolation nor weather generator is specified.','','')
+
+   ENDIF
+
+   IF (.NOT. is_watchout) THEN
+      ! We have to compute Potential air energy
+      WHERE(tair(:,:) < val_exp) 
+         eair(:,:) = cp_air*tair(:,:)+cte_grav*zlev(:,:)
+      ENDWHERE
+   ENDIF
+
+END SUBROUTINE forcing_read
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	   : forcing_read_interpol
+!!
+!>\BRIEF        
+!!
+!!\n DESCRIPTION   : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S)	   : 
+!!
+!_ ================================================================================================================================
+SUBROUTINE forcing_read_interpol &
+  & (filename, itauin, itau_split, split, nb_spread, netrad_cons, date0,   &
+  &  dt_force, iim, jjm, lon, lat, zlev, zlevuv, ttm, swdown, coszang, rainf, snowf, tair, &
+  &  u, v, qair, pb, lwdown, &
+  &  fcontfrac, fneighbours, fresolution, &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+  &  kindex, nbindex, force_id)
+!---------------------------------------------------------------------
+!- filename   : name of the file to be opened
+!- itauin     : time step for which we need the data
+!- itau_split : Where are we within the splitting
+!-              of the time-steps of the forcing files
+!-              (it decides IF we READ or not)
+!- split      : The number of time steps we do
+!-              between two time-steps of the forcing
+!- nb_spread  : Over how many time steps do we spread the precipitation
+!- netrad_cons: flag that decides if net radiation should be conserved.
+!- date0      : The date at which the forcing file starts (julian days)
+!- dt_force   : time-step of the forcing file in seconds
+!- iim        : Size of the grid in x
+!- jjm        : size of the grid in y
+!- lon        : Longitudes
+!- lat        : Latitudes
+!- zlev       : First Levels if it exists (ie if watchout file)
+!- zlevuv     : First Levels of the wind (equal precedent, if it exists)
+!- ttm        : number of time steps in all in the forcing file
+!- swdown     : Downward solar radiation (W/m^2)
+!- coszang    : Cosine of the solar zenith angle (unitless)
+!- rainf      : Rainfall (kg/m^2s)
+!- snowf      : Snowfall (kg/m^2s)
+!- tair       : 2m air temperature (K)
+!- u and v    : 2m (in theory !) wind speed (m/s)
+!- qair       : 2m humidity (kg/kg)
+!- pb         : Surface pressure (Pa)
+!- lwdown     : Downward long wave radiation (W/m^2)
+!- fcontfrac  : Continental fraction (no unit)
+!- fneighbours: land neighbours
+!- fresolution: resolution in x and y dimensions for each points
+!-
+!- From a WATCHOUT file :
+!- SWnet      : Net surface short-wave flux
+!- Eair       : Air potential energy
+!- petAcoef   : Coeficients A from the PBL resolution for T
+!- peqAcoef   : Coeficients A from the PBL resolution for q
+!- petBcoef   : Coeficients B from the PBL resolution for T
+!- peqBcoef   : Coeficients B from the PBL resolution for q
+!- cdrag      : Surface drag
+!- ccanopy    : CO2 concentration in the canopy
+!- 
+!- kindex     : Index of all land-points in the data
+!-              (used for the gathering)
+!- nbindex    : Number of land points
+!- force_id   : FLINCOM file id.
+!-              It is used to close the file at the end of the run.
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER,PARAMETER :: lm=1
+!-
+!- Input variables
+!-
+   CHARACTER(LEN=*) :: filename
+   INTEGER :: itauin, itau_split, split, nb_spread
+   LOGICAL :: netrad_cons
+   REAL    :: date0, dt_force
+   INTEGER :: iim, jjm, ttm
+   REAL,DIMENSION(:,:),INTENT(IN) :: lon, lat   !- LOCAL data array (size=iim,jjm)
+   INTEGER, INTENT(IN) :: force_id
+!-
+!- Output variables
+!-
+   REAL,DIMENSION(:,:),INTENT(OUT) :: zlev, zlevuv, &  !- LOCAL data array (size=iim,jjm)
+  &  swdown, coszang, rainf, snowf, tair, u, v, qair, pb, lwdown, &
+  &  fcontfrac
+   REAL,DIMENSION(:,:,:),INTENT(OUT) :: fresolution    !- LOCAL data array (size=iim,jjm,2)
+   INTEGER,DIMENSION(:,:,:),INTENT(OUT) :: fneighbours !- LOCAL data array (size=iim,jjm,8)
+   ! for watchout files
+   REAL,DIMENSION(:,:),INTENT(OUT) :: &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy
+   INTEGER,DIMENSION(:),INTENT(INOUT) :: kindex    !- LOCAL index of the map
+   INTEGER, INTENT(INOUT) :: nbindex
+!-
+!- Local variables
+!-
+   INTEGER, SAVE :: last_read=0
+   INTEGER, SAVE :: itau_read, itau_read_nm1=0, itau_read_n=0
+   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:) :: &
+  &  zlev_nm1, zlevuv_nm1, swdown_nm1, rainf_nm1, snowf_nm1, tair_nm1, u_nm1, v_nm1, qair_nm1, & 
+  &  pb_nm1, lwdown_nm1, & 
+  &  zlev_n, zlevuv_n, swdown_n, rainf_n, snowf_n, tair_n, u_n, v_n, qair_n, &
+  &  pb_n, lwdown_n, mean_coszang
+
+   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:) :: &
+  &  startday_n, startday_nm1, daylength_n, daylength_nm1, tmax_n, tmax_nm1, tmin_nm1, tmin_nm2, tmin_n,   &
+  &  qsatta, qsattmin_n, qsattmin_nm1, qmin_n, qmin_nm1, qmax_n, qmax_nm1, qsa
+   REAL,SAVE    :: hour
+
+!  just for grid stuff if the forcing file is a watchout file
+   REAL, ALLOCATABLE, DIMENSION(:,:) :: tmpdata
+   ! variables to be read in watchout files
+   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:) :: &
+  &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+  &  SWnet_n, Eair_n, petAcoef_n, peqAcoef_n, petBcoef_n, peqBcoef_n, cdrag_n, ccanopy_n
+   REAL, SAVE :: julian_for ! Date of the forcing to be read
+   REAL :: julian, ss, rw
+!jur, 
+   REAL, SAVE :: julian0    ! First day of this year
+   INTEGER :: yy, mm, dd, is, i, j, ik
+   REAL(r_std), DIMENSION(2) :: min_resol, max_resol
+   REAL(r_std), DIMENSION(1,1) :: lon_temp  ! Only used in a special case
+!  if Wind_N and Wind_E are in the file (and not just Wind)
+   LOGICAL, SAVE :: wind_N_exists=.FALSE.
+   LOGICAL       :: wind_E_exists=.FALSE.
+   LOGICAL, SAVE :: contfrac_exists=.FALSE.
+   LOGICAL, SAVE :: neighbours_exists=.FALSE.
+   LOGICAL, SAVE :: initialized = .FALSE.
+   LOGICAL :: check=.FALSE.
+!  to bypass FPE problem on integer convertion with missing_value heigher than precision
+   INTEGER, PARAMETER                         :: undef_int = 999999999
+!---------------------------------------------------------------------
+
+   itau_read = MOD((itauin-1),ttm)+1
+
+   IF (check) THEN
+      WRITE(numout,*) &
+           " FORCING READ : itauin, itau_read, itau_split : ",&
+           itauin, itau_read, itau_split
+   ENDIF
+
+!-
+!- This part initializes the reading of the forcing. As you can see
+!- we only go through here if both time steps are zero.
+!- 
+   IF ( (itau_read == 0).AND.(itau_split == 0) ) THEN
+!-
+!- Tests on forcing file type
+     CALL flinquery_var(force_id, 'Wind_N', wind_N_exists)
+     IF ( wind_N_exists ) THEN
+        CALL flinquery_var(force_id, 'Wind_E', wind_E_exists)
+        IF ( .NOT. wind_E_exists ) THEN
+           CALL ipslerr_p(3,'forcing_read_interpol', &
+   &             'Variable Wind_E does not exist in forcing file', &
+   &             'But variable Wind_N exists.','Please, rename Wind_N to Wind;') 
+        ENDIF
+     ENDIF
+     CALL flinquery_var(force_id, 'levels', is_watchout)
+     IF ( is_watchout ) THEN
+        WRITE(numout,*) "Read a Watchout File."
+     ENDIF
+     CALL flinquery_var(force_id, 'contfrac', contfrac_exists)
+!-
+     IF (check) WRITE(numout,*) 'ALLOCATE all the memory needed'
+!-
+     ALLOCATE &
+    &  (swdown_nm1(iim,jjm), rainf_nm1(iim,jjm), snowf_nm1(iim,jjm), &
+    &   tair_nm1(iim,jjm), u_nm1(iim,jjm), v_nm1(iim,jjm), qair_nm1(iim,jjm), &
+    &   pb_nm1(iim,jjm), lwdown_nm1(iim,jjm))
+     ALLOCATE &
+    &  (swdown_n(iim,jjm), rainf_n(iim,jjm), snowf_n(iim,jjm), &
+    &   tair_n(iim,jjm), u_n(iim,jjm), v_n(iim,jjm), qair_n(iim,jjm), &
+    &   pb_n(iim,jjm), lwdown_n(iim,jjm))
+
+     IF(daily_interpol) THEN
+        ALLOCATE &
+       &  (startday_n(iim,jjm), startday_nm1(iim,jjm), daylength_n(iim,jjm), &
+       &   daylength_nm1(iim,jjm), tmax_n(iim,jjm), tmax_nm1(iim,jjm), tmin_n(iim,jjm), &
+       &   tmin_nm1(iim,jjm), tmin_nm2(iim,jjm), qsatta(iim,jjm), qsattmin_n(iim,jjm), qsattmin_nm1(iim,jjm), &
+       &   qmin_n(iim,jjm), qmin_nm1(iim,jjm), qmax_n(iim,jjm), qmax_nm1(iim,jjm), qsa(iim,jjm) )
+     ENDIF
+
+
+     ALLOCATE &
+    &  (zlev_nm1(iim,jjm), zlev_n(iim,jjm), zlevuv_nm1(iim,jjm), zlevuv_n(iim,jjm), &
+    &   SWnet_nm1(iim,jjm), Eair_nm1(iim,jjm), cdrag_nm1(iim,jjm), ccanopy_nm1(iim,jjm), &
+    &   petAcoef_nm1(iim,jjm), peqAcoef_nm1(iim,jjm), petBcoef_nm1(iim,jjm), peqBcoef_nm1(iim,jjm), &
+    &   SWnet_n(iim,jjm), Eair_n(iim,jjm), cdrag_n(iim,jjm), ccanopy_n(iim,jjm), &
+    &   petAcoef_n(iim,jjm), peqAcoef_n(iim,jjm), petBcoef_n(iim,jjm), peqBcoef_n(iim,jjm))
+     ALLOCATE &
+    &  (mean_coszang(iim,jjm))
+!-
+     IF (check) WRITE(numout,*) 'Memory ALLOCATED'
+!-
+!- We need for the driver surface air temperature and humidity before the
+!- the loop starts. Thus we read it here.
+!-     
+     CALL forcing_just_read (iim, jjm, zlev, zlevuv, ttm, 1, 1, &
+          &  swdown, rainf, snowf, tair, &
+          &  u, v, qair, pb, lwdown, &
+          &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+          &  force_id, wind_N_exists, check)
+!----
+
+!-- First in case it's not a watchout file
+     IF ( .NOT. is_watchout ) THEN
+        IF ( contfrac_exists ) THEN
+           WRITE(numout,*) "contfrac exist in the forcing file."
+           CALL flinget_buffer (force_id,'contfrac',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+           CALL forcing_zoom(data_full, fcontfrac)
+           !WRITE(numout,*) "fcontfrac min/max :",MINVAL(fcontfrac(1:iim_zoom,jjm_zoom)),MAXVAL(fcontfrac(1:iim_zoom,jjm_zoom))
+           !
+           ! We need to make sure that when we gather the points we pick all
+           ! the points where contfrac is above 0. Thus we prepare tair for
+           ! subroutine forcing_landind
+           !
+           DO i=1,iim
+              DO j=1,jjm
+                 IF ( j==1 .AND. i<ii_begin) fcontfrac(i,j)=0.     ! bande de recouvrement du scatter2D 
+                 IF ( j==jjm .AND. i>ii_end) fcontfrac(i,j)=0.     ! => on mets les données qu'on veut pas du noeud à missing_value
+                 IF ( fcontfrac(i,j) <= EPSILON(1.) ) THEN
+                    tair(i,j) = 999999.
+                 ENDIF
+              ENDDO
+           ENDDO
+        ELSE
+           fcontfrac(:,:) = 1.0
+        ENDIF
+        !---
+        !--- Create the index table
+        !---
+        !--- This job return a LOCAL kindex
+        CALL forcing_landind(iim, jjm, tair, check, nbindex, kindex, i_test, j_test)
+#ifdef CPP_PARA
+        ! We keep previous function forcing_landind, only to get a valid (i_test,j_test) 
+        ! Force nbindex points for parallel computation
+        nbindex=nbp_loc
+        CALL scatter(index_g,kindex(1:nbindex))
+        kindex(1:nbindex)=kindex(1:nbindex)-(jj_begin-1)*iim_g
+#endif
+        ik=MAX(nbindex/2,1)
+        j_test = (((kindex(ik)-1)/iim) + 1)
+        i_test = (kindex(ik) - (j_test-1)*iim)
+        IF (check) THEN
+           WRITE(numout,*) 'New test point is : ', i_test, j_test
+        ENDIF
+        !---
+        !--- Allocate grid stuff
+        !---
+        CALL grid_init ( nbindex, 4, "RegLonLat", "ForcingGrid" )
+        !---
+        !--- All grid variables
+        !---
+        CALL grid_stuff(nbp_glo, iim_g, jjm_g, lon_g, lat_g, index_g)
+        DO ik=1,nbindex
+           !
+           j = ((kindex(ik)-1)/iim) + 1
+           i = (kindex(ik) - (j-1)*iim)
+           !-
+           !- Store variable to help describe the grid
+           !- once the points are gathered.
+              !-
+           fneighbours(i,j,:) = neighbours(ik,:)
+           !
+           fresolution(i,j,:) = resolution(ik,:)
+        ENDDO
+     ELSE
+!-- Second, in case it is a watchout file
+        ALLOCATE (tmpdata(iim,jjm))
+        tmpdata(:,:) = 0.0
+!--
+        IF ( .NOT. contfrac_exists ) THEN
+           CALL ipslerr_p (3,'forcing_read_interpol', &
+ &          'Could get contfrac variable in a watchout file :',TRIM(filename), &
+ &          '(Problem with file ?)')
+        ENDIF
+        CALL flinget_buffer (force_id,'contfrac',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, fcontfrac)
+        !
+        ! We need to make sure that when we gather the points we pick all
+        ! the points where contfrac is above 0. Thus we prepare tair for
+        ! subroutine forcing_landind
+        !
+        DO i=1,iim
+           DO j=1,jjm
+	      IF ( j==1 .AND. i<ii_begin) fcontfrac(i,j)=0.
+	      IF ( j==jjm .AND. i>ii_end) fcontfrac(i,j)=0.
+              IF ( fcontfrac(i,j) <= EPSILON(1.) ) THEN
+                 tair(i,j) = 999999.
+              ENDIF
+           ENDDO
+        ENDDO
+        !---
+        !--- Create the index table
+        !---
+        !--- This job return a LOCAL kindex
+        CALL forcing_landind(iim, jjm, tair, check, nbindex, kindex, i_test, j_test)
+#ifdef CPP_PARA
+        ! We keep previous function forcing_landind, only to get a valid (i_test,j_test) 
+        ! Force nbindex points for parallel computation
+        nbindex=nbp_loc
+        CALL scatter(index_g,kindex)
+        kindex(:)=kindex(:)-offset
+!        kindex(:)=kindex(:)-(jj_begin-1)*iim_g
+#endif
+        ik=MAX(nbindex/2,1)
+        j_test = (((kindex(ik)-1)/iim) + 1)
+        i_test = (kindex(ik) - (j_test-1)*iim)
+        IF (check) THEN
+           WRITE(numout,*) 'New test point is : ', i_test, j_test
+        ENDIF
+        !---
+        !--- Allocate grid stuff
+        !---
+        CALL grid_init ( nbindex, 4, "RegLonLat", "ForcingGrid" )
+        neighbours(:,:) = -1
+        resolution(:,:) = 0.
+        min_resol(:) = 1.e6
+        max_resol(:) = -1.
+        !---
+        !--- All grid variables
+        !---
+        !-
+        !- Get variables to help describe the grid
+        CALL flinquery_var(force_id, 'neighboursNN', neighbours_exists)
+        IF ( .NOT. neighbours_exists ) THEN
+           CALL ipslerr_p (3,'forcing_read_interpol', &
+ &          'Could get neighbours in a watchout file :',TRIM(filename), &
+ &          '(Problem with file ?)')
+        ELSE
+           WRITE(numout,*) "Watchout file contains neighbours and resolutions."
+        ENDIF
+        !
+        fneighbours(:,:,:) = undef_int
+        !
+        !- once the points are gathered.
+        CALL flinget_buffer (force_id,'neighboursNN',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,1) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursNE',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,2) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursEE',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,3) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursSE',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,4) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursSS',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,5) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursSW',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,6) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursWW',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,7) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursNW',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,8) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        ! now, resolution of the grid
+        CALL flinget_buffer (force_id,'resolutionX',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        fresolution(:,:,1) = tmpdata(:,:)
+        !
+        CALL flinget_buffer (force_id,'resolutionY',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        fresolution(:,:,2) = tmpdata(:,:)
+        !
+        DO ik=1,nbindex
+           !
+           j = ((kindex(ik)-1)/iim) + 1
+           i = (kindex(ik) - (j-1)*iim)
+           !-
+           !- Store variable to help describe the grid
+           !- once the points are gathered.
+           !-
+           neighbours(ik,:) = fneighbours(i,j,:)  
+           !
+           resolution(ik,:) = fresolution(i,j,:)
+           !
+        
+        ENDDO
+        CALL gather(neighbours,neighbours_g)
+        CALL gather(resolution,resolution_g)
+        min_resol(1) = MINVAL(resolution(:,1))
+        min_resol(2) = MAXVAL(resolution(:,2))
+        max_resol(1) = MAXVAL(resolution(:,1))
+        max_resol(2) = MAXVAL(resolution(:,2))
+        !
+        area(:) = resolution(:,1)*resolution(:,2)
+        CALL gather(area,area_g)
+!--
+        DEALLOCATE (tmpdata)
+     ENDIF
+     WRITE(numout,*) 'contfrac : ', MINVAL(fcontfrac), MAXVAL(fcontfrac)
+!---
+   ENDIF
+!---
+   IF (check) THEN
+      WRITE(numout,*) &
+           & 'The dates : ',itau_read,itau_split,itau_read_nm1,itau_read_n
+   ENDIF
+
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+!--- With the use of ORCHIDEE-CN-CAN, the solar angle needs to be provided at every timestep.
+!--- Calculation of the absorption of light in the canopy (and therefore GPP) depends on this angle.
+!--- Previously, the solar angle was not always computer (for example, for driver files
+!--- with timesteps of less than half an hour.  The other problem, though, is that driver file
+!--- time (often local time) does not always match ORCHIDEE time (UTC) for a single site.
+!--- We treat this specific case here.  We may still have problems with daily_interpol, I believe.
+!--- If dt_force is less than dt_cutoff (previously set to 3600), the solar angle will not
+!--- be calculated below.
+   IF ( dt_force .LE. dt_cutoff )  THEN
+
+      ! First, the case we have tested.  The forcing file timestep equals the model timestep.
+      IF(split .EQ. 1)THEN
+         IF(iim .EQ. 1 .AND. jjm .EQ. 1)THEN
+
+            julian_for = itau2date(itau_read-1, date0, dt_force)
+            CALL ju2ymds (julian_for, yy, mm, dd, ss)
+            
+            ! first day of this year
+            CALL ymds2ju (yy,1,1,0.0, julian0)
+            !-----
+            IF (check) THEN
+               WRITE(numout,*) 'Forcing for Julian day ',julian_for,'is read'
+               WRITE(numout,*) 'Date for this day ',yy,' / ',mm,' / ',dd,"  ",ss
+            ENDIF
+            
+            julian = julian_for+dt_force/one_day
+            ! By temporarily setting the longitude to zero degrees, we force UTC.
+            lon_temp(:,:)=0.0_r_std
+            CALL solarang (julian, julian0, iim, jjm, lon_temp, lat, coszang)
+         ELSE
+            CALL ipslerr_p(3,'forcing_read_interpol', &
+                 'The forcing file is high frequency but not a single point!', &
+                 'Not sure how to deal with this in regards to the solar angle.',&
+                 'Continuing may result in points with low or zero GPP.') 
+         ENDIF
+      ELSE
+         CALL ipslerr_p(3,'forcing_read_interpol', &
+              'The forcing file is high frequency but not the same as the model timestep!', &
+              'Not sure how to deal with this in regards to the solar angle.',&
+              'Continuing may result in points with low or zero GPP.') 
+      ENDIF
+   ENDIF
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+!---
+!--- Here we do the work in case only interpolation is needed.
+!---
+   IF ( initialized .AND. interpol ) THEN
+!---
+      IF ( daily_interpol ) THEN
+
+         IF (split > 1) THEN
+            IF ( itau_split <= (split/2.) ) THEN
+               rw = REAL(itau_split+split/2.)/split
+            ELSE 
+               rw = REAL(itau_split-split/2.)/split
+            ENDIF
+         ELSE
+            rw = 1.
+         ENDIF
+
+         IF ((last_read == 0) .OR. ( rw==(1./split)) ) THEN
+   !---
+   !-----   Start or Restart
+            IF (last_read == 0) THEN
+               ! Case of a restart or a shift in the forcing file.
+               IF (itau_read > 1) THEN
+                  itau_read_nm1=itau_read-1
+                  CALL forcing_just_read (iim, jjm, zlev_nm1, zlevuv_nm1, ttm, itau_read_nm1, itau_read_nm1, &
+                       &  swdown_nm1, rainf_nm1, snowf_nm1, tmin_nm1, &
+                       &  u_nm1, v_nm1, qair_nm1, pb_nm1, lwdown_nm1, &
+                       &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+                       &  force_id, wind_N_exists, check)
+                  CALL forcing_just_read_tmax (iim, jjm, ttm, itau_read_nm1, itau_read_nm1, tmax_nm1, force_id )
+               ! Case of a simple start.
+               ELSE 
+                  itau_read_nm1 = un
+                  WRITE(numout,*) "we will use the forcing of the first day to initialize "
+                  CALL forcing_just_read (iim, jjm, zlev_nm1, zlevuv_nm1, ttm, itau_read_nm1, itau_read_nm1, &
+                       &  swdown_nm1, rainf_nm1, snowf_nm1, tmin_nm1, &
+                       &  u_nm1, v_nm1, qair_nm1, pb_nm1, lwdown_nm1, &
+                       &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+                       &  force_id, wind_N_exists, check)
+                  CALL forcing_just_read_tmax (iim, jjm, ttm, itau_read_nm1, itau_read_nm1, tmax_nm1, force_id )
+               ENDIF
+               tmin_nm2(:,:)=tmin_nm1(:,:)
+
+               IF ( dt_force .GT. dt_cutoff )  THEN
+                  mean_coszang(:,:) = 0.0
+                  daylength_n(:,:) = 0.
+                  DO is=1,split
+                     !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+                     julian = julian_for+((is-0.5)/split)*dt_force/one_day
+      !!$               julian = julian_for+(FLOAT(is)/split)*dt_force/one_day
+                     CALL solarang (julian, julian0, iim, jjm, lon*0, lat, coszang)
+                     mean_coszang(:,:) = mean_coszang(:,:)+coszang(:,:)
+                     WHERE( coszang(:,:) > 0. ) 
+                        daylength_n(:,:)=daylength_n(:,:)+1./split*24
+                     ENDWHERE
+                  ENDDO
+                  mean_coszang(:,:) = mean_coszang(:,:)/split
+                  daylength_nm1(:,:)=daylength_n(:,:)
+      !            WRITE(*,*) "mean_coszang =",MAXVAL(mean_coszang)
+               ENDIF
+            ELSE
+   !-----   Normal mode : copy old step
+               swdown_nm1(:,:) = swdown_n(:,:)
+               rainf_nm1(:,:) = rainf_n(:,:)
+               snowf_nm1(:,:)  = snowf_n(:,:) 
+               tair_nm1(:,:)   = tair_n(:,:)
+               u_nm1(:,:)      = u_n(:,:)
+               v_nm1(:,:)      = v_n(:,:)
+               qair_nm1(:,:)   = qair_n(:,:)
+               pb_nm1(:,:)     = pb_n(:,:)
+               lwdown_nm1(:,:) = lwdown_n(:,:)
+               tmin_nm2(:,:)   = tmin_nm1(:,:)
+               tmin_nm1(:,:)   = tmin_n(:,:)
+               tmax_nm1(:,:)   = tmax_n(:,:)
+
+               IF (is_watchout) THEN
+                  zlev_nm1(:,:)   = zlev_n(:,:)
+                  zlevuv_nm1(:,:) = zlevuv_n(:,:)
+                  ! Net surface short-wave flux
+                  SWnet_nm1(:,:) = SWnet_n(:,:)
+                  ! Air potential energy
+                  Eair_nm1(:,:)   = Eair_n(:,:)
+                  ! Coeficients A from the PBL resolution for T
+                  petAcoef_nm1(:,:) = petAcoef_n(:,:)
+                  ! Coeficients A from the PBL resolution for q
+                  peqAcoef_nm1(:,:) = peqAcoef_n(:,:)
+                  ! Coeficients B from the PBL resolution for T
+                  petBcoef_nm1(:,:) = petBcoef_n(:,:)
+                  ! Coeficients B from the PBL resolution for q
+                  peqBcoef_nm1(:,:) = peqBcoef_n(:,:)
+                  ! Surface drag
+                  cdrag_nm1(:,:) = cdrag_n(:,:)
+                  ! CO2 concentration in the canopy
+                  ccanopy_nm1(:,:) = ccanopy_n(:,:)
+               ENDIF
+               itau_read_nm1 = itau_read_n
+            ENDIF
+   !-----
+   !-----
+            IF(last_read==0)THEN
+               itau_read_n = itau_read
+            ELSE
+               itau_read_n = itau_read+1
+            ENDIF
+
+            IF (itau_read_n > ttm) THEN
+               WRITE(numout,*) 'WARNING --WARNING --WARNING --WARNING '
+               WRITE(numout,*) &
+                    &  'WARNING : We are going back to the start of the file'
+               itau_read_n =1
+            ENDIF
+            IF (check) THEN
+               WRITE(numout,*) &
+                    & 'The dates 2 : ',itau_read,itau_split,itau_read_nm1,itau_read_n
+            ENDIF
+   !-----
+   !----- Get a reduced julian day !
+   !----- This is needed because we lack the precision on 32 bit machines.
+   !-----
+
+            IF ( dt_force .GT. dt_cutoff ) THEN
+               julian_for = itau2date(itau_read-1, date0, dt_force)
+               CALL ju2ymds (julian_for, yy, mm, dd, ss)
+   
+               ! first day of this year
+               CALL ymds2ju (yy,1,1,0.0, julian0)
+   !-----
+               IF (check) THEN
+                  WRITE(numout,*) 'Forcing for Julian day ',julian_for,'is read'
+                  WRITE(numout,*) 'Date for this day ',yy,' / ',mm,' / ',dd,"  ",ss
+               ENDIF
+            ENDIF
+   !-----
+            CALL forcing_just_read (iim, jjm, zlev_n, zlevuv_n, ttm, itau_read_n, itau_read_n, &
+                 &  swdown_n, rainf_n, snowf_n, tmin_n, &
+                 &  u_n, v_n, qair_n, pb_n, lwdown_n, &
+                 &  SWnet_n, Eair_n, petAcoef_n, peqAcoef_n, petBcoef_n, peqBcoef_n, cdrag_n, ccanopy_n, &
+                 &  force_id, wind_N_exists, check)
+            CALL forcing_just_read_tmax (iim, jjm, ttm, itau_read_n, itau_read_n, tmax_n, force_id )
+
+   !---
+            last_read = itau_read_n
+   !-----
+   !----- Compute mean solar angle for the comming period
+   !-----
+            IF (check) WRITE(numout,*) 'Going into  solarang', split, one_day
+   !-----
+
+   !-----
+         ENDIF
+   !---
+         IF ( itau_split == 1. ) THEN
+
+            IF ( dt_force .GT. dt_cutoff ) THEN
+               mean_coszang(:,:) = 0.0
+               daylength_nm1(:,:)=daylength_n(:,:)
+               daylength_n(:,:) = 0.
+               DO is=1,split
+                  !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+                  julian = julian_for+((is-0.5)/split)*dt_force/one_day
+   !!$               julian = julian_for+(FLOAT(is)/split)*dt_force/one_day
+                  CALL solarang (julian, julian0, iim, jjm, lon*0, lat, coszang)
+                  mean_coszang(:,:) = mean_coszang(:,:)+coszang(:,:)
+                  WHERE( coszang(:,:) > 0. ) 
+                     daylength_n(:,:)=daylength_n(:,:)+1./split*24
+                  ENDWHERE
+               ENDDO
+               mean_coszang(:,:) = mean_coszang(:,:)/split
+   !            WRITE(*,*) "mean_coszang =",MAXVAL(mean_coszang)
+            ENDIF
+         ENDIF
+ 
+   !--- Do the interpolation
+         IF (check) WRITE(numout,*) 'Doing the interpolation between time steps'
+   !---
+
+         IF (check) WRITE(numout,*) 'Coeff of interpollation : ',rw
+   !---
+
+         pb(:,:) = (pb_n(:,:)-pb_nm1(:,:))*rw + pb_nm1(:,:)
+         u(:,:)  = (u_n(:,:)-u_nm1(:,:))*rw + u_nm1(:,:)
+         v(:,:)  = (v_n(:,:)-v_nm1(:,:))*rw + v_nm1(:,:)
+
+   !--- Take care of the height of the vertical levels 
+         zlev(:,:) = (zlev_n(:,:)-zlev_nm1(:,:))*rw + zlev_nm1(:,:) 
+         zlevuv(:,:) = (zlevuv_n(:,:)-zlevuv_nm1(:,:))*rw + zlevuv_nm1(:,:) 
+
+         hour=REAL(itau_split)/split*24
+         startday_n(:,:)=12.-daylength_n(:,:)/2.
+         startday_nm1(:,:)=12.-daylength_nm1(:,:)/2.
+
+         WHERE ( ( hour >= startday_n(:,:) ) .AND. ( hour > 12) .AND. ( hour <= 14) )
+            tair(:,:)=(tmax_nm1(:,:)-tmin_nm1(:,:))/2 * ( sin(pi/(14-startday_n(:,:))*(hour-0.5* &
+           &    (14.-startday_n(:,:))-startday_n(:,:))) )+ (tmax_nm1(:,:)+tmin_nm1(:,:))/2.
+         ELSEWHERE( ( hour >= startday_n(:,:) ) .AND. ( hour <= 12) )
+            tair(:,:)=(tmax_n(:,:)-tmin_n(:,:))/2 * ( sin(pi/(14-startday_n(:,:))*(hour-0.5* &
+           &    (14.-startday_n(:,:))-startday_n(:,:))) )+ (tmax_n(:,:)+tmin_n(:,:))/2.
+         ELSEWHERE ( hour < startday_n(:,:) )
+            tair(:,:)=(tmax_nm1(:,:)-tmin_n(:,:))/2.*sin(pi/(24.-14.+startday_nm1(:,:) )* &
+           &    (hour + 24.+0.5*(24.-14.+startday_nm1(:,:) )-14.))+(tmax_nm1(:,:)+tmin_n(:,:))/2.
+         ELSEWHERE
+            tair(:,:)=(tmax_nm1(:,:)-tmin_n(:,:))/2.*sin(pi/(24.-14.+startday_n(:,:))*(hour+0.5* &
+           &    (24.-14.+startday_n(:,:))-14.))+(tmax_nm1(:,:)+tmin_n(:,:))/2.
+         ENDWHERE
+
+         CALL weathgen_qsat_2d (iim,jjm,tmin_n,pb,qsattmin_n)
+         CALL weathgen_qsat_2d (iim,jjm,tmin_nm1,pb,qsattmin_nm1)
+         CALL weathgen_qsat_2d (iim,jjm,tair,pb,qsatta)
+
+         !---
+         qmin_nm1(:,:) = MIN(qair_nm1(:,:),0.99*qsattmin_nm1(:,:))
+         qmin_n(:,:) = MIN(qair_n(:,:),0.99*qsattmin_n(:,:))
+         qmax_nm1(:,:) = (qair_nm1(:,:)-qmin_nm1(:,:)) + qair_nm1(:,:)
+         qmax_n(:,:) = (qair_n(:,:)-qmin_n(:,:)) + qair_n(:,:)
+
+         qsa(:,:)  = 0.99*qsatta(:,:)
+
+
+         WHERE ( ( hour >= startday_n(:,:) ) .AND. ( hour > 12) .AND. ( hour <= 14) )
+            qair(:,:)=MIN(qsa(:,:),(qmax_nm1(:,:)-qmin_nm1(:,:))/2 * ( sin(pi/(14-startday_n(:,:))*(hour-0.5* &
+           &    (14.-startday_n(:,:))-startday_n(:,:))) )+ (qmax_nm1(:,:)+qmin_nm1(:,:))/2.)
+         ELSEWHERE( ( hour >= startday_n(:,:) ) .AND. ( hour <= 12) )
+            qair(:,:)=MIN(qsa(:,:),(qmax_n(:,:)-qmin_n(:,:))/2 * ( sin(pi/(14-startday_n(:,:))*(hour-0.5* &
+           &    (14.-startday_n(:,:))-startday_n(:,:))) )+ (qmax_n(:,:)+qmin_n(:,:))/2.)
+         ELSEWHERE ( hour < startday_n(:,:) )
+            qair(:,:)=MIN(qsa(:,:),(qmax_nm1(:,:)-qmin_n(:,:))/2.*sin(pi/(24.-14.+startday_nm1(:,:) )* &
+           &    (hour + 24.+0.5*(24.-14.+startday_nm1(:,:) )-14.))+(qmax_nm1(:,:)+qmin_n(:,:))/2.)
+         ELSEWHERE
+            qair(:,:)=MIN(qsa(:,:),(qmax_nm1(:,:)-qmin_n(:,:))/2.*sin(pi/(24.-14.+startday_n(:,:))*(hour+0.5* &
+           &    (24.-14.+startday_n(:,:))-14.))+(qmax_nm1(:,:)+qmin_n(:,:))/2.)
+         ENDWHERE
+
+         IF (is_watchout) THEN
+            SWnet(:,:) = (SWnet_n(:,:)-SWnet_nm1(:,:))*rw + SWnet_nm1(:,:)
+            Eair(:,:) = (Eair_n(:,:)-Eair_nm1(:,:))*rw + Eair_nm1(:,:)
+            petAcoef(:,:) = (petAcoef_n(:,:)-petAcoef_nm1(:,:))*rw + petAcoef_nm1(:,:)
+            peqAcoef(:,:) = (peqAcoef_n(:,:)-peqAcoef_nm1(:,:))*rw + peqAcoef_nm1(:,:)
+            petBcoef(:,:) = (petBcoef_n(:,:)-petBcoef_nm1(:,:))*rw + petBcoef_nm1(:,:)
+            peqBcoef(:,:) = (peqBcoef_n(:,:)-peqBcoef_nm1(:,:))*rw + peqBcoef_nm1(:,:)
+            cdrag(:,:) = (cdrag_n(:,:)-cdrag_nm1(:,:))*rw + cdrag_nm1(:,:)
+            ccanopy(:,:) = (ccanopy_n(:,:)-ccanopy_nm1(:,:))*rw + ccanopy_nm1(:,:)
+         ENDIF
+   !---
+   !--- Here we need to allow for an option
+   !--- where radiative energy is conserved
+   !---
+         IF ( netrad_cons ) THEN
+            lwdown(:,:) = lwdown_n(:,:)
+         ELSE
+            lwdown(:,:) = (lwdown_n(:,:)-lwdown_nm1(:,:))*rw + lwdown_nm1(:,:)
+         ENDIF
+   !---
+   !--- For the solar radiation we decompose the mean value
+   !--- using the zenith angle of the sun if the time step in the forcing data is 
+   !---- more than an hour. Else we use the standard linera interpolation
+   !----
+         IF (check) WRITE(numout,*) 'Ready to deal with the solar radiation'
+   !----
+
+         IF ( dt_force .GT. dt_cutoff ) THEN
+   !---
+            IF ( netrad_cons ) THEN
+               WRITE(numout,*) 'Solar radiation can not be conserved with a timestep of ', dt_force
+            ENDIF
+   !---
+            !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+            julian = julian_for + (itau_split-0.5)/split*dt_force/one_day
+   !!$         julian = julian_for + rw*dt_force/one_day
+            IF (check) THEN
+               WRITE(numout,'(a,f20.10,2I3)') &
+                    &  'JULIAN BEFORE SOLARANG : ',julian,itau_split,split
+            ENDIF
+   !---
+            CALL solarang(julian, julian0, iim, jjm, lon*0, lat, coszang)
+   !---
+            
+            WHERE ((mean_coszang(:,:) > 0.) .AND. (hour <= 12 ))
+               swdown(:,:) = swdown_n(:,:) *coszang(:,:)/mean_coszang(:,:)
+            ELSEWHERE ((mean_coszang(:,:) > 0.) .AND. (hour > 12 ))
+               swdown(:,:) = swdown_nm1(:,:) *coszang(:,:)/mean_coszang(:,:)
+            ELSEWHERE
+               swdown(:,:) = 0.0
+            END WHERE
+   !---
+            WHERE (swdown(:,:) > 2000. )
+               swdown(:,:) = 2000.
+            END WHERE
+   !---
+         ELSE
+   !---
+            IF ( netrad_cons ) THEN
+               swdown(:,:) = swdown_n(:,:)
+            ELSE
+               swdown(:,:) = (swdown_n(:,:)-swdown_nm1(:,:))*rw + swdown_nm1(:,:)
+            ENDIF
+   !---
+         ENDIF
+   !---
+         IF (check) THEN
+            WRITE(numout,*) '__ Forcing read at ',itau_split,' :',i_test, j_test
+            WRITE(numout,*) 'SWdown  : ',swdown_nm1(i_test, j_test), &
+                 &           ' < ', swdown(i_test, j_test), ' < ', swdown_n(i_test, j_test)
+            IF (is_watchout) THEN
+               WRITE(numout,*) 'SWnet  : ',swnet_nm1(i_test, j_test), &
+                    &           ' < ', swnet(i_test, j_test), ' < ', swnet_n(i_test, j_test)
+               WRITE(numout,*) 'levels  :',zlev_nm1(i_test, j_test), &
+                    &           ' < ', zlev(i_test, j_test), ' < ', zlev_n(i_test, j_test)
+               WRITE(numout,*) 'EAIR  :',Eair_nm1(i_test, j_test), &
+                    &           ' < ', eair(i_test, j_test), ' < ', Eair_n(i_test, j_test)
+            ENDIF
+            WRITE(numout,*) 'TAIR  :',tair_nm1(i_test, j_test), &
+                 &           ' < ', tair(i_test, j_test), ' < ', tair_n(i_test, j_test)
+            WRITE(numout,*) 'QAIR  :',qair_nm1(i_test, j_test), &
+                 &           ' < ', qair(i_test, j_test), ' < ', qair_n(i_test, j_test)
+            WRITE(numout,*) 'U  :',u_nm1(i_test, j_test), &
+                 &           ' < ', u(i_test, j_test), ' < ', u_n(i_test, j_test)
+            WRITE(numout,*) 'V  :',v_nm1(i_test, j_test), &
+                 &           ' < ', v(i_test, j_test), ' < ', v_n(i_test, j_test)
+         ENDIF
+   !---
+   !--- For precip we suppose that the rain
+   !--- is the sum over the next 6 hours
+   !---
+         WHERE ((itau_split <= nb_spread).AND.(hour<=12).AND.(tair(:,:)>=273.15)) 
+            rainf(:,:) = rainf_n(:,:) *(split/REAL(nb_spread))
+            snowf(:,:) = 0.0
+         ELSEWHERE ((itau_split <= nb_spread).AND.(hour<=12).AND.(tair(:,:)<273.15)) 
+            snowf(:,:) = rainf_n(:,:) *(split/REAL(nb_spread))
+            rainf(:,:) = 0.0
+         ELSEWHERE ((itau_split <= nb_spread).AND.(hour>12).AND.(tair(:,:)>=273.15)) 
+            rainf(:,:) = rainf_nm1(:,:) *(split/REAL(nb_spread))
+            snowf(:,:) = 0.0
+         ELSEWHERE ((itau_split <= nb_spread).AND.(hour>12).AND.(tair(:,:)<273.15)) 
+            snowf(:,:) = rainf_nm1(:,:) *(split/REAL(nb_spread))
+            rainf(:,:) = 0.0
+         ELSEWHERE
+            snowf(:,:) = 0.0
+            rainf(:,:) = 0.0
+         ENDWHERE
+
+         IF (check) THEN
+            WRITE(numout,*) '__ Forcing read at ',itau_split,' :'
+            WRITE(numout,*) 'Rainf  : ',rainf_nm1(i_test, j_test), &
+                 &           ' < ', rainf(i_test, j_test), ' < ', rainf_n(i_test, j_test)
+            WRITE(numout,*) 'Snowf  : ',snowf_nm1(i_test, j_test), &
+                 &           ' < ', snowf(i_test, j_test), ' < ', snowf_n(i_test, j_test)
+         ENDIF
+   !---
+
+
+      ELSE
+      
+         IF (itau_read /= last_read) THEN
+   !---
+   !-----   Start or Restart
+            IF (itau_read_n == 0) THEN
+               ! Case of a restart or a shift in the forcing file.
+               IF (itau_read > 1) THEN
+                  itau_read_nm1=itau_read-1
+                  CALL forcing_just_read (iim, jjm, zlev_nm1, zlevuv_nm1, ttm, itau_read_nm1, itau_read_nm1, &
+                       &  swdown_nm1, rainf_nm1, snowf_nm1, tair_nm1, &
+                       &  u_nm1, v_nm1, qair_nm1, pb_nm1, lwdown_nm1, &
+                       &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+                       &  force_id, wind_N_exists, check)
+               ! Case of a simple start.
+               ELSE IF (dt_force*ttm > one_day-1. ) THEN
+                  ! if the forcing file contains at least 24 hours, 
+                  ! we will use the last forcing step of the first day
+                  ! as initiale condition to prevent first shift off reading.
+                  itau_read_nm1 = NINT (one_day/dt_force)
+                  WRITE(numout,*) "the forcing file contains 24 hours :",dt_force*ttm,one_day-1.
+                  WRITE(numout,*) "we will use the last forcing step of the first day : itau_read_nm1 ",itau_read_nm1
+                  CALL forcing_just_read (iim, jjm, zlev_nm1, zlevuv_nm1, ttm, itau_read_nm1, itau_read_nm1, &
+                       &  swdown_nm1, rainf_nm1, snowf_nm1, tair_nm1, &
+                       &  u_nm1, v_nm1, qair_nm1, pb_nm1, lwdown_nm1, &
+                       &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+                       &  force_id, wind_N_exists, check)
+               ELSE
+                  ! if the forcing file contains less than 24 hours, 
+                  ! just say error !
+                  CALL ipslerr_p(3,'forcing_read_interpol', &
+      &             'The forcing file contains less than 24 hours !', &
+      &             'We can''t intialize interpolation with such a file.','') 
+               ENDIF
+            ELSE
+   !-----   Normal mode : copy old step
+               swdown_nm1(:,:) = swdown_n(:,:)
+               rainf_nm1(:,:) = rainf_n(:,:)
+               snowf_nm1(:,:)  = snowf_n(:,:) 
+               tair_nm1(:,:)   = tair_n(:,:)
+               u_nm1(:,:)      = u_n(:,:)
+               v_nm1(:,:)      = v_n(:,:)
+               qair_nm1(:,:)   = qair_n(:,:)
+               pb_nm1(:,:)     = pb_n(:,:)
+               lwdown_nm1(:,:) = lwdown_n(:,:)
+               IF (is_watchout) THEN
+                  zlev_nm1(:,:)   = zlev_n(:,:)
+                  ! Net surface short-wave flux
+                  SWnet_nm1(:,:) = SWnet_n(:,:)
+                  ! Air potential energy
+                  Eair_nm1(:,:)   = Eair_n(:,:)
+                  ! Coeficients A from the PBL resolution for T
+                  petAcoef_nm1(:,:) = petAcoef_n(:,:)
+                  ! Coeficients A from the PBL resolution for q
+                  peqAcoef_nm1(:,:) = peqAcoef_n(:,:)
+                  ! Coeficients B from the PBL resolution for T
+                  petBcoef_nm1(:,:) = petBcoef_n(:,:)
+                  ! Coeficients B from the PBL resolution for q
+                  peqBcoef_nm1(:,:) = peqBcoef_n(:,:)
+                  ! Surface drag
+                  cdrag_nm1(:,:) = cdrag_n(:,:)
+                  ! CO2 concentration in the canopy
+                  ccanopy_nm1(:,:) = ccanopy_n(:,:)
+               ENDIF
+               itau_read_nm1 = itau_read_n
+            ENDIF
+   !-----
+            itau_read_n = itau_read
+            IF (itau_read_n > ttm) THEN
+               WRITE(numout,*) 'WARNING --WARNING --WARNING --WARNING '
+               WRITE(numout,*) &
+                    &  'WARNING : We are going back to the start of the file'
+               itau_read_n =1
+            ENDIF
+            IF (check) THEN
+               WRITE(numout,*) &
+                    & 'The dates 2 : ',itau_read,itau_split,itau_read_nm1,itau_read_n
+            ENDIF
+   !-----
+   !----- Get a reduced julian day !
+   !----- This is needed because we lack the precision on 32 bit machines.
+   !-----
+
+            IF ( dt_force .GT. dt_cutoff ) THEN
+               julian_for = itau2date(itau_read-1, date0, dt_force)
+               CALL ju2ymds (julian_for, yy, mm, dd, ss)
+   
+               ! first day of this year
+               CALL ymds2ju (yy,1,1,0.0, julian0)
+   !-----
+               IF (check) THEN
+                  WRITE(numout,*) 'Forcing for Julian day ',julian_for,'is read'
+                  WRITE(numout,*) 'Date for this day ',yy,' / ',mm,' / ',dd,"  ",ss
+               ENDIF
+            ENDIF
+   !-----
+            CALL forcing_just_read (iim, jjm, zlev_n, zlevuv_n, ttm, itau_read_n, itau_read_n, &
+                 &  swdown_n, rainf_n, snowf_n, tair_n, &
+                 &  u_n, v_n, qair_n, pb_n, lwdown_n, &
+                 &  SWnet_n, Eair_n, petAcoef_n, peqAcoef_n, petBcoef_n, peqBcoef_n, cdrag_n, ccanopy_n, &
+                 &  force_id, wind_N_exists, check)
+   !---
+            last_read = itau_read_n
+   !-----
+   !----- Compute mean solar angle for the comming period
+   !-----
+            IF (check) WRITE(numout,*) 'Going into  solarang', split, one_day
+   !-----
+
+            IF ( dt_force .GT. dt_cutoff ) THEN
+               mean_coszang(:,:) = 0.0
+               DO is=1,split
+                  !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+                  julian = julian_for+((is-0.5)/split)*dt_force/one_day
+   !!$               julian = julian_for+(FLOAT(is)/split)*dt_force/one_day
+                  CALL solarang (julian, julian0, iim, jjm, lon, lat, coszang)
+                  mean_coszang(:,:) = mean_coszang(:,:)+coszang(:,:)
+               ENDDO
+               mean_coszang(:,:) = mean_coszang(:,:)/split
+   !            WRITE(*,*) "mean_coszang =",MAXVAL(mean_coszang)
+            ENDIF
+   !-----
+         ENDIF
+   !---
+   !--- Do the interpolation
+         IF (check) WRITE(numout,*) 'Doing the interpolation between time steps'
+   !---
+         IF (split > 1) THEN
+            rw = REAL(itau_split)/split
+         ELSE
+            rw = 1.
+         ENDIF
+         IF (check) WRITE(numout,*) 'Coeff of interpollation : ',rw
+   !---
+         qair(:,:) = (qair_n(:,:)-qair_nm1(:,:))*rw + qair_nm1(:,:)
+         tair(:,:) = (tair_n(:,:)-tair_nm1(:,:))*rw + tair_nm1(:,:)
+         pb(:,:) = (pb_n(:,:)-pb_nm1(:,:))*rw + pb_nm1(:,:)
+         u(:,:)  = (u_n(:,:)-u_nm1(:,:))*rw + u_nm1(:,:)
+         v(:,:)  = (v_n(:,:)-v_nm1(:,:))*rw + v_nm1(:,:)
+         IF (is_watchout) THEN
+            zlev(:,:) = (zlev_n(:,:)-zlev_nm1(:,:))*rw + zlev_nm1(:,:)
+            zlevuv(:,:) = zlev(:,:)
+            SWnet(:,:) = (SWnet_n(:,:)-SWnet_nm1(:,:))*rw + SWnet_nm1(:,:)
+            Eair(:,:) = (Eair_n(:,:)-Eair_nm1(:,:))*rw + Eair_nm1(:,:)
+            petAcoef(:,:) = (petAcoef_n(:,:)-petAcoef_nm1(:,:))*rw + petAcoef_nm1(:,:)
+            peqAcoef(:,:) = (peqAcoef_n(:,:)-peqAcoef_nm1(:,:))*rw + peqAcoef_nm1(:,:)
+            petBcoef(:,:) = (petBcoef_n(:,:)-petBcoef_nm1(:,:))*rw + petBcoef_nm1(:,:)
+            peqBcoef(:,:) = (peqBcoef_n(:,:)-peqBcoef_nm1(:,:))*rw + peqBcoef_nm1(:,:)
+            cdrag(:,:) = (cdrag_n(:,:)-cdrag_nm1(:,:))*rw + cdrag_nm1(:,:)
+            ccanopy(:,:) = (ccanopy_n(:,:)-ccanopy_nm1(:,:))*rw + ccanopy_nm1(:,:)
+         ENDIF
+   !---
+   !--- Here we need to allow for an option
+   !--- where radiative energy is conserved
+   !---
+         IF ( netrad_cons ) THEN
+            lwdown(:,:) = lwdown_n(:,:)
+         ELSE
+            lwdown(:,:) = (lwdown_n(:,:)-lwdown_nm1(:,:))*rw + lwdown_nm1(:,:)
+         ENDIF
+   !---
+   !--- For the solar radiation we decompose the mean value
+   !--- using the zenith angle of the sun if the time step in the forcing data is 
+   !---- more than an hour. Else we use the standard linera interpolation
+   !----
+         IF (check) WRITE(numout,*) 'Ready to deal with the solar radiation'
+   !----
+         IF ( dt_force .GT. dt_cutoff ) THEN
+   !---
+            IF ( netrad_cons ) THEN
+               WRITE(numout,*) 'Solar radiation can not be conserved with a timestep of ', dt_force
+            ENDIF
+   !---
+            !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+            julian = julian_for + (itau_split-0.5)/split*dt_force/one_day
+   !!$         julian = julian_for + rw*dt_force/one_day
+            IF (check) THEN
+               WRITE(numout,'(a,f20.10,2I3)') &
+                    &  'JULIAN BEFORE SOLARANG : ',julian,itau_split,split
+            ENDIF
+   !---
+            CALL solarang(julian, julian0, iim, jjm, lon, lat, coszang)
+   !---
+            WHERE (mean_coszang(:,:) > 0.)
+               swdown(:,:) = swdown_n(:,:) *coszang(:,:)/mean_coszang(:,:)
+            ELSEWHERE
+               swdown(:,:) = 0.0
+            END WHERE
+   !---
+            WHERE (swdown(:,:) > 2000. )
+               swdown(:,:) = 2000.
+            END WHERE
+   !---
+         ELSE
+   !---
+            IF ( netrad_cons ) THEN
+               swdown(:,:) = swdown_n(:,:)
+            ELSE
+               swdown(:,:) = (swdown_n(:,:)-swdown_nm1(:,:))*rw + swdown_nm1(:,:)
+            ENDIF
+   !---
+         ENDIF
+   !---
+         IF (check) THEN
+            WRITE(numout,*) '__ Forcing read at ',itau_split,' :',i_test, j_test
+            WRITE(numout,*) 'SWdown  : ',swdown_nm1(i_test, j_test), &
+                 &           ' < ', swdown(i_test, j_test), ' < ', swdown_n(i_test, j_test)
+            IF (is_watchout) THEN
+               WRITE(numout,*) 'SWnet  : ',swnet_nm1(i_test, j_test), &
+                    &           ' < ', swnet(i_test, j_test), ' < ', swnet_n(i_test, j_test)
+               WRITE(numout,*) 'levels  :',zlev_nm1(i_test, j_test), &
+                    &           ' < ', zlev(i_test, j_test), ' < ', zlev_n(i_test, j_test)
+               WRITE(numout,*) 'EAIR  :',Eair_nm1(i_test, j_test), &
+                    &           ' < ', eair(i_test, j_test), ' < ', Eair_n(i_test, j_test)
+            ENDIF
+            WRITE(numout,*) 'TAIR  :',tair_nm1(i_test, j_test), &
+                 &           ' < ', tair(i_test, j_test), ' < ', tair_n(i_test, j_test)
+            WRITE(numout,*) 'QAIR  :',qair_nm1(i_test, j_test), &
+                 &           ' < ', qair(i_test, j_test), ' < ', qair_n(i_test, j_test)
+            WRITE(numout,*) 'U  :',u_nm1(i_test, j_test), &
+                 &           ' < ', u(i_test, j_test), ' < ', u_n(i_test, j_test)
+            WRITE(numout,*) 'V  :',v_nm1(i_test, j_test), &
+                 &           ' < ', v(i_test, j_test), ' < ', v_n(i_test, j_test)
+         ENDIF
+   !---
+   !--- For precip we suppose that the rain
+   !--- is the sum over the next 6 hours
+   !---
+         IF (itau_split <= nb_spread) THEN
+            rainf(:,:) = rainf_n(:,:)*(split/REAL(nb_spread))
+            snowf(:,:) = snowf_n(:,:)*(split/REAL(nb_spread))
+         ELSE
+            rainf(:,:) = 0.0
+            snowf(:,:) = 0.0
+         ENDIF
+         IF (check) THEN
+            WRITE(numout,*) '__ Forcing read at ',itau_split,' :'
+            WRITE(numout,*) 'Rainf  : ',rainf_nm1(i_test, j_test), &
+                 &           ' < ', rainf(i_test, j_test), ' < ', rainf_n(i_test, j_test)
+            WRITE(numout,*) 'Snowf  : ',snowf_nm1(i_test, j_test), &
+                 &           ' < ', snowf(i_test, j_test), ' < ', snowf_n(i_test, j_test)
+         ENDIF
+   !---
+      ENDIF ! (daily_interpol)
+   ENDIF
+!---
+!--- Here we might put the call to the weather generator ... one day.
+!--- Pour le moment, le branchement entre interpolation et generateur de temps 
+!--- est fait au-dessus.
+!---
+!-   IF ( initialized .AND. weathergen ) THEN
+!-      ....
+!-   ENDIF
+!---
+!--- At this point the code should be initialized. If not we have a problem !
+!---
+   IF ( (itau_read == 0).AND.(itau_split == 0) ) THEN
+!---
+      initialized = .TRUE.
+!---
+   ELSE
+      IF ( .NOT. initialized ) THEN
+         WRITE(numout,*) 'Why is the code forcing_read not initialized ?'
+         WRITE(numout,*) 'Have you called it with both time-steps set to zero ?'
+         CALL ipslerr_p(3,'forcing_read_interpol','Pb in initialization','','')
+      ENDIF
+   ENDIF
+
+END SUBROUTINE forcing_read_interpol
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	   : forcing_just_read
+!!
+!>\BRIEF        
+!!
+!!\n DESCRIPTION   : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S)	   : 
+!!
+!_ ================================================================================================================================
+SUBROUTINE forcing_just_read &
+  & (iim, jjm, zlev, zlev_uv, ttm, itb, ite, &
+  &  swdown, rainf, snowf, tair, &
+  &  u, v, qair, pb, lwdown, &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+  &  force_id, wind_N_exists, check)
+!---------------------------------------------------------------------
+!- iim        : Size of the grid in x
+!- jjm        : size of the grid in y
+!- zlev       : height of the varibales T and Q 
+!- zlev_uv    : height of the varibales U and V 
+!- ttm        : number of time steps in all in the forcing file
+!- itb, ite   : index of respectively begin and end of read for each variable
+!- swdown     : Downward solar radiation (W/m^2)
+!- rainf      : Rainfall (kg/m^2s)
+!- snowf      : Snowfall (kg/m^2s)
+!- tair       : 2m air temperature (K)
+!- u and v    : 2m (in theory !) wind speed (m/s)
+!- qair       : 2m humidity (kg/kg)
+!- pb         : Surface pressure (Pa)
+!- lwdown     : Downward long wave radiation (W/m^2)
+!-
+!- From a WATCHOUT file :
+!- SWnet      : Net surface short-wave flux
+!- Eair       : Air potential energy
+!- petAcoef   : Coeficients A from the PBL resolution for T
+!- peqAcoef   : Coeficients A from the PBL resolution for q
+!- petBcoef   : Coeficients B from the PBL resolution for T
+!- peqBcoef   : Coeficients B from the PBL resolution for q
+!- cdrag      : Surface drag
+!- ccanopy    : CO2 concentration in the canopy
+!- force_id   : FLINCOM file id.
+!-              It is used to close the file at the end of the run.
+!- wind_N_exists : if Wind_N and Wind_E are in the file (and not just Wind)
+!- check      : Prompt for reading
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER, INTENT(in) :: iim, jjm, ttm
+   INTEGER, INTENT(in) :: itb, ite
+   REAL, DIMENSION(iim,jjm), INTENT(out) ::  zlev, zlev_uv, &
+  &  swdown, rainf, snowf, tair, u, v, qair, pb, lwdown
+   ! for watchout files
+   REAL, DIMENSION(iim,jjm), INTENT(out) :: &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy
+   INTEGER, INTENT(in) :: force_id
+!  if Wind_N and Wind_E are in the file (and not just Wind)
+   LOGICAL, INTENT(in) :: wind_N_exists
+   LOGICAL :: check
+   INTEGER :: i, j 
+   REAL :: rau 
+
+!-
+!---------------------------------------------------------------------
+   IF ( daily_interpol ) THEN
+      CALL flinget_buffer (force_id,'Tmin'  , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, tair)
+      CALL flinget_buffer (force_id,'precip' , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, rainf)
+   ELSE
+      CALL flinget_buffer (force_id,'Tair'  , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, tair)
+      CALL flinget_buffer (force_id,'Snowf' , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, snowf)
+      CALL flinget_buffer (force_id,'Rainf' , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, rainf)
+   ENDIF
+
+
+   CALL flinget_buffer (force_id,'SWdown', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, swdown)
+   CALL flinget_buffer (force_id,'LWdown', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, lwdown)
+
+   CALL flinget_buffer (force_id,'PSurf' , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, pb)
+   CALL flinget_buffer (force_id,'Qair'  , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, qair)
+!---
+   IF ( wind_N_exists ) THEN
+      CALL flinget_buffer (force_id,'Wind_N', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, u)
+      CALL flinget_buffer (force_id,'Wind_E', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, v)
+   ELSE
+      CALL flinget_buffer (force_id,'Wind',   iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, u)
+      v=0.0
+   ENDIF
+
+!- 
+!- Deal with the height of the atmospheric forcing varibles 
+!- 
+!---- 
+   IF ( zheight ) THEN 
+      zlev(:,:) = zlev_fixed 
+   ELSE IF ( zsigma .OR. zhybrid ) THEN 
+      DO i=1,iim 
+         DO j=1,jjm 
+            IF ( tair(i,j) < val_exp ) THEN 
+               rau = pb(i,j)/(cte_molr*tair(i,j)) 
+ 	  	 
+               zlev(i,j) =  (pb(i,j) - (zhybrid_a + zhybrid_b*pb(i,j)))/(rau * cte_grav) 
+            ELSE 
+               zlev(i,j) = 0.0 
+            ENDIF
+         ENDDO
+      ENDDO
+   ELSE IF ( zlevels ) THEN 
+      CALL flinget_buffer (force_id,'Levels', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full) 
+      CALL forcing_zoom(data_full, zlev) 
+   ELSE 
+      CALL ipslerr(3, 'forcing_just_read','No case for the vertical levels was specified.', & 
+           &         'We cannot determine the height for T and Q.','stop readdim2') 
+   ENDIF
+   
+   IF ( zsamelev_uv ) THEN 
+      zlev_uv(:,:) = zlev(:,:) 
+   ELSE 
+      IF ( zheight ) THEN 
+         zlev_uv(:,:) = zlevuv_fixed 
+      ELSE IF ( zsigma .OR. zhybrid ) THEN 
+         DO i=1,iim 
+            DO j=1,jjm 
+               IF ( tair(i,j) < val_exp ) THEN 
+                  rau = pb(i,j)/(cte_molr*tair(i,j)) 
+                  
+                  zlev_uv(i,j) =  (pb(i,j) - (zhybriduv_a + zhybriduv_b*pb(i,j)))/(rau * cte_grav) 
+               ELSE 
+                  zlev_uv(i,j) = 0.0 
+               ENDIF
+            ENDDO
+         ENDDO
+      ELSE IF ( zlevels ) THEN 
+         CALL flinget_buffer (force_id,'Levels_uv', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full) 
+         CALL forcing_zoom(data_full, zlev_uv) 
+      ELSE 
+         CALL ipslerr(3, 'forcing_just_read','No case for the vertical levels was specified.', & 
+              &         'We cannot determine the height for U and V.','stop readdim2') 
+      ENDIF
+   ENDIF
+   !----
+   IF ( is_watchout ) THEN
+      CALL flinget_buffer (force_id,'levels', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, zlev)
+      ! 
+      ! If we are in WATHCOUT it means T,Q are at the same height as U,V 
+      ! 
+      zlev_uv(:,:) = zlev(:,:) 
+      ! Net surface short-wave flux
+      CALL flinget_buffer (force_id,'SWnet', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, SWnet)
+      ! Air potential energy
+      CALL flinget_buffer (force_id,'Eair', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, Eair)
+      ! Coeficients A from the PBL resolution for T
+      CALL flinget_buffer (force_id,'petAcoef', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, petAcoef)
+      ! Coeficients A from the PBL resolution for q
+      CALL flinget_buffer (force_id,'peqAcoef', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, peqAcoef)
+      ! Coeficients B from the PBL resolution for T
+      CALL flinget_buffer (force_id,'petBcoef', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, petBcoef)
+      ! Coeficients B from the PBL resolution for q
+      CALL flinget_buffer (force_id,'peqBcoef', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, peqBcoef)
+      ! Surface drag
+      CALL flinget_buffer (force_id,'cdrag', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, cdrag)
+      ! CO2 concentration in the canopy
+      CALL flinget_buffer (force_id,'ccanopy', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, ccanopy)
+   ENDIF
+!
+!----
+     IF (check) WRITE(numout,*) 'Variables have been extracted between ',itb,' and ',ite,' iterations of the forcing file.'
+!-------------------------
+END SUBROUTINE forcing_just_read
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	   : forcing_just_read_tmax
+!!
+!>\BRIEF        
+!!
+!!\n DESCRIPTION   : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S)	   : 
+!!
+!_ ================================================================================================================================
+SUBROUTINE forcing_just_read_tmax &
+  & (iim, jjm, ttm, itb, ite, tmax, force_id )
+!---------------------------------------------------------------------
+!- iim        : Size of the grid in x
+!- jjm        : size of the grid in y
+!- ttm        : number of time steps in all in the forcing file
+!- itb, ite   : index of respectively begin and end of read for each variable
+!- tmax       : 2m air temperature (K)
+!- force_id   : FLINCOM file id.
+!-              It is used to close the file at the end of the run.
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER, INTENT(in) :: iim, jjm, ttm
+   INTEGER, INTENT(in) :: itb, ite
+   REAL, DIMENSION(iim,jjm), INTENT(out) ::  tmax
+   INTEGER, INTENT(in) :: force_id
+!-
+!---------------------------------------------------------------------
+   CALL flinget_buffer (force_id,'Tmax'  , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, tmax)
+!-------------------------
+END SUBROUTINE forcing_just_read_tmax
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	   : forcing_landind
+!!
+!>\BRIEF        
+!!
+!!\n DESCRIPTION   : This subroutine finds the indices of the land points over which the land
+!!                   surface scheme is going to run.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S)	   : 
+!!
+!_ ================================================================================================================================
+SUBROUTINE forcing_landind(iim, jjm, tair, check, nbindex, kindex, i_test, j_test)
+!---
+!--- 
+!---
+  IMPLICIT NONE
+!-
+!- ARGUMENTS
+!-
+  INTEGER, INTENT(IN) :: iim, jjm
+  REAL, INTENT(IN)    :: tair(iim,jjm)
+  INTEGER, INTENT(OUT) :: i_test, j_test, nbindex
+  INTEGER, INTENT(OUT) :: kindex(iim*jjm)
+  LOGICAL :: check
+!-
+!- LOCAL
+  INTEGER :: i, j, ig
+!-
+!-
+  ig = 0
+  i_test = 0
+  j_test = 0
+!---
+  IF (MINVAL(tair(:,:)) < 100.) THEN
+!----- In this case the 2m temperature is in Celsius
+     DO j=1,jjm
+        DO i=1,iim
+           IF (tair(i,j) < 100.) THEN
+              ig = ig+1
+              kindex(ig) = (j-1)*iim+i
+              !
+              !  Here we find at random a land-point on which we can do
+              !  some printouts for test.
+              !
+              IF (ig .GT. (iim*jjm)/2 .AND. i_test .LT. 1) THEN
+                 i_test = i
+                 j_test = j
+                 IF (check) THEN
+                    WRITE(numout,*) 'The test point chosen for output is : ', i_test, j_test
+                 ENDIF
+              ENDIF
+           ENDIF
+        ENDDO
+     ENDDO
+  ELSE 
+!----- 2m temperature is in Kelvin
+     DO j=1,jjm
+        DO i=1,iim
+           IF (tair(i,j) < 500.) THEN
+              ig = ig+1
+              kindex(ig) = (j-1)*iim+i
+              !
+              !  Here we find at random a land-point on which we can do
+              !  some printouts for test.
+              !
+              IF (ig .GT. (iim*jjm)/2 .AND. i_test .LT. 1) THEN
+                 i_test = i
+                 j_test = j
+                 IF (check) THEN
+                    WRITE(numout,*) 'The test point chosen for output is : ', i_test, j_test
+                 ENDIF
+              ENDIF
+           ENDIF
+        ENDDO
+     ENDDO
+  ENDIF
+
+  nbindex = ig
+
+END SUBROUTINE forcing_landind
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	   : forcing_grid
+!!
+!>\BRIEF        
+!!
+!!\n DESCRIPTION   : This subroutine calculates the longitudes and latitudes of the model grid.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S)	   : 
+!!
+!_ ================================================================================================================================
+SUBROUTINE forcing_grid(iim,jjm,llm,lon,lat,init_f)
+
+  IMPLICIT NONE
+
+  INTEGER, INTENT(in)                   :: iim, jjm, llm
+  LOGICAL, INTENT(in)                   :: init_f
+  REAL, DIMENSION(iim,jjm), INTENT(out) :: lon, lat
+!-
+  INTEGER :: i,j
+!-
+!- Should be unified one day
+!-
+  IF ( printlev_loc>=3 ) WRITE(numout,*) 'forcing_grid : options : ', weathergen, interpol
+!-
+  IF ( weathergen ) THEN
+     IF (init_f) THEN
+        DO i = 1, iim
+           lon(i,:) = limit_west + merid_res/2. + &
+                FLOAT(i-1)*(limit_east-limit_west)/FLOAT(iim)
+        ENDDO
+        !-
+        DO j = 1, jjm
+           lat(:,j) = limit_north - zonal_res/2. - &
+                FLOAT(j-1)*(limit_north-limit_south)/FLOAT(jjm)
+        ENDDO
+     ELSE
+        IF (is_root_prc) THEN
+           DO i = 1, iim_g
+              lon_g(i,:) = limit_west + merid_res/2. + &
+                   FLOAT(i-1)*(limit_east-limit_west)/FLOAT(iim_g)
+           ENDDO
+           !-
+           DO j = 1, jjm_g
+              lat_g(:,j) = limit_north - zonal_res/2. - &
+                   FLOAT(j-1)*(limit_north-limit_south)/FLOAT(jjm_g)
+           ENDDO
+        ENDIF
+        CALL bcast(lon_g)
+        CALL bcast(lat_g)
+        lon=lon_g(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank))
+        lat=lat_g(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank))
+     ENDIF
+!-
+  ELSEIF ( interpol ) THEN
+!-
+    CALL forcing_zoom(lon_full, lon)
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'forcing_grid : out of zoom on lon'
+    CALL forcing_zoom(lat_full, lat)
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'forcing_grid : out of zoom on lat'
+ 
+ ELSE 
+    CALL ipslerr_p(3,'forcing_grid','Neither interpolation nor weather generator is specified.','','')
+ ENDIF
+ 
+ IF ( printlev_loc>=3 ) WRITE(numout,*) 'forcing_grid : ended'
+ 
+END SUBROUTINE forcing_grid
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	   : forcing_zoom
+!!
+!>\BRIEF             This subroutine extracts the region of data over which we wish to run the model.
+!!
+!!\n DESCRIPTION   : This subroutine extracts the region of data over which we wish to run the model.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S)	   : 
+!!
+!_ ================================================================================================================================
+SUBROUTINE forcing_zoom(x_f, x_z)
+
+  IMPLICIT NONE
+!-
+  REAL, DIMENSION(iim_full, jjm_full), INTENT(IN) :: x_f
+  REAL, DIMENSION(iim_zoom, jjm_zoom), INTENT(OUT) :: x_z
+  INTEGER :: i,j
+!-
+  DO i=1,iim_zoom
+     DO j=1,jjm_zoom
+        x_z(i,j) = x_f(i_index(i),j_index(j))
+     ENDDO
+  ENDDO
+!-
+END SUBROUTINE forcing_zoom
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	   : forcing_vertical_ioipsl
+!!
+!>\BRIEF        
+!!
+!!\n DESCRIPTION   : This subroutine explores the forcing file to decide what information is available
+!!                   on the vertical coordinate.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S)	   : 
+!!
+!_ ================================================================================================================================
+SUBROUTINE forcing_vertical_ioipsl(force_id)
+
+  INTEGER, INTENT(IN) :: force_id
+
+  LOGICAL :: var_exists, vara_exists, varb_exists, varuv_exists
+  LOGICAL :: foundvar
+  LOGICAL :: levlegacy
+
+  !
+  !- Set all the defaults
+  !
+  zfixed=.FALSE.
+  zsigma=.FALSE.
+  zhybrid=.FALSE.
+  zlevels=.FALSE.
+  zheight=.FALSE.
+  zsamelev_uv = .TRUE.
+  levlegacy = .FALSE.
+  !
+  foundvar = .FALSE.
+  !
+  !- We have a forcing file to explore so let us see if we find any of the conventions
+  !- which allow us to find the height of T,Q,U and V.
+  !
+  IF ( force_id > 0 ) THEN
+     !
+     ! Case for sigma levels
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'Sigma', var_exists)
+        CALL flinquery_var(force_id, 'Sigma_uv', varuv_exists)
+        IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zsigma = .TRUE.
+           IF ( varuv_exists ) zsamelev_uv = .FALSE.
+        ENDIF
+     ENDIF
+     !
+     ! Case for Hybrid levels
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'HybSigA', vara_exists)
+        IF ( vara_exists ) THEN
+           CALL flinquery_var(force_id, 'HybSigB', varb_exists)
+           IF ( varb_exists ) THEN
+              var_exists=.TRUE.
+           ELSE
+              CALL ipslerr ( 3, 'forcing_vertical_ioipsl','Missing the B coefficient for', &
+                   &         'Hybrid vertical levels for T and Q','stop readdim2')
+           ENDIF
+        ENDIF
+        CALL flinquery_var(force_id, 'HybSigA_uv', vara_exists)
+        IF ( vara_exists ) THEN
+           CALL flinquery_var(force_id, 'HybSigB_uv', varb_exists)
+           IF ( varb_exists ) THEN
+              varuv_exists=.TRUE.
+           ELSE
+              CALL ipslerr ( 3, 'forcing_vertical_ioipsl','Missing the B coefficient for', &
+                   &         'Hybrid vertical levels for U and V','stop readdim2')
+           ENDIF
+        ENDIF
+        IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zhybrid = .TRUE.
+           IF ( varuv_exists ) zsamelev_uv = .FALSE.
+        ENDIF
+     ENDIF
+     !
+     ! Case for levels (i.e. a 2d time varying field with the height in meters)
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'Levels', var_exists)
+        CALL flinquery_var(force_id, 'Levels_uv', varuv_exists)
+        IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zlevels = .TRUE.
+           IF ( varuv_exists ) zsamelev_uv = .FALSE.
+        ENDIF
+     ENDIF
+     !
+     ! Case where a fixed height is provided in meters
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'Height_Lev1', var_exists)
+        CALL flinquery_var(force_id, 'Height_Levuv', varuv_exists)
+       IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zheight = .TRUE.
+           IF ( varuv_exists ) zsamelev_uv = .FALSE.
+        ENDIF
+     ENDIF
+     !
+     ! Case where a fixed height is provided in meters in the lev variable
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'lev', var_exists)
+        IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zheight = .TRUE.
+           levlegacy = .TRUE.
+        ENDIF
+     ENDIF
+     !
+  ENDIF
+  !
+  ! We found forcing variables so we need to extract the values if we are dealing with constant values (i.e. all
+  ! except the case zlevels
+  !
+  IF ( foundvar .AND. .NOT. zlevels ) THEN
+     !
+     IF ( zheight ) THEN
+        !
+        ! Constant height
+        !
+        IF ( levlegacy ) THEN
+           CALL flinget (force_id,'lev',1, 1, 1, 1,  1, 1, zlev_fixed)
+        ELSE
+           CALL flinget (force_id,'Height_Lev1',1, 1, 1, 1,  1, 1, zlev_fixed)
+           IF ( .NOT. zsamelev_uv ) THEN
+              CALL flinget (force_id,'Height_Levuv',1, 1, 1, 1,  1, 1, zlevuv_fixed)
+           ENDIF
+        ENDIF
+        WRITE(numout,*) "forcing_vertical_ioipsl : case ZLEV : Read from forcing file :", zlev_fixed, zlevuv_fixed
+        !
+     ELSE IF ( zsigma .OR. zhybrid ) THEN
+        !
+        ! Sigma or hybrid levels
+        !
+        IF ( zsigma ) THEN
+           CALL flinget (force_id,'Sigma',1, 1, 1, 1,  1, 1, zhybrid_b)
+           zhybrid_a = zero
+           IF ( .NOT. zsamelev_uv ) THEN
+              CALL flinget (force_id,'Sigma_uv',1, 1, 1, 1,  1, 1, zhybriduv_b)
+              zhybriduv_a = zero
+           ENDIF
+        ELSE
+           CALL flinget (force_id,'HybSigB',1, 1, 1, 1,  1, 1, zhybrid_b)
+           CALL flinget (force_id,'HybSigA',1, 1, 1, 1,  1, 1, zhybrid_a)
+           IF ( .NOT. zsamelev_uv ) THEN
+              CALL flinget (force_id,'HybSigB_uv',1, 1, 1, 1,  1, 1, zhybriduv_b)
+              CALL flinget (force_id,'HybSigA_uv',1, 1, 1, 1,  1, 1, zhybriduv_a)
+           ENDIF
+        ENDIF
+        WRITE(numout,*) "forcing_vertical_ioipsl : case Pressure coordinates : "
+        WRITE(numout,*) "Read from forcing file :", zhybrid_b, zhybrid_a, zhybriduv_b, zhybriduv_a
+     ELSE
+        !
+        ! Why are we here ???
+        !
+        CALL ipslerr ( 3, 'forcing_vertical_ioipsl','What is the option used to describe the height of', &
+             &         'the atmospheric forcing ?','Please check your forcing file.')
+     ENDIF
+  ENDIF
+  !
+  !- We have no forcing file to explore or we did not find anything. So revert back to the run.def and
+  !- read what has been specified by the user.
+  !
+  IF ( force_id < 0 .OR. .NOT. foundvar ) THEN
+     !
+     !-
+     !Config Key   = HEIGHT_LEV1
+     !Config Desc  = Height at which T and Q are given
+     !Config Def   = 2.0
+     !Config If    = offline mode
+     !Config Help  = The atmospheric variables (temperature and specific
+     !Config         humidity) are measured at a specific level.
+     !Config         The height of this level is needed to compute
+     !Config         correctly the turbulent transfer coefficients.
+     !Config         Look at the description of the forcing
+     !Config         DATA for the correct value.
+     !Config Units = [m]
+     !-
+     zlev_fixed = 2.0
+     CALL getin('HEIGHT_LEV1', zlev_fixed)
+
+     !-
+     !Config Key  = HEIGHT_LEVW
+     !Config Desc = Height at which the wind is given
+     !Config Def  = 10.0
+     !Config If   = offline mode
+     !Config Help = The height at which wind is needed to compute
+     !Config        correctly the turbulent transfer coefficients.
+     !Config Units= [m]
+     !-
+     zlevuv_fixed = 10.0
+     CALL getin('HEIGHT_LEVW', zlevuv_fixed)
+
+     zheight = .TRUE.
+
+     IF ( ABS(zlevuv_fixed-zlev_fixed) > EPSILON(zlev_fixed)) THEN
+        zsamelev_uv = .FALSE.
+     ELSE
+        zsamelev_uv = .TRUE.
+     ENDIF
+
+     CALL ipslerr ( 2, 'forcing_vertical_ioipsl','The height of the atmospheric forcing variables', &
+          &         'was not found in the netCDF file.','Thus the values in run.def were used ... or their defaults.')
+  ENDIF
+
+END SUBROUTINE forcing_vertical_ioipsl
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	   : domain_size
+!!
+!>\BRIEF        
+!!
+!!\n DESCRIPTION   : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S)	   : 
+!!
+!_ ================================================================================================================================
+SUBROUTINE domain_size (limit_west, limit_east, limit_north, limit_south, &
+     &  iim_f, jjm_f, lon, lat, iim, jjm, iind, jind)
+  
+  IMPLICIT NONE
+  !
+  ! ARGUMENTS
+  !
+  REAL, INTENT(inout)  :: limit_west,limit_east,limit_north,limit_south
+  INTEGER, INTENT(in)  :: iim_f, jjm_f
+  REAL, INTENT(in)     :: lon(iim_f, jjm_f), lat(iim_f, jjm_f)
+  INTEGER, INTENT(out) :: iim,jjm
+  INTEGER, INTENT(out) :: iind(iim_f), jind(jjm_f)
+  !
+  ! LOCAL
+  !
+  INTEGER :: i, j
+  REAL :: lolo
+  LOGICAL :: over_dateline = .FALSE.
+  !
+  !
+  IF ( ( ABS(limit_east) .GT. 180. ) .OR. &
+       ( ABS(limit_west) .GT. 180. ) ) THEN
+     WRITE(numout,*) 'Limites Ouest, Est: ',limit_west,limit_east
+     CALL ipslerr_p (3,'domain_size', &
+ &        'Longitudes problem.','In run.def file :', &
+ &        'limit_east > 180. or limit_west > 180.')
+  ENDIF
+  !
+  IF ( limit_west .GT. limit_east ) over_dateline = .TRUE.
+  !
+  IF ( ( limit_south .LT. -90. ) .OR. &
+       ( limit_north .GT. 90. ) .OR. &
+       ( limit_south .GE. limit_north ) ) THEN
+     WRITE(numout,*) 'Limites Nord, Sud: ',limit_north,limit_south
+     CALL ipslerr_p (3,'domain_size', &
+ &        'Latitudes problem.','In run.def file :', &
+ &        'limit_south < -90. or limit_north > 90. or limit_south >= limit_north')
+  ENDIF
+  !
+  ! Here we assume that the grid of the forcing data is regular. Else we would have
+  ! to do more work to find the index table.
+  !
+  iim = 0
+  DO i=1,iim_f
+     !
+     lolo =  lon(i,1)
+     IF ( lon(i,1) .GT. 180. ) lolo =  lon(i,1) - 360.
+     IF ( lon(i,1) .LT. -180. ) lolo =  lon(i,1) + 360.
+     !
+     IF (lon(i,1) < limit_west) iim_g_begin = i+1
+     IF (lon(i,1) < limit_east) iim_g_end = i
+     !
+     IF ( over_dateline ) THEN
+        IF ( lolo .LE. limit_west .OR. lolo .GE. limit_east ) THEN
+           iim = iim + 1
+           iind(iim) = i
+        ENDIF
+     ELSE
+        IF ( lolo .GE. limit_west .AND. lolo .LE. limit_east ) THEN
+           iim = iim + 1
+           iind(iim) = i
+        ENDIF
+     ENDIF
+     !
+  ENDDO
+  !
+  jjm = 0
+  DO j=1,jjm_f
+     IF (lat(1,j) > limit_north) jjm_g_begin = j+1
+     IF (lat(1,j) > limit_south) jjm_g_end = j
+     !
+     IF ( lat(1,j) .GE. limit_south .AND. lat(1,j) .LE. limit_north) THEN
+        jjm = jjm + 1
+        jind(jjm) = j
+     ENDIF
+  ENDDO
+
+  WRITE(numout,*) 'Domain zoom size: iim, jjm = ', iim, jjm
+
+  END SUBROUTINE domain_size
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	   : flinget_buffer
+!!
+!>\BRIEF        
+!!
+!!\n DESCRIPTION   : This subroutine is a wrap of flinget/IOIPSL. The arguments are the same. 
+!!                   flinget_buffer will call flinget and buffer the forcing data localy in this subroutine. 
+!!                   According to the variable NBUFF set in run.def, several time steps can be read at the same time 
+!!                   from the forcing file. If NBUFF=0, the full forcing file is read. 
+!!                   The output, data_full, from this subroutine is always only one time step of corresponding to itb.
+!!                   itb must be equal to ite. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S)	   : 
+!!
+!_ ================================================================================================================================
+  SUBROUTINE flinget_buffer(force_id, varname, iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+    
+    !! Input arguments 
+    INTEGER, INTENT(in)          :: force_id                      !! Id for forcing file
+    CHARACTER(len=*), INTENT(in) :: varname                       !! Name of current variable to be read
+    INTEGER, INTENT(in)          :: iim_full, jjm_full, llm_full  !! Horizontal and vertical domaine
+    INTEGER, INTENT(in)          :: ttm                           !! Full lenght of forcing file
+    INTEGER, INTENT(in)          :: itb, ite                      !! Time step to be read from forcing file. itb must be equal to ite
+
+    !! Output argument
+    REAL, DIMENSION(iim_full, jjm_full), INTENT(out) :: data_full !! Data for time step itb. 
+
+    !! Define specific type to buffer data together with name and index
+    TYPE buffer_type
+       CHARACTER(len=20) :: name                   !! Name of variable in forcing file
+       INTEGER :: istart                           !! Start index of current buffered data
+       INTEGER :: iend                             !! End index of current buffered data
+       REAL, ALLOCATABLE, DIMENSION(:,:,:) :: data !! Data read from forcing file for intervall [istart,iend]
+    END TYPE buffer_type
+    
+    !! Local variables 
+    INTEGER, PARAMETER :: maxvar=20                          !! Max number of variables to be buffered
+    TYPE(buffer_type), DIMENSION(maxvar),SAVE :: data_buffer !! Containing all variables and the current buffered data
+    INTEGER, SAVE   :: nbuff                                 !! Number of time steps to be buffered
+    INTEGER, SAVE   :: lastindex=0                           !! Current number of variables stored in data_buffer
+    INTEGER, SAVE   :: ttm0                                  !! Time lenght of forcing file, stored for test purpose
+    LOGICAL, SAVE   :: first=.TRUE.                          !! First call to this subroutine
+    INTEGER         :: index                                 !! Index in data_buffer for current variable
+    INTEGER         :: i, ierr                               !! Loop and error variables
+    
+    
+    !! 1. Initialization
+    IF (first) THEN
+       data_buffer(:)%name='undef'
+       ! Read NBUFF from run.def
+       ! Note that getin_p is not used because this subroutine might be called only by master process
+
+       !Config Key  = NBUFF
+       !Config Desc = Number of time steps of data to buffer between each reading of the forcing file
+       !Config If   = OFF_LINE
+       !Config Help = The full simulation time length will be read if NBUFF equal 0. 
+       !Config        NBUFF > 1 can be used for smaller regions or site simulations only. 
+       !Config Def  = 1
+       !Config Units= -
+
+       nbuff=1
+       CALL getin('NBUFF', nbuff)
+
+       IF (nbuff == 0 .OR. nbuff >ttm) THEN
+          ! Set nbuff as the full forcing file lenght
+          nbuff=ttm
+       ELSE IF (nbuff < 0) THEN
+          ! Negativ nbuff not possible
+          CALL ipslerr_p(3,'flinget_buffer','NBUFF must be a positiv number','Set NBUFF=0 for full simulation lenght','')
+       END IF
+       WRITE(numout,*)'flinget_buffer: NBUFF=',nbuff,' number of time step will be buffered'
+       WRITE(numout,*)'flinget_buffer: Choose a lower value for NBUFF if problem with memory'
+       
+       ! Save dimensions to check following timesteps
+       ! ttm is the full lenght of forcing file
+       ttm0=ttm
+       
+       first=.FALSE.
+    END IF
+
+    !! 2. Coeherence tests on input arguments
+    IF (ttm /= ttm0) THEN
+       WRITE(numout,*)'Problem with ttm=',ttm,' ttm0=',ttm0
+       CALL ipslerr_p(3,'flinget_buffer','Error with ttm and ttm0','','')
+    END IF
+    IF (itb /= ite) THEN
+       WRITE(numout,*) 'There is a problem. Why is itb not equal ite ?'
+       WRITE(numout,*) 'itb=',itb,' ite=',ite,' varname=',varname
+       CALL ipslerr_p(3,'flinget_buffer','ite not equal itb','','')
+    END IF
+
+
+    !! 3. Find index for current variable
+    index=0
+    DO i=1, maxvar
+       IF ( trim(varname) == data_buffer(i)%name ) THEN
+          index=i
+          CYCLE
+       END IF
+    END DO
+    
+    !! 4. Initialize and allocate if necesary the current variable
+    IF ( index == 0 ) THEN
+       ! The variable was not found
+       ! This must be the first time for current variable
+       index=lastindex+1
+       lastindex=index
+       IF (index > maxvar) CALL ipslerr_p(3,'flinget_buffer','to many variables','maxvar is too small','')
+       
+       ! Initialize the data_buffer for this index
+       data_buffer(index)%name=trim(varname)
+       ALLOCATE(data_buffer(index)%data(iim_full,jjm_full,nbuff),stat=ierr)
+       IF (ierr /= 0) CALL ipslerr_p(3,'flinget_buffer','pb alloc data_buffer%data','for variable=',varname)
+       data_buffer(index)%istart=0
+       data_buffer(index)%iend=0
+    END IF
+    
+    
+    !! 5. Call flinget if current time step (itb) is outside the buffered intervall
+    IF (( itb > data_buffer(index)%iend ) .OR. ( itb < data_buffer(index)%istart )) THEN
+       ! itb is not in the time slice previously read or it is the first time to read
+       ! Reading of forcing file will now be done
+       ! First recalculate index to be read
+       data_buffer(index)%istart = itb
+       data_buffer(index)%iend   = itb + nbuff - 1
+       
+!       WRITE(numout,*) 'Now do flinget for ',varname,', itb=',itb,', istart=',&
+!            data_buffer(index)%istart,', iend=',data_buffer(index)%iend
+       CALL flinget (force_id,varname, iim_full, jjm_full, llm_full, ttm, data_buffer(index)%istart, &
+            data_buffer(index)%iend, data_buffer(index)%data(:,:,:))
+    END IF
+    
+    !! 6. Initialize the output variable with data from buffered variable
+    ! Find index for the time step corrsponding to itb in the time slice previously read from forcing file
+    i=itb-data_buffer(index)%istart+1
+    ! Initialize output variable
+    data_full(:,:) = data_buffer(index)%data(:,:,i)
+    
+    
+  END SUBROUTINE flinget_buffer
+
+END MODULE readdim2
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/testrouting.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/testrouting.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/testrouting.f90	(revision 6412)
@@ -0,0 +1,441 @@
+! =================================================================================================================================
+! PROGRAM      : testrouting
+!
+! CONTACT      : jan.polcher _at_ lmd.jussieu.fr
+!
+! LICENCE      : :)
+!
+!>\BRIEF       This program tests routing scheme (from routing.f90) which routes the water over the continents
+!!             into the oceans and computes the water stored in floodplains or taken for irrigation.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) :
+!!
+!! SVN          :
+!! $HeadURL     : svn://forge.ipsl.jussieu.fr/orchidee/trunk/ORCHIDEE/[somewhere]/testrouting.f90 $
+!! $Date: 2014-10-27 10:39:00 +0200 (Mon, 27 Oct 2014) $
+!! $Revision: XXXX $
+!! \n
+!_ ================================================================================================================================
+PROGRAM testrouting
+  !
+  USE ioipsl_para
+  USE pft_parameters
+  USE mod_orchidee_para
+  USE control
+  USE constantes_soil_var
+  USE constantes_var
+  USE constantes
+  USE routing
+  USE timer
+  USE grid
+  !
+  USE getlandseamask
+  !
+  IMPLICIT NONE
+  !
+  INTEGER(i_std)                                      :: nbseg                            !! 
+  !
+  INTEGER(i_std)                                      :: iim                              !! Size in longitude of coarser grid
+  INTEGER(i_std)                                      :: jjm                              !! Size in latitude of coarser grid
+  INTEGER(i_std)                                      :: i, j                             !! Integer variable for loops 
+  INTEGER(i_std)                                      :: ibegt, iendt
+  INTEGER(i_std)                                      :: ni                               !! For checking nbindex
+  REAL(r_std)                                         :: nbyears                          !! Lenght of simulation in years 
+  INTEGER(i_std)                                      :: simlen                           !! Lenght of simulation: simlen = 365*48*nbyears
+  REAL(r_std)                                         :: dx, dy                           !! Lon/Lat resolution of coarser grid
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:)           :: lon, lat                         !! Lon/lat of coarser grid
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:)           :: orog                             !! New orography after interpolation
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: orog_land, orog_loc
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:)           :: lalo_land
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: contfrac_land, contfrac_loc
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:)           :: contfrac_2d
+  !
+  REAL(r_std), DIMENSION (1)                          :: lev                              !! Number of level (requested by restini routine) (unitless)
+  CHARACTER(LEN=80)                                   :: histname                         !! Name of history file (can not find HISTNAME?)
+  INTEGER(i_std)                                      :: hori_id                          !! ID of the default horizontal longitude and latitude map.
+  INTEGER(i_std)                                      :: hist_id                          !! History file identification for ???
+  INTEGER(i_std)                                      :: rest_id                          !! ID of the restart file
+  !
+  REAL(r_std)                                         :: date0                            !! Initial date
+  REAL(r_std)                                         :: date0_rest                       !! Initial date from restart file
+  REAL(r_std)                                         :: date                             !! Current date
+  REAL(r_std)                                         :: dt                               !! Same as dtradia ???
+  REAL(r_std)                                         :: dw                               !! 86400. ???
+  REAL(r_std)                                         :: one_day_loc
+  !
+  CHARACTER(LEN=40)                                   :: flux_op                          !! Operations to be performed on fluxes
+  CHARACTER(LEN=40)                                   :: flux_scinsec                     !! Operation in seconds
+  CHARACTER(LEN=40)                                   :: avescatter, once_wrt             !! The various operation to be performed
+  !
+  ! Input for routing_main
+  !
+  INTEGER(i_std)                                      :: kjit                             !! Time step number
+  INTEGER(i_std)                                      :: nbindex                          !! Number of local continental points 
+  REAL(r_std)                                         :: dtradia                          !! Timestep length
+  !
+  INTEGER(i_std), ALLOCATABLE, DIMENSION (:)          :: kindex_g                         !! Index of land point on 2D map (in local position)
+  INTEGER(i_std), ALLOCATABLE, DIMENSION (:)          :: kindex                           !! index of land point per proc
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: runoff                           !! Grid-point runoff (kg/m^2/dt)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: drainage                         !! Grid-point drainage (kg/m^2/dt)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: humrel                           !! Soil moisture stress, root extraction potential (unitless)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:)           :: stempdiag                        !! Diagnostic soil temperature profile
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)       :: totfrac_nobio                    !! Total fraction of continental ice+lakes+cities+...
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)     :: veget_max                        !! Max. fraction of vegetation type (LAI -> infty, unitless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)       :: floodout                         !! Flow out of floodplains from hydrol
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)     :: transpot                         !! Potential Transpiration (needed for irrigation)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)       :: precip_rain                      !! Rainfall (kg/m^2/dt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)       :: k_litt                           !! Averaged conductivity for saturated infiltration in the 'litter' layer (kg/m^2/dt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)       :: reinf_slope                      !! Coefficient which determines the reinfiltration ratio in the grid box due to flat areas (unitless;0-1)
+  INTEGER(i_std)                                      :: hist2_id                         !! Access to history file 2 (unitless)
+  !
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: evapot_corr                      !! Soil Potential Evaporation
+  !
+  ! Output from routing_main
+  !
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: returnflow                       !! The water flow from lakes and swamps which returns to the grid box (kg/m^2/dt)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: irrigation                       !! This is the water taken from the reservoirs and beeing put into the upper layers of the soil (kg/m^2/dt)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: riverflow                        !! Outflow of the major rivers, will be located on the continental grid but this should be a coastal point (kg/dt)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: coastalflow                      !! Outflow on coastal points by small basins, the water which flows in a disperse way into the ocean (kg/dt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)       :: reinfiltration                   !! Water flow from ponds and floodplains which returns to the grid box (kg/m^2/dt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)       :: flood_res                        !! Diagnostic of water amount in the floodplains reservoir (kg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)       :: flood_frac                       !! Flooded fraction of the grid box (unitless;0-1)
+  !
+  !
+!_ ================================================================================================================================
+  !
+  !
+  CALL Init_orchidee_para() 
+  !
+  CALL getlandseamask_init(iim, jjm, nbindex)
+  ALLOCATE(lon(iim,jjm))
+  ALLOCATE(lat(iim,jjm))
+  ALLOCATE(orog(iim,jjm))
+  ALLOCATE(contfrac_2d(iim,jjm))
+  CALL getlandseamask_read(lon, lat, contfrac_2d, orog)
+  !
+  ! ALLOCATE memory needed
+  !
+  ALLOCATE(kindex_g(nbindex))
+  ALLOCATE(lalo_land(nbindex,2))
+  ALLOCATE(contfrac_land(nbindex))
+  ALLOCATE(orog_land(nbindex))
+  ! 
+  !
+  !
+  ni=0
+  DO j=1,jjm
+     DO i=1,iim
+        IF ( contfrac_2d(i,j) > 0.0 ) THEN
+           ni = ni + 1
+           IF ( ni .GT. nbindex ) THEN
+              WRITE(*,*) "We are expecting ", nbindex, "point."
+              WRITE(*,*) "We are at : ", i, j, orog(i,j)
+              STOP 'Too many continental points'
+           ENDIF
+           kindex_g(ni) = (j-1)*iim + i
+           lalo_land(ni,1) = lat(i,j)
+           lalo_land(ni,2) = lon(i,j)
+           contfrac_land(ni) = contfrac_2d(i,j)
+           orog_land(ni) = orog(i,j)
+        ENDIF
+     ENDDO
+  ENDDO  
+  !
+  !
+  nbseg = 4
+  !
+  ! 
+  CALL grid_set_glo(iim, jjm, nbindex)
+  CALL grid_allocate_glo(nbseg)
+  !
+  CALL bcast(nbindex)
+  ALLOCATE(index_g(nbindex))
+  IF ( is_root_prc ) index_g(:) = kindex_g(:)
+  CALL bcast(index_g)
+  !
+  WRITE(*,*) "GOING INTO Init_orchidee_data_para_driver", nbindex, index_g(1), SIZE(kindex_g)
+  CALL Init_orchidee_data_para_driver(nbindex, index_g)
+  WRITE(*,*) "OUT OF Init_orchidee_data_para_driver"
+  CALL init_ioipsl_para 
+  !
+  WRITE(*,*) mpi_rank, "DIMENSIONS of grid on processor : iim, jjm, nbindex = ", iim, jjm, nbindex, nbp_loc
+  !
+  CALL grid_init (nbp_loc, nbseg, "RegLonLat", "ForcingGrid")
+  !
+  !==========================================================================
+  !
+  ! Transfer the global grid variables to the root proc
+  ! *_glo -> *_g
+  ! Variables *_g were allocated with the CALL init_grid
+  !
+  IF ( is_root_prc) THEN
+     !
+     lalo_g(:,:) = lalo_land(:,:)
+     lon_g(:,:) = lon(:,:)
+     lat_g(:,:) = lat(:,:)
+     contfrac_g(:) = contfrac_land(:)
+     !
+  ENDIF
+  !
+  CALL grid_stuff(nbindex, iim, jjm, lon_g, lat_g, index_g)
+  !
+  !
+  ! Distribute the grid to all processors
+  !
+  ! Redistribute the indeces on all procs (apple distribution of land points) 
+  !
+  ALLOCATE(kindex(nbp_loc))
+  ALLOCATE(orog_loc(nbp_loc), contfrac_loc(nbp_loc))
+  CALL bcast(lon_g)
+  CALL bcast(lat_g)
+  CALL scatter(index_g, kindex) 
+  CALL scatter(lalo_land, lalo)
+  CALL scatter(orog_land, orog_loc)
+  CALL scatter(contfrac_land, contfrac_loc)
+  ! 
+  !
+  ! Apply the offset needed so that kindex refers to the index of the land point 
+  ! on the current region, i.e. the local lon lat domain.
+  !
+  kindex(1:nbp_loc)=kindex(1:nbp_loc)-(jj_begin-1)*iim
+  !
+  !
+  !==========================================================================================
+  !
+  ! The grid is in place and we can start to prepare the time of integration.
+  !
+  CALL ioconf_calendar("gregorian")
+  !
+  !
+  ! Determine initial step or restart one
+  !
+  !Config Key   = RESTART_IN
+  !Config Desc  = Name of restart file to read at restart
+  !Config If    = [-]
+  !Config Def   = NONE
+  !Config Help  = This function allows to select a restart file with which
+  !               the simulation will be initialized.
+  !Config Units = [-] 
+  !- 
+  !
+  restname_in="NONE"
+  CALL getin('RESTART_IN', restname_in)
+  !
+  !Config Key   = RESTART_OUT
+  !Config Desc  = Name of restart file to be written at the end of the simulation.
+  !Config If    = [-]
+  !Config Def   = NONE
+  !Config Help  = This function allows to select a restart file which will be written by the
+  !               model and which can be used as input for a future restart.
+  !Config Units = [-] 
+  !- 
+  !
+  restname_out="restart_out.nc"
+  CALL getin('RESTART_OUT', restname_out)
+  !
+  !Config Key   = SIMULATION_LEN
+  !Config Desc  = Time step length in years for "testrouting"
+  !Config If    = [-]
+  !Config Def   = 1
+  !Config Help  = This is time step length for testrouting
+  !Config Units = [-] 
+  nbyears=1.0
+  CALL getin('SIMULATION_LEN', nbyears)
+  !
+  !Config Key   = DTRADIA
+  !Config Desc  = Time step length for "testrouting"
+  !Config If    = [-]
+  !Config Def   = 1800.
+  !Config Help  = This is time step length for testrouting
+  !Config Units = [-] 
+  !- 
+  !DTRADIA = 1800.
+  dtradia = 1800.
+  CALL getin('DTRADIA', dtradia)
+  !
+  !- Initial date
+  CALL ymds2ju (2000,1,1,0.0, date0)
+  date0_rest = date0
+  !
+  dt = dtradia
+  dw = 86400.
+  !
+  CALL control_initialize(dt)
+  ! 
+  CALL ioget_calendar(one_year,one_day_loc)
+  !
+  !  We have all we need and we can start to work
+  !
+  !
+  IF (is_root_prc) THEN
+     CALL restini(restname_in, iim, jjm, lon_g, lat_g, 1, lev, &
+          &  restname_out, ibegt, date0_rest, dtradia, rest_id, .FALSE.)
+  ELSE
+     rest_id=0
+  ENDIF
+  CALL bcast (ibegt)
+  CALL bcast (date0_rest)
+  CALL bcast (dtradia)
+  !
+  !
+  IF ( INDEX(restname_in, "NONE") > 0 ) THEN
+     kjit = 1
+     ibegt = 1
+  ELSE
+     kjit = ibegt
+     date0 = date0_rest
+  ENDIF
+  WRITE(*,*) 'Out of restini : kjit=',kjit, " ibegt=", ibegt, " date0=", date0
+  !
+  !- time step length
+  !
+  !  Set up the history file
+  !
+  !Config Key   = HISTNAME
+  !Config Desc  = Name of the history file
+  !Config If    = [-]
+  !Config Def   = out_testrouting
+  !Config Help  = The name of the file which will contain all the diagnostics of routing.
+  !Config Units = [-] 
+  !-
+  WRITE(flux_op,'("ave(scatter(X*",F8.1,"))")') one_day_loc/dt
+  WRITE(flux_scinsec,'("ave(scatter(X*",F8.6,"))")') 1.0/dt
+  avescatter = 'ave(scatter(X))'
+  once_wrt = 'once(scatter(X))'
+  ! 
+  histname="out_testrouting"
+  CALL getin('HISTNAME', histname)
+  !
+  CALL histbeg(histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+       &     kjit-1, date0, dtradia, hori_id, hist_id, domain_id=orch_domain_id)
+  !
+  CALL histdef(hist_id, 'Orog', 'Orography', ' ', &
+       & iim, jjm, hori_id, 1,1,1, -99, 32, once_wrt, dt, dw)
+  CALL histdef(hist_id, 'Contfrac', 'Fraction of continent', ' ', &
+       & iim, jjm, hori_id, 1,1,1, -99, 32, once_wrt, dt, dw)
+  CALL histdef(hist_id, 'Areas', 'Mesh areas', 'm2', &
+       & iim,jjm, hori_id, 1,1,1, -99, 32, once_wrt, dt, dw)
+  !
+  CALL histdef(hist_id, 'riversret', 'Return from endorheic rivers', 'mm/d', &
+       & iim,jjm, hori_id, 1,1,1, -99, 32, flux_op, dt,dw)
+  CALL histdef(hist_id, 'hydrographs', 'Hydrographs of gridbox outflow', 'm^3/s', &
+       & iim,jjm, hori_id, 1,1,1, -99, 32, flux_scinsec, dt,dw)
+  !
+  CALL histdef(hist_id, 'fastr', 'Fast flow reservoir', 'kg/m^2', &
+       & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter, dt,dw)
+  CALL histdef(hist_id, 'slowr', 'Slow flow reservoir', 'kg/m^2', &
+       & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter, dt,dw)
+  CALL histdef(hist_id, 'streamr', 'Stream flow reservoir', 'kg/m^2', &
+       & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter, dt,dw)
+  CALL histdef(hist_id, 'pondr', 'Volume in pond reservoir', 'kg/m^2', &
+       & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter, dt,dw)
+  CALL histdef(hist_id, 'lakevol', 'Volume in lake reservoir', 'kg/m^2', &
+       & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter, dt,dw)
+  !
+  CALL histdef(hist_id, 'basinmap', 'Aproximate map of the river basins', ' ', &
+       & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter, dt,dw) 
+  CALL histdef(hist_id, 'nbrivers', 'Number or rivers in the outflow grid box', ' ', &
+       & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter, dt,dw)
+  !
+  CALL histend(hist_id)
+  !
+  ! Put a copy of the orography into the restart
+  !
+  !
+  CALL histwrite_p(hist_id, 'Orog', kjit+1, orog_loc, nbp_loc, kindex)
+  CALL histwrite_p(hist_id, 'Contfrac', kjit+1, contfrac_loc, nbp_loc, kindex)
+  CALL histwrite_p(hist_id, 'Areas',  kjit+1, area, nbp_loc, kindex)
+  !
+  ! Override some settings as testrouting is not as flexible as the rest of ORCHIDEE.
+  !
+  hist2_id=-1
+  almaoutput=.FALSE.
+  !================================================================================
+  !
+  ! Set up the routing schemes
+  !
+  !
+  !  Allocate all the physical variables
+  !
+  ! Input variables
+  ALLOCATE(runoff(nbp_loc), drainage(nbp_loc), humrel(nbp_loc), stempdiag(nbp_loc,nbdl), transpot(nbp_loc,nvmc))
+  ALLOCATE(totfrac_nobio(nbp_loc), veget_max(nbp_loc,nvmc), floodout(nbp_loc))
+  ALLOCATE(precip_rain(nbp_loc), k_litt(nbp_loc),reinf_slope(nbp_loc)) 
+  ALLOCATE(evapot_corr(nbp_loc))
+  ! Output variables
+  ALLOCATE(returnflow(nbp_loc), irrigation(nbp_loc), riverflow(nbp_loc), coastalflow(nbp_loc), reinfiltration(nbp_loc))
+  ALLOCATE(flood_frac(nbp_loc), flood_res(nbp_loc))
+  !
+  ! Get some fake value for input arrays
+  !
+  runoff(:) = 1.0
+  drainage(:) = 1.0
+  humrel(:) = 0.75
+  stempdiag(:,:) = 273.5
+  transpot(:,:)=0.0
+  reinfiltration(:)=0.0
+  flood_frac(:)=0.0
+  flood_res(:)=0.0
+  totfrac_nobio = 0.1
+  veget_max = 0.2
+  floodout = 0.0
+  precip_rain = 0.0
+  k_litt = 0.0 
+  reinf_slope = 0.1
+  evapot_corr(:) = 10.0
+  !
+  ! 
+  !
+  CALL routing_initialize( kjit,        nbp_loc,        kindex, &
+       &                   rest_id,     hist_id,        hist2_id,   lalo, &
+       &                   neighbours,  resolution,     contfrac,   stempdiag, &
+       &                   returnflow,  reinfiltration, irrigation, riverflow, &
+       &                   coastalflow, flood_frac,     flood_res)
+  !
+  ! Do loop over a number of time-steps
+  !
+  simlen = NINT(nbyears*365*one_day_loc/dtradia)
+  ibegt=kjit
+  iendt=kjit+simlen
+  WRITE(*,*) "The simulation will go from ", ibegt, " to ", iendt
+  !
+  DO kjit = ibegt,iendt
+     !
+     date = date0 + (kjit-1)*(dtradia/one_day_loc)
+     !
+     IF ( date < date0+1 ) THEN
+        ! During one day one kg/m^2d divided up in runoff and drainage
+        runoff(:) = 0.5/48.
+        drainage(:) = 0.5/48.
+     ELSE
+        runoff(:) = 0.0
+        drainage(:) = 0.0
+     ENDIF
+     !
+     CALL routing_main(kjit, nbp_loc, kindex, &
+           & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, floodout, runoff, &
+           & drainage, transpot, precip_rain, humrel, k_litt, flood_frac, flood_res, &
+           & stempdiag, reinf_slope, returnflow, reinfiltration, irrigation, riverflow, coastalflow, rest_id, hist_id, hist2_id)
+     !
+     WRITE(*,*) "Out of routing at time step = ",kjit,' Seconds since start', (kjit-ibegt)*dtradia
+     !
+  ENDDO
+  !
+  ! Shut everything down
+  !
+  CALL routing_finalize(kjit, nbp_loc, rest_id, flood_frac, flood_res)
+  !
+  !
+  CALL histclo
+  IF ( is_root_prc) THEN
+     CALL restclo
+  ENDIF
+  !
+  CALL Finalize_mpi
+  !
+END PROGRAM testrouting
+!
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/teststomate.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/teststomate.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/teststomate.f90	(revision 6412)
@@ -0,0 +1,1165 @@
+! =================================================================================================================================
+! PROGRAM       : teststomate
+!
+! CONTACT	: orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This program runs the STOMATE submodel using specific initial conditions 
+!! and driving variables in order to obtain the state variables of STOMATE closed to the steady-state values  
+!! quicker than when using the 'full' ORCHIDEE. 
+!!                                        
+!! \n DESCRIPTION (functional, design, flags): 
+!! It integrates STOMATE for a given number of years using a specific forcing file.       
+!! The initial GPP from this forcing is scaled in agreement with the updated calculated LAI in STOMATE 
+!! Nothing is done for soil moisture which should actually evolve with the vegetation.            
+!! - 1. It first reads a set of parameters, allocates variables and initializes them.
+!! - 2. Then, a section on the set up of the STOMATE history file
+!! - 3. A first call to slowproc subroutine in order to initialize SECHIBA variables
+!! - 4. A loop over time in which slowproc is called at each time step
+!! - 5. A restart file is written
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S)     : None
+!!
+!! SVN              :   
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+PROGRAM teststomate
+
+  ! modules used;
+
+  USE netcdf
+  USE defprec
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE stomate_data
+  USE ioipsl_para
+  USE mod_orchidee_para
+  USE grid
+  USE slowproc
+  USE stomate
+  USE intersurf, ONLY:  intsurf_time, lstep_init_intersurf
+  USE ioipslctrl, ONLY : ioipslctrl_histstom, ioipslctrl_histstomipcc
+  USE mod_orchidee_para_var, ONLY : MPI_COMM_ORCH
+!-
+#include "src_parallel.h"
+!-
+
+  IMPLICIT NONE
+
+  !! 0. Variable and parameter declaration
+
+  INTEGER(i_std)                            :: kjpij,kjpindex                       !! # of total/land points
+  REAL(r_std)                               :: dtradia,dt_force                     !! time step of sechiba and stomate components 
+                                                                                    !! read into the forcing file [second] 
+ 
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE   :: indices                              !! index over land points
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE   :: indexveg
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: soiltile, veget_x                    !! texture and fraction of vegetation type 
+                                                                                    !! (accounts for LAI dynamic) 
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: totfrac_nobio                        !! Total fraction of ice+lakes+cities etc. in 
+                                                                                    !! the mesh 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: frac_nobio                           !! Fraction of ice, lakes, cities etc. in the 
+                                                                                    !! mesh 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: veget_max_x                          !! Fraction of vegetation type
+  INTEGER(i_std), DIMENSION(:),ALLOCATABLE  :: njsc
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: lai_x                                !! Leaf Area Index as calculated in STOMATE 
+                                                                                    !! [m2/m2] 
+  REAL(r_std),DIMENSION (:,:,:), ALLOCATABLE:: frac_age_x                           !! Age efficacity from STOMATE for isoprene 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: veget_force_x                        !! Fraction of vegetation of PFTs in each grid 
+                                                                                    !! cell (read in the forcinng file) [-] 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: veget_max_force_x                    !! fraction of maximum vegetation of PFTs in 
+                                                                                    !! each grid cell (read in the forcinng file) 
+                                                                                    !! [-] 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: lai_force_x                          !! Leaf Area Index as read in the forcing file 
+                                                                                    !! [m2/m2] 
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: reinf_slope
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: t2m,t2m_min,temp_sol                 !! 2 m air temperature, min. 2 m air temp. 
+                                                                                    !! during forcing time step and Surface 
+                                                                                    !! temperature [K] 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: soiltemp,soilhum                     !!  Soil temperature and Relative soil moisture
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: humrel_x
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: litterhum                            !! Litter humidity
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: precip_rain,precip_snow              !! Rainfall, Snowfall
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: gpp_x                                !! GPP (gC/(m**2 of total ground)/time step)
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: deadleaf_cover                       !! fraction of soil covered by dead leaves
+  REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE  :: assim_param_x                        !! min/max/opt temperature for photosynthesis 
+                                                                                    !! and vcmax/vjmax parameters 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: height_x                             !! height (m)
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: qsintmax_x                           !! Maximum water on vegetation for interception
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: co2_flux                             !! CO2 flux in gC/m**2 of ground/second
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: fco2_lu                              !! Land Cover Change CO2 flux (gC/m**2 of 
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: temp_growth                          !! Growth temperature - Is equal to t2m_month (Â°C)
+                                                                                    !! average ground/s) 
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: tot_bare_soil                        !! Total evaporating bare soil fraction 
+
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE   :: indices_g                            !! Vector of indeces of land points, only known by root proc
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: x_indices_g                          !! Temporary vector of indeces of land points
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: x_neighbours_g                       !! Indeces of neighbours for each land point
+
+  INTEGER                                   :: ier,iret                             !! Return value of functions used to catch 
+                                                                                    !! errors 
+  INTEGER                                   :: ncfid                                !! Id of the restart file of SECHIBA used in 
+                                                                                    !! input 
+  CHARACTER(LEN=20),SAVE                    :: thecalendar='noleap'                 !! Type of calendar used
+  LOGICAL                                   :: a_er                                 !! Flag used to check errors when allocating
+  CHARACTER(LEN=80) :: &                                                            !! Name of the restart files used for
+       dri_restname_in,dri_restname_out, &                                          !! the driver in/out
+       sec_restname_in,sec_restname_out, &                                          !! the sechiba component in/out
+       sto_restname_in,sto_restname_out, &                                          !! the stomate component in/out
+       stom_histname, stom_ipcc_histname                                            !! Name of the history files for stomate 
+                                                                                    !! (standard and ippc format) 
+  INTEGER(i_std)                            :: iim,jjm,llm                          !! # of lon,lat and time-step in the restart 
+                                                                                    !! files 
+  REAL, ALLOCATABLE, DIMENSION(:,:)         :: lon, lat                             !! Arrays of Longitude and latitude (iim,jjm) 
+                                                                                    !! dimension for each processor 
+  REAL, ALLOCATABLE, DIMENSION(:)           :: lev                                  !! height level (required by the restini 
+                                                                                    !! interface) 
+  LOGICAL                                   :: rectilinear                          !! Is the grid rectilinear
+  REAL, ALLOCATABLE, DIMENSION(:)           :: lon_rect, lat_rect                   !! Vectors of Longitude and latitude (iim or 
+                                                                                    !! jjm) dimension used in case of a 
+                                                                                    !! rectilinear grid 
+  REAL(r_std)                               :: dt                                   !! Time step of sechiba component read in the 
+                                                                                    !! restart file [seconds] 
+  INTEGER(i_std)                            :: itau_dep,itau_fin,itau               !! First, last and current time step of SECHIBA 
+                                                                                    !! component 
+  INTEGER(i_std)                            :: itau_len,itau_step                   !! Total length of the simulation and length 
+                                                                                    !! between 2 calls of slowproc (expreseed in 
+                                                                                    !! time steps of SECHIBA component) 
+  REAL(r_std)                               :: date0                                !! Initial date
+  INTEGER(i_std)                            :: rest_id_sec,rest_id_sto              !! ID's of the restart files for the SECHIBA 
+                                                                                    !! and STOMATE components 
+  INTEGER(i_std)                            :: hist_id_sec,hist_id_sec2             !! ID's of the history files of SECHIBA 
+                                                                                    !! component (required by the interface of 
+                                                                                    !! slowproc but not used) 
+  INTEGER(i_std)                            :: hist_id_stom,hist_id_stom_IPCC       !! ID's of the history files of STOMATE 
+                                                                                    !! component 
+  CHARACTER(LEN=30)                         :: time_str                             !! String used for reading the length of 
+                                                                                    !! simulation in the .def file 
+  REAL(r_std)                               :: dt_stomate_loc                             !! 
+  REAL                                      :: hist_days_stom,hist_days_stom_ipcc   !! Time frequency at which variables are 
+                                                                                    !! written in the history file for the STOMATE 
+                                                                                    !! component (standard and ipcc format) [day] 
+  REAL                                      :: hist_dt_stom,hist_dt_stom_ipcc       !! Time frequency at which variables are 
+                                                                                    !! written in the history file for the STOMATE 
+                                                                                    !! component (standard and ipcc format) 
+                                                                                    !! [second] 
+  REAL(r_std), ALLOCATABLE, DIMENSION(:)    :: hist_PFTaxis                         !! Vector with PFT indeces used as axis in the 
+                                                                                    !! history file 
+  REAL(r_std),DIMENSION(10)                 :: hist_pool_10axis                     !! Vector with 10-year indeces used as axis in 
+                                                                                    !! the history file (for land-use change) 
+  REAL(r_std),DIMENSION(100)                :: hist_pool_100axis                    !! Vector with 100-year indeces used as axis in 
+                                                                                    !! the history file (for land-use change) 
+  REAL(r_std),DIMENSION(11)                 :: hist_pool_11axis                     !! Vector with 11-year indeces used as axis in 
+                                                                                    !! the history file (for land-use change) 
+  REAL(r_std),DIMENSION(101)                :: hist_pool_101axis                    !! Vector with 101-year indeces used as axis in 
+                                                                                    !! the history file (for land-use change) 
+  INTEGER                                   :: hist_PFTaxis_id,hist_IPCC_PFTaxis_id !! Id of the axis for PFT in the standard/IPCC 
+                                                                                    !! format 
+  INTEGER                                   :: hori_id 
+  INTEGER                                   :: hist_pool_10axis_id                  !! Id of the axis for 10-year vector
+  INTEGER                                   :: hist_pool_100axis_id                 !! Id of the axis for the 100-year vector
+  INTEGER                                   :: hist_pool_11axis_id                  !! Id of the axis for the 11-year vector
+  INTEGER                                   :: hist_pool_101axis_id                 !! Id of the axis for the 101-year vector
+  INTEGER(i_std)                            :: i,j,iv                               !! used as counters
+  LOGICAL                                   :: ldrestart_read,ldrestart_write       !! Flags to activate reading/writing of the 
+                                                                                    !! restart file 
+  LOGICAL                                   :: l1d                                  !! Are vector elements 1-dimension size ?
+  INTEGER(i_std),PARAMETER                  :: nbvarmax=200                         !! Maximum number of variables assumed in the 
+                                                                                    !! restart file of SECHIBA component used as 
+                                                                                    !! input 
+  INTEGER(i_std)                            :: nbvar                                !! Number of variables present in the restart 
+                                                                                    !! file of SECHIBA component used as input 
+  CHARACTER(LEN=50),DIMENSION(nbvarmax)     :: varnames                             !! Name of the variables present in the restart 
+                                                                                    !! file of SECHIBA component used as input 
+  INTEGER(i_std)                            :: varnbdim                             !! Number of dimensions of a variable 
+                                                                                    !! varnames(i) 
+  INTEGER(i_std),PARAMETER                  :: varnbdim_max=20                      !! Maximum number of dimensions of a variable 
+                                                                                    !! varnames(i) 
+  INTEGER,DIMENSION(varnbdim_max)           :: vardims
+  CHARACTER(LEN=200)                        :: taboo_vars
+  REAL(r_std),DIMENSION(1)                  :: xtmp
+  INTEGER                                   :: nsfm,nsft
+  INTEGER                                   :: iisf,iiisf
+  INTEGER(i_std)                            :: max_totsize,totsize_1step
+  INTEGER(i_std)                            :: totsize_tmp  
+  INTEGER                                   :: vid
+  CHARACTER(LEN=100)                        :: forcing_name
+  REAL                                      :: x
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: var_3d
+  REAL(r_std)                               :: var_1d(1)
+  REAL(r_std)                               :: time_sec,time_step_sec
+  REAL(r_std)                               :: time_dri,time_step_dri
+  REAL(r_std),DIMENSION(1)                  :: r1d
+  REAL(r_std)                               :: julian,djulian
+
+  INTEGER(i_std)                            :: ji,jv,l
+!  INTEGER(i_std)                            :: printlev_loc
+  INTEGER(i_std)                            :: ierr
+
+!---------------------------------------------------------------------
+
+  !-
+  ! 1. Reading parameters, Allocating variables and Initializations
+  !-
+
+  CALL Init_orchidee_para
+  CALL init_timer
+
+! Set specific write level to forcesoil using PRINTLEV_teststomate=[0-4] in run.def. 
+! The global printlev is used as default value. 
+!  printlev_loc=get_printlev('teststomate')
+
+  IF (is_root_prc) THEN
+     !-
+     ! open STOMATE's forcing file to read some basic info
+     !-
+     forcing_name = 'stomate_forcing.nc'
+     CALL getin ('STOMATE_FORCING_NAME',forcing_name)
+     iret = NF90_OPEN (TRIM(forcing_name),NF90_NOWRITE,forcing_id)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'teststomate', &
+             &        'Could not open file : ', &
+             &          forcing_name,'(Did you forget it ?)')
+     ENDIF
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'dt_sechiba',dtradia)
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'dt_stomate',dt_force)
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'nsft',x)
+     nsft = NINT(x)
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'kjpij',x)
+     kjpij = NINT(x)
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'kjpindex',x)
+     nbp_glo = NINT(x)
+  ENDIF
+
+  CALL bcast(dtradia)
+  CALL bcast(dt_force)
+  CALL bcast(nsft)
+  CALL bcast(nbp_glo)
+  !-
+  WRITE(numout,*) 'ATTENTION dtradia=',dtradia,' dt_force=',dt_force
+  ! Coherence test : stop if dtradia not equal dt_force
+  IF (dtradia /= dt_force) CALL ipslerr (3, 'teststomate','dtradia must be equal to dt_force','','')
+
+  ! Archive the sechiba time step in constantes_var module
+  dt_sechiba=dtradia
+
+  !-
+  ! read info about land points
+  !-
+  IF (is_root_prc) THEN
+     ALLOCATE (indices_g(nbp_glo),stat=ier)
+     IF (ier /= 0) THEN
+        CALL ipslerr (3,'teststomate', &
+             'PROBLEM WITH ALLOCATION', &
+             'for local variable indices_g','')
+     ENDIF
+     !
+     ALLOCATE (x_indices_g(nbp_glo),stat=ier)
+     IF (ier /= 0) THEN
+        CALL ipslerr (3,'teststomate', &
+             'PROBLEM WITH ALLOCATION', &
+             'for global variable x_indices_g','')
+     ENDIF
+
+     ier = NF90_INQ_VARID (forcing_id,'index',vid)
+     IF (ier /= NF90_NOERR) THEN
+        CALL ipslerr (3,'teststomate', &
+             'PROBLEM WITH READING VARIABLE ID', &
+             'for global variable index','')
+     ENDIF
+     ier = NF90_GET_VAR   (forcing_id,vid,x_indices_g)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'teststomate', &
+             'PROBLEM WITH variable "index" in file ', &
+             forcing_name,'(check this file)')
+     ENDIF
+     indices_g(:) = NINT(x_indices_g(:))
+     DEALLOCATE (x_indices_g)
+  ENDIF
+
+!---------------------------------------------------------------------
+!-
+  !-
+  ! activate CO2, STOMATE, but not sechiba
+  !-
+  river_routing = .FALSE.
+  ok_sechiba = .FALSE.
+  ok_stomate = .TRUE.
+
+  ! Deactivate writing of stomate_forcing.nc file
+  allow_forcing_write=.FALSE.
+
+  !-
+  ! is DGVM activated?
+  !-
+  ok_dgvm = .FALSE.
+  CALL getin_p('STOMATE_OK_DGVM',ok_dgvm)
+  WRITE(numout,*) 'LPJ is activated: ',ok_dgvm
+
+  ! Initialize parameter for off-line use : no coupling to atmospheric model
+  OFF_LINE_MODE=.TRUE.
+!-
+! Configuration
+!-
+  ! 1. Number of PFTs defined by the user
+
+  !Config Key   = NVM
+  !Config Desc  = number of PFTs  
+  !Config If    = OK_SECHIBA or OK_STOMATE
+  !Config Def   = 13
+  !Config Help  = The number of vegetation types define by the user
+  !Config Units = [-]
+  !
+  CALL getin_p('NVM',nvm)
+  WRITE(numout,*)'the number of pfts is : ', nvm
+
+  ! 2. Should we read the parameters in the run.def file ?
+  
+  !Config Key   = IMPOSE_PARAM
+  !Config Desc  = Do you impose the values of the parameters?
+  !Config if    = OK_SECHIBA or OK_STOMATE
+  !Config Def   = y
+  !Config Help  = This flag can deactivate the reading of some parameters.
+  !Config         Useful if you want to use the standard values without commenting the run.def
+  !Config Units = [FLAG]
+  !
+  CALL getin_p('IMPOSE_PARAM',impose_param)
+
+  ! 3. Allocate and intialize the pft parameters
+
+  CALL pft_parameters_main()
+
+  ! 4. Activation sub-models of ORCHIDEE
+
+  CALL activate_sub_models()
+
+  ! 5. Vegetation configuration (impveg, land_use, lcchange...previously in slowproc)
+
+  CALL veget_config
+
+  ! 6. Read the parameters in the run.def file
+
+  IF (impose_param) THEN
+     CALL config_pft_parameters
+     CALL config_stomate_pft_parameters
+     CALL config_co2_parameters
+     CALL config_stomate_parameters
+  ENDIF
+  !-
+  IF (ok_dgvm) THEN
+     IF ( impose_param ) THEN
+        CALL config_dgvm_parameters
+     ENDIF
+  ENDIF
+!-
+  !-
+  ! restart files
+  !-
+  IF (is_root_prc) THEN
+     ! Sechiba's restart files
+     sec_restname_in = 'sechiba_start.nc'
+     CALL getin('SECHIBA_restart_in',sec_restname_in)
+     WRITE(numout,*) 'SECHIBA INPUT RESTART_FILE: ',TRIM(sec_restname_in)
+     IF ( TRIM(sec_restname_in) .EQ. 'NONE' ) THEN
+        STOP 'Need a restart file for Sechiba'
+     ENDIF
+     sec_restname_out = 'sechiba_rest_out.nc'
+     CALL getin('SECHIBA_rest_out',sec_restname_out)
+     WRITE(numout,*) 'SECHIBA OUTPUT RESTART_FILE: ',TRIM(sec_restname_out)
+     ! Stomate's restart files
+     sto_restname_in = 'stomate_start.nc'
+     CALL getin('STOMATE_RESTART_FILEIN',sto_restname_in)
+     WRITE(numout,*) 'STOMATE INPUT RESTART_FILE: ',TRIM(sto_restname_in)
+     sto_restname_out = 'stomate_rest_out.nc'
+     CALL getin('STOMATE_RESTART_FILEOUT',sto_restname_out)
+     WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE: ',TRIM(sto_restname_out)
+
+     !-
+     ! We need to know iim, jjm.
+     ! Get them from the restart files themselves.
+     !-
+     iret = NF90_OPEN (sec_restname_in,NF90_NOWRITE,ncfid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'teststomate', &
+             &        'Could not open file : ', &
+             &          sec_restname_in,'(Do you have forget it ?)')
+     ENDIF
+     iret = NF90_INQUIRE_DIMENSION (ncfid,1,len=iim_g)
+     iret = NF90_INQUIRE_DIMENSION (ncfid,2,len=jjm_g)
+     iret = NF90_INQ_VARID (ncfid, "time", iv)
+     iret = NF90_GET_ATT (ncfid, iv, 'calendar',thecalendar)
+     iret = NF90_CLOSE (ncfid)
+     i=INDEX(thecalendar,ACHAR(0))
+     IF ( i > 0 ) THEN
+        thecalendar(i:20)=' '
+     ENDIF
+  ENDIF
+  CALL bcast(iim_g)
+  CALL bcast(jjm_g)
+  CALL bcast(thecalendar)
+  !-
+  ! calendar
+  !-
+  CALL ioconf_calendar (thecalendar)
+  CALL ioget_calendar  (one_year,one_day)
+  !
+  ! Parallelization :
+  !
+!  CALL init_data_para(iim_g,jjm_g,nbp_glo,indices_g)
+  CALL grid_set_glo(iim_g,jjm_g,nbp_glo)
+  CALL grid_allocate_glo(4)
+
+  ! Initialize index_g needed for module grid
+  ! index_g is declared in mod_orchidee_para and allocated by grid_allocate_glo
+  ! index_g and indices_g are the same but indeces_g only declared on root proc. 
+  IF (is_root_prc) THEN
+     index_g(:)=indices_g(:)
+     ! Only use index_g from now and on => Deallocate indices_g.
+     DEALLOCATE(indices_g)
+  END IF
+  CALL bcast(index_g)
+
+  CALL init_orchidee_data_para_driver(nbp_glo, index_g)
+  kjpindex=nbp_loc
+  jjm=jj_nb
+  iim=iim_g
+  kjpij=iim*jjm
+  IF (printlev_loc>=3) WRITE(numout,*) "Local grid : ",kjpindex,iim,jjm
+  !-
+  !-
+  ! read info about grids
+  !-
+  !-
+  llm=1
+  ALLOCATE(lev(llm))
+  IF (is_root_prc) THEN
+     !-
+     ier = NF90_INQ_VARID (forcing_id,'lalo',vid)
+     ier = NF90_GET_VAR   (forcing_id,vid,lalo_g)
+     !-
+     ALLOCATE (x_neighbours_g(nbp_glo,8),stat=ier)
+     ier = NF90_INQ_VARID (forcing_id,'neighbours',vid)
+     ier = NF90_GET_VAR   (forcing_id,vid,x_neighbours_g)
+     neighbours_g(:,:) = NINT(x_neighbours_g(:,:))
+     DEALLOCATE (x_neighbours_g)
+     !-
+     ier = NF90_INQ_VARID (forcing_id,'resolution',vid)
+     ier = NF90_GET_VAR   (forcing_id,vid,resolution_g)
+     !-
+     ier = NF90_INQ_VARID (forcing_id,'contfrac',vid)
+     ier = NF90_GET_VAR   (forcing_id,vid,contfrac_g)
+
+     lon_g(:,:) = zero
+     lat_g(:,:) = zero
+     lev(1)   = zero
+     !-
+     CALL restini &
+          & (sec_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
+          &  sec_restname_out, itau_dep, date0, dt, rest_id_sec)
+     !-
+     IF ( dt .NE. dtradia ) THEN
+        WRITE(numout,*) 'dt',dt
+        WRITE(numout,*) 'dtradia',dtradia
+        CALL ipslerr (3,'teststomate', &
+             &        'PROBLEM with time steps.', &
+             &          sec_restname_in,'(dt .NE. dtradia)')
+     ENDIF
+     !-
+     CALL restini &
+          & (sto_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
+          &  sto_restname_out, itau_dep, date0, dt, rest_id_sto)
+     !-
+     IF ( dt .NE. dtradia ) THEN
+        WRITE(numout,*) 'dt',dt
+        WRITE(numout,*) 'dtradia',dtradia
+        CALL ipslerr (3,'teststomate', &
+             &        'PROBLEM with time steps.', &
+             &          sto_restname_in,'(dt .NE. dtradia)')
+     ENDIF
+  ENDIF
+  CALL bcast(rest_id_sec)
+  CALL bcast(rest_id_sto)
+  CALL bcast(itau_dep)
+  CALL bcast(date0)
+  CALL bcast(dt)
+  CALL bcast(lev)
+  !---
+  !--- Create the index table
+  !---
+  !--- This job return a LOCAL kindex
+  !---
+  ALLOCATE (indices(kjpindex),stat=ier)
+  IF (printlev_loc>=3 .AND. is_root_prc) WRITE(numout,*) "index_g = ",index_g(1:nbp_glo)
+  CALL scatter(index_g,indices)
+  indices(1:kjpindex)=indices(1:kjpindex)-(jj_begin-1)*iim_g
+  IF (printlev_loc>=3) WRITE(numout,*) "indices = ",indices(1:kjpindex)
+
+  !---
+  !--- initialize global grid
+  !---
+  CALL grid_init( kjpindex, 4, "RegLonLat", "ForcingGrid" ) 
+  CALL grid_stuff (nbp_glo, iim_g, jjm_g, lon_g, lat_g, index_g)
+
+  !---
+  !--- initialize local grid
+  !---
+  jlandindex = (((indices(1:kjpindex)-1)/iim) + 1)
+  if (printlev_loc>=3) WRITE(numout,*) "jlandindex = ",jlandindex(1:kjpindex)
+  ilandindex = (indices(1:kjpindex) - (jlandindex(1:kjpindex)-1)*iim)
+  IF (printlev_loc>=3) WRITE(numout,*) "ilandindex = ",ilandindex(1:kjpindex)
+  ALLOCATE(lon(iim,jjm))
+  ALLOCATE(lat(iim,jjm))
+  lon=zero
+  lat=zero
+  CALL scatter2D_mpi(lon_g,lon)
+  CALL scatter2D_mpi(lat_g,lat)
+
+  DO ji=1,kjpindex
+
+     j = jlandindex(ji)
+     i = ilandindex(ji)
+
+     !- Create the internal coordinate table
+!-
+     lalo(ji,1) = lat(i,j)
+     lalo(ji,2) = lon(i,j)
+  ENDDO
+  CALL scatter(neighbours_g,neighbours)
+  CALL scatter(resolution_g,resolution)
+  CALL scatter(contfrac_g,contfrac)
+  CALL scatter(area_g,area)
+  !-
+  !- Check if we have by any chance a rectilinear grid. This would allow us to 
+  !- simplify the output files.
+  !
+  rectilinear = .FALSE.
+  IF (is_root_prc) THEN
+     IF ( ALL(lon_g(:,:) == SPREAD(lon_g(:,1), 2, SIZE(lon_g,2))) .AND. &
+       & ALL(lat_g(:,:) == SPREAD(lat_g(1,:), 1, SIZE(lat_g,1))) ) THEN
+        rectilinear = .TRUE.
+     ENDIF
+  ENDIF
+  CALL bcast(rectilinear)
+  IF (rectilinear) THEN
+     ALLOCATE(lon_rect(iim),stat=ier)
+     IF (ier .NE. 0) THEN
+        WRITE (numout,*) ' error in lon_rect allocation. We stop. We need iim words = ',iim
+        STOP 'intersurf_history'
+     ENDIF
+     ALLOCATE(lat_rect(jjm),stat=ier)
+     IF (ier .NE. 0) THEN
+        WRITE (numout,*) ' error in lat_rect allocation. We stop. We need jjm words = ',jjm
+        STOP 'intersurf_history'
+     ENDIF
+     lon_rect(:) = lon(:,1)
+     lat_rect(:) = lat(1,:)
+  ENDIF
+  !-
+  ! allocate arrays
+  !-
+  !
+  a_er = .FALSE.
+  ALLOCATE (hist_PFTaxis(nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (indexveg(kjpindex*nvm), stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (soiltile(kjpindex,nstm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (veget_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (totfrac_nobio(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (frac_nobio(kjpindex,nnobio),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (veget_max_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (lai_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (veget_force_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (veget_max_force_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (njsc(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (lai_force_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (reinf_slope(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (t2m(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (t2m_min(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (temp_sol(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (soiltemp(kjpindex,nbdl),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (soilhum(kjpindex,nbdl),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (humrel_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (litterhum(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (precip_rain(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (precip_snow(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (gpp_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (deadleaf_cover(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (assim_param_x(kjpindex,nvm,npco2),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (height_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (qsintmax_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (co2_flux(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (fco2_lu(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (temp_growth(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (tot_bare_soil(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (frac_age_x(kjpindex,nvm,nleafages),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  IF (a_er) THEN
+     CALL ipslerr (3,'teststomate', &
+          &        'PROBLEM WITH ALLOCATION', &
+          &        'for local variables 1','')
+  ENDIF
+  !
+  ! prepare forcing
+  ! forcing file of STOMATE is read by block 
+  ! in order to minimize the reading frequency
+  ! Here is done the calculation of the number 
+  ! of time steps we load in memory 
+  !
+  max_totsize = 50
+  CALL getin_p ('STOMATE_FORCING_MEMSIZE',max_totsize)
+  max_totsize = max_totsize * 1000000
+
+  totsize_1step = SIZE(soiltile(:,3))*KIND(soiltile(:,3)) + &
+       SIZE(humrel_x)*KIND(humrel_x) + &
+       SIZE(litterhum)*KIND(litterhum) + &
+       SIZE(t2m)*KIND(t2m) + &
+       SIZE(t2m_min)*KIND(t2m_min) + &
+       SIZE(temp_sol)*KIND(temp_sol) + &
+       SIZE(soiltemp)*KIND(soiltemp) + &
+       SIZE(soilhum)*KIND(soilhum) + &
+       SIZE(precip_rain)*KIND(precip_rain) + &
+       SIZE(precip_snow)*KIND(precip_snow) + &
+       SIZE(gpp_x)*KIND(gpp_x) + &
+       SIZE(veget_force_x)*KIND(veget_force_x) + &
+       SIZE(veget_max_force_x)*KIND(veget_max_force_x) + &
+       SIZE(lai_force_x)*KIND(lai_force_x)
+  CALL reduce_sum(totsize_1step,totsize_tmp)
+  CALL bcast(totsize_tmp)
+  totsize_1step=totsize_tmp 
+
+  ! check for consistency of the total number of forcing steps
+  IF ( nsft .NE. INT(one_year/(dt_force/one_day)) ) THEN
+     CALL ipslerr_p (3,'teststomate', &
+          &        'stomate: error with total number of forcing steps', &
+          &        'nsft','teststomate computation different with forcing file value.')
+  ENDIF
+  ! number of forcing steps in memory
+  nsfm = MIN(nsft, &
+       &       MAX(1,NINT( REAL(max_totsize,r_std) &
+       &                  /REAL(totsize_1step,r_std))))
+  !-
+  WRITE(numout,*) 'Offline forcing of Stomate:'
+  WRITE(numout,*) '  Total number of forcing steps:',nsft
+  WRITE(numout,*) '  Number of forcing steps in memory:',nsfm
+  !-
+  ! init_forcing defined into stomate.f90
+  ! allocate and set to zero driving variables of STOMATE
+  ! ie variables that are read in the forcing file
+  !-
+  CALL init_forcing(kjpindex,nsfm,nsft)
+  !-
+  ! ensure that we read all new forcing states
+  iisf = nsfm
+  ! initialize the table that contains the indices
+  ! of the forcing states that will be in memory
+  isf(:) = (/ (i,i=1,nsfm) /)
+
+  nf_written(:) = .FALSE.
+  nf_written(isf(:)) = .TRUE.
+
+  !-
+  ! a time step for STOMATE corresponds to itau_step timesteps in SECHIBA
+  !-
+  itau_step = NINT(dt_force/dtradia)
+  IF (printlev_loc>=3) WRITE(numout,*) "dtradia, dt_rest, dt_force, itau_step",dtradia, dt, dt_force, itau_step
+  !
+  CALL ioconf_startdate(date0)
+  CALL intsurf_time( itau_dep, date0 )
+  !-
+  ! Length of integration
+  !-
+  WRITE(time_str,'(a)') '1Y'
+  CALL getin_p ('TIME_LENGTH', time_str)
+  ! transform into itau
+  CALL tlen2itau(time_str, dt, date0, itau_len)
+  ! itau_len*dtradia must be a multiple of dt_force
+  itau_len = NINT( MAX(1.0,FLOAT(NINT(itau_len*dtradia/dt_force))) &
+       &                *dt_force/dtradia)
+  !-
+  itau_fin = itau_dep+itau_len
+  !-
+  ! 2. set up STOMATE history file
+  !
+  ! Initialize ioipsl_para module
+  CALL  init_ioipsl_para
+
+  !-
+  !Config Key   = STOMATE_OUTPUT_FILE
+  !Config Desc  = Name of file in which STOMATE's output is going to be written
+  !Config If    = 
+  !Config Def   = stomate_history.nc
+  !Config Help  = This file is going to be created by the model
+  !Config         and will contain the output from the model.
+  !Config         This file is a truly COADS compliant netCDF file.
+  !Config         It will be generated by the hist software from
+  !Config         the IOIPSL package.
+  !Config Units = FILE
+  !-
+  stom_histname='stomate_history.nc'
+  CALL getin_p ('STOMATE_OUTPUT_FILE', stom_histname)
+  WRITE(numout,*) 'STOMATE_OUTPUT_FILE', TRIM(stom_histname)
+  !-
+  !Config Key   = STOMATE_HIST_DT
+  !Config Desc  = STOMATE history time step 
+  !Config If    = 
+  !Config Def   = 10.
+  !Config Help  = Time step of the STOMATE history file
+  !Config Units = days [d]
+  !-
+  hist_days_stom = 10.
+  CALL getin_p ('STOMATE_HIST_DT', hist_days_stom)
+  IF ( hist_days_stom == -1. ) THEN
+     hist_dt_stom = -1.
+     WRITE(numout,*) 'output frequency for STOMATE history file (d): one month.'
+  ELSE
+     hist_dt_stom = NINT( hist_days_stom ) * one_day
+     WRITE(numout,*) 'output frequency for STOMATE history file (d): ', &
+             hist_dt_stom/one_day
+  ENDIF
+  !-
+  !- initialize
+  WRITE(numout,*) "before histbeg : ",date0,dt
+  IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+     CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+          &     itau_dep, date0, dt, hori_id, hist_id_stom, domain_id=orch_domain_id)
+#else
+     CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+          &     itau_dep, date0, dt, hori_id, hist_id_stom)
+#endif
+  ELSE
+#ifdef CPP_PARA
+     CALL histbeg(stom_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+          &     itau_dep, date0, dt, hori_id, hist_id_stom, domain_id=orch_domain_id)
+#else
+     CALL histbeg(stom_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+          &     itau_dep, date0, dt, hori_id, hist_id_stom)
+#endif
+  ENDIF
+  !- define PFT axis
+  hist_PFTaxis = (/ ( REAL(i,r_std), i=1,nvm ) /)
+  !- declare this axis
+  CALL histvert (hist_id_stom, 'PFT', 'Plant functional type', &
+       & '1', nvm, hist_PFTaxis, hist_PFTaxis_id)
+!- define Pool_10 axis
+   hist_pool_10axis = (/ ( REAL(i,r_std), i=1,10 ) /)
+!- declare this axis
+  CALL histvert (hist_id_stom, 'P10', 'Pool 10 years', &
+       & '1', 10, hist_pool_10axis, hist_pool_10axis_id)
+
+!- define Pool_100 axis
+   hist_pool_100axis = (/ ( REAL(i,r_std), i=1,100 ) /)
+!- declare this axis
+  CALL histvert (hist_id_stom, 'P100', 'Pool 100 years', &
+       & '1', 100, hist_pool_100axis, hist_pool_100axis_id)
+
+!- define Pool_11 axis
+   hist_pool_11axis = (/ ( REAL(i,r_std), i=1,11 ) /)
+!- declare this axis
+  CALL histvert (hist_id_stom, 'P11', 'Pool 10 years + 1', &
+       & '1', 11, hist_pool_11axis, hist_pool_11axis_id)
+
+!- define Pool_101 axis
+   hist_pool_101axis = (/ ( REAL(i,r_std), i=1,101 ) /)
+!- declare this axis
+  CALL histvert (hist_id_stom, 'P101', 'Pool 100 years + 1', &
+       & '1', 101, hist_pool_101axis, hist_pool_101axis_id)
+
+  !- define STOMATE history file
+  CALL ioipslctrl_histstom (hist_id_stom, nvm, iim, jjm, &
+       & dt, hist_dt_stom, hori_id, hist_PFTaxis_id, &
+ & hist_pool_10axis_id, hist_pool_100axis_id, &
+ & hist_pool_11axis_id, hist_pool_101axis_id)
+
+  !- end definition
+  CALL histend(hist_id_stom)
+  !-
+  !-
+  ! STOMATE IPCC OUTPUTS IS ACTIVATED
+  !-
+  !Config Key   = STOMATE_IPCC_OUTPUT_FILE
+  !Config Desc  = Name of file in which STOMATE's output is going to be written
+  !Config If    = 
+  !Config Def   = stomate_ipcc_history.nc
+  !Config Help  = This file is going to be created by the model
+  !Config         and will contain the output from the model.
+  !Config         This file is a truly COADS compliant netCDF file.
+  !Config         It will be generated by the hist software from
+  !Config         the IOIPSL package.
+  !Config Units = FILE
+  !-
+  stom_ipcc_histname='stomate_ipcc_history.nc'
+  CALL getin_p('STOMATE_IPCC_OUTPUT_FILE', stom_ipcc_histname)       
+  WRITE(numout,*) 'STOMATE_IPCC_OUTPUT_FILE', TRIM(stom_ipcc_histname)
+  !-
+  !Config Key   = STOMATE_IPCC_HIST_DT
+  !Config Desc  = STOMATE IPCC history time step 
+  !Config If    = 
+  !Config Def   = 0.
+  !Config Help  = Time step of the STOMATE IPCC history file
+  !Config Units = days [d]
+  !-
+  hist_days_stom_ipcc = zero
+  CALL getin_p('STOMATE_IPCC_HIST_DT', hist_days_stom_ipcc)       
+  IF ( hist_days_stom_ipcc == moins_un ) THEN
+     hist_dt_stom_ipcc = moins_un
+     WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): one month.'
+  ELSE
+     hist_dt_stom_ipcc = NINT( hist_days_stom_ipcc ) * one_day
+     WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): ', &
+          hist_dt_stom_ipcc/one_day
+  ENDIF
+
+  ! test consistency between STOMATE_IPCC_HIST_DT and DT_STOMATE parameters
+  dt_stomate_loc = one_day
+  CALL getin_p('DT_STOMATE', dt_stomate_loc)
+  IF ( hist_days_stom_ipcc > zero ) THEN
+     IF (dt_stomate_loc > hist_dt_stom_ipcc) THEN
+        WRITE(numout,*) "DT_STOMATE = ",dt_stomate_loc,"  , STOMATE_IPCC_HIST_DT = ",hist_dt_stom_ipcc
+        CALL ipslerr_p (3,'intsurf_history', &
+             &          'Problem with DT_STOMATE > STOMATE_IPCC_HIST_DT','', &
+             &          '(must be less or equal)')
+     ENDIF
+  ENDIF
+
+  IF ( hist_dt_stom_ipcc == 0 ) THEN
+     hist_id_stom_ipcc = -1
+  ELSE
+     !-
+     !- initialize
+     IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+        CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
+#else
+        CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc)
+#endif
+     ELSE
+#ifdef CPP_PARA
+        CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
+#else
+        CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc)
+#endif
+     ENDIF
+     !- declare this axis
+     CALL histvert (hist_id_stom_IPCC, 'PFT', 'Plant functional type', &
+          & '1', nvm, hist_PFTaxis, hist_IPCC_PFTaxis_id)
+
+     !- define STOMATE history file
+     CALL ioipslctrl_histstomipcc(hist_id_stom_IPCC, nvm, iim, jjm, &
+          & dt, hist_dt_stom_ipcc, hori_id, hist_IPCC_PFTaxis_id)
+
+     !- end definition
+     CALL histend(hist_id_stom_IPCC)
+
+  ENDIF
+  !
+  CALL histwrite_p(hist_id_stom, 'Areas',  itau_dep+itau_step, area, kjpindex, indices)
+  IF ( hist_id_stom_IPCC > 0 ) THEN
+     CALL histwrite_p(hist_id_stom_IPCC, 'Areas',  itau_dep+itau_step, area, kjpindex, indices)
+  ENDIF
+  !
+  hist_id_sec = -1
+  hist_id_sec2 = -1
+  !-
+  ! 3. first call of slowproc to initialize variables
+  !-
+  itau = itau_dep
+  !  
+  DO ji=1,kjpindex
+     DO jv=1,nvm
+        indexveg((jv-1)*kjpindex + ji) = indices(ji) + (jv-1)*kjpij
+     ENDDO
+  ENDDO
+  !-
+  !
+  CALL getin_p ("DEPTH_MAX_H", zmaxh)
+  !
+  !MM Problem here with dpu which depends on soil type           
+  DO l = 1, nbdl-1
+     ! first 2.0 is dpu 
+     ! second 2.0 is average
+     diaglev(l) = zmaxh/(2**(nbdl-1) -1) * ( ( 2**(l-1) -1) + ( 2**(l) -1) ) / 2.0
+  ENDDO
+  diaglev(nbdl) = zmaxh
+  !
+!-
+! Read the parameters in the "*.def" files
+!-
+  !
+  !Config Key   = CLAYFRACTION_DEFAULT
+  !Config Desc  = 
+  !Config If    = OK_SECHIBA 
+  !Config Def   = 0.2 
+  !Config Help  = 
+  !Config Units = [-]
+  CALL getin_p('CLAYFRACTION_DEFAULT',clayfraction_default)
+  !
+  !Config Key   = MIN_VEGFRAC 
+  !Config Desc  = Minimal fraction of mesh a vegetation type can occupy 
+  !Config If    = OK_SECHIBA 
+  !Config Def   = 0.001 
+  !Config Help  = 
+  !Config Units = [-]
+  CALL getin_p('MIN_VEGFRAC',min_vegfrac)
+  !
+  !Config Key   = STEMPDIAG_BID 
+  !Config Desc  = only needed for an initial LAI if there is no restart file
+  !Config If    = OK_SECHIBA 
+  !Config Def   = 280.
+  !Config Help  = 
+  !Config Units = [K]
+  CALL getin_p('STEMPDIAG_BID',stempdiag_bid)
+  !
+!-
+  CALL ioget_expval(val_exp)
+  ldrestart_read = .TRUE.
+  ldrestart_write = .FALSE.
+  !-
+  ! read some variables we need from SECHIBA's restart file
+  !-
+  CALL slowproc_initialize (itau,        kjpij,       kjpindex,                          &
+                            rest_id_sec, rest_id_sto, hist_id_stom,   hist_id_stom_IPCC, &
+                            indices,     indexveg,    lalo,           neighbours,        &
+                            resolution,  contfrac,    t2m,                               &
+                            soiltile,    reinf_slope, deadleaf_cover, assim_param_x,     &
+                            lai_x,       frac_age_x,  height_x,       veget_x,           &
+                            frac_nobio,  njsc,        veget_max_x,    tot_bare_soil,     &
+                            totfrac_nobio, qsintmax_x, co2_flux,      fco2_lu, temp_growth)
+
+!  Old interface to slowproc_main, before revision 2581
+!  CALL slowproc_main &
+! &  (itau, kjpij, kjpindex, dt_force, date0, &
+! &   ldrestart_read, ldrestart_write, &
+! &   indices, indexveg, lalo, neighbours, resolution, contfrac, soiltile, reinf_slope, &
+! &   t2m, t2m_min, temp_sol, soiltemp, &
+! &   humrel_x, soilhum, litterhum, precip_rain, precip_snow, gpp_x, &
+! &   deadleaf_cover, assim_param_x, lai_x, frac_age_x, height_x, veget_x, &
+! &   frac_nobio, njsc, veget_max_x, totfrac_nobio, qsintmax_x, &
+! &   rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, co2_flux, fco2_lu, temp_growth)
+  ! correct date
+
+
+  date=1
+
+  CALL intsurf_time( itau_dep+itau_step, date0 )
+  lstep_init_intersurf=.FALSE.
+  !-
+  ! 4. Time loop
+  !â»
+  DO itau = itau_dep+itau_step,itau_fin,itau_step
+    !
+    CALL intsurf_time( itau, date0 )
+    !-
+    ! next forcing state
+    iisf = iisf+1
+    IF (printlev_loc>=3) WRITE(numout,*) "itau,iisf : ",itau,iisf
+    !---
+    IF (iisf .GT. nsfm) THEN
+!-----
+!---- we have to read new forcing states from the file
+!-----
+!---- determine blocks of forcing states that are contiguous in memory
+!-----
+        CALL stomate_forcing_read(forcing_id,nsfm)
+
+!--------------------------
+
+!-----
+!---- determine which forcing states must be read next time
+!-----
+      isf(1) = isf(nsfm)+1
+      IF ( isf(1) .GT. nsft ) isf(1) = 1
+        DO iiisf = 2, nsfm
+           isf(iiisf) = isf(iiisf-1)+1
+           IF ( isf(iiisf) .GT. nsft ) isf(iiisf) = 1
+        ENDDO
+        nf_written(isf(:)) = .TRUE.
+!---- start again at first forcing state
+        iisf = 1
+     ENDIF
+     humrel_x(:,:) = humrel_daily_fm(:,:,iisf)
+     litterhum(:) = litterhum_daily_fm(:,iisf)
+     t2m(:) = t2m_daily_fm(:,iisf)
+     t2m_min(:) = t2m_min_daily_fm(:,iisf)
+     temp_sol(:) = tsurf_daily_fm(:,iisf)
+     soiltemp(:,:) = tsoil_daily_fm(:,:,iisf)
+     soilhum(:,:) = soilhum_daily_fm(:,:,iisf)
+     precip_rain(:) = precip_fm(:,iisf)
+     gpp_x(:,:) = gpp_daily_fm(:,:,iisf)
+     veget_force_x(:,:) = veget_fm(:,:,iisf)
+     veget_max_force_x(:,:) = veget_max_fm(:,:,iisf)
+     lai_force_x(:,:) = lai_fm(:,:,iisf)
+     WHERE ( t2m(:) .LT. ZeroCelsius )
+        precip_snow(:) = precip_rain(:)
+        precip_rain(:) = zero
+     ELSEWHERE
+        precip_snow(:) = zero
+     ENDWHERE
+!---
+!-- scale GPP to new lai and veget_max
+!---
+     WHERE ( lai_x(:,:) .EQ. zero ) gpp_x(:,:) = zero
+!-- scale GPP to new LAI
+     WHERE (lai_force_x(:,:) .GT. zero )
+        gpp_x(:,:) = gpp_x(:,:)*ATAN(2.*lai_x(:,:)) &
+ &                           /ATAN( 2.*MAX(lai_force_x(:,:),0.01))
+    ENDWHERE
+    !- scale GPP to new veget_max
+    WHERE (veget_max_force_x(:,:) .GT. zero )
+        gpp_x(:,:) = gpp_x(:,:)*veget_max_x(:,:)/veget_max_force_x(:,:)
+    ENDWHERE
+    !-
+    !- number crunching
+    !-
+     ldrestart_read = .FALSE.
+     ldrestart_write = .FALSE.
+     CALL slowproc_main &
+ &    (itau, kjpij, kjpindex, &
+ &     indices, indexveg, lalo, neighbours, resolution, contfrac, soiltile, &
+ &     t2m, temp_sol, soiltemp, &
+ &     humrel_x, soilhum, litterhum, precip_rain, precip_snow, gpp_x, &
+ &     deadleaf_cover, assim_param_x, lai_x, frac_age_x, height_x, veget_x, &
+ &     frac_nobio, veget_max_x, totfrac_nobio, qsintmax_x, &
+ &     rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, &
+ &     co2_flux, fco2_lu, temp_growth, tot_bare_soil)!, &
+! &     u, v)
+
+  ENDDO ! end of the time loop
+
+
+!-
+! 5. write restart files
+!-
+  IF (is_root_prc) THEN
+! first, read and write variables that are not managed otherwise
+     taboo_vars = &
+          &  '$lat$ $lon$ $lev$ $veget_year$ '// &
+          &  '$height$ $veget$ $veget_max$ $frac_nobio$ '// &
+          &  '$lai$ $soiltile_frac$ $clay_frac$ '// &
+          &  '$nav_lon$ $nav_lat$ $nav_lev$ $time$ $time_steps$'
+!-
+     CALL ioget_vname(rest_id_sec, nbvar, varnames)
+!-
+     DO iv = 1, nbvar
+!-- check if the variable is to be written here
+        IF (INDEX( taboo_vars,'$'//TRIM(varnames(iv))//'$') .EQ. 0 ) THEN
+           IF (printlev_loc>=3) WRITE(numout,*) "restart var : ",TRIM(varnames(iv)),itau_dep,itau_fin
+
+!---- get variable dimensions, especially 3rd dimension
+           CALL ioget_vdim &
+                &      (rest_id_sec, varnames(iv), varnbdim_max, varnbdim, vardims)
+           l1d = ALL(vardims(1:varnbdim) .EQ. 1)
+!---- read it
+           IF (l1d) THEN
+              CALL restget (rest_id_sec,TRIM(varnames(iv)), &
+                   1,1,1,itau_dep,.TRUE.,var_1d)
+           ELSE
+              ALLOCATE(var_3d(nbp_glo,vardims(3)),stat=ier)
+              IF (ier .NE. 0) STOP 'ALLOCATION PROBLEM'
+              CALL restget (rest_id_sec,TRIM(varnames(iv)), &
+                   nbp_glo,vardims(3),1,itau_dep,.TRUE.,var_3d, &
+                   "gather",nbp_glo,index_g)
+           ENDIF
+!---- write it
+           IF (l1d) THEN
+              CALL restput (rest_id_sec,TRIM(varnames(iv)), &
+                   1,1,1,itau_fin,var_1d)
+           ELSE
+              CALL restput (rest_id_sec,TRIM(varnames(iv)), &
+                   nbp_glo,vardims(3),1,itau_fin,var_3d, &
+                   'scatter',nbp_glo,index_g)
+              DEALLOCATE (var_3d)
+           ENDIF
+        ENDIF
+     ENDDO
+  ENDIF
+
+#ifdef CPP_PARA  
+  CALL MPI_BARRIER(MPI_COMM_ORCH,ierr)
+#endif
+
+! call slowproc to write restart files
+  ldrestart_read = .FALSE.
+  ldrestart_write = .TRUE.
+!-
+  IF (printlev_loc>=3) WRITE(numout,*) "Call slowproc for restart."
+       CALL slowproc_finalize (itau_fin,   kjpindex,    rest_id_sec, indices,    &
+                               njsc,       lai_x,       height_x,    veget_x,    &
+                               frac_nobio, veget_max_x, reinf_slope,             &
+                               assim_param_x, frac_age_x )
+!!$  CALL slowproc_main &
+!!$ &  (itau_fin, kjpij, kjpindex, dt_force, date0, &
+!!$ &   ldrestart_read, ldrestart_write, &
+!!$ &   indices, indexveg, lalo, neighbours, resolution, contfrac, soiltile, reinf_slope, &
+!!$ &   t2m, t2m_min, temp_sol, soiltemp, &
+!!$ &   humrel_x, soilhum, litterhum, precip_rain, precip_snow, gpp_x, &
+!!$ &   deadleaf_cover, assim_param_x, lai_x, frac_age_x, height_x, veget_x, &
+!!$ &   frac_nobio, njsc, veget_max_x, totfrac_nobio, qsintmax_x, &
+!!$ &   rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, co2_flux, fco2_lu, temp_growth)
+!-
+! close files
+!-
+  IF (is_root_prc) THEN
+     CALL restclo
+     IF ( printlev_loc>=3 )  WRITE(numout,*) 'REST CLOSED'
+  ENDIF
+  CALL histclo
+
+  IF (is_root_prc) &
+       ier = NF90_CLOSE (forcing_id)
+
+  IF (is_root_prc) THEN
+     CALL getin_dump()
+  ENDIF
+#ifdef CPP_PARA
+  CALL MPI_FINALIZE(ier)
+#endif
+  WRITE(numout,*) "End of teststomate."
+
+!---------------
+END PROGRAM teststomate
+!
+!===
+!
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/weather.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/weather.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_driver/weather.f90	(revision 6412)
@@ -0,0 +1,4004 @@
+! =================================================================================================================================
+! MODULE       : weather
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module simulates weather.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE weather
+
+  USE netcdf
+!-
+  USE defprec
+  USE ioipsl_para
+  USE constantes
+  USE mod_orchidee_para
+
+  USE solar
+  USE grid, ONLY : year,month,day,sec
+!-
+  IMPLICIT NONE
+!-
+  PRIVATE
+  PUBLIC weathgen_main, weathgen_domain_size, weathgen_init, weathgen_read_file, weathgen_qsat_2d
+!
+! Only for root proc
+  INTEGER, SAVE                              :: iim_file, jjm_file, llm_file, ttm_file !(unitless)
+  INTEGER,DIMENSION(:,:),SAVE,ALLOCATABLE    :: ncorr !(unitless)
+  INTEGER,DIMENSION(:,:,:),SAVE,ALLOCATABLE  :: icorr,jcorr !(unitless)
+  INTEGER,SAVE                               :: i_cut, n_agg !(unitless)
+
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xinwet   !! climatological wet days + anomaly @tex $(days.month^{-1})$ @endtex
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xinprec  !! climatological precipition + anomaly @tex $(mm.day^{-1})$ @endtex
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xint     !! climatological temp + anomaly (C)
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xinq     !! climatological relative humidity + anomaly (0-1, unitless)
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xinwind  !! climatological wind speed + anomaly @tex $(m.s^{-1})$ @endtex
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xincld   !! climatological cloudiness + anomaly (0-1, unitless)
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xintrng  !! climatological temp range + anomaly (C)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: xintopo  !! topography (m)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: lat_land !! latitudes of land points (unitless)
+!-
+! daily values
+!-
+  REAL,SAVE :: julian_last
+  INTEGER,DIMENSION(:),SAVE,ALLOCATABLE :: iwet    !! flag for wet day / dry day (0-1, unitless)
+!-
+! today's values (m0 means "minus 0")
+!-
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: psurfm0  !! surface pressure today(Pa)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: cloudm0  !! cloud fraction today (0-1, unitless)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: tmaxm0   !! maximum daily temperature today (K)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: tminm0   !! minimum daily temperature today (K)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: qdm0     !! daily average specific humidity today (kg_h2o/kg_air)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: udm0     !! daily average wind speed today  @tex $(m.s^{-1})$ @endtex
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: precipm0 !! daily precitation today @tex $(mm.day^{-1})$ @endtex
+!-
+! yesterday's values (m1 means "minus 1")
+!-
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: psurfm1  !! surface pressure yesterday (Pa)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: cloudm1  !! cloud fraction yesterday (0-1, unitless)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: tmaxm1   !! maximum daily temperature yesterday (K)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: tminm1   !! minimum daily temperature yesterday (K)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: qdm1     !! daily average specific humidity yesterday (kg_h2o/kg_air)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: udm1     !! daily average wind speed  yesterday  @tex $(m.s^{-1})$ @endtex 
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: precipm1 !! daily precitation  yesterday @tex $(mm.day^{-1})$ @endtex 
+!-
+! other
+!-
+  INTEGER,SAVE                  :: ipprec        !! statistical (0) or prescribed (1) daily values
+
+  LOGICAL,SAVE                  :: precip_exact  !! respect monthly precipitation
+  INTEGER,DIMENSION(31,12),SAVE :: jour_precip
+
+
+  INTEGER,PARAMETER      :: seedsize_max = 300  !! max size of random seed
+  LOGICAL,SAVE           :: dump_weather
+  CHARACTER(LEN=20),SAVE :: dump_weather_file
+  LOGICAL,SAVE           :: gathered
+  INTEGER,SAVE           :: dump_id
+
+!
+  REAL,PARAMETER         :: zero_t=273.15   !! Absolute zero
+! 
+  REAL,PARAMETER :: pir = pi/180.
+  REAL,PARAMETER :: rair = 287.
+!-
+  INTEGER,PARAMETER :: nmon = 12  !! Number of months
+
+!
+  CHARACTER(LEN=3),DIMENSION(12) :: cal = &             !! Months of the year (unitless)
+ &  (/ 'JAN','FEB','MAR','APR','MAY','JUN', &
+ &     'JUL','AUG','SEP','OCT','NOV','DEC' /)
+  INTEGER,DIMENSION(12),SAVE :: ndaypm = &              !! Number of days per month (noleap year) (unitless)
+ &  (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
+  INTEGER,SAVE :: soldownid, rainfid, snowfid, lwradid, &
+ &                tairid, qairid,  psolid, uid, vid, &
+ &                time_id, timestp_id
+!-
+  INTEGER,SAVE :: n_rtp = nf90_real4      !! Parameters for NETCDF 
+!- 
+  INTEGER  :: ALLOC_ERR                   !! Flag for dynamic allocations 
+!-
+  CHARACTER(LEN=20),SAVE :: calendar_str   !! Calendar type
+!-
+  INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: kindex_w  !! Land points index
+  INTEGER, SAVE                            :: nbindex_w  !! Land points index
+!-
+  INTEGER, PARAMETER :: termcol = 100     !! Plot of projection file => grid, number of column on terminal
+!80
+  CONTAINS
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : daily
+!!
+!>\BRIEF          This routine generates daily weather conditions from monthly-mean
+!! climatic parameters.
+!!
+!! DESCRIPTION  :  Specifically, this routine generates daily values of 
+!!                 - daily total precipitation \n
+!!                 - daily maximum temperature \n
+!!                 - daily minimum temperature \n
+!!                 - daily average cloud cover \n
+!!                 - daily average relative humidity \n
+!!                 - daily average wind speed \n
+!!                 In order to generate daily weather conditions, the model uses
+!!                 a series of 'weather generator' approaches,
+!!                 which generate random combinations of weather conditions
+!!                 based upon the climatological conditions in general. \n
+!!                 This weather generator is based upon the so-called Richardson
+!!                 weather generator. \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::psurf, ::cloud, ::tmax, ::tmin, ::qd, ::ud, ::precip 
+!!
+!! REFERENCE(S) :
+!! -  Geng, S., F.W.T. Penning de Vries, and L. Supit, 1985:  A simple
+!! method for generating rainfall data, Agricultural and Forest
+!! Meteorology, 36, 363-376.
+!! -  Richardson, C. W. and Wright, D. A., 1984: WGEN: A model for
+!! generating daily weather variables: U. S. Department of
+!! Agriculture, Agricultural Research Service. 
+!! - Richardson, C., 1981: Stochastic simulation of daily
+!! precipitation, temperature, and solar radiation. Water Resources
+!! Research 17, 182-190. 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE daily &
+ &  (npoi, imonth, iday, cloud, tmax, tmin, precip, qd, ud, psurf)
+
+!-
+! in & out: global variables
+!-
+
+! INTEGER,INTENT(INOUT):: iwet(npoi) !! wet day / dry day flag!*
+!-
+
+  !! 0. Parameters and variables declaration
+
+  REAL,PARAMETER :: rair = 287.     !! Molecular weight of one mole of dry air @tex $(g.mol{-1})$ @endtex
+  REAL,PARAMETER :: grav = 9.81     !! Acceleration of the gravity @tex $(m.s^{-2})$ @endtex
+  REAL,PARAMETER :: pi = 3.1415927  !! pi
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN) :: npoi         !! total number of land points
+  INTEGER,INTENT(IN) :: imonth, iday
+
+  !! 0.2 Output variables
+
+  REAL,INTENT(OUT) :: psurf(npoi)   !! surface pressure (Pa)
+  REAL,INTENT(OUT) :: cloud(npoi)   !! cloud fraction (0-1, unitless)
+  REAL,INTENT(OUT) :: tmax(npoi)    !! maximum daily temperature (K)
+  REAL,INTENT(OUT) :: tmin(npoi)    !! minimum daily temperature (K)
+  REAL,INTENT(OUT) :: qd(npoi)      !! daily average specific humidity (kg_h2o/kg_air)
+  REAL,INTENT(OUT) :: ud(npoi)      !! daily average wind speed  @tex $(m.s^{-1})$ @endtex
+  REAL,INTENT(OUT) :: precip(npoi)  !! daily precitation @tex $(mm.day^{-1})$ @endtex
+
+  !! 0.4 Local variables
+
+  REAL :: td(npoi)                                 !! daily average temperature (K)
+  REAL,allocatable,save,dimension(:,:) ::  xstore  !! weather generator 'memory' matrix
+  REAL :: ee(3), r(3), rr(npoi,3)
+  REAL :: alpha(npoi), rndnum, pwd, pww
+  REAL :: beta(npoi)
+  REAL :: pwet(npoi)
+  REAL :: rwork
+  REAL :: omcloud, omqd, omtmax
+  REAL :: cloudm, cloudw, cloudd
+  REAL :: cloude(npoi), clouds(npoi)
+  REAL :: tmaxd, tmaxw, tmaxm
+  REAL :: tminm
+  REAL :: tmins(npoi), tmaxs(npoi)
+  REAL :: tmine(npoi), tmaxe(npoi)
+  REAL :: qdm(npoi),qdd(npoi),qde(npoi),qdw(npoi),qdup(npoi),qdlow(npoi)
+  INTEGER :: i,j,k
+  REAL :: amn,b1,b2,b3,eud,rn,rn1,rn2,rn3,rn4,s1,s2,s12,x1,y, z(npoi)
+  REAL :: aa(npoi),ab(npoi),tr1(npoi), tr2(npoi)
+  REAL :: tdm,trngm,tdum
+  REAL :: qsattd(npoi)
+  INTEGER :: it1w, it2w
+  REAL :: dt
+  REAL :: rainpwd(npoi)
+  INTEGER :: not_ok(npoi)
+  INTEGER :: count_not_ok,count_not_ok_g
+  LOGICAL,SAVE :: lstep_init_daily = .TRUE.
+  INTEGER,save :: npoi0
+  REAL :: xx
+  REAL, DIMENSION(3,3) :: a,b              !! define autocorrelation matrices for Richardson generator
+                                           !!
+                                           !! note that this matrix should be based upon a statistical
+                                           !! analysis of regional weather patterns
+                                           !!
+                                           !! for global simulations, we use 'nominal' values
+
+  LOGICAL :: Warning_aa_ab(npoi), Warning_iwet(npoi) !! Warnings
+!---------------------------------------------------------------------
+!-
+! initial setup for daily climate calculations
+!-
+  a(1,:) = (/ 0.600,  0.500,  0.005 /)
+  a(2,:) = (/ 0.010,  0.250,  0.005 /)
+  a(3,:) = (/ 0.020,  0.125,  0.250 /)
+!-
+  b(1,:) = (/ 0.500,  0.250, -0.250 /)
+  b(2,:) = (/ 0.000,  0.500,  0.250 /)
+  b(3,:) = (/ 0.000,  0.000,  0.500 /)
+!-
+! GK240100
+  IF (lstep_init_daily) THEN
+    lstep_init_daily = .FALSE.
+    ALLOC_ERR=-1
+    ALLOCATE(xstore(npoi,3), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of xstore : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    xstore(:,:) = zero
+    npoi0 = npoi
+  ELSE IF (npoi /= npoi0) THEN
+    WRITE(numout,*) 'Domain size old, new: ',npoi0,npoi
+    STOP 'WG Daily: Problem: Domain has changed since last call'
+  ENDIF
+!-
+! define working variables
+!-
+  rwork = (cte_grav/rair/0.0065)
+!-
+! 'omega' parameters used to calculate differences in expected
+! climatic parameters on wet and dry days
+!
+! following logic of weather generator used in the EPIC crop model
+!
+! omcloud -- cloud cover
+! omqd    -- humidity
+! omtmax  -- maximum temperature
+!-
+  omcloud = 0.90    ! originally 0.90
+  omqd    = 0.50    ! originally 0.50
+  omtmax  = 0.75    ! originally 0.75
+!-
+! calculate weighting factors used in interpolating climatological
+! monthly-mean input values to daily-mean values
+!-
+! this is a simple linear interpolation technique that takes into
+! account the length of each month
+!-
+  IF (ipprec == 0) THEN
+    IF (REAL(iday) < REAL(ndaypm(imonth)+1)/2.0) then
+      it1w = imonth-1
+      it2w = imonth
+      dt   = (REAL(iday)-0.5)/ndaypm(imonth)+0.5
+    ELSE
+      it1w = imonth
+      it2w = imonth+1
+      dt   = (REAL(iday)-0.5)/ndaypm(imonth)-0.5
+    ENDIF
+    if (it1w <  1)  it1w = 12
+    if (it2w > 12)  it2w = 1
+  ELSE
+     dt = -1.
+     it1w = -1
+     it2w = -1
+  ENDIF
+!-
+  IF (ipprec == 0) THEN
+!---
+!-- use weather generator to create daily statistics
+!---
+! (1) determine if today will rain or not
+!---
+!-- calculate monthly-average probability of rainy day
+!---
+    DO i=1,npoi
+      pwet(i) = xinwet(i,imonth)/ndaypm(imonth)
+    ENDDO
+!---
+    IF (.NOT.precip_exact) THEN
+!-----
+!---- (1.1) following Geng et al.
+!-----
+      IF (is_root_prc) THEN
+         CALL random_number (rndnum)
+      ENDIF
+      CALL bcast(rndnum)
+!-----
+      DO i=1,npoi
+        IF (xinprec(i,imonth) > 1.e-6) THEN
+!---------
+!-------- implement simple first-order Markov-chain precipitation
+!-------- generator logic based on Geng et al. (1986),
+!-------- Richardson and Wright (1984), and Richardson (1981)
+!---------
+!-------- basically, this allows for the probability of today being
+!-------- a wet day (a day with measureable precipitation)
+!-------- to be a function of what yesterday was (wet or dry)
+!---------
+!-------- the logic here is that it is more likely that a wet day
+!-------- will follow another wet day -- allowing
+!-------- for 'storm events' to persist
+!---------
+!-------- estimate the probability of a wet day after a dry day
+!---------
+          pwd = 0.75*pwet(i)
+!---------
+!-------- estimate the probability of a wet day after a wet day
+!---------
+          pww = 0.25+pwd
+!---------
+!-------- decide if today is a wet day or a dry day
+!-------- using a random number
+!---------
+!-------- call random_number(rndnum) ! done before
+!---------
+          IF (iwet(i) == 0) then
+            IF (rndnum <= pwd) iwet(i) = 1
+          ELSE
+            IF (rndnum > pww) iwet(i) = 0
+          ENDIF
+        ELSE
+          iwet(i) = 0
+        ENDIF
+      ENDDO
+    ELSE
+!-----
+!---- (1.2) preserving the monthly number of precip days
+!----       and monthly precip
+!-----
+      DO i=1,npoi
+        IF (ABS(xinwet(i,imonth)) < 32.) THEN
+          IF (xinprec(i,imonth) > 1.e-6) THEN
+            IF (   jour_precip(iday,imonth) &
+ &              <= NINT(MAX(1.,xinwet(i,imonth))) ) THEN
+              iwet(i) = 1
+            ELSE
+              iwet(i) = 0
+            ENDIF
+          ELSE
+           iwet(i) = 0
+          ENDIF
+        ENDIF
+      ENDDO
+    ENDIF
+!---
+!-- (2) determine today's precipitation amount
+!---
+    IF (.not.precip_exact) THEN
+       Warning_aa_ab(:)=.FALSE.
+       Warning_iwet(:)=.FALSE.
+!-----
+!---- (2.1) following Geng et al.
+!-----
+      aa(:) = zero
+      ab(:) = zero
+      tr2(:)= zero
+      tr1(:)= zero
+      beta(:) = un
+      DO i=1,npoi
+!-------
+!------ initialize daily precipitation to zero
+!-------
+        precip(i) = zero
+!-------
+        IF (xinprec(i,imonth) > 1.e-6) THEN
+!---------
+!-------- if it is going to rain today
+!---------
+          IF (iwet(i) == 1) THEN
+!-----------
+!---------- calculate average rainfall per wet day
+!-----------
+            rainpwd(i) = xinprec(i,imonth) &
+ &                      *ndaypm(imonth)/MAX(0.1,xinwet(i,imonth))
+!-----------
+!---------- randomly select a daily rainfall amount
+!---------- from a probability density function of rainfall
+!----------
+!---------- method i --
+!-----------
+!---------- use the following technique from Geng et al. and Richardson
+!---------- to distribute rainfall probabilities
+!-----------
+!---------- pick a random rainfall amount
+!---------- from a two-parameter gamma function distribution function
+!-----------
+!---------- estimate two parameters for gamma function
+!---------- (following Geng et al.)
+!-----------
+            beta(i) = MAX(1.0,-2.16+1.83*rainpwd(i))
+            alpha(i) = rainpwd(i)/beta(i)
+!-----------
+!---------- determine daily precipitation amount
+!---------- from gamma distribution function
+!---------- (following WGEN code of Richardson and Wright (1984))
+!-----------
+            IF (ABS(1.-alpha(i)) < 1.e-6) THEN
+              alpha(i) = 1.e-6*(alpha(i)/ABS(alpha(i)))
+            ENDIF
+            aa(i) = 1.0/alpha(i)
+            ab(i) = 1.0/(1.0-alpha(i))
+!-----------
+            IF ( (ABS(aa(i)) < 1.e-6) .OR. (ABS(ab(i)) < 1.e-6) ) THEN
+               Warning_aa_ab(:)=.TRUE.
+            ENDIF
+            tr1(i) = exp(-18.42/aa(i))
+            tr2(i) = exp(-18.42/ab(i))
+          ENDIF
+        ELSE
+          IF (iwet(i) == 1) THEN
+            Warning_iwet(i)=.TRUE.
+          ENDIF
+        ENDIF
+      ENDDO
+
+      DO i=1,npoi
+         IF ( Warning_aa_ab(i) ) THEN
+            WRITE(numout,*) ' ATTENTION, aa ou ab:'
+            WRITE(numout,*) ' aa, ab = ',aa(i),ab(i)
+            WRITE(numout,*) '   alpha, rainpwd, beta =', &
+ &                       alpha(i),rainpwd(i),beta(i)
+         ENDIF
+         IF ( Warning_iwet(i) ) THEN
+            WRITE(numout,*) ' ATTENTION, iwet = 1 alors que xinprec = 0)'
+            WRITE(numout,*) '   xinprec, iwet = ',xinprec(i,imonth),iwet(i)
+          ENDIF
+      ENDDO
+!-----
+      where ( iwet(:) == 1 )
+        not_ok(:) = 1
+      elsewhere
+        not_ok(:) = 0
+      endwhere
+!-----
+      count_not_ok_g=0
+      count_not_ok=SUM(not_ok(:))
+      CALL reduce_sum(count_not_ok,count_not_ok_g)
+      CALL bcast(count_not_ok_g)
+!-
+      z(:) = zero
+      DO WHILE (count_not_ok_g > 0)
+        IF (is_root_prc) THEN
+        CALL random_number (rn1)
+        CALL random_number (rn2)
+        ENDIF
+        CALL bcast(rn1)
+        CALL bcast(rn2)
+
+        DO i=1,npoi
+          IF ((iwet(i) == 1).AND.(not_ok(i) == 1)) then
+            IF ( (rn1-tr1(i)) <= zero ) THEN
+              s1 = zero
+            ELSE
+              s1 = rn1**aa(i)
+            ENDIF
+!-----------
+            IF ((rn2-tr2(i)) <= zero) THEN
+              s2 = zero
+            ELSE
+              s2 = rn2**ab(i)
+            ENDIF
+!-----------
+            s12 = s1+s2
+            IF ((s12-1.0) <= zero) THEN
+              z(i) = s1/s12
+              not_ok(i) = 0
+            ENDIF
+          ENDIF
+        ENDDO
+
+        count_not_ok_g=0
+        count_not_ok=SUM(not_ok(:))
+        CALL reduce_sum(count_not_ok,count_not_ok_g)
+        CALL bcast(count_not_ok_g)
+      ENDDO
+!-----
+      IF (is_root_prc) THEN
+         CALL random_number (rn3)
+      ENDIF
+      CALL bcast(rn3)
+!      WRITE(*,*) mpi_rank,"rn3=",rn3
+!-----
+      DO i=1,npoi
+        IF (iwet(i) == 1) then
+          precip(i) = -z(i)*log(rn3)*beta(i)
+        ENDIF
+      ENDDO
+!-----
+!---- method ii --
+!-----
+!---- here we use a one-parameter Weibull distribution function
+!---- following the analysis of Selker and Haith (1990)
+!-----
+!---- Selker, J.S. and D.A. Haith, 1990: Development and testing
+!---- of single- parameter precipitation distributions,
+!---- Water Resources Research, 11, 2733-2740.
+!-----
+!---- this technique seems to have a significant advantage over other
+!---- means of generating rainfall distribution functions
+!-----
+!---- by calibrating the Weibull function to U.S. precipitation records,
+!---- Selker and Haith were able to establish the following relationship
+!-----
+!---- the cumulative probability of rainfall intensity x is given as:
+!-----
+!---- f(x) = 1.0-exp(-(1.191 x / rainpwd)**0.75)
+!-----
+!---- where x       : rainfall intensity
+!----       rainpwd : rainfall per wet day
+!-----
+!---- using transformation method, take uniform deviate and convert
+!---- it to a random number weighted by the following Weibull function
+!-----
+!----    call random_number(rndnum)
+!-----
+!----    precip(i) = rainpwd / 1.191*(-log(1.0-rndnum))**1.333333
+!-----
+!---- bound daily precipitation to "REAListic" range
+!-----
+      DO i=1,npoi
+        IF (iwet(i) == 1) THEN
+!---------
+!-------- lower end is determined by definition of a 'wet day'
+!-------- (at least 0.25 mm of total precipitation)
+!---------
+!-------- upper end is to prevent ibis from blowing up
+!---------
+          precip(i) = MAX(precip(i),  0.25) ! min =   0.25 mm/day
+          precip(i) = MIN(precip(i),150.00) ! max = 150.00 mm/day
+        ENDIF
+      ENDDO
+    ELSE
+!-----
+!---- (2.2) preserving the monthly number of precip days
+!----       and monthly precip
+!-----
+      DO i=1,npoi
+!-------
+!------ Correction Nathalie. C'est abs(xinwet) < 32 qu'il faut tester
+!------ et non pas abs(xinprec(i,imonth)) < 32.
+!-------
+!------ IF ( (iwet(i) == 1).and.(abs(xinprec(i,imonth)) < 32.) ) THEN
+        IF ( (iwet(i) == 1).and.(abs(xinwet(i,imonth)) < 32.) ) THEN
+          precip(i) = xinprec(i,imonth)*REAL(ndaypm(imonth)) &
+ &                   /REAL(NINT(MAX(1.,xinwet(i,imonth))))
+        ELSE
+          precip(i) = zero
+        ENDIF
+      ENDDO
+    ENDIF
+!---
+!-- (3) estimate expected minimum and maximum temperatures
+!---
+    DO i=1,npoi
+!-----
+!---- first determine the expected maximum and minimum temperatures
+!---- (from climatological means) for this day of the year
+!-----
+!---- mean daily mean temperature (K)
+      tdm = xint(i,it1w)+dt*(xint(i,it2w)-xint(i,it1w))+zero_t
+!---- mean daily temperature range (K)
+      trngm = xintrng(i,it1w)+dt*(xintrng(i,it2w)-xintrng(i,it1w))
+!---- mean minimum and maximum temperatures
+      tmaxm = tdm+0.56*trngm
+      tminm = tdm-0.44*trngm
+!-----
+!---- modify maximum temperatures for wet and dry days
+!-----
+      IF (pwet(i) /= zero) THEN
+        tmaxd = tmaxm+pwet(i)*omtmax*trngm
+        tmaxw = tmaxd-        omtmax*trngm
+      ELSE
+        tmaxd = tmaxm
+        tmaxw = tmaxm
+      ENDIF
+!-----
+!---- set the 'expected' maximum and minimum temperatures for today
+!-----
+!---- note that the expected minimum temperatures are the same for
+!---- both wet and dry days
+!-----
+      if (iwet(i) == 0)  tmaxe(i) = tmaxd
+      if (iwet(i) == 1)  tmaxe(i) = tmaxw
+!-----
+      tmine(i) = tminm
+!-----
+!---- estimate variability in minimum and maximum temperatures
+!-----
+!---- tmaxs : standard deviation in maximum temperature (K)
+!---- tmins : standard deviation in minimum temperature (K)
+!-----
+!---- Regression is based on analysis of 2-m air temperature data
+!---- from the NCEP/NCAR reanalysis (1958-1997) for 294 land points
+!---- over central North America
+!---- (24N-52N, 130W-60W, 0.5-degree resolution):
+!---- Daily max and min temperatures were calculated for each
+!---- land point from daily mean temperature and temperature range.
+!---- Anomalies were calculated
+!---- by subtracting similar max and min temperatures calculated from
+!---- monthly mean temperature and range (interpolated to daily).
+!---- The 40 years of anomalies were then binned by month
+!---- and the standard deviation calculated for each month.
+!---- The 294 x 12 standard deviations were then regressed
+!---- against the 3528 long-term monthly mean temperatures.
+!-----
+!---- note: the values are bound to be greater than 1.0 K
+!----       (at the very least they must be bound
+!----        so they don't go below zero)
+!-----
+      tmaxs(i) = MAX(1.0,-0.0713*(tdm-zero_t)+4.89)
+      tmins(i) = MAX(1.0,-0.1280*(tdm-zero_t)+5.73)
+    ENDDO
+!---
+!-- (4) estimate expected cloud cover
+!---
+!---
+!-- the formulation of dry and wet cloud cover has been
+!-- derived from the weather generator used in the epic crop model
+!---
+    DO i=1,npoi
+!-----
+!---- cloudm : mean cloud cover for today
+!---- cloudd : dry day cloud cover
+!---- cloudw : dry day cloud cover
+!---- cloude : expected cloud cover today
+!-----
+!---- mean cloud cover (%)
+!-----
+      cloudm = xincld(i,it1w)+dt*(xincld(i,it2w)-xincld(i,it1w))
+!-----
+!---- convert from percent to fraction
+!-----
+      cloudm = cloudm/100.0
+!-----
+!---- adjust cloud cover depending on dry day / rainy day
+!---- following logic of the EPIC weather generator code
+!-----
+      IF (pwet(i) /= zero) THEN
+        cloudd = (cloudm-pwet(i)*omcloud)/(un-pwet(i)*omcloud)
+        cloudd = MIN(un,MAX(zero,cloudd))
+        cloudw = (cloudm-(un-pwet(i))*cloudd)/pwet(i)
+      ELSE
+        cloudd = cloudm
+        cloudw = cloudm
+      ENDIF
+      IF (iwet(i) == 0)  cloude(i) = cloudd
+      IF (iwet(i) == 1)  cloude(i) = cloudw
+!-----
+!---- estimate variability in cloud cover for wet and dry days
+!---- following numbers proposed by Richardson
+!-----
+!---- clouds : standard deviation of cloud fraction
+!-----
+      IF (iwet(i) == 0)  clouds(i) = 0.24*cloude(i)
+      IF (iwet(i) == 1)  clouds(i) = 0.48*cloude(i)
+    ENDDO
+!---
+! (5) determine today's temperatures and cloud cover using
+!     first-order serial autoregressive technique
+!---
+!-- use the Richardson (1981) weather generator approach to simulate the
+!-- daily values of minimum / maximum temperature and cloud cover
+!---
+!-- following the implementation of the Richardson WGEN weather
+!-- generator used in the EPIC crop model
+!---
+!-- this approach uses a multivariate generator, which assumes that the
+!-- perturbation of minimum / maximum temperature and cloud cover are
+!-- normally distributed and that the serial correlation of each
+!-- variable may be described by a first-order autoregressive model
+!---
+!-- generate standard deviates for weather generator
+!---
+    DO j=1,3
+      ee(j) = 9999.
+      DO WHILE (ee(j) > 2.5)
+        IF (is_root_prc) THEN
+           CALL random_number (rn1)
+           CALL random_number (rn2)
+        ENDIF
+        CALL bcast(rn1)
+        CALL bcast(rn2)
+        ee(j) = SQRT(-2.0*LOG(rn1))*COS(6.283185*rn2)
+      ENDDO
+    ENDDO
+!---
+!-- zero out vectors
+!---
+    r(1:3)  = zero
+    rr(1:npoi,1:3) = zero
+!---
+!-- update working vectors
+!---
+    do j=1,3
+      do k=1,3
+        r(j) = r(j)+b(j,k)*ee(j)
+      enddo
+    enddo
+!---
+    do j=1,3
+      do k=1,3
+        do i=1,npoi
+          rr(i,j) = rr(i,j)+a(j,k)*xstore(i,k)
+        enddo
+      enddo
+    enddo
+!---
+!-- solve for x() perturbation vector and save current vector
+!-- into the xim1() storage vector (saved for each point)
+!---
+    do j=1,3
+      do i=1,npoi
+        xstore(i,j) = r(j)+rr(i,j)
+      enddo
+    enddo
+!---
+!-- determine today's minimum and maximum temperature
+!--
+    do i=1,npoi
+      tmax(i) = tmaxe(i)+tmaxs(i)*xstore(i,1)
+      tmin(i) = tmine(i)+tmins(i)*xstore(i,2)
+!-----
+!---- if tmin > tmax, then switch the two around
+!-----
+      if (tmin(i) > tmax(i)) then
+        tdum    = tmax(i)
+        tmax(i) = tmin(i)
+        tmin(i) = tdum
+      ENDIF
+!---- daily average temperature
+      td(i) = 0.44*tmax(i)+0.56*tmin(i)
+!---- determine today's cloud cover
+      cloud(i) = cloude(i)+clouds(i)*xstore(i,3)
+!---- constrain cloud cover to be between 0 and 100%
+      cloud(i) = MAX(zero,MIN(un,cloud(i)))
+    enddo
+!---
+!-- (6) estimate today's surface atmospheric pressure
+!---
+    do i=1,npoi
+!-----
+!---- simply a function of the daily average temperature
+!---- and topographic height -- nothing fancy here
+!-----
+      psurf(i) = 101325.0*(td(i)/(td(i)+0.0065*xintopo(i)))**rwork
+    enddo
+!---
+!-- (7) estimate today's relative humidity
+!---
+    IF (is_root_prc) THEN
+       CALL random_number (rn)
+    ENDIF
+    CALL bcast(rn)
+!---
+    CALL weathgen_qsat (npoi,td,psurf,qsattd)
+!---
+    do i=1,npoi
+!-----
+!---- the formulation of dry and wet relative humidities has been
+!---- derived from the weather generator used in the epic crop model
+!-----
+!---- qdm : mean relative humidity
+!---- qdd : dry day relative humidity
+!---- qdw : rainy day relative humidity
+!---- qde : expected relative humidity (based on wet/dry decision)
+!-----
+!---- mean relative humidity (%)
+      qdm(i) = xinq(i,it1w)+dt*(xinq(i,it2w)-xinq(i,it1w))
+!---- convert from percent to fraction
+      qdm(i) = qdm(i)/100.0
+!-----
+!---- adjust humidity depending on dry day / rainy day
+!---- following logic of the EPIC weather generator code
+!-----
+      if (pwet(i) /= zero) then
+        qdd(i) = (qdm(i)-pwet(i)*omqd)/(un-pwet(i)*omqd)
+        if (qdd(i) < 0.2) then
+          qdd(i) = 0.2
+          if (qdd(i) > qdm(i)) qdm(i) = qdd(i)
+        ENDIF
+        qdd(i) = MIN(un,qdd(i))
+        qdw(i) = (qdm(i)-(un-pwet(i))*qdd(i))/pwet(i)
+      ELSE
+        qdd(i) = qdm(i)
+        qdw(i) = qdm(i)
+      ENDIF
+!-----
+      if (iwet(i) == 0)  qde(i) = qdd(i)
+      if (iwet(i) == 1)  qde(i) = qdw(i)
+!-----
+!---- estimate lower and upper bounds of humidity distribution function
+!---- following logic of the EPIC weather generator code
+!-----
+      xx = exp(qde(i))
+      qdup(i)  = qde(i)+(un-qde(i))*xx/euler
+      qdlow(i) = qde(i)*(un-1./xx)
+!-----
+!---- randomlly select humidity from triangular distribution function
+!---- following logic of the EPIC weather generator code
+!-----
+!---- call random_number(rn) ! GK done before
+!-----
+      y  = 2.0/(qdup(i)-qdlow(i))
+!-----
+      b3 = qde(i)-qdlow(i)
+      b2 = qdup(i)-qde(i)
+      b1 = rn/y
+!-----
+      x1 = y*b3/2.0
+!-----
+      if (rn > x1) then
+        qd(i) = qdup(i)-sqrt (b2*b2-2.0*b2*(b1-0.5*b3))
+      ELSE
+        qd(i) = qdlow(i)+sqrt (2.0*b1*b3)
+      ENDIF
+!-----
+!---- adjust daily humidity to conserve monthly mean values
+!-----
+!---- note that this adjustment sometimes gives rise to humidity
+!---- values greater than 1.0 -- which is corrected below
+!-----
+      amn = (qdup(i)+qde(i)+qdlow(i))/3.0
+      qd(i) = qd(i)*qde(i)/amn
+!-----
+!---- constrain daily average relative humidity
+!-----
+      qd(i) = MAX(0.30,MIN(qd(i),0.99))
+!-----
+!---- convert from relative humidity to specific humidity at
+!---- daily mean temperature
+!-----
+      qd(i) = qd(i)*qsattd(i)
+    enddo
+!---
+!-- (8) estimate today's daily average wind speed
+!---
+    IF (is_root_prc) THEN
+        CALL random_number (rn4)
+    ENDIF
+    CALL bcast(rn4)
+
+    DO i=1,npoi
+!-----
+!---- first estimate the expected daily average wind speed (from monthly
+!---- means)
+!-----
+      eud = xinwind(i,it1w)+dt*(xinwind(i,it2w)-xinwind(i,it1w))
+!-----
+!---- following logic of the EPIC weather generator
+!---- select random wind speed following this equation
+!-----
+!---- call random_number(rn4)
+!-----
+      ud(i) = 1.13989*eud*(-log(rn4))**0.30
+!---- constrain daily wind speeds to be between 2.5 and 10.0 m/sec
+      ud(i) = MAX(2.5,MIN(ud(i),10.0))
+    ENDDO
+  ELSE
+!---
+!-- use REAL daily climate data
+!---
+    DO i=1,npoi
+!-----
+!---- use basic daily climate data, converting units
+!-----
+!---- daily total precipitation
+      precip(i) = xinprec(i,imonth)
+!---- daily average temperatures
+      td(i) = xint(i,imonth)+zero_t
+      trngm = MIN(44.0,xintrng(i,imonth))
+!-----
+      tmax(i) = td(i)+0.56*trngm
+      tmin(i) = td(i)-0.44*trngm
+!---- daily average cloud cover
+      cloud(i) = xincld(i,imonth)*0.01
+!---- daily average specific humidity
+      qd(i) = xinq(i,imonth)
+!---- daily average wind speed
+      ud(i) = xinwind(i,imonth)
+!-----
+!---- compute surface atmospheric pressure
+!-----
+      psurf(i) = 101325.0*(td(i)/(td(i)+0.0065*xintopo(i)))**rwork
+    ENDDO
+  ENDIF
+!-------------------
+END SUBROUTINE daily
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : diurnal
+!!
+!>\BRIEF          This routine interpolates values from the!* 
+!! subroutine daily into instantaneous values for simulating a diurnal cycle.
+!!
+!! DESCRIPTION  :  
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):  ::fira, ::solad, ::ua, ::ta, ::qa, ::raina, ::snowa, ::rh.
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE diurnal &
+& (npoi, nband, time, jday, plens, startp, endp, latitude, &
+&  cloud, tmax, tmin, precip, qd, ud, psurf, &
+&  fira, solad, solai, ua, ta, qa, raina, snowa, rh)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Parameter and variables declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN) :: npoi    !! number of grid points (unitless)
+  INTEGER,INTENT(IN) :: nband   !! number of visible bands (unitless)
+  REAL,INTENT(IN) :: time
+  INTEGER, INTENT(IN) :: jday
+  REAL,INTENT(IN) :: plens,startp,endp
+  REAL,INTENT(IN) :: latitude(npoi)   !! latitude in degrees
+  REAL,INTENT(IN) :: cloud(npoi)      !! cloud fraction (0-1, unitless)
+  REAL,INTENT(IN) :: tmax(npoi)       !! maximum daily temperature (K)
+  REAL,INTENT(IN) :: tmin(npoi)       !! maximum daily temperature (K)
+  REAL,INTENT(IN) :: precip(npoi)     !! daily precitation @tex $(mm.day^{-1})$ @endtex 
+  REAL,INTENT(IN) :: qd(npoi)         !! daily average specific humidity (kg_h2o/kg_air)
+  REAL,INTENT(IN) :: ud(npoi)         !! daily average wind speed @tex $(m.s^{-1})$ @endtex 
+  REAL,INTENT(IN) :: psurf(npoi)      !! surface pressure (Pa)
+
+  !! 0.2 Output variables
+
+  REAL,INTENT(OUT) :: fira(npoi)          !! incoming ir flux  @tex $(W.m^{-2})$ @endtex
+  REAL,INTENT(OUT) :: solad(npoi,nband)   !! direct downward solar flux @tex $(W.m^{-2})$ @endtex
+  REAL,INTENT(OUT) :: solai(npoi,nband)   !! diffuse downward solar flux @tex $(W.m^{-2})$ @endtex
+  REAL,INTENT(OUT) :: ua(npoi)            !! wind speed @tex $(m.s^{-1})$ @endtex 
+  REAL,INTENT(OUT) :: ta(npoi)            !! air temperature (K)
+  REAL,INTENT(OUT) :: qa(npoi)            !! specific humidity (kg_h2o/kg_air)
+  REAL,INTENT(OUT) :: raina(npoi)         !! rainfall rate @tex $(mm.day^{-1})$ @endtex 
+  REAL,INTENT(OUT) :: snowa(npoi)         !! snowfall rate @tex $(mm.day^{-1})$ @endtex 
+  REAL,INTENT(OUT) :: rh(npoi)            !! relative humidity (0-1, unitless)
+
+  !! 0.4 Local variables
+
+  REAL,SAVE      :: step
+  REAL :: xl,so,xllp,xee,xse
+  REAL :: xlam,dlamm,anm,ranm,ranv,anv,tls,rlam
+  REAL :: sd,cd,deltar,delta,Dis_ST,ddt
+!-
+  REAL :: coszen(npoi)                      !! cosine of solar zenith angle
+  REAL :: rtime
+  REAL :: sw,frac,gamma,qmin,qmax,qsa,emb,ea,ec,dtair,dtcloud,rn
+  REAL :: trans(npoi), fdiffuse(npoi), qsatta(npoi), qsattmin(npoi)
+  INTEGER :: i,ib
+  INTEGER,SAVE :: npoi0
+  LOGICAL,SAVE :: lstep_init_diurnal = .TRUE.
+
+!---------------------------------------------------------------------
+! GK240100
+  IF (lstep_init_diurnal) THEN
+    lstep_init_diurnal = .FALSE.
+    npoi0 = npoi
+  ELSE IF (npoi /= npoi0) THEN
+    WRITE(numout,*) 'Domain size old, new: ',npoi0,npoi
+    STOP 'WG Diurnal: Problem: Domain has changed since last call'
+  ENDIF
+
+! calculate time in hours
+  rtime = time/3600.0
+
+  CALL downward_solar_flux(npoi,latitude,calendar_str,REAL(jday),rtime,cloud,nband,solad,solai)
+!-
+! temperature calculations
+!-
+!---
+!-- assign hourly temperatures using tmax and tmin
+!-- following Environmental Biophysics, by Campbell and Norman, p.23
+!---
+!-- this function fits a fourier series to the diurnal temperature cycle
+!-- note that the maximum temperature occurs at 2:00 pm local solar time
+!---
+!-- note that the daily mean value of gamma is 0.44,
+!-- so td = 0.44*tmax+0.56*tmin,  instead of
+!--    td = 0.50*tmax+0.50*tmin
+!---
+  gamma = 0.44-0.46*SIN(    pi/12.0*rtime+0.9) &
+              +0.11*SIN(2.0*pi/12.0*rtime+0.9)
+  DO i=1,npoi
+    ta(i) = tmax(i)*gamma+tmin(i)*(1.0-gamma)
+  ENDDO
+!-
+! humidity calculations
+!-
+  CALL weathgen_qsat (npoi,tmin,psurf,qsattmin)
+  CALL weathgen_qsat (npoi,ta,psurf,qsatta)
+!-
+  DO i=1,npoi
+!---
+!-- adjust specific humidity against daily minimum temperatures
+!---
+!-- To do this, qa is written as an approximate sine function
+!-- (same as ta) to preserve the daily mean specific humidity,
+!-- while also preventing rh from exceeding 99% at night
+!---
+!-- Note that the daily mean RH is *not* preserved, and therefore the
+!-- output RH will be slightly different from what was read in.
+!---
+!-- first adjust so that maximum RH cannot exceed 99% at night
+!---
+    qmin = MIN(qd(i),0.99*qsattmin(i))
+    qmax = (qd(i)-0.56*qmin)/0.44
+!---
+!-- if needed, adjust again to 99% at other times of the day (in which
+!-- case the daily mean *specific* humidity is also not preserved)
+!---
+    qsa  = 0.99*qsatta(i)
+!---
+!-- calculate the hourly specific humidity, using the above adjustments
+!---
+    qa(i) = MIN(qsa,qmax*gamma+qmin*(1.0-gamma))
+!---
+!-- calculate the hourly relative humidity
+!--
+    rh(i) = 100.*qa(i)/qsatta(i)
+  ENDDO
+!-
+! wind speed calculations
+!-
+  IF (is_root_prc) THEN
+     CALL random_number (rn)
+  ENDIF
+  CALL bcast(rn)
+!-
+  DO i=1,npoi
+!---
+!-- following logic of the EPIC weather generator
+!-- select random wind speed following this equation
+!---
+!-- call random_number(rn) ! done before
+!---
+    ua(i) = 1.13989*ud(i)*(-log(rn))**0.30
+!---
+!-- fix wind speeds to always be above 2.5 m/sec and below 10.0 m/sec
+!---
+    ua(i) = MAX(2.5,MIN(10.0,ua(i)))
+  ENDDO
+!-
+! ir flux calculations
+!-
+  DO i=1,npoi
+!---
+!-- clear-sky emissivity as a function of water vapor pressure
+!-- and atmospheric temperature
+!---
+!-- calculate the ir emissivity of the clear sky
+!-- using equation from idso (1981) water resources res., 17, 295-304
+!---
+    emb = 0.01*(psurf(i)*qa(i)/(0.622+qa(i)))
+    ea  = 0.70+5.95e-5*emb*EXP(1500.0/ta(i))
+!---
+!-- assign the ir emissivity of clouds
+!-- (assume they are ~black in the ir)
+!---
+    ec = 0.950
+!---
+!-- assign the temperature difference of emissions (air+cloud) from
+!-- the surface air temperature
+!---
+    dtair   = zero
+    dtcloud = zero
+!---
+!-- total downward ir is equal to the sum of:
+!---
+!-- (1) clear sky contribution to downward ir radiation flux
+!-- (2) cloud contribution to downward ir radiation flux
+!---
+    fira(i) = (1.-cloud(i))*ea*c_stefan*(ta(i)-dtair)**4 &
+ &           +cloud(i)*ec*c_stefan*(ta(i)-dtcloud)**4
+  ENDDO
+!-
+! snow and rain calculations
+!-
+  DO i=1,npoi
+!---
+!-- reset snow and rain to zero
+!---
+    snowa(i) = zero
+    raina(i) = zero
+!---
+!-- if precipitation event then calculate
+!---
+    IF (time >= startp .and. time < endp) then
+!-----
+!---- for rain / snow partitioning, make it all rain if
+!---- ta > 2.5 C and all snow if ta <= 2.5 C
+!-----
+!---- reference:
+!-----
+!---- Auer, A. H., 1974: The rain versus snow threshold temperatures,
+!---- Weatherwise, 27, 67.
+!-----
+      IF (ta(i)-273.15 > 2.5) then
+        raina(i) = precip(i)/plens
+      ELSE
+        snowa(i) = precip(i)/plens
+      ENDIF
+    ENDIF
+  ENDDO
+!---------------------
+END SUBROUTINE diurnal
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_main
+!!
+!>\BRIEF        This subroutine manages the calls to the different subroutines of the weather module. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::tair, ::pb, ::qair, ::swdown, ::rainf, ::snowf, ::u, ::v, ::lwdown
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_main &
+& (itau, istp, filename, force_id, iim, jjm, nband, &
+&  rest_id, lrstread, lrstwrite, &
+&  limit_west, limit_east, limit_north, limit_south, &
+&  zonal_res, merid_res, lon, lat, date0, dt_force, &
+&  kindex, nbindex, &
+&  swdown, rainf, snowf, tair, u, v, qair, pb, lwdown)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                  :: itau,istp
+  CHARACTER(LEN=*),INTENT(IN)         :: filename
+  INTEGER,INTENT(IN)                  :: force_id
+  INTEGER,INTENT(IN)                  :: iim,jjm
+  INTEGER,INTENT(IN)                  :: nband
+  INTEGER,INTENT(IN)                  :: rest_id
+  LOGICAL,INTENT(IN)                  :: lrstread, lrstwrite
+  REAL,INTENT(IN)                     :: limit_west,limit_east
+  REAL,INTENT(IN)                     :: limit_north,limit_south
+  REAL,INTENT(IN)                     :: zonal_res,merid_res
+  REAL,INTENT(IN)                     :: date0,dt_force
+  REAL,DIMENSION(iim,jjm),INTENT(IN)  :: lon,lat  !! longitude, latitude
+
+  !! 0.2 Output variables 
+
+  REAL,DIMENSION(iim,jjm),INTENT(OUT) :: &
+ &  tair,pb,qair,swdown,rainf,snowf, u,v,lwdown
+
+  !! 0.3 Mofified variables
+
+  INTEGER,INTENT(INOUT)                    :: nbindex
+  INTEGER,DIMENSION(iim*jjm),INTENT(INOUT) :: kindex
+
+  !! 0.4 Local variables
+
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+ &  tair_g,pb_g,qair_g,swdown_g,rainf_g,snowf_g, u_g,v_g,lwdown_g
+  REAL,DIMENSION(nbindex) :: &
+ &  tairl,pbl,qairl,swdownl,rainfl,snowfl, ul,vl,lwdownl
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  IF (lrstread) THEN
+    CALL weathgen_begin ( &
+     & dt_force,itau, date0, &
+     & rest_id,iim,jjm, &
+     & lon,lat,tair,pb,qair,kindex,nbindex)
+        RETURN
+  ELSE
+    CALL weathgen_get &
+ &   (itau, date0, dt_force, nbindex, nband, lat_land, &
+ &    swdownl, rainfl, snowfl, tairl, ul, vl, qairl, pbl, lwdownl)
+
+    tair(:,:)=val_exp
+    qair(:,:)=val_exp
+    pb(:,:)=val_exp
+    DO ij=1,nbindex
+       j = (((kindex(ij)-1)/iim) + 1)
+       i = (kindex(ij) - (j-1)*iim)
+       !
+       swdown(i,j)=swdownl(ij)
+       rainf(i,j)=rainfl(ij)
+       snowf(i,j)=snowfl(ij)
+       tair(i,j)=tairl(ij)
+       u(i,j)=ul(ij)
+       v(i,j)=vl(ij)
+       qair(i,j)=qairl(ij)
+       pb(i,j)=pbl(ij)
+       lwdown(i,j)=lwdownl(ij)
+    ENDDO
+!---
+    IF (dump_weather) THEN
+      ALLOCATE(tair_g(iim_g,jjm_g))
+      ALLOCATE(pb_g(iim_g,jjm_g))
+      ALLOCATE(qair_g(iim_g,jjm_g))
+      ALLOCATE(swdown_g(iim_g,jjm_g))
+      ALLOCATE(rainf_g(iim_g,jjm_g))
+      ALLOCATE(snowf_g(iim_g,jjm_g))
+      ALLOCATE(u_g(iim_g,jjm_g))
+      ALLOCATE(v_g(iim_g,jjm_g))
+      ALLOCATE(lwdown_g(iim_g,jjm_g))
+
+      CALL gather2D_mpi(tair, tair_g)
+      CALL gather2D_mpi(pb, pb_g)
+      CALL gather2D_mpi(qair, qair_g)
+      CALL gather2D_mpi(swdown, swdown_g)
+      CALL gather2D_mpi(rainf, rainf_g)
+      CALL gather2D_mpi(snowf, snowf_g)
+      CALL gather2D_mpi(u, u_g)
+      CALL gather2D_mpi(v, v_g)
+      CALL gather2D_mpi(lwdown, lwdown_g)
+      IF (is_root_prc) THEN
+         CALL weathgen_dump &
+ &           (itau, dt_force, iim_g, jjm_g, nbp_glo, index_g, lrstwrite, &
+ &            swdown_g, rainf_g, snowf_g, tair_g, u_g, v_g, qair_g, pb_g, lwdown_g)
+      ENDIF
+    ENDIF
+!---
+    IF (lrstwrite) THEN
+      CALL weathgen_restwrite (rest_id,istp,iim,jjm,nbindex,kindex)
+    ENDIF
+  ENDIF
+!---------------------------
+END SUBROUTINE weathgen_main
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_init 
+!!
+!>\BRIEF         This subroutine initializes weather variables.
+!!
+!! DESCRIPTION  : None 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):  ::kindex, ::nbindex
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_init &
+     & (filename,dt_force,force_id,iim,jjm, &
+     &  zonal_res,merid_res,lon,lat,kindex,nbindex)
+!!$,iind,jind)
+  !---------------------------------------------------------------------
+  IMPLICIT NONE
+  !-
+
+  !! 0. Variables and parameters declaration
+
+  REAL,PARAMETER  :: fcrit = .5       !! Minimum land fraction on original grid
+
+  !! 0.1 Input variables
+
+  CHARACTER(LEN=*),INTENT(IN)         :: filename
+  REAL,INTENT(IN)                     :: dt_force
+  INTEGER,INTENT(IN)                  :: iim, jjm
+  REAL,INTENT(IN)                     :: zonal_res,merid_res
+  REAL,DIMENSION(iim,jjm),INTENT(IN)  :: lon,lat
+
+  !! 0.2 Output variables  
+
+  INTEGER,INTENT(OUT)                 :: nbindex
+  INTEGER,DIMENSION(iim*jjm),INTENT(OUT)  :: kindex
+!!$  INTEGER,DIMENSION(iim),INTENT(OUT) :: iind
+!!$  INTEGER,DIMENSION(jjm),INTENT(OUT) :: jind
+
+  !! 0.3 Modified variables 
+
+  INTEGER,INTENT(INOUT)               :: force_id
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(:),ALLOCATABLE         :: lon_file, lon_temp
+  REAL,DIMENSION(:,:),ALLOCATABLE       :: nav_lon, nav_lat
+  REAL,DIMENSION(:),ALLOCATABLE         :: lat_file, lat_temp
+  REAL,DIMENSION(:,:),ALLOCATABLE       :: lsm_file
+  REAL     :: xextent_file, yextent_file, xres_file, yres_file
+  INTEGER  :: i, j, plotstep
+  REAL,DIMENSION(iim,jjm)               :: mask
+  CHARACTER(LEN=1),DIMENSION(0:1)       :: maskchar
+  CHARACTER(LEN=30)                     :: var_name
+  REAL     :: x_cut
+  REAL,DIMENSION(iim) :: tmp_lon
+  REAL,DIMENSION(jjm) :: tmp_lat
+
+!_ ================================================================================================================================
+
+  !-
+  ! 0. messages, initialisations
+  !-
+  WRITE(numout,*) &
+       &  'weathgen_init: Minimum land fraction on original grid =',fcrit
+  CALL ioget_calendar(calendar_str)
+  !-
+  ! 1. on lit les longitudes et latitudes de la grille de depart
+  !    ainsi que le masque terre-ocean
+  !-
+  CALL flinclo(force_id)
+  CALL flininfo (filename,iim_file,jjm_file,llm_file,ttm_file,force_id)
+  !-
+  ALLOC_ERR=-1
+  ALLOCATE(nav_lon(iim_file,jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of nav_lon : ",ALLOC_ERR
+     STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(nav_lat(iim_file,jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of nav_lat : ",ALLOC_ERR
+     STOP 
+  ENDIF
+  !-
+  var_name='nav_lon'
+  CALL flinget (force_id,var_name,iim_file,jjm_file,0,0,1,1,nav_lon)
+  var_name='nav_lat'
+  CALL flinget (force_id,var_name,iim_file,jjm_file,0,0,1,1,nav_lat)
+  !-
+
+  ALLOC_ERR=-1
+  ALLOCATE(lon_file(iim_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of lon_file : ",ALLOC_ERR
+     STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(lat_file(jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of lat_file : ",ALLOC_ERR
+     STOP 
+  ENDIF
+  !-
+  DO i=1,iim_file
+     lon_file(i) = nav_lon(i,1)
+  ENDDO
+  DO j=1,jjm_file
+     lat_file(j) = nav_lat(1,j)
+  ENDDO
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(lsm_file(iim_file,jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of lsm_file : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+  var_name='lsmera'
+  CALL flinget (force_id,var_name,iim_file,jjm_file,0,0,1,1,lsm_file)
+!-
+! 2. La resolution du modele ne doit pas etre superieure
+!    a celle de la grille de depart
+!-
+  xextent_file = lon_file(iim_file)-lon_file(1)
+  yextent_file = lat_file(1)-lat_file(jjm_file)
+  xres_file = xextent_file/REAL(iim_file-1)
+  yres_file = yextent_file/REAL(jjm_file-1)
+!-
+  IF (xres_file > zonal_res) THEN
+    WRITE(numout,*) 'Zonal resolution of model grid too fine.'
+    WRITE(numout,*) 'Resolution of original data (deg): ', xres_file
+    STOP
+  ENDIF
+!-
+  IF (yres_file > merid_res) THEN
+    WRITE(numout,*) 'Meridional resolution of model grid too fine.'
+    WRITE(numout,*) 'Resolution of original data (deg): ', yres_file
+    STOP
+  ENDIF
+!-
+! 3. On verifie la coherence des coordonnees de depart et d'arrivee.
+!    Sinon, il faut deplacer une partie du monde (rien que ca).
+!-
+  i_cut = 0
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(lon_temp(iim_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of lon_temp : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(lat_temp(jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of lat_temp : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+  IF (lon(iim,1) > lon_file(iim_file)) THEN
+!-- A l'Est de la region d'interet, il n'y a pas de donnees
+!-- le bout a l'Ouest de la region d'interet est deplace de 360 deg
+!-- vers l'Est
+    x_cut = lon(1,1)
+    DO i=1,iim_file
+      IF (lon_file(i) < x_cut) i_cut = i
+    ENDDO
+    IF ((i_cut < 1).OR.(i_cut >= iim_file)) THEN
+        STOP 'Cannot find longitude for domain shift'
+    ENDIF
+!---
+    lon_temp(1:iim_file-i_cut-1) = lon_file(i_cut:iim_file)
+    lon_temp(iim_file-i_cut:iim_file) = lon_file(1:i_cut+1)+360.
+    lon_file(:) = lon_temp(:)
+  ELSEIF (lon(1,1) < lon_file(1)) THEN
+!-- A l'Ouest de la region d'interet, il n'y a pas de donnees
+!-- le bout a l'Est de la region d'interet est deplace de 360 deg
+!-- vers l'Ouest
+    x_cut = lon(iim,1)
+    DO i=1,iim_file
+      IF (lon_file(i) < x_cut) i_cut = i
+    ENDDO
+    IF ( ( i_cut < 1 ) .OR. ( i_cut >= iim_file ) ) THEN
+        STOP 'Cannot find longitude for domain shift'
+    ENDIF
+!---
+    lon_temp(1:iim_file-i_cut-1) = lon_file(i_cut:iim_file) -360.
+    lon_temp(iim_file-i_cut:iim_file) = lon_file(1:i_cut+1)
+    lon_file(:) = lon_temp(:)
+  ENDIF
+!-
+  DEALLOCATE (lon_temp)
+  DEALLOCATE (lat_temp)
+!-
+  IF (    (lon(1,1) < lon_file(1)) &
+ &    .OR.(     (lon(iim,1) > lon_file(iim_file)) &
+ &         .AND.(lon(iim,1) > lon_file(1)+360.) ) ) THEN
+    WRITE(numout,*) lon(:,1)
+    WRITE(numout,*)
+    WRITE(numout,*) lon_file(:)
+    STOP 'weathgen_init: cannot find coherent x-coordinates'
+  ENDIF
+!-
+  IF (i_cut /= 0) THEN
+    CALL shift_field (iim_file,jjm_file,i_cut,lsm_file)
+  ENDIF
+!-
+! 4. Verification
+!-
+  WRITE(numout,*)
+  WRITE(numout,*) 'Input File: (Shifted) Global Land-Sea Mask'
+  WRITE(numout,*)
+  maskchar(0) = '-'
+  maskchar(1) = 'X'
+  plotstep = INT(REAL(iim_file-1)/termcol)+1
+  DO j=1,jjm_file,plotstep
+    DO i=1,iim_file,plotstep
+      WRITE(numout,'(a1,$)') maskchar(NINT(lsm_file(i,j)))
+    ENDDO
+    WRITE(numout,*)
+  ENDDO
+  WRITE(numout,*)
+!-
+! 5. Prepare interpolation from fine grid land points to model grid
+!-
+! 5.1 how many grid points of the original grid fall into one grid
+!     box of the model grid?
+!-
+  n_agg = NINT((zonal_res/xres_file*merid_res/yres_file )+1.)
+!-
+! au diable l'avarice !
+!-
+  n_agg = n_agg*2
+!-
+! 5.2 Allocate arrays where we store information about which
+!     (and how many) points on the original grid fall
+!     into which box on the model grid
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(ncorr(iim,jjm), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of ncorr : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(icorr(iim,jjm,n_agg), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of icorr : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(jcorr(iim,jjm,n_agg), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of jcorr : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+! 6. Land-Ocean Mask on model grid
+!-
+  tmp_lon = lon(:,1)
+  tmp_lat = lat(1,:)
+
+  CALL mask_c_o &
+ &  (iim_file, jjm_file, lon_file, lat_file, lsm_file, fcrit, &
+ &   iim, jjm, zonal_res, merid_res, n_agg, tmp_lon, tmp_lat, &
+! &   iim, jjm, zonal_res, merid_res, n_agg, lon(:,1), lat(1,:), &
+ &   mask, ncorr, icorr, jcorr)
+!-
+  WRITE(numout,*) 'Land-Sea Mask on Model Grid'
+  WRITE(numout,*)
+  plotstep = INT(REAL(iim-1)/termcol)+1
+  DO j=1,jjm,plotstep
+    DO i=1,iim,plotstep
+      WRITE(numout,'(a1,$)') maskchar(NINT(mask(i,j)))
+    ENDDO
+    WRITE(numout,*)
+  ENDDO
+  WRITE(numout,*)
+!-
+! 7. kindex table.
+!-
+  nbindex = 0
+  DO j=1,jjm
+    DO i=1,iim
+      IF (NINT(mask(i,j)) == 1) THEN
+        nbindex = nbindex+1
+        kindex(nbindex) = (j-1)*iim+i
+      ENDIF
+    ENDDO
+  ENDDO
+  nbindex_w = nbindex
+  ALLOC_ERR=-1
+  ALLOCATE(kindex_w(nbindex_w), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of kindex_w : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  kindex_w(:)=kindex(1:nbindex)
+!-
+  IF ( nbindex == 0 ) THEN
+    WRITE(numout,*) 'Sorry, you are in the middle of the ocean. Check your coordinates.'
+    STOP 
+  ELSE
+    WRITE(numout,*) 'Number of continental points: ',nbindex
+  ENDIF
+
+!-
+! 10. clean up
+!-
+  DEALLOCATE (lon_file)
+  DEALLOCATE (lat_file)
+  DEALLOCATE (lsm_file)
+
+END SUBROUTINE weathgen_init
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_read_file
+!!
+!>\BRIEF         This subroutine allocates variables and reads files.  
+!!
+!! DESCRIPTION  :  
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_read_file &
+     & (force_id,iim,jjm)
+  !---------------------------------------------------------------------
+  IMPLICIT NONE
+  !-
+
+  !! 0. Variables and parameters declaration
+
+  REAL,PARAMETER  :: fcrit = .5
+
+  !! 0.1 Input variables 
+
+  INTEGER,INTENT(IN)                  :: force_id
+  INTEGER,INTENT(IN)                  :: iim, jjm
+
+  !! 0.4 Local variables
+
+  CHARACTER(LEN=30)               :: var_name
+
+  INTEGER,DIMENSION(iim*jjm)  :: kindex
+  INTEGER                     :: nbindex
+
+  REAL,DIMENSION(iim*jjm)     :: xchamp
+  REAL,DIMENSION(iim*jjm,nmon)  :: xchampm
+
+!_ ================================================================================================================================
+
+  kindex(:)=0
+
+#ifdef CPP_PARA
+  nbindex=nbp_loc
+  CALL scatter(index_g,kindex)
+  kindex(1:nbindex)=kindex(1:nbindex)-(jj_begin-1)*iim_g
+#else
+  ! Copy saved land points index
+  nbindex = nbindex_w
+  kindex(1:nbindex_w) = kindex_w(:)
+#endif
+
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(lat_land(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of lat_land : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+!-
+! 8 topography
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xintopo(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xintopo : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+  var_name='altitude'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,1,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchamp)
+  xintopo(:)=xchamp(kindex(1:nbindex))
+!-
+! 9. Allocate and read the monthly fields
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xinwet(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xinwet : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='prs'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xinwet(:,:)=xchampm(kindex(1:nbindex),:)
+  !-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xinprec(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xinprec : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='prm'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xinprec(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+  
+  ALLOC_ERR=-1
+  ALLOCATE(xint(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xint : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='t2m'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xint(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xinq(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xinq : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='r2m'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xinq(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xinwind(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xinwind : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='uv10m'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xinwind(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xincld(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xincld : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='tc'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                       iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xincld(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xintrng(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xintrng : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='t2a'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                       iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xintrng(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+! 10. clean up
+!-
+  IF (is_root_prc) THEN
+     DEALLOCATE (ncorr)
+     DEALLOCATE (icorr)
+     DEALLOCATE (jcorr)
+  ENDIF
+
+!-
+! 12. Allocate space for daily mean values
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(iwet(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of iwet : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(psurfm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of psurfm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(cloudm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of cloudm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(tmaxm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of tmaxm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(tminm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of tminm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(qdm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of qdm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(udm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of udm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(precipm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of precipm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(psurfm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of psurfm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(cloudm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of cloudm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(tmaxm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of tmaxm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(tminm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of tminm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(qdm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of qdm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(udm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of udm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(precipm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of precipm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+END SUBROUTINE weathgen_read_file
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_begin
+!!
+!>\BRIEF         This subroutines initializes variables or reads restart values. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::nbindex, ::tair, ::pb, ::qair, ::kindex
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_begin ( &
+     & dt_force,itau, date0, &
+     & rest_id,iim,jjm, &
+     & lon,lat,tair,pb,qair,kindex,nbindex)
+  !---------------------------------------------------------------------
+  IMPLICIT NONE
+
+  !-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN)                     :: dt_force, date0
+  INTEGER,INTENT(IN)                  :: itau
+  INTEGER,INTENT(IN)                  :: rest_id
+  INTEGER,INTENT(IN)                  :: iim, jjm
+  REAL,DIMENSION(iim,jjm),INTENT(IN)  :: lon,lat
+
+  !! 0.2 Output variables 
+
+  INTEGER,INTENT(OUT)                     :: nbindex
+  INTEGER,DIMENSION(iim*jjm),INTENT(OUT)  :: kindex
+  REAL,DIMENSION(iim,jjm),INTENT(OUT)     :: tair,pb,qair
+
+  !! 0.4 Local variables
+
+  INTEGER  :: i, j, ij
+  REAL     :: val_exp
+  REAL,DIMENSION(iim*jjm)               :: xchamp
+  REAL,DIMENSION(iim_g*jjm_g)           :: xchamp_g
+  CHARACTER(LEN=30)                     :: var_name
+  REAL,DIMENSION(1)                     :: jullasttab
+  REAL,DIMENSION(seedsize_max)          :: seed_in_file
+  INTEGER,DIMENSION(:), ALLOCATABLE     :: seed_in_proc
+  INTEGER  :: seedsize, iret
+  INTEGER  :: nlonid, nlatid, nlonid1, nlatid1, tdimid1, varid
+  INTEGER  :: ndim, dims(4)
+  CHARACTER(LEN=30) :: assoc
+  CHARACTER(LEN=70) :: str70
+  CHARACTER(LEN=80) :: stamp
+  INTEGER  :: yy_b, mm_b, dd_b, hh, mm
+  REAL     :: ss
+  CHARACTER(LEN=10) :: today, att
+  INTEGER  :: nlandid1, nlandid, nlevid, nlevid1
+  REAL     :: lev_max, lev_min
+  REAL     :: height_lev1
+  INTEGER  :: imois
+  REAL     :: xx, td
+
+!_ ================================================================================================================================
+
+  kindex(:)=0
+
+#ifdef CPP_PARA
+  nbindex=nbp_loc
+  CALL scatter(index_g,kindex)
+  kindex(1:nbindex)=kindex(1:nbindex)-(jj_begin-1)*iim_g
+#else
+  ! Copy saved land points index
+  nbindex = nbindex_w
+  kindex(1:nbindex_w) = kindex_w(:)
+#endif
+!-
+! 13. Prescribed or statistical values?
+!-
+  !Config Key   = IPPREC
+  !Config Desc  = Use prescribed values
+  !Config If    = ALLOW_WEATHERGEN
+  !Config Def   = 0
+  !Config Help  = If this is set to 1, the weather generator
+  !Config         uses the monthly mean values for daily means.
+  !Config         If it is set to 0, the weather generator
+  !Config         uses statistical relationships to derive daily
+  !Config         values from monthly means.
+  !Config Units = [-] 
+  ipprec = 0
+  CALL getin_p ('IPPREC',ipprec)
+  WRITE(numout,*) 'IPPREC: ',ipprec
+!-
+! 14. Do we want exact monthly precipitations even with ipprec=0 ?
+!-
+  !Config Key   = WEATHGEN_PRECIP_EXACT
+  !Config Desc  = Exact monthly precipitation
+  !Config If    = ALLOW_WEATHERGEN
+  !Config Def   = n
+  !Config Help  = If this is set to y, the weather generator
+  !Config         will generate pseudo-random precipitations
+  !Config         whose monthly mean is exactly the prescribed one.
+  !Config         In this case, the daily precipitation (for rainy
+  !Config         days) is constant (that is, some days have 0 precip,
+  !Config         the other days have precip=Precip_month/n_precip,
+  !Config         where n_precip is the prescribed number of rainy days
+  !Config         per month).
+  !Config Units = [FLAG]
+  precip_exact = .FALSE.
+  CALL getin_p ('WEATHGEN_PRECIP_EXACT',precip_exact)
+  WRITE(numout,*) 'PRECIP_EXACT: ',precip_exact
+
+!-
+! 15. Read restart file
+!-
+  CALL ioget_expval (val_exp)
+!-
+  var_name= 'julian'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id,var_name,1,1,1,itau,.TRUE.,jullasttab)
+     IF (jullasttab(1) == val_exp) THEN
+        jullasttab(1) = itau2date(itau-1, date0, dt_force)
+     ENDIF
+  ENDIF
+  CALL bcast(jullasttab)
+  julian_last = jullasttab(1)
+!-
+  var_name= 'seed'
+  IF (is_root_prc) &
+       CALL restget (rest_id,var_name,seedsize_max, &
+ &              1,1,itau,.TRUE.,seed_in_file)
+  CALL bcast(seed_in_file)
+  IF (ALL(seed_in_file(:) == val_exp)) THEN
+!---
+!-- there is no need to reinitialize the random number generator as
+!-- this does not seem to be a restart
+!---
+    CONTINUE
+  ELSE
+!---
+!-- reinitialize the random number generator
+!---
+     IF (is_root_prc) &
+          CALL RANDOM_SEED( SIZE = seedsize )
+     CALL bcast(seedsize)
+     IF (seedsize > seedsize_max) THEN
+        STOP 'weathgen_begin: increase seedsize_max'
+     ENDIF
+  
+     IF (precip_exact) THEN
+!---
+!-- preparer un tableau utilise pour determiner s'il pleut ou pas
+!-- (en fct. du nombre de jours de pluie par mois).
+!---
+        IF (is_root_prc) THEN
+           DO imois=1,12
+              CALL permute (ndaypm(imois),jour_precip(:,imois))
+           ENDDO
+        ENDIF
+       CALL bcast(jour_precip)
+    ENDIF
+
+    ALLOC_ERR=-1
+    ALLOCATE(seed_in_proc(seedsize), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of seed_in_proc : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    seed_in_proc(1:seedsize) = NINT( seed_in_file(1:seedsize) )
+    CALL RANDOM_SEED (PUT = seed_in_proc)
+    DEALLOCATE( seed_in_proc )
+ ENDIF
+!-
+  var_name= 'iwet'
+  IF (is_root_prc) THEN
+    CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+    IF (ALL(xchamp_g(:) == val_exp)) THEN
+      xchamp_g(:) = zero
+    ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  iwet(:) = NINT(xchamp(kindex(1:nbindex)))
+!-
+  var_name= 'psurfm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 100000.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  psurfm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'cloudm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = .5
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  cloudm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'tmaxm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 285.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  tmaxm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'tminm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 275.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  tminm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'qdm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 1.E-03
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  qdm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'udm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 2.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  udm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'precipm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 1.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  precipm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'psurfm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 100000.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  psurfm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'cloudm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = .5
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  cloudm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'tmaxm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 285.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  tmaxm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'tminm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 275.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  tminm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'qdm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 1.E-03
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  qdm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'udm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 2.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  udm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'precipm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 1.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  precipm1(:) = xchamp(kindex(1:nbindex))
+
+!-
+! 16. We still need instantaneous tair, qair, and the surface pressure
+!     We take daily mean values read from the restart file
+!-
+!!$  tair(:,:)=280.
+!!$  qair(:,:)=1.E-03
+!!$  pb(:,:)=101325
+  tair(:,:)=val_exp
+  qair(:,:)=val_exp
+  pb(:,:)=val_exp
+  xx = cte_grav/rair/0.0065
+  DO ij=1,nbindex
+     j = ((kindex(ij)-1)/iim) + 1
+     i = kindex(ij) - (j-1)*iim
+     
+     lat_land(ij) = lat(i,j)
+     
+     td =  (tmaxm0(ij)+tminm0(ij))/2.
+     tair(i,j) = td
+     qair(i,j) = qdm1(ij)
+     pb(i,j) = 101325.*(td/(td+0.0065*xintopo(ij)))**xx
+  ENDDO
+!-
+! 17. We can write a forcing file for Orchidee
+!     from this weather Generator run.
+!-
+  !Config Key   = DUMP_WEATHER
+  !Config Desc  = Write weather from generator into a forcing file
+  !Config If    = ALLOW_WEATHERGEN  
+  !Config Def   = n
+  !Config Help  = This flag makes the weather generator dump its
+  !Config         generated weather into a forcing file which can
+  !Config         then be used to get the same forcing on different
+  !Config         machines. This only works correctly if there is
+  !Config         a restart file (otherwise the forcing at the first
+  !Config         time step is slightly wrong).
+  !Config Units = [FLAG]
+  dump_weather = .FALSE.
+  CALL getin_p ('DUMP_WEATHER',dump_weather)
+!-
+  IF (dump_weather .AND. is_root_prc) THEN
+!---
+!-- Initialize the file
+!---
+     !Config Key   = DUMP_WEATHER_FILE
+     !Config Desc  = Name of the file that contains the weather from generator
+     !Config If    = DUMP_WEATHER
+     !Config Def   = weather_dump.nc
+     !Config Help  =
+     !Config Units = [FILE]
+    dump_weather_file = 'weather_dump.nc'
+    CALL getin ('DUMP_WEATHER_FILE',dump_weather_file)
+!---
+    !Config Key   = DUMP_WEATHER_GATHERED
+    !Config Desc  = Dump weather data on gathered grid
+    !Config If    = DUMP_WEATHER
+    !Config Def   = y
+    !Config Help  = If 'y', the weather data are gathered for all land points.
+    !Config Units = [FLAG]
+    gathered = .TRUE.
+    CALL getin ('DUMP_WEATHER_GATHERED',gathered)
+!---
+    iret = NF90_CREATE (TRIM(dump_weather_file),NF90_CLOBBER,dump_id)
+!---
+!-- Dimensions
+!---
+    iret = NF90_DEF_DIM (dump_id,'x',iim_g,nlonid1)
+    iret = NF90_DEF_DIM (dump_id,'y',jjm_g,nlatid1)
+    iret = NF90_DEF_DIM (dump_id,'z',  1,nlevid1)
+!---
+    IF (gathered) THEN
+      iret = NF90_DEF_DIM (dump_id,'land',nbp_glo,nlandid1)
+    ENDIF
+    iret = NF90_DEF_DIM (dump_id,'tstep',NF90_UNLIMITED,tdimid1)
+!---
+!-- Coordinate variables
+!---
+    dims(1:2) = (/ nlonid1, nlatid1 /)
+!---
+    iret = NF90_DEF_VAR (dump_id,'nav_lon',n_rtp,dims(1:2),nlonid)
+    iret = NF90_PUT_ATT (dump_id,nlonid,'units',"degrees_east")
+    iret = NF90_PUT_ATT (dump_id,nlonid,'valid_min',MINVAL(lon_g))
+    iret = NF90_PUT_ATT (dump_id,nlonid,'valid_max',MAXVAL(lon_g))
+    iret = NF90_PUT_ATT (dump_id,nlonid,'long_name',"Longitude")
+!---
+    iret = NF90_DEF_VAR (dump_id,'nav_lat',n_rtp,dims(1:2),nlatid)
+    iret = NF90_PUT_ATT (dump_id,nlatid,'units',"degrees_north")
+    iret = NF90_PUT_ATT (dump_id,nlatid,'valid_min',MINVAL(lat_g))
+    iret = NF90_PUT_ATT (dump_id,nlatid,'valid_max',MAXVAL(lat_g))
+    iret = NF90_PUT_ATT (dump_id,nlatid,'long_name',"Latitude")
+!---
+    height_lev1 = 10.
+    !Config Key   = HEIGHT_LEV1_DUMP
+    !Config Desc  = 
+    !Config If    = DUMP_WEATHER
+    !Config Def   = 10.
+    !Config Help  = 
+    !Config Units = [m]
+    CALL getin ('HEIGHT_LEV1_DUMP',height_lev1)
+    lev_min = height_lev1
+    lev_max = height_lev1
+!---
+    iret = NF90_DEF_VAR (dump_id,'level',n_rtp,(/ nlevid1 /),nlevid)
+    iret = NF90_PUT_ATT (dump_id,nlevid,'units',"m")
+    iret = NF90_PUT_ATT (dump_id,nlevid,'valid_min',lev_min)
+    iret = NF90_PUT_ATT (dump_id,nlevid,'valid_max',lev_max)
+    iret = NF90_PUT_ATT (dump_id,nlevid,'long_name',"Vertical levels")
+!---
+    IF (gathered) THEN
+      iret = NF90_DEF_VAR (dump_id,'land',NF90_INT,(/ nlandid1 /),nlandid)
+      iret = NF90_PUT_ATT (dump_id,nlandid,'compress',"y x")
+    ENDIF
+!---
+!-- Store the time axes.
+!---
+    iret = NF90_DEF_VAR (dump_id,'time',n_rtp,tdimid1,time_id)
+
+    yy_b=0
+    mm_b=1
+    dd_b=1
+    hh=00
+    mm=00
+    ss=0.
+
+    WRITE (str70,7000) yy_b, mm_b, dd_b, hh, mm, INT(ss)
+    iret = NF90_PUT_ATT (dump_id,time_id,'units',TRIM(str70))
+    iret = NF90_PUT_ATT (dump_id,time_id,'calendar',TRIM(calendar_str))
+    iret = NF90_PUT_ATT (dump_id,time_id,'title','Time')
+    iret = NF90_PUT_ATT (dump_id,time_id,'long_name','Time axis')
+    WRITE(str70,7001) yy_b, cal(mm_b), dd_b, hh, mm, INT(ss)
+    iret = NF90_PUT_ATT (dump_id,time_id,'time_origin',TRIM(str70))
+!---
+!-- Time steps
+!---
+    iret = NF90_DEF_VAR (dump_id,'timestp',NF90_INT,tdimid1,timestp_id)
+    WRITE(str70,7002) yy_b, mm_b, dd_b, hh, mm, INT(ss)
+    iret = NF90_PUT_ATT (dump_id,timestp_id,'units',TRIM(str70))
+    iret = NF90_PUT_ATT (dump_id,timestp_id,'title','Time steps')
+    iret = NF90_PUT_ATT (dump_id,timestp_id,'tstep_sec',dt_force)
+    iret = NF90_PUT_ATT &
+ &           (dump_id,timestp_id,'long_name','Time step axis')
+    WRITE(str70,7001) yy_b, cal(mm_b), dd_b, hh, mm, INT(ss)
+    iret = NF90_PUT_ATT (dump_id,timestp_id,'time_origin',TRIM(str70))
+!---
+7000 FORMAT('seconds since ',I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)
+7001 FORMAT(' ',I4.4,'-',A3,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)
+7002 FORMAT('timesteps since ', I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)
+!---
+!-- The variables in the file are declared and their attributes
+!-- written.
+!---
+    IF (gathered) THEN
+      ndim = 2
+      dims(1:2) = (/ nlandid1, tdimid1 /)
+      assoc = 'time (nav_lat nav_lon)'
+    ELSE
+      ndim = 3
+      dims(1:3) = (/ nlonid1, nlatid1, tdimid1 /)
+      assoc = 'time nav_lat nav_lon'
+    ENDIF
+!---
+    iret = NF90_DEF_VAR (dump_id,'SWdown',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','W/m^2')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Surface incident shortwave radiation')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    soldownid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Rainf',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','kg/m^2s')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Rainfall rate')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    rainfid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Snowf',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','kg/m^2s')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Snowfall rate')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    snowfid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'LWdown',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','W/m^2')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Surface incident longwave radiation')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    lwradid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'PSurf',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','Pa')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Surface pressure')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    psolid = varid
+!---
+!-- 3D Variables to be written
+!---
+    IF (gathered) THEN
+      ndim = 3
+      dims(1:3) = (/ nlandid1, nlevid1, tdimid1 /)
+      assoc = 'time level (nav_lat nav_lon)'
+    ELSE
+      ndim = 4
+      dims(1:4) = (/ nlonid1, nlatid1, nlevid1, tdimid1 /)
+      assoc = 'time level nav_lat nav_lon'
+    ENDIF
+!---
+    iret = NF90_DEF_VAR (dump_id,'Tair',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TZYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','K')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Near surface air temperature')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    tairid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Qair',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TZYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','kg/kg')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Near surface specific humidity')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    qairid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Wind_N',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TZYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','m/s')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Near surface northward wind component')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    uid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Wind_E',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TZYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','m/s')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Near surface eastward wind component')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    vid = varid
+!---
+!-- Global attributes
+!---
+    CALL DATE_AND_TIME (today, att)
+    stamp = "WG, date: "//TRIM(today)//" at "//TRIM(att)
+    iret = NF90_PUT_ATT (dump_id,NF90_GLOBAL,'Conventions',"GDT 1.2")
+    iret = NF90_PUT_ATT (dump_id,NF90_GLOBAL,'file_name', &
+ &                       TRIM(dump_weather_file))
+    iret = NF90_PUT_ATT (dump_id,NF90_GLOBAL,'production',TRIM(stamp))
+!---
+!-- Finish the definition phase
+!---
+    iret = NF90_ENDDEF (dump_id)
+!---
+!--    Write coordinates
+!---
+    iret = NF90_PUT_VAR (dump_id,nlonid,lon_g)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(numout,*) iret
+       CALL ipslerr_p (3,'weathgen_begin', &
+ &          'Could not put variable nav_lon in the file : ', &
+ &          TRIM(dump_weather_file),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_VAR (dump_id,nlatid,lat_g)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(numout,*) iret
+       CALL ipslerr_p (3,'weathgen_begin', &
+ &          'Could not put variable nav_lat in the file : ', &
+ &          TRIM(dump_weather_file),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_VAR (dump_id,nlevid,height_lev1)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(numout,*) iret
+       CALL ipslerr_p (3,'weathgen_begin', &
+ &          'Could not put variable level in the file : ', &
+ &          TRIM(dump_weather_file),'(Solution ?)')
+    ENDIF
+!---
+    IF (gathered) THEN
+       iret = NF90_PUT_VAR (dump_id,nlandid,index_g(1:nbp_glo))
+       IF (iret /= NF90_NOERR) THEN
+          WRITE(numout,*) iret
+          CALL ipslerr_p (3,'weathgen_begin', &
+ &          'Could not put variable land in the file : ', &
+ &          TRIM(dump_weather_file),'(Solution ?)')
+       ENDIF
+    ENDIF
+!---
+ ENDIF ! dump_weather
+!-----------------------------
+END SUBROUTINE weathgen_begin
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_get
+!!
+!>\BRIEF        This subroutine initializes forcing values. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::swdown, ::raina, ::snowa, ::tair, ::u, ::v, ::qair, ::psurf, ::lwdown
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_get &
+& (itau, date0, dt_force, nbindex, nband, lat, &
+&  swdown, raina, snowa, tair, u, v, qair, psurf, lwdown)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)               :: itau      !! number of time step
+  REAL,INTENT(IN)                  :: date0     !! date when itau was 0
+  REAL,INTENT(IN)                  :: dt_force  !! time step (s)
+  INTEGER,INTENT(IN)               :: nbindex   !! number of land points
+  INTEGER,INTENT(IN)               :: nband     !! number of visible bands
+  REAL,DIMENSION(nbindex),INTENT(IN)  :: lat    !! latitude (deg)
+
+  !! 0.2 Output variables  
+
+  REAL,DIMENSION(nbindex,nband),INTENT(OUT) :: swdown        !! Downward solar radiation @tex $(W.m^{-2})$ @endtex
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: raina, snowa  !! precipitations @tex $(mm.day^{-1})$ @endtex 
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: tair          !! air temperature (K)
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: u,v           !! wind speed @tex $(m.s^{-1})$ @endtex
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: qair          !! air humidity @tex $(kg_h2o.kg_air^{-1})$ @endtex
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: psurf         !! Surface pressure (Pa)
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: lwdown        !! Downward long wave radiation @tex $(W.m^{-2})$ @endtex
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(nbindex)        :: cloud, tmax, tmin, precipd, qd, ud
+  REAL,DIMENSION(nbindex)        :: rh
+  REAL,DIMENSION(nbindex,nband)  :: solai, solad
+  REAL                        :: julian, jur
+  REAL                        :: x
+  INTEGER                     :: yy, mm, dd
+  REAL                        :: ss, plens, time
+
+!_ ================================================================================================================================
+
+!-
+! 1. get a reduced julian day
+!-
+  julian = itau2date(itau-1, date0, dt_force)
+!S. Zaehle, test: solar noon at 12 o'clock!
+!  julian = itau2date(itau, date0, dt_force)
+  CALL ju2ymds (julian, yy, mm, dd, ss)
+  CALL ymds2ju (yy,1,1,0.0, jur)
+  julian = julian-jur
+  CALL ju2ymds (julian, yy, mm, dd, ss)
+!-
+! 2. daily values
+!-
+  IF (INT(julian_last) /= INT(julian)) THEN
+!-- today's values become yesterday's values
+    cloudm1(:) = cloudm0(:)
+    tmaxm1(:) = tmaxm0(:)
+    tminm1(:) = tminm0(:)
+    precipm1(:) = precipm0(:)
+    qdm1(:) = qdm0(:)
+    udm1(:) = udm0(:)
+    psurfm1(:) = psurfm0(:)
+!-- we have to get new daily values
+!!$    WRITE(*,*) mpi_rank, "weathgen_get : date ",yy, mm, dd, ss
+!!$    WRITE(*,*) mpi_rank, "weathgen_get : grid date ",year, month, day, sec
+    CALL daily (nbindex, mm, dd, cloudm0, tmaxm0, tminm0, &
+ &              precipm0, qdm0, udm0, psurfm0)
+  ENDIF
+!-
+! 3. interpolate daily values
+!    (otherwise we get ugly temperature jumps at midnight)
+!-
+  x = (julian-INT(julian))
+!-
+  cloud(:) = (1.-x)*cloudm1(:)+x*cloudm0(:)
+  tmax(:) = (1.-x)*tmaxm1(:)+x*tmaxm0(:)
+  tmin(:) = (1.-x)*tminm1(:)+x*tminm0(:)
+  precipd(:) = (1.-x)*precipm1(:)+x*precipm0(:)
+  qd(:) = (1.-x)*qdm1(:)+x*qdm0(:)
+  ud(:) = (1.-x)*udm1(:)+x*udm0(:)
+  psurf(:) = (1.-x)*psurfm1(:)+x*psurfm0(:)
+!-
+! 4. read instantaneous values
+!-
+  plens = one_day/dt_force
+  time = (julian-REAL(INT(julian)))*one_day
+!-
+  CALL diurnal (nbindex, nband, time, NINT(julian), plens, 0., one_day, &
+ &              lat, cloud, tmax, tmin, precipd, qd, ud, psurf, &
+ &              lwdown, solad, solai, u, tair, qair, raina, snowa, rh)
+!-
+  raina(:) = raina(:)/dt_force
+  snowa(:) = snowa(:)/dt_force
+!-
+  swdown(:,:) = solad(:,:)+solai(:,:)
+!-
+  v(:) = zero
+!-
+! 5. Store date
+!-
+  julian_last = julian
+!--------------------------
+END SUBROUTINE weathgen_get
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_restwrite
+!!
+!>\BRIEF         This subroutine writes data in the restart file.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_restwrite (rest_id,itau,iim,jjm,nbindex,kindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)  :: rest_id,itau,iim,jjm,nbindex
+  INTEGER,DIMENSION(iim*jjm),INTENT(IN) :: kindex
+
+  !! 0.4 Local variables
+
+  CHARACTER(LEN=30)                 :: var_name
+  INTEGER                           :: i,j,ij
+  REAL,DIMENSION(1)                 :: jullasttab
+  REAL,DIMENSION(seedsize_max)      :: seed_in_file
+  INTEGER,DIMENSION(:),ALLOCATABLE  :: seed_in_proc
+  INTEGER                           :: seedsize
+  REAL                              :: rndnum
+  REAL,DIMENSION(iim*jjm)           :: xchamp
+  REAL,DIMENSION(iim_g*jjm_g)       :: xchamp_g
+
+!_ ================================================================================================================================
+
+  var_name= 'julian'
+  jullasttab(:) = julian_last
+  IF (is_root_prc) CALL restput (rest_id, var_name, 1, 1, 1, itau, jullasttab)
+!-
+  IF (is_root_prc) THEN
+     CALL RANDOM_SEED( SIZE = seedsize )
+     IF (seedsize > seedsize_max) THEN
+        STOP 'weathgen_restwrite: increase seedsize_max'
+     ENDIF
+  ENDIF
+  CALL bcast(seedsize)
+
+  IF (is_root_prc) THEN
+     ALLOC_ERR=-1
+     ALLOCATE(seed_in_proc(seedsize), STAT=ALLOC_ERR)
+     IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of seed_in_proc : ",ALLOC_ERR
+        STOP 
+     ENDIF
+!-
+     CALL RANDOM_SEED (GET = seed_in_proc)
+!-
+     seed_in_file(1:seedsize) = REAL(seed_in_proc(1:seedsize))
+!-
+! fill in the seed up to seedsize_max
+! (useful in the case we restart on
+!  a machine with a longer seed vector:
+!  we do not want a degenerated seed)
+!-
+     DO i=seedsize+1,seedsize_max
+        CALL RANDOM_NUMBER( rndnum )
+        seed_in_file(i) = 100000.*rndnum
+     ENDDO
+  ENDIF
+  CALL bcast (seed_in_file)
+!-
+  IF (is_root_prc) THEN
+     DEALLOCATE( seed_in_proc )
+!-
+     var_name= 'seed'
+     CALL restput (rest_id,var_name,seedsize_max,1,1,itau,seed_in_file)
+  ENDIF
+!-
+
+  xchamp(:) = val_exp
+  
+!!$  DO j=1,jjm
+!!$    DO i=1,iim
+!!$      ij = (j-1)*iim+i
+!!$      xchamp(i,j) = REAL(iwet(ij))
+!!$    ENDDO
+!!$  ENDDO
+  DO ij=1,nbindex
+     xchamp(kindex(ij)) = REAL(iwet(ij))
+  ENDDO
+  var_name= 'iwet'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = psurfm0(ij)
+  ENDDO
+  var_name= 'psurfm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = cloudm0(ij)
+  ENDDO
+  var_name= 'cloudm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = tmaxm0(ij)
+  ENDDO
+  var_name= 'tmaxm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = tminm0(ij)
+  ENDDO
+  var_name= 'tminm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = qdm0(ij)
+  ENDDO
+  var_name= 'qdm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = udm0(ij)
+  ENDDO
+  var_name= 'udm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = precipm0(ij)
+  ENDDO
+  var_name= 'precipm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = psurfm1(ij)
+  ENDDO
+  var_name= 'psurfm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = cloudm1(ij)
+  ENDDO
+  var_name= 'cloudm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = tmaxm1(ij)
+  ENDDO
+  var_name= 'tmaxm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = tminm1(ij)
+  ENDDO
+  var_name= 'tminm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = qdm1(ij)
+  ENDDO
+  var_name= 'qdm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = udm1(ij)
+  ENDDO
+  var_name= 'udm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = precipm1(ij)
+  ENDDO
+  var_name= 'precipm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!--------------------------------
+END SUBROUTINE weathgen_restwrite
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_data
+!!
+!>\BRIEF         This subroutine reads data from an netcdf file. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::champout
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weather_read &
+& (force_id,nomvar,iim_file,jjm_file,n3,i_cut, &
+&  iim,jjm,n_agg,ncorr,icorr,jcorr,champout)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+  
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                          :: force_id
+  CHARACTER(LEN=*),INTENT(IN)                 :: nomvar
+  INTEGER,INTENT(IN)                          :: iim_file,jjm_file
+  INTEGER,INTENT(IN)                          :: n3
+  INTEGER,INTENT(IN)                          :: i_cut
+  INTEGER,INTENT(IN)                          :: iim,jjm
+  INTEGER,INTENT(IN)                          :: n_agg
+  INTEGER,DIMENSION(:,:),INTENT(IN)           :: ncorr
+  INTEGER,DIMENSION(:,:,:),INTENT(IN)         :: icorr,jcorr
+
+  !! 0.2 Output variables 
+
+  REAL,DIMENSION(iim*jjm,n3),INTENT(OUT)      :: champout
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(iim_file,jjm_file,n3)        :: champ_file
+  REAL,ALLOCATABLE,DIMENSION(:,:)             :: champout_g
+  INTEGER                                     :: i,j,ij,l,m
+
+!_ ================================================================================================================================
+
+  WRITE(numout,*) 'Lecture ',TRIM(nomvar)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(champout_g(iim_g*jjm_g,n3))
+     IF ( n3 == 1 ) THEN
+        CALL flinget (force_id,nomvar(1:LEN_TRIM(nomvar)), &
+             &                iim_file, jjm_file, 0, 0,  1, 1, champ_file)
+     ELSE
+        DO l=1,n3
+           CALL flinget &
+                &      (force_id,nomvar(1:LEN_TRIM(nomvar)), &
+                &       iim_file, jjm_file, 0, n3,  l, l, champ_file(:,:,l))
+        ENDDO
+     ENDIF
+     ! shift if necessary
+     IF (i_cut /= 0) THEN
+        DO l=1,n3
+           CALL shift_field (iim_file,jjm_file,i_cut,champ_file(:,:,l))
+        ENDDO
+     ENDIF
+     ! interpolate onto the model grid
+     DO l=1,n3
+        DO j=1,jjm_g
+           DO i=1,iim_g
+              ij = i+(j-1)*iim_g
+              champout_g(ij,l) = zero
+              DO m=1,ncorr(i,j)
+                 champout_g(ij,l) = champout_g(ij,l) &
+        &                        +champ_file(icorr(i,j,m),jcorr(i,j,m),l)
+              ENDDO
+              champout_g(ij,l) = champout_g(ij,l)/REAL(ncorr(i,j))
+           ENDDO
+        ENDDO
+     ENDDO
+!$     DO l=1,n3
+!$        DO j=1,jjm_g
+!$           WRITE(numout,*) j,(/ ( champout_g((j-1)*iim_g+i,l), i=1,iim_g ) /)
+!$        ENDDO
+!$     ENDDO
+  ELSE
+     ALLOCATE(champout_g(1,1))
+  ENDIF
+!!$  CALL scatter2D(champout_g,champout)
+#ifndef CPP_PARA
+  champout(:,:)=champout_g(:,:)
+#else
+  CALL orch_scatter2D_mpi_rgen(champout_g,champout,SIZE(champout_g,1),SIZE(champout_g,2))
+#endif
+
+!$  DO l=1,n3
+!$     DO j=1,jjm
+!$        WRITE(numout,*) j,(/ ( champout((j-1)*iim_g+i,l), i=1,iim_g ) /)
+!$     ENDDO
+!$  ENDDO
+  !----------------------------
+END SUBROUTINE weather_read
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_dump
+!!
+!>\BRIEF        This subroutine "dumps" data before writing an netcdf file.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_dump &
+& (itau, dt_force, iim, jjm, nbindex, kindex, lrstwrite, &
+&  swdown, rainf, snowf, tair, u, v, qair, pb, lwdown )
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                     :: itau
+  REAL,INTENT(IN)                        :: dt_force
+  INTEGER,INTENT(IN)                     :: iim,jjm
+  INTEGER,INTENT(IN)                     :: nbindex
+  LOGICAL,INTENT(IN)                     :: lrstwrite
+  INTEGER,DIMENSION(iim*jjm),INTENT(IN)  :: kindex
+  REAL,DIMENSION(iim*jjm),INTENT(IN)     :: &
+ &  swdown, rainf, snowf, tair, u, v, qair, pb, lwdown
+
+  !! 0.4 Local variables
+
+  INTEGER                 :: iret,ndim
+  INTEGER,DIMENSION(4)    :: corner,edges
+  REAL,DIMENSION(iim*jjm) :: var_gather
+
+!_ ================================================================================================================================
+
+!-
+! time dimension
+!-
+  iret = NF90_PUT_VAR (dump_id,timestp_id,(/ REAL(itau) /), &
+ &                     start=(/ itau /),count=(/ 1 /))
+  iret = NF90_PUT_VAR (dump_id,time_id,(/ REAL(itau)*dt_force /), &
+ &                     start=(/ itau /),count=(/ 1 /))
+!-
+! 2D variables: pas de dimension verticale
+!-
+  IF (gathered) THEN
+    ndim = 2
+    corner(1:2) = (/ 1, itau /)
+    edges(1:2) = (/ nbindex, 1 /)
+  ELSE
+    ndim = 3
+    corner(1:3) = (/ 1, 1, itau /)
+    edges(1:3) = (/ iim, jjm, 1 /)
+  ENDIF
+!-
+  CALL gather_weather (iim*jjm,nbindex,kindex,swdown, var_gather)
+  iret = NF90_PUT_VAR (dump_id,soldownid, var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,rainf,  var_gather)
+  iret = NF90_PUT_VAR (dump_id,rainfid,   var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,snowf,  var_gather)
+  iret = NF90_PUT_VAR (dump_id,snowfid,   var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,pb,     var_gather)
+  iret = NF90_PUT_VAR (dump_id,psolid,    var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,lwdown, var_gather)
+  iret = NF90_PUT_VAR (dump_id,lwradid,   var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+!-
+! 3D variables
+!-
+  IF (gathered) THEN
+    ndim = 3
+    corner(1:3) = (/ 1, 1, itau /)
+    edges(1:3) = (/ nbindex, 1, 1 /)
+  ELSE
+    ndim = 4
+    corner(1:4) = (/ 1, 1, 1, itau /)
+    edges(1:4) = (/ iim, jjm, 1, 1 /)
+  ENDIF
+!-
+  CALL gather_weather (iim*jjm,nbindex,kindex,u,    var_gather)
+  iret = NF90_PUT_VAR (dump_id,uid,    var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,v,    var_gather)
+  iret = NF90_PUT_VAR (dump_id,vid,    var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,tair, var_gather)
+  iret = NF90_PUT_VAR (dump_id,tairid, var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,qair, var_gather)
+  iret = NF90_PUT_VAR (dump_id,qairid, var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+!-
+  IF (lrstwrite) THEN
+    iret = NF90_CLOSE (dump_id)
+  ENDIF
+!---------------------------
+END SUBROUTINE weathgen_dump
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gather_weather
+!!
+!>\BRIEF        This subroutine determines which points are not in the computational domain and
+!! creates a mask for these points. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::var_out
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE gather_weather (iimjjm, nbindex, kindex, var_in, var_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                     :: iimjjm,nbindex
+  INTEGER,DIMENSION(iimjjm),INTENT(IN)   :: kindex
+  REAL,DIMENSION(iimjjm),INTENT(IN)      :: var_in
+
+  !! 0.2 Output variables  
+
+  REAL,DIMENSION(iimjjm),INTENT(OUT)     :: var_out
+
+  !! 0.4 Local variables
+
+  INTEGER                                :: i
+  LOGICAL,SAVE                           :: lstep_init_gather = .TRUE.
+  INTEGER,SAVE                           :: nb_outside
+  INTEGER,ALLOCATABLE,SAVE,DIMENSION(:)  :: outside
+
+!_ ================================================================================================================================
+
+  IF (lstep_init_gather) THEN
+!---
+!-- determine which points are not in the computational domain and
+!-- create a mask for these points
+!---
+    lstep_init_gather = .FALSE.
+  
+    ALLOC_ERR=-1
+    ALLOCATE(outside(iimjjm), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of outside : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    outside(:) = zero
+    nb_outside = 0
+    DO i=1,iimjjm
+      IF ( ALL( kindex(:) /= i ) ) THEN
+        nb_outside = nb_outside+1
+        outside(nb_outside) = i
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+  IF ( gathered ) THEN
+    DO i=1,nbindex
+      var_out(i) = var_in(kindex(i))
+    ENDDO
+  ELSE
+    var_out(:) = var_in(:)
+    DO i=1,nb_outside
+      var_out(outside(i)) = undef_sechiba
+    ENDDO
+  ENDIF
+!--------------------
+END SUBROUTINE gather_weather
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : shift_shield
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::champ
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE shift_field (im,jm,i_cut,champ)
+!---------------------------------------------------------------------
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                  :: im,jm,i_cut
+
+  !! 0.3 Modified variables
+
+  REAL,DIMENSION(im,jm),INTENT(INOUT) :: champ
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(im,jm)               :: champ_temp
+
+!_ ================================================================================================================================
+
+  IF ( (i_cut >= 1).AND.(i_cut <= im) ) THEN
+    champ_temp(1:im-i_cut-1,:) = champ(i_cut:im,:)
+    champ_temp(im-i_cut:im,:)  = champ(1:i_cut+1,:)
+    champ(:,:) = champ_temp(:,:)
+  ENDIF
+!-------------------------
+END SUBROUTINE shift_field
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_domain_size
+!!
+!>\BRIEF        This subroutine determines the size of the domain.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::iim, ::jjm, ::limit_west, ::limit_east, ::limit_north, ::limit_south
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_domain_size &
+& (limit_west,limit_east,limit_north,limit_south, &
+&  zonal_res,merid_res,iim,jjm)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN)     :: zonal_res,merid_res
+
+  !! 0.2 Output variables 
+
+  INTEGER,INTENT(OUT) :: iim,jjm
+
+  !! 0.3 Modified variables
+
+  REAL,INTENT(INOUT)  :: limit_west,limit_east,limit_north,limit_south
+
+!_ ================================================================================================================================
+
+  IF (limit_west > limit_east)  limit_east = limit_east+360.
+!-
+  IF (    (limit_west >= limit_east) &
+ &    .OR.(limit_east > 360.) &
+ &    .OR.(limit_west < -180.) &
+ &    .OR.(limit_east-limit_west > 360.) ) THEN
+    WRITE(numout,*) 'PROBLEME longitudes.'
+    WRITE(numout,*) 'Limites Ouest, Est: ',limit_west,limit_east
+    STOP
+  ENDIF
+!-
+  IF (    (limit_south < -90.) &
+ &    .OR.(limit_north > 90.) &
+ &    .OR.(limit_south >= limit_north ) ) THEN
+    WRITE(numout,*) 'PROBLEME latitudes.'
+    WRITE(numout,*) 'Limites Nord, Sud: ',limit_north,limit_south
+    STOP
+  ENDIF
+!-
+  IF (    (zonal_res <= 0. ) &
+ &    .OR.(zonal_res > limit_east-limit_west) ) THEN
+    WRITE(numout,*) 'PROBLEME resolution zonale.'
+    WRITE(numout,*) 'Limites Ouest, Est, Resolution: ', &
+ &             limit_west,limit_east,zonal_res
+    STOP
+  ENDIF
+!-
+  IF (    (merid_res <= 0.) &
+ &    .OR.(merid_res > limit_north-limit_south) ) THEN
+    WRITE(numout,*) 'PROBLEME resolution meridionale.'
+    WRITE(numout,*) 'Limites Nord, Sud, Resolution: ', &
+ &             limit_north,limit_south,merid_res
+    STOP
+  ENDIF
+!-
+  iim = NINT(MAX((limit_east-limit_west)/zonal_res,1.))
+  jjm = NINT(MAX((limit_north-limit_south)/merid_res,1.))
+!-
+  WRITE(numout,*) 'Domain size: iim, jjm = ', iim, jjm
+!----------------------------------
+END SUBROUTINE weathgen_domain_size
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! FUNCTION     : tsat1 
+!!
+!>\BRIEF         This function computes the saturated temperature for vapor. 
+!!
+!! DESCRIPTION :  functions tsatl,tsati are used below so that Lowe's
+!!                polyomial for liquid is used if t gt 273.16, or for ice if
+!!                t lt 273.16. also impose range of validity for Lowe's polys.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : tsat
+!!
+!! REFERENCE(S) : 
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+FUNCTION tsatl (t) RESULT (tsat)
+
+  !! 0. Variables and parameters declaration
+  
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN) :: t
+
+  !! 0.2 Result
+  REAL            :: tsat
+
+!_ ================================================================================================================================
+
+  tsat = MIN(100.,MAX(t-zero_t,zero))
+!-----------------
+END FUNCTION tsatl
+!-
+!===
+!-
+!! ================================================================================================================================
+!! FUNCTION     : tsati 
+!!
+!>\BRIEF         This function computes the saturated temperature for ice. 
+!!
+!! DESCRIPTION :  functions tsatl,tsati are used below so that Lowe's
+!!                polyomial for liquid is used if t gt 273.16, or for ice if
+!!                t lt 273.16. also impose range of validity for Lowe's polys.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : tsat
+!!
+!! REFERENCE(S) : 
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+FUNCTION tsati (t) RESULT (tsat)
+
+  !! 0. Variables and parameters declaration
+  
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN) :: t
+
+  !! 0.2 Result
+  REAL            :: tsat
+
+!_ ================================================================================================================================
+
+  tsat = MAX(-60.,MIN(t-zero_t,zero))
+
+!-----------------
+END FUNCTION tsati
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! FUNCTION     : esat
+!!
+!>\BRIEF         This function computes specific humidity with the polynomials of Lowe.
+!!
+!! DESCRIPTION : The function esat is svp in n/m**2, with t in deg k.
+!!               (100 * lowe's poly since 1 mb = 100 n/m**2.). \n
+!!               Polynomials for svp(t), d(svp)/dt over water and ice 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : esatout
+!!
+!! REFERENCE(S) : 
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+FUNCTION esat (t) RESULT (esatout)
+
+  !! 0. Variables and parameters declaration
+
+  REAL,PARAMETER :: &                                                    !! polynomials for svp(t), d(svp)/dt over water and ice are from
+ & asat0 = 6.1078000,    asat1 = 4.4365185e-1, asat2 = 1.4289458e-2, &   !! lowe(1977),jam,16,101-103.
+ & asat3 = 2.6506485e-4, asat4 = 3.0312404e-6, asat5 = 2.0340809e-8, &
+ & asat6 = 6.1368209e-11, &
+ & bsat0 = 6.1091780,    bsat1 = 5.0346990e-1, bsat2 = 1.8860134e-2, &
+ & bsat3 = 4.1762237e-4, bsat4 = 5.8247203e-6, bsat5 = 4.8388032e-8, &
+ & bsat6 = 1.8388269e-10
+
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN) :: t
+
+  !! 0.2 Result
+
+  REAL             :: esatout
+
+  !! 0.4 Local variables
+
+  REAL             :: x
+
+!_ ================================================================================================================================
+
+  IF (t >= zero_t) THEN
+    x = asat0
+  ELSE
+    x = bsat0
+  ENDIF
+!-
+  esatout = 100.* &
+    ( x &
+     +tsatl(t)*(asat1+tsatl(t)*(asat2+tsatl(t)*(asat3 &
+     +tsatl(t)*(asat4+tsatl(t)*(asat5+tsatl(t)* asat6))))) &
+     +tsati(t)*(bsat1+tsati(t)*(bsat2+tsati(t)*(bsat3 &
+     +tsati(t)*(bsat4+tsati(t)*(bsat5+tsati(t)* bsat6)))))  )
+!----------------
+END FUNCTION esat
+!-
+!===
+!-
+! ================================================================================================================================
+!! FUNCTION     : qsat
+!!
+!>\BRIEF         This function computes the saturation specific humidity. 
+!!
+!! DESCRIPTION :  statement function qsat is saturation specific humidity,
+!! with svp e and ambient pressure p in n/m**2. impose an upper
+!! limit of 1 to avoid spurious values for very high svp
+!! and/or small p
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : qsatout
+!!
+!! REFERENCE(S) : 
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+FUNCTION qsat (e,p) RESULT (qsatout)
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  REAL, INTENT(IN) :: e,p
+
+  !! 0.2 Result
+  REAL             :: qsatout
+
+!_ ================================================================================================================================
+
+  qsatout = 0.622*e/MAX(p-(1.0-0.622)*e,0.622*e)
+!----------------
+END FUNCTION qsat
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_qsat
+!!
+!>\BRIEF        This subroutine calculates the saturation vapor pressure with the polynomials of Lowe. 
+!!
+!! DESCRIPTION  : Vectorized version of functions esat and qsat.
+!!                statement function esat is svp in n/m**2, with t in deg K.\n
+!!               (100 * lowe's poly since 1 mb = 100 n/m**2.)\n
+!!               Polynomials for svp(t), d(svp)/dt over water 
+!!               and ice are from Lowe(1977),jam,16,101-103 \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::qsat
+!!
+!! REFERENCE(S) :
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation 
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_qsat (npoi,t,p,qsat)
+
+
+  !! 0. Variables and parameters declaration
+
+ !-
+ ! polynomials for svp(t), d(svp)/dt over water and ice
+ ! are from lowe(1977),ja
+  REAL,PARAMETER :: &
+ & asat0 = 6.1078000,    asat1 = 4.4365185e-1, asat2 = 1.4289458e-2, &   !! polynomials for svp(t), d(svp)/dt over water and ice
+ & asat3 = 2.6506485e-4, asat4 = 3.0312404e-6, asat5 = 2.0340809e-8, &
+ & asat6 = 6.1368209e-11, &
+ & bsat0 = 6.1091780,    bsat1 = 5.0346990e-1, bsat2 = 1.8860134e-2, &
+ & bsat3 = 4.1762237e-4, bsat4 = 5.8247203e-6, bsat5 = 4.8388032e-8, &
+ & bsat6 = 1.8388269e-10
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)              :: npoi
+  REAL,DIMENSION(npoi),INTENT(IN) :: t,p
+
+  !! 0.2 Output variables 
+
+  REAL,DIMENSION(npoi),INTENT(OUT):: qsat
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(npoi) :: x, tl, ti, e
+
+!_ ================================================================================================================================
+
+  WHERE (t(:) > zero_t)
+    x(:) = asat0
+  ELSEWHERE
+    x(:) = bsat0
+  ENDWHERE
+!-
+  tl(:) = MIN(100.,MAX(t(:)-zero_t,zero))
+  ti(:) = MAX(-60.,MIN(t(:)-zero_t,zero))
+!-
+  e(:) =  100.* &
+    ( x(:) &
+     +tl(:)*(asat1+tl(:)*(asat2+tl(:)*(asat3 &
+     +tl(:)*(asat4+tl(:)*(asat5+tl(:)* asat6))))) &
+     +ti(:)*(bsat1+ti(:)*(bsat2+ti(:)*(bsat3 &
+     +ti(:)*(bsat4+ti(:)*(bsat5+ti(:)* bsat6)))))  )
+!-
+  qsat(:) = 0.622*e(:)/MAX(p(:)-(1.0-0.622)*e(:),0.622*e(:))
+!---------------------------
+END SUBROUTINE weathgen_qsat
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_qsat_2d
+!!
+!>\BRIEF        This subroutine calculates the saturation vapor pressure with the polynomials of Lowe. 
+!!
+!! DESCRIPTION  : Vectorized version of functions esat and qsat.
+!!                statement function esat is svp in n/m**2, with t in deg K.\n
+!!               (100 * lowe's poly since 1 mb = 100 n/m**2.)\n
+!!               Polynomials for svp(t), d(svp)/dt over water 
+!!               and ice are from Lowe(1977),jam,16,101-103 \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::qsat
+!!
+!! REFERENCE(S) :
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation 
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_qsat_2d (iim,jjm,t,p,qsat)
+
+  !! 0. Parameters and variable declaration
+
+  !! 0.1 Input variables
+
+  INTEGER, INTENT(IN) :: iim
+  INTEGER, INTENT(IN) :: jjm
+  REAL,DIMENSION(iim,jjm),INTENT(IN)  :: t,p
+
+   !! 0.2 Output variables
+   REAL,DIMENSION(iim,jjm),INTENT(OUT) :: qsat
+
+   !! 0.4 Local variables
+
+   REAL,DIMENSION(iim,jjm) :: x, tl, ti, e
+
+  REAL,PARAMETER :: &
+ & asat0 = 6.1078000,    asat1 = 4.4365185e-1, asat2 = 1.4289458e-2, &
+ & asat3 = 2.6506485e-4, asat4 = 3.0312404e-6, asat5 = 2.0340809e-8, &
+ & asat6 = 6.1368209e-11, &
+ & bsat0 = 6.1091780,    bsat1 = 5.0346990e-1, bsat2 = 1.8860134e-2, &
+ & bsat3 = 4.1762237e-4, bsat4 = 5.8247203e-6, bsat5 = 4.8388032e-8, &
+ & bsat6 = 1.8388269e-10
+
+!_ ================================================================================================================================
+
+  WHERE (t(:,:) > zero_t)
+    x(:,:) = asat0
+  ELSEWHERE
+    x(:,:) = bsat0
+  ENDWHERE
+!-
+  tl(:,:) = MIN(100.,MAX(t(:,:)-zero_t,0.))
+  ti(:,:) = MAX(-60.,MIN(t(:,:)-zero_t,0.))
+!-
+  e(:,:) =  100.* &
+    ( x(:,:) &
+     +tl(:,:)*(asat1+tl(:,:)*(asat2+tl(:,:)*(asat3 &
+     +tl(:,:)*(asat4+tl(:,:)*(asat5+tl(:,:)* asat6))))) &
+     +ti(:,:)*(bsat1+ti(:,:)*(bsat2+ti(:,:)*(bsat3 &
+     +ti(:,:)*(bsat4+ti(:,:)*(bsat5+ti(:,:)* bsat6)))))  )
+!-
+  qsat(:,:) = 0.622*e(:,:)/MAX(p(:,:)-(1.0-0.622)*e(:,:),0.622*e(:,:))
+!---------------------------
+END SUBROUTINE weathgen_qsat_2d
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : mask_c_o 
+!!
+!>\BRIEF        This subroutine computes a field which indicated if the point is terrestrial or oceanic.
+!!
+!! DESCRIPTION  : From a mask field, we make an indicator mask Earth/ocean. Earth : 1 ; ocean : 0.
+!!
+!! RECENT CHANGE(S): z.x.li,01/04/1994 : creation of the subroutine 
+!!
+!! MAIN OUTPUT VARIABLE(S): ::mask, ::ncorr, ::icorr
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE mask_c_o &
+& (imdep, jmdep, xdata, ydata, mask_in, fcrit, &
+&  imar, jmar, zonal_res, merid_res, n_agg, x, y, mask, &
+&  ncorr, icorr, jcorr)
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER :: imdep,jmdep
+  REAL :: xdata(imdep),ydata(jmdep)
+  REAL :: mask_in(imdep,jmdep)
+  REAL :: fcrit
+  INTEGER :: imar,jmar
+  REAL :: zonal_res,merid_res
+  INTEGER :: n_agg
+  REAL :: x(imar),y(jmar)
+
+  !! 0.2 Output variables 
+
+  REAL, INTENT(OUT) :: mask(imar,jmar)
+  INTEGER :: ncorr(imar,jmar)
+  INTEGER,DIMENSION(imar,jmar,n_agg) :: icorr,jcorr
+
+  !! 0.4 Local variables 
+
+  INTEGER i, j, ii, jj
+  REAL a(imar),b(imar),c(jmar),d(jmar)
+  INTEGER num_tot(imar,jmar), num_oce(imar,jmar)
+  REAL,ALLOCATABLE :: distans(:)
+  INTEGER ij_proche(1),i_proche,j_proche
+!-
+  INTEGER,DIMENSION(imar,jmar) :: ncorr_oce , ncorr_land
+  INTEGER,DIMENSION(imar,jmar,n_agg) :: &
+ &  icorr_oce, jcorr_oce , icorr_land, jcorr_land
+!-
+  INTEGER imdepp
+  REAL,ALLOCATABLE :: xdatap(:)
+  REAL,ALLOCATABLE :: mask_inp(:,:)
+  LOGICAL :: extend
+
+!_ ================================================================================================================================
+
+  ncorr(:,:) = 0
+  icorr(:,:,:) = -1; jcorr(:,:,:) = -1
+  ncorr_land(:,:) = 0
+  icorr_land(:,:,:) = -1; jcorr_land(:,:,:) = -1
+  ncorr_oce(:,:) = 0
+  icorr_oce(:,:,:) = -1; jcorr_oce(:,:,:) = -1
+! do we have to extend the domain (-x...-x+360)?
+  IF ( xdata(1)+360.-xdata(imdep) > 0.01 ) THEN
+    extend = .TRUE.
+    imdepp = imdep+1
+  ELSE
+    extend = .FALSE.
+    imdepp = imdep
+  ENDIF
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xdatap(imdepp), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xdatap : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(mask_inp(imdepp,jmdep), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of mask_inp : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+  xdatap(1:imdep) = xdata(1:imdep)
+  mask_inp(1:imdep,:) = mask_in(1:imdep,:)
+!-
+  IF (extend) THEN
+    xdatap(imdepp) = xdatap(1)+360.
+    mask_inp(imdepp,:) = mask_inp(1,:)
+  ENDIF
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(distans(imdepp*jmdep), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of distans : ",ALLOC_ERR
+    STOP 
+  ENDIF
+! Definition des limites des boites de la grille d'arrivee.
+  IF (imar > 1) THEN
+    a(1) = x(1)-(x(2)-x(1))/2.0
+    b(1) = (x(1)+x(2))/2.0
+    DO i=2,imar-1
+      a(i) = b(i-1)
+      b(i) = (x(i)+x(i+1))/2.0
+    ENDDO
+    a(imar) = b(imar-1)
+    b(imar) = x(imar)+(x(imar)-x(imar-1))/2.0
+  ELSE
+    a(1) = x(1)-zonal_res/2.
+    b(1) = x(1)+zonal_res/2.
+  ENDIF
+!-
+  IF (jmar > 1) THEN
+    c(1) = y(1)-(y(2)-y(1))/2.0
+    d(1) = (y(1)+y(2))/2.0
+    DO j=2,jmar-1
+      c(j) = d(j-1)
+      d(j) = (y(j)+y(j+1))/2.0
+    ENDDO
+    c(jmar) = d(jmar-1)
+    d(jmar) = y(jmar)+(y(jmar)-y(jmar-1))/2.0
+  ELSE
+    c(1) = y(1)-merid_res/2.
+    d(1) = y(1)+merid_res/2.
+  ENDIF
+!-
+  num_oce(1:imar,1:jmar) = 0
+  num_tot(1:imar,1:jmar) = 0
+!-
+!  .....  Modif  P. Le Van ( 23/08/95 )  ....
+!-
+  DO ii=1,imar
+    DO jj=1,jmar
+      DO i=1,imdepp
+        IF (    (     (xdatap(i)-a(ii) >= 1.e-5) &
+ &               .AND.(xdatap(i)-b(ii) <= 1.e-5) ) &
+ &          .OR.(     (xdatap(i)-a(ii) <= 1.e-5) &
+ &               .AND.(xdatap(i)-b(ii) >= 1.e-5) ) ) THEN
+          DO j=1,jmdep
+            IF (    (     (ydata(j)-c(jj) >= 1.e-5) &
+ &                   .AND.(ydata(j)-d(jj) <= 1.e-5) ) &
+ &              .OR.(     (ydata(j)-c(jj) <= 1.e-5) &
+ &                   .AND.(ydata(j)-d(jj) >= 1.e-5) ) ) THEN
+              num_tot(ii,jj) = num_tot(ii,jj)+1
+              IF (mask_inp(i,j) < 0.5) THEN
+                num_oce(ii,jj) = num_oce(ii,jj)+1
+!-------------- on a trouve un point oceanique. On le memorise.
+                ncorr_oce(ii,jj) = ncorr_oce(ii,jj)+1
+                IF ((i == imdepp).AND.extend) THEN
+                  icorr_oce(ii,jj,ncorr_oce(ii,jj)) = 1
+                ELSE
+                  icorr_oce(ii,jj,ncorr_oce(ii,jj)) = i
+                ENDIF
+                jcorr_oce(ii,jj,ncorr_oce(ii,jj)) = j
+              ELSE
+!-------------- on a trouve un point continental. On le memorise.
+                ncorr_land(ii,jj) = ncorr_land(ii,jj)+1
+                IF ((i == imdepp).AND.extend) THEN
+                  icorr_land(ii,jj,ncorr_land(ii,jj)) = 1
+                ELSE
+                  icorr_land(ii,jj,ncorr_land(ii,jj)) = i
+                ENDIF
+                jcorr_land(ii,jj,ncorr_land(ii,jj)) = j
+              ENDIF
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  DO i=1,imar
+    DO j=1,jmar
+      IF (num_tot(i,j) > 0) THEN
+        IF (    (     (num_oce(i,j) == 0) &
+ &               .AND.(num_tot(i,j) > 0) ) &
+ &          .OR.(     (num_oce(i,j) > 0) &
+ &               .AND.(   REAL(num_oce(i,j)) &
+ &                     <= REAL(num_tot(i,j))*(1.-fcrit) ) ) ) THEN
+          mask(i,j) = un
+          ncorr(i,j) = ncorr_land(i,j)
+          icorr(i,j,:) = icorr_land(i,j,:)
+          jcorr(i,j,:) = jcorr_land(i,j,:)
+        ELSE
+          mask(i,j) = zero
+          ncorr(i,j) = ncorr_oce(i,j)
+          icorr(i,j,:) = icorr_oce(i,j,:)
+          jcorr(i,j,:) = jcorr_oce(i,j,:)
+        ENDIF
+      ELSE
+        CALL dist_sphe(x(i),y(j),xdatap,ydata,imdepp,jmdep,distans)
+        ij_proche(:) = MINLOC(distans)
+        j_proche = (ij_proche(1)-1)/imdepp+1
+        i_proche = ij_proche(1)-(j_proche-1)*imdepp
+        mask(i,j) = mask_inp(i_proche,j_proche)
+        IF ( (i_proche == imdepp).AND.extend)  i_proche=1
+        ncorr(i,j) = 1
+        icorr(i,j,1) = i_proche
+        jcorr(i,j,1) = j_proche
+      ENDIF
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE mask_c_o
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : dist_sphe
+!!
+!>\BRIEF        This subroutine computes the minimum distance between two points on Earth
+!! according the great circle. \n
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): Laurent Li, 30/12/1996 : creation of this subroutine
+!!
+!! MAIN OUTPUT VARIABLE(S): ::distance
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE dist_sphe (rf_lon,rf_lat,rlon,rlat,im,jm,distance)
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER :: im, jm    !! dimensions
+  REAL    :: rf_lon       !! longitude of the referenced point (degrees)
+  REAL    :: rf_lat       !! latitude of the referenced point (degrees)
+  REAL    :: rlon(im), rlat(jm) !! longitude and latitude of points
+
+  !! 0.2 Output variables
+
+  REAL :: distance(im,jm) !! distances in meters (m)
+
+  !! 0.4 Local variables
+
+  REAL :: rlon1, rlat1
+  REAL :: rlon2, rlat2
+  REAL :: dist
+  REAL :: pa, pb, p
+  INTEGER :: i,j
+
+!_ ================================================================================================================================
+
+  DO j=1,jm
+    DO i=1,im
+      rlon1=rf_lon
+      rlat1=rf_lat
+      rlon2=rlon(i)
+      rlat2=rlat(j)
+      pa = pi/2.0-rlat1*pir ! dist. entre pole n et point a
+      pb = pi/2.0-rlat2*pir ! dist. entre pole n et point b
+!-----
+      p = (rlon1-rlon2)*pir ! angle entre a et b (leurs meridiens)
+!-----
+      dist = ACOS( COS(pa)*COS(pb)+SIN(pa)*SIN(pb)*COS(p))
+      dist = R_Earth*dist      
+      distance(i,j) = dist
+    ENDDO
+  ENDDO
+!-----------------------
+END SUBROUTINE dist_sphe
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : permute
+!!
+!>\BRIEF         This subroutine initializes an array of size n by random integers between 1 and n.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::ordre
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE permute (n,ordre)
+!---------------------------------------------------------------------
+
+  !! 0. Variables and parameters declaration 
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN) :: n   !! size of the array
+
+  !! 0.2 Output variables 
+
+  INTEGER,DIMENSION(n),INTENT(OUT) :: ordre
+
+  !! 0.4 Local variables
+
+  INTEGER,DIMENSION(n) :: restant
+  INTEGER :: ipique, i, n_rest
+  REAL    :: rndnum
+
+!_ ================================================================================================================================
+
+  n_rest = n
+  restant(:) = (/ (i, i=1,n) /)
+!-
+  DO i=1,n
+    CALL random_number (rndnum)
+    ipique = INT(rndnum*n_rest)+1
+    ordre(i) = restant(ipique)
+    restant(ipique:n_rest-1) = restant(ipique+1:n_rest)
+    n_rest = n_rest-1
+  ENDDO
+!---------------------
+END SUBROUTINE permute
+!-
+!===
+!-----------------
+END MODULE weather
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/AA_make
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/AA_make	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/AA_make	(revision 6412)
@@ -0,0 +1,73 @@
+#-
+#- $Id$
+#-
+PARAM_LIB = $(LIBDIR)/libparameters.a
+SXPARAM_LIB = $(PARAM_LIB)
+#-Q- sxnec  SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- eshpux SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-
+MODS1 = grid.f90           \
+        solar.f90          \
+	interpol_help.f90  \
+	gauss_jordan_method.f90 \
+	interpweight.f90 
+
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libparallel
+	$(M_K) libparameters
+	$(M_K) m_all
+	@echo orglob is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+libparameters:
+	(cd ../src_parameters; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o) : %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+
+config : 
+	$(BINDIR)/Fparser -name ORGLOB $(MODS1)
+	echo 'Configuration of ORGLOB done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(grid.o): \
+  $(PARAM_LIB)(constantes.o)
+
+$(MODEL_LIB)(interpol_help.o): \
+  $(PARAM_LIB)(constantes.o)
+
+$(MODEL_LIB)(gauss_jordan_method.o): \
+  $(PARAM_LIB)(constantes.o)
+
+$(MODEL_LIB)(interpweight.o): \
+  $(PARAM_LIB)(constantes.o)
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/AA_make.ldef
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/AA_make.ldef	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/AA_make.ldef	(revision 6412)
@@ -0,0 +1,19 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a ORGLOB
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/liborglob.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxorglob.a
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/gauss_jordan_method.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/gauss_jordan_method.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/gauss_jordan_method.f90	(revision 6412)
@@ -0,0 +1,244 @@
+! =================================================================================================================================
+! MODULE       : matrix_resolution
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         This module solves a linear system using the Gauss-Jordan elimination method. It also calculates relative errors
+!! globally and for the passive pools.        
+!! 
+!!
+!!\n DESCRIPTION:  This module solves a linear system AX = B with the Gauss Jordan elimination method
+!!                 (chosen because the system has no particular properties). \n
+!!                 The code has originally picked up in Numerical recipes in Fortran 90. \n
+!!                 We simplified the code in our case because we solve a basic (7,7) matrix for each point and each pft
+!!                 (so we have npts*nvm*(7,7) systems to solve each time we call this routine). \n
+!!                 We also calculate relative for biomass and passive carbon pools in order to test the threshold error. \n
+!!
+!! RECENT CHANGE(S): Didier Solyga - add subroutine for calculating relative error for passive pool.
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision:  $
+!! \n
+!_ ================================================================================================================================
+
+MODULE matrix_resolution
+
+  ! modules used 
+
+  USE ioipsl ! for precision
+  USE constantes
+
+  IMPLICIT NONE
+
+  CONTAINS
+    
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gauss-jordan_method 
+!!
+!>\BRIEF          This subroutine resolves a linear system by the Gauss-Jordan method.
+!! (inversion of the system - complexity O(n^3)) .
+!!
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): vector_b contains the solution of the system.
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+    SUBROUTINE gauss_jordan_method(n,matrix_a,vector_b)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration    
+
+      !! 0.1 Input variables 
+ 
+      INTEGER(i_std), INTENT(in) :: n  !! size of the system (1-N, unitless)
+
+      !! 0.3 Modified variables
+
+      REAL(r_std), DIMENSION(n,n), INTENT(inout) :: matrix_a   !! Matrix A of the linear system A.X = B
+      REAL(r_std), DIMENSION(n), INTENT(inout)   :: vector_b   !! Vector B in the linear system A.X = B
+      
+      !! 0.4 Local Variables
+
+      INTEGER(i_std) :: i,col,row,j,k,ii,jj        !! index (unitless)
+      INTEGER(i_std), DIMENSION(n) :: index_pivot  !! vector containing the pivot index
+      INTEGER(i_std), DIMENSION(n) :: index_col    !! vector containing the columns index
+      INTEGER(i_std), DIMENSION(n) :: index_row    !! vector containing the rows index
+      REAL(r_std) :: pivot_max,inv_pivot,temp      !! temporary variables
+      
+!_ ================================================================================================================================
+      
+      !! Initialization
+      index_pivot(:) = 0
+      col = 0
+      row = 0
+      
+      !! Search the pivot (strategy of full pivoting)
+      !! We search the greatest pivot (in order to reduce errors)
+      DO i = 1,n     
+         pivot_max = 0.
+         DO  j = 1,n
+            IF(index_pivot(j) /= 1) THEN
+               DO k = 1,n
+                  IF(index_pivot(k) .EQ. 0) THEN
+                     IF(ABS(matrix_a(j,k)) .GE. pivot_max) THEN  
+                        pivot_max = ABS(matrix_a(j,k))           
+                        row = j
+                        col = k
+                     ENDIF
+                  ENDIF
+               ENDDO
+            ENDIF
+         ENDDO
+
+         IF (col .EQ. 0) THEN
+            CALL ipslerr (3,'gauss_jordan_method','Method failed.','','')
+         ENDIF
+
+         index_pivot(col)=index_pivot(col) + 1
+
+         !! We exchange the rows and the lines if needed
+         IF(row /= col) THEN
+            DO j = 1,n
+               temp = matrix_a(row,j)
+               matrix_a(row,j) = matrix_a(col,j)
+               matrix_a(col,j) = temp
+            ENDDO
+            temp = vector_b(row)
+            vector_b(row) = vector_b(col)
+            vector_b(col) = temp
+         ENDIF
+         index_row(i) = row
+         index_col(i) = col
+         IF(matrix_a(col,col) .EQ. 0.) STOP 'the matrix A is not inversible'
+         inv_pivot = 1./matrix_a(col,col)
+         DO j = 1,n
+            matrix_a(col,j) = matrix_a(col,j) * inv_pivot 
+         ENDDO
+         vector_b(col) = vector_b(col) * inv_pivot
+         DO ii = 1,n
+            IF(ii /= col) THEN
+               temp = matrix_a(ii,col)
+               matrix_a(ii,col) = 0.
+               DO jj = 1,n
+                  matrix_a(ii,jj) = matrix_a(ii,jj) - matrix_a(col,jj)*temp
+               ENDDO
+               vector_b(ii) = vector_b(ii) - vector_b(col)*temp
+            ENDIF
+         ENDDO
+      ENDDO
+      
+      DO j = n,1,-1
+         IF(index_row(j) /= index_col(j)) THEN
+            DO i = 1,n
+               temp = matrix_a(i,index_row(j))
+               matrix_a(i,index_row(j)) = matrix_a(i,index_col(j)) 
+               matrix_a(i,index_col(j)) = temp
+          ENDDO
+       ENDIF
+    ENDDO
+    
+    
+  END SUBROUTINE gauss_jordan_method
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : error_L1_passive
+!!
+!>\BRIEF          This subroutine calculates relative errors of a vector by taking the relative error for the passive pool.
+!!
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): flag is to true if the maximum relative error is less than a threshold chosen by the user.
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE error_L1_passive(npts,nb_veget, nb_pools, current_value, previous_value, veget_max, criterion, flag)
+  
+    IMPLICIT NONE
+
+    !! 0. Parameters and variables declaration
+    
+    !! 0.1 Input variables    
+    
+    INTEGER(i_std), INTENT(in) :: npts                                             !! Number of continental grid cells (unitless)
+    INTEGER(i_std), INTENT(in) :: nb_veget                                         !! Number of vegetation types (2-N, unitless)
+    INTEGER(i_std), INTENT(in) :: nb_pools                                         !! Number of carbon pools (unitless)
+    REAL(r_std), DIMENSION(npts,nb_veget,nb_pools), INTENT(in) :: current_value    !! Previous values of carbon pools obtained
+                                                                                   !! by matrix resolution (gC.m^{-2})
+    REAL(r_std), DIMENSION(npts,nb_veget,nb_pools), INTENT(in) :: previous_value   !! Current values of carbon pools  obtained
+                                                                                   !! by matrix resolution (gC.m^{-2})   
+    REAL(r_std), DIMENSION(npts,nb_veget), INTENT(in) :: veget_max                 !! Fraction of vegetation (0-1, uniless)
+    REAL(r_std), INTENT(in) :: criterion                                           !! Threshold for the relativ error (0-1, unitless) 
+    
+    !! 0.2 Output variables
+    
+    LOGICAL, DIMENSION(npts), INTENT(out) :: flag   !! Logical array used only inside this subroutine (true/false)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std) :: j                                      !! Index (unitless)
+    REAL(r_std), DIMENSION(npts) :: previous_passive_stock   !! Previous value of total passive carbon (gC) 
+    REAL(r_std), DIMENSION(npts) :: current_passive_stock    !! Current value of total passive carbon (gC)
+    REAL(r_std), DIMENSION(npts) :: error_global             !! Temporary arrays containing the relative error for each grid cell 
+                                                             !! (unitless)         
+    REAL(r_std), DIMENSION(npts) :: temp_diff                !! Working array storing difference values between previous_passive_stock
+                                                             !! and current_passive_stock (gC)
+
+!_ ================================================================================================================================
+
+    !! Initialize flag and error_global
+    flag(:) = .FALSE.
+    error_global(:) = zero
+
+    !! Calculation previous_passive_stock
+    previous_passive_stock(:) = zero
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool)*veget_max(:,j)
+    ENDDO
+
+    !! Calculation current_passive_stock
+    current_passive_stock(:) = zero
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool)*veget_max(:,j)
+    ENDDO
+    
+    !! We calculate for the error for the passive pool for each pixel
+    temp_diff(:) = zero
+    temp_diff(:) =  current_passive_stock(:) - previous_passive_stock(:) 
+    WHERE ( previous_passive_stock(:) >  min_stomate )
+       error_global(:) = 100.*ABS(temp_diff(:))/previous_passive_stock(:) 
+    ELSEWHERE
+       error_global(:) = ABS(temp_diff(:))
+    ENDWHERE
+
+    !! if the criterion is reached, we can mark the point 
+    WHERE (error_global(:) <= criterion)
+       flag = .TRUE.
+    ENDWHERE
+       
+  END SUBROUTINE error_L1_passive       
+
+
+END MODULE matrix_resolution
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/grid.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/grid.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/grid.f90	(revision 6412)
@@ -0,0 +1,1104 @@
+
+!! This module define variables for the grid to gathered points.
+!!
+!! @call sechiba_main
+!! @Version : $Revision$, $Date$
+!! 
+!< $HeadURL$
+!< $Date$
+!< $Revision$
+!!
+!! @author Marie-Alice Foujols, Jan Polcher and Martial Mancip
+!!
+!! This module archives and makes available for all ORCHIDEE routine the information on the grid
+!! being used. 3 types of grids are foreseen :
+!! - Regular longitude latitude grid : This is the default and mostly used for global applications.
+!! - Regular X/Y grid : this is a typical grid for regional models and requires a projection method
+!!                      to go from X/y to lon/lat.
+!! - unstructures grid : This is a general grid where each cell is a polygone. It prepares ORCHIDEE
+!!                       for DYNAMICO.
+!!
+!! The subroutines have the following role :
+!!  grid_init : this routine will provide the dimensions needed to allocate the memory and the
+!!              characteristics of the grid.
+!!
+!!  grid_stuff : This subroutine provides the grid details for all land points. Obviously depending
+!!               on the grid type different level of information need to be provided.
+!!
+!f90doc MODULEgrid
+MODULE grid
+
+  USE grid_var
+  USE defprec
+  USE constantes
+  USE mod_orchidee_para
+
+  USE haversine
+  USE module_llxy
+
+  USE ioipsl
+  USE netcdf
+
+  IMPLICIT NONE
+  !
+  !=================================================================================
+  !
+  ! Horizontal grid information
+  !
+  !=================================================================================
+
+  ! Global map or not.
+  ! There is little chance that if iim <=2 and jjm <= 2 that we have global grid.
+  ! Furthermore using the second line allows to avoid pole problems for global grids
+  LOGICAL, SAVE                                     :: global = .TRUE.
+!$OMP THREADPRIVATE(global)
+
+  ! PARAMETERS
+  ! default resolution (m)
+  REAL(r_std), PARAMETER :: default_resolution = 250000.
+  !
+  ! VARIABLES
+  !
+  !-
+  !- Variable to help describe the grid
+  !- once the points are gathered.
+  !-
+  !! Limits of the domain
+  REAL(r_std), SAVE                                   :: limit_west, limit_east, &
+       &                                                limit_north, limit_south
+!$OMP THREADPRIVATE(limit_west, limit_east, limit_north, limit_south)
+  !-
+  !! Geographical coordinates
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:), SAVE     :: lalo
+!$OMP THREADPRIVATE(lalo)
+  !! index  of land points
+  INTEGER, ALLOCATABLE, DIMENSION (:), SAVE           :: ilandindex,jlandindex
+!$OMP THREADPRIVATE(ilandindex, jlandindex)
+  !- 
+  !! Fraction of continents.
+  REAL(r_std), ALLOCATABLE, DIMENSION (:), SAVE       :: contfrac
+!$OMP THREADPRIVATE(contfrac)
+  !
+  ! indices of the NbNeighb neighbours of each grid point 
+  ! (1=Northern most vertex and then in clockwise order)
+  ! Zero or negative index means that this neighbour is not a land point
+  INTEGER(i_std), ALLOCATABLE, DIMENSION (:,:), SAVE  :: neighbours
+!$OMP THREADPRIVATE(neighbours)
+  !
+  ! Heading of the direction out of the grid box either through the vertex 
+  ! of the mid-segment of the polygon.
+  !
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:), SAVE      :: headings
+!$OMP THREADPRIVATE(headings)
+  !
+  ! Length of segments of the polygon.
+  !
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:), SAVE      :: seglength
+!$OMP THREADPRIVATE(seglength)
+  !
+  ! Area of the grid box
+  !
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE        :: area
+!$OMP THREADPRIVATE(area)
+  !
+  ! Coordinats of the vertices
+  !
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:), SAVE    :: corners
+!$OMP THREADPRIVATE(corners)
+  !
+  ! Resolution remains a temporary variable until the merge of the
+  ! re-interfacing of the interpolation by Lluis. One this is done
+  ! Resolution will be replaced in the model either by area or seglength.
+  !
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:), SAVE     :: resolution
+!$OMP THREADPRIVATE(resolution)
+  !
+  !
+  !
+  ! Get the direction of the grid
+  !
+  CHARACTER(LEN=2), DIMENSION(2), SAVE, PRIVATE      :: grid_dir
+!$OMP THREADPRIVATE(grid_dir)
+  !
+  INTEGER(i_std), PARAMETER :: MAX_DOMAINS=1
+  !
+  type (proj_info), SAVE, dimension(1:MAX_DOMAINS) :: proj_stack
+  !
+  real(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)   :: dxwrf, dywrf
+  !
+  !
+  !=================================================================================
+  !
+  ! Calendar information
+  !
+  !=================================================================================
+  !
+  ! The calendar
+  CHARACTER(LEN=20), SAVE               :: calendar_str
+!$OMP THREADPRIVATE(calendar_str)
+  !
+  ! The date
+  REAL(r_std), SAVE                     :: in_julian
+!$OMP THREADPRIVATE(in_julian)
+  ! Diff with day 0
+  REAL(r_std), SAVE                     :: julian_diff
+!$OMP THREADPRIVATE(julian_diff)
+  !
+  INTEGER(i_std), SAVE                  :: year, month, day
+!$OMP THREADPRIVATE(year, month, day)
+  REAL(r_std), SAVE                     :: sec
+!$OMP THREADPRIVATE(sec)
+  !
+  ! month_len (d)
+  INTEGER(i_std), SAVE                  :: month_len
+!$OMP THREADPRIVATE(month_len)
+  !
+  ! year length (d)
+  INTEGER(i_std), SAVE                  :: year_length=0
+!$OMP THREADPRIVATE(year_length)
+  !
+  ! Ration between calendar year in days (ie 360d or 365d ...) to gregorian year length 
+  REAL(r_std), SAVE :: year_spread
+!$OMP THREADPRIVATE(year_spread)
+  !
+  !
+  INTERFACE grid_tolola
+     MODULE PROCEDURE grid_tolola_scal, grid_tolola_1d, grid_tolola_2d
+  END INTERFACE grid_tolola
+
+  INTERFACE grid_toij
+     MODULE PROCEDURE grid_toij_scal, grid_toij_1d, grid_toij_2d
+  END INTERFACE grid_toij
+  !
+CONTAINS
+  !
+  !f90doc CONTAINS
+  ! 
+  !
+!!  =============================================================================================================================
+!! SUBROUTINE:    grid_init
+!!
+!>\BRIEF	  Initialization of grid description distributed by this module to the rest of the model.
+!!
+!! DESCRIPTION:	  Routine which provides the dimension of the grid (number of land points) as well as the 
+!!                grid characteristics (type and name) so that the memory can be allocated.
+!!
+!!                This subroutine is called by intersurf_main_2d or any driver of the model.
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE grid_init ( npts, nbseg, gtype, gname, isglobal )
+    !
+    ! 0 interface
+    !
+    IMPLICIT NONE
+    !
+    ! 0.1 input  !
+    !
+    ! Domain size
+    INTEGER(i_std), INTENT(in)                                 :: npts     !! Number of local continental points
+    INTEGER(i_std), INTENT(in)                                 :: nbseg    !! number of segments of the polygone of the mesh
+    CHARACTER(LEN=*), INTENT(in)                               :: gtype    !! Type of grid
+    CHARACTER(LEN=*), INTENT(in)                               :: gname    !! Name of the grid
+    LOGICAL, OPTIONAL                                          :: isglobal
+    !
+    !
+    !
+    CHARACTER(LEN=20)                                          :: gtype_lower
+    !
+    ! Verify the information passed and save it in the global variables of the model.
+    !
+    gtype_lower = gtype
+    CALL strlowercase(gtype_lower)
+
+    IF ( INDEX(gtype_lower, "reglonlat") > 0) THEN
+       IF ( nbseg /= 4 ) THEN
+          CALL ipslerr(3, "grid_init", "This regular Lon/lat grid should have 4 segments", &
+               &       "per horizontal grid box","")
+       ELSE
+          NbSegments=4
+       ENDIF
+       GridType="RegLonLat"
+       GridName=gridname
+       IF ( PRESENT(isglobal) ) THEN
+          global = isglobal
+       ELSE
+          global = .TRUE.
+       ENDIF
+    ELSE IF ( INDEX(gtype_lower, "regxy") > 0) THEN
+       IF ( nbseg /= 4 ) THEN
+          CALL ipslerr(3, "grid_init", "This regular X/Y grid should have 4 segments", &
+               &       "per horizontal grid box","")
+       ELSE
+          NbSegments=4
+       ENDIF
+       GridType="RegXY"
+       GridName=gridname
+       IF ( PRESENT(isglobal) ) THEN
+          global = isglobal
+       ELSE
+          global = .FALSE.
+       ENDIF
+    ELSE IF ( INDEX(gtype_lower, "unstruct") > 0) THEN
+       NbSegments=nbseg
+       GridType="UnStruct"
+       GridName=gridname
+       IF ( PRESENT(isglobal) ) THEN
+          global = isglobal
+       ELSE
+          global = .TRUE.
+       ENDIF
+    ELSE
+       CALL ipslerr(3, "grid_init", "unrecognized grid type.",&
+            &       "It has to be either reglatlon, regxy or unstruct","")
+    ENDIF
+    !
+    !  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.
+    !-
+    NbNeighb=2*NbSegments
+    IF ( (.NOT.ALLOCATED(neighbours))) THEN
+       ALLOCATE(neighbours(npts,NbNeighb))
+       neighbours(:,:) = -999999
+    ENDIF
+    IF ( (.NOT.ALLOCATED(headings))) THEN
+       ALLOCATE(headings(npts,NbNeighb))
+       headings(:,:) = val_exp
+    ENDIF
+    IF ( (.NOT.ALLOCATED(seglength))) THEN
+       ALLOCATE(seglength(npts,NbSegments))
+       seglength(:,:) = val_exp
+    ENDIF
+    IF ( (.NOT.ALLOCATED(corners))) THEN
+       ALLOCATE(corners(npts,NbSegments,2))
+       corners(:,:,:) = val_exp
+    ENDIF
+    IF ( (.NOT.ALLOCATED(area))) THEN
+       ALLOCATE(area(npts))
+       area(:) = val_exp
+    ENDIF
+    !
+    ! TEMPORARY
+    !
+    IF ( (.NOT.ALLOCATED(resolution))) THEN
+       ALLOCATE(resolution(npts,2))
+       resolution(:,:) = 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 ... 
+    ! JP : these are global fields and should perhaps be allocated somewhere else.
+    IF (.NOT. ALLOCATED(ilandindex)) THEN
+       ALLOCATE(ilandindex(nbp_glo),jlandindex(nbp_glo))
+       ilandindex(:) = -10000000
+       jlandindex(:) = -10000000
+    ENDIF
+    !
+  END SUBROUTINE grid_init
+!!
+!!
+!!  =============================================================================================================================
+!! FUNCTION grid_set
+!!
+!>\BRIEF	     subroutine to set global grid parameters present on all procs
+!!
+!! DESCRIPTION:	  
+!!                
+!!
+!!              
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE grid_set_glo(arg_nbp_lon,arg_nbp_lat,arg_nbp_glo)
+    IMPLICIT NONE
+
+    INTEGER(i_std), INTENT(IN) :: arg_nbp_lon
+    INTEGER(i_std), INTENT(IN) :: arg_nbp_lat
+    INTEGER(i_std), INTENT(IN),OPTIONAL :: arg_nbp_glo
+    iim_g=arg_nbp_lon
+    jjm_g=arg_nbp_lat
+    IF (PRESENT(arg_nbp_glo)) nbp_glo=arg_nbp_glo
+  END SUBROUTINE grid_set_glo
+!!  =============================================================================================================================
+!! FUNCTION grid_set/allocate_glo
+!!
+!>\BRIEF	 subroutines to allocate variables present on all procs
+!!
+!! DESCRIPTION:	  
+!!                
+!!
+!!              
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE grid_allocate_glo(nbseg)
+    !
+    IMPLICIT NONE
+    ! 0.1 input  !
+    !
+    ! Domain size
+    INTEGER(i_std), INTENT(in)                                 :: nbseg    !! number of segments of the polygone of the mesh
+    !
+    ! In case the allocation of the grid is called before the initialisation,
+    ! we already set the number of segments.
+    ! This will be done properly in grid_init.
+    !
+    IF ( NbSegments < 3 ) THEN
+       NbSegments = nbseg
+       NbNeighb=2*NbSegments
+    ENDIF
+    !
+    !
+    ALLOCATE(neighbours_g(nbp_glo,NbNeighb))
+    ALLOCATE(headings_g(nbp_glo,NbNeighb))
+    ALLOCATE(seglength_g(nbp_glo,NbSegments))
+    ALLOCATE(corners_g(nbp_glo,NbSegments,2))
+    ALLOCATE(area_g(nbp_glo))
+    !
+    ! TEMPORARY
+    !
+    ALLOCATE(resolution_g(nbp_glo,2))
+    !
+    ! Allocate other variables
+    !
+    ALLOCATE(lalo_g(nbp_glo,2), contfrac_g(nbp_glo),index_g(nbp_glo))
+    ALLOCATE(lon_g(iim_g, jjm_g), lat_g(iim_g, jjm_g), zlev_g(iim_g, jjm_g))
+    !
+  END SUBROUTINE grid_allocate_glo
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE:    grid_stuff
+!!
+!>\BRIEF	  transfers the global horizontal grid information to ORCHIDEE in the case of grid regular in Longitude
+!!                and Latitude.
+!!
+!! DESCRIPTION:	  
+!!                
+!!
+!!                This subroutine is called by intersurf_main_2d or any driver of the model.
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE grid_stuff (npts_glo, iim, jjm, grid_lon, grid_lat, kindex, contfrac_tmp)
+    !
+    ! 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(npts_glo), INTENT(in)            :: kindex
+    ! The fraction of continent in the grid box [0-1]
+    REAL(r_std), DIMENSION(npts_glo), OPTIONAL, INTENT(in)     :: contfrac_tmp
+    !
+    !
+    ! =========================================================================
+    
+    IF ( printlev >= 4 ) WRITE(numout,*) 'Entering grid_stuff'
+
+    ! default resolution
+    IF ( printlev >=2 ) WRITE(numout,*) 'grid stuff: default resolution (m): ',default_resolution
+    !
+    !-
+    IF (is_root_prc) THEN
+       !
+       CALL grid_topolylist(GridType, NbSegments, npts_glo, iim, jjm, grid_lon, grid_lat, kindex, &
+            &               global, corners_g, neighbours_g, headings_g, seglength_g, area_g, ilandindex, jlandindex)
+       !
+       IF (PRESENT(contfrac_tmp)) THEN
+          !
+          ! Transfer the contfrac into the array managed in this module. 
+          !
+          contfrac_g(:) = contfrac_tmp(:)
+       ENDIF
+       !
+    ENDIF
+    !
+    ! With this the description of the grid is complete and the information
+    ! can be scattered to all processors.
+    !
+    CALL grid_scatter()
+    !
+    IF ( printlev >= 3 ) WRITE(numout,*) 'Leaving grid_stuff'
+    
+  END SUBROUTINE grid_stuff
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE:    grid_topolylist
+!!
+!>\BRIEF	  This routine transforms a regular grid into a list of polygons which are defined by the following 
+!!                quantities :
+!!
+!!                corners : the n vertices of the polugon in longitude and latitude
+!!                neighbours : the neighbouring land grid box for each of the vertices and segments
+!!                headings : the direction in which the neighbour is
+!!                seglength : the lenght of each segment
+!!                area : the area of the polygon
+!!                ilindex, jlindex : provides the i,j coordinates of the mesh in the global grid.
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE grid_topolylist(gtype, nbseg, nland, iim, jjm, grid_lon, grid_lat, kindex, &
+       &                     globalg, corners_loc, neighbours_loc, headings_loc, seglength_loc, &
+       &                     area_loc, ilindex_loc, jlindex_loc)
+    !
+    ! 0 interface
+    !
+    IMPLICIT NONE
+    !
+    ! 0.1 input  !
+    ! Grid type
+    CHARACTER(LEN=20), INTENT(in)                        :: gtype
+    ! Number of segments for each polygon
+    INTEGER(i_std), INTENT(in)                           :: nbseg
+    ! Number of land points on the grid
+    INTEGER(i_std), INTENT(in)                           :: nland
+    ! 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(nland), INTENT(in)         :: kindex
+    !
+    ! 0.2 Output
+    !
+    LOGICAL, INTENT(out)                                  :: globalg
+    !
+    REAL(r_std), DIMENSION(nland,nbseg,2), INTENT(out)    :: corners_loc
+    INTEGER(i_std), DIMENSION(nland,nbseg*2), INTENT(out) :: neighbours_loc
+    REAL(r_std), DIMENSION(nland,nbseg*2), INTENT(out)    :: headings_loc
+    REAL(r_std), DIMENSION(nland,nbseg), INTENT(out)      :: seglength_loc
+    REAL(r_std), DIMENSION(nland), INTENT(out)            :: area_loc
+    INTEGER(i_std), DIMENSION(nland), INTENT(out)         :: ilindex_loc, jlindex_loc
+    !
+    ! 0.3 Local variables
+    !
+    INTEGER(i_std)                        :: i, is, iss
+    REAL(r_std), DIMENSION(nland,2)       :: center
+    REAL(r_std)                           :: maxdellon, mindellon, maxlon, minlon
+    REAL(r_std), DIMENSION(nland,nbseg*2) :: lonpoly, latpoly
+    !
+    IF ( INDEX(gtype,"RegLonLat") > 0 ) THEN
+       !
+       ! If we are in regular Lon Lat, then we test just the longitude and see if we span 0-360deg.
+       !
+       maxdellon=MAXVAL(ABS(grid_lon(1:iim-1,1)-grid_lon(2:iim,1)))
+       mindellon=MINVAL(ABS(grid_lon(1:iim-1,1)-grid_lon(2:iim,1)))
+       maxlon=MAXVAL(grid_lon(1:iim,1))
+       minlon=MINVAL(grid_lon(1:iim,1))
+       !
+       ! test if it could be a global grid on 0 -> 360
+       !
+       IF ( minlon > 0 .AND. maxlon > 180 ) THEN
+          IF ( (minlon - maxdellon/2.0 ) <= 0 .AND. (maxlon + maxdellon/2.0) >= 360) THEN
+             globalg = .TRUE.
+          ELSE
+             globalg = .FALSE.
+          ENDIF
+       !
+       ! Test if it could be a -180 to 180 grid
+       !
+       ELSE IF ( minlon < 0 .AND. maxlon > 0 ) THEN
+          IF ( (minlon - maxdellon/2.0 ) <= -180 .AND. (maxlon + maxdellon/2.0) >= 180) THEN
+             globalg = .TRUE.
+          ELSE
+             globalg = .FALSE.
+          ENDIF
+       !
+       ! If neither condition is met then it cannot be global.
+       !
+       ELSE
+          globalg = .FALSE.
+       ENDIF
+    ELSE IF ( gtype == "RegXY" ) THEN
+       !
+       ! The hypothesis is that if we are in RegXY then we are not global
+       !
+       globalg = .FALSE.
+    ELSE
+       STOP "Unknown grid"
+    ENDIF
+    !
+    ! 2.0 Transform the grid into a list of polygones while keeping the neighbour relations
+    !     between these polygones.
+    !
+    !     Each polygone starts with a vertex and alternates vertices and mid-points of segments.
+    !
+    IF (nland == 1) THEN
+       CALL haversine_singlepointploy(iim, jjm, grid_lon, grid_lat, nland, kindex, global, &
+     &                              nbseg, lonpoly, latpoly, center, &
+     &                              neighbours_loc, ilindex_loc, jlindex_loc)
+    ELSE IF ( INDEX(gtype, "RegLonLat") > 0 ) THEN
+       CALL haversine_reglatlontoploy(iim, jjm, grid_lon, grid_lat, nland, kindex, global, &
+     &                              nbseg, lonpoly, latpoly, center, &
+     &                              neighbours_loc, ilindex_loc, jlindex_loc)
+    ELSE IF ( INDEX(gtype, "RegXY") > 0 ) THEN
+       CALL haversine_regxytoploy(iim, jjm, grid_lon, grid_lat, nland, kindex, proj_stack, &
+     &                              nbseg, lonpoly, latpoly, center, &
+     &                              neighbours_loc, ilindex_loc, jlindex_loc)
+    ELSE
+       STOP "Unknown grid"
+    ENDIF
+    !
+    ! Save the longitude and latitudes nbseg corners (=vertices) of the polygones
+    !
+    DO i=1,nland
+       DO is=1,nbseg
+          iss=(is-1)*2+1
+          corners_loc(i,is,1) = lonpoly(i,iss)
+          corners_loc(i,is,2) = latpoly(i,iss)
+       ENDDO
+    ENDDO
+    !
+    ! Get the heading normal to the 4 segments and through the 4 corners.
+    ! 
+    CALL haversine_polyheadings(nland, nbseg, lonpoly, latpoly, center, headings_loc)
+    !
+    ! Order the points of the polygone in clockwise order Starting with the northern most
+    !
+    CALL haversine_polysort(nland, nbseg, lonpoly, latpoly, headings_loc, neighbours_loc)
+    !
+    ! Compute the segment length and area.
+    ! For the RegLonLat we have specific calculations for seglength and area.
+    ! For projected regular grids we use the great cicle assumption for the segments
+    ! but the projected area.
+    ! For unstructured grid we use the most general routines.
+    !
+    IF ( INDEX(gtype, "RegLonLat") > 0 ) THEN
+       CALL haversine_laloseglen(nland, nbseg, lonpoly, latpoly, seglength_loc)
+       CALL haversine_laloarea(nland, nbseg, seglength_loc, area_loc)
+    ELSE IF ( INDEX(gtype, "RegXY") > 0 ) THEN
+       CALL haversine_polyseglen(nland, nbseg, lonpoly, latpoly, seglength_loc)
+       CALL haversine_xyarea(nland, nbseg, ilindex_loc, jlindex_loc, dxwrf, dywrf, area_loc)
+    ELSE
+       CALL haversine_polyseglen(nland, nbseg, lonpoly, latpoly, seglength_loc)
+       CALL haversine_polyarea(nland, nbseg, lonpoly, latpoly, area_loc)
+    ENDIF
+    ! Compute the area
+
+    !
+  END SUBROUTINE grid_topolylist
+  !!
+!!
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE:    grid_scatter
+!!
+!>\BRIEF	  Scatter the grid information so that each processor knows the characteristics of the grid it works on.
+!!
+!! DESCRIPTION:	  
+!!                
+!!
+!!                The grid information has been computed for the entire grid on the root processor. Now we give each processor
+!!                the information of the piece of the grid it works on. This concerns the following variables describing the grid :
+!!                - area
+!!                - resolution
+!!                - neighbours
+!!                - contfrac    : fraction of continent
+!!
+!!                Should ilandindex and jlandindex not b initialized, we catch-up here. This field is the same on all processors.
+!!
+!!                TODO :
+!!                This code should get the grid describing fields as arguments and then writem into the *_g variables on
+!!                root_prc before scattering. This would allow to compute the grid characteristics in any subroutine
+!!                fore calling grid_scatter.
+!!
+!!      
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+!!
+  SUBROUTINE grid_scatter()
+    !
+    !
+    INTEGER(i_std)  :: i, ip, jp
+    !
+    IF ( MAXVAL(ilandindex) < 0 .AND. MAXVAL(jlandindex) < 0 ) THEN
+       DO i = 1, nbp_glo          
+          !
+          ! 1 find numbers of the latitude and longitude of each point
+          !
+          
+          ! index of latitude
+          jp = INT( (index_g(i)-1) /iim_g ) + 1
+          
+          ! index of longitude
+          ip = index_g(i) - ( jp-1 ) * iim_g
+          !
+          ! Save this information for usage in other modules.
+          !
+          ilandindex(i)=ip
+          jlandindex(i)=jp
+          !
+       ENDDO       
+    ENDIF
+    !
+    CALL scatter(neighbours_g, neighbours)
+    CALL scatter(contfrac_g, contfrac)
+    CALL scatter(headings_g, headings)
+    CALL scatter(seglength_g, seglength)
+    CALL scatter(corners_g, corners)
+    CALL scatter(area_g, area)
+    !
+    ! TEMPORARY section for resolution
+    !
+    IF ( is_root_prc) THEN
+       IF ( INDEX(GridType,"Reg") > 0 ) THEN
+          resolution_g(:,1) = (seglength_g(:,1)+seglength_g(:,3))/2.0
+          resolution_g(:,2) = (seglength_g(:,2)+seglength_g(:,4))/2.0
+       ELSE
+          CALL ipslerr(3, "grid_scatter", "unsupported grid type.",&
+               &       "As long as resolution has not been replaced,",&
+               &       "ORCHIDEE cannot run on anything other than regular grids.")
+       ENDIF
+    ENDIF
+    CALL scatter(resolution_g, resolution)
+    !
+    !
+    IF ( printlev >=4 ) THEN
+       WRITE(numout,*) 'grid_scatter  > seglength  = ', seglength(1,:)
+       WRITE(numout,*) 'grid_scatter  > neighbours  = ', neighbours(1,:)
+       WRITE(numout,*) 'grid_scatter  > contfrac  = ', contfrac(1)
+       WRITE(numout,*) 'grid_scatter  > area  = ', area(1)
+    ENDIF
+    !
+  END SUBROUTINE grid_scatter
+!!
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE:    grid_initproj
+!!
+!>\BRIEF	  Routine to initialise the projection
+!!
+!! DESCRIPTION:	  
+!!                
+!!
+!!                This subroutine is called by the routine whichs ets-up th grid on which ORCHIDEE is to run.
+!!                The aim is to set-upu the projection so that all the grid variables needed by ORCHIDEE can
+!!                be computed in grid_stuff_regxy
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+!!
+  SUBROUTINE grid_initproj (fid, iim, jjm)
+    !
+    !
+    ! 0 interface
+    !
+    IMPLICIT NONE
+    !
+    ! 0.1 input  !
+    !
+    ! Domain size
+    INTEGER(i_std), INTENT(in)                                  :: fid
+    INTEGER(i_std), INTENT(in)                                  :: iim, jjm
+    !
+    ! 0.2 Local variables
+    !
+    INTEGER(i_std)             :: current_proj, idom, iret, lonid, latid, numLons, numLats
+    INTEGER, DIMENSION(nf90_max_var_dims) :: dimIDs
+    REAL(r_std)                :: user_stand_lon, user_truelat1, user_truelat2, user_dxkm, user_dykm
+    REAL(r_std)                :: user_dlat, user_dlon, user_known_x, user_known_y, user_known_lat, user_known_lon
+    REAL(r_std), DIMENSION(16) :: corner_lons, corner_lats
+    !
+    INTEGER(i_std)             :: iv, i, j
+    CHARACTER(LEN=20)          :: varname
+    REAL(r_std)                :: dx, dy, dtx, dty, coslat
+    REAL(r_std), ALLOCATABLE, DIMENSION (:)    :: LON, LAT
+    REAL(r_std), ALLOCATABLE, DIMENSION (:,:)  :: mapfac_x, mapfac_y
+    !
+    !
+    ! Only one domain is possible for the moment
+    !
+    idom=1
+    CALL map_init(proj_stack(idom))
+    !
+    ! Does ORCHIDEE have the same Earth Radius as the map projection ?
+    !
+    IF ( ABS(R_Earth-EARTH_RADIUS_M) > 0.1 ) THEN
+       WRITE(*,*) "Earth Radius in WRF : ", EARTH_RADIUS_M
+       WRITE(*,*) "Earth Radius in ORCHIDEE : ", R_Earth
+       CALL ipslerr (3,'grid_initproj','The Earth radius is not the same in the projection module and ORCHIDEE',&
+            & " ", " ")
+    ENDIF
+    !
+    ! Get parameters of the projection from the netCDF file
+    !
+    iret = NF90_GET_ATT(fid, NF90_GLOBAL, "MAP_PROJ", current_proj)
+    !
+    iret = NF90_GET_ATT(fid, NF90_GLOBAL, "STAND_LON",  user_stand_lon)
+    iret = NF90_GET_ATT(fid, NF90_GLOBAL, "TRUELAT1", user_truelat1)
+    iret = NF90_GET_ATT(fid, NF90_GLOBAL, "TRUELAT2", user_truelat2)
+    !
+    iret = NF90_GET_ATT(fid, NF90_GLOBAL, "DX", user_dxkm)
+    iret = NF90_GET_ATT(fid, NF90_GLOBAL, "DY", user_dykm)
+    user_dlat = undef
+    user_dlon = undef
+    !
+    IF ( current_proj == PROJ_LATLON ) THEN
+       !
+       iret = NF90_inq_VARID(fid, "XLONG_M",lonid)
+       iret = NF90_INQUIRE_VARIABLE(fid, lonid, dimids = dimIDs)
+       iret = NF90_INQUIRE_DIMENSION(fid, dimIDs(1), len = numLons)
+       iret = NF90_INQUIRE_DIMENSION(fid, dimIDs(2), len = numLats)
+       ALLOCATE(LON(numLons))
+       iret = NF90_GET_VAR(fid, lonid, LON(:), start = (/ 1, 1, 1 /), count = (/ numLons, 1, 1 /))
+       
+       iret = NF90_inq_VARID(fid, "XLAT_M",latid)
+       ALLOCATE(LAT(numLats))
+       iret = NF90_GET_VAR(fid, latid, LAT(:), start = (/ 1, 1, 1 /), count = (/ 1, numLats, 1 /))
+       
+       user_dlon = (LON(numLons) - LON(1)) / (numLons - 1)
+       user_dlat = (LAT(numLats) - LAT(1)) / (numLats - 1)
+       
+       DEALLOCATE(LON,LAT)
+
+    ENDIF
+    ! Unable to know from where to get the information
+    user_known_x = 1
+    user_known_y = 1
+    !
+    iret = NF90_GET_ATT(fid, NF90_GLOBAL, "corner_lats", corner_lats)
+    iret = NF90_GET_ATT(fid, NF90_GLOBAL, "corner_lons", corner_lons)
+    user_known_lat = corner_lats(1)
+    user_known_lon = corner_lons(1)
+    !
+    ! Read mapfactor, land mask and orography
+    !
+    !
+    ! Allocation
+    !
+    ALLOCATE(mapfac_x(iim,jjm))
+    ALLOCATE(mapfac_y(iim,jjm))
+    ALLOCATE(dxwrf(iim,jjm))
+    ALLOCATE(dywrf(iim,jjm))
+    !
+    varname = "MAPFAC_MX"
+    iret = NF90_INQ_VARID (fid, varname, iv)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'WRFdomain_Read',"Could not find variable ", varname," ")
+    ELSE
+       iret = NF90_GET_VAR (fid,iv,mapfac_x)
+    ENDIF
+    varname = "MAPFAC_MY"
+    iret = NF90_INQ_VARID (fid, varname, iv)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'WRFdomain_Read',"Could not find variable ", varname," ")
+    ELSE
+       iret = NF90_GET_VAR (fid,iv,mapfac_y)
+    ENDIF
+    !
+    ! Initilize the projection
+    !
+    if (current_proj == PROJ_LATLON) then
+       call map_set(current_proj, proj_stack(idom), &
+            lat1=user_known_lat, &
+            lon1=user_known_lon, &
+            knowni=user_known_x, &
+            knownj=user_known_y, &
+            latinc=user_dlat, &
+            loninc=user_dlon, &
+            r_earth=R_Earth)
+       
+    else if (current_proj == PROJ_MERC) then
+       call map_set(current_proj, proj_stack(idom), &
+            truelat1=user_truelat1, &
+            lat1=user_known_lat, &
+            lon1=user_known_lon, &
+            knowni=user_known_x, &
+            knownj=user_known_y, &
+            dx=user_dxkm, &
+            r_earth=R_Earth)
+       
+    else if (current_proj == PROJ_CYL) then
+       call ipslerr(3,"grid_initproj",'Should not have PROJ_CYL as projection for',&
+            'source data in push_source_projection()', " ")
+       
+    else if (current_proj == PROJ_CASSINI) then
+       call ipslerr(3,"grid_initproj",'Should not have PROJ_CASSINI as projection for', &
+            'source data in push_source_projection()', " ")
+       
+    else if (current_proj == PROJ_LC) then
+       call map_set(current_proj, proj_stack(idom), &
+            truelat1=user_truelat1, &
+            truelat2=user_truelat2, &
+            stdlon=user_stand_lon, &
+            lat1=user_known_lat, &
+            lon1=user_known_lon, &
+            knowni=user_known_x, &
+            knownj=user_known_y, &
+            dx=user_dxkm, &
+            r_earth=R_Earth)
+       
+    else if (current_proj == PROJ_ALBERS_NAD83) then
+       call map_set(current_proj, proj_stack(idom), &
+            truelat1=user_truelat1, &
+            truelat2=user_truelat2, &
+            stdlon=user_stand_lon, &
+            lat1=user_known_lat, &
+            lon1=user_known_lon, &
+            knowni=user_known_x, &
+            knownj=user_known_y, &
+            dx=user_dxkm, &
+            r_earth=R_Earth)
+       
+    else if (current_proj == PROJ_PS) then
+       call map_set(current_proj, proj_stack(idom), &
+            truelat1=user_truelat1, &
+            stdlon=user_stand_lon, &
+            lat1=user_known_lat, &
+            lon1=user_known_lon, &
+            knowni=user_known_x, &
+            knownj=user_known_y, &
+            dx=user_dxkm, &
+            r_earth=R_Earth)
+       
+    else if (current_proj == PROJ_PS_WGS84) then
+       call map_set(current_proj, proj_stack(idom), &
+            truelat1=user_truelat1, &
+            stdlon=user_stand_lon, &
+            lat1=user_known_lat, &
+            lon1=user_known_lon, &
+            knowni=user_known_x, &
+            knownj=user_known_y, &
+            dx=user_dxkm, &
+            r_earth=R_Earth)
+       
+    else if (current_proj == PROJ_GAUSS) then
+       call map_set(current_proj, proj_stack(idom), &
+            lat1=user_known_lat, &
+            lon1=user_known_lon, &
+            nlat=nint(user_dlat), &
+            loninc=user_dlon, &
+            r_earth=R_Earth)
+       
+    else if (current_proj == PROJ_ROTLL) then
+       call ipslerr(3 ,"grid_initproj",'Should not have PROJ_ROTLL as projection for', &
+            'source data in push_source_projection() as not yet implemented', '')
+    end if
+    !
+    ! Transform the mapfactors into dx and dy to be used for the description of the polygons and
+    ! interpolations.
+    !
+    DO i=1,iim
+       DO j=1,jjm
+          !
+          IF (proj_stack(idom)%code /= PROJ_LATLON ) THEN
+             dx = proj_stack(idom)%dx
+             ! Some projections in WRF do not store dy, in that case dy=dx.
+             IF ( proj_stack(idom)%dy > 0 ) THEN
+                dy = proj_stack(idom)%dy
+             ELSE
+                dy = proj_stack(idom)%dx
+             ENDIF
+             dxwrf(i,j) = dx/mapfac_x(i,j)
+             dywrf(i,j) = dy/mapfac_y(i,j)
+          ELSE
+             !
+             ! The LatLon projection is also a special case as here it is not the dx and dy
+             ! which are stored in the projection file but the increments in Lon and Lat.
+             !
+             dtx = proj_stack(idom)%loninc
+             dty = proj_stack(idom)%latinc
+             coslat = COS(lat(j) * pi/180. )
+             dxwrf(i,j) = dtx * pi/180. * R_Earth * coslat
+             dywrf(i,j) = dty * pi/180. * R_Earth
+             !
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE grid_initproj
+!
+!
+!
+!=========================================================================================
+!
+  SUBROUTINE grid_tolola_scal (ri, rj, lon, lat)
+    !
+    !
+    ! Argument
+    REAL(r_std), INTENT(in)      :: ri, rj
+    REAL(r_std), INTENT(out)     :: lon, lat
+    !
+    !
+    IF ( proj_stack(1)%code < undef_int ) THEN
+       !
+       CALL ij_to_latlon(proj_stack(1), ri, rj, lat, lon)
+       !
+    ELSE
+       CALL ipslerr(3, "grid_tolola_scal", "Projection not initilized"," "," ")
+    ENDIF
+    !
+  END SUBROUTINE grid_tolola_scal
+!
+!=========================================================================================
+!
+  SUBROUTINE grid_tolola_1d (ri, rj, lon, lat)
+    !
+    !
+    ! Argument
+    REAL(r_std), INTENT(in), DIMENSION(:)      :: ri, rj
+    REAL(r_std), INTENT(out), DIMENSION(:)     :: lon, lat
+    !
+    ! Local
+    INTEGER                            :: i, imax
+    !
+    imax=SIZE(lon)
+    !
+    IF ( proj_stack(1)%code < undef_int ) THEN
+       DO i=1,imax
+          !
+          CALL ij_to_latlon(proj_stack(1), ri(i), rj(i), lat(i), lon(i))
+          !
+       ENDDO
+    ELSE
+       CALL ipslerr(3, "grid_tolola_1d", "Projection not initilized"," "," ")
+    ENDIF
+    !
+  END SUBROUTINE grid_tolola_1d
+!
+!=========================================================================================
+!
+  SUBROUTINE grid_tolola_2d (ri, rj, lon, lat)
+    !
+    !
+    ! Argument
+    REAL(r_std), INTENT(in), DIMENSION(:,:)      :: ri, rj
+    REAL(r_std), INTENT(out), DIMENSION(:,:)     :: lon, lat
+    !
+    ! Local
+    INTEGER                            :: i, imax, j, jmax
+    !
+    imax=SIZE(lon,DIM=1)
+    jmax=SIZE(lon,DIM=2)
+    !
+    IF ( proj_stack(1)%code < undef_int ) THEN
+       DO i=1,imax
+          DO j=1,jmax
+             !
+             CALL ij_to_latlon(proj_stack(1), ri(i,j), rj(i,j), lat(i,j), lon(i,j))
+             !
+          ENDDO
+       ENDDO
+    ELSE
+       CALL ipslerr(3, "grid_tolola_2d", "Projection not initilized"," "," ")
+    ENDIF
+    !
+  END SUBROUTINE grid_tolola_2d
+!
+!=========================================================================================
+!
+  SUBROUTINE grid_toij_scal (lon, lat, ri, rj)
+    !
+    !
+    ! Argument
+    REAL(r_std), INTENT(in)     :: lon, lat
+    REAL(r_std), INTENT(out)    :: ri, rj
+    !
+    !
+    IF ( proj_stack(1)%code < undef_int ) THEN
+       !
+       CALL latlon_to_ij(proj_stack(1), lat, lon, ri, rj)
+       !
+    ELSE
+       CALL ipslerr(3, "grid_toij_scal", "Projection not initilized"," "," ")
+    ENDIF
+    !
+  END SUBROUTINE grid_toij_scal
+!
+!=========================================================================================
+!
+  SUBROUTINE grid_toij_1d (lon, lat, ri, rj)
+    !
+    !
+    ! Argument
+    REAL(r_std), INTENT(in), DIMENSION(:)     :: lon, lat
+    REAL(r_std), INTENT(out), DIMENSION(:)    :: ri, rj
+    !
+    ! Local
+    INTEGER                            :: i, imax
+    !
+    imax=SIZE(lon)
+    !
+    IF ( proj_stack(1)%code < undef_int ) THEN
+       DO i=1,imax
+          !
+          CALL latlon_to_ij(proj_stack(1), lat(i), lon(i), ri(i), rj(i))
+          !
+       ENDDO
+    ELSE
+       CALL ipslerr(3, "grid_toij_1d", "Projection not initilized"," "," ")
+    ENDIF
+    !
+  END SUBROUTINE grid_toij_1d
+!
+!=========================================================================================
+!
+  SUBROUTINE grid_toij_2d (lon, lat, ri, rj)
+    !
+    !
+    ! Argument
+    REAL(r_std), INTENT(in), DIMENSION(:,:)     :: lon, lat
+    REAL(r_std), INTENT(out), DIMENSION(:,:)    :: ri, rj
+    !
+    ! Local
+    INTEGER                            :: i, imax, j, jmax
+    !
+    imax=SIZE(lon,DIM=1)
+    jmax=SIZE(lon,DIM=2)
+    !
+    IF ( proj_stack(1)%code < undef_int ) THEN
+       DO i=1,imax
+          DO j=1,jmax
+             !
+             CALL latlon_to_ij(proj_stack(1), lat(i,j), lon(i,j), ri(i,j), rj(i,j))
+             !
+          ENDDO
+       ENDDO
+    ELSE
+       CALL ipslerr(3, "grid_toij_2d", "Projection not initilized"," "," ")
+    ENDIF
+    !
+  END SUBROUTINE grid_toij_2d
+!
+!
+!=========================================================================================
+!
+!
+END MODULE grid
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/grid_var.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/grid_var.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/grid_var.f90	(revision 6412)
@@ -0,0 +1,49 @@
+! ===============================================================================================================================
+! MODULE       : grid_var
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF
+!!
+!! \n DESCRIPTION : This module define variables for the grid module. 
+!!                The module is already USE in module grid. Therefor no need to use it seperatly if use grid is already done.
+
+!!
+!! RECENT CHANGE(S): These variables were previously in grid module. They have been moved here to avoid dependency 
+!!                   problems when the variables are needed in the parallelization modules. 
+!!
+!!
+!! SVN
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/trunk/ORCHIDEE/src_global/grid_var.f90 $
+!! $Date: 2017-03-22 10:06:56 +0100 (Wed, 22 Mar 2017) $
+!! $Revision: 4179 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE grid_var
+
+  IMPLICIT NONE
+
+  !=================================================================================
+  !
+  ! Horizontal grid information
+  !
+  !=================================================================================
+
+  CHARACTER(LEN=20), SAVE                           :: GridType    !! Describes the grid it can be RegLonLat, RegXY or UnStruct
+!$OMP THREADPRIVATE(GridType)
+
+  CHARACTER(LEN=20), SAVE                           :: GridName    !! Name of the grid
+!$OMP THREADPRIVATE(GridName)
+
+  INTEGER, SAVE                                     :: NbSegments  !! Number of segments in 
+                                                                   !! the polygone defining the grid box
+!$OMP THREADPRIVATE(NbSegments)
+  
+  INTEGER, SAVE                                     :: NbNeighb    !! Number of neighbours
+!$OMP THREADPRIVATE(NbNeighb)
+  
+END MODULE grid_var
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/haversine.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/haversine.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/haversine.f90	(revision 6412)
@@ -0,0 +1,1017 @@
+!  ==============================================================================================================================\n
+!  MODULE 	: This module provides a few basic operations for convex polygons on the sphere and in longitude
+!                 latitude coordinates. These operations are based on the haversine equations for great circle arcs.
+!
+!                 Definition of polygons : the basic assumption is that they describe grid boxes and are thus 
+!                 provided with more points than strictly necessary. Each polygon starts at index 1 on a vertex and
+!                 alternates mid-points of segments and vertices. The mid-point of segments are kept as they are
+!                 useful elements for the operations on the grid boxes.
+!
+!                 The module provides the following subroutine and functions :
+!                 haversine_reglatlontoploy : Lists the polygons and all their attributes (centre point, 
+!                                             neighbouring grids, indices in i and j on the original grid) for 
+!                                             regular lon/lat grid.
+!                 haversine_regxytoploy : As above but for grid boxes on the sphere projected onto a regular
+!                                         X/Y grid.
+!                 haversine_singlepointpoly : Computes the polygone around a given point with a known area.
+!                 haversine_polyheadings : Compute the heading out of the polygon for each vertex and mid-point of
+!                                          segment.
+!                 haversine_polysort : Sort the polygons so that all points are in clockwise order.
+!                 haversine_polyseglen : Compute the length of all segments of the polygon using great circles.
+!                 haversine_polyseglen : Compute the length of all segments of the polygon on a regular lat lon grid.
+!                 haversine_clockwise : Get the indices which sort a polygon in a clockwise order starting from an
+!                                       initial vertex.
+!                 haversine_polyarea : Computes the area covered by a polygon on the sphere.
+!                 haversine_laloarea : Compute the area for a regular lat lon grid.
+!                 haversine_xyarea : Compute the area for the special case where the grid box size in x and y are already 
+!                                    given by the projection.
+!                 haversine_heading : Initial heading between start point and end point along a great circle.
+!                 haversine_distance : Compute the distance between 2 points along the great circle.
+!                 haversine_radialdis : Compute the coordinates found in a given heading and distance.
+!                 haversine_dtor : Degrees to radians
+!                 haversine_rtod : Radians to degrees
+!
+!  CONTACT      : jan.polcher@lmd.jussieu.fr
+!
+!  LICENCE      : IPSL (2016)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        
+!! 
+!! RECENT CHANGE(S): None 
+!! 
+!! REFERENCE(S) : None
+!! 
+!_ ================================================================================================================================
+MODULE haversine
+
+  USE defprec
+  USE constantes_var
+  USE module_llxy
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: haversine_reglatlontoploy, haversine_regxytoploy, haversine_singlepointploy, &
+       &    haversine_polyheadings, haversine_polysort, &
+       &    haversine_polyseglen, haversine_laloseglen, haversine_clockwise, haversine_polyarea, &
+       &    haversine_laloarea, haversine_xyarea
+
+CONTAINS
+!!  =============================================================================================================================
+!! SUBROUTINE: haversine_reglatlontoploy   
+!!
+!>\BRIEF       Lists the polygons and all their attributes (centre point, 
+!              neighbouring grids, indices in i and j on the original grid) for 
+!              regular lon/lat grid.
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE haversine_reglatlontoploy(iim, jjm, lon, lat, nbpt, index_loc, global, &
+       &                              nbseg, lonpoly, latpoly, center, neighb_loc, iorig, jorig)
+    !
+    ! This subroutine constructs a series of polygons out of the grid boxes which are listed
+    ! in the index_loc array. The polygons are ordered according to the indexing space and independently
+    ! of the geographical coordinates.
+    !
+    ! 0 interface
+    !
+    IMPLICIT NONE
+    !
+    ! 0.1 input  !
+    ! Size of cartesian grid
+    INTEGER(i_std), INTENT(in)                                 :: iim, jjm
+    ! Longitudes on cartesian grid
+    REAL(r_std), DIMENSION(iim,jjm), INTENT(in)                :: lon
+    ! Latitudes on cartesian grid
+    REAL(r_std), DIMENSION(iim,jjm), INTENT(in)                :: lat
+    ! Size of the gathered domain
+    INTEGER(i_std), INTENT(in)                                 :: nbpt
+    ! Index of land point on 2D map (in local position)
+    INTEGER(i_std), DIMENSION(nbpt), INTENT(in)                :: index_loc
+    ! Is it a global grid ?
+    LOGICAL, INTENT(in)                                        :: global
+    ! Number of segments
+    INTEGER(i_std), INTENT(in)                                 :: nbseg
+    !
+    ! 0.2 Ouput
+    !
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(out)          :: lonpoly
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(out)          :: latpoly
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(out)                :: center
+    INTEGER(i_std), DIMENSION(nbpt,nbseg*2), INTENT(out)       :: neighb_loc
+    INTEGER(i_std), DIMENSION(nbpt), INTENT(out)               :: iorig, jorig
+    !
+    !
+    ! 0.3 Local variables
+    !
+    INTEGER(i_std), DIMENSION(iim,jjm) :: correspondance
+    INTEGER(i_std)                     :: i, ip, jp
+    INTEGER(i_std)                     :: ipm1, ipp1, jpm1, jpp1
+    REAL(r_std)                        :: dlonm1, dlonp1, dlatm1, dlatp1
+    !
+    !
+    correspondance(:,:) = -1
+    DO i = 1, nbpt      
+       !
+       ! 1 find numbers of the latitude and longitude of each point
+       !
+       ! index of latitude
+       jp = INT( (index_loc(i)-1) /iim ) + 1
+       ! index of longitude
+       ip = index_loc(i) - ( jp-1 ) * iim
+       !
+       !correspondance(ip,jp) = kindex(i)
+       !
+       correspondance(ip,jp) = i
+       iorig(i)=ip
+       jorig(i)=jp
+       !
+    ENDDO
+    !
+    !
+    ! Go through all the points and build the polygone which defines the grid area.
+    ! This polygone will include the mid-point of each segment so that 
+    ! we can later compute the direction of the normal to the segment.
+    !
+    neighb_loc(:,:) = -1
+    !
+    DO i = 1, nbpt
+       !
+       ip = iorig(i)
+       jp = jorig(i)
+       !
+       ipm1 = ip-1
+       ipp1 = ip+1
+       jpm1 = jp-1
+       jpp1 = jp+1
+       !
+       ! Compute the longitude increments
+       !
+       IF ( ipp1 <= iim ) THEN
+          dlonp1 = (lon(ipp1,jp)-lon(ip,jp))/2.0
+       ELSE IF ( ipm1 > 0 ) THEN
+          dlonp1 = (lon(ip,jp)-lon(ipm1,jp))/2.0
+          IF ( global ) ipp1=1
+       ELSE
+          dlonp1 = undef_sechiba
+       ENDIF
+       IF ( ipm1 > 0 ) THEN
+          dlonm1 = (lon(ip,jp)-lon(ipm1,jp))/2.0
+       ELSE IF ( ipp1 <= iim ) THEN
+          dlonm1 = (lon(ipp1,jp)-lon(ip,jp))/2.0
+          IF ( global ) ipm1=iim
+       ELSE
+          dlonm1 = undef_sechiba
+       ENDIF
+       !
+       ! Verify that we have at least one valid longitude increment. Else we do not have enough
+       ! points in the grid to estimate the position of the vertices in longitude.
+       !
+       IF ( dlonp1 >= undef_sechiba-1 ) dlonp1 = dlonm1
+       IF ( dlonm1 >= undef_sechiba-1 ) dlonm1 = dlonp1
+       IF ( dlonp1 >= undef_sechiba-1 .AND. dlonm1 >= undef_sechiba-1 ) THEN
+          CALL ipslerr(3, "haversine_reglatlontoploy", "There are not enogh point in longitude", &
+               &       "to estimate the bounds of the polygone of the grid box.",&
+               &       "Please choose a larger grid.")
+       ENDIF
+       !
+       ! Compute the latitude increments
+       !
+       IF ( jpp1 <= jjm ) THEN
+          dlatp1 = (lat(ip,jpp1)-lat(ip,jp))/2.0
+       ELSE IF ( jpm1 > 0 ) THEN
+          dlatp1 = (lat(ip,jp)-lat(ip,jpm1))/2.0
+       ELSE
+          dlatp1 = undef_sechiba
+       ENDIF
+       IF ( jpm1 > 0 ) THEN
+          dlatm1 = (lat(ip,jp)-lat(ip,jpm1))/2.0
+       ELSE IF ( jpp1 <= jjm ) THEN
+          dlatm1 = (lat(ip,jpp1)-lat(ip,jp))/2.0
+       ELSE
+          dlatm1 = undef_sechiba
+       ENDIF
+       !
+       ! Verify that we have at least one valid latitude increment. Else we do not have enough
+       ! points in the grid to estimate the position of the vertices in latitude.
+       !
+       IF ( dlatp1 >= undef_sechiba-1 ) dlatp1 = dlatm1
+       IF ( dlatm1 >= undef_sechiba-1 ) dlatm1 = dlatp1
+       IF ( dlatp1 >= undef_sechiba-1 .AND. dlatm1 >= undef_sechiba-1 ) THEN
+          CALL ipslerr(3, "haversine_reglatlontoploy", "There are not enogh point in latitude", &
+               &       "to estimate the bounds of the polygone of the grid box.",&
+               &       "Please choose a larger grid.")
+       ENDIF
+       !
+       ! The longitude of all elements of the polygone
+       !
+       lonpoly(i,1) = lon(ip,jp)-dlonm1
+       lonpoly(i,2) = lon(ip,jp)
+       lonpoly(i,3) = lon(ip,jp)+dlonp1
+       lonpoly(i,4) = lon(ip,jp)+dlonp1
+       lonpoly(i,5) = lon(ip,jp)+dlonp1
+       lonpoly(i,6) = lon(ip,jp)
+       lonpoly(i,7) = lon(ip,jp)-dlonm1
+       lonpoly(i,8) = lon(ip,jp)-dlonm1
+       !
+       ! The longitude of all elements of the polygone
+       !
+       latpoly(i,1) = lat(ip,jp)-dlatp1
+       latpoly(i,2) = lat(ip,jp)-dlatp1
+       latpoly(i,3) = lat(ip,jp)-dlatp1
+       latpoly(i,4) = lat(ip,jp)
+       latpoly(i,5) = lat(ip,jp)+dlatm1
+       latpoly(i,6) = lat(ip,jp)+dlatm1
+       latpoly(i,7) = lat(ip,jp)+dlatm1
+       latpoly(i,8) = lat(ip,jp)
+       !
+       ! Keep the center of the gridbox
+       !
+       center(i,1) = lon(ip,jp)
+       center(i,2) = lat(ip,jp)
+       !
+       ! Get the neighbours when they exist in the list of land points
+       ! There are no neighbours over the North or South poles.
+       !
+       IF ( ipm1 > 0 .AND. jpm1 > 0 ) neighb_loc(i,1) = correspondance(ipm1,jpm1)
+       IF ( jpm1 > 0 ) neighb_loc(i,2) = correspondance(ip,jpm1)
+       IF ( ipp1 <= iim .AND. jpm1 > 0 ) neighb_loc(i,3) = correspondance(ipp1,jpm1)
+       IF ( ipp1 <= iim ) neighb_loc(i,4) = correspondance(ipp1,jp)
+       IF ( ipp1 <= iim .AND. jpp1 <= jjm ) neighb_loc(i,5) = correspondance(ipp1,jpp1)
+       IF ( jpp1 <= jjm ) neighb_loc(i,6) = correspondance(ip,jpp1)
+       IF ( ipm1 > 0 .AND. jpp1 <= jjm ) neighb_loc(i,7) = correspondance(ipm1,jpp1)
+       IF ( ipm1 > 0 ) neighb_loc(i,8) = correspondance(ipm1,jp)
+       !
+    ENDDO
+    !
+  END SUBROUTINE haversine_reglatlontoploy
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: haversine_regxytoploy    
+!!
+!>\BRIEF       Same as haversine_reglatlontoploy but for grid boxes on the sphere projected onto a regular
+!              X/Y grid.
+!!
+!! DESCRIPTION: Keep in mind that in these projections the straight line assumed between 2 points is not always
+!!              the great circle. Thus the distance computed by the haversine formula might deviate a little.
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE haversine_regxytoploy(iim, jjm, lon, lat, nbpt, index_loc, proj, &
+       &                              nbseg, lonpoly, latpoly, center, neighb_loc, iorig, jorig)
+    !
+    ! This subroutine constructs a series of polygons out of the grid boxes which are listed
+    ! in the index array. This version will go directly from the indexing space to the coordinate as we know that 
+    ! we are dealing with a projection of the sphere to the plane where the regular grid is created.
+    ! The polygons are ordered according to the indexing space and independently
+    ! of the geographical coordinates.
+    !
+    ! 0 interface
+    !
+    IMPLICIT NONE
+    !
+    ! 0.1 input  !
+    ! Size of cartesian grid
+    INTEGER(i_std), INTENT(in)                                 :: iim, jjm
+    ! Longitudes on cartesian grid
+    REAL(r_std), DIMENSION(iim,jjm), INTENT(in)                :: lon
+    ! Latitudes on cartesian grid
+    REAL(r_std), DIMENSION(iim,jjm), INTENT(in)                :: lat
+    ! Size of the gathered domain
+    INTEGER(i_std), INTENT(in)                                 :: nbpt
+    ! Index of land point on 2D map (in local position)
+    INTEGER(i_std), DIMENSION(nbpt), INTENT(in)                :: index_loc
+    ! Projection ID
+    type (proj_info), DIMENSION(1)                             :: proj
+    ! Number of segments
+    INTEGER(i_std), INTENT(in)                                 :: nbseg
+    !
+    ! 0.2 Ouput
+    !
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(out)          :: lonpoly
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(out)          :: latpoly
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(out)                :: center
+    INTEGER(i_std), DIMENSION(nbpt,nbseg*2), INTENT(out)       :: neighb_loc
+    INTEGER(i_std), DIMENSION(nbpt), INTENT(out)               :: iorig, jorig
+    !
+    !
+    ! 0.3 Local variables
+    !
+    INTEGER(i_std), DIMENSION(iim,jjm) :: correspondance
+    INTEGER(i_std)                     :: i, ip, jp
+    INTEGER(i_std)                     :: ipm1, ipp1, jpm1, jpp1
+    REAL(r_std)                        :: dlonm1, dlonp1, dlatm1, dlatp1
+    !
+    !
+    !
+    correspondance(:,:) = -1
+    DO i = 1, nbpt      
+       !
+       ! 1 find numbers of the latitude and longitude of each point
+       !
+       ! index of latitude
+       jp = INT( (index_loc(i)-1) /iim ) + 1
+       ! index of longitude
+       ip = index_loc(i) - ( jp-1 ) * iim
+       !
+       !correspondance(ip,jp) = kindex(i)
+       !
+       correspondance(ip,jp) = i
+       iorig(i)=ip
+       jorig(i)=jp
+       !
+    ENDDO
+    !
+    ! Go through all the points and build the polygone which defines the grid area.
+    ! This polygone will include the mid-point of each segment so that 
+    ! we can later compute the direction of the normal to the segment.
+    !
+    neighb_loc(:,:) = -1
+    !
+    DO i = 1, nbpt
+       ! index of latitude
+       jp = INT( (index_loc(i)-1) /iim ) + 1
+       ! index of longitude
+       ip = index_loc(i) - ( jp-1 ) * iim
+       !
+       ipm1 = ip-1
+       ipp1 = ip+1
+       jpm1 = jp-1
+       jpp1 = jp+1
+       !
+       ! Get the longitude and latitude throug the projection
+       ! The range of possible values for projection depends on the module
+       ! which defines these projections. For module_llxy the range is 0-203.
+       !
+       IF ( proj(1)%code > 0 .AND. proj(1)%code < 203 ) THEN
+          CALL ij_to_latlon(proj(1), ip-0.5, jp-0.5, latpoly(i,1), lonpoly(i,1))
+          CALL ij_to_latlon(proj(1), ip+0.0, jp-0.5, latpoly(i,2), lonpoly(i,2))
+          CALL ij_to_latlon(proj(1), ip+0.5, jp-0.5, latpoly(i,3), lonpoly(i,3))
+          CALL ij_to_latlon(proj(1), ip+0.5, jp+0.0, latpoly(i,4), lonpoly(i,4))
+          CALL ij_to_latlon(proj(1), ip+0.5, jp+0.5, latpoly(i,5), lonpoly(i,5))
+          CALL ij_to_latlon(proj(1), ip+0.0, jp+0.5, latpoly(i,6), lonpoly(i,6))
+          CALL ij_to_latlon(proj(1), ip-0.5, jp+0.5, latpoly(i,7), lonpoly(i,7))
+          CALL ij_to_latlon(proj(1), ip-0.5, jp+0.0, latpoly(i,8), lonpoly(i,8))
+       ELSE
+          CALL ipslerr(3, "haversine_regxytoploy", "Unknown projection code", &
+               &       "Check proj(1)%code","")
+       ENDIF
+       !
+       ! Keep the center of the gridbox
+       !
+       center(i,1) = lon(ip,jp)
+       center(i,2) = lat(ip,jp)
+       !
+       ! Get the neighbours when they exist in the list of land points
+       ! There are no neighbours over the North or South poles.
+       !
+       IF ( ipm1 > 0 .AND. jpm1 > 0 ) neighb_loc(i,1) = correspondance(ipm1,jpm1)
+       IF ( jpm1 > 0 ) neighb_loc(i,2) = correspondance(ip,jpm1)
+       IF ( ipp1 <= iim .AND. jpm1 > 0 ) neighb_loc(i,3) = correspondance(ipp1,jpm1)
+       IF ( ipp1 <= iim ) neighb_loc(i,4) = correspondance(ipp1,jp)
+       IF ( ipp1 <= iim .AND. jpp1 <= jjm ) neighb_loc(i,5) = correspondance(ipp1,jpp1)
+       IF ( jpp1 <= jjm ) neighb_loc(i,6) = correspondance(ip,jpp1)
+       IF ( ipm1 > 0 .AND. jpp1 <= jjm ) neighb_loc(i,7) = correspondance(ipm1,jpp1)
+       IF ( ipm1 > 0 ) neighb_loc(i,8) = correspondance(ipm1,jp)
+       !
+    ENDDO
+    !
+  END SUBROUTINE haversine_regxytoploy
+!!  =============================================================================================================================
+!! SUBROUTINE: haversine_singlepointploy
+!!
+!>\BRIEF       Lists the polygons and all their attributes (centre point, 
+!              neighbouring grids, indices in i and j on the original grid) for 
+!              a single point. A regular lon/lat grid is assumed.
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE haversine_singlepointploy(iim, jjm, lon, lat, nbpt, index_loc, global, &
+       &                              nbseg, lonpoly, latpoly, center, neighb_loc, iorig, jorig)
+    !
+    ! This subroutine constructs a series of polygons out of the grid boxe which is provided.
+    ! The polygon is ordered according to the indexing space and independently
+    ! of the geographical coordinates.
+    ! It uses the same interface as haversine_reglatlontoploy but can only used with iim=jjm=1
+    !
+    ! 0 interface
+    !
+    IMPLICIT NONE
+    !
+    ! 0.1 input  !
+    ! Size of cartesian grid
+    INTEGER(i_std), INTENT(in)                                 :: iim, jjm
+    ! Longitudes on cartesian grid
+    REAL(r_std), DIMENSION(iim,jjm), INTENT(in)                :: lon
+    ! Latitudes on cartesian grid
+    REAL(r_std), DIMENSION(iim,jjm), INTENT(in)                :: lat
+    ! Size of the gathered domain
+    INTEGER(i_std), INTENT(in)                                 :: nbpt
+    ! Index of land point on 2D map (in local position)
+    INTEGER(i_std), DIMENSION(nbpt), INTENT(in)                :: index_loc
+    ! Is it a global grid ?
+    LOGICAL, INTENT(in)                                        :: global
+    ! Number of segments
+    INTEGER(i_std), INTENT(in)                                 :: nbseg
+    !
+    ! 0.2 Ouput
+    !
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(out)          :: lonpoly
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(out)          :: latpoly
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(out)                :: center
+    INTEGER(i_std), DIMENSION(nbpt,nbseg*2), INTENT(out)       :: neighb_loc
+    INTEGER(i_std), DIMENSION(nbpt), INTENT(out)               :: iorig, jorig
+    !
+    !
+    ! 0.3 Local variables
+    !
+    REAL(r_std)                        :: area, rlon, rlat
+    REAL(r_std), DIMENSION(2)          :: coord
+    !
+    IF ( iim .NE. 1 .AND. jjm .NE. 1 ) THEN
+       CALL ipslerr(3, "haversine_singlepointploy", "Can only be used if iim=jjm=1", &
+            &       "Please ensure this routine is called in the","right conditions")
+    ENDIF
+    !
+    iorig(1)=1
+    jorig(1)=1
+    !
+    area = 111111.0*111111.0
+    rlon= SQRT(area)/2.0
+    rlat=rlon
+    WRITE(*,*) "Area : ", area/1.0e6
+    !
+    ! Set all the variables defining the polygone of the specified area
+    !
+    neighb_loc(:,:) = -1
+    !
+    ! Northern point
+    coord = haversine_radialdis(lon(1,1), lat(1,1), 0.0, rlon)
+    lonpoly(1,2) = coord(1)
+    latpoly(1,2) = coord(2)
+    ! Eastern point
+    coord = haversine_radialdis(lon(1,1), lat(1,1), 90.0, rlon)
+    lonpoly(1,4) = coord(1)
+    latpoly(1,4) = coord(2)
+    ! Souther point
+    coord = haversine_radialdis(lon(1,1), lat(1,1), 180.0, rlon)
+    lonpoly(1,6) = coord(1)
+    latpoly(1,6) = coord(2)
+    ! Souther point
+    coord = haversine_radialdis(lon(1,1), lat(1,1), 270.0, rlon)
+    lonpoly(1,8) = coord(1)
+    latpoly(1,8) = coord(2)
+    !
+    ! Doing the corners
+    !
+    ! North West
+    lonpoly(1,1) = lonpoly(1,8)
+    latpoly(1,1) = latpoly(1,2)
+    ! North East
+    lonpoly(1,3) = lonpoly(1,4)
+    latpoly(1,3) = latpoly(1,2)
+    ! South East
+    lonpoly(1,5) = lonpoly(1,4)
+    latpoly(1,5) = latpoly(1,6)
+    ! South West
+    lonpoly(1,7) = lonpoly(1,8)
+    latpoly(1,7) = latpoly(1,6)
+    !
+    center(1,1) = lon(1,1)
+    center(1,2) = lat(1,1)
+    !
+  END SUBROUTINE haversine_singlepointploy
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: haversine_polyheadings   
+!!
+!>\BRIEF       Compute the heading out of the polygon for each vertex and mid-point of
+!              segment.
+!!
+!! DESCRIPTION: This heading is computed by using the great circle between the centre of the polygon and
+!!              the point on the boundary considered. The direction is the one facing outwards from the polygon.
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+!!
+  SUBROUTINE haversine_polyheadings(nbpt, nbseg, lonpoly, latpoly, center, headings)
+    !
+    ! 0.1 Input variables 
+    ! Size of the gathered domain
+    INTEGER(i_std), INTENT(in)                                 :: nbpt
+    ! Number of segments
+    INTEGER(i_std), INTENT(in)                                 :: nbseg
+    !
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(in)           :: lonpoly
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(in)           :: latpoly
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in)                 :: center
+    !
+    ! 0.2 Output variables
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(out)          :: headings
+    !
+    ! 0.3 Local variables
+    !
+    INTEGER(i_std) :: i, ns
+    !
+    ! We compute for each vertex of our polygon (actual vertices and mid-points) the direction to the
+    ! centre. The we add 180. to get the opposite direction.
+    !
+    DO i=1,nbpt
+       DO ns=1,nbseg*2
+          headings(i,ns) = MOD(haversine_heading(lonpoly(i,ns), latpoly(i,ns), center(i,1), center(i,2))+180.0, 360.0)
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE haversine_polyheadings
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: haversine_polysort     
+!!
+!>\BRIEF Sort the polygons so that all points are in clockwise order.	  
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE haversine_polysort(nbpt, nbseg, lonpoly, latpoly, headings, neighb)
+    !
+    ! This subroutine is foreseen for polygones which start with a vertex and then alternate
+    ! with mid-points of the segments. The heading at a vertex is the direction (along the 
+    ! great circle) between the center of the polygone and this vertex. At a segment mid-point
+    ! the direction is the normal facing outward.
+    !
+    ! 0.1 Input Variables
+    ! Size of the gathered domain
+    INTEGER(i_std), INTENT(in)                                 :: nbpt
+    ! Number of segments
+    INTEGER(i_std), INTENT(in)                                 :: nbseg
+    !
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(inout)        :: lonpoly
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(inout)        :: latpoly
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(inout)        :: headings
+    INTEGER(i_std), DIMENSION(nbpt,nbseg*2), INTENT(inout)     :: neighb
+    !
+    ! 0.2 Local variables
+    !
+    INTEGER(i_std) :: i, ic, startindex
+    INTEGER(i_std), DIMENSION(nbseg*2)     :: reindex
+    REAL(r_std)                            :: starthead
+    REAL(r_std), DIMENSION(nbseg*2)        :: lon_loc
+    REAL(r_std), DIMENSION(nbseg*2)        :: lat_loc
+    REAL(r_std), DIMENSION(nbseg*2)        :: head_loc
+    REAL(r_std), DIMENSION(nbseg*2)        :: negb_loc
+    !
+    DO i=1,nbpt
+       head_loc(:) = headings(i,:)
+       lon_loc(:) = lonpoly(i,:)
+       lat_loc(:) = latpoly(i,:)
+       negb_loc(:) = neighb(i,:)
+       !
+       ! The first vertice of our polygone needs to be the heading closest to 
+       ! North (0 degree). No difference is done between vertices and mid-points
+       ! of segments.
+       !
+       starthead=0.0
+       !
+       CALL haversine_clockwise(nbseg, head_loc, starthead, reindex)
+       !
+       !
+       headings(i,:) = head_loc(reindex(:))
+       lonpoly(i,:) = lon_loc(reindex(:))
+       latpoly(i,:) = lat_loc(reindex(:))
+       neighb(i,:) = negb_loc(reindex(:))
+       !
+    ENDDO
+    !
+  END SUBROUTINE haversine_polysort
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: haversine_polyseglen   
+!!
+!>\BRIEF       Compute the length of all segments of the polygon using the great circle.
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE haversine_polyseglen(nbpt, nbseg, lonpoly, latpoly, seglength)
+    !
+    ! Computes the segment length for each of the polygones. These are
+    ! polygones with middle points given for each segment. This we need
+    ! to take only every other point.
+    !
+    !
+    ! 0.1 Input Variables
+    ! Size of the gathered domain
+    INTEGER(i_std), INTENT(in)                                 :: nbpt
+    ! Number of segments
+    INTEGER(i_std), INTENT(in)                                 :: nbseg
+    !
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(in)           :: lonpoly
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(in)           :: latpoly
+    REAL(r_std), DIMENSION(nbpt,nbseg), INTENT(out)            :: seglength
+    !
+    ! 0.2 Local variables
+    !
+    INTEGER(i_std) :: i, iv, istart, iend, iseg, ioff
+    REAL(r_std)    :: slpm1, slpp1
+    !
+    DO i=1,nbpt
+       iseg = 0
+       !
+       ! Find if the first element is a vertex or mid-point of segment.
+       ! Get the 2 headings out of the start point. If these headings are larger than 135 degrees
+       ! then probably this point is a segment mid-point.
+       !
+       slpm1 = haversine_heading(lonpoly(i,1), latpoly(i,1), lonpoly(i,nbseg*2), latpoly(i,nbseg*2))
+       slpp1 = haversine_heading(lonpoly(i,1), latpoly(i,1), lonpoly(i,2), latpoly(i,2))
+       !
+       IF ( ABS(MOD(slpp1-slpm1, 360.0)) > 135.0 ) THEN
+          ! The polygon starts with a segment mid-point
+          ioff = -1
+       ELSE
+          ioff = 0
+       ENDIF
+       !
+       DO iv=1,nbseg*2,2
+          !
+          istart=MODULO((iv-1)+ioff,nbseg*2)+1
+          iend=MODULO((iv-1)+ioff+2,nbseg*2)+1
+          iseg = iseg + 1
+          !
+          seglength(i,iseg) = haversine_distance(lonpoly(i,istart), latpoly(i,istart), &
+               &                                 lonpoly(i,iend), latpoly(i,iend))
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE haversine_polyseglen
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: haversine_laloseglen   
+!!
+!>\BRIEF       Compute the length of all segments of the polygon when on a regular Lat Lon grid.
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE haversine_laloseglen(nbpt, nbseg, lonpoly, latpoly, seglength)
+    !
+    ! Computes the segment length for each of the polygones. These are
+    ! polygones with middle points given for each segment. This we need
+    ! to take only every other point.
+    !
+    !
+    ! 0.1 Input Variables
+    ! Size of the gathered domain
+    INTEGER(i_std), INTENT(in)                                 :: nbpt
+    ! Number of segments
+    INTEGER(i_std), INTENT(in)                                 :: nbseg
+    !
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(in)           :: lonpoly
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(in)           :: latpoly
+    REAL(r_std), DIMENSION(nbpt,nbseg), INTENT(out)            :: seglength
+    !
+    ! 0.2 Local variables
+    !
+    INTEGER(i_std) :: i, iv, istart, iend, ioff, iseg
+    REAL(r_std)    :: coslat, slpm1, slpp1
+    !
+    DO i=1,nbpt
+       iseg = 0
+       !
+       ! Find if the first element is a vertex or mid-point of segment.
+       ! Get the 2 headings out of the start point. If these headings are larger than 135 degrees
+       ! then probably this point is a segment mid-point.
+       !
+       slpm1 = haversine_heading(lonpoly(i,1), latpoly(i,1), lonpoly(i,nbseg*2), latpoly(i,nbseg*2))
+       slpp1 = haversine_heading(lonpoly(i,1), latpoly(i,1), lonpoly(i,2), latpoly(i,2))
+       !
+       IF ( ABS(MOD(slpp1-slpm1, 360.0)) > 135.0 ) THEN
+          ! The polygon starts with a segment mid-point
+          ioff = -1
+       ELSE
+          ioff = 0
+       ENDIF
+       !
+       DO iv=1,nbseg*2,2
+          !
+          istart=MODULO((iv-1)+ioff,nbseg*2)+1
+          iend=MODULO((iv-1)+ioff+2,nbseg*2)+1
+          iseg = iseg + 1
+          !
+          !
+          IF ( ABS(lonpoly(i,istart)-lonpoly(i,iend)) < EPSILON(lonpoly) ) THEN
+             !
+             ! Distance along a meridian
+             !
+             seglength(i,iseg) =  ABS(latpoly(i,istart) - latpoly(i,iend)) * &
+                     pi/180. * R_Earth
+             !
+          ELSE IF ( ABS(latpoly(i,istart)-latpoly(i,iend)) < EPSILON(latpoly) ) THEN
+             !
+             ! Distance along a circle of constant latitude
+             !
+             coslat = MAX(COS(latpoly(i,istart) * pi/180.), mincos)
+             seglength(i,iseg) = ABS( lonpoly(i,istart) - lonpoly(i,iend) ) * &
+                  pi/180. * R_Earth * coslat
+             !
+          ELSE
+             CALL ipslerr(3, "haversine_laloseglen", "The polygon here does not originate from a regular", &
+               &       "latitude longitude grid.","")
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE haversine_laloseglen
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: haversine_clockwise   
+!!
+!>\BRIEF       Get the indices which sort a polygon in a clockwise order starting from an
+!              initial vertex given by start.	  
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE haversine_clockwise(nbseg, heading, start, sortindex)
+    !
+    ! Find the order of the polygone vertices which start at "start" and 
+    ! follow in a clockwise direction.
+    !
+    ! 0.1 Input Variables
+    ! Number of segments
+    INTEGER(i_std), INTENT(in)                                 :: nbseg
+    REAL(r_std), DIMENSION(nbseg*2), INTENT(in)                :: heading
+    REAL(r_std), INTENT(in)                                    :: start
+    ! 
+    ! 0.2 Output variable
+    !
+    INTEGER(i_std), DIMENSION(nbseg*2), INTENT(out)            :: sortindex
+    !
+    ! 0.3 Local variables
+    !
+    INTEGER(i_std) :: is, js, imin(1)
+    REAL(r_std)    :: delang
+    REAL(r_std)    :: undef = 9999999999.99999
+    REAL(r_std), DIMENSION(nbseg*2) :: workhead
+    !
+    delang = 360.0/(nbseg*2)
+    !
+    workhead(:) = heading(:)
+    !
+    DO is=1,nbseg*2
+       !
+       ! Compute the difference of heading to the next target angle
+       !
+       DO js=1,nbseg*2
+          IF ( workhead(js) < undef ) THEN
+             workhead(js) = MOD(heading(js)-(start+(is-1)*delang)+360.0, 360.0)
+             ! Transfer to -180:180 interval
+             IF (workhead(js) > 180.0) workhead(js)=workhead(js)-360.0
+          ENDIF
+       ENDDO
+       !
+       ! Locate the vertex closest to that target angle
+       !
+       imin=MINLOC(ABS(workhead))
+       sortindex(is) = imin(1)
+       !
+       ! Mask this vertex so that it is skipped in the next iteration
+       !
+       workhead(imin(1)) = undef
+       !
+    ENDDO
+    !
+  END SUBROUTINE haversine_clockwise
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: haversine_polyarea   
+!!
+!>\BRIEF       Computes the area covered by a polygon on the sphere.	  
+!!
+!! DESCRIPTION:	Computes the area of each polygon based on Girard's theorem. It
+!!              states that the area of a polygon of great circles is R**2 times 
+!!              the sum of the angles between the polygons minus (N-2)*pi where N 
+!!             x is number of corners.  
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE haversine_polyarea(nbpt, nbseg, lonpoly, latpoly, area)
+    !
+    !
+    ! 0.1 Input Variables
+    ! Size of the gathered domain
+    INTEGER(i_std), INTENT(in)                                 :: nbpt
+    ! Number of segments
+    INTEGER(i_std), INTENT(in)                                 :: nbseg
+    !
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(in)           :: lonpoly
+    REAL(r_std), DIMENSION(nbpt,nbseg*2), INTENT(in)           :: latpoly
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)                  :: area
+    !
+    ! 0.2 Local variables
+    !
+    INTEGER(i_std) :: i, ia, ib1, ib2, iseg
+    REAL(r_std)    :: beta1, beta2
+    REAL(r_std), DIMENSION(nbseg) :: angles
+    !
+    DO i=1,nbpt
+       iseg=0
+       DO ia=1,nbseg*2,2
+          !! Index of next vertex, i.e. ia+1
+          ib1=MOD(ia+1, nbseg*2)+1
+          !! Index of previous vertex, i.e. ia-2
+          ib2=MOD(ia+nbseg*2-3, nbseg*2)+1
+          iseg=iseg+1
+          !
+          beta1=haversine_dtor(haversine_heading(lonpoly(i,ia), latpoly(i,ia), lonpoly(i,ib1), latpoly(i,ib1)))
+          beta2=haversine_dtor(haversine_heading(lonpoly(i,ia), latpoly(i,ia), lonpoly(i,ib2), latpoly(i,ib2)))
+          !
+          angles(iseg)=acos(cos(-beta1)*cos(-beta2) + sin(-beta1)*sin(-beta2))
+          !
+       ENDDO
+       area(i) = (sum(angles) - (nbseg-2)*pi)*R_Earth**2
+    ENDDO
+    !
+  END SUBROUTINE haversine_polyarea
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: haversine_laloarea   
+!!
+!>\BRIEF       Computes the area of a regular latitude longitude box for which we already have the
+!!             the segment length.	  
+!!
+!! DESCRIPTION:	Just verify that we have 4 segments. 
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE haversine_laloarea(nbpt, nbseg, seglen, area)
+    !
+    !
+    ! 0.1 Input Variables
+    ! Size of the gathered domain
+    INTEGER(i_std), INTENT(in)                                 :: nbpt
+    ! Number of segments
+    INTEGER(i_std), INTENT(in)                                 :: nbseg
+    !
+    REAL(r_std), DIMENSION(nbpt,nbseg), INTENT(in)             :: seglen
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)                  :: area
+    !
+    ! 0.2 Local variables
+    !
+    INTEGER(i_std) :: i
+    !
+    IF ( nbseg .NE. 4 ) THEN
+          CALL ipslerr(3, "haversine_laloarea", "We need to have 4 segments in the polygons", &
+               &       "to use this subroutine","")
+    ENDIF
+    !
+    DO i=1,nbpt
+       area(i) = (seglen(i,1)+seglen(i,3))/2.0*(seglen(i,2)+seglen(i,4))/2.0
+    ENDDO
+    !
+  END SUBROUTINE haversine_laloarea
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: haversine_laloarea   
+!!
+!>\BRIEF       Computes the area in the special case where the projection has given us the size in X and Y of each
+!!             grid box.
+!!
+!! DESCRIPTION:
+!!
+!! \n
+!_ ==============================================================================================================================
+!!
+  SUBROUTINE haversine_xyarea(nbpt, nbseg, ilandtoij, jlandtoij, dx, dy, area)
+    !
+    !
+    ! 0.1 Input Variables
+    ! Size of the gathered domain
+    INTEGER(i_std), INTENT(in)                                 :: nbpt
+    ! Number of segments
+    INTEGER(i_std), INTENT(in)                                 :: nbseg
+    !
+    INTEGER(i_std), DIMENSION(nbpt), INTENT(in)                :: ilandtoij, jlandtoij
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                    :: dx, dy
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)                  :: area
+    !
+    ! 0.2 Local variables
+    !
+    INTEGER(i_std) :: il
+    !
+    DO il=1,nbpt
+       area(il) = dx(ilandtoij(il),jlandtoij(il))*dy(ilandtoij(il),jlandtoij(il))
+    ENDDO
+    !
+  END SUBROUTINE haversine_xyarea
+!!
+!!  =============================================================================================================================
+!! FUNCTIONS: haversine_heading,  haversine_distance, haversine_dtor, haversine_rtod 
+!!
+!>\BRIEF Various functions to help with the calculations in this module.	  
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+  REAL(r_std) FUNCTION haversine_heading(lon_start, lat_start, lon_end, lat_end)
+    !
+    ! The heading is an angle in degrees between 0 and 360.
+    !
+    IMPLICIT NONE
+    REAL(r_std), INTENT(IN) :: lon_start, lat_start, lon_end, lat_end
+    !
+    REAL(r_std) :: dlon, lat1, lat2, y, x
+    !
+    dlon = haversine_dtor(lon_end-lon_start)
+    lat1 = haversine_dtor(lat_start)
+    lat2 = haversine_dtor(lat_end)
+    y = sin(dlon) * cos(lat2)
+    x = cos(lat1)* sin(lat2) - sin(lat1) * cos(lat2)* cos(dLon)
+    haversine_heading = MOD(haversine_rtod(atan2(y,x))+360.0, 360.0)
+    !
+  END FUNCTION haversine_heading
+  !!
+  !!
+  !!
+  REAL(r_std) FUNCTION haversine_distance(lon_start, lat_start, lon_end, lat_end)
+    IMPLICIT NONE
+    REAL(r_std), INTENT(IN) :: lon_start, lat_start, lon_end, lat_end
+    !
+    REAL(r_std) :: dlon, dlat, lat1, lat2, a, c
+    !
+    dlat = haversine_dtor(lat_end-lat_start)
+    dlon = haversine_dtor(lon_end-lon_start)
+    lat1 = haversine_dtor(lat_start)
+    lat2 = haversine_dtor(lat_end)
+    a = sin(dlat/2) * sin(dlat/2) + sin(dlon/2) * sin(dlon/2) * cos(lat1) * cos(lat2)
+    c = 2 * atan2(sqrt(a), sqrt(1-a))
+    haversine_distance = c * R_Earth
+    !
+  END FUNCTION haversine_distance
+  !!
+  !!
+  !!
+  FUNCTION haversine_radialdis(lon_start, lat_start, head, dis)
+    IMPLICIT NONE
+    REAL(r_std), INTENT(IN)   :: lon_start, lat_start, head, dis
+    REAL(r_std), DIMENSION(2) :: haversine_radialdis
+    !
+    REAL(r_std) :: lonout, latout, lat1, lon1, lat, lon, dlon, tc
+    !
+    lon1 = haversine_dtor(lon_start)
+    lat1 = haversine_dtor(lat_start)
+    tc = haversine_dtor(head)
+    !
+    lat =asin(sin(lat1)*cos(dis/R_Earth)+cos(lat1)*sin(dis/R_Earth)*cos(tc))
+    dlon = atan2(sin(tc)*sin(dis/R_Earth)*cos(lat1),cos(dis/R_Earth)-sin(lat1)*sin(lat))
+    lon = MOD(lon1+dlon+pi, 2*pi)-pi
+    !
+    latout = haversine_rtod(lat)
+    lonout = haversine_rtod(lon)
+    !
+    haversine_radialdis(1) = lonout
+    haversine_radialdis(2) = latout
+    !
+  END FUNCTION haversine_radialdis
+  ! --------------------------------------------------------------------
+  ! FUNCTION  haversine_dtor():
+  !    This function takes a REAL argument in degree and converts it to
+  ! the equivalent radian.
+  ! --------------------------------------------------------------------
+  REAL(r_std) FUNCTION  haversine_dtor(Degree)
+    IMPLICIT  NONE
+    REAL(r_std), INTENT(IN) :: Degree
+    haversine_dtor = Degree * pi/180.0
+  END FUNCTION haversine_dtor
+  ! --------------------------------------------------------------------
+  ! FUNCTION  haversine_rtod():
+  !    This function takes a REAL argument in radian and converts it to
+  ! the equivalent degree.
+  ! --------------------------------------------------------------------
+  REAL(r_std) FUNCTION  haversine_rtod(Radian)
+    IMPLICIT  NONE
+    REAL(r_std), INTENT(IN) :: Radian
+
+    haversine_rtod = Radian * 180.0/pi
+  END FUNCTION haversine_rtod
+  !!
+  !!
+  !!
+END MODULE haversine
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/interpol_help.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/interpol_help.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/interpol_help.f90	(revision 6412)
@@ -0,0 +1,844 @@
+!
+! 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$
+!< $Revision$
+!
+!
+MODULE interpol_help
+
+  ! Modules used :
+
+  USE constantes
+  USE mod_orchidee_para
+  USE grid
+  USE interregxy
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC aggregate, aggregate_p
+  !
+  INTERFACE aggregate
+     MODULE PROCEDURE aggregate_2d, aggregate_vec
+  END INTERFACE
+  !
+  INTERFACE aggregate_p
+     MODULE PROCEDURE aggregate_2d_p, aggregate_vec_p
+  END INTERFACE
+  !
+  LOGICAL, PARAMETER                              :: check_grid=.FALSE.
+  !
+CONTAINS
+  !
+  ! This routing will get for each point of the coarse grid the
+  ! indexes of the finer grid and the area of overlap. 
+  ! This routine is designed for a fine grid which is regular in lat/lon.
+  !
+  SUBROUTINE aggregate_2d (nbpt, lalo, neighbours, resolution, contfrac, &
+       &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+       &                incmax, indinc, areaoverlap, ok)
+
+    USE grid, ONLY : global
+
+    !
+    ! INPUT
+    ! 
+    INTEGER(i_std), INTENT(in)   :: nbpt                 ! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)      :: lalo(nbpt,2)         ! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)   :: neighbours(nbpt,NbNeighb)! Vector of neighbours for each grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std), INTENT(in)      :: resolution(nbpt,2)   ! The size in km of each grid-box in X and Y
+    REAL(r_std), INTENT(in)      :: contfrac(nbpt)       ! Fraction of land in each grid box.
+    INTEGER(i_std), INTENT(in)   :: iml, jml             ! Size of the finer grid
+    REAL(r_std), INTENT(in)      :: lon_rel(iml, jml)    ! Longitudes for the finer grid
+    REAL(r_std), INTENT(in)      :: lat_rel(iml, jml)    ! Latitudes for the finer grid
+    INTEGER(i_std), INTENT(in)   :: mask(iml, jml)       ! Mask which retains only the significative points
+                                                         ! of the fine grid.
+    CHARACTER(LEN=*), INTENT(in) :: callsign             ! Allows to specify which variable is beeing treated
+    INTEGER(i_std), INTENT(in)   :: incmax              ! Maximum point of the fine grid we can store.
+    !
+    ! Output
+    !
+    INTEGER(i_std), INTENT(out)  :: indinc(nbpt,incmax,2)
+    REAL(r_std), INTENT(out)      :: areaoverlap(nbpt,incmax)
+    LOGICAL, OPTIONAL, INTENT(out)      :: ok            ! return code
+    !
+    ! Local Variables
+    !
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_ful, lon_ful
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: loup_rel, lolow_rel, laup_rel, lalow_rel
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: searchind
+    REAL(r_std) :: lon_up, lon_low, lat_up, lat_low
+    REAL(r_std) :: coslat, ax, ay, sgn, lonrel, lolowrel, louprel
+    INTEGER(i_std) :: fopt, fopt_max, ip, jp, ib, i, itmp, iprog, nbind
+    REAL(r_std) :: domain_minlon,domain_maxlon,domain_minlat,domain_maxlat
+    INTEGER(i_std) :: minLon(1), maxLon(1)
+
+    INTEGER                  :: ALLOC_ERR
+    LOGICAL :: err_fopt
+    err_fopt = .FALSE.
+    !
+    ! Some inital assignmens
+    !
+    areaoverlap(:,:) = moins_un
+    indinc(:,:,:) = zero
+
+    ALLOCATE (laup_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of laup_rel','','')
+
+    ALLOCATE (loup_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of loup_rel','','')
+
+    ALLOCATE (lalow_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of lalow_rel','','')
+
+    ALLOCATE (lolow_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of lolow_rel','','')
+
+    ALLOCATE (lat_ful(iml+2,jml+2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of lat_ful','','')
+
+    ALLOCATE (lon_ful(iml+2,jml+2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of lon_ful','','')
+
+    ALLOCATE (searchind(iml*jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of searchind','','')
+
+    IF (PRESENT(ok)) ok = .TRUE.
+    !
+    !    Duplicate the border assuming we have a global grid going from west to east
+    !
+    lon_ful(2:iml+1,2:jml+1) = lon_rel(1:iml,1:jml)
+    lat_ful(2:iml+1,2:jml+1) = lat_rel(1:iml,1:jml)
+    !
+    IF ( lon_rel(iml,1) .LT. lon_ful(2,2)) THEN
+       lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)
+       lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
+    ELSE
+       lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)-360
+       lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
+    ENDIF
+
+    IF ( lon_rel(1,1) .GT. lon_ful(iml+1,2)) THEN
+       lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)
+       lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
+    ELSE
+       lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)+360
+       lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
+    ENDIF
+    !
+    sgn = lat_rel(1,1)/ABS(lat_rel(1,1))
+    lat_ful(2:iml+1,1) = sgn*180 - lat_rel(1:iml,1)
+    sgn = lat_rel(1,jml)/ABS(lat_rel(1,jml))
+    lat_ful(2:iml+1,jml+2) = sgn*180 - lat_rel(1:iml,jml)
+    lat_ful(1,1) = lat_ful(iml+1,1)
+    lat_ful(iml+2,1) = lat_ful(2,1)
+    lat_ful(1,jml+2) = lat_ful(iml+1,jml+2)
+    lat_ful(iml+2,jml+2) = lat_ful(2,jml+2)
+    !
+    ! Add the longitude lines to the top and bottom
+    !
+    lon_ful(:,1) = lon_ful(:,2) 
+    lon_ful(:,jml+2) = lon_ful(:,jml+1) 
+    !
+    !  Get the upper and lower limits of each grid box
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          loup_rel(ip,jp) =MAX(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)),&
+               & 0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
+          lolow_rel(ip,jp) =MIN(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)),&
+               & 0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
+          laup_rel(ip,jp) =MAX(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)),&
+               & 0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
+          lalow_rel(ip,jp) =MIN(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)),&
+               & 0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
+          !
+       ENDDO
+    ENDDO
+    IF (check_grid) THEN
+       WRITE(numout,*) "================================"
+       WRITE(numout,*) "interpol_aggregate_2d : "
+       WRITE(numout,*) "lalo(:,1) :",lalo(:,1)
+       WRITE(numout,*) "lalo(:,2) :",lalo(:,2)
+       WRITE(numout,*) "Map meshes : "
+       WRITE(numout,*) "lat read(1,:) :",lat_rel(1,:)
+       WRITE(numout,*) "lat_ful(1,:) :",lat_ful(1,:)
+       WRITE(numout,*) "lat_ful(2,:) :",lat_ful(2,:)
+       WRITE(numout,*) "lalow_rel(1,:) :",lalow_rel(1,:)
+       WRITE(numout,*) "laup_rel(1,:) :",laup_rel(1,:)
+       WRITE(numout,*) "================================"
+       WRITE(numout,*) "lon read(:,1) :",lon_rel(:,1)
+       WRITE(numout,*) "lon_ful(:,1) :",lon_ful(:,1)
+       WRITE(numout,*) "lon_ful(:,2) :",lon_ful(:,2)
+       WRITE(numout,*) "lolow_rel(:,1) :",lolow_rel(:,1)
+       WRITE(numout,*) "loup_rel(:,1) :",loup_rel(:,1)
+       WRITE(numout,*) "================================"
+    ENDIF
+    !
+    !
+    !  To speedup calculations we will get the limits of the domain of the 
+    !  coarse grid and select all the points of the fine grid which are potentialy
+    !  in this domain.
+    !
+    !
+    minLon = MINLOC(lalo(1:nbpt,2))
+    coslat = MAX(COS(lalo(minLon(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    domain_minlon = lalo(minLon(1),2) - resolution(minLon(1),1)/(2.0*coslat)
+    maxLon = MAXLOC(lalo(1:nbpt,2))
+    coslat = MAX(COS(lalo(maxLon(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    domain_maxlon = lalo(maxLon(1),2) + resolution(maxLon(1),1)/(2.0*coslat)
+    !
+    coslat = pi/180. * R_Earth
+    domain_minlat = MINVAL(lalo(1:nbpt,1)) - resolution(maxLon(1),2)/(2.0*coslat)
+    domain_maxlat = MAXVAL(lalo(1:nbpt,1)) + resolution(maxLon(1),2)/(2.0*coslat)
+    !
+    IF (check_grid) THEN
+       WRITE(numout,*) "indices min/max of longitude :",minLon,maxLon, &
+            & "; longitude min/max : ",lalo(minLon,1),lalo(maxLon,1)
+       WRITE(numout,*) "Domain for coarse grid :"
+       WRITE(numout,*) '(',domain_minlat,',',domain_minlon,')',&
+   &                   '(',domain_maxlat,',',domain_maxlon,')'
+       WRITE(numout,*) "================================"
+    ENDIF
+    !
+    ! we list a first approximation of all point we will need to 
+    ! scan to fill our coarse grid.
+    !
+    IF ( global ) THEN
+       ! Here we do the entire globe
+       WRITE(numout,*) 'In aggregate_p : do interpolation to global model domain'
+       nbind=0
+       DO jp=1,jml
+          DO ip=1,iml
+             IF (mask(ip,jp) == 1 ) THEN
+                nbind = nbind + 1
+                searchind(nbind,1) = ip
+                searchind(nbind,2) = jp
+             ENDIF
+          ENDDO
+       ENDDO
+       !
+    ELSE
+       ! Now we get a limited number of points
+       WRITE(numout,*) 'In aggregate_p : do interpolation to regional model domain'
+       nbind=0
+       DO jp=1,jml
+          DO ip=1,iml
+             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 .AND. lon_up <= 180.0) THEN
+             lonrel = lon_rel(ip,jp)
+             lolowrel = lolow_rel(ip,jp)
+             louprel = loup_rel(ip,jp)
+          ELSE 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)
+          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 .AND. lon_up <= 180.0 ) THEN
+                      lolowrel = lolow_rel(ip,jp)
+                      louprel = loup_rel(ip,jp)
+                   ELSE 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)
+                   ENDIF
+                   !
+                   ! Get the area of the fine grid in the model grid
+                   !
+                   coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )
+                   ax = (MIN(lon_up,louprel)-MAX(lon_low, lolowrel))*pi/180. * R_Earth * coslat
+                   ay = (MIN(lat_up, laup_rel(ip,jp))-MAX(lat_low,lalow_rel(ip,jp)))*pi/180. * R_Earth
+                   !
+                   areaoverlap(ib, fopt) = ax*ay
+                   indinc(ib, fopt, 1) = ip
+                   indinc(ib, fopt, 2) = jp
+                   !
+                   ! If this point was 100% within the grid then we can de-select it from our
+                   ! list as it can not be in another mesh of the coarse grid.
+                   !
+                   IF ( louprel < lon_up .AND. lolowrel > lon_low .AND. &
+                     &  laup_rel(ip,jp) < lat_up .AND. lalow_rel(ip,jp) > lat_low ) THEN
+                      searchind(i,1) = 0
+                      searchind(i,2) = 0
+                   ENDIF
+                   !
+                ENDIF
+             ENDIF       ! IF lat
+          ENDIF          ! IF lon
+       ENDDO
+
+       IF (err_fopt) THEN
+          WRITE(numout,*) 'Working on variable :', callsign
+          WRITE(numout,*) 'Reached value ', fopt,' for fopt on point', ib, lalo(ib,2), lalo(ib,1)
+          CALL ipslerr_p(2,'aggregate_2d', &
+               'Working on variable :'//callsign, &
+               'Reached incmax value for fopt.',&
+               'Please increase incmax in subroutine calling aggregate')                   
+          IF (PRESENT(ok)) THEN
+             ok = .FALSE.
+             RETURN
+          ELSE
+             CALL ipslerr_p(3,'aggregate_2d','Stop now','','')
+          ENDIF
+       ENDIF
+       fopt_max = MAX ( fopt, fopt_max )
+       !
+       ! De-select the marked points
+       !
+       itmp = nbind
+       nbind = 0
+       DO i=1,itmp
+          IF ( searchind(i,1) > 0 .AND. searchind(i,2) > 0 ) THEN
+             nbind = nbind + 1
+             searchind(nbind,1) = searchind(i,1)
+             searchind(nbind,2) = searchind(i,2)
+          ENDIF
+       ENDDO
+       !
+    ENDDO
+    !
+    DO ib=1,nbpt
+       DO fopt=1,incmax
+          IF (( indinc(ib,fopt,1) == 0 .AND. indinc(ib,fopt,2) > 0) .OR.&
+               & ( indinc(ib,fopt,2) == 0 .AND. indinc(ib,fopt,1) > 0) ) THEN
+             WRITE(*,*) "aggregate_2d PROBLEM : point =",ib, fopt," Indicies = ", &
+                  & indinc(ib,fopt,1), indinc(ib,fopt,2), areaoverlap(ib,fopt)
+          ENDIF
+       ENDDO
+    ENDDO
+
+    WRITE(numout,*) ""
+    WRITE(numout,*) "aggregate_2D nbvmax = ",incmax, "max used = ",fopt_max
+    !
+    ! Do some memory management.
+    !
+    DEALLOCATE (laup_rel)
+    DEALLOCATE (loup_rel)
+    DEALLOCATE (lalow_rel)
+    DEALLOCATE (lolow_rel)
+    DEALLOCATE (lat_ful)
+    DEALLOCATE (lon_ful)
+    DEALLOCATE (searchind)
+    !
+    ! Close the progress meter
+    !
+    WRITE(numout,*) '    '
+    !
+  END SUBROUTINE aggregate_2d
+
+  !
+  ! This routing will get for each point of the coarse grid the
+  ! indexes of the finer grid and the area of overlap. 
+  ! This routine is designed for a fine grid which is regular in meters along lat lon axes.
+  !
+  SUBROUTINE aggregate_vec (nbpt, lalo, neighbours, resolution, contfrac, &
+       &                iml, lon_rel, lat_rel, resol_lon, resol_lat, callsign, &
+       &                incmax, indinc, areaoverlap, ok)
+    !
+    ! INPUT
+    ! 
+    INTEGER(i_std), INTENT(in)   :: nbpt                 ! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)      :: lalo(nbpt,2)         ! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)   :: neighbours(nbpt,NbNeighb)   ! Vector of neighbours for each grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std), INTENT(in)      :: resolution(nbpt,2)   ! The size in km of each grid-box in X and Y
+    REAL(r_std), INTENT(in)      :: contfrac(nbpt)       ! Fraction of land in each grid box.
+    INTEGER(i_std), INTENT(in)   :: iml                  ! Size of the finer grid
+    REAL(r_std), INTENT(in)      :: lon_rel(iml)         ! Longitudes for the finer grid
+    REAL(r_std), INTENT(in)      :: lat_rel(iml)         ! Latitudes for the finer grid
+    REAL(r_std), INTENT(in)      :: resol_lon, resol_lat ! Resolution in meters of the fine grid
+    CHARACTER(LEN=*), INTENT(in) :: callsign             ! Allows to specify which variable is beeing treated
+    INTEGER(i_std), INTENT(in)   :: incmax              ! Maximum point of the fine grid we can store.
+    !
+    ! Output
+    !
+    INTEGER(i_std), INTENT(out)  :: indinc(nbpt,incmax)
+    REAL(r_std), INTENT(out)      :: areaoverlap(nbpt,incmax)
+    LOGICAL, OPTIONAL, INTENT(out)      :: ok            ! return code
+    !
+    ! Local Variables
+    !
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: searchind
+    REAL(r_std) :: lon_up, lon_low, lat_up, lat_low
+    REAL(r_std) :: coslat, ax, ay, lonrel, lolowrel, louprel
+    REAL(r_std) :: latrel, lauprel, lalowrel
+    INTEGER(i_std), DIMENSION(nbpt) :: fopt
+    INTEGER(i_std) :: fopt_max, not_found_fopt
+    INTEGER(i_std) :: ip, ib, i, j, itmp, iprog, nbind, pp, ipp
+    REAL(r_std) :: domain_minlon,domain_maxlon,domain_minlat,domain_maxlat
+    REAL(r_std) :: minlon, minlat, mini
+    INTEGER(i_std) :: ff(1), incp
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: fine_ind
+    INTEGER(i_std) :: pos_pnt(5)
+    INTEGER                  :: ALLOC_ERR
+    !
+    LOGICAL :: err_fopt
+    err_fopt = .FALSE.
+    !
+    ! Some inital assignmens
+    !
+    areaoverlap(:,:) = moins_un
+    indinc(:,:) = zero
+
+    ALLOCATE (searchind(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_vec','ERROR IN ALLOCATION of searchbind','','')
+
+    IF (PRESENT(ok)) ok = .TRUE.
+    !
+    !  To speedup calculations we will get the limits of the domain of the 
+    !  coarse grid and select all the points of the fine grid which are potentialy
+    !  in this domain.
+    !
+    !
+    ff = MINLOC(lalo(:,2))
+    coslat = MAX(COS(lalo(ff(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    domain_minlon = lalo(ff(1),2) - resolution(ff(1),1)/(2.0*coslat)
+    ff = MAXLOC(lalo(:,2))
+    coslat = MAX(COS(lalo(ff(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    domain_maxlon = lalo(ff(1),2) + resolution(ff(1),1)/(2.0*coslat)
+    !
+    coslat = pi/180. * R_Earth
+    domain_minlat = MINVAL(lalo(:,1)) - resolution(ff(1),2)/(2.0*coslat)
+    domain_maxlat = MAXVAL(lalo(:,1)) + resolution(ff(1),2)/(2.0*coslat)
+    !
+    ! Find appropriate resolution for index table
+    !
+    ff=MINLOC(resolution(:,1))
+    coslat = MAX(COS(lalo(ff(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    minlon=resolution(ff(1),1)/(2.0*coslat)
+    ff=MINLOC(resolution(:,2))
+    coslat = pi/180. * R_Earth
+    minlat=resolution(ff(1),2)/(2.0*coslat)
+    mini=MIN(minlon, minlat)
+    !
+    ! This interpolation only works if the model grid is coarser than the data grid
+    !
+    IF (MINVAL(resolution(:,1)) < resol_lon .OR. MINVAL(resolution(:,2)) < resol_lat) THEN
+       WRITE(numout,*) " === WARNING == "
+       WRITE(numout,*) "Resolution minima of the model (lon, lat) : ", &
+            & MINVAL(resolution(:,1)), MINVAL(resolution(:,2))
+       WRITE(numout,*) "Resolution of the file to be interpolated (fine grid) : ", resol_lon, resol_lat
+       WRITE(numout,*) "This interpolation assumes that we aggregate from a fine grid to a coarser grid"
+       WRITE(numout,*) "In the data submitted it apears that the model is runing on a finer grid than the data"
+    ENDIF
+    !
+    incp = 10
+    IF (mini < 0.1) THEN
+       incp=100
+    ELSE IF (mini < 0.01) THEN
+       incp = 1000
+    ENDIF
+    !
+    ! Allocate the needed memory for fine_ind
+    !
+    ALLOCATE (fine_ind(NINT(domain_minlon*incp)-2:NINT(domain_maxlon*incp)+2, &
+         & NINT(domain_minlat*incp)-2:NINT(domain_maxlat*incp)+2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_vec','ERROR IN ALLOCATION of find_ind','','')
+    !
+    ! Generate a quick access table for the coarse grid
+    !
+    fine_ind(:,:) = zero
+    !
+    DO ib=1,nbpt
+       coslat = MAX(COS(lalo(ib,1) * pi/180. ), mincos )*pi/180. * R_Earth
+       !
+       lon_up = lalo(ib,2) + resolution(ib,1)/(2.0*coslat) 
+       lon_low =lalo(ib,2) - resolution(ib,1)/(2.0*coslat) 
+       !
+       coslat = pi/180. * R_Earth
+       !
+       lat_up =lalo(ib,1) + resolution(ib,2)/(2.0*coslat) 
+       lat_low =lalo(ib,1) - resolution(ib,2)/(2.0*coslat) 
+       !
+       fine_ind(NINT(lon_low*incp):NINT(lon_up*incp),NINT(lat_low*incp):NINT(lat_up*incp))=ib
+       !
+    ENDDO
+    !
+    WRITE(numout,*) 'Domaine LON range : ', domain_minlon, domain_maxlon
+    WRITE(numout,*) 'Domaine LAT range : ', domain_minlat, domain_maxlat
+    !
+    ! we list a first approximation of all point we will need to 
+    ! scan to fill our coarse grid.
+    !
+    IF ( domain_minlon <= -179.5 .AND. domain_maxlon >= 179.5 .AND. &
+      &  domain_minlat <= -89.5  .AND. domain_maxlat >= 89.5 ) THEN
+       ! Here we do the entire globe
+       nbind=0
+       DO ip=1,iml
+          nbind = nbind + 1
+          searchind(nbind) = ip
+       ENDDO
+       !
+    ELSE
+       ! Now we get a limited number of points
+       nbind=0
+       DO ip=1,iml
+          ! Compute the limits of the meshes of the fine grid
+          coslat = MAX(COS(lat_rel(ip) * pi/180. ), mincos )*pi/180. * R_Earth
+          louprel = MIN(lon_rel(ip) + resol_lon/(2.0*coslat), 180.)
+          lolowrel = MAX(lon_rel(ip) - resol_lon/(2.0*coslat), -180.)
+          coslat = pi/180. * R_Earth
+          lauprel = MIN(lat_rel(ip) + resol_lat/(2.0*coslat), 90.)
+          lalowrel = MAX(lat_rel(ip) - resol_lat/(2.0*coslat), -90.)
+          !
+          IF ( louprel >= domain_minlon .AND. lolowrel <= domain_maxlon .AND.&
+            &  lauprel >= domain_minlat .AND. lalowrel <= domain_maxlat ) THEN
+             nbind = nbind + 1
+             searchind(nbind) = ip
+          ENDIF
+       ENDDO
+    ENDIF
+    !
+    WRITE(numout,*) 'We will work with ', nbind, ' points of the fine grid and ', nbpt, 'for the coarse grid'
+    !
+    WRITE(numout,*) 'Aggregate_vec : ', callsign
+    !
+    !   Now we take each grid point and find out which values from the forcing we need to average
+    !
+    fopt(:) = zero
+    fopt_max = -1
+    !
+    !
+    !
+    loopnbind : DO i=1,nbind
+       !
+       !
+       ip = searchind(i)
+       !
+       !  Either the center of the data grid point is in the interval of the model grid or
+       !  the East and West limits of the data grid point are on either sides of the border of
+       !  the data grid.
+       !
+       lonrel = lon_rel(ip)
+       coslat = MAX(COS(lat_rel(ip) * pi/180. ), mincos )*pi/180. * R_Earth
+       louprel = MIN(lon_rel(ip) + resol_lon/(2.0*coslat), domain_maxlon)
+       lolowrel = MAX(lon_rel(ip) - resol_lon/(2.0*coslat), domain_minlon)
+       !
+       latrel = lat_rel(ip)
+       coslat = pi/180. * R_Earth
+       lauprel = MIN(lat_rel(ip) + resol_lat/(2.0*coslat), domain_maxlat)
+       lalowrel = MAX(lat_rel(ip) - resol_lat/(2.0*coslat), domain_minlat)
+       !
+       !
+       pos_pnt(:) = zero
+       ipp = zero
+       pp = fine_ind(NINT(lonrel*incp),NINT(latrel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       pp = fine_ind(NINT(louprel*incp),NINT(lauprel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       pp = fine_ind(NINT(louprel*incp),NINT(lalowrel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       pp = fine_ind(NINT(lolowrel*incp),NINT(lauprel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       pp = fine_ind(NINT(lolowrel*incp),NINT(lalowrel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       !
+       !
+       IF ( ipp > zero ) THEN
+          !
+          DO pp=1,ipp
+             ib = pos_pnt(pp)
+             !
+             !  We find the 4 limits of the grid-box. As we transform the resolution of the model
+             !  into longitudes and latitudes we do not have the problem of periodicity.
+             !  coslat is a help variable here !
+             !
+             coslat = MAX(COS(lalo(ib,1) * pi/180. ), mincos )*pi/180. * R_Earth
+             !
+             lon_up = lalo(ib,2) + resolution(ib,1)/(2.0*coslat) 
+             lon_low =lalo(ib,2) - resolution(ib,1)/(2.0*coslat) 
+             !
+             coslat = pi/180. * R_Earth
+             !
+             lat_up =lalo(ib,1) + resolution(ib,2)/(2.0*coslat) 
+             lat_low =lalo(ib,1) - resolution(ib,2)/(2.0*coslat) 
+             !
+             IF ( lonrel > lon_low .AND. lonrel < lon_up .OR. &
+                  & lolowrel < lon_low .AND.  louprel > lon_low .OR. &
+                  & lolowrel < lon_up  .AND.  louprel > lon_up ) THEN
+                !
+                ! Now that we have the longitude let us find the latitude
+                !             
+                IF ( latrel > lat_low .AND. latrel < lat_up .OR. &
+                     & lalowrel < lat_low .AND. lauprel > lat_low .OR.&
+                     & lalowrel < lat_up .AND. lauprel > lat_up) THEN
+                   !
+                   fopt(ib) = fopt(ib) + 1
+                   fopt_max = MAX ( fopt(ib), fopt_max )
+                   !
+                   IF ( fopt(ib) > incmax) THEN
+                      err_fopt=.TRUE.
+                      EXIT loopnbind
+                   ELSE
+                      !
+                      ! Get the area of the fine grid in the model grid
+                      !
+                      coslat = MAX( COS( lat_rel(ip) * pi/180. ), mincos )
+                      ax = (MIN(lon_up,louprel)-MAX(lon_low,lolowrel))*pi/180. * R_Earth * coslat
+                      ay = (MIN(lat_up,lauprel)-MAX(lat_low,lalowrel))*pi/180. * R_Earth
+                      !
+                      areaoverlap(ib, fopt(ib)) = ax*ay
+                      indinc(ib, fopt(ib)) = ip
+                      !
+                   ENDIF
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDIF
+    ENDDO loopnbind
+    !
+    IF (err_fopt) THEN
+       WRITE(numout,*) 'Reached value ', fopt(ib),' for fopt on point', ib
+       CALL ipslerr_p(2,'aggregate_vec (nbpt < nbind)', &
+            'Working on variable :'//callsign, &
+            'Reached incmax value for fopt.',&
+            'Please increase incmax in subroutine calling aggregate')
+       IF (PRESENT(ok)) THEN
+          ok = .FALSE.
+          RETURN
+       ELSE
+          CALL ipslerr_p(3,'aggregate_vec','Stop now','','')
+       ENDIF
+    ENDIF
+    !
+    WRITE(numout,*) 
+    not_found_fopt = COUNT(fopt(:) .EQ. zero)
+    WRITE(numout,*) "aggregate_vec : ",not_found_fopt, &
+         & "did not find any corresponding data in the input file."
+    WRITE(numout,*) "aggregate_vec : This is ", not_found_fopt/REAL(nbpt, r_std)*100., &
+         & " % of the grid"
+    WRITE(numout,*) "aggregate_vec : nbvmax = ",incmax, "max used = ",fopt_max
+    !
+    ! Do some memory management.
+    !
+    DEALLOCATE (searchind)
+    DEALLOCATE (fine_ind)
+    !
+    ! Close the progress meter
+    !
+    WRITE(numout,*) '    '
+    !
+  END SUBROUTINE aggregate_vec
+!
+!
+  SUBROUTINE aggregate_vec_p(nbpt, lalo, neighbours, resolution, contfrac,          &
+       &                 iml, lon_ful, lat_ful, resol_lon, resol_lat, callsign, &
+       &                 nbvmax, sub_index, sub_area, ok)
+    
+    IMPLICIT NONE
+    
+    INTEGER(i_std), INTENT(in)   :: nbpt                 
+    REAL(r_std), INTENT(in)      :: lalo(nbpt,2)
+    INTEGER(i_std), INTENT(in)   :: neighbours(nbpt,NbNeighb)   
+    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 ( INDEX(GridType,"RegLonLat") > 0) THEN
+       IF (is_root_prc) CALL aggregate_vec(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)
+    ELSE IF ( INDEX(GridType,"RegXY") > 0) THEN
+       IF ( proj_stack(1)%code > undef_int-1 ) THEN
+          CALL ipslerr(3, "aggregate_vec_p", "RegXY projection was not intialized.", &
+               &       "proj_stack(1)%code is undefined","")
+       ENDIF
+       IF (is_root_prc) CALL interregxy_aggrve(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)
+    ELSE
+       CALL ipslerr(3, "aggregate_vec_p", "Interpolation is only possible for regular lat/lon grids for the moment.", &
+            &       "More general interpolation will be implemented soon.","")
+    ENDIF
+    !
+    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,NbNeighb)   
+    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 ( INDEX(GridType,"RegLonLat") > 0) THEN
+       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)
+    ELSE IF ( INDEX(GridType,"RegXY") > 0) THEN
+       IF ( proj_stack(1)%code > undef_int-1 ) THEN
+          CALL ipslerr(3, "aggregate_2d_p", "RegXY projection was not intialized.", &
+               &       "proj_stack(1)%code is undefined","")
+       ENDIF
+       IF (is_root_prc) CALL interregxy_aggr2d(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)
+    ELSE
+       CALL ipslerr(3, "aggregate_2d_p", "Interpolation is only possible for regular lat/lon grids for the moment.", &
+            &       "More general interpolation will be implemented soon.","")
+
+    ENDIF
+    !
+    CALL BCAST(ok)
+    CALL scatter(sub_index_g,sub_index)
+    CALL scatter(sub_area_g,sub_area)
+   
+  END SUBROUTINE aggregate_2d_p
+!
+END MODULE interpol_help
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/interpweight.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/interpweight.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/interpweight.f90	(revision 6412)
@@ -0,0 +1,5043 @@
+MODULE interpweight
+!=================================================================================================================================
+! MODULE       : interpweight
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       ! Specific module for the interpolation in ORCHIDEE
+!!
+!!\n DESCRIPTION: L. Fita, October 2016
+!!   This module is used in the re-organization done in the section of the code
+!! responsible of the interpolation of the morphology datat (PFT, albedo, LAI,
+!! ...) from different files done by L. Fita in the mark of the HEAT project.
+!! Previous version of the interpolation of these files, proceed by three 
+!! basic steps common for all the files:
+!!   1.: Modification of values from file
+!!   2.: Creation of land/sea mask using values from file
+!!   3.: Interpolate values
+!!   This module servs to generalize all these steps and construct a common 
+!! interface independently of the file. Each step is generalize and the 
+!! different processes almost specific for each file in the previous form
+!! are introduced as different methodologies. Thus now it provides:
+!!   1. Modification of initial values: Removing that wrong values from the file
+!|     `interpweight_modifying_input[1/2/3/4]D': subroutines to modify 1D, 2D, 3D
+!!     or 4D input data from file, using different methods
+!!   2. Masking input: Compute âon flyâ the values of the land/sea mask taking
+!!    the values in the file
+!!     `interpweight_masking_input[1/2/3/4]D': subroutines to compute the mask
+!!     using data from input file using different methods: nomask, mbelow, 
+!!     mabove, msumrange, var
+!!   3. Area weights: Get coincident areas from input file to the target 
+!!    projection using aggregate_p
+!!      No changes on it
+!!   4. Interpolate: Use obtained areas and interpolate values at each grid
+!!    point at the same format as it will be provided by XIOS
+!!      `interpweight_provide_fractions[1/2/3/4]D': Perform interpolation for
+!!      fraction/category data
+!!      `interpweight_provide_interpolation[2/4]D': Perform interpolation for
+!!      continuous data
+!!      `variableusetypes': Variable to provide the values along the additional
+!!      dimension to perform the interpolation. (e.g.: in case the 13 pfts
+!!      are: 1,3,6,18,23,34,35,39,48,...)
+!!   5. A new variable is added which explains the âavailabilityâ of data to 
+!!    perform the interpolation (0, 1). When it is negative it means that there
+!!    was no data for that grid point
+!!            availability = SUM(area_source)/Area_target_grid_point
+!!   This module will disappear once interpolation will be done throuhguot XIOS
+!! 
+!! More details at:
+!!   https://forge.ipsl.jussieu.fr/orchidee/wiki/DevelopmentActivities/ORCHIDEE-DYNAMICO
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S): None
+!!
+!! SVN         :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_================================================================================================================================
+
+  USE ioipsl_para
+  USE interpol_help
+  USE grid
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC interpweight_1D, interpweight_2D, interpweight_3D, interpweight_4D, interpweight_2Dcont,     &
+    interpweight_4Dcont, interpweight_get_varNdims_file, interpweight_RangeR,                         &
+    interpweight_get_var2dims_file, interpweight_get_var3dims_file, interpweight_get_var4dims_file,   &
+    interpweight_Index2DLonLat, interpweight_ValVecR
+
+  CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_1D
+!!
+!>\BRIEF        ! Interpolate any input file to the grid of the model for a 1D-variable  
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): outvar1D, aoutvar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_1D(nbpt, Nvariabletypes, variabletypes, lalo, resolution, neighbours,       &
+    contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype,               &
+    maskvalues, maskvarname, dim1, dim2, initime, typefrac,                                           &
+    maxresollon, maxresollat, outvar1D, aoutvar)
+
+    USE ioipsl
+    USE constantes_var
+    USE mod_orchidee_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                 :: nbpt                    !! Number of points for which the data 
+                                                                          !!   needs to be interpolated
+    INTEGER(i_std), INTENT(in)                 :: Nvariabletypes          !! Number of types of the variable
+    REAL(r_std), DIMENSION(Nvariabletypes),    &                          !! Vector of values of the types
+      INTENT(in)    :: variabletypes                                      !!   (-1, not used)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo                    !! Vector of latitude and longitudes 
+                                                                          !! (beware of the order = 1 : latitude, 
+                                                                          !!   2 : longitude)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution              !! The size in km of each grid-box in X and Y
+    !
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), 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),  INTENT(in)  :: contfrac                !! Fraction of land in each grid box.
+    CHARACTER(LEN=80), INTENT(in)              :: filename                !! name of the input map to read
+
+    CHARACTER(LEN=80), INTENT(in)              :: varname                 !! name of the variable to interpolate
+    CHARACTER(LEN=80), INTENT(in)              :: inlonname, inlatname    !! names of the longitude and latitude
+    REAL(r_std), INTENT(inout)                 :: varmin, varmax          !! min/max values to use for the
+                                                                          !!   renormalization
+! Transformations to apply to the original read values from the file
+    LOGICAL, INTENT(in)                        :: noneg                   !! no negative values
+    CHARACTER(LEN=50), INTENT(in)              :: masktype                !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below maskvalues(1)
+                                                                          !!   'mabove': take values above maskvalues(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      maskvalues(2) <= SUM(vals(k)) <= maskvalues(1)
+                                                                          !!      maskvalues(1) < SUM(vals(k)) <= maskvalues(3)
+                                                                          !!        (normalized by maskvalues(3))
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)      :: maskvalues              !! values to use to mask (according to 
+                                                                          !!   `masktype') 
+    CHARACTER(LEN=250), INTENT(in)             :: maskvarname             !! name of the variable to use to mask 
+    INTEGER(i_std), INTENT(in)                 :: dim1, dim2              !! 4D complementary dimension sizes
+    CHARACTER(LEN=50), INTENT(in)              :: typefrac                !! Type of fraction retrieval:
+                                                                          !!   'default': standard
+
+    INTEGER(i_std), INTENT(in)                 :: initime                 !! Initial time to take (for input data 
+                                                                          !!   with time values, -1 not used)
+    REAL(r_std), INTENT(in)                    :: maxresollon,maxresollat !! lon,lat maximum resolutions (in m)
+                                                                          !!   (-un, not used)
+    !! 0.2 Modified variables
+    !
+    !! 0.3 output variables
+    !
+    REAL(r_std), DIMENSION(nbpt), INTENT(out) :: outvar1D                 !! 1D output variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: aoutvar                 !! availability of input data to
+                                                                          !!   interpolate output variable 
+                                                                          !!   (on the nbpt space)
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                             :: iml, jml, lml, tml, fid, ib, ip, jp, it, jj, jv
+    INTEGER                                    :: inNdims                 !! Number of dimensions of the input data
+    INTEGER                                    :: inNLldims               !! Number of dimensions of the lon/lat input data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: lat_in, lon_in          !! latitude and
+                                                                          !! longitude, extract from input map
+    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(:)       :: invar1D               !! 1D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: invar2D               !! 2D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: invar3D               !! 3D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: invar4D               !! 4D input values
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: resol_in
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)    :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: maskvar
+    INTEGER(i_std)                             :: nix, njx
+    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 
+    CHARACTER(LEN=50)                          :: S1
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: variableusetypes
+    CHARACTER(LEN=256)                         :: msg
+    INTEGER, DIMENSION(:), ALLOCATABLE         :: indims
+
+! Debug vars
+    INTEGER                                    :: nb_coord, nb_var, nb_gat
+
+
+!_ ================================================================================================================================
+! Allocating input data
+
+    IF (printlev >= 3) WRITE(numout,*)"In interpweight_1D filename: ",TRIM(filename),          &
+      " varname:'" // TRIM(varname) // "'"
+    
+    IF (is_root_prc) THEN
+       IF (printlev >=5) THEN
+          WRITE(numout,*) "Entering 'interpweight_1D'. Debug mode."
+          WRITE(numout,*)'(/," --> fliodmpf")'
+          CALL fliodmpf (TRIM(filename))
+          WRITE(numout,*)'(/," --> flioopfd")'
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (printlev >=5) THEN
+          WRITE (numout,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (numout,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (numout,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+
+! Getting shape of input variable from input file
+    inNdims = interpweight_get_varNdims_file(filename, varname)
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+
+    InputDims: SELECT CASE (inNdims)
+      CASE (1)
+        CALL bcast(iml)
+
+        ALLOCATE(invar1D(iml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, 0, 0, 0, 1, 1, invar1D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_1D input data dimensions _______'
+          WRITE(numout,*)'    iml:',iml
+        END IF
+
+      CASE DEFAULT
+        WRITE (S1,'(I3)') inNdims
+        CALL ipslerr_p(3,'interpweight_1D',"Input number of dimensions: '" // TRIM(S1) // "' not ready !!", &
+          '','')
+
+    END SELECT InputDims
+    CALL bcast(invar1D)
+
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_1D getting variable ended!'
+
+! Getting longitudes/latitudes from input file
+    inNLldims = interpweight_get_varNdims_file(filename, inlonname)
+    
+    IF (inNLldims == 1) THEN
+      ! Allocate memory for latitudes
+      ALLOCATE(lon_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variable lon_in','','')
+
+      ALLOCATE(lat_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variable lat_in','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, 0, 0, 0, 1, 1, lon_in)
+        CALL flinget(fid, TRIM(inlatname), iml, 0, 0, 0, 1, 1, lat_in)
+      ENDIF
+
+    END IF
+    CALL bcast(lon_in)
+    CALL bcast(lat_in)
+
+    IF (noneg) THEN
+      IF (is_root_prc) THEN
+        SELECT CASE (inNdims)
+          CASE(1)
+            CALL interpweight_modifying_input1D(iml, 0, 0, 0, 1, 1, zero, invar1D)
+        END SELECT       
+      END IF
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_1D modifying input ended!'
+
+    IF (is_root_prc) CALL flinclo(fid)
+
+    !
+    ! Consider all points a priori
+    !
+    ALLOCATE(mask(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variable mask','','')
+    mask = zero
+
+    IF (TRIM(masktype) == 'var') THEN
+      ALLOCATE(maskvar(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variable maskvar','','')
+      maskvar = zero
+! Reads the mask from the file
+      IF (is_root_prc) THEN
+! ATTTENTION!! One can not use flinget in this way. It always spect to have a REAL variable!
+        CALL flinget(fid, TRIM(maskvarname), iml, 0, 0, 0, 1, 1, maskvar)
+        WHERE (maskvar > zero)
+          mask = un 
+        END WHERE
+      END IF
+      CALL bcast(mask)
+    ELSE
+      SELECT CASE (inNdims)
+        CASE(1)
+          CALL interpweight_masking_input1D(iml, 0, 0, 0, 0, 0, masktype, maskvalues, invar1D,        &
+            mask)
+      END SELECT
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_1D masking input ended!'
+
+    ! Computation of nbvmax
+    ! In 'condveg_soilalb, slowproc_update' nbvmax=200
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+      IF ( (maxresollon /= -un) .AND. (maxresollat /= -un) ) THEN
+!       Assuming regular lon/lat projection for the input data but it is not caluclated assuming a maximum  &
+!         lon,lat resolution given as input paramater
+         nix=INT(MAXVAL(resolution(:,1))/maxresollon)+2
+         njx=INT(MAXVAL(resolution(:,2))/maxresollat)+2
+      ELSE
+!       Assuming regular lon/lat projection for the input data
+        CALL interpweight_calc_resolution_in(lon_in, lat_in, iml, jml, mincos, R_Earth, pi, resol_in)
+        nix=INT(MAXVAL(resolution(:,1))/MAXVAL(resol_in(:,:,1)))+2
+        njx=INT(MAXVAL(resolution(:,2))/MAXVAL(resol_in(:,:,2)))+2
+      END IF
+      nbvmax = MAX(nix*njx, 200)
+    END IF  
+    CALL bcast(nbvmax)
+    CALL bcast(nix)
+    CALL bcast(njx)
+
+    !
+    callsign = TRIM(varname) // ' map'
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       IF (printlev>=3) WRITE(numout,*) "Projection arrays for ",callsign," : "
+       IF (printlev>=3) WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+
+       ALLOCATE(sub_index(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variable sub_index','','')
+
+       sub_index(:,:)=zero
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variable sub_area','','')
+
+       sub_area(:,:)=zero
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LON:', MINVAL(lon_in), MAXVAL(lon_in)
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LAT:', MINVAL(lat_in), MAXVAL(lat_in)
+
+       !
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac,  &
+            &                iml, lon_in, lat_in, maxresollon, maxresollat, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       !
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+    IF (printlev>=4) WRITE (numout,*) '  interpweight_1D: read/allocate OK'
+
+! Getting variables thresholds
+    ALLOCATE(variableusetypes(Nvariabletypes), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variableusetypes','','')
+
+    IF (variabletypes(1) == -un) THEN
+      variableusetypes = (/ (ip*1., ip=1,Nvariabletypes) /)
+      IF (printlev>=4) WRITE(numout,*) 'interpweight_1D: Note: Using default ',&
+           'equivalence between dimension in the file and dimension in the variable, for file ', filename
+      varmin = 1._r_std
+      varmax = Nvariabletypes*1._r_std
+    ELSE
+      variableusetypes = variabletypes    
+    END IF
+
+    outvar1D = zero
+
+! Providing the fractions of each type for each interpolated grid point
+    CALL interpweight_provide_fractions1D(typefrac, nbpt, Nvariabletypes, variableusetypes,           &
+      iml, jml, lml, tml, nbvmax, zero, invar1D, sub_area, sub_index, varmax, varmin,                 &
+      deux, lalo, outvar1D, aoutvar)
+    IF (printlev>=5) WRITE (numout,*)'  interpweight_1D end of interp_provide_fractions1D'
+
+    IF (printlev>=3) THEN
+       IF (COUNT(aoutvar == -1) >= AINT(nbpt*0.4)) THEN
+          WRITE(numout,*) '  interpweight_1D total number of points: ', nbpt
+          WRITE(numout,*) '  interpweight_1D interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' non-interpolated: ', COUNT(aoutvar == -1)
+          msg = "Less than 60% of points '" // TRIM(filename) // "' variable '" // TRIM(varname) //       & 
+               "' have been succesfully interpolated !!"
+          WRITE(numout,*) '  interpweight_1D: ' // TRIM(msg)
+       ELSE
+          msg = TRIM(filename) // "' variable: '" // TRIM(varname) // "' interpolation Done _______"
+          WRITE(numout,*) "  interpweight_1D: '" // TRIM(msg)
+          WRITE(numout,*) '  interpweight_1D total number of points: ', nbpt
+          WRITE(numout,*) '  interpweight_1D interpolated: ', COUNT(aoutvar /= -1),               &
+               ' non-interpolated: ', COUNT(aoutvar == -1)
+       END IF
+    END IF
+
+! Scaling to 1 the quality variable
+    DO ip=1, nbpt
+      IF (aoutvar(ip) /= -1) aoutvar(ip) = aoutvar(ip)/(resolution(ip,1)*resolution(ip,2))/contfrac(ip)
+    END DO
+
+    IF (ALLOCATED(lon_in)) DEALLOCATE(lon_in)
+    IF (ALLOCATED(lat_in)) DEALLOCATE(lat_in)
+    IF (ALLOCATED(invar1D)) DEALLOCATE(invar1D)
+    DEALLOCATE(mask)
+    IF (ALLOCATED(maskvar)) DEALLOCATE(maskvar)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(sub_index)
+
+    RETURN
+
+  END SUBROUTINE interpweight_1D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_2D
+!!
+!>\BRIEF        ! Interpolate any input file to the grid of the model for a 2D-variable  
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): outvar2D, aoutvar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_2D(nbpt, Nvariabletypes, variabletypes, lalo, resolution, neighbours,       &
+    contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype,               &
+    maskvalues, maskvarname, dim1, dim2, initime, typefrac,                                           & 
+    maxresollon, maxresollat, outvar2D, aoutvar)
+
+    USE ioipsl
+    USE constantes_var
+    USE mod_orchidee_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                 :: nbpt                    !! Number of points for which the data 
+                                                                          !!   needs to be interpolated
+    INTEGER(i_std), INTENT(in)                 :: Nvariabletypes          !! Number of types of the variable
+    REAL(r_std), DIMENSION(Nvariabletypes),    &                          !! Vector of values of the types
+      INTENT(in)    :: variabletypes                                      !!   (-1, not used)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo                    !! Vector of latitude and longitudes 
+                                                                          !! (beware of the order = 1 : latitude, 
+                                                                          !!   2 : longitude)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution              !! The size in km of each grid-box in X and Y
+    !
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), 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),  INTENT(in)  :: contfrac                !! Fraction of land in each grid box.
+    CHARACTER(LEN=80), INTENT(in)              :: filename                !! name of the input map to read
+
+    CHARACTER(LEN=80), INTENT(in)              :: varname                 !! name of the variable to interpolate
+    CHARACTER(LEN=80), INTENT(in)              :: inlonname, inlatname    !! names of the longitude and latitude
+    REAL(r_std), INTENT(inout)                 :: varmin, varmax          !! min/max values to use for the
+                                                                          !!   renormalization
+! Transformations to apply to the original read values from the file
+    LOGICAL, INTENT(in)                        :: noneg                   !! no negative values
+    CHARACTER(LEN=50), INTENT(in)              :: masktype                !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below maskvalues(1)
+                                                                          !!   'mabove': take values above maskvalues(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      maskvalues(2) <= SUM(vals(k)) <= maskvalues(1)
+                                                                          !!      maskvalues(1) < SUM(vals(k)) <= maskvalues(3)
+                                                                          !!        (normalized by maskvalues(3))
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)      :: maskvalues              !! values to use to mask (according to 
+                                                                          !!   `masktype') 
+    CHARACTER(LEN=250), INTENT(in)             :: maskvarname             !! name of the variable to use to mask 
+    CHARACTER(LEN=50), INTENT(in)              :: typefrac                !! Type of fraction retrieval:
+                                                                          !!   'default': standard
+    INTEGER(i_std), INTENT(in)                 :: dim1, dim2              !! 4D complementary dimension sizes
+    INTEGER(i_std), INTENT(in)                 :: initime                 !! Initial time to take (for input data 
+                                                                          !!   with time values, -1 not used)
+    REAL(r_std), INTENT(in)                    :: maxresollon,maxresollat !! lon,lat maximum resolutions (in m)
+    !! 0.2 Modified variables
+    !
+    !  0.3 OUTPUT
+    !
+!    REAL(r_std), INTENT(out)                   ::  laimap(nbpt,nvm,12)    !! lai read variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt),  INTENT(out) :: outvar2D          !! 2D output variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: aoutvar                 !! availability of input data to
+                                                                          !!   interpolate output variable 
+                                                                          !!   (on the nbpt space)
+    !
+    !  0.4 LOCAL
+    !
+    INTEGER(i_std)                             :: iml, jml, lml, tml, fid, ib, ip, jp, it, jj, jv
+    INTEGER                                    :: inNdims                 !! Number of dimensions of the input data
+    INTEGER                                    :: inNLldims               !! Number of dimensions of the lon/lat input data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: lat_in, lon_in          !! latitude and
+                                                                          !! longitude, extract from input 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(:)       :: invar1D               !! 1D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: invar2D               !! 2D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: invar3D               !! 3D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: invar4D               !! 4D input values
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: resol_in
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: maskvar
+    INTEGER(i_std)                             :: nix, njx
+    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 
+    CHARACTER(LEN=50)                          :: S1
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: variableusetypes
+    CHARACTER(LEN=256)                         :: msg
+    INTEGER, DIMENSION(:), ALLOCATABLE         :: indims
+
+! Debug vars
+    INTEGER                                    :: nb_coord, nb_var, nb_gat
+
+
+!_ ================================================================================================================================
+! Allocating input data
+
+    IF (printlev >= 3) WRITE(numout,*)"In interpweight_2D filename: ",TRIM(filename),          &
+      " varname:'" // TRIM(varname) // "'"
+    !
+    IF (is_root_prc) THEN
+       IF (printlev >=5) THEN
+          WRITE(numout,*) "Entering 'interpweight_2D'. Debug mode."
+          WRITE(numout,*)'(/," --> fliodmpf")'
+          CALL fliodmpf (TRIM(filename))
+          WRITE(numout,*)'(/," --> flioopfd")'
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (printlev >=5) THEN
+          WRITE (numout,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (numout,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (numout,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+
+! Getting shape of input variable from input file
+    inNdims = interpweight_get_varNdims_file(filename, varname)
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+    
+    ! Read variable (varname) from input file
+    InputDims: SELECT CASE (inNdims)
+      CASE (2)
+        CALL bcast(iml)
+        CALL bcast(jml)
+
+        ALLOCATE(invar2D(iml,jml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, 0, 0, 1, 1, invar2D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_2D input data dimensions: '
+          WRITE(numout,*)'    iml, jml:',iml, jml
+        END IF
+
+      CASE (3)
+        ALLOCATE(indims(3), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of indims','','')
+        indims = interpweight_get_var3dims_file(filename, varname)
+
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+
+        ALLOCATE(invar3D(iml,jml, lml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, 0, 1, 1, invar3D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_2D input data dimensions:'
+          WRITE(numout,*)'    iml, jml, lml:',iml, jml, lml
+        END IF
+
+      CASE (4)
+        ALLOCATE(indims(4), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of indims','','')
+        indims = interpweight_get_var4dims_file(filename, varname)
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+!       Taken from `slowproc_update'
+        IF (initime /= -1) THEN
+          inNdims = 3
+          IF (printlev >= 3)  WRITE(numout,*) &
+               'interpweight_2D: taking into account the initial reading time:',initime
+          IF (initime <= 0) tml = 0
+
+          CALL bcast(tml)
+          ALLOCATE(invar3D(iml,jml,lml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF ( initime > 0 ) THEN
+            IF (is_root_prc) THEN
+              IF (initime <= tml) THEN
+                 CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, initime, 1, invar3D)
+              ELSE
+                 CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, tml, 1, invar3D)
+              ENDIF
+            ENDIF
+          ELSE
+            IF (is_root_prc) THEN
+              CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, 1, 1, invar3D)
+            ENDIF
+          ENDIF
+        ELSE
+          CALL bcast(tml)
+          ALLOCATE(invar4D(iml,jml,lml,tml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, tml, 1, tml, invar4D)
+        END IF
+
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_2D input data dimensions'
+          WRITE(numout,*)'    iml, jml, lml, tml :',iml, jml, lml, tml
+        END IF
+
+      CASE DEFAULT
+        WRITE (S1,'(I3)') inNdims
+        CALL ipslerr_p(3,'interpweight_2D',"Input number of dimensions: '" // TRIM(S1) // "' not ready !!", &
+          '','')
+
+    END SELECT InputDims
+    CALL bcast(invar2D)
+
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2D getting variable ended!'
+
+! Getting longitudes/latitudes from input file
+    inNLldims = interpweight_get_varNdims_file(filename, inlonname)
+    
+    IF (inNLldims == 1) THEN
+      ! Allocate memory for latitudes
+      ALLOCATE(lon_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable lon_in','','')
+
+      ALLOCATE(lat_in(jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable lat_in','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, 0, 0, 0, 1, 1, lon_in)
+        CALL flinget(fid, TRIM(inlatname), jml, 0, 0, 0, 1, 1, lat_in)
+      ENDIF
+      CALL bcast(lon_in)
+      CALL bcast(lat_in)
+
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable lon','','')
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable lat','','')
+
+      DO ip=1,iml
+         lat(ip,:) = lat_in(:)
+      ENDDO
+      DO jp=1,jml
+         lon(:,jp) = lon_in(:)
+      ENDDO
+    ELSE
+      ! Allocate memory for longitude
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Pb in allocation for lon','','')
+      ! Allocate memory for latitudes
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Pb in allocation for lat','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, jml, 0, 0, 1, 1, lon)
+        CALL flinget(fid, TRIM(inlatname), iml, jml, 0, 0, 1, 1, lat)
+      ENDIF
+    END IF
+    CALL bcast(lon)
+    CALL bcast(lat)
+
+    IF (is_root_prc) THEN
+      ALLOCATE(resol_in(iml,jml,2), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable resol_in','','')
+    END IF
+
+    IF (noneg) THEN
+      IF (is_root_prc) THEN
+        SELECT CASE (inNdims)
+          CASE(2)
+            CALL interpweight_modifying_input2D(iml, jml, 0, 0, 1, 1, zero, invar2D)
+          CASE(3)
+            CALL interpweight_modifying_input3D(iml, jml, lml, 0, 1, 1, zero, invar3D)
+          CASE(4)
+            CALL interpweight_modifying_input4D(iml, jml, lml, tml, 1, tml, zero, invar4D)
+        END SELECT       
+      END IF
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2D modifying input ended!'
+
+    !
+    ! Consider all points a priori
+    !
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable mask','','')
+    mask = zero
+
+    IF (TRIM(masktype) == 'var') THEN
+      ALLOCATE(maskvar(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable maskvar','','')
+      maskvar(:,:) = 0
+! Reads the mask from the file
+      IF (is_root_prc) THEN
+! ATTTENTION!! One can not use flinget in this way. It always spect to have a REAL variable!
+        CALL flinget(fid, TRIM(maskvarname), iml, jml, 0, 0, 1, 1, maskvar)
+        WHERE (maskvar > zero)
+          mask = un 
+        END WHERE
+      END IF
+      CALL bcast(mask)
+    ELSE
+      ! Create land-sea mask based on values from the variable according to maskvalues and masktype
+      SELECT CASE (inNdims)
+        CASE(2)
+          CALL interpweight_masking_input2D(iml, jml, 0, 0, 0, 0, masktype, maskvalues, invar2D,      &
+            mask)
+        CASE(3)
+          CALL interpweight_masking_input3D(iml, jml, 0, 0, lml, 0, masktype, maskvalues, invar3D,    &
+            mask)
+        CASE(4)
+          CALL interpweight_masking_input4D(iml, jml, 0, 0, lml, tml, masktype, maskvalues, invar4D,  &
+            mask)
+      END SELECT
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2D masking input ended!'
+
+    IF (is_root_prc) CALL flinclo(fid)
+
+! Assuming regular lon/lat projection for the input data
+    IF (is_root_prc) THEN
+      CALL interpweight_calc_resolution_in(lon, lat, iml, jml, mincos, R_Earth, pi, resol_in)
+    END IF
+
+    ! Computation of nbvmax
+    ! In 'condveg_soilalb, slowproc_update' nbvmax=200
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+      IF ( (maxresollon /= -un) .AND. (maxresollat /= -un) ) THEN
+!       Assuming regular lon/lat projection for the input data but it is not caluclated assuming a maximum  &
+!         lon,lat resolution given as input paramater
+         nix=INT(MAXVAL(resolution(:,1))/maxresollon)+2
+         njx=INT(MAXVAL(resolution(:,2))/maxresollat)+2
+      ELSE
+!       Assuming regular lon/lat projection for the input data
+        CALL interpweight_calc_resolution_in(lon, lat, iml, jml, mincos, R_Earth, pi, resol_in)
+        nix=INT(MAXVAL(resolution(:,1))/MAXVAL(resol_in(:,:,1)))+2
+        njx=INT(MAXVAL(resolution(:,2))/MAXVAL(resol_in(:,:,2)))+2
+      END IF
+      nbvmax = MAX(nix*njx, 200)
+    END IF  
+    CALL bcast(nbvmax)
+    CALL bcast(nix)
+    CALL bcast(njx)
+
+    !
+    callsign = TRIM(varname) // ' map'
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       IF (printlev>=3) WRITE(numout,*) "Projection arrays for ",callsign," : "
+       IF (printlev>=3) WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+
+       ALLOCATE(sub_index(nbpt, nbvmax, 2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable sub_index','','')
+
+       sub_index(:,:,:)=zero
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable sub_area','','')
+
+       sub_area(:,:)=zero
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LON:', MINVAL(lon), MAXVAL(lon)
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LAT:', MINVAL(lat), MAXVAL(lat)
+
+       !
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon, lat, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       !
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+    IF (printlev>=4) WRITE (numout,*) '  interpweight_2D: read/allocate OK'
+
+! Getting variables thresholds
+    ALLOCATE(variableusetypes(Nvariabletypes), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variableusetypes','','')
+    
+
+    IF (variabletypes(1) == -un) THEN
+      variableusetypes = (/ (ip*1., ip=1,Nvariabletypes) /)
+      IF (printlev>=4) THEN
+         WRITE(numout,*)'  interpweight_2D: Note: Using default equivalence between dimension ',&
+              'in the file and dimension in the variable, for file ', filename
+      END IF
+      varmin = 1._r_std
+      varmax = Nvariabletypes*1._r_std
+    ELSE
+      variableusetypes = variabletypes    
+    END IF
+
+    outvar2D = zero
+
+! Providing the fractions of each type for each interpolated grid point
+    CALL interpweight_provide_fractions2D(typefrac, nbpt, Nvariabletypes, variableusetypes,           &
+      iml, jml, lml, tml, nbvmax, zero, invar2D, sub_area, sub_index, varmax, varmin,                 &
+      deux, lalo, outvar2D, aoutvar)
+    IF (printlev>=5) WRITE (numout,*)'  interpweight_2D end of provide_fractions2D'
+
+    IF (printlev>=3) THEN
+       IF (COUNT(aoutvar == -1) >= AINT(nbpt*0.4)) THEN
+          WRITE(numout,*) '  interpweight_2D total number of points: ', nbpt
+          WRITE(numout,*) '  interpweight_2D interpolated: ', COUNT(aoutvar /= -1),                   &
+               ' non-interpolated: ', COUNT(aoutvar == -1)
+          msg = "Less than 60% of points '" // TRIM(filename) // "' variable '" // TRIM(varname) //       & 
+               "' have been succesfully interpolated !!"
+          WRITE(numout,*) '  interpweight_2D: ' // TRIM(msg)
+       ELSE
+          msg = TRIM(filename) // "' variable: '" // TRIM(varname) // "' interpolation Done _______"
+          WRITE(numout,*) "interpweight_2D: '" // TRIM(msg)
+          WRITE(numout,*) '  Total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+       END IF
+    END IF
+
+! Scaling to 1 the quality variable
+    DO ip=1, nbpt
+      IF (aoutvar(ip) /= -1) aoutvar(ip) = aoutvar(ip)/(resolution(ip,1)*resolution(ip,2))/contfrac(ip)
+    END DO
+
+    IF (ALLOCATED(lon_in)) DEALLOCATE(lon_in)
+    IF (ALLOCATED(lat_in)) DEALLOCATE(lat_in)
+    DEALLOCATE(lon)
+    DEALLOCATE(lat)
+    IF (ALLOCATED(invar2D)) DEALLOCATE(invar2D)
+    IF (ALLOCATED(invar3D)) DEALLOCATE(invar3D)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(invar4D)
+    DEALLOCATE(mask)
+    IF (ALLOCATED(maskvar)) DEALLOCATE(maskvar)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(sub_index)
+    IF (ALLOCATED(resol_in)) DEALLOCATE(resol_in)
+
+    RETURN
+
+  END SUBROUTINE interpweight_2D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_3D
+!!
+!>\BRIEF        ! Interpolate any input file to the grid of the model for a 3D-variable  
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): outvar3D, aoutvar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_3D(nbpt, Nvariabletypes, variabletypes, lalo, resolution, neighbours,       &
+    contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype,               &
+    maskvalues, maskvarname, dim1, dim2, initime, typefrac,                                           &
+    maxresollon, maxresollat, outvar3D, aoutvar)
+
+    USE ioipsl
+    USE constantes_var
+    USE mod_orchidee_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)                 :: nbpt                    !! Number of points for which the data 
+                                                                          !!   needs to be interpolated
+    INTEGER(i_std), INTENT(in)                 :: Nvariabletypes          !! Number of types of the variable
+    REAL(r_std), DIMENSION(Nvariabletypes),    &                          !! Vector of values of the types
+      INTENT(in)    :: variabletypes                                      !!   (-1, not used)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo                    !! Vector of latitude and longitudes 
+                                                                          !! (beware of the order = 1 : latitude, 
+                                                                          !!   2 : longitude)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution              !! The size in km of each grid-box in X and Y
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), 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), INTENT(in)   :: contfrac                !! Fraction of land in each grid box.
+    CHARACTER(LEN=80), INTENT(in)              :: filename                !! name of the input map to read
+
+    CHARACTER(LEN=80), INTENT(in)              :: varname                 !! name of the variable to interpolate
+    CHARACTER(LEN=80), INTENT(in)              :: inlonname, inlatname    !! names of the longitude and latitude
+                                                                          !!   in the input file
+! Transformations to apply to the original read values from the file
+    LOGICAL, INTENT(in)                        :: noneg                   !! no negative values
+    CHARACTER(LEN=50), INTENT(in)              :: masktype                !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below maskvalues(1)
+                                                                          !!   'mabove': take values above maskvalues(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      maskvalues(2) <= SUM(vals(k)) <= maskvalues(1)
+                                                                          !!      maskvalues(1) < SUM(vals(k)) <= maskvalues(3)
+                                                                          !!        (normalized by maskvalues(3))
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)      :: maskvalues              !! values to use to mask (according to 
+                                                                          !!   `masktype') 
+    CHARACTER(LEN=250), INTENT(in)             :: maskvarname             !! name of the variable to use to mask 
+    INTEGER, INTENT(in)                        :: dim1, dim2              !! 3/4D dimensions of the output variable
+    REAL(r_std), DIMENSION(dim1), INTENT(inout) :: varmin, varmax          !! min/max values to use for the renormalization
+    CHARACTER(LEN=50), INTENT(in)              :: typefrac                !! Type of fraction retrieval:
+                                                                          !!   'default': standard
+    INTEGER(i_std), INTENT(in)                 :: initime                 !! Initial time to take (for input data 
+                                                                          !!   with time values, -1 not used)
+    REAL(r_std), INTENT(in)                    :: maxresollon,maxresollat !! lon,lat maximum resolutions (in m)
+                                                                          !!   (-un, not used)
+    !! 0.2 Modified variables
+    !
+    !  0.3 OUTPUT
+    !
+    REAL(r_std), DIMENSION(nbpt,dim1), INTENT(out) :: outvar3D            !! 3D output variable and re-dimensioned
+! aovar: availability of input data to interpolate output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: aoutvar                 !! availability of input data to
+                                                                          !!   interpolate output variable 
+                                                                          !!   (on the nbpt space)
+    !
+    !  0.4 Local variables
+    !
+    INTEGER(i_std)                             :: iml, jml, lml, tml, fid, ib, ip, jp, it, jj, jv
+    INTEGER                                    :: inNdims                 !! Number of dimensions of the input data
+    INTEGER                                    :: inNLldims               !! Number of dimensions of the lon/lat input data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: lat_in, lon_in          !! latitude and
+                                                                          !! longitude, extract from input 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(:)       :: invar1D               !! 1D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: invar2D               !! 2D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: invar3D               !! 3D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: invar4D               !! 4D input values
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: resol_in
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: maskvar
+    INTEGER(i_std)                             :: nix, njx
+    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 
+
+    CHARACTER(LEN=50)                          :: S1
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: variableusetypes
+    CHARACTER(LEN=256)                         :: msg
+
+! Debug vars
+    INTEGER                                    :: nb_coord, nb_var, nb_gat
+    CHARACTER(LEN=5)                           :: iS
+    CHARACTER(LEN=50)                          :: suminS
+
+    INTEGER, ALLOCATABLE, DIMENSION(:)         :: indims
+
+
+!_ ================================================================================================================================
+    IF (printlev >= 3) WRITE(numout, *)"In interpweight_3D filename: ",TRIM(filename),         &
+      " varname:'" // TRIM(varname) // "'"
+! Allocating input data
+    IF (is_root_prc) THEN
+       IF (printlev >=5) THEN
+          WRITE(numout,*) "Entering 'interpweight_3D'. Debug mode."
+          WRITE(numout,*)'(/," --> fliodmpf")'
+          CALL fliodmpf (TRIM(filename))
+          WRITE(numout,*)'(/," --> flioopfd")'
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (printlev >=5) THEN
+          WRITE (numout,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (numout,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (numout,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+
+! Getting shape of input variable from input file
+    inNdims = interpweight_get_varNdims_file(filename, varname)
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+
+    InputDims: SELECT CASE (inNdims)
+      CASE (2)
+        CALL bcast(iml)
+        CALL bcast(jml)
+
+        ALLOCATE(invar2D(iml,jml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, 0, 0, 1, 1, invar2D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_3D input data dimensions'
+          WRITE(numout,*)'    iml, jml:',iml, jml
+        END IF
+
+      CASE (3)
+        ALLOCATE(indims(3), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of indims','','')
+        indims = interpweight_get_var3dims_file(filename, varname)
+
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+
+        ALLOCATE(invar3D(iml,jml, lml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','') 
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, 0, 2, 1, invar3D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_3D input data dimensions'
+          WRITE(numout,*)'    iml, jml, lml :',iml, jml, lml
+        END IF
+
+      CASE (4)
+        ALLOCATE(indims(4), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of indims','','')
+        
+        indims = interpweight_get_var4dims_file(filename, varname)
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+!       Taken from `slowproc_update'
+        IF (initime /= -1) THEN
+          inNdims = 3
+          IF (printlev >= 3) WRITE (numout,*) &
+               'interpweight_3D: taking into account the initial reading time:',initime
+          IF (initime <= 0) tml = 0
+
+          CALL bcast(tml)
+          ALLOCATE(invar3D(iml,jml,lml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable invar3D','','')
+          IF ( initime > 0 ) THEN
+            IF (is_root_prc) THEN
+              IF (initime <= tml) THEN
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, initime, 1, invar3D)
+              ELSE
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, tml, 1, invar3D)
+              ENDIF
+            ENDIF
+          ELSE
+            IF (is_root_prc) THEN
+              CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, 1, 1, invar3D)
+            ENDIF
+          ENDIF
+        ELSE
+          CALL bcast(tml)
+          ALLOCATE(invar4D(iml,jml,lml,tml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable invar4D','','')
+          IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, tml, 1, tml, invar4D)
+        END IF
+
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_3D input data dimensions'
+          WRITE(numout,*)'    iml, jml, lml, tml:',iml, jml, lml, tml
+        END IF
+
+      CASE DEFAULT
+        WRITE (S1,'(I3)') inNdims
+        CALL ipslerr_p(3,'interpweight_3D',"Input number of dimensions: '" // TRIM(S1) // "' not ready !!", &
+          '','')
+
+    END SELECT InputDims
+    CALL bcast(invar3D)
+  
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_3D getting variable ended!'
+! Test lecture
+    DO ip=1,lml
+      IF ( SUM(invar3D(:,:,ip)) < 0.00001 ) THEN
+        WRITE(iS, '(i5)')ip 
+        WRITE(suminS, '(f20.10)')SUM(invar3d(:,:,ip)) 
+        msg = 'Wrong lecture of data for type ' // TRIM(iS) // ' all values are zero !!'
+        CALL ipslerr_p(3,'interpweight_3D',TRIM(msg),'','')
+      END IF
+    END DO
+
+! Getting longitudes/latitudes from input file
+    inNLldims = interpweight_get_varNdims_file(filename, inlonname)
+    IF (inNLldims == 1) THEN
+      ! Allocate memory for latitudes
+      ALLOCATE(lon_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable lon_in','','')
+
+      ALLOCATE(lat_in(jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable lat_in','','')
+
+      IF (is_root_prc) THEN
+        CALL flininspect(fid)
+        CALL flinget(fid, TRIM(inlonname), iml, 0, 0, 0, 1, 1, lon_in)
+        CALL flinget(fid, TRIM(inlatname), jml, 0, 0, 0, 1, 1, lat_in)
+      ENDIF
+      CALL bcast(lon_in)
+      CALL bcast(lat_in)
+
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable lon','','')
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable lat','','')
+
+      DO ip=1,iml
+         lat(ip,:) = lat_in(:)
+      ENDDO
+      DO jp=1,jml
+         lon(:,jp) = lon_in(:)
+      ENDDO
+    ELSE
+      ! Allocate memory for longitude
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Pb in allocation for lon','','')
+      ! Allocate memory for latitudes
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Pb in allocation for lat','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, jml, 0, 0, 1, 1, lon)
+        CALL flinget(fid, TRIM(inlatname), iml, jml, 0, 0, 1, 1, lat)
+      ENDIF
+    END IF
+    CALL bcast(lon)
+    CALL bcast(lat)
+
+    ALLOCATE(resol_in(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable resol_in','','')
+
+    IF (noneg) THEN
+      IF (is_root_prc) THEN
+        SELECT CASE (inNdims)
+          CASE(2)
+            CALL interpweight_modifying_input2D(iml, jml, 0, 0, 1, 1, zero, invar2D)
+          CASE(3)
+            CALL interpweight_modifying_input3D(iml, jml, lml, 0, 1, 1, zero, invar3D)
+          CASE(4)
+            CALL interpweight_modifying_input4D(iml, jml, lml, tml, 1, tml, zero, invar4D)
+        END SELECT       
+      END IF
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_3D modifying input ended!'
+
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable mask','','')
+    mask(:,:) = 0
+
+    IF (TRIM(masktype) == 'var') THEN
+      ALLOCATE(maskvar(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable maskvar','','')
+      maskvar(:,:) = 0.
+! Reads the mask from the file
+      IF (is_root_prc) THEN
+! ATTTENTION!! One can not use flinget in this way. It always spect to have a REAL variable!
+        CALL flinget(fid, TRIM(maskvarname), iml, jml, 0, 0, 1, 1, maskvar)
+        WHERE (maskvar > zero)
+          mask = un 
+        END WHERE
+      END IF
+      CALL bcast(mask)
+    ELSE
+      SELECT CASE (inNdims)
+        CASE(2)
+          CALL interpweight_masking_input2D(iml, jml, 0, 0, 0, 0, masktype, maskvalues, invar2D,      &
+            mask)
+        CASE(3)
+          CALL interpweight_masking_input3D(iml, jml, 0, 0, lml, 0, masktype, maskvalues, invar3D,    &
+            mask)
+        CASE(4)
+          CALL interpweight_masking_input4D(iml, jml, 0, 0, lml, tml, masktype, maskvalues, invar4D,  &
+            mask)
+      END SELECT
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_3D masking input ended!'
+
+    IF (is_root_prc) CALL flinclo(fid)
+
+    ! Computation of nbvmax
+    ! In 'condveg_soilalb, slowproc_update' nbvmax=200
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+      IF ( (maxresollon /= -un) .AND. (maxresollat /= -un) ) THEN
+!       Assuming regular lon/lat projection for the input data but it is not caluclated assuming a maximum  &
+!         lon,lat resolution given as input paramater
+         nix=INT(MAXVAL(resolution(:,1))/maxresollon)+2
+         njx=INT(MAXVAL(resolution(:,2))/maxresollat)+2
+      ELSE
+!       Assuming regular lon/lat projection for the input data
+        CALL interpweight_calc_resolution_in(lon, lat, iml, jml, mincos, R_Earth, pi, resol_in)
+        nix=INT(MAXVAL(resolution(:,1))/MAXVAL(resol_in(:,:,1)))+2
+        njx=INT(MAXVAL(resolution(:,2))/MAXVAL(resol_in(:,:,2)))+2
+      END IF
+      nbvmax = MAX(nix*njx, 200)
+    END IF  
+    CALL bcast(nbvmax)
+    CALL bcast(nix)
+    CALL bcast(njx)
+
+    !
+    callsign = TRIM(varname) // ' map'
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       IF (printlev>=3) WRITE(numout,*) "Projection arrays for ",callsign," : "
+       IF (printlev>=3) WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+       ALLOCATE(sub_index(nbpt, nbvmax, 2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable sub_index','','')
+
+       sub_index(:,:,:)=zero
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable sub_area','','')
+
+       sub_area(:,:)=zero
+
+       IF (printlev >= 3) THEN
+         WRITE(numout,*) 'interpweight_3D:'
+         WRITE(numout,*) '  Carteveg range LON:', MINVAL(lon), MAXVAL(lon)
+         WRITE(numout,*) '  Carteveg range LAT:', MINVAL(lat), MAXVAL(lat)
+       END IF
+       
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon, lat, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+
+! Getting variables thresholds
+    ALLOCATE(variableusetypes(Nvariabletypes),STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable variableusetypes','','')
+
+    IF (variabletypes(1) == -un) THEN
+      variableusetypes = (/ (ip*1., ip=1,Nvariabletypes) /)
+      IF (printlev>=4) WRITE(numout,*)'interpweight_3D: Note: Using default equivalence between ',&
+           'dimension in the file and dimension in the variable, for file ', filename
+      varmin = 1._r_std
+      varmax = Nvariabletypes*1._r_std
+    ELSE
+      variableusetypes = variabletypes
+    END IF
+    
+    outvar3D = zero
+
+! Providing the fractions of each type for each interpolated grid point
+    CALL interpweight_provide_fractions3D(typefrac, nbpt, Nvariabletypes, variableusetypes,           &
+      iml, jml, lml, tml, nbvmax, zero, invar3D, sub_area, sub_index, varmax, varmin,                 &
+      deux, lalo, outvar3D, aoutvar)
+    IF (printlev >= 5) WRITE(numout,*)'interpweight_3D end of interpweight_provide_fractions3D'
+
+    IF (printlev>=2) THEN
+       IF (COUNT(aoutvar == -1) >= AINT(nbpt*0.4)) THEN
+          WRITE(numout,*) 'interpweight_3D total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+          msg = "Less than 60% of points '" // TRIM(filename) // "' variable '" // TRIM(varname) //       & 
+               "' have been succesfully interpolated on the current process !!"
+          WRITE(numout,*)'   ' // TRIM(msg)
+       ELSE
+          msg = TRIM(filename) // "' variable: '" // TRIM(varname) // "' interpolation Done"
+          WRITE(numout,*) "interpweight_3D: '" // TRIM(msg)
+          WRITE(numout,*) '  Total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+       END IF
+    END IF
+
+! Scaling to 1 the quality variable
+    DO ip=1, nbpt
+      IF (aoutvar(ip) /= -1) aoutvar(ip) = aoutvar(ip)/(resolution(ip,1)*resolution(ip,2))/contfrac(ip)
+    END DO
+
+    IF (ALLOCATED(lat_in)) DEALLOCATE(lat_in)
+    IF (ALLOCATED(lon_in)) DEALLOCATE(lon_in)
+    DEALLOCATE(lon)
+    DEALLOCATE(lat)
+    IF (ALLOCATED(invar2D)) DEALLOCATE(invar2D)
+    IF (ALLOCATED(invar3D)) DEALLOCATE(invar3D)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(invar4D)
+    DEALLOCATE(mask)
+    IF (ALLOCATED(maskvar)) DEALLOCATE(maskvar)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(sub_index)
+    IF (ALLOCATED(resol_in)) DEALLOCATE(resol_in)
+
+    RETURN
+
+  END SUBROUTINE interpweight_3D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_4D
+!!
+!>\BRIEF        ! Interpolate any input file to the grid of the model for a 4D-variable  
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): outvar4D, aoutvar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_4D(nbpt, Nvariabletypes, variabletypes, lalo, resolution, neighbours,       &
+    contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype,               &
+    maskvalues, maskvarname, dim1, dim2, initime, typefrac,                                           &
+    maxresollon, maxresollat, outvar4D, aoutvar)
+
+    USE ioipsl
+    USE constantes_var
+    USE mod_orchidee_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                 :: nbpt                    !! Number of points for which the data 
+                                                                          !!   needs to be interpolated
+    INTEGER(i_std), INTENT(in)                 :: Nvariabletypes          !! Number of types of the variable
+    REAL(r_std), DIMENSION(Nvariabletypes),    &                          !! Vector of values of the types
+      INTENT(in)    :: variabletypes                                      !!   (-1, not used)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo                    !! Vector of latitude and longitudes 
+                                                                          !! (beware of the order = 1 : latitude, 
+                                                                          !!   2 : longitude)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution              !! The size in km of each grid-box in X and Y
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), 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), INTENT(in)   :: contfrac                !! Fraction of land in each grid box.
+    CHARACTER(LEN=80), INTENT(in)              :: filename                !! name of the input map to read
+
+    CHARACTER(LEN=80), INTENT(in)              :: varname                 !! name of the variable to interpolate
+    CHARACTER(LEN=80), INTENT(in)              :: inlonname, inlatname    !! names of the longitude and latitude
+! Transformations to apply to the original read values from the file
+    LOGICAL, INTENT(in)                        :: noneg                   !! no negative values
+    CHARACTER(LEN=50), INTENT(in)              :: masktype                !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below maskvalues(1)
+                                                                          !!   'mabove': take values above maskvalues(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      maskvalues(2) <= SUM(vals(k)) <= maskvalues(1)
+                                                                          !!      maskvalues(1) < SUM(vals(k)) <= maskvalues(3)
+                                                                          !!        (normalized by maskedvalues(3))
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)      :: maskvalues              !! values to use to mask (according to 
+                                                                          !!   `masktype') 
+    CHARACTER(LEN=250), INTENT(in)             :: maskvarname             !! name of the variable to use to mask 
+    INTEGER, INTENT(in)                        :: dim1, dim2              !! 3/4D dimensions of the output variable
+                                                                          !! dim1 = 1 fpr outvar2D
+                                                                          !!   in the input file
+    REAL(r_std), DIMENSION(dim1), INTENT(inout) :: varmin, varmax         !! min/max values to use for the renormalization
+    CHARACTER(LEN=50), INTENT(in)              :: typefrac                !! Type of fractions retrieval:
+                                                                          !!   'default': standard
+
+    INTEGER(i_std), INTENT(in)                 :: initime                 !! Initial time to take (for input data 
+                                                                          !!   with time values, -1 not used)
+    REAL(r_std), INTENT(in)                    :: maxresollon,maxresollat !! lon,lat maximum resolutions (in m)
+                                                                          !!   (-un, not used)
+    !! 0.2 Modified variables
+    !
+    !! 0.3 Output variables
+    !
+!    REAL(r_std), INTENT(out)                   ::  laimap(nbpt,nvm,12)    !! lai read variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt,dim1,dim2), INTENT(out) :: outvar4D       !! 4D output variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: aoutvar                 !! availability of input data to
+                                                                          !!   interpolate output variable 
+                                                                          !!   (on the nbpt space)
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                             :: iml, jml, lml, tml, fid, ib, ip, jp, it, jj, jv
+    INTEGER                                    :: inNdims                 !! Number of dimensions of the input data
+    INTEGER                                    :: inNLldims               !! Number of dimensions of the lon/lat input data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: lat_in, lon_in          !! latitude and
+                                                                          !! longitude, extract from input 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"
+
+    INTEGER                                      :: ALLOC_ERR
+!    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: invar1D               !! 1D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: invar2D               !! 2D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: invar3D               !! 3D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: invar4D               !! 4D input values
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: resol_in
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: maskvar
+    INTEGER(i_std)                             :: nix, njx
+    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
+    CHARACTER(LEN=50)                          :: S1
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: variableusetypes
+    CHARACTER(LEN=256)                         :: msg
+
+! Debug vars
+    INTEGER                                    :: nb_coord, nb_var, nb_gat
+
+    INTEGER, ALLOCATABLE, DIMENSION(:)         :: indims
+
+
+!_ ================================================================================================================================
+    IF (printlev >= 3) WRITE(numout, *)"In interpweight_4D filename: ",TRIM(filename),         &
+      " varname:'" // TRIM(varname) // "'"
+
+! Allocating input data
+    IF (is_root_prc) THEN
+       IF (printlev >=5) THEN
+          WRITE(numout,*) "Entering 'interpweight_4D'. Debug mode."
+          WRITE(numout,*)'(/," --> fliodmpf")'
+          CALL fliodmpf (TRIM(filename))
+          WRITE(numout,*)'(/," --> flioopfd")'
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (printlev >=5) THEN
+          WRITE (numout,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (numout,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (numout,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+
+! Getting shape of input variable from input file
+    inNdims = interpweight_get_varNdims_file(filename, varname)
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+
+    InputDims: SELECT CASE (inNdims)
+      CASE (2)
+        CALL bcast(iml)
+        CALL bcast(jml)
+
+        ALLOCATE(invar2D(iml,jml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, 0, 0, 1, 1, invar2D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_4D input data dimensions _______'
+          WRITE(numout,*)'    iml, jml:',iml, jml
+        END IF
+
+      CASE (3)
+        ALLOCATE(indims(3), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of indims','','')
+        indims = interpweight_get_var3dims_file(filename, varname)
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+
+        ALLOCATE(invar3D(iml,jml, lml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, 0, 1, 1, invar3D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_4D input data dimensions:'
+          WRITE(numout,*)'    iml, jml, lml:',iml, jml, lml
+        END IF
+
+      CASE (4)
+        ALLOCATE(indims(4), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of indims','','')
+        indims = interpweight_get_var4dims_file(filename, varname)
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+!       Taken from `slowproc_update'
+        IF (initime /= -1) THEN
+          inNdims = 3
+          IF (printlev >= 3) WRITE(numout,*) &
+               'interpweight_4D: taking into account the initial reading time:',initime
+          IF (initime <= 0) tml = 0
+
+          CALL bcast(tml)
+          ALLOCATE(invar3D(iml,jml,lml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF ( initime > 0 ) THEN
+            IF (is_root_prc) THEN
+              IF (initime <= tml) THEN
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, initime, 1, invar3D)
+              ELSE
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, tml, 1, invar3D)
+              ENDIF
+            ENDIF
+          ELSE
+            IF (is_root_prc) THEN
+              CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, 1, 1, invar3D)
+            ENDIF
+          ENDIF
+        ELSE
+          CALL bcast(tml)
+          ALLOCATE(invar4D(iml,jml,lml,tml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, tml, 1, tml, invar4D)
+        END IF
+
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_4D input data dimensions'
+          WRITE(numout,*)'    iml, jml, lml, tml:',iml, jml, lml, tml
+        END IF
+
+      CASE DEFAULT
+        WRITE (S1,'(I3)') inNdims
+        CALL ipslerr_p(3,'interpweight_4D',"Input number of dimensions: '" // TRIM(S1) // "' not ready !!", &
+          '','')
+
+    END SELECT InputDims
+    CALL bcast(invar4D)
+  
+! Getting longitudes/latitudes from input file
+    inNLldims = interpweight_get_varNdims_file(filename, inlonname)
+    IF (inNLldims == 1) THEN
+      ! Allocate memory for latitudes
+      ALLOCATE(lon_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable lon_in','','')
+
+      ALLOCATE(lat_in(jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable lat_in','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, 0, 0, 0, 1, 1, lon_in)
+        CALL flinget(fid, TRIM(inlatname), jml, 0, 0, 0, 1, 1, lat_in)
+      ENDIF
+      CALL bcast(lon_in)
+      CALL bcast(lat_in)
+
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable lon','','')
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable lat','','')
+
+      DO ip=1,iml
+         lat(ip,:) = lat_in(:)
+      ENDDO
+      DO jp=1,jml
+         lon(:,jp) = lon_in(:)
+      ENDDO
+    ELSE
+      ! Allocate memory for longitude
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Pb in allocation for lon','','')
+      ! Allocate memory for latitudes
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Pb in allocation for lat','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, jml, 0, 0, 1, 1, lon)
+        CALL flinget(fid, TRIM(inlatname), iml, jml, 0, 0, 1, 1, lat)
+      ENDIF
+    END IF
+    CALL bcast(lon)
+    CALL bcast(lat)
+
+    IF (is_root_prc) THEN
+      ALLOCATE(resol_in(iml,jml,2), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable resol_in','','')
+    END IF
+
+    IF (noneg) THEN
+      IF (is_root_prc) THEN
+        SELECT CASE (inNdims)
+          CASE(2)
+            CALL interpweight_modifying_input2D(iml, jml, 0, 0, 1, 1, zero, invar2D)
+          CASE(3)
+            CALL interpweight_modifying_input3D(iml, jml, lml, 0, 1, 1, zero, invar3D)
+          CASE(4)
+            CALL interpweight_modifying_input4D(iml, jml, lml, tml, 1, tml, zero, invar4D)
+        END SELECT       
+      END IF
+    END IF
+
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_4D modifying input ended!'
+
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable mask','','')
+
+    IF (TRIM(masktype) == 'var') THEN
+      ALLOCATE(maskvar(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable maskvar','','')
+      maskvar(:,:) = 0
+! Reads the mask from the file
+      IF (is_root_prc) THEN
+! ATTTENTION!! One can not use flinget in this way. It always spect to have a REAL variable!
+        CALL flinget(fid, TRIM(maskvarname), iml, jml, 0, 0, 1, 1, maskvar)
+        WHERE (maskvar > zero)
+          mask = un 
+        END WHERE
+      END IF
+      CALL bcast(mask)
+    ELSE
+      SELECT CASE (inNdims)
+        CASE(2)
+          CALL interpweight_masking_input2D(iml, jml, 0, 0, 0, 0, masktype, maskvalues, invar2D,      &
+            mask)
+        CASE(3)
+          CALL interpweight_masking_input3D(iml, jml, 0, 0, lml, 0, masktype, maskvalues, invar3D,    &
+            mask)
+        CASE(4)
+          CALL interpweight_masking_input4D(iml, jml, 0, 0, lml, tml, masktype, maskvalues, invar4D,  &
+            mask)
+      END SELECT
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_4D masking input ended!'
+
+    IF (is_root_prc) CALL flinclo(fid)
+
+    ! Computation of nbvmax
+    ! In 'condveg_soilalb, slowproc_update' nbvmax=200
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+      IF ( (maxresollon /= -un) .AND. (maxresollat /= -un) ) THEN
+!       Assuming regular lon/lat projection for the input data but it is not caluclated assuming a maximum  &
+!         lon,lat resolution given as input paramater
+         nix=INT(MAXVAL(resolution(:,1))/maxresollon)+2
+         njx=INT(MAXVAL(resolution(:,2))/maxresollat)+2
+      ELSE
+!       Assuming regular lon/lat projection for the input data
+        CALL interpweight_calc_resolution_in(lon, lat, iml, jml, mincos, R_Earth, pi, resol_in)
+        nix=INT(MAXVAL(resolution(:,1))/MAXVAL(resol_in(:,:,1)))+2
+        njx=INT(MAXVAL(resolution(:,2))/MAXVAL(resol_in(:,:,2)))+2
+      END IF
+      nbvmax = MAX(nix*njx, 200)
+    END IF  
+    CALL bcast(nbvmax)
+    CALL bcast(nix)
+    CALL bcast(njx)
+
+    callsign = TRIM(varname) // ' map'
+
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       IF (printlev>=3) WRITE(numout,*) "Projection arrays for ",callsign," : "
+       IF (printlev>=3) WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+       ALLOCATE(sub_index(nbpt, nbvmax, 2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable sub_index','','')
+
+       sub_index(:,:,:)=zero
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable sub_area','','')
+
+       sub_area(:,:)=zero
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon, lat, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+
+! Getting variables thresholds
+    ALLOCATE(variableusetypes(Nvariabletypes), STAT=ALLOC_ERR)
+            IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable variableusetypesr','','')
+
+    IF (variabletypes(1) == -un) THEN
+      variableusetypes = (/ (ip*1., ip=1,Nvariabletypes) /)
+      IF (printlev>=4) WRITE(numout,*)'  interpweight_4D: Note: Using default ',&
+           'equivalence between dimension in the file and dimension in the variable, for file ', filename
+      varmin = 1._r_std
+      varmax = Nvariabletypes*1._r_std
+    ELSE
+      variableusetypes = variabletypes
+    END IF
+    
+    outvar4D = zero
+
+! Doing the interpolation as function of the type fo the values
+    CALL interpweight_provide_fractions4D(typefrac, nbpt, Nvariabletypes, variableusetypes,           &
+      iml, jml, lml, tml, nbvmax, zero, invar4D, sub_area, sub_index, varmax, varmin,                 &
+      deux, lalo, outvar4D, aoutvar)
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_4D end of interpweight_provide_fractions4D'
+
+    IF (printlev>=2) THEN
+       IF (COUNT(aoutvar == -1) >= AINT(nbpt*0.4)) THEN
+          WRITE(numout,*) 'interpweight_4D total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+          msg = "Less than 60% of points '" // TRIM(filename) // "' variable '" // TRIM(varname) //       & 
+               "' have been succesfully interpolated !!"
+          WRITE(numout,*)'  ' // TRIM(msg)
+       ELSE
+          msg = TRIM(filename) // "' variable: '" // TRIM(varname) // "' interpolation Done _______"
+          WRITE(numout,*) "interpweight_4D: '" // TRIM(msg)
+          WRITE(numout,*) '  Total number of points: ', nbpt
+          WRITE(numout,*) '  Interpweight_4D interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+       END IF
+    END IF
+
+! Scaling to 1 the quality variable
+    DO ip=1, nbpt
+      IF (aoutvar(ip) /= -1) aoutvar(ip) = aoutvar(ip)/(resolution(ip,1)*resolution(ip,2))/contfrac(ip)
+    END DO
+
+    IF (ALLOCATED(lat_in)) DEALLOCATE(lat_in)
+    IF (ALLOCATED(lon_in)) DEALLOCATE(lon_in)
+    DEALLOCATE(lon)
+    DEALLOCATE(lat)
+    IF (ALLOCATED(invar2D)) DEALLOCATE(invar2D)
+    IF (ALLOCATED(invar3D)) DEALLOCATE(invar3D)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(invar4D)
+    DEALLOCATE(mask)
+    IF (ALLOCATED(maskvar)) DEALLOCATE(maskvar)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(sub_index)
+    IF (ALLOCATED(resol_in)) DEALLOCATE(resol_in)
+
+    RETURN
+
+  END SUBROUTINE interpweight_4D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_2Dcont
+!!
+!>\BRIEF        ! Interpolate any input file to the grid of the model for a continuos 2D-variable  
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): outvar2D, aoutvar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_2Dcont(nbpt, dim1, dim2, lalo, resolution, neighbours,                      &
+    contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype,               &
+    maskvalues, maskvarname, initime, typefrac, defaultvalue, defaultNOvalue,                         &
+    outvar2D, aoutvar)
+
+    USE ioipsl
+    USE constantes_var
+    USE mod_orchidee_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                 :: nbpt                    !! Number of points for which the data 
+                                                                          !!   needs to be interpolated
+    INTEGER(i_std), INTENT(in)                 :: dim1, dim2              !! 4D complementary dimension sizes
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo                    !! Vector of latitude and longitudes 
+                                                                          !! (beware of the order = 1 : latitude, 
+                                                                          !!   2 : longitude)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution              !! The size in km of each grid-box in X and Y
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), 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), INTENT(in)   :: contfrac                !! Fraction of land in each grid box.
+    CHARACTER(LEN=80), INTENT(in)              :: filename                !! name of the input map to read
+
+    CHARACTER(LEN=80), INTENT(in)              :: varname                 !! name of the variable to interpolate
+    CHARACTER(LEN=80), INTENT(in)              :: inlonname, inlatname    !! names of the longitude and latitude
+    REAL(r_std), INTENT(in)                    :: varmin, varmax          !! min/max values to use for the
+                                                                          !!   renormalization
+    REAL(r_std), INTENT(in)                    :: defaultvalue            !! default interpolated value 
+    REAL(r_std), INTENT(in)                    :: defaultNOvalue          !! default interpolated NO-value 
+
+! Transformations to apply to the original read values from the file
+    LOGICAL, INTENT(in)                        :: noneg                   !! no negative values
+    CHARACTER(LEN=50), INTENT(in)              :: masktype                !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below maskvalues(1)
+                                                                          !!   'mabove': take values above maskvalues(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      maskvalues(2) <= SUM(vals(k)) <= maskvalues(1)
+                                                                          !!      maskvalues(1) < SUM(vals(k)) <= maskvalues(3)
+                                                                          !!        (normalized by maskedvalues(3))
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (1/0)
+    REAL(r_std), DIMENSION(3), INTENT(in)      :: maskvalues              !! values to use to mask (according to 
+                                                                          !!   `masktype') 
+    CHARACTER(LEN=250), INTENT(in)             :: maskvarname             !! name of the variable to use to mask 
+                                                                          !!   (according to `masktype') 
+    CHARACTER(LEN=50), INTENT(in)              :: typefrac                !! Type of fraction retrieval:
+                                                                          !!   'default': standard
+
+    INTEGER(i_std), INTENT(in)                 :: initime                 !! Initial time to take (for input data 
+                                                                          !!   with time values, -1: not used)
+    !! 0.2 Modified variables
+    !
+    !! 0.3 Output variables
+    !
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: outvar2D                !! 2D output variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: aoutvar                 !! availability of input data to
+                                                                          !!   interpolate output variable 
+                                                                          !!   (on the nbpt space)
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                             :: iml, jml, lml, tml, fid, ib, ip, jp, it, jj, jv
+    INTEGER                                    :: inNdims                 !! Number of dimensions of the input data
+    INTEGER                                    :: inNLldims               !! Number of dimensions of the lon/lat input data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: lat_in, lon_in          !! latitude and
+                                                                          !! longitude, extract from input 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(:)       :: invar1D               !! 1D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: invar2D               !! 2D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: invar3D               !! 3D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: invar4D               !! 4D input values
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: resol_in
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: maskvar
+    INTEGER(i_std)                             :: nix, njx
+    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 
+
+    CHARACTER(LEN=50)                          :: S1
+    CHARACTER(LEN=250)                         :: msg
+
+
+! Debug vars
+    INTEGER                                    :: nb_coord, nb_var, nb_gat
+
+!_ ================================================================================================================================
+    IF (printlev >= 3) WRITE(numout,*)"In interpweight_2Dcont filename: ",TRIM(filename),          &
+      " varname:'" // TRIM(varname) // "'"
+! Allocating input data
+    IF (is_root_prc) THEN
+       IF (printlev >=5) THEN
+          WRITE(numout,*) "Entering 'interpweight_2Dcont'. Debug mode."
+          WRITE(numout,*)'(/," --> fliodmpf")'
+          CALL fliodmpf (TRIM(filename))
+          WRITE(numout,*)'(/," --> flioopfd")'
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (printlev >=5) THEN
+          WRITE (numout,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (numout,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (numout,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+
+! Getting shape of input variable from input file
+    inNdims = interpweight_get_varNdims_file(filename, varname)
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+
+    InputDims: SELECT CASE (inNdims)
+      CASE (2)
+        CALL bcast(iml)
+        CALL bcast(jml)
+
+        ALLOCATE(invar2D(iml,jml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, 0, 0, 1, 1, invar2D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_2Dcont input data dimensions _______'
+          WRITE(numout,*)'    iml, jml:',iml, jml
+        END IF
+
+      CASE (3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+
+        ALLOCATE(invar3D(iml,jml, lml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, 0, 1, 1, invar3D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_2Dcont input data dimensions:'
+          WRITE(numout,*)'    iml, jml, lml:',iml, jml, lml
+        END IF
+
+      CASE (4)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+!       Taken from `slowproc_update'
+        IF (initime /= -1) THEN
+          inNdims = 3
+          IF (printlev >= 3) WRITE(numout,*) &
+               'interpweight_2Dcont: taking into account the initial reading time:',initime
+          IF (initime <= 0) tml = 0
+          
+          CALL bcast(tml)
+          ALLOCATE(invar3D(iml,jml,lml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF ( initime > 0 ) THEN
+            IF (is_root_prc) THEN
+              IF (initime <= tml) THEN
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, initime, 1, invar3D)
+              ELSE
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, tml, 1, invar3D)
+              ENDIF
+            ENDIF
+          ELSE
+            IF (is_root_prc) THEN
+              CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, 1, 1, invar3D)
+            ENDIF
+          ENDIF
+        ELSE
+          CALL bcast(tml)
+          ALLOCATE(invar4D(iml,jml,lml,tml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, tml, 1, tml, invar4D)
+        END IF
+
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_2Dcont input data dimensions:'
+          WRITE(numout,*)'    iml, jml, lml, tml :',iml, jml, lml, tml
+        END IF
+
+      CASE DEFAULT
+        WRITE (S1,'(I3)') inNdims
+        CALL ipslerr_p(3,'interpweight_2Dcont',"Input number of dimensions: '" // TRIM(S1) // "' not ready !!", &
+          '','')
+
+    END SELECT InputDims
+    CALL bcast(invar2D)
+
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2Dcont getting variable ended!'
+
+! Getting longitudes/latitudes from input file
+    inNLldims = interpweight_get_varNdims_file(filename, inlonname)
+
+    IF (inNLldims == 1) THEN
+      ! Allocate memory for latitudes
+      ALLOCATE(lon_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable lon_in','','')
+
+      ALLOCATE(lat_in(jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable lat_in','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, 0, 0, 0, 1, 1, lon_in)
+        CALL flinget(fid, TRIM(inlatname), jml, 0, 0, 0, 1, 1, lat_in)
+      ENDIF
+      CALL bcast(lon_in)
+      CALL bcast(lat_in)
+
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable lon','','')
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable lat','','')
+
+      DO ip=1,iml
+         lat(ip,:) = lat_in(:)
+      ENDDO
+      DO jp=1,jml
+         lon(:,jp) = lon_in(:)
+      ENDDO
+    ELSE
+      ! Allocate memory for longitude
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Pb in allocation for lon','','')
+      ! Allocate memory for latitudes
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Pb in allocation for lat','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, jml, 0, 0, 1, 1, lon)
+        CALL flinget(fid, TRIM(inlatname), iml, jml, 0, 0, 1, 1, lat)
+      ENDIF
+    END IF
+    CALL bcast(lon)
+    CALL bcast(lat)
+
+    IF (is_root_prc) THEN
+      ALLOCATE(resol_in(iml,jml,2), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable resol_in','','')
+    END IF
+
+    IF (noneg) THEN
+      IF (is_root_prc) THEN
+        SELECT CASE (inNdims)
+          CASE(2)
+            CALL interpweight_modifying_input2D(iml, jml, 0, 0, 1, 1, zero, invar2D)
+          CASE(3)
+            CALL interpweight_modifying_input3D(iml, jml, lml, 0, 1, 1, zero, invar3D)
+          CASE(4)
+            CALL interpweight_modifying_input4D(iml, jml, lml, tml, 1, tml, zero, invar4D)
+        END SELECT       
+      END IF
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2Dcont modifying input ended!'
+
+    !
+    ! Consider all points a priori
+    !
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable mask','','')
+    mask(:,:) = 0
+
+    IF (TRIM(masktype) == 'var') THEN
+      ALLOCATE(maskvar(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable maskvar','','')
+      maskvar(:,:) = 0
+! Reads the mask from the file
+      IF (is_root_prc) THEN
+! ATTTENTION!! One can not use flinget in this way. It always spect to have a REAL variable!
+        CALL flinget(fid, TRIM(maskvarname), iml, jml, 0, 0, 1, 1, maskvar)
+        WHERE (maskvar > zero)
+          mask = un 
+        END WHERE
+      END IF
+      CALL bcast(mask)
+    ELSE
+      SELECT CASE (inNdims)
+        CASE(2)
+          CALL interpweight_masking_input2D(iml, jml, 0, 0, 0, 0, masktype, maskvalues, invar2D,      &
+            mask)
+        CASE(3)
+          CALL interpweight_masking_input3D(iml, jml, 0, 0, lml, 0, masktype, maskvalues, invar3D,    &
+            mask)
+        CASE(4)
+          CALL interpweight_masking_input4D(iml, jml, 0, 0, lml, tml, masktype, maskvalues, invar4D,  &
+            mask)
+      END SELECT
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2Dcont masking input ended!'
+    IF (is_root_prc) CALL flinclo(fid)
+
+    IF (printlev>=5) WRITE(numout,*)"  interpweight_2Dcont '" // TRIM(typefrac) // "' interpolation"
+
+! Assuming regular lon/lat projection for the input data
+    IF (is_root_prc) THEN
+      CALL interpweight_calc_resolution_in(lon, lat, iml, jml, mincos, R_Earth, pi, resol_in)
+    END IF
+
+!   Computation of nbvmax
+!   In 'condveg_soilalb, slowproc_update' nbvmax=200
+
+!
+!   The number of maximum vegetation map points in the GCM grid is estimated.
+!   Some lmargin is taken.
+!
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution(:,1))/MAXVAL(resol_in(:,:,1)))+2
+       njx=INT(MAXVAL(resolution(:,2))/MAXVAL(resol_in(:,:,2)))+2
+       nbvmax = MAX(nix*njx, 200)
+    ENDIF
+    CALL bcast(nbvmax)
+    CALL bcast(nix)
+    CALL bcast(njx)
+
+    callsign = TRIM(varname) // ' map'
+
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       IF (printlev>=3) WRITE(numout,*) "Projection arrays for ",callsign," : "
+       IF (printlev>=3) WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+       ALLOCATE(sub_index(nbpt, nbvmax, 2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable sub_index','','')
+
+       sub_index(:,:,:)=0
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable sub_area','','')
+
+       sub_area(:,:)=zero
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LON:', MINVAL(lon), MAXVAL(lon)
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LAT:', MINVAL(lat), MAXVAL(lat)
+
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon, lat, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+    IF (printlev>=4) WRITE (numout,*) '  interpweight_2Dcont: read/allocate OK'
+
+    outvar2D = zero
+! Providing the interpolated grid point
+
+    CALL interpweight_provide_interpolation2D(typefrac, nbpt, 0, 0, iml, jml, lml, tml,               &
+      nbvmax, zero, invar2D, sub_area, sub_index, varmax, varmin, un, deux, lalo,                     &
+      defaultvalue, defaultNOvalue, outvar2D, aoutvar)
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2Dcont end of interpweight_provide_interpolation2D'
+
+    IF (printlev>=2) THEN
+       IF (COUNT(aoutvar == -1) >= AINT(nbpt*0.4)) THEN
+          WRITE(numout,*) 'interpweight_2Dcont total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' non-interpolated: ', COUNT(aoutvar == -1)
+          msg = "Less than 60% of points '" // TRIM(filename) // "' variable '" // TRIM(varname) //       &
+               "' have been succesfully interpolated !!"
+          WRITE(numout,*) '  ' // TRIM(msg)
+       ELSE
+          msg = TRIM(filename) // "' variable: '" // TRIM(varname) // "' interpolation Done _______"
+          WRITE(numout,*) "interpweight_2Dcont: '" // TRIM(msg)
+          WRITE(numout,*) '  Total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+       END IF
+    END IF
+
+! Scaling to 1 the quality variable
+    DO ip=1, nbpt
+      IF (aoutvar(ip) /= -1) aoutvar(ip) = aoutvar(ip)/(resolution(ip,1)*resolution(ip,2))/contfrac(ip)
+    END DO
+
+    IF (printlev>=5) WRITE(numout,*) '  interpweight_2Dcont: Interpolation Done'
+
+    IF (ALLOCATED(lat_in)) DEALLOCATE(lat_in)
+    IF (ALLOCATED(lon_in)) DEALLOCATE(lon_in)
+    DEALLOCATE(lon)
+    DEALLOCATE(lat)
+    IF (ALLOCATED(invar2D)) DEALLOCATE(invar2D)
+    IF (ALLOCATED(invar3D)) DEALLOCATE(invar3D)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(invar4D)
+    DEALLOCATE(mask)
+    IF (ALLOCATED(maskvar)) DEALLOCATE(maskvar)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(sub_area)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(sub_index)
+    IF (ALLOCATED(resol_in)) DEALLOCATE(resol_in)
+
+    RETURN
+
+  END SUBROUTINE interpweight_2Dcont
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_4Dcont
+!!
+!>\BRIEF        ! Interpolate any input file to the grid of the model for a continuos 4D-variable  
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): outvar4D, aoutvar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_4Dcont(nbpt, dim1, dim2, lalo, resolution, neighbours,                      &
+    contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype,               &
+    maskvalues, maskvarname, initime, typefrac, defaultvalue, defaultNOvalue,                         &
+    outvar4D, aoutvar)
+
+    USE ioipsl
+    USE constantes_var
+    USE mod_orchidee_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)                 :: nbpt                    !! Number of points for which the data 
+                                                                          !!   needs to be interpolated
+    INTEGER(i_std), INTENT(in)                 :: dim1, dim2              !! 4D complementary dimension sizes
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo                    !! Vector of latitude and longitudes 
+                                                                          !! (beware of the order = 1 : latitude, 
+                                                                          !!   2 : longitude)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution              !! The size in km of each grid-box in X and Y
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), 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), INTENT(in)   :: contfrac                !! Fraction of land in each grid box.
+    CHARACTER(LEN=80), INTENT(in)              :: filename                !! name of the input map to read
+
+    CHARACTER(LEN=80), INTENT(in)              :: varname                 !! name of the variable to interpolate
+    CHARACTER(LEN=80), INTENT(in)              :: inlonname, inlatname    !! names of the longitude and latitude
+    REAL(r_std), INTENT(in)                    :: varmin, varmax          !! min/max values to use for the
+                                                                          !!   renormalization
+    REAL(r_std), DIMENSION(dim1,dim2), INTENT(in) :: defaultvalue         !! default interpolated value 
+    REAL(r_std), INTENT(in)                    :: defaultNOvalue          !! default interpolated NO-value 
+
+! Transformations to apply to the original read values from the file
+    LOGICAL, INTENT(in)                        :: noneg                   !! no negative values
+    CHARACTER(LEN=50), INTENT(in)              :: masktype                !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below maskvalues(1)
+                                                                          !!   'mabove': take values above maskvalues(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      maskvalues(2) <= SUM(vals(k)) <= maskvalues(1)
+                                                                          !!      maskvalues(1) < SUM(vals(k)) <= maskvalues(3)
+                                                                          !!        (normalized by maskedvalues(3))
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (1/0)
+    REAL(r_std), DIMENSION(3), INTENT(in)      :: maskvalues              !! values to use to mask (according to 
+                                                                          !!   `masktype') 
+    CHARACTER(LEN=250), INTENT(in)             :: maskvarname             !! name of the variable to use to mask 
+                                                                          !!   (according to `masktype') 
+    CHARACTER(LEN=50), INTENT(in)              :: typefrac                !! Type of fraction retrieval:
+                                                                          !!   'default': standard
+
+    INTEGER(i_std), INTENT(in)                 :: initime                 !! Initial time to take (for input data 
+                                                                          !!   with time values, -1: not used)
+    !! 0.2 Modified variables
+    !
+    !! 0.3 Output variables
+    !
+    REAL(r_std), DIMENSION(nbpt,dim1,dim2), INTENT(out) :: outvar4D       !! 2D output variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: aoutvar                 !! availability of input data to
+                                                                          !!   interpolate output variable 
+                                                                          !!   (on the nbpt space)
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                             :: iml, jml, lml, tml, fid, ib, ip, jp, it, jj, jv
+    INTEGER                                    :: inNdims                 !! Number of dimensions of the input data
+    INTEGER                                    :: inNLldims               !! Number of dimensions of the lon/lat input data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: lat_in, lon_in          !! latitude and
+                                                                          !! longitude, extract from input 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(:)       :: invar1D               !! 1D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: invar2D               !! 2D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: invar3D               !! 3D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: invar4D               !! 4D input values
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: resol_in
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: maskvar
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: mask
+    INTEGER(i_std)                             :: nix, njx
+    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 
+
+    CHARACTER(LEN=50)                          :: S1
+    INTEGER, ALLOCATABLE, DIMENSION(:)         :: indims
+    CHARACTER(LEN=250)                         :: msg
+
+! Debug vars
+    INTEGER                                    :: nb_coord, nb_var, nb_gat
+    INTEGER                                    :: nblL
+    INTEGER, DIMENSION(2)                      :: lLpt
+
+!_ ================================================================================================================================
+    IF (printlev >= 3) WRITE(numout, *)"In interpweight_4Dcont filename: '",TRIM(filename),         &
+      " varname:'" // TRIM(varname) // "'"
+! Allocating input data
+    IF (is_root_prc) THEN
+       IF (printlev >=5) THEN
+          WRITE(numout,*) "Entering 'interpweight_4Dcont'. Debug mode."
+          WRITE(numout,*)'(/," --> fliodmpf")'
+          CALL fliodmpf (TRIM(filename))
+          WRITE(numout,*)'(/," --> flioopfd")'
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (printlev >=5) THEN
+          WRITE (numout,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (numout,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (numout,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+
+! Getting shape of input variable from input file
+    inNdims = interpweight_get_varNdims_file(filename, varname)
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+
+    InputDims: SELECT CASE (inNdims)
+      CASE (2)
+        CALL bcast(iml)
+        CALL bcast(jml)
+
+        ALLOCATE(invar2D(iml,jml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, 0, 0, 1, 1, invar2D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_4Dcont input data dimensions:'
+          WRITE(numout,*)'    iml, jml:',iml, jml
+        END IF
+
+      CASE (3)
+        ALLOCATE(indims(3),STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable indims','','')
+        indims = interpweight_get_var3dims_file(filename, varname)
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+
+        ALLOCATE(invar3D(iml,jml, lml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, 0, 1, 1, invar3D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_4Dcont input data dimensions:'
+          WRITE(numout,*)'    iml, jml, lml:',iml, jml, lml
+        END IF
+
+      CASE (4)
+        ALLOCATE(indims(4), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of indims','','')
+        indims = interpweight_get_var4dims_file(filename, varname)
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+!       Taken from `slowproc_update'
+        IF (initime /= -1) THEN
+          inNdims = 3
+          IF (printlev >= 3) WRITE(numout,*) &
+               'interpweight_4Dcont: taking into account the initial reading time:',initime
+          IF (initime <= 0) tml = 0
+
+          CALL bcast(tml)
+          ALLOCATE(invar3D(iml,jml,lml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF ( initime > 0 ) THEN
+            IF (is_root_prc) THEN
+              IF (initime <= tml) THEN
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, initime, 1, invar3D)
+              ELSE
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, tml, 1, invar3D)
+              ENDIF
+            ENDIF
+          ELSE
+            IF (is_root_prc) THEN
+              CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, 1, 1, invar3D)
+            ENDIF
+          ENDIF
+        ELSE
+          CALL bcast(tml)
+          ALLOCATE(invar4D(iml,jml,lml,tml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, tml, 1, tml, invar4D)
+        END IF
+
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'interpweight_4Dcont input data dimensions:'
+          WRITE(numout,*)'    iml, jml, lml, tml:',iml, jml, lml, tml
+        END IF
+
+      CASE DEFAULT
+        WRITE (S1,'(I3)') inNdims
+        CALL ipslerr_p(3,'interpweight_4Dcont',"Input number of dimensions: '" // S1 // "' not ready !!",'','')
+
+    END SELECT InputDims
+    CALL bcast(invar4D)
+
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_4Dcont getting variable ended!'
+
+! Getting longitudes/latitudes from input file
+    inNLldims = interpweight_get_varNdims_file(filename, inlonname)
+
+    IF (inNLldims == 1) THEN
+      ! Allocate memory for latitudes
+      ALLOCATE(lon_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable lon_in','','')
+
+      ALLOCATE(lat_in(jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable lat_in','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, 0, 0, 0, 1, 1, lon_in)
+        CALL flinget(fid, TRIM(inlatname), jml, 0, 0, 0, 1, 1, lat_in)
+      ENDIF
+      CALL bcast(lon_in)
+      CALL bcast(lat_in)
+
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable lon','','')
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable lat','','')
+
+      DO ip=1,iml
+         lat(ip,:) = lat_in(:)
+      ENDDO
+      DO jp=1,jml
+         lon(:,jp) = lon_in(:)
+      ENDDO
+    ELSE
+      ! Allocate memory for longitude
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Pb in allocation for lon','','')
+      ! Allocate memory for latitudes
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Pb in allocation for lat','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, jml, 0, 0, 1, 1, lon)
+        CALL flinget(fid, TRIM(inlatname), iml, jml, 0, 0, 1, 1, lat)
+      ENDIF
+    END IF
+    CALL bcast(lon)
+    CALL bcast(lat)
+
+    IF (is_root_prc) THEN
+      ALLOCATE(resol_in(iml,jml,2), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable resol_in','','')
+    END IF
+
+    IF (noneg) THEN
+      IF (is_root_prc) THEN
+        SELECT CASE (inNdims)
+          CASE(2)
+            CALL interpweight_modifying_input2D(iml, jml, 0, 0, 0, 0, zero, invar2D)
+          CASE(3)
+            CALL interpweight_modifying_input3D(iml, jml, lml, 0, 0, 0, zero, invar3D)
+          CASE(4)
+            CALL interpweight_modifying_input4D(iml, jml, lml, tml, 1, tml, zero, invar4D)
+        END SELECT       
+      END IF
+    END IF
+    CALL bcast(invar4D)
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_4Dcont modifying input ended!'
+
+    !
+    ! Consider all points a priori
+    !
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable mask','','')
+    mask(:,:) = zero
+
+    IF (TRIM(masktype) == 'var') THEN
+      ALLOCATE(maskvar(iml,jml), STAT=ALLOC_ERR)
+      maskvar(:,:) = zero
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable maskvar','','')
+      ! Reads the mask from the file
+      IF (is_root_prc) THEN
+         ! ATTTENTION!! One can not use flinget in this way. It always spect to have a REAL variable!
+        CALL flinget(fid, TRIM(maskvarname), iml, jml, 0, 0, 1, 1, maskvar)
+        WHERE (maskvar > zero)
+          mask = un 
+        ENDWHERE
+      END IF
+      CALL bcast(mask)
+    ELSE
+      SELECT CASE (inNdims)
+        CASE(2)
+          CALL interpweight_masking_input2D(iml, jml, 0, 0, 0, 0, masktype, maskvalues, invar2D,      &
+            mask)
+        CASE(3)
+          CALL interpweight_masking_input3D(iml, jml, 0, 0, lml, 0, masktype, maskvalues, invar3D,    &
+            mask)
+        CASE(4)
+          CALL interpweight_masking_input4D(iml, jml, 0, 0, lml, tml, masktype, maskvalues, invar4D,  &
+            mask)
+      END SELECT
+    END IF
+
+    IF (is_root_prc) CALL flinclo(fid)
+
+! Assuming regular lon/lat projection for the input data
+    IF (is_root_prc) THEN
+      CALL interpweight_calc_resolution_in(lon, lat, iml, jml, mincos, R_Earth, pi, resol_in)
+    END IF
+
+    ! Computation of nbvmax
+    ! In 'condveg_soilalb, slowproc_update' nbvmax=200
+
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution(:,1))/MAXVAL(resol_in(:,:,1)))+2
+       njx=INT(MAXVAL(resolution(:,2))/MAXVAL(resol_in(:,:,2)))+2
+       nbvmax = MAX(nix*njx, 200)
+    ENDIF
+    CALL bcast(nbvmax)
+    CALL bcast(nix)
+    CALL bcast(njx)
+
+    !
+    callsign = TRIM(varname) // ' map'
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       IF (printlev>=3) WRITE(numout,*) "Projection arrays for ",callsign," : "
+       IF (printlev>=3) WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+
+       ALLOCATE(sub_index(nbpt, nbvmax, 2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable sub_index','','')
+
+       sub_index(:,:,:)=0
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable sub_area','','')
+
+       sub_area(:,:)=zero
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LON:', MINVAL(lon), MAXVAL(lon)
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LAT:', MINVAL(lat), MAXVAL(lat)
+
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon, lat, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+    IF (printlev>=4) WRITE (numout,*) '  interpweight_4Dcont: read/allocate OK'
+
+    outvar4D = zero
+
+! Providing the interpolated grid point
+    CALL interpweight_provide_interpolation4D(typefrac, nbpt, dim1, dim2, iml, jml, lml, tml,         &
+      nbvmax, zero, invar4D, sub_area, sub_index, varmax, varmin, un, deux, lalo,                     &
+      defaultvalue, defaultNOvalue, outvar4D, aoutvar)
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_4Dcont end of interpweight_provide_interpolation4D'
+    
+    IF (printlev>=2) THEN
+       IF (COUNT(aoutvar == -1) >= AINT(nbpt*0.4)) THEN
+          WRITE(numout,*) 'interpweight_4Dcont total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' non-interpolated: ', COUNT(aoutvar == -1)
+          msg = "Less than 60% of points '" // TRIM(filename) // "' variable '" // TRIM(varname) //       &
+               "' have been succesfully interpolated !!"
+          WRITE(numout,*) '  ' // TRIM(msg)
+       ELSE
+          msg = TRIM(filename) // "' variable: '" // TRIM(varname) // "' interpolation Done _______"
+          WRITE(numout,*) "interpweight_4Dcont: '" // TRIM(msg)
+          WRITE(numout,*) '  Total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+       END IF
+    END IF
+
+! Scaling to 1 the quality variable
+    DO ip=1, nbpt
+      IF (aoutvar(ip) /= -1) aoutvar(ip) = aoutvar(ip)/(resolution(ip,1)*resolution(ip,2))/contfrac(ip)
+    END DO
+
+    IF (printlev>=5) WRITE(numout,*) '  interpweight_4Dcont: Interpolation Done'
+
+    IF (ALLOCATED(lat_in)) DEALLOCATE(lat_in)
+    IF (ALLOCATED(lon_in)) DEALLOCATE(lon_in)
+    DEALLOCATE(lon)
+    DEALLOCATE(lat)
+    IF (ALLOCATED(invar2D)) DEALLOCATE(invar2D)
+    IF (ALLOCATED(invar3D)) DEALLOCATE(invar3D)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(invar4D)
+    DEALLOCATE(mask)
+    IF (ALLOCATED(maskvar)) DEALLOCATE(maskvar)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(sub_index)
+    IF (ALLOCATED(resol_in)) DEALLOCATE(resol_in)
+
+    RETURN
+
+  END SUBROUTINE interpweight_4Dcont
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_calc_resolution_in
+!!
+!>\BRIEF        ! Subroutine to compute the resolution of the input data
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): resolin
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_calc_resolution_in(lons, lats, dx, dy, mcos, REarth, piv, resolin)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                           :: dx, dy        !! Resolution input data
+    REAL(r_std), INTENT(in)                              :: mcos          !! cosinus
+    REAL(r_std), INTENT(in)                              :: REarth        !! Earth Radius
+    REAL(r_std), INTENT(in)                              :: piv           !! pi
+    REAL(r_std), DIMENSION(dx,dy), INTENT(in)            :: lons, lats    !! longitude and latitudes (degrees)
+    !! 0.2 Modified variables
+    !
+    !! 0.3 Output variables
+    !
+    REAL(r_std), DIMENSION(dx,dy,2), INTENT(out)         :: resolin       !! distance between grid points (km)
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER                                              :: ip,jp
+    REAL(r_std)                                          :: coslat
+
+    DO ip=1,dx
+       DO jp=1,dy
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( lats(ip,jp) * piv/180. ), mcos )     
+          IF ( ip .EQ. 1 ) THEN
+             resolin(ip,jp,1) = ABS( lons(ip+1,jp) - lons(ip,jp) ) * piv/180. * REarth * coslat
+          ELSEIF ( ip .EQ. dx ) THEN
+             resolin(ip,jp,1) = ABS( lons(ip,jp) - lons(ip-1,jp) ) * piv/180. * REarth * coslat
+          ELSE
+             resolin(ip,jp,1) = ABS( lons(ip+1,jp) - lons(ip-1,jp) )/2. * piv/180. * REarth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resolin(ip,jp,2) = ABS( lats(ip,jp) - lats(ip,jp+1) ) * piv/180. * REarth
+          ELSEIF ( jp .EQ. dy ) THEN
+             resolin(ip,jp,2) = ABS( lats(ip,jp-1) - lats(ip,jp) ) * piv/180. * REarth
+          ELSE
+             resolin(ip,jp,2) =  ABS( lats(ip,jp-1) - lats(ip,jp+1) )/2. * piv/180. * REarth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+
+  END SUBROUTINE interpweight_calc_resolution_in
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_modifying_input1D
+!!
+!>\BRIEF        ! modify the initial 1D values from the given file
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ivar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_modifying_input1D(dim1, dim2, dim3, dim4, stime, etime, zeroval, ivar)
+
+    USE constantes_var
+    USE ioipsl_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dim1, dim2, dim3, dim4  !! size of the dimensions to get
+    INTEGER, INTENT(in)                                  :: stime, etime  !! starting/ending time step to get
+    REAL(r_std), INTENT(in)                              :: zeroval       !! zero value
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dim1), INTENT(inout)          :: ivar          !! modified input data
+
+
+    WHERE (ivar(:) < zeroval )
+      ivar(:) = zeroval
+    END WHERE
+
+  END SUBROUTINE interpweight_modifying_input1D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_modifying_input2D
+!!
+!>\BRIEF        ! modify the initial 2D values from the given file
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ivar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_modifying_input2D(dim1, dim2, dim3, dim4, stime, etime, zeroval, ivar)
+
+    USE constantes_var
+    USE ioipsl_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dim1, dim2, & !! size of the dimensions to get
+      dim3, dim4
+    INTEGER, INTENT(in)                                  :: stime, etime  !! starting/ending time step to get
+    REAL(r_std), INTENT(in)                              :: zeroval       !! zero value
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dim1,dim2), INTENT(inout)     :: ivar          !! modified input data
+
+    WHERE (ivar(:,:) < zeroval )
+      ivar(:,:) = zeroval
+    END WHERE
+
+  END SUBROUTINE interpweight_modifying_input2D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_modifying_input3D
+!!
+!>\BRIEF        ! modify the initial 3D values from the given file
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ivar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_modifying_input3D(dim1, dim2, dim3, dim4, stime, etime, zeroval, ivar)
+
+    USE constantes_var
+    USE ioipsl_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dim1, dim2, & !! size of the dimensions to get
+      dim3, dim4
+    INTEGER, INTENT(in)                                  :: stime, etime  !! starting/ending time step to get
+    REAL(r_std), INTENT(in)                              :: zeroval       !! zero value
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dim1,dim2,dim3), INTENT(inout):: ivar          !! modified input data
+
+    WHERE (ivar(:,:,:) < zeroval )
+      ivar(:,:,:) = zeroval
+    END WHERE
+
+  END SUBROUTINE interpweight_modifying_input3D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_modifying_input4D
+!!
+!>\BRIEF        ! modify the initial 4D values from the given file
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ivar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_modifying_input4D(dim1, dim2, dim3, dim4, stime, etime, zeroval, ivar)
+
+    USE constantes_var
+    USE ioipsl_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dim1, dim2, & !! size of the dimensions to get
+      dim3, dim4
+    INTEGER, INTENT(in)                                  :: stime, etime  !! starting/ending time step to get
+    REAL(r_std), INTENT(in)                              :: zeroval       !! zero value
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dim1,dim2,dim3,dim4), INTENT(inout) :: ivar          !! modified input data
+
+    WHERE (ivar(:,:,:,:) < zeroval )
+      ivar(:,:,:,:) = zeroval
+    END WHERE
+
+  END SUBROUTINE interpweight_modifying_input4D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_interpweight_1D
+!!
+!>\BRIEF        ! mask 1D input values
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): msk
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_masking_input1D(dx, dy, d1, d2, d3, d4, mtype, mvalues, var,                &
+    msk)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+  
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dx, dy, d1, & !! shapes of the input variables
+      d2, d3, d4
+    CHARACTER(LEN=50), INTENT(in)                        :: mtype         !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below values(1)
+                                                                          !!   'mabove': take values above values(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      values(2) <= SUM(vals(k)) <= values(1)
+                                                                          !!      values(1) < SUM(vals(k)) <= values(3): 
+                                                                          !!        renormalize
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)                :: mvalues       !! values to use to mask (according to `mtype') 
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dx), INTENT(inout)            :: var           !! variable from which provide the mask
+    INTEGER(i_std), DIMENSION(dx), INTENT(inout)         :: msk           !! mask to retrieve
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,l
+
+    SELECT CASE (mtype)
+      CASE('nomask')
+        msk=un
+      CASE('mbelow')
+        ! e.g.: 
+        ! Exclude the points where there is never a LAI value. It is probably 
+        ! an ocean point.
+        !
+        DO i=1,dx
+          IF ( var(i) < mvalues(1) ) msk(i) = un
+        END DO
+      CASE('mabove')
+        DO i=1,dx
+          IF ( var(i) > mvalues(1) ) msk(i) = un 
+        ENDDO
+      CASE('msumrange')
+        CALL ipslerr_p(3, 'interpweight_masking_input1D',"'msumrange' no sens on a 1D variable",'','')
+      CASE DEFAULT
+        CALL ipslerr_p(3, 'interpweight_masking_input1D',"mask with '" // TRIM(mtype) // "' not ready !!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_masking_input1D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_masking_input2D
+!!
+!>\BRIEF        ! mask 2D input values
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): msk
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_masking_input2D(dx, dy, d1, d2, d3, d4, mtype, mvalues, var,                &
+    msk)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+  
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dx, dy, d1, & !! shapes of the input variables
+      d2, d3, d4
+    CHARACTER(LEN=50), INTENT(in)                        :: mtype         !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below values(1)
+                                                                          !!   'mabove': take values above values(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      values(2) <= SUM(vals(k)) <= values(1)
+                                                                          !!      values(1) < SUM(vals(k)) <= values(3): 
+                                                                          !!        renormalize
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)                :: mvalues       !! values to use to mask (according to `mtype') 
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dx,dy), INTENT(inout)         :: var           !! variable from which provide the mask
+    INTEGER(i_std), DIMENSION(dx,dy), INTENT(inout)      :: msk           !! mask to retrieve
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,l
+    REAL(r_std)                                          :: sumval
+
+
+    SELECT CASE (mtype)
+      CASE('nomask')
+        msk=un
+      CASE('mbelow')
+        ! e.g.: 
+        ! Exclude the points where there is never a LAI value. It is probably 
+        ! an ocean point.
+        !
+        DO i=1,dx
+          DO j=1,dy
+            IF ( var(i,j) < mvalues(1) ) msk(i,j) = un
+          END DO
+        END DO
+      CASE('mabove')
+        DO i=1,dx
+          DO j=1,dy
+            IF ( var(i,j) > mvalues(1) ) msk(i,j) = un 
+          ENDDO
+        ENDDO
+      CASE('msumrange')
+        IF (printlev>=3) WRITE(numout,*) &
+             'interpweight_masking_input2D: masking with mask sum range. Interval:', mvalues
+         DO i=1,dx
+           DO j=1,dy
+              sumval=SUM(var(i,:))
+              IF ( sumval .GE. mvalues(2) .AND. sumval .LE. mvalues(1) ) THEN
+                 msk(i,j) = un 
+              ELSEIF ( sumval .GT. mvalues(1) .AND. sumval .LE. mvalues(3) ) THEN
+                 ! normalization
+                 var(i,j) = var(i,j) / sumval
+                 msk(i,j) = un 
+              ENDIF
+           ENDDO
+        ENDDO
+      CASE DEFAULT
+        CALL ipslerr_p(3, 'interpweight_masking_input2D',"mask with '" // TRIM(mtype) // "' not ready !!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_masking_input2D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_masking_input3D
+!!
+!>\BRIEF        ! mask 3D input values
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): msk
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_masking_input3D(dx, dy, d1, d2, d3, d4, mtype, mvalues, var,                &
+    msk)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+  
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dx, dy, d1, & !! shapes of the input variables
+      d2, d3, d4
+    CHARACTER(LEN=50), INTENT(in)                        :: mtype         !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below values(1)
+                                                                          !!   'mabove': take values above values(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      values(2) <= SUM(vals(k)) <= values(1)
+                                                                          !!      values(1) < SUM(vals(k)) <= values(3): 
+                                                                          !!        renormalize
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)                :: mvalues       !! values to use to mask (according to `mtype') 
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dx,dy,d3), INTENT(inout)      :: var           !! variable from which provide the mask
+    INTEGER(i_std), DIMENSION(dx,dy), INTENT(inout)      :: msk           !! mask to retrieve
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,l
+    REAL(r_std)                                          :: sumval
+
+
+    SELECT CASE (mtype)
+      CASE('nomask')
+        msk=un
+      CASE('mbelow')
+        ! e.g.: 
+        ! Exclude the points where there is never a LAI value. It is probably 
+        ! an ocean point.
+        !
+        DO i=1,dx
+          DO j=1,dy
+            IF ( ANY(var(i,j,:) < mvalues(1)) ) msk(i,j) = un
+          END DO
+        END DO
+      CASE('mabove')
+        DO i=1,dx
+          DO j=1,dy
+            IF ( ANY(var(i,j,:) > mvalues(1)) ) msk(i,j) = un 
+          ENDDO
+        ENDDO
+      CASE('msumrange')
+         DO i=1,dx
+           DO j=1,dy
+             sumval=SUM(var(i,j,:))
+             IF ( sumval .GE. mvalues(2) .AND. sumval .LE. mvalues(1)) THEN
+                msk(i,j) = un 
+             ELSEIF ( sumval .GT. mvalues(1) .AND. sumval .LE. mvalues(3)) THEN
+                ! normalization
+                var(i,j,:) = var(i,j,:) / sumval
+                msk(i,j) = un 
+             ENDIF
+           ENDDO
+        ENDDO
+      CASE DEFAULT
+        CALL ipslerr_p(3, 'interpweight_masking_input3D',"mask with '" // TRIM(mtype) // "' not ready !!",'','')
+    END SELECT
+  END SUBROUTINE interpweight_masking_input3D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_masking_input4D
+!!
+!>\BRIEF        ! mask 4D input values
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): msk
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_masking_input4D(dx, dy, d1, d2, d3, d4, mtype, mvalues, var,                &
+    msk)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+  
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dx, dy, d1, & !! shapes of the input variables
+      d2, d3, d4
+    CHARACTER(LEN=50), INTENT(in)                        :: mtype         !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below values(1)
+                                                                          !!   'mabove': take values above values(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      values(2) <= SUM(vals(k)) <= values(1)
+                                                                          !!      values(1) < SUM(vals(k)) <= values(3): 
+                                                                          !!        renormalize
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)                :: mvalues       !! values to use to mask (according to `mtype') 
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dx,dy,d3,d4), INTENT(inout)   :: var           !! variable from which provide the mask
+    INTEGER(i_std), DIMENSION(dx,dy), INTENT(inout)      :: msk           !! mask to retrieve
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,l
+    REAL(r_std)                                          :: sumval
+
+
+    SELECT CASE (mtype)
+      CASE('nomask')
+        msk=un
+      CASE('mbelow')
+        ! e.g.: 
+        ! Exclude the points where there is never a LAI value. It is probably 
+        ! an ocean point.
+        !
+        DO i=1,dx
+          DO j=1,dy
+            IF ( ANY(var(i,j,:,:) < mvalues(1)) ) msk(i,j) = un
+          END DO
+        END DO
+      CASE('mabove')
+        DO i=1,dx
+          DO j=1,dy
+            IF ( ANY(var(i,j,:,:) > mvalues(1)) ) msk(i,j) = un 
+          ENDDO
+        ENDDO
+      CASE('msumrange')
+        IF (printlev>=3) WRITE(numout,*) &
+             'interpweight_masking_input4D: masking with mask sum range. Interval:', mvalues
+         DO i=1,dx
+           DO j=1,dy
+             DO l=1,d4
+               sumval=SUM(var(i,j,:,l))
+               IF ( sumval .GE. mvalues(2) .AND. sumval .LE. mvalues(1) .AND. msk(i,j) /= un) THEN
+                  msk(i,j) = un 
+               ELSEIF ( sumval .GT. mvalues(1) .AND. sumval .LE. mvalues(3)) THEN
+                  ! normalization
+                  var(i,j,:,l) = var(i,j,:,l) / sumval
+                  msk(i,j) = un 
+               ENDIF
+             ENDDO
+           ENDDO
+        ENDDO
+      CASE DEFAULT
+        CALL ipslerr_p(3, 'interpweight_masking_input4D',"mask with '" // TRIM(mtype) // "' not ready !!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_masking_input4D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_provide_fractions1D
+!!
+!>\BRIEF        ! provide fractions from a 1D incoming variable
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ovar, aovar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_provide_fractions1D(tint, npt, Ntypes, valstypes,                           &
+    dx, dy, d3, d4, nbmax, zeroval, ivar1D, sarea, sindex, vmax, vmin,                                &
+    two, latlon, ovar, aovar)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+  
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=50), INTENT(in)                        :: tint          !! tint: type of interpolation
+                                                                          !!   'XYKindTime': Input values are kinds 
+                                                                          !!     of something with a temporal 
+                                                                          !!     evolution on the dx*dy matrix
+    INTEGER, INTENT(in)                                  :: npt           !! total number of grid points
+    INTEGER, INTENT(in)                                  :: dx,dy,d3,d4   !! shape of the input values
+    INTEGER, INTENT(in)                                  :: nbmax         !! maximum input grid cells to use 
+                                                                          !!   for in 1 grid point
+    REAL(r_std), INTENT(in)                              :: zeroval, two  !! zero and 2. real values
+    INTEGER, INTENT(in)                                  :: Ntypes        !! number of types
+    REAL(r_std), DIMENSION(Ntypes), INTENT(in)           :: valstypes     !! value for each type 
+    REAL(r_std), DIMENSION(dx), INTENT(in)               :: ivar1D        !! values of the input data
+    REAL(r_std), DIMENSION(npt,nbmax), INTENT(in)        :: sarea         !! overlaping area of a given input 
+                                                                          !!   grid point
+    INTEGER(i_std), DIMENSION(npt,nbmax), INTENT(in)     :: sindex        !! index of the overlaping input 
+                                                                          !!   grid point
+    REAL(r_std), DIMENSION(npt,2), INTENT(in)            :: latlon        !! longitude and latitude of the destiny
+                                                                          !!   grid points
+    !! 0.2 Modified variables
+    REAL(r_std), INTENT(inout)                           :: vmax, vmin    !! thresholds of the values
+    !! 0.3 Output variables
+    REAL(r_std), DIMENSION(npt,Ntypes), INTENT(out)      :: ovar          !! output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: aovar         !! availability of input data to 
+                                                                          !!   interpolate output variable (on 
+                                                                          !!   the nbpt space)
+                                                                          !!     >0.: As the total sum of the 
+                                                                          !!       space fraction used from the 
+                                                                          !!       source
+                                                                          !!     -1: Did not find any required values 
+                                                                          !!       from input data
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,ij,ib,idi,jj,ip,jp,jv,it
+    CHARACTER(LEN=250)                                   :: msg
+
+
+! Initialization
+!!
+    ovar = zeroval
+
+    SELECT CASE (tint)
+      CASE ('default')
+        IF (printlev>=4) WRITE(numout,*)'  interpweight_provide_fractions1D Fractions following default1D method'
+        IF (ALL(ivar1D == zeroval)) THEN
+          msg = "' wrong 1D input variable"
+          CALL ipslerr_p(3,'interpweight_provide_fractions1D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF 
+        DO ib=1,npt
+          aovar(ib) = zeroval
+          idi = COUNT(sarea(ib,:) > zeroval)
+          IF ( idi > 0 ) THEN
+            DO jj=1,idi
+               ip = sindex(ib,jj)
+               DO it = 1, Ntypes
+                 IF (ivar1d(ip) == valstypes(it)*un) THEN
+                   ovar(ib,it) = ovar(ib,it) + sarea(ib,jj)
+                 END IF
+               END DO
+               aovar(ib) = aovar(ib) + sarea(ib,jj)
+            ENDDO
+            !
+            ! Normalize
+            !
+            ovar(ib,:) = ovar(ib,:)/aovar(ib)
+            !
+            ! Quality variable
+          ELSE
+             ! No points found.
+            aovar(ib) = -un
+            ovar(ib,INT((vmax+vmin)/two)) = un
+          ENDIF
+          IF (SUM(ovar(ib,:)) > 1.0000001) THEN
+            IF (printlev>=3) WRITE(numout,*) '  interpweight_provide_fractions1D On point ', ib, &
+                 ' location: ', latlon(ib,2), latlon(ib,1),' total fractions=', SUM(ovar(ib,:))
+            IF (printlev>=3) THEN
+               WRITE(numout,*) '  type fraction: '
+               DO i=1, Ntypes
+                  WRITE(numout,*) i, ovar(ib,i)
+               END DO
+            END IF
+            msg='total of fractions above 1.!'
+            CALL ipslerr_p(3,'interpweight_provide_fractions1D',TRIM(msg),'','')
+          END IF
+        END DO
+
+        IF (printlev >= 3 .AND. ANY(aovar == -un)) THEN
+           WRITE(numout,*) 'interpweight_provide_fractions1D: '
+           WRITE(numout,*) 'Some points on the model grid did not have any points on the source grid for interpolation.'
+           WRITE(numout,*) 'These points are initialized by putting the average VAR ', INT((vmax+vmin)/two), ' to 1.'
+           WRITE(numout,*) 'The points are (ib, lon, lat) :'
+           DO ib=1, npt
+              IF (aovar(ib) == -un) WRITE(numout,*) ib, latlon(ib,2), latlon(ib,1)
+           END DO
+        END IF
+      CASE DEFAULT
+        CALL ipslerr_p(3,'interpweight_provide_fractions1D',"Inerpolation type '" // TRIM(tint) // "' not ready!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_provide_fractions1D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_provide_fractions2D
+!!
+!>\BRIEF        ! provide fractions from a 2D incoming variable
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ovar, aovar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_provide_fractions2D(tint, npt, Ntypes, valstypes,                           &
+    dx, dy, d3, d4, nbmax, zeroval, ivar2D, sarea, sindex, vmax, vmin,                                &
+    two, latlon, ovar, aovar)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=50), INTENT(in)                        :: tint          !! tint: type of interpolation
+                                                                          !!   'XYKindTime': Input values are kinds 
+                                                                          !!     of something with a temporal 
+                                                                          !!     evolution on the dx*dy matrix
+    INTEGER, INTENT(in)                                  :: npt           !! total number of grid points
+    INTEGER, INTENT(in)                                  :: dx,dy,d3,d4   !! shape of the input values
+    INTEGER, INTENT(in)                                  :: nbmax         !! maximum input grid cells to use 
+                                                                          !!   for in 1 grid point
+    REAL(r_std), INTENT(in)                              :: zeroval, two  !! zero and 2. real values
+    INTEGER, INTENT(in)                                  :: Ntypes        !! number of types
+    REAL(r_std), DIMENSION(Ntypes), INTENT(in)           :: valstypes     !! value for each type 
+    REAL(r_std), DIMENSION(dx,dy), INTENT(in)            :: ivar2D        !! values of the input data
+    REAL(r_std), DIMENSION(npt,nbmax), INTENT(in)        :: sarea         !! overlaping area of a given input 
+                                                                          !!   grid point
+    INTEGER(i_std), DIMENSION(npt,nbmax,2), INTENT(in)   :: sindex        !! index of the overlaping input 
+                                                                          !!   grid point
+    REAL(r_std), DIMENSION(npt,2), INTENT(in)            :: latlon        !! longitude and latitude of the destiny
+                                                                          !!   grid points
+    !! 0.2 Modified variables
+    REAL(r_std), INTENT(inout)                           :: vmax, vmin    !! thresholds of the values
+    !! 0.3 Output variables
+    REAL(r_std), DIMENSION(npt,Ntypes), INTENT(out)      :: ovar          !! output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: aovar         !! availability of input data to 
+                                                                          !!   interpolate output variable (on 
+                                                                          !!   the nbpt space)
+                                                                          !!     >0.: As the total sum of the 
+                                                                          !!       space fraction used from the 
+                                                                          !!       source
+                                                                          !!     -1: Found any required values 
+                                                                          !!       from input data
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,ij,ib,idi,jj,ip,jp,jv,it
+    CHARACTER(LEN=250)                                   :: msg
+
+
+! Initialization
+!!
+    ovar = zeroval
+
+    SELECT CASE (tint)
+      CASE ('default')
+        IF (printlev>=3) WRITE(numout,*)'  interpweight_provide_fractions2D Fractions following default2D method'
+        IF (ALL(ivar2D == zeroval)) THEN
+          msg = "' wrong 2D input variable"
+          CALL ipslerr_p(3,'interpweight_provide_fractions2D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF 
+        DO ib=1,npt
+          aovar(ib) = zeroval
+          idi = COUNT(sarea(ib,:) > zeroval)
+          IF ( idi > 0 ) THEN
+            DO jj=1,idi
+               ip = sindex(ib,jj,1)
+               jp = sindex(ib,jj,2)
+               DO it = 1, Ntypes
+                 IF (ivar2d(ip,jp) == valstypes(it)*un) THEN
+                   ovar(ib,it) = ovar(ib,it) + sarea(ib,jj)
+                 END IF
+               END DO
+               aovar(ib) = aovar(ib) + sarea(ib,jj)
+            ENDDO
+            !
+            ! Normalize
+            !
+            ovar(ib,:) = ovar(ib,:)/aovar(ib)
+            !
+            ! Quality variable
+          ELSE
+            ! No points on the source grid were found for the current point. 
+            ! We provide here a default value.
+            aovar(ib) = -un
+            ovar(ib,INT((vmax+vmin)/two)) = un
+          ENDIF
+
+          IF (SUM(ovar(ib,:)) > 1.0000001) THEN
+            WRITE(numout,*) '  interpweight_provide_fractions2D On point ', ib, ' location: ', latlon(ib,2),     &
+              latlon(ib,1),' total fractions=', SUM(ovar(ib,:))
+            WRITE(numout,*) '  type fraction _______'
+            DO i=1, Ntypes
+              WRITE(numout,*) i, ovar(ib,i)
+            END DO
+            msg='total of fractions above 1.!'
+            CALL ipslerr_p(3,'interpweight_provide_fractions2D',TRIM(msg),'','')
+          END IF
+        END DO
+
+        IF (printlev >= 3 .AND. ANY(aovar == -un)) THEN
+           WRITE(numout,*) 'interpweight_provide_fractions2D: '
+           WRITE(numout,*) 'Some points on the model grid did not have any points on the source grid for interpolation.'
+           WRITE(numout,*) 'These points are initialized by putting the average VAR ', INT((vmax+vmin)/two), ' to 1.'
+           WRITE(numout,*) 'The points are (ib, lon, lat) :'
+           DO ib=1, npt
+              IF (aovar(ib) == -un) WRITE(numout,*) ib, latlon(ib,2), latlon(ib,1)
+           END DO
+        END IF
+ 
+      CASE DEFAULT
+        CALL ipslerr_p(3,'interpweight_provide_fractions2D',"Inerpolation type '" // TRIM(tint) // "' not ready!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_provide_fractions2D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_provide_fractions3D
+!!
+!>\BRIEF        ! provide fractions from a 3D incoming variable
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ovar, aovar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_provide_fractions3D(tint, npt, Ntypes, valstypes,                           &
+    dx, dy, d3, d4, nbmax, zeroval, ivar3D, sarea, sindex, vmax, vmin,                                &
+    two, latlon, ovar, aovar)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=50), INTENT(in)                        :: tint          !! tint: type of interpolation
+                                                                          !!   'XYKindTime': Input values are kinds 
+                                                                          !!     of something with a temporal 
+                                                                          !!     evolution on the dx*dy matrix
+    INTEGER, INTENT(in)                                  :: npt           !! total number of grid points
+    INTEGER, INTENT(in)                                  :: dx,dy,d3,d4   !! shape of the input values
+    INTEGER, INTENT(in)                                  :: nbmax         !! maximum input grid cells to use 
+                                                                          !!   for in 1 grid point
+    REAL(r_std), INTENT(in)                              :: zeroval, two  !! zero and 2. real values
+    INTEGER, INTENT(in)                                  :: Ntypes        !! number of types
+    REAL(r_std), DIMENSION(Ntypes), INTENT(in)           :: valstypes     !! value for each type 
+    REAL(r_std), DIMENSION(dx,dy,d3), INTENT(in)         :: ivar3D        !! values of the input data
+    REAL(r_std), DIMENSION(npt,nbmax), INTENT(in)        :: sarea         !! overlaping area of a given input 
+                                                                          !!   grid point
+    INTEGER(i_std), DIMENSION(npt,nbmax,2), INTENT(in)   :: sindex        !! index of the overlaping input 
+                                                                          !!   grid point
+    REAL(r_std), DIMENSION(npt,2), INTENT(in)            :: latlon        !! longitude and latitude of the destiny
+                                                                          !!   grid points
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(Ntypes), INTENT(inout)        :: vmax, vmin    !! thresholds of the values
+    !! 0.3 Output variables
+    REAL(r_std), DIMENSION(npt,Ntypes), INTENT(out)      :: ovar          !! output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: aovar         !! availability of input data to 
+                                                                          !!   interpolate output variable (on 
+                                                                          !!   the nbpt space)
+                                                                          !!     >0.: As the total sum of the 
+                                                                          !!       space fraction used from the 
+                                                                          !!       source
+                                                                          !!     -1: Found any required values 
+                                                                          !!       from input data
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,ij,ib,idi,jj,ip,jp,jv,it
+    CHARACTER(LEN=250)                                   :: msg
+    INTEGER                                              :: Nzeros
+    INTEGER                                              :: ALLOC_ERR 
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)               :: subfrac
+    REAL(r_std)                                          :: sumpt
+
+
+! Initialization
+!!
+    ovar = zeroval
+
+    IF (Ntypes /= d3) THEN
+      msg = 'Different number of types than third dimension in the input data!!'
+      CALL ipslerr_p(3,'interpweight_provide_fractions3D',TRIM(msg),'','')
+    END IF
+
+    Nzeros = 0
+    SELECT CASE (tint)
+      CASE ('default')
+        IF (printlev>=3) WRITE(numout,*)'Fractions following default3D method'
+        IF (ALL(ivar3D == zeroval)) THEN
+          msg = "' wrong 3D input variable"
+          CALL ipslerr_p(3,'interpweight_provide_fractions3D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF
+        DO ib=1,npt
+          aovar(ib) = zeroval
+          idi = COUNT(sarea(ib,:) > zeroval)
+          IF ( idi > 0 ) THEN
+            sumpt = zeroval
+            DO jj=1,idi
+               ip = sindex(ib,jj,1)
+               jp = sindex(ib,jj,2)
+               DO it = 1, Ntypes
+! Do not get that areas with zero input value and with missing value
+                 IF (ivar3D(ip,jp,it) > zeroval .AND. ivar3D(ip,jp,it) < two) THEN
+                   ovar(ib,it) = ovar(ib,it) + ivar3D(ip,jp,it)*sarea(ib,jj)
+                   sumpt = sumpt + ivar3D(ip,jp,it)*sarea(ib,jj)
+                 END IF
+               END DO
+               aovar(ib) = aovar(ib) + sarea(ib,jj)
+            ENDDO
+            !
+            ! Normalize
+            !
+            ovar(ib,:) = ovar(ib,:)/aovar(ib)
+            !
+            ! Quality variable
+          ELSE
+            Nzeros = Nzeros + 1
+            aovar(ib) = -un
+
+            DO it = 1, d3
+              ovar(ib,INT((vmax(it)+vmin(it))/two)) = un
+            END DO
+          ENDIF
+! Tests
+!
+          IF (SUM(ovar(ib,:)) > 1.0000001) THEN
+            idi = COUNT(sarea(ib,:) > zeroval)
+            ALLOCATE(subfrac(idi), STAT=ALLOC_ERR)
+            IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_provide_fractions3D','Problem in allocation of subfrac','','')
+            IF (printlev>=3) THEN
+               WRITE(numout,*) 'interpweight_provide_fractions3D On point ', ib, &
+                    ' location: ', latlon(ib,2), latlon(ib,1),' total fractions=', SUM(ovar(ib,:)), &
+                    ' total points from invar: ', idi, ' total invar area: ', aovar(ib)
+               WRITE(numout,*) '  type ivar3D jj sarea fraction: '
+
+               DO it = 1, Ntypes
+                  DO jj=1,idi
+                     ip = sindex(ib,jj,1)
+                     jp = sindex(ib,jj,2)
+                     IF (ivar3D(ip,jp,it) > zeroval) THEN
+                        WRITE(numout,*) it, ivar3D(ip,jp,it), jj, sarea(ib,jj), ovar(ib,it)
+                     END IF
+                  END DO
+               END DO
+            END IF
+            msg='total of fractions above 1.!'
+            CALL ipslerr_p(3,'interpweight_provide_fractions3D',TRIM(msg),'','')
+         END IF
+
+        END DO
+
+        IF (printlev >= 3 .AND. ANY(aovar == -un)) THEN
+           WRITE(numout,*) 'interpweight_provide_fractions3D: '
+           WRITE(numout,*) 'Some points on the model grid did not have any points on the source grid for interpolation.'
+           WRITE(numout,*) 'These points are initialized by putting the average VAR ', INT((vmax+vmin)/two), ' to 1.'
+           WRITE(numout,*) 'The points are (ib, lon, lat) :'
+           DO ib=1, npt
+              IF (aovar(ib) == -un) WRITE(numout,*) ib, latlon(ib,2), latlon(ib,1)
+           END DO
+        END IF
+
+        IF (COUNT(aovar == -1) == npt) THEN
+          msg='No grid points could be interpolated from the source grid for the current process'
+          CALL ipslerr_p(2,'interpweight_provide_fractions3D',TRIM(msg),'','')
+        END IF
+
+        IF (printlev >=3) WRITE(numout,*) 'interpweight_provide_fractions3D: Nzeros=', &
+             Nzeros,' aovar=', COUNT(aovar == -1), ' nbpt=', npt
+
+        IF (COUNT(aovar == -1) /= Nzeros) THEN
+          msg='Something went wrong COUNT(aovar == -1) /= Nzeros'
+          CALL ipslerr_p(3,'interpweight_provide_fractions3D',TRIM(msg),'','')
+        END IF
+ 
+      CASE DEFAULT
+        CALL ipslerr_p(3,'interpweight_provide_fractions3D',"Inerpolation type '" // TRIM(tint) // "' not ready!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_provide_fractions3D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_provide_fractions4D
+!!
+!>\BRIEF        ! provide fractions from a 4D incoming variable
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ovar, aovar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_provide_fractions4D(tint, npt, Ntypes, valstypes,                           &
+    dx, dy, d3, d4, nbmax, zeroval, ivar4D, sarea, sindex, vmax, vmin,                                &
+    two, latlon, ovar, aovar)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=50), INTENT(in)                        :: tint          !! tint: type of interpolation
+                                                                          !!   'XYKindTime': Input values are kinds 
+                                                                          !!     of something with a temporal 
+                                                                          !!     evolution on the dx*dy matrix
+    INTEGER, INTENT(in)                                  :: npt           !! total number of grid points
+    INTEGER, INTENT(in)                                  :: dx,dy,d3,d4   !! shape of the input values
+    INTEGER, INTENT(in)                                  :: nbmax         !! maximum input grid cells to use 
+                                                                          !!   for in 1 grid point
+    REAL(r_std), INTENT(in)                              :: zeroval, two  !! zero and 2. real values
+    INTEGER, INTENT(in)                                  :: Ntypes        !! number of types
+    REAL(r_std), DIMENSION(Ntypes), INTENT(in)           :: valstypes     !! value for each type 
+    REAL(r_std), DIMENSION(dx,dy,d3,d4), INTENT(in)      :: ivar4D        !! values of the input data
+    REAL(r_std), DIMENSION(npt,nbmax), INTENT(in)        :: sarea         !! overlaping area of a given input 
+                                                                          !!   grid point
+    INTEGER(i_std), DIMENSION(npt,nbmax,2), INTENT(in)   :: sindex        !! index of the overlaping input 
+                                                                          !!   grid point
+    REAL(r_std), DIMENSION(npt,2), INTENT(in)            :: latlon        !! longitude and latitude of the destiny
+                                                                          !!   grid points
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(Ntypes), INTENT(inout)        :: vmax, vmin    !! thresholds of the values
+    !! 0.3 Output variables
+    REAL(r_std), DIMENSION(npt,Ntypes,d4), INTENT(out)   :: ovar          !! output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: aovar         !! availability of input data to 
+                                                                          !!   interpolate output variable (on 
+                                                                          !!   the nbpt space)
+                                                                          !!     >0.: As the total sum of the 
+                                                                          !!       space fraction used from the 
+                                                                          !!       source
+                                                                          !!     -1: Found any required values 
+                                                                          !!       from input data
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,ij,ib,idi,jj,ip,jp,jv,it,itt
+    CHARACTER(LEN=250)                                   :: msg
+
+
+! Initialization
+!!
+    ovar = zeroval
+
+    IF (Ntypes /= d3) THEN
+      msg = 'Different number of types than third dimension in the input data!!'
+      CALL ipslerr_p(3,'interpweight_provide_fractions4D',TRIM(msg),'','')
+    END IF
+
+    SELECT CASE (tint)
+      CASE ('default')
+        IF (printlev>=3) WRITE(numout,*)'Fractions following default4D method'
+        IF (ALL(ivar4D == zeroval)) THEN
+          msg = "' wrong 4D input variable"
+          CALL ipslerr_p(3,'interpweight_provide_fractions4D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF
+        DO ib=1,npt
+          aovar(ib) = zeroval
+          idi = COUNT(sarea(ib,:) > zeroval)
+          IF ( idi > 0 ) THEN
+            DO jj=1,idi
+               ip = sindex(ib,jj,1)
+               jp = sindex(ib,jj,2)
+               DO it = 1, Ntypes
+                 DO itt = 1, d4
+                   ! Do not get that areas with zero input value and with missing value
+                   IF (ivar4D(ip,jp,it,itt) > zeroval .AND. ivar4D(ip,jp,it,itt) < 20.) THEN
+                     ovar(ib,it,itt) = ovar(ib,it,itt) + ivar4D(ip,jp,it,itt)*sarea(ib,jj)
+                   END IF
+                 END DO
+               END DO
+               aovar(ib) = aovar(ib) + sarea(ib,jj)
+            ENDDO
+            !
+            ! Normalize
+            !
+            ovar(ib,:,:) = ovar(ib,:,:)/aovar(ib)
+            !
+            ! Quality variable
+          ELSE
+            ! No points found. Set the average of input threashold (vmax, vmin) as value. 
+            aovar(ib) = -un
+            IF (printlev >= 3) WRITE(numout,*) 'interpweight_provide_fractions4D: ',&
+                 'No points found for interpolating of point ib=',ib,&
+                 ' with location lon, lat = ',latlon(ib,2), latlon(ib,1)
+            DO it=1, Ntypes
+              DO itt=1, d4
+                ovar(ib,INT((vmax(it)+vmin(it))/two),itt) = un
+              END DO
+            END DO
+          ENDIF
+!!$          DO itt = 1, d4
+!!$             IF (SUM(ovar(ib,:,itt)) > 1.0000001) THEN
+!!$                IF (printlev>=3) THEN
+!!$                   WRITE(numout,*) '  interpweight_provide_fractions4D On point ', ib, &
+!!$                        ' location: ', latlon(ib,2), latlon(ib,1),' itt=', itt, &
+!!$                        ' total fractions=', SUM(ovar(ib,:,itt))
+!!$                   WRITE(numout,*) '  type fraction:'
+!!$                   DO i=1, Ntypes
+!!$                      WRITE(numout,*) i, ovar(ib,:,itt)
+!!$                   END DO
+!!$                END IF
+!!$                msg='total of fractions above 1.!'
+!!$                CALL ipslerr_p(3,'interpweight_provide_fractions4D',TRIM(msg),'','')
+!!$             END IF
+!!$          END DO
+       END DO
+       
+      CASE DEFAULT
+        CALL ipslerr_p(3,'interpweight_provide_fractions4D',"Inerpolation type '" // TRIM(tint) // "' not ready!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_provide_fractions4D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_provide_interpolation2D
+!!
+!>\BRIEF        ! perform the interpolation for a continuos 2D field
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ovar, aovar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_provide_interpolation2D(tint, npt, d1, d2, dx, dy, d3, d4,                  &
+    nbmax, zeroval, ivar2D, sarea, sindex, vmax, vmin, one, two, latlon,                              &
+    defaultval, defaultNOval, ovar, aovar)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=50), INTENT(in)                        :: tint          !! tint: type of interpolation
+                                                                          !!   'XYKindTime': Input values are kinds 
+                                                                          !!     of something with a temporal 
+                                                                          !!     evolution on the dx*dy matrix
+    INTEGER, INTENT(in)                                  :: npt           !! total number of grid points
+    INTEGER, INTENT(in)                                  :: d1, d2, d3, & !! shape of the input values
+      d4, dx, dy
+    INTEGER, INTENT(in)                                  :: nbmax         !! maximum input grid cells to use 
+                                                                          !!   for in 1 grid point
+    REAL(r_std), INTENT(in)                              :: zeroval,one,two !! zero 1. and 2. real values
+    REAL(r_std), DIMENSION(dx,dy), INTENT(in)            :: ivar2D        !! values of the input data
+    REAL(r_std), DIMENSION(npt,nbmax), INTENT(in)        :: sarea         !! overlaping area of a given input 
+                                                                          !!   grid point
+    INTEGER(i_std), DIMENSION(npt,nbmax,2), INTENT(in)   :: sindex        !! index of the overlaping input 
+                                                                          !!   grid point
+    REAL(r_std), DIMENSION(npt,2), INTENT(in)            :: latlon        !! longitude and latitude of the destiny
+                                                                          !!   grid points
+    REAL(r_std), INTENT(in)                              :: defaultval    !! default interpolated value, only usef if tint='default'
+    REAL(r_std), INTENT(in)                              :: defaultNOval  !! default interpolated NO value, only used if tint='slopecalc'
+    !! 0.2 Modified variables
+    REAL(r_std), INTENT(in)                              :: vmax, vmin    !! thresholds of the values
+    !! 0.3 Output variables
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: ovar          !! output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: aovar         !! availability of input data to 
+                                                                          !!   interpolate output variable (on 
+                                                                          !!   the nbpt space)
+                                                                          !!     >0.: As the total sum of the 
+                                                                          !!       space fraction used from the 
+                                                                          !!       source
+                                                                          !!     -1: Found any required values 
+                                                                          !!       from input data
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,ij,ib,idi,jj,ip,jp,jv,it
+    INTEGER                                              :: idi_last
+    REAL(r_std)                                          :: int1D
+    CHARACTER(LEN=250)                                   :: msg
+
+
+! Initialization
+!!
+    ovar = zeroval
+
+    SELECT CASE (tint)
+      CASE ('default')
+        IF (printlev>=3) WRITE(numout,*)'Fractions following default method'
+        IF (ALL(ivar2D == zeroval)) THEN
+          msg = "' wrong 2D input variable"
+          CALL ipslerr_p(3,'interpweight_provide_interpolation2D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF
+
+        DO ib = 1, npt
+          !-
+          !- Reinfiltration coefficient due to the slope: Calculation with parameteres maxlope_ro 
+          !-
+          int1D = zeroval
+
+          ! Initialize last index to the highest possible 
+          idi_last=nbmax
+          aovar(ib) = zero
+          DO idi=1, nbmax
+             ! Leave the do loop if all sub areas are treated, sub_area <= 0
+             IF ( sarea(ib,idi) <= zeroval ) THEN
+                ! Set last index to the last one used
+                idi_last=idi-1
+                ! Exit do loop
+                EXIT
+             END IF
+
+             ip = sindex(ib,idi,1)
+             jp = sindex(ib,idi,2)
+
+             int1D = int1D + ivar2D(ip,jp) * sarea(ib,idi)
+             aovar(ib) = aovar(ib) + sarea(ib,idi)
+          ENDDO
+
+          IF ( idi_last >= 1 ) THEN
+             ovar(ib) = int1D / aovar(ib)
+          ELSE
+             ovar(ib) = defaultval
+            !
+            ! Quality variable
+            aovar(ib) = -1.
+          ENDIF
+        ENDDO
+      CASE ('slopecalc')
+        IF (printlev>=3) WRITE(numout,*)'Fractions following slopecalc method'
+        IF (ALL(ivar2D == zeroval)) THEN
+          msg = "' requires a 2D input variable"
+          CALL ipslerr_p(3,'interpweight_provide_interpolation2D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF
+
+        DO ib = 1, npt
+          !-
+          !- Reinfiltration coefficient due to the slope: Calculation with parameteres maxlope_ro 
+          !-
+          int1D = zeroval
+
+          ! Initialize last index to the highest possible 
+          idi_last=nbmax
+          aovar(ib) = zero
+          DO idi=1, nbmax
+             ! Leave the do loop if all sub areas are treated, sub_area <= 0
+             IF ( sarea(ib,idi) <= zeroval ) THEN
+                ! Set last index to the last one used
+                idi_last=idi-1
+                ! Exit do loop
+                EXIT
+             END IF
+
+             ip = sindex(ib,idi,1)
+             jp = sindex(ib,idi,2)
+
+             int1D = int1D + MIN(ivar2D(ip,jp)/defaultNOval,un) * sarea(ib,idi)
+             aovar(ib) = aovar(ib) + sarea(ib,idi)
+          ENDDO
+
+          IF ( idi_last >= 1 ) THEN
+             ovar(ib) = un - int1D / aovar(ib)
+          ELSE
+             ovar(ib) = defaultval
+            !
+            ! Quality variable
+            aovar(ib) = -1.
+          ENDIF
+        ENDDO
+
+      CASE DEFAULT
+        CALL ipslerr_p(3,'interpweight_provide_interpolation2D',"Inerpolation type '" // TRIM(tint) // "' not ready!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_provide_interpolation2D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_provide_interpolation4D
+!!
+!>\BRIEF        ! perform the interpolation for a continuos 4D field
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ovar, aovar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_provide_interpolation4D(tint, npt, d1, d2, dx, dy, d3, d4,                  &
+    nbmax, zeroval, ivar4D, sarea, sindex, vmax, vmin, one, two, latlon,                              &
+    defaultval, defaultNOval, ovar, aovar)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=50), INTENT(in)                        :: tint          !! tint: type of interpolation
+                                                                          !!   'XYKindTime': Input values are kinds 
+                                                                          !!     of something with a temporal 
+                                                                          !!     evolution on the dx*dy matrix
+    INTEGER, INTENT(in)                                  :: npt           !! total number of grid points
+    INTEGER, INTENT(in)                                  :: d1, d2, d3, & !! shape of the input values
+      d4, dx, dy
+    INTEGER, INTENT(in)                                  :: nbmax         !! maximum input grid cells to use 
+                                                                          !!   for in 1 grid point
+    REAL(r_std), INTENT(in)                              :: zeroval,two,one  !! zero 1. and 2. real values
+    REAL(r_std), DIMENSION(dx,dy,d3,d4), INTENT(in)      :: ivar4D        !! values of the input data
+    REAL(r_std), DIMENSION(npt,nbmax), INTENT(in)        :: sarea         !! overlaping area of a given input 
+                                                                          !!   grid point
+    INTEGER(i_std), DIMENSION(npt,nbmax,2), INTENT(in)   :: sindex        !! index of the overlaping input 
+                                                                          !!   grid point
+    REAL(r_std), DIMENSION(npt,2), INTENT(in)            :: latlon        !! longitude and latitude of the destiny
+                                                                          !!   grid points
+    REAL(r_std), DIMENSION(d1,d2), INTENT(in)            :: defaultval    !! default interpolated value
+    REAL(r_std), INTENT(in)                              :: defaultNOval  !! default interpolated NO value
+    !! 0.2 Modified variables
+    REAL(r_std), INTENT(in)                              :: vmax, vmin    !! thresholds of the values
+    !! 0.3 Output variables
+    REAL(r_std), DIMENSION(npt,d1,d2), INTENT(out)       :: ovar          !! output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: aovar         !! availability of input data to 
+                                                                          !!   interpolate output variable (on 
+                                                                          !!   the nbpt space)
+                                                                          !!     >0.: As the total sum of the 
+                                                                          !!       space fraction used from the 
+                                                                          !!       source
+                                                                          !!     -1: Found any required values 
+                                                                          !!       from input data
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,ij,ib,idi,jj,ip,jp,jv,it
+    INTEGER                                              :: ilf, fopt
+    REAL(r_std)                                          :: totarea
+    CHARACTER(LEN=250)                                   :: msg
+! Debug
+    INTEGER                                              :: nbptlL
+    REAL(r_std), DIMENSION(npt,d1,d2)                    :: ovartst
+
+
+! Initialization
+!!
+    ovar = zero
+    ovartst = zero
+
+    SELECT CASE (tint)
+      CASE ('default')
+        IF (printlev>=3) WRITE(numout,*)'Fractions following default method'
+        IF ( ALL(ivar4D == zeroval) ) THEN
+          msg = "' wrong 4D input variable"
+          CALL ipslerr_p(3,'provide_interpolation4D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF
+
+        DO ib = 1, npt
+
+          fopt = COUNT(sarea(ib,:) > zero)
+          aovar(ib) = zero
+
+          IF ( fopt > 0 ) THEN
+            !-
+            !- Reinfiltration coefficient
+            !-
+            totarea = zeroval
+ 
+            DO ilf=1, fopt
+               ! Leave the do loop if all sub areas are treated, sub_area <= 0
+               ip = sindex(ib,ilf,1)
+               jp = sindex(ib,ilf,2)
+
+               DO jv=1,d1
+                 DO it=1,d2
+                   ovar(ib,jv,it) = ovar(ib,jv,it) + ivar4D(ip,jp,jv,it)*sarea(ib,ilf)
+                 END DO
+               END DO
+               totarea = totarea + sarea(ib,ilf)
+            ENDDO
+            ! Normalize
+            ovar(ib,:,:) = ovar(ib,:,:)/totarea
+            aovar(ib) = totarea
+          ELSE
+        ! Set defalut value for points where the interpolation fail
+            IF (printlev>=3) THEN
+               WRITE(numout,*) 'provide_interpolation4D: no point found !!'
+               WRITE(numout,*) 'On point ', ib, ' no points were found for interpolation data. ' //      &
+                    'Default values are used.'
+               WRITE(numout,*) 'Location : ', latlon(ib,2), latlon(ib,1)
+            END IF
+            ovar(ib,ivis,:) = defaultval(ivis,:)
+            ovar(ib,inir,:) = defaultval(inir,:) 
+            aovar(ib) = -un
+          END IF
+        ENDDO
+
+      CASE DEFAULT
+        CALL ipslerr_p(3,'provide_interpolation4D',"Inerpolation type '" // TRIM(tint) // "' not ready!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_provide_interpolation4D
+
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_get_var2dims_file
+!!
+!>\BRIEF        ! Function to get the dimensions of a given 2D variable inside a file
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_get_var2dims_file
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_get_var2dims_file(filename, varname)
+
+    USE netcdf
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=*), INTENT(in)                         :: filename      !! filename: name of the file to open
+    CHARACTER(LEN=*), INTENT(in)                         :: varname       !! varname: name of the variable 
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
+    INTEGER, DIMENSION(2)                                :: interpweight_get_var2dims_file
+    !! 0.4 Local variables
+    INTEGER                                              :: nid, vid, Ndims
+    INTEGER                                              :: rcode
+    INTEGER, DIMENSION(2)                                :: dimsid
+    CHARACTER(LEN=250)                                   :: msg
+
+
+    IF (LEN_TRIM(varname) < 1) THEN
+      msg = "  interpweight_get_var2dims_file: any variable name '" // TRIM(varname) // "' was provided !!"
+      CALL ipslerr_p(3,'interpweight_get_var2dims_file',TRIM(msg), '', '')
+    END IF
+
+    IF (is_root_prc) THEN
+       ! Open file for read only mode
+       rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_open', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       rcode = nf90_inq_varid(nid, varname, vid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_inq_varid', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_inquire_variable 1', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       IF (Ndims /= 2) THEN
+          msg = "variable '" // TRIM(varname) // "' has not 2 dimensions!!"
+          CALL ipslerr_p(3,'interpweight_get_var2dims_file',TRIM(msg), '', '')
+       END IF
+       
+       rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_inquire_variable 2', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = interpweight_get_var2dims_file(1))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_inquire_dimension 1', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = interpweight_get_var2dims_file(2))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_inquire_dimension 2', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = NF90_CLOSE(nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_close', &
+            TRIM(nf90_strerror(rcode)),'')
+    END IF
+
+    CALL bcast(interpweight_get_var2dims_file)
+
+  END FUNCTION interpweight_get_var2dims_file
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_get_var3dims_file
+!!
+!>\BRIEF        ! Function to get the dimensions of a given 3D variable inside a file
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_get_var3dims_file
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_get_var3dims_file(filename, varname)
+
+    USE netcdf
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=*), INTENT(in)                         :: filename      !! filename: name of the file to open
+    CHARACTER(LEN=*), INTENT(in)                         :: varname       !! varname: name of the variable 
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(3)                                :: interpweight_get_var3dims_file
+    !! 0.4 Local variables
+    INTEGER                                              :: nid, vid, Ndims
+    INTEGER                                              :: rcode
+    INTEGER, DIMENSION(3)                                :: dimsid
+    CHARACTER(LEN=250)                                   :: msg
+
+
+    IF (LEN_TRIM(varname) < 1) THEN
+      msg = "  interpweight_get_var3dims_file: any variable name '" // TRIM(varname) // "' was provided !!"
+      CALL ipslerr_p(3,'interpweight_get_var3dims_file',TRIM(msg), '', '')
+    END IF
+
+    IF (is_root_prc) THEN
+       ! Open file for read only mode
+       rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_open', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inq_varid(nid, varname, vid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_inq_varid', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_inquire_variable 1', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       IF (Ndims /= 3) THEN
+          msg = "variable '" // TRIM(varname) // "' has not 3 dimensions!!"
+          CALL ipslerr_p(3,'interpweight_get_var3dims_file',TRIM(msg), '', '')
+       END IF
+       
+       rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_inquire_variable 2', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = interpweight_get_var3dims_file(1))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_dimesion 1', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = interpweight_get_var3dims_file(2))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_dimension 2', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = interpweight_get_var3dims_file(3))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_dimension 3', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = NF90_CLOSE(nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_close', &
+            TRIM(nf90_strerror(rcode)),'')
+    END IF
+    CALL bcast(interpweight_get_var3dims_file)
+
+  END FUNCTION interpweight_get_var3dims_file
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_get_var4dims_file
+!!
+!>\BRIEF        ! Function to get the dimensions of a given 4D variable inside a file
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_get_var4dims_file
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_get_var4dims_file(filename, varname)
+
+    USE netcdf
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=*), INTENT(in)                         :: filename      !! filename: name of the file to open
+    CHARACTER(LEN=*), INTENT(in)                         :: varname       !! varname: name of the variable 
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(4)                                :: interpweight_get_var4dims_file
+    !! 0.4 Local variables
+    INTEGER                                              :: nid, vid, Ndims
+    INTEGER                                              :: rcode
+    INTEGER, DIMENSION(4)                                :: dimsid
+    CHARACTER(LEN=250)                                   :: msg
+
+    IF (LEN_TRIM(varname) < 1) THEN
+      msg = "  interpweight_get_var4dims_file: any variable name '" // TRIM(varname) // "' was provided !!"
+      CALL ipslerr_p(3,'interpweight_get_var4dims_file',TRIM(msg), '', '')
+    END IF
+
+    IF (is_root_prc) THEN
+       ! Open file for read only mode
+       rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_open', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inq_varid(nid, varname, vid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inq_varid', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inquire_variable 1', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       IF (Ndims /= 4) THEN
+          msg = "variable '" // TRIM(varname) // "' has not 4 dimensions!!"
+          CALL ipslerr_p(3,'interpweight_get_var4dims_file',TRIM(msg), '', '')
+       END IF
+
+       rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inquire_variable 2', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = interpweight_get_var4dims_file(1))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inquire_dimension 1', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = interpweight_get_var4dims_file(2))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inquire_dimension 2', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = interpweight_get_var4dims_file(3))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inquire_dimension 3', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(4), LEN = interpweight_get_var4dims_file(4))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inquire_dimension 4', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       rcode = NF90_CLOSE(nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_close', &
+            TRIM(nf90_strerror(rcode)),'')
+    END iF
+    CALL bcast(interpweight_get_var4dims_file)
+
+  END FUNCTION interpweight_get_var4dims_file
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_get_varNdims_file
+!!
+!>\BRIEF        ! Function to get the rank(number of dimensions) of a given variable inside a file
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_get_varNdims_file
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  INTEGER FUNCTION interpweight_get_varNdims_file(filename, varname)
+
+    USE netcdf
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=*), INTENT(in)                         :: filename      !! filename: name of the file to open
+    CHARACTER(LEN=*), INTENT(in)                         :: varname       !! varname: name of the variable 
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: nid, vid
+    INTEGER                                              :: rcode
+    CHARACTER(LEN=256)                                   :: msg
+
+
+    IF (LEN_TRIM(varname) < 1) THEN
+      msg = "  interpweight_get_varNdims_file: any variable name '" // TRIM(varname) // "' was provided !!"
+      CALL ipslerr_p(3,'interpweight_get_varNdims_file',TRIM(msg), '', '')
+    END IF
+
+    IF (is_root_prc) THEN
+       
+       ! Open file for read only mode
+       rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_varNdims_file','Problem with nf90_open', &
+            TRIM(nf90_strerror(rcode)), '')
+       
+       rcode = nf90_inq_varid(nid, varname, vid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_varNdims_file','Problem with nf90_inq_varid', &
+            TRIM(nf90_strerror(rcode)), '')
+       
+       rcode = nf90_inquire_variable(nid, vid, NDIMS = interpweight_get_varNdims_file)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_varNdims_file','Problem with nf90_inquire_variable', &
+            TRIM(nf90_strerror(rcode)), '')
+
+       rcode = NF90_CLOSE(nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_varNdims_file','Problem with nf90_close', &
+            TRIM(nf90_strerror(rcode)), '')
+    END IF
+    CALL bcast(interpweight_get_varNdims_file)
+
+  END FUNCTION interpweight_get_varNdims_file
+
+!!================================================================================================================================
+!! FUNCTION     : isin_file
+!!
+!>\BRIEF        ! Function to tell if a given variable is inside a file
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : isin_file
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+LOGICAL FUNCTION isin_file(filename, varname)
+
+    USE netcdf
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=*), INTENT(in)                         :: filename      !! filename: name of the file to open
+    CHARACTER(LEN=*), INTENT(in)                         :: varname       !! varname: name of the variable 
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: nid, vid, Ndims, Nvars
+    INTEGER                                              :: iv, rcode
+    CHARACTER(LEN=1000)                                  :: varinfile
+    CHARACTER(LEN=250)                                   :: msg
+
+
+    IF (is_root_prc) THEN
+       rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'isin_file','Problem with nf90_open',TRIM(nf90_strerror(rcode)),'')
+
+       rcode = nf90_inquire(nid, Ndims, Nvars)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'isin_file','Problem with nf90_inquire',TRIM(nf90_strerror(rcode)),'')
+
+       DO iv=1, Nvars
+          rcode = nf90_inquire_variable(nid, iv, name=varinfile)
+          IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'isin_file','Problem with nf90_inquire_variable',TRIM(nf90_strerror(rcode)),'')
+          
+          IF (TRIM(varinfile) == TRIM(varname)) THEN
+             isin_file = .TRUE.
+             EXIT
+          ELSE
+             isin_file = .FALSE.
+          END IF
+       END DO
+
+       rcode = NF90_CLOSE(nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'isin_file','Problem with nf90_close',TRIM(nf90_strerror(rcode)),'')
+    END IF
+
+    CALL bcast(isin_file)
+
+  END FUNCTION isin_file
+
+!!!!!!! !!!!!! !!!!! !!!! !!! !! !
+! Generic functions no netCDF
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_Index1DArrayI
+!!
+!>\BRIEF        ! Function to provide the first index of a given value inside a 1D intger array
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_Index1DArrayI
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  INTEGER FUNCTION interpweight_Index1DArrayI(array1D, d1, val)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! size of the array
+    INTEGER, INTENT(in)                                  :: val           !! value to search
+    INTEGER, DIMENSION(d1), INTENT(in)                   :: array1D       !! values of the array
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i
+
+
+    interpweight_Index1DArrayI = -1
+
+    DO i=1,d1
+      IF (array1d(i) == val) THEN
+        interpweight_Index1DArrayI = i
+        EXIT
+      END IF
+    END DO
+
+  END FUNCTION interpweight_Index1DArrayI
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_Index1DArrayR
+!!
+!>\BRIEF        ! Function to provide the first index of a given value inside a 1D real array
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_Index1DArrayR
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  INTEGER FUNCTION interpweight_Index1DArrayR(array1D, d1, val)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! size of the array 
+    REAL, INTENT(in)                                     :: val           !! value to search
+    REAL, DIMENSION(d1), INTENT(in)                      :: array1D       !! values of the array
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i
+
+    interpweight_Index1DArrayR = -1
+
+    DO i=1,d1
+      IF (array1d(i) == val) THEN
+        interpweight_Index1DArrayR = i
+        EXIT
+      END IF
+    END DO
+
+  END FUNCTION interpweight_Index1DArrayR
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_Index2DArrayI
+!!
+!>\BRIEF        ! Function to provide the first index of a given value inside a 2D integer array
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_Index2DArrayI
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_Index2DArrayI(array2D, d1, d2, val)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1, d2        !! size of the array 
+    INTEGER, INTENT(in)                                  :: val           !! value to search
+    INTEGER, DIMENSION(d1,d2), INTENT(in)                :: array2D       !! values of the array
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(2)                                :: interpweight_Index2DArrayI
+    !! 0.4 Local variables
+    INTEGER                                              :: i, j
+
+
+    interpweight_Index2DArrayI = -1
+
+    DO i=1,d1
+      DO j=1,d2
+        IF (array2d(i,j) == val) THEN
+          interpweight_Index2DArrayI(1) = i
+          interpweight_Index2DArrayI(2) = j
+          EXIT
+        END IF
+      END DO
+    END DO
+
+  END FUNCTION interpweight_Index2DArrayI
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_Index2DArrayR
+!!
+!>\BRIEF        ! Function to provide the first index of a given value inside a 2D real array
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : bm_vol
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_Index2DArrayR(array2D, d1, d2, val)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1, d2        !! size of the array 
+    REAL, INTENT(in)                                     :: val           !! value to search
+    REAL, DIMENSION(d1,d2), INTENT(in)                   :: array2D       !! values of the array
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(2)                                :: interpweight_Index2DArrayR
+    !! 0.4 Local variables
+    INTEGER                                              :: i, j
+
+    interpweight_Index2DArrayR = -1
+
+    DO i=1,d1
+      DO j=1,d2
+        IF (array2d(i,j) == val) THEN
+          interpweight_Index2DArrayR(1) = i
+          interpweight_Index2DArrayR(2) = j
+          EXIT
+        END IF
+      END DO
+    END DO
+
+  END FUNCTION interpweight_Index2DArrayR
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_Index1DLonLat
+!!
+!>\BRIEF        ! Function to provide the first index of a given pair of 
+!! longitude and latitude from a set of lon, lat 1D arrays
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_Index1DLonLat
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  INTEGER FUNCTION interpweight_Index1DLonLat(lon, lat, d1, lonval, latval)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! size of the array 
+    REAL(r_std), INTENT(in)                              :: lonval,latval !! longitude and latitude value
+    REAL(r_std), DIMENSION(d1), INTENT(in)               :: lon, lat      !! longitude and latitudes to search in
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i
+    REAL(r_std)                                          :: mindist
+    REAL(r_std), DIMENSION(d1)                           :: dist
+
+
+    interpweight_Index1DLonLat = -1
+
+    dist = SQRT((lon - lonval)**2. + (lat - latval)**2.)
+!    mindist = MINVAL(ABS(dist))
+    mindist = 0.
+
+    DO i=1,d1
+      IF (dist(i) == mindist) THEN
+        interpweight_Index1DLonLat = i
+        EXIT
+      END IF
+    END DO
+
+  END FUNCTION interpweight_Index1DLonLat
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_Index2DLonLat
+!!
+!>\BRIEF          Function to provide the first index of a given pair of longitude and latitude
+!!                from a set of lon, lat 2D arrays
+!!
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_Index2DLonLat
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_Index2DLonLat(lon, lat, d1, d2, lonval, latval)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1, d2        !! size of the array 
+    REAL(r_std), INTENT(in)                              :: lonval,latval !! longitude and latitude value
+    REAL(r_std), DIMENSION(d1,d2), INTENT(in)            :: lon, lat      !! longitude and latitudes to search in
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(2)                                :: interpweight_Index2DLonLat
+    !! 0.4 Local variables
+    INTEGER                                              :: i, j
+    REAL(r_std)                                          :: mindist
+    REAL(r_std), DIMENSION(d1,d2)                        :: dist
+
+
+    interpweight_Index2DLonLat = -1
+
+    dist = SQRT((lon - lonval)**2. + (lat - latval)**2.)
+    mindist = 0.
+
+    DO i=1,d1
+      DO j=1,d2
+        IF (dist(i,j) == mindist) THEN
+          interpweight_Index2DLonLat(1) = i
+          interpweight_Index2DLonLat(2) = j
+          EXIT
+        END IF
+      END DO
+    END DO
+
+  END FUNCTION interpweight_Index2DLonLat
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_RangeI
+!!
+!>\BRIEF        ! Function to provide a range of d1 values from 'iniv' to 
+!!  'endv', of integer values in a vector
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_RangeI
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_RangeI(d1, iniv, endv)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! number of values
+    INTEGER, INTENT(in)                                  :: iniv          !! initial value
+    INTEGER, INTENT(in)                                  :: endv          !! end value
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(d1)                               :: interpweight_RangeI
+    !! 0.4 Local variables
+    INTEGER                                              :: i, intv
+
+    intv = (endv - iniv) / (d1*1 - 1)
+
+    interpweight_RangeI(1) = iniv
+    DO i=2,d1
+      interpweight_RangeI(i) = interpweight_RangeI(i-1) + intv
+    END DO
+
+  END FUNCTION interpweight_RangeI 
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_RangeR
+!!
+!>\BRIEF        ! Function to provide a range of d1 values from 'iniv' to 
+!!  'endv', of real values in a vector
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_RangeR
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_RangeR(d1, iniv, endv)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! number of values
+    REAL, INTENT(in)                                     :: iniv          !! initial value
+    REAL, INTENT(in)                                     :: endv          !! end value
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    REAL, DIMENSION(d1)                                  :: interpweight_RangeR
+    !! 0.4 Local variables
+    INTEGER                                              :: i
+    REAL                                                 :: intv
+
+    intv = (endv - iniv) / (d1*1. - 1.)
+
+    interpweight_RangeR(1) = iniv
+    DO i=2,d1
+      interpweight_RangeR(i) = interpweight_RangeR(i-1) + intv
+    END DO
+
+  END FUNCTION interpweight_RangeR
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_ValVecI
+!!
+!>\BRIEF        ! Function to provide the number of times and where that a 
+!!  given value 'oper' on a vector of integers
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_ValVecI
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_ValVecI(vec, d1, val, oper)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! Number of values
+    INTEGER, DIMENSION(d1), INTENT(in)                   :: vec           !! vector of integer values
+    INTEGER, INTENT(in)                                  :: val           !! value to search
+    CHARACTER(LEN=*), INTENT(in)                         :: oper          !! operation:
+                                                                          !!   'eq': equal
+                                                                          !!   'ge': greater or equal
+                                                                          !!   'le': less or equal
+                                                                          !!   'ne': not equal
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(d1)                               :: interpweight_ValVecI !! Vector with positions 
+                                                                                 !! (NtimesVal, pos1, pos2, ..., posNtimesVal, ...)
+                                                                                 !! NtimesVal=number of correspondencies with 'oper'
+    !! 0.4 Local variables
+    INTEGER                                              :: i, NtimesVal
+    CHARACTER(LEN=50)                                    :: errormsg
+
+    errormsg = 'ERROR -- error -- ERROR -- error'
+
+    NtimesVal = 0
+    DO i=1,d1
+      SELECT CASE(oper)
+        CASE ('eq')
+          IF (vec(i) == val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecI(NtimesVal + 1) = i
+          END IF
+        CASE ('ge')
+          IF (vec(i) >= val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecI(NtimesVal + 1) = i
+          END IF
+        CASE ('le')
+          IF (vec(i) <= val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecI(NtimesVal + 1) = i
+          END IF
+        CASE ('neq')
+          IF (vec(i) /= val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecI(NtimesVal + 1) = i
+          END IF
+        CASE DEFAULT
+          WRITE(numout,*)TRIM(errormsg)
+          WRITE(numout,*)"  interpweight_ValVecI: operation '" // TRIM(oper) // "' not ready!!"
+          WRITE(numout,*)"    only available: 'eq', 'ge', 'le', 'neq'"
+          CALL ipslerr_p (3, 'interpweight_ValVecI', 'wrong operation', 'provide another one', '')
+      END SELECT
+    END DO
+    interpweight_ValVecI(1) = NtimesVal
+
+
+  END FUNCTION interpweight_ValVecI
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_ValVecR
+!!
+!>\BRIEF         Function to provide the number of times and where that a 
+!!  given value 'oper' on a vector of reals
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_ValVecR
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_ValVecR(vec, d1, val, oper)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! Number of values
+    REAL, DIMENSION(:), INTENT(in)                      :: vec           !! vector of integer values
+    REAL, INTENT(in)                                     :: val           !! value to search
+    CHARACTER(LEN=*), INTENT(in)                         :: oper          !! operation:
+                                                                          !!   'eq': equal
+                                                                          !!   'ge': greater or equal
+                                                                          !!   'le': less or equal
+                                                                          !!   'neq': not equal
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(d1)                               :: interpweight_ValVecR !! Vector with positions 
+                                                                                 !! (NtimesVal, pos1, pos2, ..., posNtimesVal, ...)
+                                                                                 !! NtimesVal=number of correspondencies with 'oper'
+    !! 0.4 Local variables
+    INTEGER                                              :: i, NtimesVal
+    CHARACTER(LEN=50)                                    :: errormsg
+
+    errormsg = 'ERROR -- error -- ERROR -- error'
+
+    NtimesVal = 0
+    DO i=1,d1
+      SELECT CASE(oper)
+        CASE ('eq')
+          IF (vec(i) == val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecR(NtimesVal + 1) = i
+          END IF
+        CASE ('ge')
+          IF (vec(i) >= val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecR(NtimesVal + 1) = i
+          END IF
+        CASE ('le')
+          IF (vec(i) <= val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecR(NtimesVal + 1) = i
+          END IF
+        CASE ('neq')
+          IF (vec(i) /= val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecR(NtimesVal + 1) = i
+          END IF
+        CASE DEFAULT
+          WRITE(numout,*)TRIM(errormsg)
+          WRITE(numout,*)"  interpweight_ValVecR: operation '" // TRIM(oper) // "' not ready!!"
+          WRITE(numout,*)"    only available: 'eq', 'ge', 'le', 'neq'"
+          CALL ipslerr_p (3, 'interpweight_ValVecR', 'wrong operation', 'provide another one', '')
+      END SELECT
+    END DO
+    interpweight_ValVecR(1) = NtimesVal
+
+
+  END FUNCTION interpweight_ValVecR
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_From2DmatTo1Dvec
+!!
+!>\BRIEF        ! Suroutine to provide value on a transformation from a 2D 
+!!  matrix to a 1D vector
+!!    e.g.: from T2(i,j) to T2M(ijklon)
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_From2DmatTo1Dvec
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  INTEGER FUNCTION interpweight_From2DmatTo1Dvec(ix,iy,dx,dy)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: ix,iy         !! location within the 2D matrix
+    INTEGER, INTENT(in)                                  :: dx,dy         !! dimension of the 2D matrix
+
+    IF (ix > dx) THEN
+      WRITE(numout,*) "Error: "
+      WRITE(numout,*)"  interpweight_From2DmatTo1Dvec: 'ix' too large ix > dx ", ix, '>', dx, '!!'
+      CALL ipslerr_p (3, 'interpweight_From2DmatTo1Dvec', 'ix value too big', 'out of bounds', '')
+    END IF
+
+    IF (iy > dy) THEN
+      WRITE(numout,*) "Error: "
+      WRITE(numout,*)"  interpweight_From2DmatTo1Dvec: 'iy' too large iy > dy ", iy, '>', dy, '!!'
+      CALL ipslerr_p (3, 'interpweight_From2DmatTo1Dvec', 'iy value too big', 'out of bounds', '')
+    END IF
+
+    interpweight_From2DmatTo1Dvec = (ix-1)*dy + iy
+
+  END FUNCTION interpweight_From2DmatTo1Dvec
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_From1DvecTo2Dmat
+!!
+!>\BRIEF        ! Suroutine to provide value on a transformation from a 1D 
+!!  vector to a 2D matrix 
+!!     e.g.: from T2M(ijklon) to T2(i,j)
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_From1DvecTo2Dmat
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_From1DvecTo2Dmat(ivec,dx,dy)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: ivec              !! position within the 1D vec
+    INTEGER, INTENT(in)                                  :: dx,dy             !! dimension of the 2D matrix
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(2)                                :: interpweight_From1DvecTo2Dmat
+
+
+    IF (ivec > dx*dy) THEN
+      WRITE(numout,*) "Error: "
+      WRITE(numout,*)"  interpweight_From1DvecTo2Dmat: 'ivec' too large ivec > dx*dy ", ivec, '>', dx*dy, '!!'
+      CALL ipslerr_p (3, 'interpweight_From1DvecTo2Dmat', "'ivec' too large", 'out of bounds!!', '')
+    END IF
+
+    interpweight_From1DvecTo2Dmat(1) = INT((ivec-1)/dy) + 1
+    interpweight_From1DvecTo2Dmat(2) = ivec - (interpweight_From1DvecTo2Dmat(1)-1)*dy
+
+  END FUNCTION interpweight_From1DvecTo2Dmat
+
+END MODULE interpweight
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/interregxy.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/interregxy.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/interregxy.f90	(revision 6412)
@@ -0,0 +1,490 @@
+MODULE interregxy
+
+  ! Modules used :
+
+  USE constantes
+  USE mod_orchidee_para
+  USE grid
+  USE module_llxy
+  USE polygones
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC interregxy_aggr2d, interregxy_aggrve
+
+CONTAINS
+
+  SUBROUTINE interregxy_aggr2d(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,NbNeighb)! 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 source grid
+    REAL(r_std), INTENT(in)      :: lon_rel(iml, jml)    ! Longitudes for the source grid
+    REAL(r_std), INTENT(in)      :: lat_rel(iml, jml)    ! Latitudes for the souce grid
+    INTEGER(i_std), INTENT(in)   :: mask(iml, jml)       ! Mask which retains only the significative points
+                                                         ! of the source grid.
+    CHARACTER(LEN=*), INTENT(in) :: callsign             ! Allows to specify which variable is beeing treated
+    INTEGER(i_std), INTENT(in)   :: incmax               ! Maximum point of the source 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
+    !
+    ! The number of sub-division we wish to have on each side of the rectangle.
+    ! sbd=1 means that on each side we take only the middle point.
+    !
+    INTEGER(i_std), PARAMETER  :: sbd=5
+    INTEGER(i_std), PARAMETER  :: idom=1
+    !
+    INTEGER(i_std)                                :: i, is, js, in
+    INTEGER(i_std)                                :: ilow, iup, jlow, jup
+    REAL(r_std)                                   :: dle, dlw, dls, dln
+    !
+    REAL(r_std), DIMENSION((sbd+1)*4+1)           :: lons, lats, ri, rj
+    !
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: nbov
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sourcei, sourcej
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)    :: overlap
+    LOGICAL                                       :: checkprint=.FALSE.
+    !
+    !
+    REAL(r_std), DIMENSION(2)   :: BBlon, BBlat
+    !
+    WRITE(*,*) "interregxy_aggr2d working on ", callsign
+    !
+    ALLOCATE(sourcei(iim_g, jjm_g, incmax))
+    ALLOCATE(sourcej(iim_g, jjm_g, incmax))
+    ALLOCATE(nbov(iim_g, jjm_g))
+    ALLOCATE(overlap(iim_g, jjm_g, incmax))
+    nbov(:,:) = 0
+    !
+    BBlon(1) = MINVAL(lalo(:,2))
+    BBlon(2) = MAXVAL(lalo(:,2))
+    BBlat(1) = MINVAL(lalo(:,1))
+    BBlat(2) = MAXVAL(lalo(:,1))
+    !
+    ! Go through the entire source grid and try to place each grid box in a target grid box.
+    !
+    DO is=1,iml
+       DO js=1,jml
+          !
+          ! 1.0 Get the center of the box and their corresponding grid point 
+          !
+          lons(1) = lon_rel(is,js)
+          lats(1) = lat_rel(is,js)
+          !
+          ! Assume all grids go from West to Est
+          dle=(lon_rel(MIN(is+1,iml),js)-lon_rel(is,js))/2.0
+          dlw=(lon_rel(is,js)-lon_rel(MAX(is-1,1),js))/2.0
+          ! 
+          IF ( lat_rel(1,1) < lat_rel(iml,jml)) THEN
+             ! Grid in SN direction
+             dls=(lat_rel(is,js)-lat_rel(is,MAX(js-1,1)))/2.0
+             dln=(lat_rel(is,MIN(js+1,jml))-lat_rel(is,js))/2.0
+          ELSE
+             dls=(lat_rel(is,js)-lat_rel(is,MIN(js+1,jml)))/2.0
+             dln=(lat_rel(is,MAX(js-1,1))-lat_rel(is,js))/2.0
+          ENDIF
+          ! Treat the border cases
+          IF ( dlw < dle/2. ) dlw = dle
+          IF ( dle < dlw/2. ) dle = dlw
+          !
+          IF ( dls < dln/2. ) dls = dln
+          IF ( dln < dls/2. ) dln = dls
+          !
+          DO i=0,sbd
+             ! Put the points in the order : SW, SE, NE, NW
+             lons(2+i) = lons(1) - dlw + i*((dlw+dle)/FLOAT(sbd+1))
+             lats(2+i) = lats(1) - dls
+             !
+             lons(2+(sbd+1)+i) = lons(1) + dle
+             lats(2+(sbd+1)+i) = lats(1) - dls + i*((dls+dln)/FLOAT(sbd+1))
+             !
+             lons(2+2*(sbd+1)+i) = lons(1) + dle - i*((dlw+dle)/FLOAT(sbd+1))
+             lats(2+2*(sbd+1)+i) = lats(1) + dln
+             !
+             lons(2+3*(sbd+1)+i) = lons(1) - dlw
+             lats(2+3*(sbd+1)+i) = lats(1) + dln - i*((dls+dln)/FLOAT(sbd+1))
+          ENDDO
+          !
+          ! Test that the polygone overlaps with the Bounding box. We might have projections
+          ! which are not valid outside of the RCM domain.
+          !
+          IF ( ((MINVAL(lons) > BBlon(1) .AND. MINVAL(lons) < BBlon(2)) .OR.   &
+             &  (MAXVAL(lons) > BBlon(1) .AND. MAXVAL(lons) < BBlon(2))) .AND. & 
+             & ((MINVAL(lats) > BBlat(1) .AND. MINVAL(lats) < BBlat(2)) .OR.   &
+             &  (MAXVAL(lats) > BBlat(1) .AND. MAXVAL(lats) < BBlat(2)))) THEN
+             !
+             !
+             CALL Grid_Toij (lons, lats, ri, rj)
+             !
+             !
+             ! Find the points of the WRF grid boxes we need to scan to place this box (is, js) 
+             ! of the source grid.
+             !
+             ilow = MAX(FLOOR(MINVAL(ri)),1)
+             iup  = MIN(CEILING(MAXVAL(ri)), iim_g)
+             jlow = MAX(FLOOR(MINVAL(rj)),1)
+             jup  = MIN(CEILING(MAXVAL(rj)), jjm_g)
+             !
+             !
+             IF ( ilow < iup .OR. jlow < jup ) THEN
+                !
+                ! Find the grid boxes in WRF and compute the overlap area.
+                !
+                CALL interregxy_findpoints(iim_g, jjm_g, lon_rel(is,js), lon_rel(is,js), is, js, ri, rj, incmax, &
+                     &    checkprint, nbov, sourcei, sourcej, overlap)
+                
+             ENDIF
+             !
+             !
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Gather the land points from the global grid
+    !
+    areaoverlap(:,:) = zero
+    DO in=1,nbpt
+       !
+       is = ilandindex(in)
+       js = jlandindex(in)
+       !
+       indinc(in,1:nbov(is,js),1) = sourcei(is,js,1:nbov(is,js))
+       indinc(in,1:nbov(is,js),2) = sourcej(is,js,1:nbov(is,js))
+       areaoverlap(in,1:nbov(is,js)) = overlap(is,js,1:nbov(is,js))
+    ENDDO
+    !
+    ! The model will stop if incmax is not sufficient. So if we are here all is OK.
+    !
+    ok=.TRUE.
+    !
+  END SUBROUTINE interregxy_aggr2d
+!
+! ===================================================================================
+!
+  SUBROUTINE interregxy_aggrve(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,NbNeighb)   ! 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 source grid
+    REAL(r_std), INTENT(in)      :: lon_rel(iml)         ! Longitudes for the source grid
+    REAL(r_std), INTENT(in)      :: lat_rel(iml)         ! Latitudes for the source grid
+    REAL(r_std), INTENT(in)      :: resol_lon, resol_lat ! Resolution in meters of the source grid
+    CHARACTER(LEN=*), INTENT(in) :: callsign             ! Allows to specify which variable is beeing treated
+    INTEGER(i_std), INTENT(in)   :: incmax               ! Maximum point of the source 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
+    !
+    ! The number of sub-division we wish to have on each side of the rectangle.
+    ! sbd=1 means that on each side we take only the middle point.
+    !
+    INTEGER(i_std), PARAMETER  :: sbd=5
+    INTEGER(i_std), PARAMETER  :: idom=1
+    !
+    INTEGER(i_std)                                :: i, is, js, in
+    INTEGER(i_std)                                :: ilow, iup, jlow, jup
+    REAL(r_std)                                   :: dle, dlw, dls, dln, coslat
+    !
+    REAL(r_std), DIMENSION((sbd+1)*4+1)           :: lons, lats, ri, rj
+    !
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: nbov
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sourcei, sourcej
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)    :: overlap
+    !
+    !
+    REAL(r_std), DIMENSION(2)   :: BBlon, BBlat
+    REAL(r_std)                 :: half_resol_lon, half_resol_lat, trtmp
+    LOGICAL                     :: checkprint=.FALSE.
+    !
+    WRITE(*,*) "interregxy_aggrve working on ", callsign
+    !
+    ALLOCATE(sourcei(iim_g, jjm_g, incmax))
+    ALLOCATE(sourcej(iim_g, jjm_g, incmax))
+    ALLOCATE(nbov(iim_g, jjm_g))
+    ALLOCATE(overlap(iim_g, jjm_g, incmax))
+    nbov(:,:) = 0
+    !
+    BBlon(1) = MINVAL(lalo(:,2))
+    BBlon(2) = MAXVAL(lalo(:,2))
+    BBlat(1) = MINVAL(lalo(:,1))
+    BBlat(2) = MAXVAL(lalo(:,1))
+    !
+    ! Go through the entire source grid and try to place each grid box in a target grid box.
+    !
+    DO is=1,iml
+       !
+       ! 1.0 Get the center of the box and their corresponding grid point 
+       !
+       lons(1) = lon_rel(is)
+       lats(1) = lat_rel(is)
+       ! Some pre-calculations
+       trtmp = 180./(2.*pi)
+       half_resol_lon = resol_lon/2.0
+       half_resol_lat = resol_lat/2.0
+       !
+       dln = half_resol_lat*trtmp/R_Earth
+       dls = half_resol_lat*trtmp/R_Earth
+       !
+       DO i=0,sbd
+          ! Put the points in the order : SW, SE, NE, NW
+          lats(2+i) = lats(1) - dls
+          coslat = COS( lats(2+i) * pi/180. )
+          dlw = half_resol_lon*trtmp/R_Earth/coslat
+          lons(2+i) = lons(1) - dlw + i*((2.*dlw)/FLOAT(sbd+1))
+          !
+          lats(2+(sbd+1)+i) = lats(1) - dls + i*((dls+dln)/FLOAT(sbd+1))
+          coslat = COS( lats(2+(sbd+1)+i) * pi/180. )
+          dle = half_resol_lon*trtmp/R_Earth/coslat
+          lons(2+(sbd+1)+i) = lons(1) + dle
+          !
+          lats(2+2*(sbd+1)+i) = lats(1) + dln
+          coslat = COS( lats(2+2*(sbd+1)+i) * pi/180. )
+          dle = half_resol_lon*trtmp/R_Earth/coslat
+          lons(2+2*(sbd+1)+i) = lons(1) + dle - i*((2*dle)/FLOAT(sbd+1))
+          !
+          lats(2+3*(sbd+1)+i) = lats(1) + dln - i*((dls+dln)/FLOAT(sbd+1))
+          coslat = COS( lats(2+3*(sbd+1)+i) * pi/180. )
+          dlw = half_resol_lon*trtmp/R_Earth/coslat
+          lons(2+3*(sbd+1)+i) = lons(1) - dlw
+       ENDDO
+       !
+       ! Test that the polygone overlaps with the Bounding box. We might have projections
+       ! which are not valid outside of the RCM domain.
+       !
+       IF ( ((MINVAL(lons) > BBlon(1) .AND. MINVAL(lons) < BBlon(2)) .OR.   &
+            &  (MAXVAL(lons) > BBlon(1) .AND. MAXVAL(lons) < BBlon(2))) .AND. & 
+            & ((MINVAL(lats) > BBlat(1) .AND. MINVAL(lats) < BBlat(2)) .OR.   &
+            &  (MAXVAL(lats) > BBlat(1) .AND. MAXVAL(lats) < BBlat(2)))) THEN
+          !
+          CALL Grid_Toij (lons, lats, ri, rj)
+          !
+          !
+          ! Find the points of the WRF grid boxes we need to scan to place this box (is, js) 
+          ! of the source grid.
+          !
+          ilow = MAX(FLOOR(MINVAL(ri)),1)
+          iup  = MIN(CEILING(MAXVAL(ri)), iim_g)
+          jlow = MAX(FLOOR(MINVAL(rj)),1)
+          jup  = MIN(CEILING(MAXVAL(rj)), jjm_g)
+          !
+          !
+          IF ( ilow < iup .OR. jlow < jup ) THEN
+             !
+             ! Find the grid boxes in WRF and compute the overlap area.
+             !
+             CALL interregxy_findpoints(iim_g, jjm_g, lon_rel(is), lon_rel(is), is, 1, ri, rj, incmax, &
+                  &    checkprint, nbov, sourcei, sourcej, overlap)
+             
+          ENDIF
+          !
+          !
+       ENDIF
+    ENDDO
+    !
+    ! Gather the land points from the global grid
+    !
+    areaoverlap(:,:) = zero
+    DO in=1,nbpt
+       !
+       is = ilandindex(in)
+       js = jlandindex(in)
+       !
+       indinc(in,1:nbov(is,js)) = sourcei(is,js,1:nbov(is,js))
+       areaoverlap(in,1:nbov(is,js)) = overlap(is,js,1:nbov(is,js))
+    ENDDO
+    !
+    ! The model will stop if incmax is not sufficient. So if we are here all is OK.
+    !
+    ok=.TRUE.
+    !
+  END SUBROUTINE interregxy_aggrve
+!
+! ===================================================================================
+!
+  SUBROUTINE interregxy_findpoints(nb_we, nb_sn, lon_cen, lat_cen, is, js, ri, rj, &
+       &                           nbpt_max, checkprint, nbpt, sourcei, sourcej, overlap_area)
+    !
+    !
+    !   This Subroutine finds the overlap of grid box ri,rj with the WRF grid.  (ri,rj) are the WRF indexes of the (is,js) point
+    !   of the source grid.
+    !   Each time we find an overlap of (is,js) with a WRF grid box (ix,jx) we add that in the (sourcei,sourcej) fields.
+    !
+    !
+    ! Arguments
+    !
+    INTEGER(i_std), INTENT(in)                      :: nb_we, nb_sn
+    REAL(r_std), INTENT(in)                         :: lon_cen, lat_cen
+    INTEGER(i_std), INTENT(in)                      :: is, js
+    REAL(r_std), DIMENSION(:), INTENT(in)           :: ri, rj
+    INTEGER(i_std), INTENT(in)                      :: nbpt_max
+    LOGICAL, INTENT(in)                             :: checkprint
+    INTEGER(i_std), DIMENSION(:,:), INTENT(out)     :: nbpt
+    INTEGER(i_std), DIMENSION(:,:,:), INTENT(out)   :: sourcei, sourcej
+    REAL(r_std), DIMENSION(:,:,:), INTENT(out)      :: overlap_area
+    !
+    ! Local
+    ! 
+    INTEGER(i_std)                                  :: ilow, iup, jlow, jup, nbr
+    INTEGER(i_std)                                  :: ix, jx, i
+
+    INTEGER(i_std)                                  :: nbint, nbcross, nbsorted, nbfinal, nbtmpa, nbtmpb
+    !
+    INTEGER(i_std)                                  :: nbdots=5, dimpoly = 200
+    REAL(r_std), DIMENSION(4,2)                     :: poly_wrf
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)        :: poly_in, poly_tmpa, poly_tmpb, poly_int, poly_cross
+    !
+    REAL(r_std)                                     :: ax, ay, overlaparea
+    !
+    INTEGER(i_std), PARAMETER                       :: icheck=50, jcheck=46
+    !
+    !
+    !
+    nbr = SIZE(ri)
+    !
+    IF ( dimpoly < 4*(nbr-1) ) THEN
+       dimpoly =  4*nbr
+    ENDIF
+    !
+    ALLOCATE(poly_in(nbr-1,2))
+    ALLOCATE(poly_tmpa(dimpoly,2))
+    ALLOCATE(poly_tmpb(dimpoly,2))
+    ALLOCATE(poly_int(dimpoly,2))
+    ALLOCATE(poly_cross(dimpoly,2))
+    !
+    ! Scan all Determine the range of indicis of the WRF grid we need to scan 
+    ! within the box of the source grid.
+    !
+    ilow = MAX(FLOOR(MINVAL(ri)),1)
+    iup  = MIN(CEILING(MAXVAL(ri)), nb_we)
+    jlow = MAX(FLOOR(MINVAL(rj)),1)
+    jup  = MIN(CEILING(MAXVAL(rj)), nb_sn)
+    !
+    !
+    poly_wrf(:,1) = (/ -0.5, 0.5, 0.5, -0.5 /)
+    poly_wrf(:,2) = (/ -0.5, -0.5, 0.5, 0.5 /)
+    !
+    DO ix = ilow,iup
+       DO jx = jlow,jup
+          !
+          ! Bring the points of the source grid into the +-0.5 range of the WRF grid ...
+          ! and remove the center point.
+          !
+          poly_in(1:nbr-1,1) = ri(2:nbr) - ix
+          poly_in(1:nbr-1,2) = rj(2:nbr) - jx
+          !
+          IF ( checkprint .AND. ix == icheck .AND. jx == jcheck ) THEN
+             WRITE(*,*) "X = ", poly_in(1:nbr-1,1)
+             WRITE(*,*) "Y = ", poly_in(1:nbr-1,2)
+          ENDIF
+          !
+          CALL polygones_extend(nbr-1, poly_in, nbdots, nbtmpa, poly_tmpa)
+          CALL polygones_extend(4, poly_wrf, nbdots, nbtmpb, poly_tmpb)
+          !
+          IF ( checkprint .AND. ix == icheck .AND. jx == jcheck ) THEN
+             WRITE(*,*) "X_extend = ", poly_tmpa(1:nbtmpa,1)
+             WRITE(*,*) "Y_extend = ", poly_tmpa(1:nbtmpa,2)
+          ENDIF
+          !
+          CALL polygones_intersection(nbtmpa, poly_tmpa, nbtmpb, poly_tmpb, nbint, poly_int) 
+          CALL polygones_crossing(nbr-1, poly_in,  4, poly_wrf, nbcross, poly_cross)
+          !
+          IF ( checkprint .AND. ix == icheck .AND. jx == jcheck ) THEN
+              WRITE(*,*) "nbint = nbcross = ", nbint, nbcross
+           ENDIF
+          !
+          IF ( nbint+nbcross > dimpoly ) THEN
+             WRITE(*,*) "The intersection of polygones is larger than the memory foressen : ",  nbint+nbcross, dimpoly
+             STOP "interregxy_compoverlap"
+          ENDIF
+          !
+          !
+          IF ( nbint+nbcross > 2 ) THEN
+
+             poly_tmpa(1:nbint,:) = poly_int(1:nbint,:)
+             poly_tmpa(nbint+1:nbint+nbcross,:) =  poly_cross(1:nbcross,:)
+             
+             IF ( checkprint .AND. ix == icheck .AND. jx == jcheck ) THEN
+                WRITE(*,*) "X_overlap = ", poly_tmpa(1:(nbint+nbcross),1)
+                WRITE(*,*) "Y_overlap = ", poly_tmpa(1:(nbint+nbcross),2)
+             ENDIF
+
+             CALL polygones_cleanup(nbint+nbcross, poly_tmpa, nbfinal, poly_tmpb)
+             IF ( nbint+nbcross < 3 ) THEN
+                WRITE(*,*) "poly_tmpa X : ", poly_tmpa(1:(nbint+nbcross),1)
+                WRITE(*,*) "poly_tmpa Y : ", poly_tmpa(1:(nbint+nbcross),2)
+                WRITE(*,*) "Cleaning goes too far : ", nbint+nbcross, " to ", nbfinal
+                WRITE(*,*) "poly_tmpb X : ", poly_tmpb(1:nbfinal,1)
+                WRITE(*,*) "poly_tmpb Y : ", poly_tmpb(1:nbfinal,2)
+             ENDIF
+
+             IF ( checkprint .AND. ix == icheck .AND. jx == jcheck ) THEN
+                WRITE(*,*) "X_final = ", poly_tmpb(1:nbfinal,1)
+                WRITE(*,*) "Y_final = ", poly_tmpb(1:nbfinal,2)
+             ENDIF
+             IF ( nbfinal > 2 ) THEN
+                CALL polygones_convexhull(nbfinal, poly_tmpb, nbsorted, poly_tmpa)
+                IF ( checkprint .AND. ix == icheck .AND. jx == jcheck ) THEN
+                   WRITE(*,*) "X_sorted = ", poly_tmpa(1:nbsorted,1)
+                   WRITE(*,*) "Y_sorted = ", poly_tmpa(1:nbsorted,2)
+                ENDIF
+                CALL polygones_area(nbsorted, poly_tmpa, dxWRF(ix,jx), dyWRF(ix,jx), overlaparea)
+             ELSE
+                overlaparea = 0.0
+             ENDIF
+
+             IF ( checkprint .AND. ix == icheck .AND. jx == jcheck ) THEN
+                WRITE(*,*) ix, jx, "overlaparea = ", overlaparea
+                WRITE(*,*) "============================================================================="
+             ENDIF
+
+             IF ( overlaparea > 0.0 ) THEN
+                nbpt(ix,jx) = nbpt(ix,jx)+1
+                IF ( nbpt(ix,jx) > nbpt_max ) THEN
+                   WRITE(*,*) "ERROR in interregxy_findpoints. "
+                   WRITE(*,*) "Consider your algorithm to estimate nbpt_max. "
+                   WRITE(*,*) "You should change it as it does not give enough points."
+                   WRITE(*,*) "nbpt(ix,jx) = ", nbpt(ix,jx)
+                   WRITE(*,*) "nbpt_max = ", nbpt_max
+                   STOP "interregxy_findpoints"
+                ENDIF
+                sourcei(ix,jx,nbpt(ix,jx)) = is
+                sourcej(ix,jx,nbpt(ix,jx)) = js
+                overlap_area(ix,jx,nbpt(ix,jx)) =  overlaparea
+                !
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    DEALLOCATE(poly_in, poly_tmpa, poly_tmpb, poly_int, poly_cross)
+    !
+  END SUBROUTINE interregxy_findpoints
+
+END MODULE interregxy
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/module_llxy.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/module_llxy.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/module_llxy.f90	(revision 6412)
@@ -0,0 +1,2235 @@
+MODULE module_llxy
+!!
+!! Changes for ORCHIDEE
+!!
+!! - PI becomes PI_M so that it does not conflict with ORCHIDEE
+!! - Put a use for IOIPSL
+!! - added wrf_error_fatal is replaced by ipslerrsubroutine to redirect to ipslerr
+!!
+!!  Jan Polcher
+!!
+! Module that defines constants, data structures, and
+! subroutines used to convert grid indices to lat/lon
+! and vice versa.   
+!
+! SUPPORTED PROJECTIONS
+! ---------------------
+! Cylindrical Lat/Lon (code = PROJ_LATLON)
+! Mercator (code = PROJ_MERC)
+! Lambert Conformal (code = PROJ_LC)
+! Gaussian (code = PROJ_GAUSS)
+! Polar Stereographic (code = PROJ_PS)
+! Rotated Lat/Lon (code = PROJ_ROTLL)
+!
+! REMARKS
+! -------
+! The routines contained within were adapted from routines
+! obtained from NCEP's w3 library.  The original NCEP routines were less
+! flexible (e.g., polar-stereo routines only supported truelat of 60N/60S)
+! than what we needed, so modifications based on equations in Hoke, Hayes, and
+! Renninger (AFGWC/TN/79-003) were added to improve the flexibility.  
+! Additionally, coding was improved to F90 standards and the routines were
+! combined into this module.  
+!
+! ASSUMPTIONS
+! -----------
+!  Grid Definition:
+!    For mercator, lambert conformal, and polar-stereographic projections,
+!    the routines within assume the following:
+!
+!       1.  Grid is dimensioned (i,j) where i is the East-West direction,
+!           positive toward the east, and j is the north-south direction,
+!           positive toward the north.
+!       2.  Origin is at (1,1) and is located at the southwest corner,
+!           regardless of hemispere.
+!       3.  Grid spacing (dx) is always positive.
+!       4.  Values of true latitudes must be positive for NH domains
+!           and negative for SH domains.
+!
+!     For the latlon and Gaussian projection, the grid origin may be at any
+!     of the corners, and the deltalat and deltalon values can be signed to
+!     account for this using the following convention:
+!       Origin Location        Deltalat Sign      Deltalon Sign
+!       ---------------        -------------      -------------
+!        SW Corner                  +                   +
+!        NE Corner                  -                   -
+!        NW Corner                  -                   +
+!        SE Corner                  +                   -
+!
+!  Data Definitions:
+!       1. Any arguments that are a latitude value are expressed in
+!          degrees north with a valid range of -90 -> 90
+!       2. Any arguments that are a longitude value are expressed in
+!          degrees east with a valid range of -180 -> 180.
+!       3. Distances are in meters and are always positive.
+!       4. The standard longitude (stdlon) is defined as the longitude
+!          line which is parallel to the grid's y-axis (j-direction), along
+!          which latitude increases (NOT the absolute value of latitude, but
+!          the actual latitude, such that latitude increases continuously
+!          from the south pole to the north pole) as j increases.
+!       5. One true latitude value is required for polar-stereographic and
+!          mercator projections, and defines at which latitude the
+!          grid spacing is true.  For lambert conformal, two true latitude
+!          values must be specified, but may be set equal to each other to
+!          specify a tangent projection instead of a secant projection.
+!
+! USAGE
+! -----
+! To use the routines in this module, the calling routines must have the
+! following statement at the beginning of its declaration block:
+!   USE map_utils
+!
+! The use of the module not only provides access to the necessary routines,
+! but also defines a structure of TYPE (proj_info) that can be used
+! to declare a variable of the same type to hold your map projection
+! information.  It also defines some integer parameters that contain
+! the projection codes so one only has to use those variable names rather
+! than remembering the acutal code when using them.  The basic steps are
+! as follows:
+!
+!   1.  Ensure the "USE map_utils" is in your declarations.
+!   2.  Declare the projection information structure as type(proj_info):
+!         TYPE(proj_info) :: proj
+!   3.  Populate your structure by calling the map_set routine:
+!         CALL map_set(code,lat1,lon1,knowni,knownj,dx,stdlon,truelat1,truelat2,proj)
+!       where:
+!         code (input) = one of PROJ_LATLON, PROJ_MERC, PROJ_LC, PROJ_PS,
+!                        PROJ_GAUSS, or PROJ_ROTLL
+!         lat1 (input) = Latitude of grid origin point (i,j)=(1,1)
+!                         (see assumptions!)
+!         lon1 (input) = Longitude of grid origin
+!         knowni (input) = origin point, x-location
+!         knownj (input) = origin point, y-location
+!         dx (input) = grid spacing in meters (ignored for LATLON projections)
+!         stdlon (input) = Standard longitude for PROJ_PS and PROJ_LC,
+!               deltalon (see assumptions) for PROJ_LATLON,
+!               ignored for PROJ_MERC
+!         truelat1 (input) = 1st true latitude for PROJ_PS, PROJ_LC, and
+!                PROJ_MERC, deltalat (see assumptions) for PROJ_LATLON
+!         truelat2 (input) = 2nd true latitude for PROJ_LC,
+!                ignored for all others.
+!         proj (output) = The structure of type (proj_info) that will be fully
+!                populated after this call
+!
+!   4.  Now that the proj structure is populated, you may call either
+!       of the following routines:
+!
+!       latlon_to_ij(proj, lat, lon, i, j)
+!       ij_to_latlon(proj, i, j, lat, lon)
+!
+!       It is incumbent upon the calling routine to determine whether or
+!       not the values returned are within your domain's bounds.  All values
+!       of i, j, lat, and lon are REAL values.
+!
+!
+! REFERENCES
+! ----------
+!  Hoke, Hayes, and Renninger, "Map Preojections and Grid Systems for
+!       Meteorological Applications." AFGWC/TN-79/003(Rev), Air Weather
+!       Service, 1985.
+!
+!  NCAR MM5v3 Modeling System, REGRIDDER program, module_first_guess_map.F
+!  NCEP routines w3fb06, w3fb07, w3fb08, w3fb09, w3fb11, w3fb12
+!
+! HISTORY
+! -------
+! 27 Mar 2001 - Original Version
+!               Brent L. Shaw, NOAA/FSL (CSU/CIRA)
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   USE ioipsl
+   USE constantes_var
+
+   INTEGER, PARAMETER :: HH=4, VV=5
+
+   REAL, PARAMETER :: PI_M = 3.141592653589793
+   REAL, PARAMETER :: OMEGA_E = 7.292e-5
+
+   REAL, PARAMETER :: DEG_PER_RAD = 180./PI_M
+   REAL, PARAMETER :: RAD_PER_DEG = PI_M/180.
+
+   REAL, PARAMETER :: A_WGS84  = 6378137.
+   REAL, PARAMETER :: B_WGS84  = 6356752.314
+   REAL, PARAMETER :: RE_WGS84 = A_WGS84
+   REAL, PARAMETER :: E_WGS84  = 0.081819192
+
+   REAL, PARAMETER :: A_NAD83  = 6378137.
+   REAL, PARAMETER :: RE_NAD83 = A_NAD83
+   REAL, PARAMETER :: E_NAD83  = 0.0818187034
+
+   REAL, PARAMETER :: EARTH_RADIUS_M = R_Earth
+   REAL, PARAMETER :: EARTH_CIRC_M = 2.*PI_M*EARTH_RADIUS_M
+
+   INTEGER, PUBLIC, PARAMETER  :: PROJ_CASSINI = 0
+   INTEGER, PUBLIC, PARAMETER  :: PROJ_LC = 1
+   INTEGER, PUBLIC, PARAMETER  :: PROJ_PS = 2
+   INTEGER, PUBLIC, PARAMETER  :: PROJ_PS_WGS84 = 102
+   INTEGER, PUBLIC, PARAMETER  :: PROJ_MERC = 3
+   INTEGER, PUBLIC, PARAMETER  :: PROJ_GAUSS = 4
+   INTEGER, PUBLIC, PARAMETER  :: PROJ_CYL = 5
+   INTEGER, PUBLIC, PARAMETER  :: PROJ_LATLON = 6
+   INTEGER, PUBLIC, PARAMETER  :: PROJ_ALBERS_NAD83 = 105
+   INTEGER, PUBLIC, PARAMETER  :: PROJ_ROTLL = 203
+
+   ! Define some private constants
+   INTEGER, PRIVATE, PARAMETER :: HIGH = 8
+ 
+   TYPE proj_info
+ 
+      INTEGER          :: code     ! Integer code for projection TYPE
+      INTEGER          :: nlat     ! For Gaussian -- number of latitude points 
+                                   !  north of the equator 
+      INTEGER          :: nlon     !
+                                   !
+      INTEGER          :: ixdim    ! For Rotated Lat/Lon -- number of mass points
+                                   !  in an odd row
+      INTEGER          :: jydim    ! For Rotated Lat/Lon -- number of rows
+      INTEGER          :: stagger  ! For Rotated Lat/Lon -- mass or velocity grid 
+      REAL             :: phi      ! For Rotated Lat/Lon -- domain half-extent in 
+                                   !  degrees latitude
+      REAL             :: lambda   ! For Rotated Lat/Lon -- domain half-extend in
+                                   !  degrees longitude
+      REAL             :: lat1     ! SW latitude (1,1) in degrees (-90->90N)
+      REAL             :: lon1     ! SW longitude (1,1) in degrees (-180->180E)
+      REAL             :: lat0     ! For Cassini, latitude of projection pole
+      REAL             :: lon0     ! For Cassini, longitude of projection pole
+      REAL             :: dx       ! Grid spacing in meters at truelats, used
+                                   !  only for ps, lc, and merc projections
+      REAL             :: dy       ! Grid spacing in meters at truelats, used
+                                   !  only for ps, lc, and merc projections
+      REAL             :: latinc   ! Latitude increment for cylindrical lat/lon
+      REAL             :: loninc   ! Longitude increment for cylindrical lat/lon
+                                   !  also the lon increment for Gaussian grid
+      REAL             :: dlat     ! Lat increment for lat/lon grids
+      REAL             :: dlon     ! Lon increment for lat/lon grids
+      REAL             :: stdlon   ! Longitude parallel to y-axis (-180->180E)
+      REAL             :: truelat1 ! First true latitude (all projections)
+      REAL             :: truelat2 ! Second true lat (LC only)
+      REAL             :: hemi     ! 1 for NH, -1 for SH
+      REAL             :: cone     ! Cone factor for LC projections
+      REAL             :: polei    ! Computed i-location of pole point
+      REAL             :: polej    ! Computed j-location of pole point
+      REAL             :: rsw      ! Computed radius to SW corner
+      REAL             :: rebydx   ! Earth radius divided by dx
+      REAL             :: knowni   ! X-location of known lat/lon
+      REAL             :: knownj   ! Y-location of known lat/lon
+      REAL             :: re_m     ! Radius of spherical earth, meters
+      REAL             :: rho0     ! For Albers equal area
+      REAL             :: nc       ! For Albers equal area
+      REAL             :: bigc     ! For Albers equal area
+      LOGICAL          :: init     ! Flag to indicate if this struct is 
+                                   !  ready for use
+      LOGICAL          :: wrap     ! For Gaussian -- flag to indicate wrapping 
+                                   !  around globe?
+      REAL, POINTER, DIMENSION(:) :: gauss_lat  ! Latitude array for Gaussian grid
+ 
+   END TYPE proj_info
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ CONTAINS
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+   SUBROUTINE map_init(proj)
+      ! Initializes the map projection structure to missing values
+  
+      IMPLICIT NONE
+      TYPE(proj_info), INTENT(INOUT)  :: proj
+  
+      proj%code     = -999
+      proj%lat1     = -999.9
+      proj%lon1     = -999.9
+      proj%lat0     = -999.9
+      proj%lon0     = -999.9
+      proj%dx       = -999.9
+      proj%dy       = -999.9
+      proj%latinc   = -999.9
+      proj%loninc   = -999.9
+      proj%stdlon   = -999.9
+      proj%truelat1 = -999.9
+      proj%truelat2 = -999.9
+      proj%phi      = -999.9
+      proj%lambda   = -999.9
+      proj%ixdim    = -999
+      proj%jydim    = -999
+      proj%stagger  = HH
+      proj%nlat     = 0
+      proj%nlon     = 0
+      proj%hemi     = 0.0
+      proj%cone     = -999.9
+      proj%polei    = -999.9
+      proj%polej    = -999.9
+      proj%rsw      = -999.9
+      proj%knowni   = -999.9
+      proj%knownj   = -999.9
+      proj%re_m     = EARTH_RADIUS_M
+      proj%init     = .FALSE.
+      proj%wrap     = .FALSE.
+      proj%rho0     = 0.
+      proj%nc       = 0.
+      proj%bigc     = 0.
+      nullify(proj%gauss_lat)
+   
+   END SUBROUTINE map_init
+
+
+   SUBROUTINE map_set(proj_code, proj, lat1, lon1, lat0, lon0, knowni, knownj, dx, latinc, &
+                      loninc, stdlon, truelat1, truelat2, nlat, nlon, ixdim, jydim, &
+                      stagger, phi, lambda, r_earth)
+      ! Given a partially filled proj_info structure, this routine computes
+      ! polei, polej, rsw, and cone (if LC projection) to complete the 
+      ! structure.  This allows us to eliminate redundant calculations when
+      ! calling the coordinate conversion routines multiple times for the
+      ! same map.
+      ! This will generally be the first routine called when a user wants
+      ! to be able to use the coordinate conversion routines, and it
+      ! will call the appropriate subroutines based on the 
+      ! proj%code which indicates which projection type this is.
+  
+      IMPLICIT NONE
+      
+      ! Declare arguments
+      INTEGER, INTENT(IN)               :: proj_code
+      INTEGER, INTENT(IN), OPTIONAL     :: nlat
+      INTEGER, INTENT(IN), OPTIONAL     :: nlon
+      INTEGER, INTENT(IN), OPTIONAL     :: ixdim
+      INTEGER, INTENT(IN), OPTIONAL     :: jydim
+      INTEGER, INTENT(IN), OPTIONAL     :: stagger
+      REAL, INTENT(IN), OPTIONAL        :: latinc
+      REAL, INTENT(IN), OPTIONAL        :: loninc
+      REAL, INTENT(IN), OPTIONAL        :: lat1
+      REAL, INTENT(IN), OPTIONAL        :: lon1
+      REAL, INTENT(IN), OPTIONAL        :: lat0
+      REAL, INTENT(IN), OPTIONAL        :: lon0
+      REAL, INTENT(IN), OPTIONAL        :: dx
+      REAL, INTENT(IN), OPTIONAL        :: stdlon
+      REAL, INTENT(IN), OPTIONAL        :: truelat1
+      REAL, INTENT(IN), OPTIONAL        :: truelat2
+      REAL, INTENT(IN), OPTIONAL        :: knowni
+      REAL, INTENT(IN), OPTIONAL        :: knownj
+      REAL, INTENT(IN), OPTIONAL        :: phi
+      REAL, INTENT(IN), OPTIONAL        :: lambda
+      REAL, INTENT(IN), OPTIONAL        :: r_earth
+      TYPE(proj_info), INTENT(OUT)      :: proj
+
+      INTEGER :: iter
+      REAL :: dummy_lon1
+      REAL :: dummy_lon0
+      REAL :: dummy_stdlon
+  
+      ! First, verify that mandatory parameters are present for the specified proj_code
+      IF ( proj_code == PROJ_LC ) THEN
+         IF ( .NOT.PRESENT(truelat1) .OR. &
+              .NOT.PRESENT(truelat2) .OR. &
+              .NOT.PRESENT(lat1) .OR. &
+              .NOT.PRESENT(lon1) .OR. &
+              .NOT.PRESENT(knowni) .OR. &
+              .NOT.PRESENT(knownj) .OR. &
+              .NOT.PRESENT(stdlon) .OR. &
+              .NOT.PRESENT(dx) ) THEN
+            PRINT '(A,I2)', 'The following are mandatory parameters for projection code : ', proj_code
+            PRINT '(A)', ' truelat1, truelat2, lat1, lon1, knowni, knownj, stdlon, dx'
+            CALL wrf_error_fatal ( 'MAP_INIT' )
+         END IF
+      ELSE IF ( proj_code == PROJ_PS ) THEN
+         IF ( .NOT.PRESENT(truelat1) .OR. &
+              .NOT.PRESENT(lat1) .OR. &
+              .NOT.PRESENT(lon1) .OR. &
+              .NOT.PRESENT(knowni) .OR. &
+              .NOT.PRESENT(knownj) .OR. &
+              .NOT.PRESENT(stdlon) .OR. &
+              .NOT.PRESENT(dx) ) THEN
+            PRINT '(A,I2)', 'The following are mandatory parameters for projection code : ', proj_code
+            PRINT '(A)', ' truelat1, lat1, lon1, knonwi, knownj, stdlon, dx'
+            CALL wrf_error_fatal ( 'MAP_INIT' )
+         END IF
+      ELSE IF ( proj_code == PROJ_PS_WGS84 ) THEN
+         IF ( .NOT.PRESENT(truelat1) .OR. &
+              .NOT.PRESENT(lat1) .OR. &
+              .NOT.PRESENT(lon1) .OR. &
+              .NOT.PRESENT(knowni) .OR. &
+              .NOT.PRESENT(knownj) .OR. &
+              .NOT.PRESENT(stdlon) .OR. &
+              .NOT.PRESENT(dx) ) THEN
+            PRINT '(A,I2)', 'The following are mandatory parameters for projection code : ', proj_code
+            PRINT '(A)', ' truelat1, lat1, lon1, knonwi, knownj, stdlon, dx'
+            CALL wrf_error_fatal ( 'MAP_INIT' )
+         END IF
+      ELSE IF ( proj_code == PROJ_ALBERS_NAD83 ) THEN
+         IF ( .NOT.PRESENT(truelat1) .OR. &
+              .NOT.PRESENT(truelat2) .OR. &
+              .NOT.PRESENT(lat1) .OR. &
+              .NOT.PRESENT(lon1) .OR. &
+              .NOT.PRESENT(knowni) .OR. &
+              .NOT.PRESENT(knownj) .OR. &
+              .NOT.PRESENT(stdlon) .OR. &
+              .NOT.PRESENT(dx) ) THEN
+            PRINT '(A,I2)', 'The following are mandatory parameters for projection code : ', proj_code
+            PRINT '(A)', ' truelat1, truelat2, lat1, lon1, knonwi, knownj, stdlon, dx'
+            CALL wrf_error_fatal ( 'MAP_INIT' )
+         END IF
+      ELSE IF ( proj_code == PROJ_MERC ) THEN
+         IF ( .NOT.PRESENT(truelat1) .OR. &
+              .NOT.PRESENT(lat1) .OR. &
+              .NOT.PRESENT(lon1) .OR. &
+              .NOT.PRESENT(knowni) .OR. &
+              .NOT.PRESENT(knownj) .OR. &
+              .NOT.PRESENT(dx) ) THEN
+            PRINT '(A,I2)', 'The following are mandatory parameters for projection code : ', proj_code
+            PRINT '(A)', ' truelat1, lat1, lon1, knowni, knownj, dx'
+            CALL wrf_error_fatal ( 'MAP_INIT' )
+         END IF
+      ELSE IF ( proj_code == PROJ_LATLON ) THEN
+         IF ( .NOT.PRESENT(latinc) .OR. &
+              .NOT.PRESENT(loninc) .OR. &
+              .NOT.PRESENT(knowni) .OR. &
+              .NOT.PRESENT(knownj) .OR. &
+              .NOT.PRESENT(lat1) .OR. &
+              .NOT.PRESENT(lon1) ) THEN
+            PRINT '(A,I2)', 'The following are mandatory parameters for projection code : ', proj_code
+            PRINT '(A)', ' latinc, loninc, knowni, knownj, lat1, lon1'
+            CALL wrf_error_fatal ( 'MAP_INIT' )
+         END IF
+      ELSE IF ( proj_code == PROJ_CYL ) THEN
+         IF ( .NOT.PRESENT(latinc) .OR. &
+              .NOT.PRESENT(loninc) .OR. &
+              .NOT.PRESENT(stdlon) ) THEN
+            PRINT '(A,I2)', 'The following are mandatory parameters for projection code : ', proj_code
+            PRINT '(A)', ' latinc, loninc, stdlon'
+            CALL wrf_error_fatal ( 'MAP_INIT' )
+         END IF
+      ELSE IF ( proj_code == PROJ_CASSINI ) THEN
+         IF ( .NOT.PRESENT(latinc) .OR. &
+              .NOT.PRESENT(loninc) .OR. &
+              .NOT.PRESENT(lat1) .OR. &
+              .NOT.PRESENT(lon1) .OR. &
+              .NOT.PRESENT(lat0) .OR. &
+              .NOT.PRESENT(lon0) .OR. &
+              .NOT.PRESENT(knowni) .OR. &
+              .NOT.PRESENT(knownj) .OR. &
+              .NOT.PRESENT(stdlon) ) THEN
+            PRINT '(A,I2)', 'The following are mandatory parameters for projection code : ', proj_code
+            PRINT '(A)', ' latinc, loninc, lat1, lon1, knowni, knownj, lat0, lon0, stdlon'
+            CALL wrf_error_fatal ( 'MAP_INIT' )
+         END IF
+      ELSE IF ( proj_code == PROJ_GAUSS ) THEN
+         IF ( .NOT.PRESENT(nlat) .OR. &
+              .NOT.PRESENT(lat1) .OR. &
+              .NOT.PRESENT(lon1) .OR. &
+              .NOT.PRESENT(loninc) ) THEN
+            PRINT '(A,I2)', 'The following are mandatory parameters for projection code : ', proj_code
+            PRINT '(A)', ' nlat, lat1, lon1, loninc'
+            CALL wrf_error_fatal ( 'MAP_INIT' )
+         END IF
+      ELSE IF ( proj_code == PROJ_ROTLL ) THEN
+         IF ( .NOT.PRESENT(ixdim) .OR. &
+              .NOT.PRESENT(jydim) .OR. &
+              .NOT.PRESENT(phi) .OR. &
+              .NOT.PRESENT(lambda) .OR. &
+              .NOT.PRESENT(lat1) .OR. &
+              .NOT.PRESENT(lon1) .OR. &
+              .NOT.PRESENT(stagger) ) THEN
+            PRINT '(A,I2)', 'The following are mandatory parameters for projection code : ', proj_code
+            PRINT '(A)', ' ixdim, jydim, phi, lambda, lat1, lon1, stagger'
+            CALL wrf_error_fatal ( 'MAP_INIT' )
+         END IF
+      ELSE
+         PRINT '(A,I2)', 'Unknown projection code: ', proj_code
+         CALL wrf_error_fatal ( 'MAP_INIT' )
+      END IF
+  
+      ! Check for validity of mandatory variables in proj
+      IF ( PRESENT(lat1) ) THEN
+         IF ( ABS(lat1) .GT. 90. ) THEN
+            PRINT '(A)', 'Latitude of origin corner required as follows:'
+            PRINT '(A)', '    -90N <= lat1 < = 90.N'
+            CALL wrf_error_fatal ( 'MAP_INIT' )
+         ENDIF
+      ENDIF
+  
+      IF ( PRESENT(lon1) ) THEN
+         dummy_lon1 = lon1
+         IF ( ABS(dummy_lon1) .GT. 180.) THEN
+            iter = 0 
+            DO WHILE (ABS(dummy_lon1) > 180. .AND. iter < 10)
+               IF (dummy_lon1 < -180.) dummy_lon1 = dummy_lon1 + 360.
+               IF (dummy_lon1 > 180.) dummy_lon1 = dummy_lon1 - 360.
+               iter = iter + 1
+            END DO
+            IF (abs(dummy_lon1) > 180.) THEN
+               PRINT '(A)', 'Longitude of origin required as follows:'
+               PRINT '(A)', '   -180E <= lon1 <= 180W'
+               CALL wrf_error_fatal ( 'MAP_INIT' )
+            ENDIF
+         ENDIF
+      ENDIF
+  
+      IF ( PRESENT(lon0) ) THEN
+         dummy_lon0 = lon0
+         IF ( ABS(dummy_lon0) .GT. 180.) THEN
+            iter = 0 
+            DO WHILE (ABS(dummy_lon0) > 180. .AND. iter < 10)
+               IF (dummy_lon0 < -180.) dummy_lon0 = dummy_lon0 + 360.
+               IF (dummy_lon0 > 180.) dummy_lon0 = dummy_lon0 - 360.
+               iter = iter + 1
+            END DO
+            IF (abs(dummy_lon0) > 180.) THEN
+               PRINT '(A)', 'Longitude of pole required as follows:'
+               PRINT '(A)', '   -180E <= lon0 <= 180W'
+               CALL wrf_error_fatal ( 'MAP_INIT' )
+            ENDIF
+         ENDIF
+      ENDIF
+  
+      IF ( PRESENT(dx) ) THEN
+         IF ((dx .LE. 0.).AND.(proj_code .NE. PROJ_LATLON)) THEN
+            PRINT '(A)', 'Require grid spacing (dx) in meters be positive'
+            CALL wrf_error_fatal ( 'MAP_INIT' )
+         ENDIF
+      ENDIF
+  
+      IF ( PRESENT(stdlon) ) THEN
+         dummy_stdlon = stdlon
+         IF ((ABS(dummy_stdlon) > 180.).AND.(proj_code /= PROJ_MERC)) THEN
+            iter = 0 
+            DO WHILE (ABS(dummy_stdlon) > 180. .AND. iter < 10)
+               IF (dummy_stdlon < -180.) dummy_stdlon = dummy_stdlon + 360.
+               IF (dummy_stdlon > 180.) dummy_stdlon = dummy_stdlon - 360.
+               iter = iter + 1
+            END DO
+            IF (abs(dummy_stdlon) > 180.) THEN
+               PRINT '(A)', 'Need orientation longitude (stdlon) as: '
+               PRINT '(A)', '   -180E <= stdlon <= 180W' 
+               CALL wrf_error_fatal ( 'MAP_INIT' )
+            ENDIF
+         ENDIF
+      ENDIF
+  
+      IF ( PRESENT(truelat1) ) THEN
+         IF (ABS(truelat1).GT.90.) THEN
+            PRINT '(A)', 'Set true latitude 1 for all projections'
+            CALL wrf_error_fatal ( 'MAP_INIT' )
+         ENDIF
+      ENDIF
+     
+      CALL map_init(proj) 
+      proj%code  = proj_code
+      IF ( PRESENT(lat1) )     proj%lat1     = lat1
+      IF ( PRESENT(lon1) )     proj%lon1     = dummy_lon1
+      IF ( PRESENT(lat0) )     proj%lat0     = lat0
+      IF ( PRESENT(lon0) )     proj%lon0     = dummy_lon0
+      IF ( PRESENT(latinc) )   proj%latinc   = latinc
+      IF ( PRESENT(loninc) )   proj%loninc   = loninc
+      IF ( PRESENT(knowni) )   proj%knowni   = knowni
+      IF ( PRESENT(knownj) )   proj%knownj   = knownj
+      IF ( PRESENT(dx) )       proj%dx       = dx
+      IF ( PRESENT(stdlon) )   proj%stdlon   = dummy_stdlon
+      IF ( PRESENT(truelat1) ) proj%truelat1 = truelat1
+      IF ( PRESENT(truelat2) ) proj%truelat2 = truelat2
+      IF ( PRESENT(nlat) )     proj%nlat     = nlat
+      IF ( PRESENT(nlon) )     proj%nlon     = nlon
+      IF ( PRESENT(ixdim) )    proj%ixdim    = ixdim
+      IF ( PRESENT(jydim) )    proj%jydim    = jydim
+      IF ( PRESENT(stagger) )  proj%stagger  = stagger
+      IF ( PRESENT(phi) )      proj%phi      = phi
+      IF ( PRESENT(lambda) )   proj%lambda   = lambda
+      IF ( PRESENT(r_earth) )  proj%re_m     = r_earth
+  
+      IF ( PRESENT(dx) ) THEN 
+         IF ( (proj_code == PROJ_LC) .OR. (proj_code == PROJ_PS) .OR. &
+              (proj_code == PROJ_PS_WGS84) .OR. (proj_code == PROJ_ALBERS_NAD83) .OR. &
+              (proj_code == PROJ_MERC) ) THEN
+            proj%dx = dx
+            IF (truelat1 .LT. 0.) THEN
+               proj%hemi = -1.0 
+            ELSE
+               proj%hemi = 1.0
+            ENDIF
+            proj%rebydx = proj%re_m / dx
+         ENDIF
+      ENDIF
+
+      pick_proj: SELECT CASE(proj%code)
+  
+         CASE(PROJ_PS)
+            CALL set_ps(proj)
+
+         CASE(PROJ_PS_WGS84)
+            CALL set_ps_wgs84(proj)
+
+         CASE(PROJ_ALBERS_NAD83)
+            CALL set_albers_nad83(proj)
+   
+         CASE(PROJ_LC)
+            IF (ABS(proj%truelat2) .GT. 90.) THEN
+               proj%truelat2=proj%truelat1
+            ENDIF
+            CALL set_lc(proj)
+      
+         CASE (PROJ_MERC)
+            CALL set_merc(proj)
+      
+         CASE (PROJ_LATLON)
+   
+         CASE (PROJ_GAUSS)
+            CALL set_gauss(proj)
+      
+         CASE (PROJ_CYL)
+            CALL set_cyl(proj)
+      
+         CASE (PROJ_CASSINI)
+            CALL set_cassini(proj)
+      
+         CASE (PROJ_ROTLL)
+     
+      END SELECT pick_proj
+      proj%init = .TRUE.
+
+      RETURN
+
+   END SUBROUTINE map_set
+
+
+   SUBROUTINE latlon_to_ij(proj, lat, lon, i, j)
+      ! Converts input lat/lon values to the cartesian (i,j) value
+      ! for the given projection. 
+  
+      IMPLICIT NONE
+      TYPE(proj_info), INTENT(IN)          :: proj
+      REAL, INTENT(IN)                     :: lat
+      REAL, INTENT(IN)                     :: lon
+      REAL, INTENT(OUT)                    :: i
+      REAL, INTENT(OUT)                    :: j
+  
+      IF (.NOT.proj%init) THEN
+         PRINT '(A)', 'You have not called map_set for this projection'
+         CALL wrf_error_fatal ( 'LATLON_TO_IJ' )
+      ENDIF
+  
+      SELECT CASE(proj%code)
+   
+         CASE(PROJ_LATLON)
+            CALL llij_latlon(lat,lon,proj,i,j)
+   
+         CASE(PROJ_MERC)
+            CALL llij_merc(lat,lon,proj,i,j)
+   
+         CASE(PROJ_PS)
+            CALL llij_ps(lat,lon,proj,i,j)
+
+         CASE(PROJ_PS_WGS84)
+            CALL llij_ps_wgs84(lat,lon,proj,i,j)
+         
+         CASE(PROJ_ALBERS_NAD83)
+            CALL llij_albers_nad83(lat,lon,proj,i,j)
+         
+         CASE(PROJ_LC)
+            CALL llij_lc(lat,lon,proj,i,j)
+   
+         CASE(PROJ_GAUSS)
+            CALL llij_gauss(lat,lon,proj,i,j)
+   
+         CASE(PROJ_CYL)
+            CALL llij_cyl(lat,lon,proj,i,j)
+
+         CASE(PROJ_CASSINI)
+            CALL llij_cassini(lat,lon,proj,i,j)
+
+         CASE(PROJ_ROTLL)
+            CALL llij_rotlatlon(lat,lon,proj,i,j)
+   
+         CASE DEFAULT
+            PRINT '(A,I2)', 'Unrecognized map projection code: ', proj%code
+            CALL wrf_error_fatal ( 'LATLON_TO_IJ' )
+    
+      END SELECT
+
+      RETURN
+
+   END SUBROUTINE latlon_to_ij
+
+
+   SUBROUTINE ij_to_latlon(proj, i, j, lat, lon)
+      ! Computes geographical latitude and longitude for a given (i,j) point
+      ! in a grid with a projection of proj
+  
+      IMPLICIT NONE
+      TYPE(proj_info),INTENT(IN)          :: proj
+      REAL, INTENT(IN)                    :: i
+      REAL, INTENT(IN)                    :: j
+      REAL, INTENT(OUT)                   :: lat
+      REAL, INTENT(OUT)                   :: lon
+  
+      IF (.NOT.proj%init) THEN
+         PRINT '(A)', 'You have not called map_set for this projection'
+         CALL wrf_error_fatal ( 'IJ_TO_LATLON' )
+      ENDIF
+      SELECT CASE (proj%code)
+  
+         CASE (PROJ_LATLON)
+            CALL ijll_latlon(i, j, proj, lat, lon)
+   
+         CASE (PROJ_MERC)
+            CALL ijll_merc(i, j, proj, lat, lon)
+   
+         CASE (PROJ_PS)
+            CALL ijll_ps(i, j, proj, lat, lon)
+
+         CASE (PROJ_PS_WGS84)
+            CALL ijll_ps_wgs84(i, j, proj, lat, lon)
+   
+         CASE (PROJ_ALBERS_NAD83)
+            CALL ijll_albers_nad83(i, j, proj, lat, lon)
+   
+         CASE (PROJ_LC)
+            CALL ijll_lc(i, j, proj, lat, lon)
+   
+         CASE (PROJ_CYL)
+            CALL ijll_cyl(i, j, proj, lat, lon)
+   
+         CASE (PROJ_CASSINI)
+            CALL ijll_cassini(i, j, proj, lat, lon)
+   
+         CASE (PROJ_ROTLL)
+            CALL ijll_rotlatlon(i, j, proj, lat, lon)
+   
+         CASE DEFAULT
+            PRINT '(A,I2)', 'Unrecognized map projection code: ', proj%code
+            CALL wrf_error_fatal ( 'IJ_TO_LATLON' )
+  
+      END SELECT
+      RETURN
+   END SUBROUTINE ij_to_latlon
+
+
+   SUBROUTINE set_ps(proj)
+      ! Initializes a polar-stereographic map projection from the partially
+      ! filled proj structure. This routine computes the radius to the
+      ! southwest corner and computes the i/j location of the pole for use
+      ! in llij_ps and ijll_ps.
+      IMPLICIT NONE
+   
+      ! Declare args
+      TYPE(proj_info), INTENT(INOUT)    :: proj
+  
+      ! Local vars
+      REAL                              :: ala1
+      REAL                              :: alo1
+      REAL                              :: reflon
+      REAL                              :: scale_top
+  
+      ! Executable code
+      reflon = proj%stdlon + 90.
+  
+      ! Compute numerator term of map scale factor
+      scale_top = 1. + proj%hemi * SIN(proj%truelat1 * rad_per_deg)
+  
+      ! Compute radius to lower-left (SW) corner
+      ala1 = proj%lat1 * rad_per_deg
+      proj%rsw = proj%rebydx*COS(ala1)*scale_top/(1.+proj%hemi*SIN(ala1))
+  
+      ! Find the pole point
+      alo1 = (proj%lon1 - reflon) * rad_per_deg
+      proj%polei = proj%knowni - proj%rsw * COS(alo1)
+      proj%polej = proj%knownj - proj%hemi * proj%rsw * SIN(alo1)
+
+      RETURN
+
+   END SUBROUTINE set_ps
+
+
+   SUBROUTINE llij_ps(lat,lon,proj,i,j)
+      ! Given latitude (-90 to 90), longitude (-180 to 180), and the
+      ! standard polar-stereographic projection information via the 
+      ! public proj structure, this routine returns the i/j indices which
+      ! if within the domain range from 1->nx and 1->ny, respectively.
+  
+      IMPLICIT NONE
+  
+      ! Delcare input arguments
+      REAL, INTENT(IN)               :: lat
+      REAL, INTENT(IN)               :: lon
+      TYPE(proj_info),INTENT(IN)     :: proj
+  
+      ! Declare output arguments     
+      REAL, INTENT(OUT)              :: i !(x-index)
+      REAL, INTENT(OUT)              :: j !(y-index)
+  
+      ! Declare local variables
+      
+      REAL                           :: reflon
+      REAL                           :: scale_top
+      REAL                           :: ala
+      REAL                           :: alo
+      REAL                           :: rm
+  
+      ! BEGIN CODE
+    
+      reflon = proj%stdlon + 90.
+     
+      ! Compute numerator term of map scale factor
+  
+      scale_top = 1. + proj%hemi * SIN(proj%truelat1 * rad_per_deg)
+  
+      ! Find radius to desired point
+      ala = lat * rad_per_deg
+      rm = proj%rebydx * COS(ala) * scale_top/(1. + proj%hemi *SIN(ala))
+      alo = (lon - reflon) * rad_per_deg
+      i = proj%polei + rm * COS(alo)
+      j = proj%polej + proj%hemi * rm * SIN(alo)
+   
+      RETURN
+
+   END SUBROUTINE llij_ps
+
+
+   SUBROUTINE ijll_ps(i, j, proj, lat, lon)
+ 
+      ! This is the inverse subroutine of llij_ps.  It returns the 
+      ! latitude and longitude of an i/j point given the projection info 
+      ! structure.  
+  
+      IMPLICIT NONE
+  
+      ! Declare input arguments
+      REAL, INTENT(IN)                    :: i    ! Column
+      REAL, INTENT(IN)                    :: j    ! Row
+      TYPE (proj_info), INTENT(IN)        :: proj
+      
+      ! Declare output arguments
+      REAL, INTENT(OUT)                   :: lat     ! -90 -> 90 north
+      REAL, INTENT(OUT)                   :: lon     ! -180 -> 180 East
+  
+      ! Local variables
+      REAL                                :: reflon
+      REAL                                :: scale_top
+      REAL                                :: xx,yy
+      REAL                                :: gi2, r2
+      REAL                                :: arccos
+  
+      ! Begin Code
+  
+      ! Compute the reference longitude by rotating 90 degrees to the east
+      ! to find the longitude line parallel to the positive x-axis.
+      reflon = proj%stdlon + 90.
+     
+      ! Compute numerator term of map scale factor
+      scale_top = 1. + proj%hemi * SIN(proj%truelat1 * rad_per_deg)
+  
+      ! Compute radius to point of interest
+      xx = i - proj%polei
+      yy = (j - proj%polej) * proj%hemi
+      r2 = xx**2 + yy**2
+  
+      ! Now the magic code
+      IF (r2 .EQ. 0.) THEN 
+         lat = proj%hemi * 90.
+         lon = reflon
+      ELSE
+         gi2 = (proj%rebydx * scale_top)**2.
+         lat = deg_per_rad * proj%hemi * ASIN((gi2-r2)/(gi2+r2))
+         arccos = ACOS(xx/SQRT(r2))
+         IF (yy .GT. 0) THEN
+            lon = reflon + deg_per_rad * arccos
+         ELSE
+            lon = reflon - deg_per_rad * arccos
+         ENDIF
+      ENDIF
+    
+      ! Convert to a -180 -> 180 East convention
+      IF (lon .GT. 180.) lon = lon - 360.
+      IF (lon .LT. -180.) lon = lon + 360.
+
+      RETURN
+   
+   END SUBROUTINE ijll_ps
+
+
+   SUBROUTINE set_ps_wgs84(proj)
+      ! Initializes a polar-stereographic map projection (WGS84 ellipsoid) 
+      ! from the partially filled proj structure. This routine computes the 
+      ! radius to the southwest corner and computes the i/j location of the 
+      ! pole for use in llij_ps and ijll_ps.
+
+      IMPLICIT NONE
+   
+      ! Arguments
+      TYPE(proj_info), INTENT(INOUT)    :: proj
+  
+      ! Local variables
+      real :: h, mc, tc, t, rho
+
+      h = proj%hemi
+
+      mc = cos(h*proj%truelat1*rad_per_deg)/sqrt(1.0-(E_WGS84*sin(h*proj%truelat1*rad_per_deg))**2.0)
+      tc = sqrt(((1.0-sin(h*proj%truelat1*rad_per_deg))/(1.0+sin(h*proj%truelat1*rad_per_deg)))* &
+                (((1.0+E_WGS84*sin(h*proj%truelat1*rad_per_deg))/(1.0-E_WGS84*sin(h*proj%truelat1*rad_per_deg)))**E_WGS84 ))
+
+      ! Find the i/j location of reference lat/lon with respect to the pole of the projection
+      t = sqrt(((1.0-sin(h*proj%lat1*rad_per_deg))/(1.0+sin(h*proj%lat1*rad_per_deg)))* &
+               (((1.0+E_WGS84*sin(h*proj%lat1*rad_per_deg))/(1.0-E_WGS84*sin(h*proj%lat1*rad_per_deg)) )**E_WGS84 ) )
+      rho = h * (A_WGS84 / proj%dx) * mc * t / tc
+      proj%polei = rho * sin((h*proj%lon1 - h*proj%stdlon)*rad_per_deg)
+      proj%polej = -rho * cos((h*proj%lon1 - h*proj%stdlon)*rad_per_deg)
+
+      RETURN
+
+   END SUBROUTINE set_ps_wgs84
+
+
+   SUBROUTINE llij_ps_wgs84(lat,lon,proj,i,j)
+      ! Given latitude (-90 to 90), longitude (-180 to 180), and the
+      ! standard polar-stereographic projection information via the 
+      ! public proj structure, this routine returns the i/j indices which
+      ! if within the domain range from 1->nx and 1->ny, respectively.
+  
+      IMPLICIT NONE
+  
+      ! Arguments
+      REAL, INTENT(IN)               :: lat
+      REAL, INTENT(IN)               :: lon
+      REAL, INTENT(OUT)              :: i !(x-index)
+      REAL, INTENT(OUT)              :: j !(y-index)
+      TYPE(proj_info),INTENT(IN)     :: proj
+  
+      ! Local variables
+      real :: h, mc, tc, t, rho
+
+      h = proj%hemi
+
+      mc = cos(h*proj%truelat1*rad_per_deg)/sqrt(1.0-(E_WGS84*sin(h*proj%truelat1*rad_per_deg))**2.0)
+      tc = sqrt(((1.0-sin(h*proj%truelat1*rad_per_deg))/(1.0+sin(h*proj%truelat1*rad_per_deg)))* &
+                (((1.0+E_WGS84*sin(h*proj%truelat1*rad_per_deg))/(1.0-E_WGS84*sin(h*proj%truelat1*rad_per_deg)))**E_WGS84 ))
+
+      t = sqrt(((1.0-sin(h*lat*rad_per_deg))/(1.0+sin(h*lat*rad_per_deg))) * &
+               (((1.0+E_WGS84*sin(h*lat*rad_per_deg))/(1.0-E_WGS84*sin(h*lat*rad_per_deg)))**E_WGS84))
+
+      ! Find the x/y location of the requested lat/lon with respect to the pole of the projection
+      rho = (A_WGS84 / proj%dx) * mc * t / tc
+      i = h *  rho * sin((h*lon - h*proj%stdlon)*rad_per_deg)
+      j = h *(-rho)* cos((h*lon - h*proj%stdlon)*rad_per_deg)
+
+      ! Get i/j relative to reference i/j
+      i = proj%knowni + (i - proj%polei)
+      j = proj%knownj + (j - proj%polej)
+  
+      RETURN
+
+   END SUBROUTINE llij_ps_wgs84
+
+
+   SUBROUTINE ijll_ps_wgs84(i, j, proj, lat, lon)
+ 
+      ! This is the inverse subroutine of llij_ps.  It returns the 
+      ! latitude and longitude of an i/j point given the projection info 
+      ! structure.  
+  
+      implicit none
+  
+      ! Arguments
+      REAL, INTENT(IN)                    :: i    ! Column
+      REAL, INTENT(IN)                    :: j    ! Row
+      REAL, INTENT(OUT)                   :: lat     ! -90 -> 90 north
+      REAL, INTENT(OUT)                   :: lon     ! -180 -> 180 East
+      TYPE (proj_info), INTENT(IN)        :: proj
+
+      ! Local variables
+      real :: h, mc, tc, t, rho, x, y
+      real :: chi, a, b, c, d
+
+      h = proj%hemi
+      x = (i - proj%knowni + proj%polei)
+      y = (j - proj%knownj + proj%polej)
+
+      mc = cos(h*proj%truelat1*rad_per_deg)/sqrt(1.0-(E_WGS84*sin(h*proj%truelat1*rad_per_deg))**2.0)
+      tc = sqrt(((1.0-sin(h*proj%truelat1*rad_per_deg))/(1.0+sin(h*proj%truelat1*rad_per_deg))) * &
+                (((1.0+E_WGS84*sin(h*proj%truelat1*rad_per_deg))/(1.0-E_WGS84*sin(h*proj%truelat1*rad_per_deg)))**E_WGS84 ))
+
+      rho = sqrt((x*proj%dx)**2.0 + (y*proj%dx)**2.0)
+      t = rho * tc / (A_WGS84 * mc) 
+
+      lon = h*proj%stdlon*rad_per_deg + h*atan2(h*x,h*(-y))
+
+      chi = PI_M/2.0-2.0*atan(t)
+      a = 1./2.*E_WGS84**2. + 5./24.*E_WGS84**4. +  1./40.*E_WGS84**6.  +    73./2016.*E_WGS84**8.
+      b =                     7./24.*E_WGS84**4. + 29./120.*E_WGS84**6. + 54113./40320.*E_WGS84**8.
+      c =                                           7./30.*E_WGS84**6.  +    81./280.*E_WGS84**8.
+      d =                                                                  4279./20160.*E_WGS84**8.
+
+      lat = chi + sin(2.*chi)*(a + cos(2.*chi)*(b + cos(2.*chi)*(c + d*cos(2.*chi))))
+      lat = h * lat
+
+      lat = lat*deg_per_rad
+      lon = lon*deg_per_rad
+
+      RETURN
+   
+   END SUBROUTINE ijll_ps_wgs84
+
+
+   SUBROUTINE set_albers_nad83(proj)
+      ! Initializes an Albers equal area map projection (NAD83 ellipsoid) 
+      ! from the partially filled proj structure. This routine computes the 
+      ! radius to the southwest corner and computes the i/j location of the 
+      ! pole for use in llij_albers_nad83 and ijll_albers_nad83.
+
+      IMPLICIT NONE
+   
+      ! Arguments
+      TYPE(proj_info), INTENT(INOUT)    :: proj
+  
+      ! Local variables
+      real :: h, m1, m2, q1, q2, theta, q, sinphi
+
+      h = proj%hemi
+
+      m1 = cos(h*proj%truelat1*rad_per_deg)/sqrt(1.0-(E_NAD83*sin(h*proj%truelat1*rad_per_deg))**2.0)
+      m2 = cos(h*proj%truelat2*rad_per_deg)/sqrt(1.0-(E_NAD83*sin(h*proj%truelat2*rad_per_deg))**2.0)
+
+      sinphi = sin(proj%truelat1*rad_per_deg)
+      q1 = (1.0-E_NAD83**2.0) * &
+           ((sinphi/(1.0-(E_NAD83*sinphi)**2.0)) - 1.0/(2.0*E_NAD83) * log((1.0-E_NAD83*sinphi)/(1.0+E_NAD83*sinphi)))
+
+      sinphi = sin(proj%truelat2*rad_per_deg)
+      q2 = (1.0-E_NAD83**2.0) * &
+           ((sinphi/(1.0-(E_NAD83*sinphi)**2.0)) - 1.0/(2.0*E_NAD83) * log((1.0-E_NAD83*sinphi)/(1.0+E_NAD83*sinphi)))
+
+      if (proj%truelat1 == proj%truelat2) then
+         proj%nc = sin(proj%truelat1*rad_per_deg)
+      else
+         proj%nc = (m1**2.0 - m2**2.0) / (q2 - q1)
+      end if
+
+      proj%bigc = m1**2.0 + proj%nc*q1
+
+      ! Find the i/j location of reference lat/lon with respect to the pole of the projection
+      sinphi = sin(proj%lat1*rad_per_deg)
+      q = (1.0-E_NAD83**2.0) * &
+           ((sinphi/(1.0-(E_NAD83*sinphi)**2.0)) - 1.0/(2.0*E_NAD83) * log((1.0-E_NAD83*sinphi)/(1.0+E_NAD83*sinphi)))
+
+      proj%rho0 = h * (A_NAD83 / proj%dx) * sqrt(proj%bigc - proj%nc * q) / proj%nc 
+      theta = proj%nc*(proj%lon1 - proj%stdlon)*rad_per_deg
+
+      proj%polei = proj%rho0 * sin(h*theta) 
+      proj%polej = proj%rho0 - proj%rho0 * cos(h*theta)
+
+      RETURN
+
+   END SUBROUTINE set_albers_nad83
+
+
+   SUBROUTINE llij_albers_nad83(lat,lon,proj,i,j)
+      ! Given latitude (-90 to 90), longitude (-180 to 180), and the
+      ! standard projection information via the 
+      ! public proj structure, this routine returns the i/j indices which
+      ! if within the domain range from 1->nx and 1->ny, respectively.
+  
+      IMPLICIT NONE
+  
+      ! Arguments
+      REAL, INTENT(IN)               :: lat
+      REAL, INTENT(IN)               :: lon
+      REAL, INTENT(OUT)              :: i !(x-index)
+      REAL, INTENT(OUT)              :: j !(y-index)
+      TYPE(proj_info),INTENT(IN)     :: proj
+  
+      ! Local variables
+      real :: h, q, rho, theta, sinphi
+
+      h = proj%hemi
+
+      sinphi = sin(h*lat*rad_per_deg)
+
+      ! Find the x/y location of the requested lat/lon with respect to the pole of the projection
+      q = (1.0-E_NAD83**2.0) * &
+           ((sinphi/(1.0-(E_NAD83*sinphi)**2.0)) - 1.0/(2.0*E_NAD83) * log((1.0-E_NAD83*sinphi)/(1.0+E_NAD83*sinphi)))
+
+      rho = h * (A_NAD83 / proj%dx) * sqrt(proj%bigc - proj%nc * q) / proj%nc
+      theta = proj%nc * (h*lon - h*proj%stdlon)*rad_per_deg
+
+      i = h*rho*sin(theta)
+      j = h*proj%rho0 - h*rho*cos(theta)
+
+      ! Get i/j relative to reference i/j
+      i = proj%knowni + (i - proj%polei)
+      j = proj%knownj + (j - proj%polej)
+
+      RETURN
+
+   END SUBROUTINE llij_albers_nad83
+
+
+   SUBROUTINE ijll_albers_nad83(i, j, proj, lat, lon)
+ 
+      ! This is the inverse subroutine of llij_albers_nad83.  It returns the 
+      ! latitude and longitude of an i/j point given the projection info 
+      ! structure.  
+  
+      implicit none
+  
+      ! Arguments
+      REAL, INTENT(IN)                    :: i    ! Column
+      REAL, INTENT(IN)                    :: j    ! Row
+      REAL, INTENT(OUT)                   :: lat     ! -90 -> 90 north
+      REAL, INTENT(OUT)                   :: lon     ! -180 -> 180 East
+      TYPE (proj_info), INTENT(IN)        :: proj
+
+      ! Local variables
+      real :: h, q, rho, theta, beta, x, y
+      real :: a, b, c
+
+      h = proj%hemi
+
+      x = (i - proj%knowni + proj%polei)
+      y = (j - proj%knownj + proj%polej)
+
+      rho = sqrt(x**2.0 + (proj%rho0 - y)**2.0)
+      theta = atan2(x, proj%rho0-y)
+
+      q = (proj%bigc - (rho*proj%nc*proj%dx/A_NAD83)**2.0) / proj%nc
+
+      beta = asin(q/(1.0 - log((1.0-E_NAD83)/(1.0+E_NAD83))*(1.0-E_NAD83**2.0)/(2.0*E_NAD83)))
+      a = 1./3.*E_NAD83**2. + 31./180.*E_NAD83**4. + 517./5040.*E_NAD83**6.
+      b =                     23./360.*E_NAD83**4. + 251./3780.*E_NAD83**6.
+      c =                                            761./45360.*E_NAD83**6.
+
+      lat = beta + a*sin(2.*beta) + b*sin(4.*beta) + c*sin(6.*beta)
+
+      lat = h*lat*deg_per_rad
+      lon = proj%stdlon + theta*deg_per_rad/proj%nc
+
+      RETURN
+   
+   END SUBROUTINE ijll_albers_nad83
+
+
+   SUBROUTINE set_lc(proj)
+      ! Initialize the remaining items in the proj structure for a
+      ! lambert conformal grid.
+  
+      IMPLICIT NONE
+      
+      TYPE(proj_info), INTENT(INOUT)     :: proj
+  
+      REAL                               :: arg
+      REAL                               :: deltalon1
+      REAL                               :: tl1r
+      REAL                               :: ctl1r
+  
+      ! Compute cone factor
+      CALL lc_cone(proj%truelat1, proj%truelat2, proj%cone)
+  
+      ! Compute longitude differences and ensure we stay out of the
+      ! forbidden "cut zone"
+      deltalon1 = proj%lon1 - proj%stdlon
+      IF (deltalon1 .GT. +180.) deltalon1 = deltalon1 - 360.
+      IF (deltalon1 .LT. -180.) deltalon1 = deltalon1 + 360.
+  
+      ! Convert truelat1 to radian and compute COS for later use
+      tl1r = proj%truelat1 * rad_per_deg
+      ctl1r = COS(tl1r)
+  
+      ! Compute the radius to our known lower-left (SW) corner
+      proj%rsw = proj%rebydx * ctl1r/proj%cone * &
+             (TAN((90.*proj%hemi-proj%lat1)*rad_per_deg/2.) / &
+              TAN((90.*proj%hemi-proj%truelat1)*rad_per_deg/2.))**proj%cone
+  
+      ! Find pole point
+      arg = proj%cone*(deltalon1*rad_per_deg)
+      proj%polei = proj%hemi*proj%knowni - proj%hemi * proj%rsw * SIN(arg)
+      proj%polej = proj%hemi*proj%knownj + proj%rsw * COS(arg)  
+  
+      RETURN
+
+   END SUBROUTINE set_lc                             
+
+
+   SUBROUTINE lc_cone(truelat1, truelat2, cone)
+ 
+   ! Subroutine to compute the cone factor of a Lambert Conformal projection
+ 
+      IMPLICIT NONE
+      
+      ! Input Args
+      REAL, INTENT(IN)             :: truelat1  ! (-90 -> 90 degrees N)
+      REAL, INTENT(IN)             :: truelat2  !   "   "  "   "     "
+  
+      ! Output Args
+      REAL, INTENT(OUT)            :: cone
+  
+      ! Locals
+  
+      ! BEGIN CODE
+  
+      ! First, see if this is a secant or tangent projection.  For tangent
+      ! projections, truelat1 = truelat2 and the cone is tangent to the 
+      ! Earth's surface at this latitude.  For secant projections, the cone
+      ! intersects the Earth's surface at each of the distinctly different
+      ! latitudes
+      IF (ABS(truelat1-truelat2) .GT. 0.1) THEN
+         cone = ALOG10(COS(truelat1*rad_per_deg)) - &
+                ALOG10(COS(truelat2*rad_per_deg))
+         cone = cone /(ALOG10(TAN((45.0 - ABS(truelat1)/2.0) * rad_per_deg)) - &
+                ALOG10(TAN((45.0 - ABS(truelat2)/2.0) * rad_per_deg)))        
+      ELSE
+         cone = SIN(ABS(truelat1)*rad_per_deg )  
+      ENDIF
+
+      RETURN
+
+   END SUBROUTINE lc_cone
+
+
+   SUBROUTINE ijll_lc( i, j, proj, lat, lon)
+ 
+   ! Subroutine to convert from the (i,j) cartesian coordinate to the 
+   ! geographical latitude and longitude for a Lambert Conformal projection.
+ 
+   ! History:
+   ! 25 Jul 01: Corrected by B. Shaw, NOAA/FSL
+   ! 
+      IMPLICIT NONE
+  
+      ! Input Args
+      REAL, INTENT(IN)              :: i        ! Cartesian X coordinate
+      REAL, INTENT(IN)              :: j        ! Cartesian Y coordinate
+      TYPE(proj_info),INTENT(IN)    :: proj     ! Projection info structure
+  
+      ! Output Args                 
+      REAL, INTENT(OUT)             :: lat      ! Latitude (-90->90 deg N)
+      REAL, INTENT(OUT)             :: lon      ! Longitude (-180->180 E)
+  
+      ! Locals 
+      REAL                          :: inew
+      REAL                          :: jnew
+      REAL                          :: r
+      REAL                          :: chi,chi1,chi2
+      REAL                          :: r2
+      REAL                          :: xx
+      REAL                          :: yy
+  
+      ! BEGIN CODE
+  
+      chi1 = (90. - proj%hemi*proj%truelat1)*rad_per_deg
+      chi2 = (90. - proj%hemi*proj%truelat2)*rad_per_deg
+  
+      ! See if we are in the southern hemispere and flip the indices
+      ! if we are. 
+      inew = proj%hemi * i
+      jnew = proj%hemi * j
+  
+      ! Compute radius**2 to i/j location
+      xx = inew - proj%polei
+      yy = proj%polej - jnew
+      r2 = (xx*xx + yy*yy)
+      r = SQRT(r2)/proj%rebydx
+     
+      ! Convert to lat/lon
+      IF (r2 .EQ. 0.) THEN
+         lat = proj%hemi * 90.
+         lon = proj%stdlon
+      ELSE
+         
+         ! Longitude
+         lon = proj%stdlon + deg_per_rad * ATAN2(proj%hemi*xx,yy)/proj%cone
+         lon = MOD(lon+360., 360.)
+   
+         ! Latitude.  Latitude determined by solving an equation adapted 
+         ! from:
+         !  Maling, D.H., 1973: Coordinate Systems and Map Projections
+         ! Equations #20 in Appendix I.  
+           
+         IF (chi1 .EQ. chi2) THEN
+            chi = 2.0*ATAN( ( r/TAN(chi1) )**(1./proj%cone) * TAN(chi1*0.5) )
+         ELSE
+            chi = 2.0*ATAN( (r*proj%cone/SIN(chi1))**(1./proj%cone) * TAN(chi1*0.5)) 
+         ENDIF
+         lat = (90.0-chi*deg_per_rad)*proj%hemi
+  
+      ENDIF
+  
+      IF (lon .GT. +180.) lon = lon - 360.
+      IF (lon .LT. -180.) lon = lon + 360.
+ 
+      RETURN
+
+   END SUBROUTINE ijll_lc
+
+
+   SUBROUTINE llij_lc( lat, lon, proj, i, j)
+ 
+   ! Subroutine to compute the geographical latitude and longitude values
+   ! to the cartesian x/y on a Lambert Conformal projection.
+     
+      IMPLICIT NONE
+  
+      ! Input Args
+      REAL, INTENT(IN)              :: lat      ! Latitude (-90->90 deg N)
+      REAL, INTENT(IN)              :: lon      ! Longitude (-180->180 E)
+      TYPE(proj_info),INTENT(IN)      :: proj     ! Projection info structure
+  
+      ! Output Args                 
+      REAL, INTENT(OUT)             :: i        ! Cartesian X coordinate
+      REAL, INTENT(OUT)             :: j        ! Cartesian Y coordinate
+  
+      ! Locals 
+      REAL                          :: arg
+      REAL                          :: deltalon
+      REAL                          :: tl1r
+      REAL                          :: rm
+      REAL                          :: ctl1r
+      
+  
+      ! BEGIN CODE
+      
+      ! Compute deltalon between known longitude and standard lon and ensure
+      ! it is not in the cut zone
+      deltalon = lon - proj%stdlon
+      IF (deltalon .GT. +180.) deltalon = deltalon - 360.
+      IF (deltalon .LT. -180.) deltalon = deltalon + 360.
+      
+      ! Convert truelat1 to radian and compute COS for later use
+      tl1r = proj%truelat1 * rad_per_deg
+      ctl1r = COS(tl1r)     
+     
+      ! Radius to desired point
+      rm = proj%rebydx * ctl1r/proj%cone * &
+           (TAN((90.*proj%hemi-lat)*rad_per_deg/2.) / &
+            TAN((90.*proj%hemi-proj%truelat1)*rad_per_deg/2.))**proj%cone
+  
+      arg = proj%cone*(deltalon*rad_per_deg)
+      i = proj%polei + proj%hemi * rm * SIN(arg)
+      j = proj%polej - rm * COS(arg)
+  
+      ! Finally, if we are in the southern hemisphere, flip the i/j
+      ! values to a coordinate system where (1,1) is the SW corner
+      ! (what we assume) which is different than the original NCEP
+      ! algorithms which used the NE corner as the origin in the 
+      ! southern hemisphere (left-hand vs. right-hand coordinate?)
+      i = proj%hemi * i  
+      j = proj%hemi * j
+
+      RETURN
+   END SUBROUTINE llij_lc
+
+
+   SUBROUTINE set_merc(proj)
+   
+      ! Sets up the remaining basic elements for the mercator projection
+  
+      IMPLICIT NONE
+      TYPE(proj_info), INTENT(INOUT)       :: proj
+      REAL                                 :: clain
+  
+  
+      !  Preliminary variables
+  
+      clain = COS(rad_per_deg*proj%truelat1)
+      proj%dlon = proj%dx / (proj%re_m * clain)
+  
+      ! Compute distance from equator to origin, and store in the 
+      ! proj%rsw tag.
+  
+      proj%rsw = 0.
+      IF (proj%lat1 .NE. 0.) THEN
+         proj%rsw = (ALOG(TAN(0.5*((proj%lat1+90.)*rad_per_deg))))/proj%dlon
+      ENDIF
+
+      RETURN
+
+   END SUBROUTINE set_merc
+
+
+   SUBROUTINE llij_merc(lat, lon, proj, i, j)
+ 
+      ! Compute i/j coordinate from lat lon for mercator projection
+    
+      IMPLICIT NONE
+      REAL, INTENT(IN)              :: lat
+      REAL, INTENT(IN)              :: lon
+      TYPE(proj_info),INTENT(IN)    :: proj
+      REAL,INTENT(OUT)              :: i
+      REAL,INTENT(OUT)              :: j
+      REAL                          :: deltalon
+  
+      deltalon = lon - proj%lon1
+      IF (deltalon .LT. -180.) deltalon = deltalon + 360.
+      IF (deltalon .GT. 180.) deltalon = deltalon - 360.
+      i = proj%knowni + (deltalon/(proj%dlon*deg_per_rad))
+      j = proj%knownj + (ALOG(TAN(0.5*((lat + 90.) * rad_per_deg)))) / &
+             proj%dlon - proj%rsw
+  
+      RETURN
+
+   END SUBROUTINE llij_merc
+
+
+   SUBROUTINE ijll_merc(i, j, proj, lat, lon)
+ 
+      ! Compute the lat/lon from i/j for mercator projection
+  
+      IMPLICIT NONE
+      REAL,INTENT(IN)               :: i
+      REAL,INTENT(IN)               :: j    
+      TYPE(proj_info),INTENT(IN)    :: proj
+      REAL, INTENT(OUT)             :: lat
+      REAL, INTENT(OUT)             :: lon 
+  
+  
+      lat = 2.0*ATAN(EXP(proj%dlon*(proj%rsw + j-proj%knownj)))*deg_per_rad - 90.
+      lon = (i-proj%knowni)*proj%dlon*deg_per_rad + proj%lon1
+      IF (lon.GT.180.) lon = lon - 360.
+      IF (lon.LT.-180.) lon = lon + 360.
+      RETURN
+
+   END SUBROUTINE ijll_merc
+
+
+   SUBROUTINE llij_latlon(lat, lon, proj, i, j)
+  
+      ! Compute the i/j location of a lat/lon on a LATLON grid.
+      IMPLICIT NONE
+      REAL, INTENT(IN)             :: lat
+      REAL, INTENT(IN)             :: lon
+      TYPE(proj_info), INTENT(IN)  :: proj
+      REAL, INTENT(OUT)            :: i
+      REAL, INTENT(OUT)            :: j
+  
+      REAL                         :: deltalat
+      REAL                         :: deltalon
+  
+      ! Compute deltalat and deltalon as the difference between the input 
+      ! lat/lon and the origin lat/lon
+      deltalat = lat - proj%lat1
+      deltalon = lon - proj%lon1      
+      
+      ! Compute i/j
+      i = deltalon/proj%loninc
+      j = deltalat/proj%latinc
+
+      i = i + proj%knowni
+      j = j + proj%knownj
+  
+      RETURN
+
+   END SUBROUTINE llij_latlon
+
+
+   SUBROUTINE ijll_latlon(i, j, proj, lat, lon)
+  
+      ! Compute the lat/lon location of an i/j on a LATLON grid.
+      IMPLICIT NONE
+      REAL, INTENT(IN)             :: i
+      REAL, INTENT(IN)             :: j
+      TYPE(proj_info), INTENT(IN)  :: proj
+      REAL, INTENT(OUT)            :: lat
+      REAL, INTENT(OUT)            :: lon
+  
+      REAL                         :: i_work, j_work
+      REAL                         :: deltalat
+      REAL                         :: deltalon
+  
+      i_work = i - proj%knowni
+      j_work = j - proj%knownj
+
+      ! Compute deltalat and deltalon 
+      deltalat = j_work*proj%latinc
+      deltalon = i_work*proj%loninc
+  
+      lat = proj%lat1 + deltalat
+      lon = proj%lon1 + deltalon
+  
+      RETURN
+
+   END SUBROUTINE ijll_latlon
+
+
+   SUBROUTINE set_cyl(proj)
+
+      implicit none
+
+      ! Arguments
+      type(proj_info), intent(inout) :: proj
+
+      proj%hemi = 1.0
+
+   END SUBROUTINE set_cyl
+
+
+   SUBROUTINE llij_cyl(lat, lon, proj, i, j)
+
+      implicit none
+    
+      ! Arguments
+      real, intent(in) :: lat, lon
+      real, intent(out) :: i, j
+      type(proj_info), intent(in) :: proj
+
+      ! Local variables
+      real :: deltalat
+      real :: deltalon
+
+      ! Compute deltalat and deltalon as the difference between the input
+      ! lat/lon and the origin lat/lon
+      deltalat = lat - proj%lat1
+!      deltalon = lon - proj%stdlon
+      deltalon = lon - proj%lon1
+
+      if (deltalon <   0.) deltalon = deltalon + 360.
+      if (deltalon > 360.) deltalon = deltalon - 360.
+
+      ! Compute i/j
+      i = deltalon/proj%loninc
+      j = deltalat/proj%latinc
+
+      if (i <= 0.)              i = i + 360./proj%loninc
+      if (i > 360./proj%loninc) i = i - 360./proj%loninc
+
+      i = i + proj%knowni
+      j = j + proj%knownj
+
+   END SUBROUTINE llij_cyl
+
+
+   SUBROUTINE ijll_cyl(i, j, proj, lat, lon)
+   
+      implicit none
+    
+      ! Arguments
+      real, intent(in) :: i, j
+      real, intent(out) :: lat, lon
+      type(proj_info), intent(in) :: proj
+
+      ! Local variables
+      real :: deltalat
+      real :: deltalon
+      real :: i_work, j_work
+
+      i_work = i - proj%knowni 
+      j_work = j - proj%knownj
+
+      if (i_work < 0.)              i_work = i_work + 360./proj%loninc
+      if (i_work >= 360./proj%loninc) i_work = i_work - 360./proj%loninc
+
+      ! Compute deltalat and deltalon
+      deltalat = j_work*proj%latinc
+      deltalon = i_work*proj%loninc
+
+      lat = deltalat + proj%lat1
+!      lon = deltalon + proj%stdlon
+      lon = deltalon + proj%lon1
+
+      if (lon < -180.) lon = lon + 360.
+      if (lon >  180.) lon = lon - 360.
+
+   END SUBROUTINE ijll_cyl
+
+
+   SUBROUTINE set_cassini(proj)
+
+      implicit none
+
+      ! Arguments
+      type(proj_info), intent(inout) :: proj
+
+      ! Local variables
+      real :: comp_lat, comp_lon
+      logical :: global_domain
+
+      proj%hemi = 1.0
+
+      ! Try to determine whether this domain has global coverage
+      if (abs(proj%lat1 - proj%latinc/2. + 90.) < 0.001 .and. &
+          abs(mod(proj%lon1 - proj%loninc/2. - proj%stdlon,360.)) < 0.001) then
+         global_domain = .true.
+      else
+         global_domain = .false.
+      end if
+
+      if (abs(proj%lat0) /= 90. .and. .not.global_domain) then
+         call rotate_coords(proj%lat1,proj%lon1,comp_lat,comp_lon,proj%lat0,proj%lon0,proj%stdlon,-1)
+         proj%lat1 = comp_lat
+         proj%lon1 = comp_lon
+      end if
+
+   END SUBROUTINE set_cassini
+
+
+   SUBROUTINE llij_cassini(lat, lon, proj, i, j)
+
+      implicit none
+    
+      ! Arguments
+      real, intent(in) :: lat, lon
+      real, intent(out) :: i, j
+      type(proj_info), intent(in) :: proj
+
+      ! Local variables
+      real :: comp_lat, comp_lon
+
+      ! Convert geographic to computational lat/lon
+      if (abs(proj%lat0) /= 90.) then
+         call rotate_coords(lat,lon,comp_lat,comp_lon,proj%lat0,proj%lon0,proj%stdlon,-1)
+      else
+         comp_lat = lat
+         comp_lon = lon
+      end if
+
+      ! Convert computational lat/lon to i/j
+      call llij_cyl(comp_lat, comp_lon, proj, i, j)
+
+   END SUBROUTINE llij_cassini
+
+
+   SUBROUTINE ijll_cassini(i, j, proj, lat, lon)
+   
+      implicit none
+    
+      ! Arguments
+      real, intent(in) :: i, j
+      real, intent(out) :: lat, lon
+      type(proj_info), intent(in) :: proj
+
+      ! Local variables
+      real :: comp_lat, comp_lon
+
+      ! Convert i/j to computational lat/lon
+      call ijll_cyl(i, j, proj, comp_lat, comp_lon)
+
+      ! Convert computational to geographic lat/lon
+      if (abs(proj%lat0) /= 90.) then
+         call rotate_coords(comp_lat,comp_lon,lat,lon,proj%lat0,proj%lon0,proj%stdlon,1)
+      else
+         lat = comp_lat
+         lon = comp_lon
+      end if
+
+   END SUBROUTINE ijll_cassini
+
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Purpose: Converts between computational and geographic lat/lon for Cassini
+   !          
+   ! Notes: This routine was provided by Bill Skamarock, 2007-03-27
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   SUBROUTINE rotate_coords(ilat,ilon,olat,olon,lat_np,lon_np,lon_0,direction)
+
+      IMPLICIT NONE
+
+      REAL, INTENT(IN   ) :: ilat, ilon
+      REAL, INTENT(  OUT) :: olat, olon
+      REAL, INTENT(IN   ) :: lat_np, lon_np, lon_0
+      INTEGER, INTENT(IN  ), OPTIONAL :: direction
+      ! >=0, default : computational -> geographical
+      ! < 0          : geographical  -> computational
+
+      REAL :: rlat, rlon
+      REAL :: phi_np, lam_np, lam_0, dlam
+      REAL :: sinphi, cosphi, coslam, sinlam
+
+      ! Convert all angles to radians
+      phi_np = lat_np * rad_per_deg
+      lam_np = lon_np * rad_per_deg
+      lam_0  = lon_0  * rad_per_deg
+      rlat = ilat * rad_per_deg
+      rlon = ilon * rad_per_deg
+
+      IF ( PRESENT(direction) ) THEN
+         IF (direction < 0) THEN
+            ! The equations are exactly the same except for one small difference
+            ! with respect to longitude ...
+            dlam = PI_M - lam_0
+         ELSE
+            dlam = lam_np
+         END IF
+      ELSE
+         dlam = lam_np
+      END IF
+      sinphi = COS(phi_np)*COS(rlat)*COS(rlon-dlam) + SIN(phi_np)*SIN(rlat)
+      cosphi = SQRT(1.-sinphi*sinphi)
+      coslam = SIN(phi_np)*COS(rlat)*COS(rlon-dlam) - COS(phi_np)*SIN(rlat)
+      sinlam = COS(rlat)*SIN(rlon-dlam)
+      IF ( cosphi /= 0. ) THEN
+         coslam = coslam/cosphi
+         sinlam = sinlam/cosphi
+      END IF
+      olat = deg_per_rad*ASIN(sinphi)
+      olon = deg_per_rad*(ATAN2(sinlam,coslam)-dlam-lam_0+lam_np)
+      ! Both of my F90 text books prefer the DO-EXIT form, and claim it is faster
+      ! when optimization is turned on (as we will always do...)
+      DO
+         IF (olon >= -180.) EXIT
+         olon = olon + 360.
+      END DO
+      DO
+         IF (olon <=  180.) EXIT
+         olon = olon - 360.
+      END DO
+
+   END SUBROUTINE rotate_coords
+
+
+   SUBROUTINE llij_rotlatlon(lat, lon, proj, i_real, j_real)
+   
+      IMPLICIT NONE
+    
+      ! Arguments
+      REAL, INTENT(IN) :: lat, lon
+      REAL             :: i, j
+      REAL, INTENT(OUT) :: i_real, j_real
+      TYPE (proj_info), INTENT(IN) :: proj
+      
+      ! Local variables
+      INTEGER :: ii,imt,jj,jmt,k,krows,ncol,nrow,iri
+      REAL(KIND=HIGH) :: dphd,dlmd !Grid increments, degrees
+      REAL(KIND=HIGH) :: glatd  !Geographic latitude, positive north
+      REAL(KIND=HIGH) :: glond  !Geographic longitude, positive west
+      REAL(KIND=HIGH) :: col,d1,d2,d2r,dlm,dlm1,dlm2,dph,glat,glon,    &
+                         pi,r2d,row,tlat,tlat1,tlat2,              &
+                         tlon,tlon1,tlon2,tph0,tlm0,x,y,z
+
+      glatd = lat
+      glond = -lon
+  
+      dphd = proj%phi/REAL((proj%jydim-1)/2)
+      dlmd = proj%lambda/REAL(proj%ixdim-1)
+
+      pi = ACOS(-1.0)
+      d2r = pi/180.
+      r2d = 1./d2r
+  
+      imt = 2*proj%ixdim-1
+      jmt = proj%jydim/2+1
+
+      glat = glatd*d2r
+      glon = glond*d2r
+      dph = dphd*d2r
+      dlm = dlmd*d2r
+      tph0 = proj%lat1*d2r
+      tlm0 = -proj%lon1*d2r
+  
+      x = COS(tph0)*COS(glat)*COS(glon-tlm0)+SIN(tph0)*SIN(glat)
+      y = -COS(glat)*SIN(glon-tlm0)
+      z = COS(tph0)*SIN(glat)-SIN(tph0)*COS(glat)*COS(glon-tlm0)
+      tlat = r2d*ATAN(z/SQRT(x*x+y*y))
+      tlon = r2d*ATAN(y/x)
+
+      row = tlat/dphd+jmt
+      col = tlon/dlmd+proj%ixdim
+
+      if ( (row - INT(row)) .gt. 0.999) then
+         row = row + 0.0002
+      else if ( (col - INT(col)) .gt. 0.999) then
+         col = col + 0.0002
+      end if
+
+      nrow = INT(row)
+      ncol = INT(col)
+
+!      nrow = NINT(row)
+!      ncol = NINT(col)
+
+      tlat = tlat*d2r
+      tlon = tlon*d2r
+
+  
+      IF (proj%stagger == HH) THEN
+
+         IF (mod(nrow,2) .eq. 0) then
+            i_real = col / 2.0
+         ELSE
+            i_real = col / 2.0 + 0.5
+         ENDIF
+         j_real=row
+
+  
+         IF ((abs(MOD(nrow,2)) == 1 .AND. abs(MOD(ncol,2)) == 1) .OR. &
+             (MOD(nrow,2) == 0 .AND. MOD(ncol,2) == 0)) THEN
+
+            tlat1 = (nrow-jmt)*dph
+            tlat2 = tlat1+dph
+            tlon1 = (ncol-proj%ixdim)*dlm
+            tlon2 = tlon1+dlm
+
+            dlm1 = tlon-tlon1
+            dlm2 = tlon-tlon2
+            d1 = ACOS(COS(tlat)*COS(tlat1)*COS(dlm1)+SIN(tlat)*SIN(tlat1))
+            d2 = ACOS(COS(tlat)*COS(tlat2)*COS(dlm2)+SIN(tlat)*SIN(tlat2))
+
+            IF (d1 > d2) THEN
+               nrow = nrow+1
+               ncol = ncol+1
+            END IF
+   
+         ELSE
+            tlat1 = (nrow+1-jmt)*dph
+            tlat2 = tlat1-dph
+            tlon1 = (ncol-proj%ixdim)*dlm
+            tlon2 = tlon1+dlm
+            dlm1 = tlon-tlon1
+            dlm2 = tlon-tlon2
+            d1 = ACOS(COS(tlat)*COS(tlat1)*COS(dlm1)+SIN(tlat)*SIN(tlat1))
+            d2 = ACOS(COS(tlat)*COS(tlat2)*COS(dlm2)+SIN(tlat)*SIN(tlat2))
+
+            IF (d1 < d2) THEN
+               nrow = nrow+1
+            ELSE
+               ncol = ncol+1
+            END IF
+         END IF
+  
+      ELSE IF (proj%stagger == VV) THEN
+
+         IF (mod(nrow,2) .eq. 0) then
+            i_real = col / 2.0 + 0.5
+         ELSE
+            i_real = col / 2.0 
+         ENDIF
+         j_real=row
+  
+         IF ((MOD(nrow,2) == 0 .AND. abs(MOD(ncol,2)) == 1) .OR. &
+             (abs(MOD(nrow,2)) == 1 .AND. MOD(ncol,2) == 0)) THEN
+            tlat1 = (nrow-jmt)*dph
+            tlat2 = tlat1+dph
+            tlon1 = (ncol-proj%ixdim)*dlm
+            tlon2 = tlon1+dlm
+            dlm1 = tlon-tlon1
+            dlm2 = tlon-tlon2
+            d1 = ACOS(COS(tlat)*COS(tlat1)*COS(dlm1)+SIN(tlat)*SIN(tlat1))
+            d2 = ACOS(COS(tlat)*COS(tlat2)*COS(dlm2)+SIN(tlat)*SIN(tlat2))
+    
+            IF (d1 > d2) THEN
+               nrow = nrow+1
+               ncol = ncol+1
+            END IF
+   
+         ELSE
+            tlat1 = (nrow+1-jmt)*dph
+            tlat2 = tlat1-dph
+            tlon1 = (ncol-proj%ixdim)*dlm
+            tlon2 = tlon1+dlm
+            dlm1 = tlon-tlon1
+            dlm2 = tlon-tlon2
+            d1 = ACOS(COS(tlat)*COS(tlat1)*COS(dlm1)+SIN(tlat)*SIN(tlat1))
+            d2 = ACOS(COS(tlat)*COS(tlat2)*COS(dlm2)+SIN(tlat)*SIN(tlat2))
+    
+            IF (d1 < d2) THEN
+               nrow = nrow+1
+            ELSE
+               ncol = ncol+1
+            END IF
+         END IF
+      END IF
+  
+
+!!! Added next line as a Kludge - not yet understood why needed
+      if (ncol .le. 0) ncol=ncol-1
+
+      jj = nrow
+      ii = ncol/2
+
+      IF (proj%stagger == HH) THEN
+         IF (abs(MOD(jj,2)) == 1) ii = ii+1
+      ELSE IF (proj%stagger == VV) THEN
+         IF (MOD(jj,2) == 0) ii=ii+1
+      END IF
+
+      i = REAL(ii)
+      j = REAL(jj)
+
+   END SUBROUTINE llij_rotlatlon
+
+
+   SUBROUTINE ijll_rotlatlon(i, j, proj, lat,lon)
+   
+      IMPLICIT NONE
+    
+      ! Arguments
+      REAL, INTENT(IN) :: i, j
+      REAL, INTENT(OUT) :: lat, lon
+      TYPE (proj_info), INTENT(IN) :: proj
+      
+      ! Local variables
+      INTEGER :: ih,jh
+      INTEGER :: midcol,midrow,ncol,iadd1,iadd2,imt,jh2,knrow,krem,kv,nrow
+      REAL :: i_work, j_work
+      REAL :: dphd,dlmd !Grid increments, degrees
+      REAL(KIND=HIGH) :: arg1,arg2,d2r,fctr,glatr,glatd,glond,pi, &
+              r2d,tlatd,tlond,tlatr,tlonr,tlm0,tph0
+      REAL :: col
+
+      i_work = i
+      j_work = j
+  
+      if ( (j - INT(j)) .gt. 0.999) then
+         j_work = j + 0.0002
+      endif
+
+      jh = INT(j_work)
+  
+      dphd = proj%phi/REAL((proj%jydim-1)/2)
+      dlmd = proj%lambda/REAL(proj%ixdim-1)
+    
+      pi = ACOS(-1.0)
+      d2r = pi/180.
+      r2d = 1./d2r
+      tph0 = proj%lat1*d2r
+      tlm0 = -proj%lon1*d2r
+
+      midrow = (proj%jydim+1)/2
+      midcol = proj%ixdim
+
+      col = 2*i_work-1+abs(MOD(jh+1,2))
+      tlatd = (j_work-midrow)*dphd
+      tlond = (col-midcol)*dlmd
+
+       IF (proj%stagger == VV) THEN
+          if (mod(jh,2) .eq. 0) then
+             tlond = tlond - DLMD
+          else
+             tlond = tlond + DLMD
+          end if
+       END IF
+    
+      tlatr = tlatd*d2r
+      tlonr = tlond*d2r
+      arg1 = SIN(tlatr)*COS(tph0)+COS(tlatr)*SIN(tph0)*COS(tlonr)
+      glatr = ASIN(arg1)
+     
+      glatd = glatr*r2d
+     
+      arg2 = COS(tlatr)*COS(tlonr)/(COS(glatr)*COS(tph0))-TAN(glatr)*TAN(tph0)
+      IF (ABS(arg2) > 1.) arg2 = ABS(arg2)/arg2
+      fctr = 1.
+      IF (tlond > 0.) fctr = -1.
+     
+      glond = tlm0*r2d+fctr*ACOS(arg2)*r2d
+
+      lat = glatd
+      lon = -glond
+
+      IF (lon .GT. +180.) lon = lon - 360.
+      IF (lon .LT. -180.) lon = lon + 360.
+   
+   END SUBROUTINE ijll_rotlatlon
+
+
+   SUBROUTINE set_gauss(proj)
+    
+      IMPLICIT NONE
+ 
+      ! Argument
+      type (proj_info), intent(inout) :: proj
+ 
+      !  Initialize the array that will hold the Gaussian latitudes.
+ 
+      IF ( ASSOCIATED( proj%gauss_lat ) ) THEN
+         DEALLOCATE ( proj%gauss_lat )
+      END IF
+ 
+      !  Get the needed space for our array.
+ 
+      ALLOCATE ( proj%gauss_lat(proj%nlat*2) )
+ 
+      !  Compute the Gaussian latitudes.
+ 
+      CALL gausll( proj%nlat*2 , proj%gauss_lat )
+ 
+      !  Now, these could be upside down from what we want, so let's check.
+      !  We take advantage of the equatorial symmetry to remove any sort of
+      !  array re-ordering.
+ 
+      IF ( ABS(proj%gauss_lat(1) - proj%lat1) .GT. 0.01 ) THEN
+         proj%gauss_lat = -1. * proj%gauss_lat
+      END IF
+ 
+      !  Just a sanity check.
+ 
+      IF ( ABS(proj%gauss_lat(1) - proj%lat1) .GT. 0.01 ) THEN
+         PRINT '(A)','Oops, something is not right with the Gaussian latitude computation.'
+         PRINT '(A,F8.3,A)','The input data gave the starting latitude as ',proj%lat1,'.'
+         PRINT '(A,F8.3,A)','This routine computed the starting latitude as +-',ABS(proj%gauss_lat(1)),'.'
+         PRINT '(A,F8.3,A)','The difference is larger than 0.01 degrees, which is not expected.'
+         CALL wrf_error_fatal ( 'Gaussian_latitude_computation' )
+      END IF
+ 
+   END SUBROUTINE set_gauss
+
+
+   SUBROUTINE gausll ( nlat , lat_sp )
+ 
+      IMPLICIT NONE
+   
+      INTEGER                            :: nlat , i
+      REAL (KIND=HIGH) , PARAMETER       :: pi = 3.141592653589793
+      REAL (KIND=HIGH) , DIMENSION(nlat) :: cosc , gwt , sinc , colat , wos2 , lat
+      REAL             , DIMENSION(nlat) :: lat_sp
+   
+      CALL lggaus(nlat, cosc, gwt, sinc, colat, wos2)
+   
+      DO i = 1, nlat
+         lat(i) = ACOS(sinc(i)) * 180._HIGH / pi
+         IF (i.gt.nlat/2) lat(i) = -lat(i)
+      END DO
+   
+      lat_sp = REAL(lat)
+ 
+   END SUBROUTINE gausll
+
+
+   SUBROUTINE lggaus( nlat, cosc, gwt, sinc, colat, wos2 )
+ 
+      IMPLICIT NONE
+ 
+      !  LGGAUS finds the Gaussian latitudes by finding the roots of the
+      !  ordinary Legendre polynomial of degree NLAT using Newton's
+      !  iteration method.
+      
+      !  On entry:
+            integer NLAT ! the number of latitudes (degree of the polynomial)
+      
+      !  On exit: for each Gaussian latitude
+      !     COSC   - cos(colatitude) or sin(latitude)
+      !     GWT    - the Gaussian weights
+      !     SINC   - sin(colatitude) or cos(latitude)
+      !     COLAT  - the colatitudes in radians
+      !     WOS2   - Gaussian weight over sin**2(colatitude)
+ 
+      REAL (KIND=HIGH) , DIMENSION(nlat) :: cosc , gwt , sinc , colat  , wos2 
+      REAL (KIND=HIGH) , PARAMETER       :: pi = 3.141592653589793
+ 
+      !  Convergence criterion for iteration of cos latitude
+ 
+      REAL , PARAMETER :: xlim  = 1.0E-14
+ 
+      INTEGER :: nzero, i, j
+      REAL (KIND=HIGH) :: fi, fi1, a, b, g, gm, gp, gt, delta, c, d
+ 
+      !  The number of zeros between pole and equator
+ 
+      nzero = nlat/2
+ 
+      !  Set first guess for cos(colat)
+ 
+      DO i=1,nzero
+         cosc(i) = SIN( (i-0.5)*pi/nlat + pi*0.5 )
+      END DO
+ 
+      !  Constants for determining the derivative of the polynomial
+      fi  = nlat
+      fi1 = fi+1.0
+      a   = fi*fi1 / SQRT(4.0*fi1*fi1-1.0)
+      b   = fi1*fi / SQRT(4.0*fi*fi-1.0)
+ 
+      !  Loop over latitudes, iterating the search for each root
+ 
+      DO i=1,nzero
+         j=0
+ 
+         !  Determine the value of the ordinary Legendre polynomial for
+         !  the current guess root
+ 
+         DO
+            CALL lgord( g, cosc(i), nlat )
+   
+            !  Determine the derivative of the polynomial at this point
+   
+            CALL lgord( gm, cosc(i), nlat-1 )
+            CALL lgord( gp, cosc(i), nlat+1 )
+            gt = (cosc(i)*cosc(i)-1.0) / (a*gp-b*gm)
+   
+            !  Update the estimate of the root
+   
+            delta   = g*gt
+            cosc(i) = cosc(i) - delta
+   
+            !  If convergence criterion has not been met, keep trying
+   
+            j = j+1
+            IF( ABS(delta).GT.xlim ) CYCLE
+   
+            !  Determine the Gaussian weights
+   
+            c      = 2.0 *( 1.0-cosc(i)*cosc(i) )
+            CALL lgord( d, cosc(i), nlat-1 )
+            d      = d*d*fi*fi
+            gwt(i) = c *( fi-0.5 ) / d
+            EXIT
+ 
+         END DO
+ 
+      END DO
+ 
+      !  Determine the colatitudes and sin(colat) and weights over sin**2
+ 
+      DO i=1,nzero
+         colat(i)= ACOS(cosc(i))
+         sinc(i) = SIN(colat(i))
+         wos2(i) = gwt(i) /( sinc(i)*sinc(i) )
+      END DO
+ 
+      !  If NLAT is odd, set values at the equator
+ 
+      IF( MOD(nlat,2) .NE. 0 ) THEN
+         i       = nzero+1
+         cosc(i) = 0.0
+         c       = 2.0
+         CALL lgord( d, cosc(i), nlat-1 )
+         d       = d*d*fi*fi
+         gwt(i)  = c *( fi-0.5 ) / d
+         colat(i)= pi*0.5
+         sinc(i) = 1.0
+         wos2(i) = gwt(i)
+      END IF
+ 
+      !  Determine the southern hemisphere values by symmetry
+ 
+      DO i=nlat-nzero+1,nlat
+         cosc(i) =-cosc(nlat+1-i)
+         gwt(i)  = gwt(nlat+1-i)
+         colat(i)= pi-colat(nlat+1-i)
+         sinc(i) = sinc(nlat+1-i)
+         wos2(i) = wos2(nlat+1-i)
+      END DO
+ 
+   END SUBROUTINE lggaus
+
+
+   SUBROUTINE lgord( f, cosc, n )
+ 
+      IMPLICIT NONE
+ 
+      !  LGORD calculates the value of an ordinary Legendre polynomial at a
+      !  specific latitude.
+      
+      !  On entry:
+      !     cosc - COS(colatitude)
+      !     n      - the degree of the polynomial
+      
+      !  On exit:
+      !     f      - the value of the Legendre polynomial of degree N at
+      !              latitude ASIN(cosc)
+ 
+      REAL (KIND=HIGH) :: s1, c4, a, b, fk, f, cosc, colat, c1, fn, ang
+      INTEGER :: n, k
+ 
+      !  Determine the colatitude
+ 
+      colat = ACOS(cosc)
+ 
+      c1 = SQRT(2.0_HIGH)
+      DO k=1,n
+         c1 = c1 * SQRT( 1.0 - 1.0/(4*k*k) )
+      END DO
+ 
+      fn = n
+      ang= fn * colat
+      s1 = 0.0
+      c4 = 1.0
+      a  =-1.0
+      b  = 0.0
+      DO k=0,n,2
+         IF (k.eq.n) c4 = 0.5 * c4
+         s1 = s1 + c4 * COS(ang)
+         a  = a + 2.0
+         b  = b + 1.0
+         fk = k
+         ang= colat * (fn-fk-2.0)
+         c4 = ( a * (fn-b+1.0) / ( b * (fn+fn-a) ) ) * c4
+      END DO 
+ 
+      f = s1 * c1
+ 
+   END SUBROUTINE lgord
+
+
+   SUBROUTINE llij_gauss (lat, lon, proj, i, j) 
+ 
+      IMPLICIT NONE
+ 
+      REAL    , INTENT(IN)  :: lat, lon
+      REAL    , INTENT(OUT) :: i, j
+      TYPE (proj_info), INTENT(IN) :: proj
+ 
+      INTEGER :: n , n_low
+      LOGICAL :: found = .FALSE.
+      REAL    :: diff_1 , diff_nlat
+ 
+      !  The easy one first, get the x location.  The calling routine has already made
+      !  sure that the necessary assumptions concerning the sign of the deltalon and the
+      !  relative east/west'ness of the longitude and the starting longitude are consistent
+      !  to allow this easy computation.
+ 
+      i = ( lon - proj%lon1 ) / proj%loninc + 1.
+ 
+      !  Since this is a global data set, we need to be concerned about wrapping the
+      !  fields around the globe.
+ 
+!      IF      ( ( proj%loninc .GT. 0 ) .AND. &
+!                ( FLOOR((lon-proj%lon1)/proj%loninc) + 1 .GE. proj%ixdim ) .AND. &
+!                ( lon + proj%loninc .GE. proj%lon1 + 360 ) ) THEN
+!! BUG: We may need to set proj%wrap, but proj is intent(in)
+!! WHAT IS THIS USED FOR?
+!!        proj%wrap = .TRUE.
+!         i = proj%ixdim
+!      ELSE IF ( ( proj%loninc .LT. 0 ) .AND. &
+!                ( FLOOR((lon-proj%lon1)/proj%loninc) + 1 .GE. proj%ixdim ) .AND. &
+!                ( lon + proj%loninc .LE. proj%lon1 - 360 ) ) THEN
+! ! BUG: We may need to set proj%wrap, but proj is intent(in)
+! ! WHAT IS THIS USED FOR?
+! !        proj%wrap = .TRUE.
+!         i = proj%ixdim
+!      END IF
+ 
+      !  Yet another quicky test, can we find bounding values?  If not, then we may be
+      !  dealing with putting data to a polar projection, so just give them them maximal
+      !  value for the location.  This is an OK assumption for the interpolation across the
+      !  top of the pole, given how close the longitude lines are.
+ 
+      IF ( ABS(lat) .GT. ABS(proj%gauss_lat(1)) ) THEN
+ 
+         diff_1    = lat - proj%gauss_lat(1)
+         diff_nlat = lat - proj%gauss_lat(proj%nlat*2)
+ 
+         IF ( ABS(diff_1) .LT. ABS(diff_nlat) ) THEN
+            j = 1
+         ELSE
+            j = proj%nlat*2
+         END IF
+ 
+      !  If the latitude is between the two bounding values, we have to search and interpolate.
+ 
+      ELSE
+ 
+         DO n = 1 , proj%nlat*2 -1
+            IF ( ( proj%gauss_lat(n) - lat ) * ( proj%gauss_lat(n+1) - lat ) .LE. 0 ) THEN
+               found = .TRUE.
+               n_low = n
+               EXIT
+            END IF
+         END DO
+ 
+         !  Everything still OK?
+  
+         IF ( .NOT. found ) THEN
+            PRINT '(A)','Troubles in river city.  No bounding values of latitude found in the Gaussian routines.'
+            CALL wrf_error_fatal ( 'Gee_no_bounding_lats_Gaussian' )
+         END IF
+ 
+         j = ( ( proj%gauss_lat(n_low) - lat                     ) * ( n_low + 1 ) + &
+               ( lat                   - proj%gauss_lat(n_low+1) ) * ( n_low     ) ) / &
+               ( proj%gauss_lat(n_low) - proj%gauss_lat(n_low+1) )
+ 
+      END IF
+
+   END SUBROUTINE llij_gauss 
+
+   SUBROUTINE wrf_error_fatal(str)
+
+     CHARACTER(LEN=*) :: str
+
+     CALL ipslerr(3, str, "Error redirected from wrf_error_fatal in modile_llxy","","")
+
+   END SUBROUTINE wrf_error_fatal
+  
+END MODULE module_llxy
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/polygones.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/polygones.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/polygones.f90	(revision 6412)
@@ -0,0 +1,733 @@
+
+MODULE polygones
+  !
+  ! This module is there to handle polygones. It is an essential tool in interpolation methods.
+  !
+  USE defprec
+  
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: polygones_pointinside, polygones_extend, polygones_intersection, polygones_cleanup, &
+       &    polygones_area, polygones_crossing, polygones_convexhull
+  !
+  REAL(r_std),PARAMETER                     :: zero=0.0
+  !
+CONTAINS
+!
+!=======================================================================================================
+!
+  SUBROUTINE polygones_pointinside(nvert_in, poly, point_x, point_y, inside)
+    !
+    ! Routine to determine of point (point_x, point_y) is inside of polygone poly
+    ! Mathode based on docume http://www.ecse.rpi.edu/Homepages/wrf/Research/Short_Notes/pnpoly.html
+    !
+    ! Arguments
+    INTEGER(i_std), INTENT(in)              :: nvert_in
+    REAL(r_std), DIMENSION(:,:), INTENT(in) :: poly
+    REAL(r_std), INTENT(in)                 :: point_x, point_y
+    LOGICAL, INTENT(out)                    :: inside
+    !
+    ! Local
+    INTEGER(i_std)                          :: i, j, nvert
+    REAL(r_std)                             :: xonline
+    !
+    !
+    inside = .FALSE.
+    !
+    nvert=SIZE(poly,DIM=1)
+    IF ( nvert < nvert_in) THEN
+       WRITE(*,*) "Input polygone is smaller than the size proposed in the interface."
+       STOP "polygones_pointinside"
+    ENDIF
+    IF (SIZE(poly,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "This cannot be a polygone :", SIZE(poly)
+       STOP "polygones_pointinside"
+    ENDIF
+    !
+    j = nvert_in
+    DO i=1,nvert_in
+       IF ( (poly(i,2) > point_y) .NEQV. (poly(j,2) > point_y) ) THEN
+          xonline = (poly(j,1)-poly(i,1))*(point_y-poly(i,2))/(poly(j,2)-poly(i,2))+poly(i,1)
+          IF ( point_x < xonline ) THEN
+             inside = (.NOT. inside)
+          ENDIF
+       ENDIF
+       j = i
+    ENDDO
+    !
+  END SUBROUTINE polygones_pointinside
+!
+!=======================================================================================================
+!
+  SUBROUTINE polygones_lineintersect(la, lb, intersection, point_x, point_y)
+    !
+    ! Simple alogorith tho determine the intersections of 2 lines.
+    !
+    ! ARGUMENTS
+    REAL(r_std), DIMENSION(2,2), INTENT(in)    :: la, lb
+    LOGICAL, INTENT(out)                       :: intersection
+    REAL(r_std), INTENT(out)                   :: point_x, point_y
+    !
+    ! Local
+    REAL(r_std)                                :: den, ua, ub
+    REAL(r_std)                                :: x1, x2, x3, x4, y1, y2, y3, y4
+    !
+    intersection = .FALSE.
+    !
+     x1 = la(1,1)
+     y1 = la(1,2)
+     x2 = la(2,1)
+     y2 = la(2,2)
+
+     x3 = lb(1,1)
+     y3 = lb(1,2)
+     x4 = lb(2,1)
+     y4 = lb(2,2)
+
+     den = (y4-y3)*(x2-x1)-(x4-x3)*(y2-y1)
+
+     IF ( ABS(den) > EPSILON(den) ) THEN
+        ua = ((x4-x3)*(y1-y3)-(y4-y3)*(x1-x3))/den
+        ub = ((x2-x1)*(y1-y3)-(y2-y1)*(x1-x3))/den
+        IF ( ua >= 0 .AND. ua <= 1 .AND. ub >= 0 .AND. ub <= 1) THEN
+           intersection = .TRUE.
+           point_x = x1 + ua*(x2-x1)
+           point_y = y1 + ua*(y2-y1)
+        ENDIF
+     ENDIF
+
+  END SUBROUTINE polygones_lineintersect
+!
+!=======================================================================================================
+!
+  SUBROUTINE polygones_extend(nvert_in, poly_in, nbdots, nvert_out, poly_out)
+    !
+    ! This function simply add nbdots onto each side of the polygone.
+    !
+    ! Arguments
+    INTEGER(i_std), INTENT(in)               :: nvert_in
+    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_in
+    INTEGER(i_std), INTENT(in)               :: nbdots
+    INTEGER(i_std), INTENT(out)              :: nvert_out
+    REAL(r_std), DIMENSION(:,:), INTENT(out) :: poly_out
+    !
+    ! Local
+    !
+    INTEGER(i_std)                        :: nvert, nvert_tmp, i, j, id, ipos
+    REAL(r_std)                           :: xs, xe, ys, ye
+    !
+    nvert=SIZE(poly_in,DIM=1)
+    IF ( nvert < nvert_in ) THEN
+       WRITE(*,*) "Input polygone is smaller than the size proposed in the interface."
+       STOP "polygones_extend"
+    ENDIF
+    IF (SIZE(poly_in,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "Poly_in cannot be a polygone :", SIZE(poly_in)
+       STOP "polygones_extend"
+    ENDIF
+    nvert_tmp=SIZE(poly_out,DIM=1)
+    IF (SIZE(poly_out,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "Poly_out cannot be a polygone :", SIZE(poly_out)
+       STOP "polygones_extend"
+    ENDIF
+    !
+    IF ( nvert_tmp < nvert_in*nbdots) THEN
+       WRITE(*,*) "Poly_out is too small for extending it :", SIZE(poly_out), " we would need :", nvert_in*nbdots
+       STOP "polygones_extend"
+    ENDIF
+    nvert_out = nvert_in*nbdots
+    !
+    j = nvert_in
+    ipos = 0
+    DO i=1,nvert_in
+       xs = poly_in(j,1)
+       xe = poly_in(i,1)
+       ys = poly_in(j,2)
+       ye = poly_in(i,2)
+       IF (xs == xe ) THEN 
+          DO id=1,nbdots 
+             ipos = ipos + 1
+             poly_out(ipos,1) = xs
+             poly_out(ipos,2) = ys + (id-1)*(ye-ys)/nbdots
+          ENDDO
+       ELSE IF (ys == ye ) THEN
+          DO id=1,nbdots
+             ipos = ipos + 1
+             poly_out(ipos,1) = xs + (id-1)*(xe-xs)/nbdots
+             poly_out(ipos,2) = ys
+          ENDDO
+       ELSE
+          DO id=1,nbdots
+             ipos = ipos + 1
+             poly_out(ipos,2) = ys + (id-1)*(ye-ys)/nbdots
+             poly_out(ipos,1) = (xs-xe)*(poly_out(ipos,2)-ye)/(ys-ye)+xe
+          ENDDO
+       ENDIF
+       j = i
+    ENDDO
+    !
+  END SUBROUTINE polygones_extend
+!
+!=======================================================================================================
+!
+  SUBROUTINE polygones_intersection(nvert_a, poly_a, nvert_b, poly_b, nbpts, poly_out)
+    !
+    ! Find the polygon resulting from the intersection of poly_a and poly_b
+    !
+    ! Arguments
+    INTEGER(i_std), INTENT(in)               :: nvert_a
+    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_a
+    INTEGER(i_std), INTENT(in)               :: nvert_b
+    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_b
+    INTEGER(i_std), INTENT(out)              :: nbpts
+    REAL(r_std), DIMENSION(:,:), INTENT(out) :: poly_out
+    !
+    ! Local
+    INTEGER(i_std)                            :: nvert_tmpa, nvert_tmpb, nvert_out, i, j
+    LOGICAL                                   :: inside
+    INTEGER(i_std)                            :: in_a, in_b
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: ptin_a, ptin_b
+    !
+    nvert_tmpa=SIZE(poly_a,DIM=1)
+    IF ( nvert_tmpa < nvert_a) THEN
+       WRITE(*,*) "Input polygone (poly_a) is smaller than the size proposed in the interface."
+       STOP "polygones_intersection"
+    ENDIF
+    IF (SIZE(poly_a,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "Poly_a cannot be a polygone :", SIZE(poly_a)
+       STOP "polygones_intersection"
+    ENDIF
+    ALLOCATE(ptin_a(nvert_a))
+    nvert_tmpb=SIZE(poly_b,DIM=1)
+    IF ( nvert_tmpb < nvert_a) THEN
+       WRITE(*,*) "Input polygone (poly_b) is smaller than the size proposed in the interface."
+       STOP "polygones_intersection"
+    ENDIF
+    IF (SIZE(poly_b,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "Poly_b cannot be a polygone :", SIZE(poly_b)
+       STOP "polygones_intersection"
+    ENDIF
+    ALLOCATE(ptin_b(nvert_b))
+    !
+    !
+    in_a = 0
+    DO i=1,nvert_a
+       CALL polygones_pointinside(nvert_b, poly_b, poly_a(i,1), poly_a(i,2), inside)
+       IF ( inside ) THEN
+          in_a = in_a + 1
+          ptin_a(in_a) = i
+       ENDIF
+    ENDDO
+    !
+    in_b = 0
+    DO i=1,nvert_b
+       CALL polygones_pointinside(nvert_a, poly_a, poly_b(i,1), poly_b(i,2), inside)
+       IF ( inside ) THEN
+          in_b = in_b + 1
+          ptin_b(in_b) = i
+       ENDIF
+    ENDDO
+    !
+    nbpts = in_a + in_b
+    !
+    nvert_out=SIZE(poly_out,DIM=1)
+    IF (SIZE(poly_out,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "Poly_out cannot be a polygone :", SIZE(poly_out)
+       STOP "polygones_intersection"
+    ENDIF
+    IF ( nbpts <= nvert_out ) THEN
+       i = 0
+       DO j=1,in_a
+          i = i+1
+          poly_out(i,:) = poly_a(ptin_a(j),:)
+       ENDDO
+       DO j=1,in_b
+          i = i+1
+          poly_out(i,:) = poly_b(ptin_b(j),:)
+       ENDDO
+    ELSE
+       WRITE(*,*) "The intersection polygone has", nbpts, "points and that is more than available in poly_out", SIZE(poly_out)
+       STOP "polygones_intersection"
+    ENDIF
+    !
+    DEALLOCATE(ptin_a, ptin_b)
+    !
+  END SUBROUTINE polygones_intersection
+!
+!=======================================================================================================
+!
+  SUBROUTINE polygones_cleanup(nvert_in, poly_in, nvert_out, poly_out)
+    !
+    ! Clean_up the polygone by deleting points which are redundant and ordering based 
+    ! on the proximity of the points. Beware this does not give a convex hull to the surface
+    ! inside the polygone.
+    !
+    ! Arguments
+    INTEGER(i_std), INTENT(in)               :: nvert_in
+    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_in
+    INTEGER(i_std), INTENT(out)              :: nvert_out
+    REAL(r_std), DIMENSION(:,:), INTENT(out) :: poly_out
+    !
+    ! Local
+    !
+    INTEGER(i_std)                           :: nvert, nvert_tmpin, nvert_tmp
+    INTEGER(i_std)                           :: i, j
+    INTEGER(i_std), DIMENSION(1)             :: ismin
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)   :: dist
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: poly_tmp
+    !
+    nvert_tmpin=SIZE(poly_in,DIM=1)
+    IF ( nvert_tmpin < nvert_in ) THEN
+       WRITE(*,*) "Input polygone is smaller than the size proposed in the interface."
+       STOP "polygones_cleanup"
+    ENDIF
+    IF (SIZE(poly_in,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "Poly_in cannot be a polygone :", SIZE(poly_in)
+       STOP "polygones_cleanup"
+    ENDIF
+    nvert_tmp=SIZE(poly_out,DIM=1)
+    IF (SIZE(poly_out,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "Poly_out cannot be a polygone :", SIZE(poly_out)
+       STOP "polygones_cleanup"
+    ENDIF
+    !
+    ALLOCATE(poly_tmp(nvert_in,2))
+    ALLOCATE(dist(nvert_in))
+    !
+    nvert = nvert_in-1
+    poly_tmp(1:nvert,:) = poly_in(2:nvert_in,:)
+    poly_out(1,:) = poly_in(1,:)
+    nvert_out = 1
+    !
+    DO WHILE ( nvert > 0 ) 
+       !
+       DO j=1,nvert
+          dist(j) = SQRT((poly_out(nvert_out,1)-poly_tmp(j,1))**2+(poly_out(nvert_out,2)-poly_tmp(j,2))**2)
+       ENDDO
+       !
+       ismin = MINLOC(dist(1:nvert))
+       !
+       IF ( dist(ismin(1)) > EPSILON(dist(1)) ) THEN
+          !
+          ! The smallest distance between 2 vertices is larger than zero :
+          ! Add the vertex to poly_out and delete it from poly_tmp
+          !
+          nvert_out = nvert_out + 1
+          IF ( nvert_out > nvert_tmp) THEN
+             WRITE(*,*) "Output polygone too small"
+             STOP "polygones_cleanup"
+          ENDIF
+          poly_out(nvert_out,:) = poly_tmp(ismin(1),:)
+          poly_tmp(ismin(1):nvert-1,:) = poly_tmp(ismin(1)+1:nvert,:)
+       ELSE
+          !
+          ! Else the vertex already exists in poly_out and thus we just need
+          ! to delete it from poly_tmp
+          !
+          poly_tmp(ismin(1):nvert-1,:) = poly_tmp(ismin(1)+1:nvert,:)
+       ENDIF
+       !
+       ! One less vertices exists in poly_tmp
+       !
+       nvert = nvert-1
+       !
+    ENDDO
+
+    DEALLOCATE(poly_tmp, dist)
+
+  END SUBROUTINE polygones_cleanup
+!
+!=======================================================================================================
+!
+  SUBROUTINE polygones_area(nvert_in, poly_in, dx, dy, area)
+    !
+    ! Find the polygon resulting from the intersection of poly_a and poly_b
+    !
+    ! Arguments
+    INTEGER(i_std), INTENT(in)               :: nvert_in
+    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_in
+    REAL(r_std), INTENT(in)                  :: dx, dy
+    REAL(r_std), INTENT(out)                 :: area
+    !
+    ! Local
+    !
+    INTEGER(i_std)     :: nvert, i, j
+    !
+    nvert = SIZE(poly_in,DIM=1)
+    IF ( nvert < nvert_in) THEN
+       WRITE(*,*) "Input polygone is smaller than the size proposed in the interface."
+       STOP "polygones_area"
+    ENDIF
+    IF (SIZE(poly_in,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "Poly_in cannot be a polygone :", SIZE(poly_in)
+       STOP "polygones_area"
+    ENDIF
+    !
+    area = zero
+    j = nvert_in
+    DO i=1,nvert_in
+!!       area = area + (dy*(poly_in(j,2)+poly_in(i,2))/2.0)*(dx*(poly_in(j,1)-poly_in(i,1)))
+       area = area + dy*dx/2.0*(poly_in(j,2)+poly_in(i,2))*(poly_in(j,1)-poly_in(i,1))
+       j = i
+    ENDDO
+    !
+    area = ABS(area)
+    !
+  END SUBROUTINE polygones_area
+!
+!=======================================================================================================
+!
+  SUBROUTINE polygones_crossing(nvert_a, poly_a, nvert_b, poly_b, nbpts, crossings)
+    !
+    ! Find the polygon resulting from the intersection of poly_a and poly_b
+    !
+    ! Arguments
+    INTEGER(i_std), INTENT(in)               :: nvert_a
+    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_a
+    INTEGER(i_std), INTENT(in)               :: nvert_b
+    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_b
+    INTEGER(i_std), INTENT(out)              :: nbpts
+    REAL(r_std), DIMENSION(:,:), INTENT(out) :: crossings
+    !
+    ! Local
+    !
+    INTEGER(i_std)                            :: nvert, ia, ja, ib, jb
+    REAL(r_std), DIMENSION(2,2)               :: la, lb
+    REAL(r_std)                               :: x, y
+    LOGICAL                                   :: intersect
+    !
+    nvert=SIZE(poly_a,DIM=1)
+    IF ( nvert < nvert_a) THEN
+       WRITE(*,*) "Input polygone (poly_a) is smaller than the size proposed in the interface."
+       STOP "polygones_crossing"
+    ENDIF
+    IF (SIZE(poly_a,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "Poly_a cannot be a polygone :", SIZE(poly_a)
+       STOP "polygones_crossing"
+    ENDIF
+    nvert=SIZE(poly_b,DIM=1)
+    IF ( nvert < nvert_b) THEN
+       WRITE(*,*) "Input polygone (poly_b) is smaller than the size proposed in the interface."
+       STOP "polygones_crossing"
+    ENDIF
+    IF (SIZE(poly_b,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "Poly_b cannot be a polygone :", SIZE(poly_b)
+       STOP "polygones_crossing"
+    ENDIF
+    nvert=SIZE(crossings,DIM=1)
+    IF (SIZE(crossings,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "Poly_a cannot be a polygone :", SIZE(poly_a)
+       STOP "polygones_crossing"
+    ENDIF
+    !
+    nbpts = 0
+    !
+    ja = nvert_a
+    DO ia=1,nvert_a
+       !
+       ! Put one side of the polygone a into la
+       !
+       la(1,1) = poly_a(ja,1)
+       la(1,2) = poly_a(ja,2)
+       la(2,1) = poly_a(ia,1)
+       la(2,2) = poly_a(ia,2)
+       !
+       jb = nvert_b
+       DO ib=1,nvert_b
+          !
+          ! Put one side of the polygone b into lb
+          !
+          lb(1,1) = poly_b(jb,1)
+          lb(1,2) = poly_b(jb,2)
+          lb(2,1) = poly_b(ib,1)
+          lb(2,2) = poly_b(ib,2)
+          !
+          CALL polygones_lineintersect(la, lb, intersect, x, y)
+          !
+          IF ( intersect ) THEN
+             nbpts = nbpts + 1
+             IF ( nbpts <= nvert ) THEN
+                crossings(nbpts, 1) = x
+                crossings(nbpts, 2) = y
+             ELSE
+                WRITE(*,*) "Polygone to write the intersection points is too small", nvert, nbpts
+                STOP "polygones_crossing"
+             ENDIF
+          ENDIF
+          !
+          jb = ib
+       ENDDO
+       ja = ia
+    ENDDO
+    !
+
+  END SUBROUTINE polygones_crossing
+!
+!=======================================================================================================
+!
+  SUBROUTINE polygones_convexhull(nvert_in, poly_in, nvert_out, poly_out)
+    !
+    ! Routine orders points in poly_in so that they form a convex shape. This is based on the Graham scan
+    ! algorith as implemented by Alan Miller : http://jblevins.org/mirror/amiller/
+    !
+    ! The output polygone can be smaller than the input one as we are computing the convex envelope.
+    !
+    ! Arguments
+    INTEGER(i_std), INTENT(in)               :: nvert_in
+    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_in
+    INTEGER(i_std), INTENT(out)              :: nvert_out
+    REAL(r_std), DIMENSION(:,:), INTENT(out) :: poly_out
+    !
+    ! Local
+    !
+    INTEGER(i_std)                           :: nvert, nvert_tmp
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:):: iwk, next, vertex
+    REAL(r_std)                              :: xmin, temp, dy, dx2, dy1, dy2
+    REAL(r_std)                              :: x1, x2, y1, y2
+    REAL(r_std)                              :: xmax, ymin, ymax 
+    REAL(r_std)                              :: dx, dx1 
+    REAL(r_std)                              :: dmax, dmax1, dmax2
+    REAL(r_std)                              :: dist, dmin
+    INTEGER(i_std)                           :: i, i1, i2, j, jp1, jp2, i2save, i3, i2next
+    LOGICAL                                  :: points_todo
+    INTEGER(i_std), PARAMETER                :: nextinc=20
+    !
+    nvert_tmp=SIZE(poly_in,DIM=1)
+    IF ( nvert_tmp < nvert_in) THEN
+       WRITE(*,*) "Input polygone is smaller than the size proposed in the interface."
+       STOP "polygones_convexhull"
+    ENDIF
+    IF ( nvert_tmp <= 2 ) THEN
+       WRITE(*,*) "The input polygone is too small to compute a convex hull."
+       STOP "polygones_convexhull"
+    ENDIF
+    IF (SIZE(poly_in,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "Poly_a cannot be a polygone :", SIZE(poly_in)
+       STOP "polygones_convexhull"
+    ENDIF
+    IF (SIZE(poly_out,DIM=2) .NE. 2) THEN
+       WRITE(*,*) "Poly_b cannot be a polygone :", SIZE(poly_out)
+       STOP "polygones_convexhull"
+    ENDIF
+    !
+    ALLOCATE(vertex(nvert_in))
+    ALLOCATE(iwk(nvert_in))
+    ALLOCATE(next(nvert_in*nextinc))
+    !
+    !
+    !  Choose the points with smallest & largest x- values as the
+    !  first two vertices of the polygon.
+    !
+    IF (poly_in(1,1) > poly_in(nvert_in,1)) THEN
+       vertex(1) = nvert_in
+       vertex(2) = 1
+       xmin = poly_in(nvert_in,1)
+       xmax = poly_in(1,1)
+    ELSE
+       vertex(1) = 1
+       vertex(2) = nvert_in
+       xmin = poly_in(1,1)
+       xmax = poly_in(nvert_in,1)
+    END IF
+    
+    DO i = 2, nvert_in-1
+       temp = poly_in(i,1)
+       IF (temp < xmin) THEN
+          vertex(1) = i
+          xmin = temp
+       ELSE IF (temp > xmax) THEN
+          vertex(2) = i
+          xmax = temp
+       END IF
+    END DO
+    !
+    !       Special case, xmax = xmin.
+    !
+    IF (xmax == xmin) THEN
+       IF (poly_in(1,2) > poly_in(nvert_in,2)) THEN
+          vertex(1) = nvert_in
+          vertex(2) = 1
+          ymin = poly_in(nvert_in,2)
+          ymax = poly_in(1,2)
+       ELSE
+          vertex(1) = 1
+          vertex(2) = nvert_in
+          ymin = poly_in(1,2)
+          ymax = poly_in(nvert_in,2)
+       END IF
+       
+       DO i = 2, nvert_in-1
+          temp = poly_in(i,2)
+          IF (temp < ymin) THEN
+             vertex(1) = i
+             ymin = temp
+          ELSE IF (temp > ymax) THEN
+             vertex(2) = i
+             ymax = temp
+          END IF
+       END DO
+       
+       nvert = 2
+       IF (ymax == ymin) nvert = 1
+       RETURN
+    END IF
+    !
+    !  Set up two initial lists of points; those points above & those below the
+    !  line joining the first two vertices.    next(i) will hold the pointer to the
+    !  point furthest from the line joining vertex(i) to vertex(i+1) on the left
+    !  hand side.
+    !
+    i1 = vertex(1)
+    i2 = vertex(2)
+    iwk(i1) = -1
+    iwk(i2) = -1
+    dx = xmax - xmin
+    y1 = poly_in(i1,2)
+    dy = poly_in(i2,2) - y1
+    dmax = zero
+    dmin = zero
+    next(1) = -1
+    next(2) = -1
+    !
+    DO i = 1, nvert_in
+       IF (i == vertex(1) .OR. i == vertex(2)) CYCLE
+       dist = (poly_in(i,2) - y1)*dx - (poly_in(i,1) - xmin)*dy
+       IF (dist > zero) THEN
+          iwk(i1) = i
+          i1 = i
+          IF (dist > dmax) THEN
+             next(1) = i
+             dmax = dist
+          END IF
+       ELSE IF (dist < zero) THEN
+          iwk(i2) = i
+          i2 = i
+          IF (dist < dmin) THEN
+             next(2) = i
+             dmin = dist
+          END IF
+       END IF
+    END DO
+    !
+    !  Ends of lists are indicated by pointers to -ve positions.
+    !
+    iwk(i1) = -1
+    iwk(i2) = -1
+    nvert = 2
+    !
+    j = 1
+    !
+    !  Start of main process.
+    !
+    !  Introduce new vertex between vertices j & j+1, if one has been found.
+    !  Otherwise increase j.   Exit if no more vertices.
+    !
+    !
+    points_todo = .TRUE.
+    DO WHILE ( points_todo )
+       !
+       DO WHILE ( points_todo .AND. next(j) < 0 )
+          IF (j == nvert) points_todo = .FALSE.
+          j = j + 1
+       ENDDO
+          !
+       IF ( points_todo ) THEN
+          !
+          jp1 = j + 1
+          IF ( jp1 >= nvert_in*nextinc) THEN
+             STOP "polygones_convexhull : please increase nextinc"
+          ENDIF
+          !
+          DO i = nvert, jp1, -1
+             vertex(i+1) = vertex(i)
+             next(i+1) = next(i)
+          END DO
+          jp2 = jp1 + 1
+          nvert = nvert + 1
+          IF (jp2 > nvert) jp2 = 1
+          i1 = vertex(j)
+          i2 = next(j)
+          i3 = vertex(jp2)
+          vertex(jp1) = i2
+          !
+          !  Process the list of points associated with vertex j.   New list at vertex j
+          !  consists of those points to the left of the line joining it to the new
+          !  vertex (j+1).   Similarly for the list at the new vertex.
+          !  Points on or to the right of these lines are dropped.
+          !
+          x1 = poly_in(i1,1)
+          x2 = poly_in(i2,1)
+          y1 = poly_in(i1,2)
+          y2 = poly_in(i2,2)
+          !
+          dx1 = x2 - x1
+          dx2 = poly_in(i3,1) - x2
+          dy1 = y2 - y1
+          dy2 = poly_in(i3,2) - y2
+          dmax1 = zero
+          dmax2 = zero
+          next(j) = -1
+          next(jp1) = -1
+          i2save = i2
+          i2next = iwk(i2)
+          i = iwk(i1)
+          iwk(i1) = -1
+          iwk(i2) = -1
+          !
+          DO WHILE ( i > 0 )
+             IF (i /= i2save) THEN
+                dist = (poly_in(i,2) - y1)*dx1 - (poly_in(i,1) - x1)*dy1
+                IF (dist > zero) THEN
+                   iwk(i1) = i
+                   i1 = i
+                   IF (dist > DMAX1) THEN
+                      next(j) = i
+                      dmax1 = dist
+                   END IF
+                ELSE
+                   dist = (poly_in(i,2) - y2)*dx2 - (poly_in(i,1) - x2)*dy2
+                   IF (dist > zero) THEN
+                      iwk(i2) = i
+                      i2 = i
+                      IF (dist > dmax2) THEN
+                         next(jp1) = i
+                         dmax2 = dist
+                      END IF
+                   END IF
+                END IF
+                i = iwk(i)
+             ELSE
+                i = i2next
+             END IF
+             !
+             !  Get next point from old list at vertex j.
+             !
+          ENDDO
+          !
+          !  End lists with -ve values.
+          !
+          iwk(i1) = -1
+          iwk(i2) = -1
+          !
+       ENDIF
+    ENDDO
+    !
+    ! Copy the polygone in he right order to the output variable
+    !
+    nvert_out = nvert
+    nvert_tmp=SIZE(poly_out,DIM=1)
+    IF ( nvert_tmp < nvert_out) THEN
+       WRITE(*,*) "Ouptput polygone is smaller than the size proposed in the interface."
+       STOP "polygones_convexhull"
+    ENDIF
+    !
+    DO i=1,nvert
+       poly_out(i,:) = poly_in(vertex(i),:)
+    ENDDO
+    !
+    DEALLOCATE(vertex, iwk, next)
+    !
+  END SUBROUTINE polygones_convexhull
+
+END MODULE polygones
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/solar.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/solar.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_global/solar.f90	(revision 6412)
@@ -0,0 +1,601 @@
+
+! =================================================================================================================================
+! MODULE       : solar
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module define solar 
+!!
+!!\n DESCRIPTION: 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE solar
+
+  USE defprec
+  USE constantes
+  USE ioipsl_para 
+
+  IMPLICIT NONE
+
+
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : solarang
+!!
+!>\BRIEF         This subroutine computes the solar angle according to the method used by GSWP and developed by J.C. Morill.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::csang
+!!
+!! REFERENCE(S) : See for further details :
+!! http://www.atmo.arizona.edu/~morrill/swrad.html
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE solarang (julian, julian0, iim, jjm, lon, lat, csang)
+
+    USE calendar
+
+    IMPLICIT NONE
+
+    !! 0. Parameters and variables declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                      :: iim, jjm        !!
+    REAL, INTENT(in)                         :: julian          !!
+    REAL, INTENT(in)                         :: julian0         !!
+    REAL, DIMENSION(iim,jjm), INTENT(in)     :: lon, lat        !!
+
+    !! 0.2 Output variables
+
+    REAL, DIMENSION(iim,jjm), INTENT(out)    :: csang           !!
+
+    !! 0.4 Local variables
+
+    REAL                                     :: gamma           !!
+    REAL                                     :: dec             !!
+    REAL                                     :: decd            !!
+    REAL                                     :: et              !!
+    REAL                                     :: gmt             !!
+    REAL                                     :: le              !!
+    REAL                                     :: ls              !!
+    REAL                                     :: lcorr           !!
+    REAL                                     :: latime          !!
+    REAL                                     :: omega           !!
+    REAL                                     :: omegad          !!
+    REAL                                     :: llatd, llat     !!
+    INTEGER                                  :: igmt            !!
+    INTEGER                                  :: ilon, ilat      !!
+    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: zone            !!
+!$OMP THREADPRIVATE(zone)
+    REAL, SAVE, ALLOCATABLE, DIMENSION(:)    :: lhour           !!
+!$OMP THREADPRIVATE(lhour)
+    !
+    LOGICAL                                  :: check = .FALSE. !!
+!$OMP THREADPRIVATE(check)
+
+!_ ================================================================================================================================
+
+    IF (check) WRITE(numout,*) 'Calendar information', julian, julian0
+    !-
+    !- 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', gamma, one_year
+    !
+    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', decd
+    !- 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', et, gmt
+    CALL time_zone(gmt, iim, jjm, lon, zone, lhour)
+    !-
+    !- Start a loop through the grid
+    !-
+    IF (check) WRITE(numout,*) 'Start a loop through the grid'
+    DO ilon=1,iim
+       !---
+       !--- 4) Local apparent time  page 13
+       !---
+       !--- ls     standard longitude (nearest 15 degree meridian)
+       !--- le     local longtitude
+       !--- lhour  local standard time
+       !--- latime local apparent time
+       !--- lcorr  longitudunal correction (minutes)
+       !---
+       le = lon(ilon,1)
+       ls = ((zone(ilon)-1)*15)-180.
+       lcorr = 4.*(ls-le)*(-1)
+       latime = lhour(ilon)+lcorr/60.+et/60.
+       IF (latime <  0.) latime = latime+24
+       IF (latime > 24.) latime = latime-24
+       !---
+       !--- 5) Hour angle omega  page 15
+       !---
+       !--- hour angle is zero at noon, positive in the morning
+       !--- It ranges from 180 to -180
+       !---
+       !--- omegad is omega in degrees, omega is in radians
+       !---
+       omegad = (latime-12.)*(-15.)
+       omega  = omegad*pi/180.
+       !---
+       DO ilat=1,jjm
+          !-----
+          !----- 6)  Zenith angle  page 15
+          !-----
+          !----- csang cosine of zenith angle (radians)
+          !----- llatd =  local latitude in degrees
+          !----- llat  =  local latitude in radians
+          !-----
+          llatd = lat(1,ilat)
+          llat  = llatd*pi/180.
+          csang(ilon,ilat) = &
+               &  MAX(zero,SIN(dec)*SIN(llat)+COS(dec)*COS(llat)*COS(omega))
+       ENDDO
+    ENDDO
+    !----------------------
+  END SUBROUTINE solarang
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : time_zone
+!!
+!>\BRIEF         
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::zone, ::lhour
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE time_zone (gmt, iim, jjm, lon, zone, lhour)
+
+    IMPLICIT NONE
+
+    !! 0. Parameters and variables declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                   :: iim, jjm        !!
+    REAL, DIMENSION(iim,jjm), INTENT(in)  :: lon             !!
+    REAL, INTENT(in)                      :: gmt             !!
+
+    !! 0.2 Output variables
+
+    INTEGER, DIMENSION(iim), INTENT(out)  :: zone            !!
+    REAL, DIMENSION(iim), INTENT(out)     :: lhour           !!
+
+    !! 0.4 Local variables
+
+    INTEGER                               :: deg             !!
+    !!??   REAL :: deg
+    INTEGER                               :: i, ilon, change !! Indices
+
+!_ ================================================================================================================================
+
+    DO ilon=1,iim
+       !---
+       !--- Convert longitude index to longtitude in degrees
+       !---
+       deg = lon(ilon,1)
+       !---
+       !--- Determine into which time zone (15 degree interval) the
+       !--- longitude falls.
+       !---
+       DO i=1,25
+          IF (deg < (-187.5+(15*i))) THEN
+             zone(ilon) = i
+             IF (zone(ilon) == 25)   zone(ilon) = 1
+             EXIT
+          ENDIF
+       ENDDO
+       !---
+       !--- Calculate change (in number of hours) from GMT time to
+       !--- local hour.  Change will be negative for zones < 13 and
+       !--- positive for zones > 13.
+       !---
+       !--- There is also a correction for lhour < 0 and lhour > 23
+       !--- to lhour between 0 and 23.
+       !---
+       IF (zone(ilon) < 13) THEN
+          change = zone(ilon)-13
+          lhour(ilon) = gmt+change
+       ENDIF
+       !---
+       IF (zone(ilon) == 13) THEN
+          lhour(ilon) = gmt
+       ENDIF
+       !---
+       IF (zone(ilon) > 13) THEN
+          change = zone(ilon)-13
+          lhour(ilon) = gmt+change
+       ENDIF
+       IF (lhour(ilon) <  0) lhour(ilon) = lhour(ilon)+24
+       IF (lhour(ilon) >= 24) lhour(ilon) = lhour(ilon)-24
+       !---
+    ENDDO
+    !-----------------------
+  END SUBROUTINE time_zone
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : downward_solar_flux
+!!
+!>\BRIEF         
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::solad, ::solai
+!!
+!! REFERENCE(S) :See for further details :
+!! http://www.atmo.arizona.edu/~morrill/swrad.html
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE downward_solar_flux (npoi,latitude,calendar_str,jday,rtime,cloud,nband,solad,solai)
+
+    IMPLICIT NONE
+
+    !! 0. Parameter and variables declaration
+    
+    !! 0.1 Input variables
+    
+    INTEGER, INTENT(in)                      :: npoi               !! number of grid points (unitless)
+    REAL, DIMENSION(npoi), INTENT(in)        :: latitude           !! latitude in degrees
+    CHARACTER(LEN=20),INTENT(in)             :: calendar_str       !! Calendar type
+    REAL, INTENT(in)                         :: jday
+    REAL,INTENT(in)                          :: rtime
+    REAL, DIMENSION(npoi), INTENT(in)        :: cloud              !! cloud fraction (0-1, unitless)
+    INTEGER,INTENT(in)                       :: nband              !! number of visible bands (unitless)
+
+    !! 0.2 Output variables
+
+    REAL, DIMENSION(npoi,nband), INTENT(out) :: solad              !! direct downward solar flux 
+                                                                   !! @tex $(W.m^{-2})$ @endtex
+    REAL, DIMENSION(npoi,nband), INTENT(out) :: solai              !! diffuse downward solar flux 
+                                                                   !! @tex $(W.m^{-2})$ @endtex
+
+    !! 0.4 Local variables
+
+    ! Parametres orbitaux:
+
+    REAL, SAVE                               :: ecc                !! Eccentricity
+!$OMP THREADPRIVATE(ecc)
+    REAL, SAVE                               :: perh               !! Longitude of perihelie
+!$OMP THREADPRIVATE(perh)
+    REAL, SAVE                               :: xob                !! obliquity
+!$OMP THREADPRIVATE(xob)
+    REAL, PARAMETER                          :: pir = pi/180.      !!
+    REAL, SAVE                               :: step               !!
+!$OMP THREADPRIVATE(step)
+    REAL                                     :: xl                 !!
+    REAL                                     :: so                 !!
+    REAL                                     :: xllp               !!
+    REAL                                     :: xee                !!
+    REAL                                     :: xse                !!  
+    REAL                                     :: xlam               !!
+    REAL                                     :: dlamm              !!
+    REAL                                     :: anm                !!
+    REAL                                     :: ranm               !!
+    REAL                                     :: ranv               !!
+    REAL                                     :: anv                !!
+    REAL                                     :: tls                !!
+    REAL                                     :: rlam               !!
+    REAL                                     :: sd                 !!
+    REAL                                     :: cd                 !!
+    REAL                                     :: deltar             !!
+    REAL                                     :: delta              !!
+    REAL                                     :: Dis_ST             !!  
+    REAL                                     :: ddt                !!
+    REAL                                     :: orbit              !!
+    REAL                                     :: angle              !!
+    REAL                                     :: xdecl              !!
+    REAL                                     :: xlat               !!
+    REAL, DIMENSION(npoi)                    :: trans              !!
+    REAL, DIMENSION(npoi)                    :: fdiffuse           !!
+    REAL, DIMENSION(npoi)                    :: coszen             !! cosine of solar zenith angle
+    REAL                                     :: sw                 !!
+    REAL                                     :: frac               !!
+    INTEGER                                  :: i,ib               !!
+    LOGICAL, SAVE                            :: lstep_init = .TRUE. !!
+!$OMP THREADPRIVATE(lstep_init)
+
+!_ ================================================================================================================================
+    
+    IF (lstep_init) THEN
+       IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN  
+          step = 1.0
+       ELSE
+          step = one_year/365.2425
+       ENDIF
+       !-
+       ! Read Orbital Parameters
+       !-
+
+       !Config Key   = ECCENTRICITY
+       !Config Desc  = Use prescribed values
+       !Config If    = ALLOW_WEATHERGEN
+       !Config Def   = 0.016724
+       !Config Help  =
+       !Config Units = [-]
+       ecc = 0.016724
+       CALL getin_p ('ECCENTRICITY',ecc)
+       WRITE(numout,*) 'ECCENTRICITY: ',ecc
+       !
+       !Config Key  = PERIHELIE
+       !Config Desc = Use prescribed values
+       !Config If   = ALLOW_WEATHERGEN
+       !Config Def  = 102.04
+       !Config Help  =
+       !Config Units = [-]
+       perh = 102.04
+       CALL getin_p ('PERIHELIE',perh)
+       WRITE(numout,*) 'PERIHELIE: ',perh
+       !
+       !Config Key  = OBLIQUITY
+       !Config Desc = Use prescribed values
+       !Config If   = ALLOW_WEATHERGEN
+       !Config Def  = 23.446
+       !Config Help  =
+       !Config Units = [Degrees]
+       xob = 23.446
+       CALL getin_p ('OBLIQUITY',xob)
+       WRITE(numout,*) 'OBLIQUITY: ',xob
+
+       lstep_init = .FALSE.
+    ENDIF
+
+    !-
+    ! calendar and orbital calculations
+    !-
+
+    !-
+    ! calculate the earth's orbital angle (around the sun) in radians
+    orbit = 2.0*pi*jday/365.2425
+    !-
+    ! calculate the solar hour angle in radians
+    angle = 2.0*pi*(rtime-12.0)/24.0
+    !-
+    ! calculate the current solar declination angle
+    ! ref: global physical climatology, hartmann, appendix a
+    !
+    ! xdecl = 0.006918 &
+    !        -0.399912*cos(orbit) &
+    !        +0.070257*sin(orbit) &
+    !        -0.006758*cos(2.0*orbit) &
+    !        +0.000907*sin(2.0*orbit) &
+    !        -0.002697*cos(3.0*orbit) &
+    !        +0.001480*sin(3.0*orbit)
+    !
+    ! calculate the effective solar constant,
+    ! including effects of eccentricity
+    ! ref: global physical climatology, hartmann, appendix a
+    !
+    ! sw = 1370.*( 1.000110 &
+    !             +0.034221*cos(orbit) &
+    !             +0.001280*sin(orbit) &
+    !             +0.000719*cos(2.0*orbit) &
+    !             +0.000077*sin(2.0*orbit))
+    !
+    ! correction Marie-France Loutre
+    !
+    !    orbital parameters
+    !
+    !    ecc = 0.016724
+    !    perh = 102.04
+    !    xob = 23.446
+    !-
+    xl = perh+180.0
+    ! so : sinus of obliquity
+    so = sin(xob*pir)
+    !-
+    xllp = xl*pir
+    xee  = ecc*ecc
+    xse  = sqrt(1.0d0-xee)
+    ! xlam : true long. sun for mean long. = 0
+    xlam = (ecc/2.0+ecc*xee/8.0d0)*(1.0+xse)*sin(xllp)-xee/4.0 &
+         &      *(0.5+xse)*sin(2.0*xllp)+ecc*xee/8.0*(1.0/3.0+xse) &
+         &      *sin(3.0*xllp)
+    xlam  =2.0d0*xlam/pir
+    ! dlamm : mean long. sun for ma-ja
+    dlamm =xlam+(INT(jday)-79)*step
+    anm   = dlamm-xl
+    ranm  = anm*pir
+    xee   = xee*ecc
+    ! ranv : anomalie vraie    (radian)
+    ranv = ranm+(2.0*ecc-xee/4.0)*sin(ranm)+5.0/4.0*ecc*ecc &
+         &      *sin(2.0*ranm)+13.0/12.0*xee*sin(3.0*ranm)
+    ! anv  : anomalie vraie    (degrees)
+    anv  = ranv/pir
+    ! tls  : longitude vraie   (degrees)
+    tls  = anv+xl
+    ! rlam : longitude vraie   (radian)
+    rlam = tls*pir
+    ! sd and cd: cosinus and sinus of solar declination angle (delta)
+    ! sinus delta = sin (obl)*sin(lambda) with lambda = real longitude
+    ! (Phd. thesis of Marie-France Loutre, ASTR-UCL, Belgium, 1993)
+    sd    = so*sin(rlam)
+    cd    = sqrt(1.0d0-sd*sd)
+    ! delta : Solar Declination (degrees, angle sun at equator)
+    deltar = atan(sd/cd)
+    delta  = deltar/pir
+    !-
+    ! Eccentricity Effect
+    !-
+    Dis_ST  =(1.0-ecc*ecc)/(1.0+ecc*cos(ranv))
+    ! ddt :    1 / normalized earth's sun distance
+    ddt = 1.0/Dis_ST
+    !-
+    ! Insolation normal to the atmosphere (W/m2)
+    !-
+    sw  = ddt *ddt *1370.d0
+    !-
+    xdecl = deltar
+    !-
+    ! solar calculations
+    !-
+    do i=1,npoi
+       !---
+       !-- calculate the latitude in radians
+       !---
+       xlat = latitude(i)*pi/180.0
+       !---
+       !-- calculate the cosine of the solar zenith angle
+       !---
+       coszen(i) = MAX(0.0, (sin(xlat)*sin(xdecl) &
+            &                      + cos(xlat)*cos(xdecl)*cos(angle)))
+       !---
+       !-- calculate the solar transmission through the atmosphere
+       !-- using simple linear function of tranmission and cloud cover
+       !---
+       !-- note that the 'cloud cover' data is typically obtained from
+       !-- sunshine hours -- not direct cloud observations
+       !---
+       !-- where, cloud cover = 1 - sunshine fraction
+       !---
+       !-- different authors present different values for the slope and
+       !-- intercept terms of this equation
+       !---
+       !-- Friend, A: Parameterization of a global daily weather generator
+       !-- for terrestrial ecosystem and biogeochemical modelling,
+       !-- Ecological Modelling
+       !---
+       !-- Spitters et al., 1986: Separating the diffuse and direct component
+       !-- of global radiation and its implications for modeling canopy
+       !-- photosynthesis, Part I: Components of incoming radiation,
+       !-- Agricultural and Forest Meteorology, 38, 217-229.
+       !---
+       !-- A. Friend       : trans = 0.251+0.509*(1.0-cloud(i))
+       !-- Spitters et al. : trans = 0.200+0.560*(1.0-cloud(i))
+       !---
+       !-- we are using the values from A. Friend
+       !---
+       trans(i) = 0.251+0.509*(1.0-cloud(i))
+       !---
+       !-- calculate the fraction of indirect (diffuse) solar radiation
+       !-- based upon the cloud cover
+       !---
+       !-- note that these relationships typically are measured for either
+       !-- monthly or daily timescales, and may not be exactly appropriate
+       !-- for hourly calculations -- however, in ibis, cloud cover is fixed
+       !-- through the entire day so it may not make much difference
+       !---
+       !-- method i --
+       !---
+       !-- we use a simple empirical relationships
+       !-- from Nikolov and Zeller (1992)
+       !---
+       !-- Nikolov, N. and K.F. Zeller, 1992:  A solar radiation algorithm
+       !-- for ecosystem dynamics models, Ecological Modelling, 61, 149-168.
+       !---
+       fdiffuse(i) = 1.0045+trans(i)*( 0.0435+trans(i) &
+            &                                 *(-3.5227+trans(i)*2.6313))
+       !---
+       IF (trans(i) > 0.75) fdiffuse(i) = 0.166
+       !---
+       !-- method ii --
+       !---
+       !-- another method was suggested by Spitters et al. (1986) based on
+       !-- long-term data from the Netherlands
+       !--
+       !-- Spitters et al., 1986: Separating the diffuse and direct component
+       !-- of global radiation and its implications for modeling canopy
+       !-- photosynthesis, Part I: Components of incoming radiation,
+       !-- Agricultural and Forest Meteorology, 38, 217-229.
+       !---
+       !--       if ((trans == 0.00).and.(trans < 0.07)) then
+       !--         fdiffuse = 1.0
+       !--       else if ((trans >= 0.07).and.(trans < 0.35)) then
+       !--         fdiffuse = 1.0-2.3*(trans-0.07)**2
+       !--       else if ((trans >= 0.35).and.(trans < 0.75)) then
+       !--         fdiffuse = 1.33-1.46*trans
+       !--       ELSE
+       !--         fdiffuse = 0.23
+       !--       endif
+       !---
+    ENDDO
+    !-----------------------
+    !-
+    ! do for each waveband
+    !-
+    DO ib=1,nband
+       !---
+       !-- calculate the fraction in each waveband
+       !---
+       !-- GK010200
+       IF (nband == 2) then
+          frac = 0.46+0.08*REAL(ib-1)
+       ELSE
+          frac = 1./REAL(nband)
+       ENDIF
+       !---
+       DO i=1,npoi
+          !-----
+          !---- calculate the direct and indirect solar radiation
+          !-----
+          solad(i,ib) = sw*coszen(i)*frac*trans(i)*(1.-fdiffuse(i))
+          solai(i,ib) = sw*coszen(i)*frac*trans(i)*fdiffuse(i)
+       ENDDO
+    ENDDO
+
+
+  END SUBROUTINE downward_solar_flux
+
+ 
+END MODULE solar
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_oasisdriver/driver2oasis.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_oasisdriver/driver2oasis.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_oasisdriver/driver2oasis.f90	(revision 6412)
@@ -0,0 +1,849 @@
+PROGRAM driver2oasis
+  !---------------------------------------------------------------------
+  !-
+  !- Reads the forcing file in the ALMA format and feeds the data to the
+  !- OASIS coupler.
+  !- 
+  !---------------------------------------------------------------------
+  USE defprec
+  !
+  USE netcdf
+  !
+  USE constantes
+  !
+  USE ioipsl_para
+  USE mod_orchidee_para
+  !
+  USE grid
+  USE globgrd
+  USE forcing_tools
+  !
+  USE mod_oasis
+  USE timer
+  !-
+  IMPLICIT NONE
+  !-
+  INCLUDE 'mpif.h'
+  !-
+  CHARACTER(LEN=80) :: gridfilename
+  CHARACTER(LEN=80), DIMENSION(100) :: forfilename
+  CHARACTER(LEN=6)   :: comp_name = 'driver'
+  !
+  !
+  CHARACTER(LEN=8)  :: model_guess
+  INTEGER(i_std)    :: iim_glo, jjm_glo, file_id
+  !- 
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lon_glo, lat_glo, area_glo
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: mask_glo
+  INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: maskinv_glo
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: corners_glo
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: corners_lon, corners_lat
+  INTEGER(i_std) :: nbindex_g, kjpindex
+  INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: kindex_g
+  REAL(r_std), DIMENSION(2) :: zoom_lon, zoom_lat
+  CHARACTER(LEN=20) :: calendar
+  !-
+  !- Variables local to each processors.
+  !-
+  INTEGER(i_std) :: i, j, ik, nbdt, first_point
+  INTEGER(i_std) :: nb_forcefile
+  INTEGER(i_std) :: itau, itau_offset, itau_sechiba
+  REAL(r_std)    :: date_start, dt
+  REAL(r_std)    :: timestep_interval(2), timestep_int_next(2), julian
+  INTEGER(i_std) :: rest_id, rest_id_stom
+  INTEGER(i_std) :: hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC
+!-
+!- input fields
+!-
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: u             !! Lowest level wind speed
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: v             !! Lowest level wind speed 
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: pb            !! Surface pressure
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: zlev_tq       !! Height of layer for T and q
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: zlev_uv       !! Height of layer for u and v
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: temp_air      !! Air temperature in Kelvin
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: qair          !! Lowest level specific humidity
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: ccanopy       !! CO2 concentration in the canopy
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: cdrag         !! Cdrag
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: precip_rain   !! Rain precipitation
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: precip_snow   !! Snow precipitation
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: lwdown        !! Down-welling long-wave flux 
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: swdown        !! Downwelling surface short-wave flux
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: swnet         !! Net surface short-wave flux
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: solarang      !! Cosine of solar zenith angle
+  !-
+  !- output fields
+  !-
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: z0            !! Surface roughness
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: coastalflow   !! Diffuse flow of water into the ocean (m^3/dt)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: riverflow     !! Largest rivers flowing into the ocean (m^3/dt)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: tsol_rad      !! Radiative surface temperature
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: vevapp        !! Total of evaporation
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: temp_sol_new  !! New soil temperature
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: qsurf         !! Surface specific humidity
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:)          :: albedo        !! Albedo
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: fluxsens      !! Sensible chaleur flux
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: fluxlat       !! Latent chaleur flux
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: emis          !! Emissivity
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: netco2        !! netco2flux
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: carblu        !! fco2_land_use
+  !-
+  !- Declarations for OASIS
+  !-
+  INTEGER(i_std) :: glo_rank, glo_size ! rank and  number of pe
+  INTEGER(i_std) :: loc_rank, loc_size ! rank and  number of pe
+  INTEGER(i_std) :: LOCAL_OASIS_COMM  ! local MPI communicator and Initialized
+  INTEGER(i_std) :: comp_id    ! component identification
+  INTEGER(i_std) :: ierror, flag, oasis_info
+  CHARACTER(LEN=4) :: drv_gridname
+  CHARACTER(LEN=8) :: varname
+  INTEGER(i_std), DIMENSION(3) :: ig_paral
+  ! OASIS Output
+  INTEGER(i_std) :: il_part_id, tair_id, qair_id, zlevtq_id, zlevuv_id
+  INTEGER(i_std) :: rainf_id, snowf_id, swnet_id, lwdown_id, solarang_id
+  INTEGER(i_std) :: u_id, v_id, ps_id, cdrag_id
+  ! OASIS Input
+  INTEGER(i_std) :: vevapp_id, fluxsens_id, fluxlat_id, coastal_id, river_id
+  INTEGER(i_std) :: netco2_id, carblu_id, tsolrad_id, tsolnew_id, qsurf_id
+  INTEGER(i_std) :: albnir_id, albvis_id, emis_id, z0_id
+  !
+  INTEGER(i_std), DIMENSION(2) :: var_nodims, var_shape
+  INTEGER(i_std) :: nbarg, iret, helpmsg = 0
+  CHARACTER(LEN=10) :: arg
+  LOGICAL :: initmode = .FALSE.
+  !-
+  INTEGER(i_std) :: freq_diag=10, debug_lev=1
+  INTEGER(i_std) :: w_unit=737
+  !
+  ! Timer variables
+  !
+  LOGICAL, PARAMETER :: timemeasure=.TRUE.
+  REAL(r_std) :: waitput_cputime=0.0, waitget_cputime=0.0, preparation_cputime=0.0
+  REAL(r_std) :: waitput_walltime=0.0, waitget_walltime=0.0, preparation_walltime=0.0
+  !
+  ! Print point
+  !
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/44.8,-25.3/)
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/44.8,-18.3/)
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/-60.25,-5.25/)
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/-5.25,41.25/)
+  REAL(r_std), DIMENSION(2) :: testpt=(/9999.99,9999.99/)
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/46.7,10.3/)
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/0.25,49.25/)
+  !
+  INTEGER iargc, getarg 
+  EXTERNAL iargc, getarg 
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- The code has 2 execution mode :
+  !-          1) initialisation of the grid file based on the forcing file
+  !-          2) Reading the forcing file and sending the data out with OASIS
+  !-
+  !-
+  nbarg = iargc()
+  IF ( nbarg > 1 ) THEN
+     helpmsg = 1
+  ELSE IF ( nbarg == 1 ) THEN
+     iret = getarg(1,arg)
+     SELECT CASE(arg)
+        !
+     CASE('-h')
+        helpmsg = 1
+     CASE('-init')
+        initmode = .TRUE.
+     CASE DEFAULT
+        helpmsg = 1
+        !
+     END SELECT
+  ELSE
+     initmode = .FALSE.
+  ENDIF
+  !
+  ! Does the user just want help ?
+  !
+  IF ( helpmsg > 0 ) THEN
+     WRITE(*,*) "USAGE : driver2oasis [-init] " 
+     WRITE(*,*) "             The program will read the forcing file provided by variable" 
+     WRITE(*,*) "             FORCING_FILE in the run.def file and do one of 2 things :"
+     WRITE(*,*) "        "
+     WRITE(*,*) "      -init  a grid description file will be generated for the specified "
+     WRITE(*,*) "             forcing file. This grid description file will be written into"
+     WRITE(*,*) "             the file name provided by the variable GRID_FILE "
+     WRITE(*,*) "             of the run.def. "
+     WRITE(*,*) "       "
+     WRITE(*,*) "             If no arguments are provided driver2oasis will initiate and "
+     WRITE(*,*) "             send the forcing data out via OASIS."
+     STOP "HELP from driver2oasis"
+  ENDIF
+  !-
+  !- Open output file for driver
+  !-
+  OPEN(UNIT=w_unit, FILE="out_driver_mono", FORM="formatted")
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Get the general information we need 
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+!!  CALL getin_name("run.def")
+  !
+  !Config Key   = FORCING_FILE
+  !Config Desc  = Name of file containing the forcing data
+  !Config If    = [-]
+  !Config Def   = forcing_file.nc
+  !Config Help  = This is the name of the file which should be opened
+  !Config         for reading the forcing data of the dim0 model.
+  !Config         The format of the file has to be netCDF and COADS
+  !Config         compliant.
+  !Config Units = [FILE] 
+  !-
+  forfilename(:)=" "
+  forfilename(1)='forcing_file.nc'
+  CALL getin('FORCING_FILE', forfilename)
+  !
+  !Config Key   = GRID_FILE
+  !Config Desc  = Name of file containing the forcing data
+  !Config If    = [-]
+  !Config Def   = grid_file.nc
+  !Config Help  = This is the name of the file from which we will read
+  !Config         or write into it the description of the grid from 
+  !Config         the forcing file.
+  !Config         compliant.
+  !Config Units = [FILE] 
+  !- 
+  gridfilename='grid_file.nc'
+  CALL getin('GRID_FILE', gridfilename)
+  !-
+  !- Define the zoom
+  !-
+  zoom_lon=(/-180,180/)
+  zoom_lat=(/-90,90/)
+  !
+  !Config Key   = LIMIT_WEST
+  !Config Desc  = Western limit of region
+  !Config If    = [-]
+  !Config Def   = -180.
+  !Config Help  = Western limit of the region we are 
+  !Config         interested in. Between -180 and +180 degrees
+  !Config         The model will use the smalest regions from
+  !Config         region specified here and the one of the forcing file.
+  !Config Units = [Degrees] 
+  !- 
+  CALL getin_p('LIMIT_WEST',zoom_lon(1))
+  !-
+  !Config Key   = LIMIT_EAST
+  !Config Desc  = Eastern limit of region
+  !Config If    = [-]
+  !Config Def   = 180.
+  !Config Help  = Eastern limit of the region we are
+  !Config         interested in. Between -180 and +180 degrees
+  !Config         The model will use the smalest regions from
+  !Config         region specified here and the one of the forcing file.
+  !Config Units = [Degrees] 
+  !-
+  CALL getin_p('LIMIT_EAST',zoom_lon(2))
+  !-
+  !Config Key   = LIMIT_NORTH
+  !Config Desc  = Northern limit of region
+  !Config If    = [-]
+  !Config Def   = 90.
+  !Config Help  = Northern limit of the region we are
+  !Config         interested in. Between +90 and -90 degrees
+  !Config         The model will use the smalest regions from
+  !Config         region specified here and the one of the forcing file.
+  !Config Units = [Degrees]
+  !-
+  CALL getin_p('LIMIT_NORTH',zoom_lat(2))
+  !-
+  !Config Key   = LIMIT_SOUTH
+  !Config Desc  = Southern limit of region
+  !Config If    = [-]
+  !Config Def   = -90.
+  !Config Help  = Southern limit of the region we are
+  !Config         interested in. Between 90 and -90 degrees
+  !Config         The model will use the smalest regions from
+  !Config         region specified here and the one of the forcing file.
+  !Config Units = [Degrees]
+  !-
+  CALL getin_p('LIMIT_SOUTH',zoom_lat(1))
+  IF ( (zoom_lon(1)+180 < EPSILON(zoom_lon(1))) .AND. (zoom_lon(2)-180 < EPSILON(zoom_lon(2))) .AND.&
+       &(zoom_lat(1)+90 < EPSILON(zoom_lat(1))) .AND. (zoom_lat(2)-90 < EPSILON(zoom_lat(2))) ) THEN
+     !
+     !Config Key   = WEST_EAST
+     !Config Desc  = Longitude interval to use from the forcing data
+     !Config If    = [-]
+     !Config Def   = -180, 180
+     !Config Help  = This function allows to zoom into the forcing data
+     !Config Units = [degrees east] 
+     !- 
+     CALL getin('WEST_EAST', zoom_lon)
+     !
+     !Config Key   = SOUTH_NORTH
+     !Config Desc  = Latitude interval to use from the forcing data
+     !Config If    = [-]
+     !Config Def   = -90, 90
+     !Config Help  = This function allows to zoom into the forcing data
+     !Config Units = [degrees north] 
+     !- 
+     CALL getin('SOUTH_NORTH', zoom_lat)
+  ENDIF
+  !-
+  debug_lev=1
+  CALL getin('BAVARD', debug_lev)
+  IF ( debug_lev .EQ. 4 ) THEN
+     freq_diag=1
+  ELSE IF ( debug_lev .EQ. 3 ) THEN
+     freq_diag=10
+  ELSE IF ( debug_lev .EQ. 2 ) THEN
+     freq_diag=24
+  ELSE
+     freq_diag=96
+  ENDIF
+  WRITE(w_unit,*) "Debug_lev, freq_diag = ", debug_lev, freq_diag
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- We go into the mode which initialises the grid of the forcing file and writes it
+  !- for future usage by the driver and ORCHIDEE.
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  IF ( initmode ) THEN
+
+     WRITE(w_unit,*) 'Forcing files : ', forfilename(:)
+     WRITE(w_unit,*) 'Grid files : ', gridfilename
+
+     nb_forcefile = 0
+     DO ik=1,100
+        IF ( INDEX(forfilename(ik), '.nc') > 0 ) nb_forcefile = nb_forcefile+1
+     ENDDO
+     !
+     ! This mode of driver2oasis is monoproc and thus we need to force is_root_prc
+     !
+     is_root_prc = .TRUE.
+     !
+     CALL forcing_getglogrid (nb_forcefile, forfilename, iim_glo, jjm_glo, nbindex_g, .TRUE.)
+
+     CALL forcing_zoomgrid (zoom_lon, zoom_lat, forfilename(1), .TRUE.)
+ 
+     CALL globgrd_writegrid (gridfilename)
+
+     STOP "Grid file sucessfully generated"
+  ENDIF
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- This mode will read the grid file and the forcing file and produce the
+  !- data to be handed over to OASIS.
+  !-
+  !---------------------------------------------------------------------------------------
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Define MPI communicator and set-up OASIS
+  !-
+  CALL oasis_init_comp(comp_id, comp_name, ierror)
+  CALL oasis_get_localcomm(LOCAL_OASIS_COMM, ierror)
+  !
+  CALL Init_orchidee_para(LOCAL_OASIS_COMM)
+  !-
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Get the grid associated to the forcing file ... it should be generated by
+  !- this code with a special option before the OASIS coupled case is run.
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  IF ( timemeasure ) THEN
+     CALL init_timer
+     CALL start_timer(timer_global)
+  ENDIF
+  !
+  CALL globgrd_getdomsz(gridfilename, iim_glo, jjm_glo, nbindex_g, model_guess, file_id)
+  !-
+  !- Allocation of memory
+  !- variables over the entire grid (thus in x,y)
+  ALLOCATE(lon_glo(iim_glo, jjm_glo))
+  ALLOCATE(lat_glo(iim_glo, jjm_glo))
+  ALLOCATE(mask_glo(iim_glo, jjm_glo))
+  ALLOCATE(area_glo(iim_glo, jjm_glo))
+  ALLOCATE(corners_glo(iim_glo, jjm_glo, 4, 2))
+  !
+  ! Gathered variables
+  ALLOCATE(kindex_g(nbindex_g))
+  ALLOCATE(contfrac(nbindex_g))
+  !-
+  !-
+  !-
+  CALL globgrd_getgrid(file_id, iim_glo, jjm_glo, nbindex_g, model_guess, &
+       &               lon_glo, lat_glo, mask_glo, area_glo, corners_glo,&
+       &               kindex_g, contfrac, calendar)
+  !-
+  !- Set the calendar and get some information
+  !-
+  CALL ioconf_calendar(calendar)
+  CALL ioget_calendar(one_year, one_day)
+  !-
+  !- lalo needs to be created before going into the parallel region
+  !-
+  ALLOCATE(lalo(nbindex_g,2))
+  DO ik=1,nbindex_g
+     !
+     j = ((kindex_g(ik)-1)/iim_glo)+1
+     i = (kindex_g(ik)-(j-1)*iim_glo)
+     !
+     IF ( i > iim_glo .OR. j > jjm_glo ) THEN
+        WRITE(w_unit,*) "Error in the indexing (ik, kindex_g, i, j) : ", ik, kindex_g(ik), i, j
+        STOP "ERROR in driver2oasis"
+     ENDIF
+     !
+     lalo(ik,1) = lat_glo(i,j)
+     lalo(ik,2) = lon_glo(i,j)
+     !
+  ENDDO
+  !
+  WRITE(w_unit,*) "Rank", mpi_rank, " Before opening forcingfile. All land points : ",  nbindex_g
+  WRITE(w_unit,*) "Rank", mpi_rank, " from ", iim_glo, " point in Lon. and ", jjm_glo, "in Lat."
+  !
+  ! Set-up the paralelisation so that all gather and scatters work properly on this monoproc task.
+  !
+  CALL grid_set_glo(iim_glo, jjm_glo, nbindex_g)
+  CALL grid_allocate_glo(4)
+  CALL bcast(nbindex_g)
+  CALL bcast(kindex_g)
+  !
+  WRITE(numout,*) "Rank", mpi_rank, "Into Init_orchidee_data_para_driver with ", nbindex_g,index_g(1)
+  !
+  CALL Init_orchidee_data_para_driver(nbindex_g,kindex_g)
+  CALL init_ioipsl_para 
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Open the forcing file and get the time information.
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  ! Add w_unit as last arguments in order to get some print_out from the forcing_open routine.
+  !
+  CALL forcing_open(forfilename, iim_glo,  jjm_glo, lon_glo, lat_glo, nbindex_g, zoom_lon, zoom_lat, &
+       &            kindex_g, nbindex_g, w_unit)
+  CALL forcing_integration_time(date_start, dt, nbdt)
+  !
+  !
+  ALLOCATE(zlev_tq(nbindex_g), zlev_uv(nbindex_g))
+  ALLOCATE(u(nbindex_g), v(nbindex_g), pb(nbindex_g))
+  ALLOCATE(temp_air(nbindex_g))
+  ALLOCATE(qair(nbindex_g))
+  ALLOCATE(ccanopy(nbindex_g))
+  ALLOCATE(cdrag(nbindex_g))
+  ALLOCATE(precip_rain(nbindex_g))
+  ALLOCATE(precip_snow(nbindex_g))
+  ALLOCATE(swdown(nbindex_g))
+  ALLOCATE(swnet(nbindex_g))
+  ALLOCATE(lwdown(nbindex_g))
+  ALLOCATE(solarang(nbindex_g))
+  ALLOCATE(vevapp(nbindex_g))
+  ALLOCATE(fluxsens(nbindex_g))
+  ALLOCATE(fluxlat(nbindex_g))
+  ALLOCATE(coastalflow(nbindex_g))
+  ALLOCATE(riverflow(nbindex_g))
+  ALLOCATE(netco2(nbindex_g))
+  ALLOCATE(carblu(nbindex_g))
+  ALLOCATE(tsol_rad(nbindex_g))
+  ALLOCATE(temp_sol_new(nbindex_g))
+  ALLOCATE(qsurf(nbindex_g))
+  ALLOCATE(albedo(nbindex_g,2))
+  ALLOCATE(emis(nbindex_g))
+  ALLOCATE(z0(nbindex_g))
+  !
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- OASIS Diagnostics
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  ! Unit for output messages : one file for each process
+  !-
+  CALL MPI_Comm_Size (LOCAL_OASIS_COMM, loc_size, ierror )
+  CALL MPI_Comm_Size (MPI_COMM_WORLD, glo_size, ierror )
+  IF (ierror /= 0) THEN
+     WRITE(w_unit,*) 'MPI_comm_size abort by model1 compid ',comp_id
+  ENDIF
+  CALL MPI_Comm_Rank (LOCAL_OASIS_COMM, loc_rank, ierror )
+  CALL MPI_Comm_Rank (MPI_COMM_WORLD, glo_rank, ierror )
+  IF (ierror /= 0) THEN
+     WRITE(0,*) 'MPI_Comm_Rank abort by orchidee comp_id ',comp_id
+  ENDIF
+  !
+  WRITE (w_unit,*) '-----------------------------------------------------------'
+  WRITE (w_unit,*) TRIM(comp_name), ' Running with reals compiled as kind =',r_std
+  WRITE (w_unit,*) 'I am component ', TRIM(comp_name), ' Local rank :',loc_rank, &
+       &           " Global rank : ", glo_rank
+  WRITE (w_unit,*) '----------------------------------------------------------'
+  CALL flush(w_unit)
+  !
+  !
+  WRITE (w_unit,*) 'DD I am the ', TRIM(comp_name), 'local rank', loc_rank, " with ", iim_glo*jjm_glo, "points."
+  WRITE (w_unit,*) 'DD Local number of processors :', loc_size, " Global value :", glo_size
+  WRITE (w_unit,*) 'DD Local MPI communicator is :', LOCAL_OASIS_COMM,  MPI_COMM_WORLD
+  CALL flush(w_unit)
+  !-
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Send the grid to OASIS ... only on the root processor
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  IF (loc_rank == 0) THEN
+     !
+     ! TOCOMPLETE - Put here OASIS grid, corner, areas and mask writing calls !
+     !
+     drv_gridname = "DRIV"
+     !
+     CALL oasis_start_grids_writing(flag)
+     !
+     CALL oasis_write_grid(drv_gridname, iim_glo, jjm_glo, lon_glo, lat_glo)
+     !
+     ALLOCATE(corners_lon(iim_glo, jjm_glo, 4), corners_lat(iim_glo, jjm_glo, 4))
+     corners_lon(:,:,:) = corners_glo(:,:,:,1)
+     corners_lat(:,:,:) = corners_glo(:,:,:,2)
+     CALL oasis_write_corner(drv_gridname, iim_glo, jjm_glo, 4, corners_lon, corners_lat)
+     DEALLOCATE(corners_lon, corners_lat)
+     !
+     ALLOCATE(maskinv_glo(iim_glo, jjm_glo))
+     DO i=1,iim_glo
+        DO j=1,jjm_glo
+           IF (mask_glo(i,j) == 0) THEN
+              maskinv_glo(i,j) = 1
+           ELSE
+              maskinv_glo(i,j) = 0
+           ENDIF
+        ENDDO
+     ENDDO
+     CALL oasis_write_mask(drv_gridname, iim_glo, jjm_glo, maskinv_glo)
+     !
+     CALL oasis_write_area(drv_gridname, iim_glo, jjm_glo, area_glo)
+     !
+     CALL oasis_terminate_grids_writing()
+  ENDIF
+  !
+  WRITE(w_unit,*) 'After grids writing'
+  call flush(w_unit)
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Declare the variables
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  ig_paral(1) = 0
+  ig_paral(2) = 0
+  ig_paral(3) = nbindex_g
+
+  CALL oasis_def_partition (il_part_id, ig_paral, ierror)
+
+  var_nodims(1) = 1
+  var_nodims(2) = 1
+  var_shape(1) = 1
+  var_shape(1) = nbindex_g
+  !
+  ! Variables SENT to ORCHIDEE
+  ! ==========================
+  !
+  ! Define levels
+  !
+  varname="ZLTQDRIV"
+  CALL oasis_def_var(zlevtq_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+  varname="ZLUVDRIV"
+  CALL oasis_def_var(zlevuv_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+  !
+  ! Define scalar atmospheric variables
+  !
+  varname="TAIRDRIV"
+  CALL oasis_def_var(tair_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+  varname="QAIRDRIV"
+  CALL oasis_def_var(qair_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+  !
+  ! Define precipitation variables
+  !
+  varname="RAINDRIV"
+  CALL oasis_def_var(rainf_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+  varname="SNOWDRIV"
+  CALL oasis_def_var(snowf_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+  !
+  ! Define radiation variables
+  !
+  varname="SWNEDRIV"
+  CALL oasis_def_var(swnet_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+  varname="LWDODRIV"
+  CALL oasis_def_var(lwdown_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+  varname="SOLADRIV"
+  CALL oasis_def_var(solarang_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+  !
+  ! Finaly pressure and wind
+  !
+  varname="UWINDRIV"
+  CALL oasis_def_var(u_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+  varname="VWINDRIV"
+  CALL oasis_def_var(v_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+  varname="PRESDRIV"
+  CALL oasis_def_var(ps_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+  varname="DRAGDRIV"
+  CALL oasis_def_var(cdrag_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+  !
+  !
+  ! Variables RECEIVED from ORCHIDEE
+  ! ================================
+  !
+  !
+  ! Turbulent fluxes
+  !
+  varname="EVAPDRIV"
+  CALL oasis_def_var(vevapp_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  !
+  varname="SENSDRIV"
+  CALL oasis_def_var(fluxsens_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  !
+  varname="LATEDRIV"
+  CALL oasis_def_var(fluxlat_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  !
+  ! Discharge to the oceans
+  !
+  varname="COASDRIV"
+  CALL oasis_def_var(coastal_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  !
+  varname="RIVEDRIV"
+  CALL oasis_def_var(river_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  !
+  ! Carbon fluxes
+  !
+  varname="NECODRIV"
+  CALL oasis_def_var(netco2_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  !
+  varname="LUCODRIV"
+  CALL oasis_def_var(carblu_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  !
+  ! Surface states
+  !
+  varname="TRADDRIV"
+  CALL oasis_def_var(tsolrad_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  !
+  varname="TNEWDRIV"
+  CALL oasis_def_var(tsolnew_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  !
+  varname="QSURDRIV"
+  CALL oasis_def_var(qsurf_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  !
+  varname="ANIRDRIV"
+  CALL oasis_def_var(albnir_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  !
+  varname="AVISDRIV"
+  CALL oasis_def_var(albvis_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  !
+  varname="EMISDRIV"
+  CALL oasis_def_var(emis_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  ! 
+  varname="ROUGDRIV"
+  CALL oasis_def_var(z0_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+  !
+  CALL oasis_enddef (ierror)
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Get a first set of forcing data
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  timestep_interval(1) = date_start
+  timestep_interval(2) = date_start + (dt/one_day)
+  CALL forcing_getvalues(timestep_interval, dt, zlev_tq, zlev_uv, temp_air, qair, &
+       &                 precip_rain, precip_snow, swdown, lwdown, solarang, u, v, pb)
+  ! An atmsopheric model will provide this information. If zero ORCHIDEE will compute it.
+  cdrag(:) = 0.0
+  ! Transform the swdown into a swnet
+  swnet(:) = 0.13*swdown(:)
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Go into the time loop
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  IF ( timemeasure ) THEN
+     WRITE(w_unit,*) '------> CPU Time for start-up of driver : ',Get_cpu_Time(timer_global)
+     WRITE(w_unit,*) '------> Real Time for start-up of driver : ',Get_real_Time(timer_global)
+     CALL stop_timer(timer_global)
+     CALL start_timer(timer_global)
+  ENDIF
+  !-
+  DO itau = 0,nbdt-1
+     !
+     timestep_interval(1) = date_start + itau*(dt/one_day)
+     timestep_interval(2) = date_start + (itau+1)*(dt/one_day)
+     julian = date_start + (itau+0.5)*(dt/one_day)
+     !
+     ! Write some diagnostics to look at the shape of the maps
+     !
+     IF ( itau == 0 ) THEN
+       CALL globgrd_writevar(iim_glo, jjm_glo, lon_glo, lat_glo, &
+          &                  nbindex_g, lalo, temp_air, "TAIR", "Tair_Driver_0.nc")
+     ENDIF
+     !
+     ! Put first the height of the atmospheric levels
+     !
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), zlev_tq, "TQ height")
+     CALL oasis_put(zlevtq_id, NINT(itau*dt), zlev_tq, oasis_info)
+     CALL oasis_put(zlevuv_id, NINT(itau*dt), zlev_uv, oasis_info)
+     !
+     !
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), temp_air, "Air temperature")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), qair, "Air humidity")
+     !
+     CALL oasis_put(tair_id, NINT(itau*dt), temp_air, oasis_info)
+     CALL oasis_put(qair_id, NINT(itau*dt), qair, oasis_info)
+     !
+     ! Precipitation fluxes
+     !
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), precip_rain*one_day, "Rainfall")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), precip_snow*one_day, "Snowfall")
+     CALL oasis_put(rainf_id, NINT(itau*dt), precip_rain, oasis_info)
+     CALL oasis_put(snowf_id, NINT(itau*dt), precip_snow, oasis_info)
+     !
+     ! Radiation fluxes
+     !
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), swnet, "Net solar")
+     CALL oasis_put(swnet_id, NINT(itau*dt), swnet, oasis_info)
+     CALL oasis_put(lwdown_id, NINT(itau*dt), lwdown, oasis_info)
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), lwdown, "Downward Longwave") 
+     CALL oasis_put(solarang_id, NINT(itau*dt), solarang, oasis_info)
+     !
+     ! Dynamical fields
+     !
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), u, "East-ward wind")
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), pb, "Surface Pressure")
+     CALL oasis_put(u_id, NINT(itau*dt), u, oasis_info)
+     CALL oasis_put(v_id, NINT(itau*dt), v, oasis_info)
+     CALL oasis_put(ps_id, NINT(itau*dt), pb, oasis_info)
+     CALL oasis_put(cdrag_id, NINT(itau*dt), cdrag, oasis_info)
+     !
+     IF ( timemeasure ) THEN
+        waitput_cputime = waitput_cputime + Get_cpu_Time(timer_global)
+        waitput_walltime = waitput_walltime + Get_real_Time(timer_global)
+        CALL stop_timer(timer_global)
+        CALL start_timer(timer_global)
+     ENDIF
+     !
+     ! Get the forcing data for the next time step before we go into the blocking gets
+     !
+     IF ( itau < (nbdt-1) ) THEN
+        timestep_int_next(1) = date_start + (itau+1)*(dt/one_day)
+        timestep_int_next(2) = date_start + (itau+2)*(dt/one_day)
+        CALL forcing_getvalues(timestep_int_next, dt, zlev_tq, zlev_uv, temp_air, qair, &
+             &                 precip_rain, precip_snow, swdown, lwdown, solarang, u, v, pb)
+        ! An atmsopheric model will provide this information. If zero ORCHIDEE will compute it.
+        cdrag(:) = 0.0
+        ! Compute swnet with the albedo computed in the previous call to ORCHIDEE
+        swnet(:) = (1.-(albedo(:,1)+albedo(:,2))/2.)*swdown(:)
+        !
+     ENDIF
+     !
+     ! Timing of computations for next forcing data
+     !
+     IF ( timemeasure ) THEN
+        preparation_cputime = preparation_cputime + Get_cpu_Time(timer_global)
+        preparation_walltime = preparation_walltime + Get_real_Time(timer_global)
+        CALL stop_timer(timer_global)
+        CALL start_timer(timer_global)
+     ENDIF
+     !
+     ! Go into the blocking gets from OASIS
+     !
+     CALL oasis_get(vevapp_id, NINT(itau*dt), vevapp, oasis_info)
+     CALL oasis_get(fluxsens_id, NINT(itau*dt), fluxsens, oasis_info)
+     CALL oasis_get(fluxlat_id, NINT(itau*dt), fluxlat, oasis_info)
+     !
+     CALL oasis_get(coastal_id, NINT(itau*dt), coastalflow, oasis_info)
+     CALL oasis_get(river_id, NINT(itau*dt), riverflow, oasis_info)
+     !
+     CALL oasis_get(netco2_id, NINT(itau*dt), netco2, oasis_info)
+     CALL oasis_get(carblu_id, NINT(itau*dt), carblu, oasis_info)
+     !
+     CALL oasis_get(tsolrad_id, NINT(itau*dt), tsol_rad, oasis_info)
+     CALL oasis_get(tsolnew_id, NINT(itau*dt), temp_sol_new, oasis_info)
+     CALL oasis_get(qsurf_id, NINT(itau*dt), qsurf, oasis_info)
+     !
+     CALL oasis_get(albvis_id, NINT(itau*dt), albedo(:,1), oasis_info)
+     CALL oasis_get(albnir_id, NINT(itau*dt), albedo(:,2), oasis_info)
+     CALL oasis_get(emis_id, NINT(itau*dt), emis, oasis_info)
+     CALL oasis_get(z0_id, NINT(itau*dt), z0, oasis_info)
+     CALL forcing_printpoint(julian, testpt(1), testpt(2), vevapp, "Recived evap")
+     !
+     ! Timing of waits
+     !
+     IF ( timemeasure ) THEN
+        waitget_cputime = waitget_cputime + Get_cpu_Time(timer_global)
+        waitget_walltime = waitget_walltime + Get_real_Time(timer_global)
+        CALL stop_timer(timer_global)
+        CALL start_timer(timer_global)
+     ENDIF
+     !
+     !---------------------------------------------------------------------------------------
+     ! Some dianostics
+     !---------------------------------------------------------------------------------------
+     !
+     IF ( MOD(itau, freq_diag) == 0 ) THEN
+        !
+        CALL forcing_printdate(timestep_interval(1), "Diagnostics START", w_unit)
+        !
+        WRITE(w_unit,*) MINVAL(temp_sol_new), " << TEMP_SOL_NEW << ", MAXVAL(temp_sol_new)
+        WRITE(w_unit,*) MINVAL(vevapp), " << VEVAPP << ", MAXVAL(vevapp)
+        WRITE(w_unit,*) MINVAL(fluxsens), " << FLUXSENS << ", MAXVAL(fluxsens)
+        WRITE(w_unit,*) MINVAL(fluxlat), " << FLUXLAT << ", MAXVAL(fluxlat)
+        WRITE(w_unit,*) MINVAL(coastalflow), " <<  COASTALFLOW << ", MAXVAL(coastalflow)
+        WRITE(w_unit,*) MINVAL(riverflow), " << RIVERFLOW << ", MAXVAL(riverflow)
+        WRITE(w_unit,*) MINVAL(netco2), " << NETCO2 << ", MAXVAL(netco2)
+        WRITE(w_unit,*) MINVAL(carblu), " << CARBLU << ", MAXVAL(carblu)
+        WRITE(w_unit,*) MINVAL(tsol_rad), " << TSOL_RAD, << ", MAXVAL(tsol_rad)
+        WRITE(w_unit,*) MINVAL(temp_sol_new), " << TEMP_SOL_NEW << ", MAXVAL(temp_sol_new)
+        WRITE(w_unit,*) MINVAL(qsurf), " << QSURF << ", MAXVAL(qsurf)
+        WRITE(w_unit,*) MINVAL(albedo(:,1)), " << ALBEDO VIS << ", MAXVAL(albedo(:,1))
+        WRITE(w_unit,*) MINVAL(albedo(:,2)), " << ALBEDO NIR << ", MAXVAL(albedo(:,2))
+        WRITE(w_unit,*) MINVAL(emis), " << EMIS << ", MAXVAL(emis)
+        WRITE(w_unit,*) MINVAL(z0), " << Z0 << ", MAXVAL(z0)
+        !
+        CALL forcing_printdate(timestep_interval(2), "Diagnostics END", w_unit)
+        !
+     ENDIF
+     !
+  ENDDO
+  !-
+  !-
+  !-
+  IF ( timemeasure ) THEN
+     WRITE(w_unit,*) '------> Total CPU Time waiting for put to ORCH : ',waitput_cputime
+     WRITE(w_unit,*) '------> Total Real Time waiting for put to ORCH : ',waitput_walltime
+     WRITE(w_unit,*) '------> Total CPU Time for preparing forcing : ', preparation_cputime
+     WRITE(w_unit,*) '------> Total Real Time for preparing forcing : ', preparation_walltime
+     WRITE(w_unit,*) '------> Total CPU Time waiting for get from ORCH : ',waitget_cputime
+     WRITE(w_unit,*) '------> Total Real Time waiting for get from ORCH : ',waitget_walltime
+     CALL stop_timer(timer_global)
+  ENDIF
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Close OASIS and MPI
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  CALL oasis_terminate(ierror)
+  !
+  CALL forcing_close()
+
+  ! Deallocate all variables and reset init flags
+  CALL forcing_tools_clear()
+
+  CLOSE(UNIT=w_unit)
+  !-
+END PROGRAM driver2oasis
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_oasisdriver/orchideeoasis.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_oasisdriver/orchideeoasis.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_oasisdriver/orchideeoasis.f90	(revision 6412)
@@ -0,0 +1,917 @@
+! =================================================================================================================================
+! PROGRAM       : orchideedriveroasis
+!
+! CONTACT       : jan.polcher@lmd.jussieu.fr
+!
+! LICENCE      : IPSL (2016)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF      This is the main program for the driver which gets the forcing data from OASIS. It is used as an interface
+!!            for WRF for instance. It allows to have another domain decomposition than the atmosphere. Particularly useful
+!!            for coupling to atmospheric models not decomposed by the "apple method".
+!!
+!!\n DESCRIPTION: This program only organises the data and calls sechiba_main after having received the data from OASIS.
+!!                The main work for the OASIS interface is done in orchoasis_tools.f90 module.
+!!                Call the various modules to get the forcing data and provide it to SECHIBA. The only complexity
+!!                is setting-up the domain decomposition and distributing the grid information.
+!!                The code is parallel from tip to toe using the domain decomposition inherited from LMDZ.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL:  $
+!! $Date:  $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+PROGRAM orchideeoasis
+  !---------------------------------------------------------------------
+  !-
+  !- 
+  !---------------------------------------------------------------------
+  USE defprec
+  USE netcdf
+  !
+  !
+  USE ioipsl_para
+  USE mod_orchidee_para
+  !
+  USE grid
+  USE timer
+
+  USE globgrd
+  USE orchoasis_tools
+  !
+  USE sechiba
+  USE control
+  USE ioipslctrl
+  !
+  USE mod_oasis
+  !-
+  IMPLICIT NONE
+  !-
+  INCLUDE 'mpif.h'
+  !-
+  CHARACTER(LEN=80) :: gridfilename
+  CHARACTER(LEN=8)  :: model_guess
+  INTEGER(i_std)    :: iim_glo, jjm_glo, file_id
+  !- 
+  INTEGER(i_std)    :: nbseg
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lon_glo, lat_glo, area_glo
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: mask_glo
+  INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: maskinv_glo
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: corners_glo
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: corners_lon, corners_lat
+  INTEGER(i_std) :: nbindex_g, kjpindex
+  INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: kindex, kindex_g
+  !
+  ! Variables for the global grid available on all procs and used
+  ! to fill the ORCHIDEE variable on the root_proc
+  !
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: lalo_glo
+  REAL(r_std), ALLOCATABLE, DIMENSION(:)      :: contfrac_glo
+  CHARACTER(LEN=20)                           :: calendar
+  !-
+  !- Variables local to each processors.
+  !-
+  INTEGER(i_std) :: i, j, ik, nbdt, first_point
+  INTEGER(i_std) :: itau, itau_offset, itau_sechiba
+  REAL(r_std)    :: date0, date0_shifted, dt, julian, julian0
+  INTEGER(i_std) :: rest_id, rest_id_stom
+  INTEGER(i_std) ::  hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lalo_loc
+  INTEGER(i_std) :: iim, jjm
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lon, lat
+  !-
+  !- input fields
+  !-
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: u             !! Lowest level wind speed
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: v             !! Lowest level wind speed 
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: zlev_uv       !! Height of first layer
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: zlev_tq       !! Height of first layer
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: qair          !! Lowest level specific humidity
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: precip_rain   !! Rain precipitation
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: precip_snow   !! Snow precipitation
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: lwdown        !! Down-welling long-wave flux 
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: swdown        !! Downwelling surface short-wave flux
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: sinang        !! cosine of solar zenith angle
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: temp_air      !! Air temperature in Kelvin
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: epot_air      !! Air potential energy
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: ccanopy       !! CO2 concentration in the canopy
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: petAcoef      !! Coeficients A from the PBL resolution
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: peqAcoef      !! One for T and another for q
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: petBcoef      !! Coeficients B from the PBL resolution
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: peqBcoef      !! One for T and another for q
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: cdrag         !! Cdrag
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)             :: pb            !! Lowest level pressure
+  !-
+  !- output fields
+  !-
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: z0            !! Surface roughness
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: coastalflow   !! Diffuse flow of water into the ocean (m^3/dt)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: riverflow     !! Largest rivers flowing into the ocean (m^3/dt)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: tsol_rad      !! Radiative surface temperature
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: vevapp        !! Total of evaporation
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: temp_sol_new  !! New soil temperature
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: qsurf         !! Surface specific humidity
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:)          :: albedo        !! Albedo
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: fluxsens      !! Sensible chaleur flux
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: fluxlat       !! Latent chaleur flux
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: emis          !! Emissivity
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: netco2        !! netco2flux
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: carblu        !! fco2_land_use
+  !-
+  !- Declarations for OASIS
+  !-
+  CHARACTER(LEN=6)   :: comp_name = 'orchid'
+  INTEGER(i_std) :: loc_size, glo_size ! number of pes used
+  INTEGER(i_std) :: loc_rank, glo_rank ! rank of current pe 
+  INTEGER(i_std) :: localComm, LOCAL_OASIS_COMM  ! local MPI communicator and Initialized
+  INTEGER(i_std) :: comp_id    ! component identification
+  INTEGER(i_std) :: ierror, flag, oasis_info
+  CHARACTER(LEN=3) :: chout
+  CHARACTER(LEN=4) :: oasis_gridname
+  CHARACTER(LEN=30) :: diagfilename
+  !-
+  !-
+  !-
+  REAL(r_std) :: atmco2
+  REAL(r_std), ALLOCATABLE, DIMENSION (:)  :: u_tq, v_tq, swnet
+  LOGICAL :: lrestart_read = .TRUE. !! Logical for _restart_ file to read
+  LOGICAL :: lrestart_write = .FALSE. !! Logical for _restart_ file to write'
+  !
+  ! Time  variables
+  !
+  LOGICAL, PARAMETER :: timemeasure=.TRUE.
+  REAL(r_std) :: waitput_cputime=0.0, waitget_cputime=0.0, orchidee_cputime=0.0
+  REAL(r_std) :: waitput_walltime=0.0, waitget_walltime=0.0, orchidee_walltime=0.0
+  !
+  ! Print point
+  !
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/44.8,-25.3/)
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/44.8,-18.3/)
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/-60.25,-5.25/)
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/46.7,10.3/)
+!!  REAL(r_std), DIMENSION(2) :: testpt=(/0.25,49.25/)
+  ! Case when no ouput is desired.
+  REAL(r_std), DIMENSION(2) :: testpt=(/9999.99,9999.99/)
+  INTEGER(i_std) :: ktest
+  !
+  !-
+  !---------------------------------------------------------------------------------------
+  !- 
+  !- Define MPI communicator and set-up OASIS
+  !- 
+  !---------------------------------------------------------------------------------------
+  !-
+  !
+  CALL oasis_init_comp(comp_id, comp_name, ierror)
+  CALL oasis_get_localcomm (LOCAL_OASIS_COMM, ierror)
+  !
+  ! Set parallel processing in ORCHIDEE
+  !
+  CALL Init_orchidee_para(LOCAL_OASIS_COMM) 
+  !====================================================================================
+  !
+  ! Start timer now that the paralelisation is started.
+  !
+  IF ( timemeasure ) THEN
+     CALL init_timer
+     CALL start_timer(timer_global)
+     CALL start_timer(timer_mpi)
+  ENDIF
+  !-
+  !
+  !---------------------------------------------------------------------------------------
+  !-
+  !-  Print some diagnostics for this main of ORCHIDEE
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  CALL MPI_COMM_RANK(MPI_COMM_WORLD, glo_rank, ierror)
+  CALL MPI_COMM_RANK(LOCAL_OASIS_COMM, loc_rank, ierror)
+  CALL MPI_COMM_SIZE(MPI_COMM_WORLD, glo_size, ierror)
+  CALL MPI_COMM_SIZE(LOCAL_OASIS_COMM, loc_size, ierror)
+  !-
+  !
+  WRITE (numout,*) '-----------------------------------------------------------'
+  WRITE (numout,*) '-------------------- comp_name= ',comp_name,'  ---------------'
+  WRITE (numout,*) '-----------------------------------------------------------'
+  WRITE (numout,*) TRIM(comp_name), ' Running with reals compiled as kind =',r_std
+  WRITE (numout,*) 'I am component ', TRIM(comp_name), ' local rank :', loc_rank, &
+       &           " Global rank :", glo_rank
+  WRITE (numout,*) 'CPUs we are using for the main :', loc_size, ' Global number :', glo_size
+  WRITE (numout,*) 'Local and global MPI communicators :', LOCAL_OASIS_COMM,  MPI_COMM_WORLD
+  WRITE (numout,*) '----------------------------------------------------------'
+  CALL flush(numout)
+  !
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Start the getconf processes 
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+!!  CALL getin_name("run.def")
+  !-
+  !Config Key   = GRID_FILE
+  !Config Desc  = Name of file containing the forcing data
+  !Config If    = [-]
+  !Config Def   = grid_file.nc
+  !Config Help  = This is the name of the file from which we will read
+  !Config         or write into it the description of the grid from 
+  !Config         the forcing file.
+  !Config         compliant.
+  !Config Units = [FILE] 
+  !- 
+  gridfilename='grid_file.nc'
+  CALL getin_p('GRID_FILE', gridfilename)
+  !-
+  !- Get some basic variables from the run.def
+  !-
+  atmco2=350.
+  CALL getin_p('ATM_CO2',atmco2)
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Get the grid on all processors.
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !
+  CALL globgrd_getdomsz(gridfilename, iim_glo, jjm_glo, nbindex_g, model_guess, file_id)
+  nbseg = 4
+  !
+  !-
+  !- Allocation of memory
+  !- variables over the entire grid (thus in x,y)
+  ALLOCATE(lon_glo(iim_glo, jjm_glo))
+  ALLOCATE(lat_glo(iim_glo, jjm_glo))
+  ALLOCATE(mask_glo(iim_glo, jjm_glo))
+  ALLOCATE(area_glo(iim_glo, jjm_glo))
+  ALLOCATE(corners_glo(iim_glo, jjm_glo, nbseg, 2))
+  !
+  ! Gathered variables
+  ALLOCATE(kindex_g(nbindex_g))
+  ALLOCATE(contfrac_glo(nbindex_g))
+  !-
+  !-
+  !-
+  CALL globgrd_getgrid(file_id, iim_glo, jjm_glo, nbindex_g, model_guess, &
+       &               lon_glo, lat_glo, mask_glo, area_glo, corners_glo,&
+       &               kindex_g, contfrac_glo, calendar)
+  !-
+  !- Set the calendar and get some information
+  !-
+  CALL ioconf_calendar(calendar)
+  CALL ioget_calendar(one_year, one_day)
+  !-
+  !- get the time period for the run
+  !-
+  CALL orchoasis_time(date0, dt, nbdt)
+  !-
+  !- lalo needs to be created before going into the parallel region
+  !-
+  ALLOCATE(lalo_glo(nbindex_g,2))
+  DO ik=1,nbindex_g
+     !
+     j = ((kindex_g(ik)-1)/iim_glo)+1
+     i = (kindex_g(ik)-(j-1)*iim_glo)
+     !
+     IF ( i > iim_glo .OR. j > jjm_glo ) THEN
+        WRITE(100+mpi_rank,*) "Error in the indexing (ik, kindex, i, j) : ", ik, kindex(ik), i, j
+        STOP "ERROR in orchideeoasis"
+     ENDIF
+     !
+     lalo_glo(ik,1) = lat_glo(i,j)
+     lalo_glo(ik,2) = lon_glo(i,j)
+     !
+  ENDDO
+  !
+  WRITE(100+mpi_rank,*) "Rank", mpi_rank, " Before parallel region All land points : ",  nbindex_g
+  WRITE(100+mpi_rank,*) "Rank", mpi_rank, " from ", iim_glo, " point in Lon. and ", jjm_glo, "in Lat."
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Initialise the ORCHIDEE domain on the procs (longitude, latitude, indices)
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- init_data_para also transfers kindex_g to index_g (the variable used in ORCHIDEE) 
+  !-
+  CALL grid_set_glo(iim_glo, jjm_glo, nbindex_g)
+  CALL grid_allocate_glo(nbseg)
+  ! Copy the list of indexes of land points into index_g used by ORCHIDEE and then broacast to all
+  ! processors
+  CALL bcast(nbindex_g)
+  IF ( is_root_prc) index_g = kindex_g
+  CALL bcast(index_g)
+  !
+  WRITE(numout,*) "Rank", mpi_rank, "Into Init_orchidee_data_para_driver with ", nbindex_g,index_g(1)
+  !
+  CALL Init_orchidee_data_para_driver(nbindex_g,index_g)
+  CALL init_ioipsl_para 
+  !
+  WRITE(numout,*) "Rank", mpi_rank, "After init_data_para global size : ",  nbp_glo, SIZE(index_g), iim_g, iim_glo, jjm_g, jjm_glo
+  WRITE(numout,'("After init_data_para local : ij_nb, jj_nb",2I4)') iim_glo, jj_nb
+  !
+  ! Allocate grid on the local processor
+  !
+  IF ( model_guess == "regular") THEN
+     CALL grid_init (nbp_loc, nbseg, "RegLonLat", "ForcingGrid")
+  ELSE IF ( model_guess == "WRF") THEN
+     CALL grid_init (nbp_loc, nbseg, "RegXY", "WRFGrid")
+  ELSE
+     CALL ipslerr(3, "orchideeoasis", "The grid found in the GRID_FILE is not supported by ORCHIDEE", "", "")
+  ENDIF
+  !
+  ! Transfer the global grid variables to the ORCHIDEE version on the root proc
+  ! *_glo -> *_g
+  ! Variables *_g were allocated with the CALL init_grid
+  !
+  IF ( is_root_prc) THEN
+     !
+     lalo_g(:,:) = lalo_glo(:,:)
+     lon_g(:,:) = lon_glo(:,:)
+     lat_g(:,:) = lat_glo(:,:)
+     !
+  ENDIF
+  !-
+  !
+  ! Set the local dimensions of the fields
+  !
+  iim = iim_glo
+  jjm = jj_nb
+  kjpindex = nbp_loc
+  !
+  WRITE(numout,*) mpi_rank, "DIMENSIONS of grid on processor : iim, jjm, kjpindex = ", iim, jjm, kjpindex
+  !
+  !  Allocate the local arrays we need :
+  !
+  ALLOCATE(lon(iim,jjm), lat(iim,jjm))
+  ALLOCATE(kindex(kjpindex))
+  !
+  lon=lon_glo(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank))
+  lat=lat_glo(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank))
+  !
+  !
+  ! Redistribute the indeces on all procs (apple distribution of land points) 
+  !
+  CALL bcast(lon_g)
+  CALL bcast(lat_g)
+  CALL scatter(index_g, kindex) 
+  ! 
+  !
+  ! Apply the offset needed so that kindex refers to the index of the land point 
+  ! on the current region, i.e. the local lon lat domain.
+  !
+  kindex(1:kjpindex)=kindex(1:kjpindex)-(jj_begin-1)*iim_glo
+  !
+  ! This routine transforms the global grid into a series of polygons for all land
+  ! points identified by index_g.
+  !
+  CALL grid_stuff(nbindex_g, iim_g, jjm_g, lon_g, lat_g, index_g, contfrac_glo)
+  !
+  ! Distribute the global lalo to the local processor level lalo
+  !
+  ALLOCATE(lalo_loc(kjpindex,2))
+  CALL scatter(lalo_glo, lalo_loc)
+  lalo(:,:) = lalo_loc(:,:)
+  !
+  !- 
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Allocate the space for the per processor coupling variables
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  ALLOCATE(zlev_tq(kjpindex), zlev_uv(kjpindex))
+  ALLOCATE(u(kjpindex), v(kjpindex), pb(kjpindex))
+  ALLOCATE(temp_air(kjpindex))
+  ALLOCATE(qair(kjpindex))
+  ALLOCATE(precip_rain(kjpindex), precip_snow(kjpindex))
+  ALLOCATE(swdown(kjpindex), lwdown(kjpindex), sinang(kjpindex))
+  !
+  ALLOCATE(epot_air(kjpindex), ccanopy(kjpindex), cdrag(kjpindex), swnet(kjpindex))
+  !
+  ALLOCATE(petAcoef(kjpindex), peqAcoef(kjpindex), petBcoef(kjpindex), peqBcoef(kjpindex))
+  ALLOCATE(u_tq(kjpindex), v_tq(kjpindex))
+  !
+  ALLOCATE(vevapp(kjpindex), fluxsens(kjpindex), fluxlat(kjpindex), coastalflow(kjpindex), riverflow(kjpindex))
+  ALLOCATE(netco2(kjpindex), carblu(kjpindex))
+  ALLOCATE(tsol_rad(kjpindex), temp_sol_new(kjpindex), qsurf(kjpindex))
+  ALLOCATE(albedo(kjpindex,2), emis(kjpindex), z0(kjpindex))
+  !
+  WRITE(numout,*) "Rank", mpi_rank, "Domain size per proc !:", iim_glo, jjm_glo, kjpindex, SIZE(kindex)
+  WRITE(numout,*) "Rank", mpi_rank, "In parallel region land index starts at : ", kindex(1)
+  ! 
+  CALL orchoasis_time(date0, dt, nbdt)
+  !
+  CALL control_initialize(dt)
+  ! 
+  itau = 0
+  !
+  CALL ioipslctrl_restini(itau, date0, dt, rest_id, rest_id_stom, itau_offset, date0_shifted)
+  !
+  ! Get the date of the first time step
+  !
+  julian = date0 + 0.5*(dt/one_day)
+  CALL ju2ymds (julian, year, month, day, sec)
+  !
+  CALL xios_orchidee_init( MPI_COMM_ORCH,                &
+       date0,    year,    month,           day,          &
+       lon,      lat,     soilth_lev)
+  !
+  itau_sechiba = itau + itau_offset
+  !
+  WRITE(numout,*) "orchoasis_history :", iim, jjm, SHAPE(lon)
+  !- Initialize IOIPSL sechiba output files
+  CALL ioipslctrl_history(iim, jjm, lon, lat,  kindex, kjpindex, itau_sechiba, &
+       date0, dt, hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC)
+  WRITE(numout,*) "HISTORY : Define for ", itau, date0, dt
+  !
+  !-
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Send the grid to OASIS ... only on the root processor
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  IF ( is_root_prc ) THEN
+     !
+     ! TOCOMPLETE - Put here OASIS grid, corner, areas and mask writing calls !
+     !
+     oasis_gridname = model_guess(1:4)
+     CALL oasis_start_grids_writing(flag)
+     !
+     CALL oasis_write_grid(oasis_gridname, iim_glo, jjm_glo, lon_glo, lat_glo)
+     !
+     ALLOCATE(corners_lon(iim_glo, jjm_glo, nbseg), corners_lat(iim_glo, jjm_glo, nbseg))
+     corners_lon(:,:,:) = corners_glo(:,:,:,1)
+     corners_lat(:,:,:) = corners_glo(:,:,:,2)
+     CALL oasis_write_corner(oasis_gridname, iim_glo, jjm_glo, nbseg, corners_lon, corners_lat)
+     !
+     ALLOCATE(maskinv_glo(iim_glo, jjm_glo))
+     DO i=1,iim_glo
+        DO j=1,jjm_glo
+           IF (mask_glo(i,j) == 0) THEN
+              maskinv_glo(i,j) = 1
+           ELSE
+              maskinv_glo(i,j) = 0
+           ENDIF
+        ENDDO
+     ENDDO
+     CALL oasis_write_mask(oasis_gridname, iim_glo, jjm_glo, maskinv_glo)
+     !
+     CALL oasis_write_area(oasis_gridname, iim_glo, jjm_glo, area_glo)
+     !
+     CALL oasis_terminate_grids_writing()
+     !
+     IF (model_guess == "WRF") THEN
+        oasis_gridname = "twrf"
+        !
+        CALL oasis_start_grids_writing(flag)
+        !
+        CALL oasis_write_grid(oasis_gridname, iim_glo, jjm_glo, lon_glo, lat_glo)
+        !
+        CALL oasis_write_corner(oasis_gridname, iim_glo, jjm_glo, nbseg, corners_lon, corners_lat)
+        !
+        CALL oasis_write_mask(oasis_gridname, iim_glo, jjm_glo, maskinv_glo)
+        !
+        CALL oasis_write_area(oasis_gridname, iim_glo, jjm_glo, area_glo)
+        !
+        CALL oasis_terminate_grids_writing()
+     ENDIF
+     DEALLOCATE(corners_lon, corners_lat)
+     !
+  ENDIF
+  !
+  call flush(numout)
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Declare the variables to be exchanged through OASIS
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  CALL orchoasis_defvar(mpi_rank, kjpindex)
+  !
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Get a first set of forcing data 
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  itau = 0
+  julian = date0 + (itau+0.5)*(dt/one_day)
+  CALL ju2ymds (julian, year, month, day, sec)
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Going into the time loop
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !
+  DO itau=1,nbdt
+     !
+     julian = date0 + (itau-0.5)*(dt/one_day)
+     ! Needed for STOMATE but should be taken from the arguments of SECHIBA
+     in_julian = itau2date(itau, date0, dt)
+     !
+     CALL ju2ymds (julian, year, month, day, sec)
+     CALL ymds2ju (year,1,1,zero, julian0)
+     julian_diff = in_julian-julian0
+     !
+     !
+     IF ( itau == nbdt ) lrestart_write = .TRUE.
+     !
+     !---------------------------------------------------------------------------------------
+     !-
+     !- Get the variables from OASIS
+     !-
+     !---------------------------------------------------------------------------------------
+     !
+     ! OASIS get call are blocking so they need to be done once all is finsihed
+     !
+     CALL orchoasis_getvar(itau-1, dt, kjpindex, kindex - (ii_begin - 1), &
+          &                zlev_tq, zlev_uv, temp_air, qair, &
+          &                precip_rain, precip_snow, swnet, lwdown, sinang, u, v, pb, cdrag)
+     !
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, temp_air, "RECEIVED Air temperature")
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, qair, "RECEIVED Air humidity")
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, precip_rain*one_day, "RECEIVED Rainfall")
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, precip_snow*one_day, "RECEIVED Snowfall")
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, swnet, "RECEIVED net solar")
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, lwdown, "RECEIVED lwdown")
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, u, "RECEIVED East-ward wind")
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, v, "RECEIVED North-ward wind")
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, pb, "RECEIVED surface pressure")
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, zlev_uv, "RECEIVED UV height")
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, zlev_tq, "RECEIVED TQ height")
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, sinang, "RECEIVED sinang")
+     !
+     !
+     ! Adaptation of the forcing data to SECHIBA's needs
+     !
+     ! Contrary to what the documentation says, ORCHIDEE expects surface pressure in hPa.
+     pb(:) = pb(:)/100.
+     epot_air(:) = cp_air*temp_air(:)+cte_grav*zlev_tq(:)
+     ccanopy(:) = atmco2 
+     !
+     petBcoef(:) = epot_air(:)
+     peqBcoef(:) = qair(:)
+     petAcoef(:) = zero
+     peqAcoef(:) = zero
+     !
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, z0, &
+          &                    "Z0 before compute", ktest)
+     !
+     ! Interpolate the wind (which is at hight zlev_uv) to the same height 
+     ! as the temperature and humidity (at zlev_tq).
+     !
+     u_tq(:) = u(:)*LOG(zlev_tq(:)/z0(:))/LOG(zlev_uv(:)/z0(:))
+     v_tq(:) = v(:)*LOG(zlev_tq(:)/z0(:))/LOG(zlev_uv(:)/z0(:))
+     !
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, u_tq, "USED East-ward wind")
+     !
+     IF ( itau .NE. 1 ) THEN
+        IF ( timemeasure ) THEN
+           waitget_cputime = waitget_cputime + Get_cpu_Time(timer_global)
+           waitget_walltime = waitget_walltime + Get_real_Time(timer_global)
+           CALL stop_timer(timer_global)
+           CALL start_timer(timer_global)
+        ENDIF
+     ENDIF
+     !
+     !---------------------------------------------------------------------------------------
+     !-
+     !- IF first time step : Call to SECHIBA_initialize to set-up ORCHIDEE before doing an actual call
+     !- which will provide the first fluxes.
+     !-
+     !---------------------------------------------------------------------------------------
+     !
+     itau_sechiba = itau+itau_offset
+     !
+     ! Update the calendar in xios by sending the new time step
+     CALL xios_orchidee_update_calendar(itau_sechiba)
+     !
+     IF ( itau == 1 ) THEN
+        !
+        IF ( timemeasure ) THEN
+           WRITE(numout,*) '------> CPU Time for start-up of main : ',Get_cpu_Time(timer_global)
+           WRITE(numout,*) '------> Real Time for start-up of main : ',Get_real_Time(timer_global)
+           CALL stop_timer(timer_global)
+           CALL start_timer(timer_global)
+        ENDIF
+        !
+        CALL sechiba_initialize( &
+             itau_sechiba, iim*jjm,      kjpindex,      kindex,                    &
+             lalo_loc,     contfrac,     neighbours,    resolution,  zlev_tq,      &
+             u_tq,         v_tq,         qair,          temp_air,    temp_air,     &
+             petAcoef,     peqAcoef,     petBcoef,      peqBcoef,                  &
+             precip_rain,  precip_snow,  lwdown,        swnet,       swdown,       &
+             pb,           rest_id,      hist_id,       hist2_id,                  &
+             rest_id_stom, hist_id_stom, hist_id_stom_IPCC,                        &
+             coastalflow,  riverflow,    tsol_rad,      vevapp,      qsurf,        &
+             z0,           albedo,       fluxsens,      fluxlat,     emis,         &
+             netco2,       carblu,       temp_sol_new,  cdrag)
+        CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, temp_sol_new, "Init temp_sol_new")
+        !
+        ! Use the obtained albedo to diagnose the Downward Solar
+        !
+        swdown(:) = swnet(:)/(1.-(albedo(:,1)+albedo(:,2))/2.)
+        !
+        lrestart_read = .FALSE.
+        !
+        CALL histwrite_p(hist_id, 'LandPoints',  itau+1, (/ REAL(kindex) /), kjpindex, kindex)
+        CALL histwrite_p(hist_id, 'Areas',  itau+1, area, kjpindex, kindex)
+        CALL histwrite_p(hist_id, 'Contfrac',  itau+1, contfrac, kjpindex, kindex)
+        !
+        IF ( timemeasure ) THEN
+           WRITE(numout,*) '------> CPU Time for set-up of ORCHIDEE : ',Get_cpu_Time(timer_global)
+           WRITE(numout,*) '------> Real Time for set-up of ORCHIDEE : ',Get_real_Time(timer_global)
+           CALL stop_timer(timer_global)
+           CALL start_timer(timer_global)
+        ENDIF
+        !
+     ENDIF
+     !
+     !---------------------------------------------------------------------------------------
+     !-
+     !- Call to SECHIBA  
+     !-
+     !---------------------------------------------------------------------------------------
+     !
+     CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, &
+          & lrestart_read, lrestart_write, &
+          & lalo_loc, contfrac, neighbours, resolution, &
+          ! First level conditions
+          & zlev_tq, u_tq, v_tq, qair, qair, temp_air, 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, sinang, pb, &
+          ! Output : Fluxes
+          & vevapp, fluxsens, fluxlat, coastalflow, riverflow, netco2, carblu, &
+          ! Surface temperatures and surface properties
+          & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, &
+          ! File ids
+          & rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC)
+     !
+     ! Use the obtained albedo to diagnose the Downward Solar
+     !
+     swdown(:) = swnet(:)/(1.-(albedo(:,1)+albedo(:,2))/2.)
+     !
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, temp_sol_new, "Produced temp_sol_new")
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, fluxsens, "Produced fluxsens")
+     CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, fluxlat, "Produced fluxlat")
+     !
+     IF ( timemeasure ) THEN
+        orchidee_cputime = orchidee_cputime + Get_cpu_Time(timer_global)
+        orchidee_walltime = orchidee_walltime + Get_real_Time(timer_global)
+        CALL stop_timer(timer_global)
+        CALL start_timer(timer_global)
+     ENDIF
+     !
+     !---------------------------------------------------------------------------------------
+     ! Send the ORCHIDEE output back to the driver
+     !---------------------------------------------------------------------------------------
+     !
+     CALL orchoasis_putvar(itau, dt, kjpindex, kindex - (ii_begin - 1),&
+          &                vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
+          &                netco2, carblu, tsol_rad, temp_sol_new, qsurf, albedo, emis, z0)
+     !
+     IF ( timemeasure ) THEN
+        waitput_cputime = waitput_cputime + Get_cpu_Time(timer_global)
+        waitput_walltime = waitput_walltime + Get_real_Time(timer_global)
+        CALL stop_timer(timer_global)
+        CALL start_timer(timer_global)
+     ENDIF
+     !
+     !---------------------------------------------------------------------------------------
+     !-
+     !- Write diagnostics
+     !-
+     !---------------------------------------------------------------------------------------
+     !
+     !---------------------------------------------------------------------------------------
+     !-
+     !- Write diagnostics
+     !-
+     !---------------------------------------------------------------------------------------
+     !
+     CALL xios_orchidee_send_field("LandPoints" ,(/ ( REAL(ik), ik=1,kjpindex ) /))
+     CALL xios_orchidee_send_field("Areas", area)
+     CALL xios_orchidee_send_field("Contfrac",contfrac)
+     CALL xios_orchidee_send_field("evap",vevapp*one_day/dt_sechiba)
+     CALL xios_orchidee_send_field("evap_alma",vevapp/dt_sechiba)
+     CALL xios_orchidee_send_field("coastalflow",coastalflow/dt_sechiba)
+     CALL xios_orchidee_send_field("riverflow",riverflow/dt_sechiba)
+     CALL xios_orchidee_send_field("temp_sol_C",temp_sol_new-ZeroCelsius)
+     CALL xios_orchidee_send_field("temp_sol_K",temp_sol_new)
+     CALL xios_orchidee_send_field("fluxsens",fluxsens)
+     CALL xios_orchidee_send_field("fluxlat",fluxlat)
+     CALL xios_orchidee_send_field("tair",temp_air)
+     CALL xios_orchidee_send_field("qair",qair)
+     CALL xios_orchidee_send_field("q2m",qair)
+     CALL xios_orchidee_send_field("t2m",temp_air)
+     CALL xios_orchidee_send_field("swnet",swnet)
+     CALL xios_orchidee_send_field("swdown",swdown)
+     ! zpb in hPa, output in Pa
+     CALL xios_orchidee_send_field("Psurf",pb*100.)
+     !
+     IF ( .NOT. almaoutput ) THEN
+        !
+        !  ORCHIDEE INPUT variables
+        !
+        CALL histwrite_p (hist_id, 'swdown',   itau_sechiba, swdown,   kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'tair',     itau_sechiba, temp_air, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'qair',     itau_sechiba, qair, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'evap',     itau_sechiba, vevapp, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, coastalflow, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, riverflow, kjpindex, kindex)
+        ! 
+        CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, temp_sol_new, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, temp_sol_new, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, temp_sol_new, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, fluxsens, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'fluxlat',  itau_sechiba, fluxlat,  kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'swnet',    itau_sechiba, swnet,    kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'alb_vis',  itau_sechiba, albedo(:,1), kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'alb_nir',  itau_sechiba, albedo(:,2), kjpindex, kindex)
+        !
+        IF ( hist2_id > 0 ) THEN
+           CALL histwrite_p (hist2_id, 'swdown',   itau_sechiba, swdown, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'tair',     itau_sechiba, temp_air, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'qair',     itau_sechiba, qair, kjpindex, kindex)
+           !
+           CALL histwrite_p (hist2_id, 'evap',     itau_sechiba, vevapp, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, coastalflow, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, riverflow, kjpindex, kindex)
+           ! 
+           CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, temp_sol_new, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, temp_sol_new, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, temp_sol_new, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, fluxsens, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'fluxlat',  itau_sechiba, fluxlat,  kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'swnet',    itau_sechiba, swnet,    kjpindex, kindex)
+           !
+           CALL histwrite_p (hist2_id, 'alb_vis',  itau_sechiba, albedo(:,1), kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'alb_nir',  itau_sechiba, albedo(:,2), kjpindex, kindex)
+        ENDIF
+     ELSE
+        !
+        ! Input variables
+        !
+        CALL histwrite_p (hist_id, 'SinAng', itau_sechiba, sinang, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'LWdown', itau_sechiba, lwdown, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'SWdown', itau_sechiba, swdown, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'Tair', itau_sechiba, temp_air, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'Qair', itau_sechiba, qair, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'SurfP', itau_sechiba, pb, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'Windu', itau_sechiba, u_tq, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'Windv', itau_sechiba, v_tq, kjpindex, kindex)
+        !
+        CALL histwrite_p (hist_id, 'Evap', itau_sechiba, vevapp, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'SWnet',    itau_sechiba, swnet, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'Qh', itau_sechiba, fluxsens, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'Qle',  itau_sechiba, fluxlat, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, temp_sol_new, kjpindex, kindex)
+        CALL histwrite_p (hist_id, 'RadT', itau_sechiba, temp_sol_new, kjpindex, kindex)
+        !
+        ! There is a mess with the units passed to the coupler. To be checked with Marc
+        !
+        IF ( river_routing ) THEN
+           CALL histwrite_p (hist_id, 'CoastalFlow',itau_sechiba, coastalflow, kjpindex, kindex)
+           CALL histwrite_p (hist_id, 'RiverFlow',itau_sechiba, riverflow, kjpindex, kindex)
+        ENDIF
+        !
+        IF ( hist2_id > 0 ) THEN
+           CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, vevapp, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'SWnet',    itau_sechiba, swnet, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, fluxsens, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'Qle',  itau_sechiba, fluxlat, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, temp_sol_new, kjpindex, kindex)
+           CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, temp_sol_new, kjpindex, kindex)
+        ENDIF
+     ENDIF
+     !
+     !
+     !
+  ENDDO
+  !
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Get time and close IOIPSL, OASIS and MPI
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !
+  CALL histclo
+  IF(is_root_prc) THEN
+     CALL restclo
+     CALL getin_dump
+     !-
+     DEALLOCATE(maskinv_glo)
+     !
+  ENDIF
+  !-
+  !- Deallocate all variables and reset init flags
+  !-
+  CALL orchideeoasis_clear()
+  !
+  WRITE(numout,*) "MPI finalized"
+  !-
+  IF ( timemeasure ) THEN
+     WRITE(numout,*) '------> Total CPU Time waiting to get forcing : ',waitget_cputime
+     WRITE(numout,*) '------> Total Real Time waiting to get forcing : ',waitget_walltime
+     WRITE(numout,*) '------> Total CPU Time for ORCHIDEE : ', orchidee_cputime
+     WRITE(numout,*) '------> Total Real Time for ORCHIDEE : ', orchidee_walltime
+     WRITE(numout,*) '------> Total CPU Time waiting to put fluxes : ',waitput_cputime
+     WRITE(numout,*) '------> Total Real Time waiting to put fluxes : ',waitput_walltime
+     WRITE(numout,*) '------> Total without MPI : CPU Time  : ', Get_cpu_Time(timer_mpi)
+     WRITE(numout,*) '------> Total without MPI : Real Time : ', Get_real_Time(timer_mpi)
+     CALL stop_timer(timer_global)
+     CALL stop_timer(timer_mpi)
+  ENDIF
+  !-
+  CALL oasis_terminate(ierror)
+  !
+  WRITE(numout,*) "OASIS terminated"
+  !-
+  !-
+CONTAINS
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : orchideeoasis_clear
+!!
+!>\BRIEF          Clear orchideeoasis
+!!
+!! DESCRIPTION  : Deallocate memory and reset initialization variables to there original values
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE orchideeoasis_clear
+
+    !- Deallocate all variables existing on all procs (list still incomplete)
+
+    IF ( ALLOCATED(lon_glo) ) DEALLOCATE(lon_glo)
+    IF ( ALLOCATED(lat_glo) ) DEALLOCATE(lat_glo)
+    IF ( ALLOCATED(mask_glo) ) DEALLOCATE(mask_glo)
+    IF ( ALLOCATED(area_glo) ) DEALLOCATE(area_glo)
+    IF ( ALLOCATED(corners_glo) ) DEALLOCATE(corners_glo)
+    IF ( ALLOCATED(kindex_g) ) DEALLOCATE(kindex_g)
+    IF ( ALLOCATED(contfrac_glo) ) DEALLOCATE(contfrac_glo)
+    IF ( ALLOCATED(lalo_glo) ) DEALLOCATE(lalo_glo)
+    IF ( ALLOCATED(lon) ) DEALLOCATE(lon)
+    IF ( ALLOCATED(lat) ) DEALLOCATE(lat)
+    IF ( ALLOCATED(kindex) ) DEALLOCATE(kindex)
+    IF ( ALLOCATED(lalo_loc) ) DEALLOCATE(lalo_loc)
+    IF ( ALLOCATED(zlev_tq) ) DEALLOCATE(zlev_tq)
+    IF ( ALLOCATED(zlev_uv) ) DEALLOCATE(zlev_uv)
+    IF ( ALLOCATED(u) ) DEALLOCATE(u)
+    IF ( ALLOCATED(v) ) DEALLOCATE(v)
+    IF ( ALLOCATED(pb) ) DEALLOCATE(pb)
+    IF ( ALLOCATED(temp_air) ) DEALLOCATE(temp_air)
+    IF ( ALLOCATED(qair) ) DEALLOCATE(qair)
+    IF ( ALLOCATED(precip_rain) ) DEALLOCATE(precip_rain)
+    IF ( ALLOCATED(precip_snow) ) DEALLOCATE(precip_snow)
+    IF ( ALLOCATED(swdown) ) DEALLOCATE(swdown)
+    IF ( ALLOCATED(swnet) ) DEALLOCATE(swnet)
+    IF ( ALLOCATED(lwdown) ) DEALLOCATE(lwdown)
+    IF ( ALLOCATED(sinang) ) DEALLOCATE(sinang)
+    IF ( ALLOCATED(epot_air) ) DEALLOCATE(epot_air)
+    IF ( ALLOCATED(ccanopy) ) DEALLOCATE(ccanopy)
+    IF ( ALLOCATED(cdrag) ) DEALLOCATE(cdrag)
+    IF ( ALLOCATED(swnet) ) DEALLOCATE(swnet)
+    IF ( ALLOCATED(petAcoef) ) DEALLOCATE(petAcoef)
+    IF ( ALLOCATED(peqAcoef) ) DEALLOCATE(peqAcoef)
+    IF ( ALLOCATED(petBcoef) ) DEALLOCATE(petBcoef)
+    IF ( ALLOCATED(peqBcoef) ) DEALLOCATE(peqBcoef)
+    IF ( ALLOCATED(u_tq) ) DEALLOCATE(u_tq)
+    IF ( ALLOCATED(v_tq) ) DEALLOCATE(v_tq)
+    IF ( ALLOCATED(vevapp) ) DEALLOCATE(vevapp)
+    IF ( ALLOCATED(fluxsens) ) DEALLOCATE(fluxsens)
+    IF ( ALLOCATED(fluxlat) ) DEALLOCATE(fluxlat)
+    IF ( ALLOCATED(coastalflow) ) DEALLOCATE(coastalflow)
+    IF ( ALLOCATED(riverflow) ) DEALLOCATE(riverflow)
+    IF ( ALLOCATED(netco2) ) DEALLOCATE(netco2)
+    IF ( ALLOCATED(carblu) ) DEALLOCATE(carblu)
+    IF ( ALLOCATED(tsol_rad) ) DEALLOCATE(tsol_rad)
+    IF ( ALLOCATED(temp_sol_new) ) DEALLOCATE(temp_sol_new)
+    IF ( ALLOCATED(qsurf) ) DEALLOCATE(qsurf)
+    IF ( ALLOCATED(albedo) ) DEALLOCATE(albedo)
+    IF ( ALLOCATED(emis) ) DEALLOCATE(emis)
+    IF ( ALLOCATED(z0) ) DEALLOCATE(z0)
+
+    CALL sechiba_clear()
+    WRITE(numout,*) "Memory deallocated"
+
+  END SUBROUTINE orchideeoasis_clear
+
+END PROGRAM orchideeoasis
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_oasisdriver/orchoasis_tools.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_oasisdriver/orchoasis_tools.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_oasisdriver/orchoasis_tools.f90	(revision 6412)
@@ -0,0 +1,703 @@
+MODULE orchoasis_tools
+  !
+  USE defprec
+  USE netcdf
+  !
+  USE ioipsl_para
+  USE mod_orchidee_para
+  !
+#ifdef OASIS
+  USE mod_oasis
+  !
+  ! ORCHIDEE definitions
+  !
+  USE constantes
+  USE constantes_soil
+  USE constantes_mtc
+  USE pft_parameters
+  !
+  USE control
+  !
+  IMPLICIT NONE
+  !
+  PRIVATE
+  PUBLIC :: orchoasis_time, &
+       &    orchoasis_printpoint, orchoasis_defvar, orchoasis_getvar, &
+       &    orchoasis_putvar, orchoasis_printdate
+  !
+  !
+  !  Global variables
+  !
+  !
+  INTEGER(i_std), SAVE                               :: itau_offset  !! This offset is used to phase the
+  ! INPUT
+  INTEGER(i_std), SAVE :: il_part_id, tair_id, qair_id, zlevtq_id, zlevuv_id
+  INTEGER(i_std), SAVE :: rainf_id, snowf_id, lwdown_id, swnet_id, solarang_id
+  INTEGER(i_std), SAVE :: u_id, v_id, ps_id, cdrag_id
+  ! OUTPUT
+  INTEGER(i_std), SAVE :: vevapp_id, fluxsens_id, fluxlat_id, coastal_id, river_id
+  INTEGER(i_std), SAVE :: netco2_id, carblu_id, tsolrad_id, tsolnew_id, qsurf_id
+  INTEGER(i_std), SAVE :: albnir_id, albvis_id, emis_id, z0_id
+  !
+  LOGICAL, PARAMETER :: check_INPUTS = .FALSE.         !! (very) long print of INPUTs in intersurf 
+  LOGICAL, SAVE :: check_time = .FALSE.
+  !
+  LOGICAL, SAVE :: landonly = .TRUE.
+  !
+  PUBLIC check_time
+  !
+CONTAINS
+!
+!=============================================================================================
+!
+  SUBROUTINE orchoasis_time(date_start, dt, nbdt)
+    !
+    !
+    ! This subroutine gets the start date of the simulation, the time step and the number 
+    ! of time steps we need to do until the end of the simulations.
+    !
+    !
+    !
+    REAL(r_std), INTENT(out)                     :: date_start     !! The date at which the simulation starts
+    REAL(r_std), INTENT(out)                     :: dt             !! Time step length in seconds
+    INTEGER(i_std), INTENT(out)                  :: nbdt           !! Number of timesteps to be executed
+    !
+    ! Local
+    !
+    CHARACTER(LEN=20) :: str_sdate(2), str_edate(2), tmpstr
+    INTEGER(i_std) :: s_year, s_month, s_day, e_year, e_month, e_day
+    INTEGER(i_std) :: seci, hours, minutes
+    REAL(r_std) :: s_sec, e_sec, dateend, diff_sec, date_end
+    INTEGER(i_std) :: i, ic
+    !
+    !Config Key  = START_DATE
+    !Config Desc = Date at which the simulation starts
+    !Config Def  = NONE
+    !Config Help = The format is the same as in the CF convention : 1999-09-13 12:0:0
+    str_sdate = " "
+    CALL getin('START_DATE',str_sdate)
+    !
+    IF ( (INDEX(str_sdate(1),"-") .NE. INDEX(str_sdate(1),"-", .TRUE.)) .AND. &
+         &  (INDEX(str_sdate(2),":") .NE. INDEX(str_sdate(2),":", .TRUE.)) ) THEN
+       DO i=1,2
+          tmpstr = str_sdate(1)
+          ic = INDEX(tmpstr,"-")
+          tmpstr(ic:ic) = " "
+          str_sdate(1) = tmpstr
+          tmpstr = str_sdate(2)
+          ic = INDEX(tmpstr,":")
+          tmpstr(ic:ic) = " "
+          str_sdate(2) = tmpstr
+       ENDDO
+       READ (str_sdate(1),*) s_year, s_month, s_day
+       READ (str_sdate(2),*) hours, minutes, seci
+       s_sec = hours*3600. + minutes*60. + seci
+    ELSE
+       CALL ipslerr(3, "orchoasis_time", "START_DATE incorrectly specified in run.def", str_sdate(1), str_sdate(2))
+    ENDIF
+    CALL ymds2ju (s_year, s_month, s_day, s_sec, date_start)
+    CALL orchoasis_printdate(date_start, "This is after reading the start date")
+    !
+    !Config Key  = END_DATE
+    !Config Desc = Date at which the simulation ends
+    !Config Def  = NONE
+    !Config Help =  The format is the same as in the CF convention : 1999-09-13 12:0:0
+    str_edate = " "
+    CALL getin('END_DATE',str_edate)
+    !
+    IF ( (INDEX(str_edate(1),"-") .NE. INDEX(str_edate(1),"-", .TRUE.)) .AND. &
+         &  (INDEX(str_edate(2),":") .NE. INDEX(str_edate(2),":", .TRUE.)) ) THEN
+       DO i=1,2
+          tmpstr = str_edate(1)
+          ic = INDEX(tmpstr,"-")
+          tmpstr(ic:ic) = " "
+          str_edate(1) = tmpstr
+          tmpstr = str_edate(2)
+          ic = INDEX(tmpstr,":")
+          tmpstr(ic:ic) = " "
+          str_edate(2) = tmpstr
+       ENDDO
+       READ (str_edate(1),*) e_year, e_month, e_day
+       READ (str_edate(2),*) hours, minutes, seci
+       e_sec = hours*3600. + minutes*60. + seci
+    ELSE
+       CALL ipslerr(3, "orchoasis_time", "END_DATE incorrectly specified in run.def", str_edate(1), str_edate(2))
+    ENDIF
+    CALL ymds2ju (e_year, e_month, e_day, e_sec, date_end)
+    CALL orchoasis_printdate(date_start, "This is after reading the end date")
+    !
+    CALL time_diff (s_year,s_month,s_day,s_sec,e_year,e_month,e_day,e_sec,diff_sec)
+    !
+    !Config Key  = DT_SECHIBA
+    !Config Desc = Time step length in seconds for Sechiba component
+    !Config Def  = 1800
+    !Config Help =
+    !Config Units = [seconds] 
+    dt = 1800
+    CALL getin('DT_SECHIBA', dt)
+    !
+    nbdt = NINT(diff_sec/dt)
+    !
+  END SUBROUTINE orchoasis_time
+!
+!=============================================================================================
+!
+  SUBROUTINE orchoasis_printpoint(julian_day, lon_pt, lat_pt, nbind, lalo, var, message, ktest)
+    !
+    REAL(r_std), INTENT(in) :: julian_day
+    REAL(r_std), INTENT(in) :: lon_pt, lat_pt
+    INTEGER(i_std), INTENT(in) :: nbind
+    REAL(r_std), INTENT(in) :: lalo(:,:)
+    REAL(r_std), INTENT(in) :: var(:)
+    CHARACTER(len=*), INTENT(in) :: message
+    INTEGER(i_std), OPTIONAL, INTENT(out) :: ktest
+    !
+    !
+    !
+    INTEGER(i_std) :: year, month, day, hours, minutes, seci
+    REAL(r_std) :: sec, mindist
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: dist, refdist
+    INTEGER(i_std) :: lon_ind, lat_ind, ind
+    INTEGER(i_std) :: i, imin(1)
+    REAL(r_std), PARAMETER :: mincos  = 0.0001
+    REAL(r_std), PARAMETER :: pi = 3.141592653589793238
+    REAL(r_std), PARAMETER :: R_Earth = 6378000.
+    !
+    ! Check if there is anything to be done
+    !
+    IF ( MAX(lon_pt, lat_pt) > 360.0 ) THEN
+       IF ( PRESENT(ktest) ) ktest = -1
+       RETURN
+    ENDIF
+    !
+    ! Allocate memory
+    !
+    ALLOCATE(dist(nbind))
+    ALLOCATE(refdist(nbind))
+    !
+    ! Convert time first
+    !
+    CALL ju2ymds (julian_day, year, month, day, sec)
+    hours = INT(sec/3600)
+    sec = sec - 3600 * hours
+    minutes = INT(sec / 60)
+    sec = sec - 60 * minutes
+    seci = INT(sec)
+    !
+    ! Get the location to be analysed
+    !
+    DO i=1,nbind
+       dist(i) = acos( sin(lat_pt*pi/180)*sin(lalo(i,1)*pi/180) + &
+            &    cos(lat_pt*pi/180)*cos(lalo(i,1)*pi/180)*cos((lalo(i,2)-lon_pt)*pi/180) ) * R_Earth
+    ENDDO
+    !
+    ! Look for the next grid point closest to the one with the smalest distance.
+    !
+    imin = MINLOC(dist)
+    DO i=1,nbind
+       refdist(i) = acos( sin(lalo(imin(1),1)*pi/180)*sin(lalo(i,1)*pi/180) + &
+            &       cos(lalo(imin(1),1)*pi/180)*cos(lalo(i,1)*pi/180) * cos((lalo(i,2)-lalo(imin(1),2))*pi/180) ) * R_Earth
+    ENDDO
+    refdist(imin(1)) =  MAXVAL(refdist)
+    mindist = MINVAL(refdist)
+    !
+    ! Are we closer than the closest points ?
+    !
+    IF ( PRESENT(ktest) ) ktest = -1
+    IF ( dist(imin(1)) <= mindist ) THEN
+       !
+       WRITE(numout,"(I2.2,':',I2.2,':',I2.2,' Loc : ', F6.1,',', F6.1,'(i=',I6,') Value = ',F12.4,A38)") &
+            & hours, minutes, seci, lalo(imin(1),2), lalo(imin(1),1), imin(1), var(imin(1)), message
+       !
+       IF ( PRESENT(ktest) ) ktest = imin(1)
+    ENDIF
+    !
+  END SUBROUTINE orchoasis_printpoint
+  !
+  !-------------------------------------------------------------------------------------------------------
+  !-
+  !- orchoasis_defvar
+  !-
+  !-------------------------------------------------------------------------------------------------------
+  SUBROUTINE orchoasis_defvar (mpi_rank, kjpindex)
+    !
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in) :: mpi_rank, kjpindex
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std)               :: ierror, tot_error
+    INTEGER(i_std), DIMENSION(3) :: ig_paral
+    INTEGER(i_std), DIMENSION(2) :: var_nodims, var_shape
+    CHARACTER(LEN=8) :: varname
+    !
+    !
+    !Config Key  = COUPLING_LANDONLY
+    !Config Desc = Specifies if the OASIS coupler will provide only data on land or on land and ocean.
+    !Config Def  = TRUE
+    !Config Help = If COUPLING_LANDONLY is set to TRUE, then ORCHIDEE expects to receive only land points
+    !              from OASIS. On the contrary data on both land and ocean will be received and the arrays
+    !              re-indexed so as to keep only land points.
+    landonly = .TRUE.
+    CALL getin('COUPLING_LANDONLY',landonly)
+    !
+    tot_error = 0
+    !
+    IF ( landonly ) THEN
+       ig_paral(1) = 1
+       ig_paral(2) = nbp_mpi_para_begin(mpi_rank)-1
+       ig_paral(3) = kjpindex
+    ELSE
+       ig_paral(1) = 1
+       ig_paral(2) = ij_para_begin(mpi_rank) - 1
+       ig_paral(3) = ij_nb
+    ENDIF
+
+    WRITE(*,*) mpi_rank, "Start and length =",  ig_paral(2:3)
+
+    CALL oasis_def_partition (il_part_id, ig_paral, ierror)
+
+    IF ( landonly ) THEN
+       var_nodims(1) = 1
+       var_nodims(2) = 1
+       var_shape(1) = 1
+       var_shape(1) = kjpindex
+    ELSE
+       var_nodims(1) = 1
+       var_nodims(2) = 1
+       var_shape(1) = 1
+       var_shape(1) = ij_nb
+    ENDIF
+    !
+    ! ORCHIDEE's Input variables
+    ! ===========================
+    !
+    !
+    ! Define levels
+    !
+    varname="HEIGHTTQ"
+    CALL oasis_def_var(zlevtq_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    varname="HEIGHTUV"
+    CALL oasis_def_var(zlevuv_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    !
+    varname="TEMPLEV1"
+    CALL oasis_def_var(tair_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    varname="HUMILEV1"
+    CALL oasis_def_var(qair_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    ! Define precipitation variables
+    !
+    varname="RAINFALL"
+    CALL oasis_def_var(rainf_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    varname="SNOWFALL"
+    CALL oasis_def_var(snowf_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    !
+    ! Define precipitation variables
+    !
+    varname="SHORTNET"
+    CALL oasis_def_var(swnet_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    varname="LONWDOWN"
+    CALL oasis_def_var(lwdown_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    varname="SOLARANG"
+    CALL oasis_def_var(solarang_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    ! Define dynamical variables
+    !
+    varname="EASTWIND"
+    CALL oasis_def_var(u_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    varname="NORTWIND"
+    CALL oasis_def_var(v_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    varname="SURFPRES"
+    CALL oasis_def_var(ps_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    varname="MODCDRAG"
+    CALL oasis_def_var(cdrag_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    ! ORCHIDEE's Output variables
+    ! ===========================
+    !
+    ! Turbulent fluxes
+    !
+    varname="TOTEVAPS"
+    CALL oasis_def_var(vevapp_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    varname="FLUXSENS"
+    CALL oasis_def_var(fluxsens_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    varname="FLUXLATE"
+    CALL oasis_def_var(fluxlat_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    ! Discharge to the oceans
+    !
+    varname="COASTFLO"
+    CALL oasis_def_var(coastal_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    varname="RIVERFLO"
+    CALL oasis_def_var(river_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    ! Carbon fluxes
+    !
+    varname="FLUNECO2"
+    CALL oasis_def_var(netco2_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    varname="FLULUCO2"
+    CALL oasis_def_var(carblu_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    ! Surface states
+    !
+    varname="TSURFRAD"
+    CALL oasis_def_var(tsolrad_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    varname="TSURFNEW"
+    CALL oasis_def_var(tsolnew_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    varname="QSURFNEW"
+    CALL oasis_def_var(qsurf_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    varname="ALBEDVIS"
+    CALL oasis_def_var(albvis_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    varname="ALBEDNIR"
+    CALL oasis_def_var(albnir_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    varname="EMISLONW"
+    CALL oasis_def_var(emis_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    varname="ROUGNESS"
+    CALL oasis_def_var(z0_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
+    tot_error = tot_error+ierror
+    !
+    IF ( tot_error .NE. 0 ) THEN
+       CALL ipslerr(3, "orchoasis_defvar", "Definition of one of the coupling variables failed.", &
+            &          "No futher information can be given at this point.", "")
+    ENDIF
+    !
+    CALL oasis_enddef (ierror)
+    !
+    IF ( ierror .NE. 0 ) THEN
+       CALL ipslerr(3, "orchoasis_defvar", "End of the definition of coupling variables failed.", &
+            &          "If OASIS has a way to decide the error status it should be put here.", "")
+    ENDIF
+    !
+  END SUBROUTINE orchoasis_defvar
+  !-------------------------------------------------------------------------------------------------------
+  !-
+  !- orchoasis_getvar
+  !-
+  !-------------------------------------------------------------------------------------------------------
+  SUBROUTINE orchoasis_getvar (itau, dt, kjpindex, landindex, zlev_tq, zlev_uv, temp_air, qair, precip_rain, &
+       &                      precip_snow, swnet, lwdown, sinang, u, v, pb, cdrag)
+    !
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in) :: itau, kjpindex
+    INTEGER(i_std), DIMENSION(kjpindex), INTENT(in) :: landindex
+    REAL(r_std), INTENT(in)    :: dt
+    !
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out) :: zlev_tq, zlev_uv, temp_air, qair, precip_rain
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out) :: precip_snow, swnet, lwdown, sinang, u, v, pb
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out) :: cdrag
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: oasis_info
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: buffer
+    !
+    ! Dimension the buffer for getting the data from OASIS according to the number of
+    ! points we will get : with or without ocean points.
+    !
+    IF ( .NOT. ALLOCATED(buffer) ) THEN
+       IF ( landonly ) THEN
+          ALLOCATE(buffer(kjpindex))
+       ELSE
+          ALLOCATE(buffer(ij_nb))
+       ENDIF
+    ENDIF
+    !
+    ! Get first the levels
+    !
+    CALL oasis_get(zlevtq_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       zlev_tq = buffer
+    ELSE
+       zlev_tq = buffer(landindex)
+    ENDIF
+    CALL oasis_get(zlevuv_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       zlev_uv = buffer
+    ELSE
+       zlev_uv = buffer(landindex)
+    ENDIF
+    !
+    ! Get atmospheric state variables
+    !
+    CALL oasis_get(tair_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       temp_air = buffer
+    ELSE
+       temp_air = buffer(landindex)
+    ENDIF
+    CALL oasis_get(qair_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       qair = buffer
+    ELSE
+       qair = buffer(landindex)
+    ENDIF
+    !
+    ! Get precipitation fluxes
+    !
+    CALL oasis_get(rainf_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       precip_rain = buffer
+    ELSE
+       precip_rain = buffer(landindex)
+    ENDIF
+    CALL oasis_get(snowf_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       precip_snow = buffer
+    ELSE
+       precip_snow = buffer(landindex)
+    ENDIF
+    !
+    ! Get Radiation fluxes
+    !
+    CALL oasis_get(swnet_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       swnet = buffer
+    ELSE
+       swnet = buffer(landindex)
+    ENDIF
+    CALL oasis_get(lwdown_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       lwdown = buffer
+    ELSE
+       lwdown = buffer(landindex)
+    ENDIF
+    CALL oasis_get(solarang_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       sinang = buffer
+    ELSE
+       sinang = buffer(landindex)
+    ENDIF
+    !
+    ! Get dynamical variables
+    !
+    CALL oasis_get(u_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       u = buffer
+    ELSE
+       u = buffer(landindex)
+    ENDIF
+    CALL oasis_get(v_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       v = buffer
+    ELSE
+       v = buffer(landindex)
+    ENDIF
+    CALL oasis_get(ps_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       pb = buffer
+    ELSE
+       pb = buffer(landindex)
+    ENDIF
+    CALL oasis_get(cdrag_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       cdrag = buffer
+    ELSE
+       cdrag = buffer(landindex)
+    ENDIF
+    !
+  END SUBROUTINE orchoasis_getvar
+  !
+  !-------------------------------------------------------------------------------------------------------
+  !-
+  !- orchoasis_putvar
+  !-
+  !-------------------------------------------------------------------------------------------------------
+  SUBROUTINE orchoasis_putvar(itau, dt, kjpindex, landindex, vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
+       &                      netco2, carblu, tsol_rad, temp_sol_new, qsurf, albedo, emis, z0)
+    !
+    ! ARGUMENTS
+    !
+    INTEGER(i_std), INTENT(in) :: itau, kjpindex
+    INTEGER(i_std), DIMENSION(kjpindex), INTENT(in) :: landindex
+    REAL(r_std), INTENT(in)    :: dt
+    !
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: vevapp, fluxsens, fluxlat, coastalflow, riverflow
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: netco2, carblu, tsol_rad, temp_sol_new, qsurf, emis, z0
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT(in) :: albedo
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: oasis_info
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: buffer
+    !
+    IF ( .NOT. ALLOCATED(buffer) ) THEN
+       IF ( landonly ) THEN
+          ALLOCATE(buffer(kjpindex))
+       ELSE
+          ALLOCATE(buffer(ij_nb))
+       ENDIF
+    ENDIF
+    !
+    ! Set all points to undef. This is the value which will remain over ocean points.
+    !
+    buffer(:) = undef_sechiba
+    !
+    ! Turbulent fluxes
+    !
+    IF ( landonly ) THEN
+       buffer(:) = vevapp(:)
+    ELSE
+       buffer(landindex(:)) = vevapp(:)
+    ENDIF
+    CALL oasis_put(vevapp_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       buffer(:) = fluxsens(:)
+    ELSE
+       buffer(landindex(:)) = fluxsens(:)
+    ENDIF
+    CALL oasis_put(fluxsens_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       buffer(:) = fluxlat(:)
+    ELSE
+       buffer(landindex(:)) = fluxlat(:)
+    ENDIF
+    CALL oasis_put(fluxlat_id, NINT(itau*dt), buffer, oasis_info)
+    !
+    ! Water fluxes to the ocean
+    !
+    IF ( landonly ) THEN
+       buffer(:) = coastalflow(:)
+    ELSE
+       buffer(landindex(:)) = coastalflow(:)
+    ENDIF
+    CALL oasis_put(coastal_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       buffer(:) = riverflow(:)
+    ELSE
+       buffer(landindex(:)) = riverflow(:)
+    ENDIF
+    CALL oasis_put(river_id, NINT(itau*dt), buffer, oasis_info)
+    !
+    ! Carbon
+    !
+    IF ( landonly ) THEN
+       buffer(:) = netco2(:)
+    ELSE
+       buffer(landindex(:)) = netco2(:)
+    ENDIF
+    CALL oasis_put(netco2_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       buffer(:) = carblu(:)
+    ELSE
+       buffer(landindex(:)) = carblu(:)
+    ENDIF
+    CALL oasis_put(carblu_id, NINT(itau*dt), buffer, oasis_info)
+    !
+    ! Surface conditions
+    !
+    IF ( landonly ) THEN
+       buffer(:) = tsol_rad(:)
+    ELSE
+       buffer(landindex(:)) = tsol_rad(:)
+    ENDIF
+    CALL oasis_put(tsolrad_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       buffer(:) = temp_sol_new(:)
+    ELSE
+       buffer(landindex(:)) = temp_sol_new(:)
+    ENDIF
+    CALL oasis_put(tsolnew_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       buffer(:) = qsurf(:)
+    ELSE
+       buffer(landindex(:)) = qsurf(:)
+    ENDIF
+    CALL oasis_put(qsurf_id, NINT(itau*dt), buffer, oasis_info)
+    !
+    ! Other surface conditions
+    !
+    IF ( landonly ) THEN
+       buffer(:) = albedo(:,ivis)
+    ELSE
+       buffer(landindex(:)) = albedo(:,ivis)
+    ENDIF
+    CALL oasis_put(albvis_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       buffer(:) = albedo(:,inir)
+    ELSE
+       buffer(landindex(:)) = albedo(:,inir)
+    ENDIF
+    CALL oasis_put(albnir_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       buffer(:) = emis(:)
+    ELSE
+       buffer(landindex(:)) = emis(:)
+    ENDIF
+    CALL oasis_put(emis_id, NINT(itau*dt), buffer, oasis_info)
+    IF ( landonly ) THEN
+       buffer(:) = z0(:)
+    ELSE
+       buffer(landindex(:)) = z0(:)
+    ENDIF
+    CALL oasis_put(z0_id, NINT(itau*dt), buffer, oasis_info)
+    !
+  END SUBROUTINE orchoasis_putvar
+!
+!=============================================================================================
+!
+  SUBROUTINE orchoasis_printdate(julian_day, message)
+    !
+    REAL(r_std), INTENT(in) :: julian_day
+    CHARACTER(len=*), INTENT(in) :: message
+    !
+    !
+    !
+    INTEGER(i_std) :: year, month, day, hours, minutes, seci
+    REAL(r_std) :: sec
+    !
+    CALL ju2ymds (julian_day, year, month, day, sec)
+    hours = INT(sec/3600)
+    sec = sec - 3600 * hours
+    minutes = INT(sec / 60)
+    sec = sec - 60 * minutes
+    seci = INT(sec)
+    !
+    WRITE(*,'(I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2," > ", A60)') &
+         &            year, month, day, hours, minutes, seci, message
+    !
+  END SUBROUTINE orchoasis_printdate
+  !
+  !
+#endif
+END MODULE orchoasis_tools
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/AA_make
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/AA_make	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/AA_make	(revision 6412)
@@ -0,0 +1,165 @@
+#-
+#- $Id$
+#-
+MODS1 = mod_orchidee_para_var.F90 \
+        xios_orchidee.f90 \
+        mod_orchidee_mpi_data.F90 \
+	mod_orchidee_omp_data.F90 \
+	timer.f90 \
+        mod_orchidee_mpi_transfert.F90 \
+        mod_orchidee_omp_transfert.F90 \
+        mod_orchidee_transfert_para.F90 \
+        mod_orchidee_para.F90 \
+	tools_para.f90 \
+	ioipsl_para.f90 \
+	orch_write_field.f90 \
+        orch_write_field_p.f90
+
+
+PARAM_LIB=$(LIBDIR)/libparameters.a
+FILTERf90=$(filter %.f90,$(MODS1))
+FILTERF90=$(filter %.F90,$(MODS1))
+OBJSMODS1=$(FILTERf90:.f90=.o) $(FILTERF90:.F90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) m_all
+	@echo parallel is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+#-Q- intel m_all: WORK_MOD $(MODEL_LIB)($(OBJSMODS1))
+
+$(MODEL_LIB)(%.o) : %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+#-Q- intel
+#-Q- intel WORK_MOD :
+#-Q- intel 	$(RM) work.pcl
+#-Q- intel 	@echo "work.pc" > work.pcl
+#-Q- intel 	@echo "../src_parameters/work.pc" >> work.pcl
+#-Q- intel 	@echo "../src_stomate/work.pc" >> work.pcl
+#-Q- intel 	@echo "../../IOIPSL/src/work.pc" >> work.pcl
+
+$(MODEL_LIB)(%.o) : %.F90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.F90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+
+
+$(PARAM_LIB)(pft_parameters_var.o) : ../src_parameters/pft_parameters_var.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) ../src_parameters/pft_parameters_var.f90
+	$(A_C) $(PARAM_LIB) pft_parameters_var.o
+	$(A_C) $(ORCHIDEE_LIB) pft_parameters_var.o
+	$(RM) ../src_parallel/pft_parameters_var.o
+
+$(PARAM_LIB)(constantes_var.o) : ../src_parameters/constantes_var.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) ../src_parameters/constantes_var.f90
+	$(A_C) $(PARAM_LIB) constantes_var.o
+	$(A_C) $(ORCHIDEE_LIB) constantes_var.o
+	$(RM) ../src_parallel/constantes_var.o
+
+$(PARAM_LIB)(vertical_soil_var.o) : ../src_parameters/vertical_soil_var.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) ../src_parameters/vertical_soil_var.f90
+	$(A_C) $(PARAM_LIB) vertical_soil_var.o
+	$(A_C) $(ORCHIDEE_LIB) vertical_soil_var.o
+	$(RM) ../src_parallel/vertical_soil_var.o
+
+$(PARAM_LIB)(constantes_soil_var.o) : ../src_parameters/constantes_soil_var.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) ../src_parameters/constantes_soil_var.f90
+	$(A_C) $(PARAM_LIB) constantes_soil_var.o
+	$(A_C) $(ORCHIDEE_LIB) constantes_soil_var.o
+	$(RM) ../src_parallel/constantes_soil_var.o
+
+config : 
+	$(BINDIR)/Fparser -name PARALLEL $(MODS1)
+	echo 'Configuration of PARALLEL done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(mpi_dummy.o):
+
+$(MODEL_LIB)(mod_orchidee_para_var.o):
+
+$(MODEL_LIB)(xios_orchidee.o): \
+       $(MODEL_LIB)(mod_orchidee_para_var.o) \
+       $(MODEL_LIB)(mod_orchidee_transfert_para.o) \
+       $(MODEL_LIB)(ioipsl_para.o) \
+       $(PARAM_LIB)(pft_parameters_var.o) \
+       $(PARAM_LIB)(constantes_var.o) \
+       $(PARAM_LIB)(vertical_soil_var.o) \
+       $(PARAM_LIB)(constantes_soil_var.o)
+
+$(MODEL_LIB)(mod_orchidee_mpi_data.o): \
+    $(MODEL_LIB)(mod_orchidee_para_var.o) \
+    $(MODEL_LIB)(xios_orchidee.o) 
+
+$(MODEL_LIB)(mod_orchidee_omp_data.o): \
+    $(MODEL_LIB)(mod_orchidee_para_var.o)
+
+$(MODEL_LIB)(timer.o): \
+    $(MODEL_LIB)(mod_orchidee_para_var.o)
+
+$(MODEL_LIB)(orch_write_field.o): \
+    $(MODEL_LIB)(mod_orchidee_para.o)
+
+$(MODEL_LIB)(write_field.o): \
+    $(MODEL_LIB)(orch_write_field.o)
+
+$(MODEL_LIB)(mod_orchidee_mpi_transfert.o): \
+  $(MODEL_LIB)(mod_orchidee_para_var.o) \
+  $(MODEL_LIB)(timer.o)
+
+$(MODEL_LIB)(mod_orchidee_omp_transfert.o): \
+  $(MODEL_LIB)(mod_orchidee_omp_data.o)
+
+$(MODEL_LIB)(mod_orchidee_transfert_para.o): \
+  $(MODEL_LIB)(mod_orchidee_para_var.o) \
+  $(MODEL_LIB)(mod_orchidee_mpi_transfert.o) \
+  $(MODEL_LIB)(mod_orchidee_omp_transfert.o)
+
+$(MODEL_LIB)(mod_orchidee_para.o): \
+  $(MODEL_LIB)(mod_orchidee_mpi_data.o) \
+  $(MODEL_LIB)(mod_orchidee_omp_data.o) \
+  $(MODEL_LIB)(mod_orchidee_transfert_para.o)
+
+$(MODEL_LIB)(ioipsl_para.o): \
+  $(MODEL_LIB)(mod_orchidee_transfert_para.o) \
+  $(MODEL_LIB)(mod_orchidee_para_var.o)
+
+$(MODEL_LIB)(tools_para.o): \
+  $(MODEL_LIB)(mod_orchidee_para_var.o)
+
+$(MODEL_LIB)(orch_write_field_p.o): \
+  $(MODEL_LIB)(mod_orchidee_para.o)
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/AA_make.ldef
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/AA_make.ldef	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/AA_make.ldef	(revision 6412)
@@ -0,0 +1,20 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a PARALLEL
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+ORDIR  = ..
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/libparallel.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxparallel.a
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/ioipsl_para.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/ioipsl_para.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/ioipsl_para.f90	(revision 6412)
@@ -0,0 +1,1382 @@
+! ==============================================================================================================================
+! MODULE   : ioipls_para
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF          Overlap of IOIPSL functions for specific parallel use in ORCHIDEE.
+!!
+!!\n DESCRIPTION: This module contains interfaces for some IOIPSL subroutines adapted to be used in parallel mode by ORCHIDEE. 
+!!
+!!                 Following interfaces are available :
+!!                  - getin_p : Read a variable from run.def file. The master process will call getin in IOIPSL. 
+!!                              The same result will be known by all processes after the call. 
+!!                              The variable can be an integer, real, logical or character string. It can be a scalar or 
+!!                              have 1 or 2 dimensions except for character string which can only be scalar or have 1 dimension. 
+!!                  - restget_p :   Read a variable from restart file. The master process will call the subroutine restget in IOIPSL. 
+!!                                  The variable will be distributed on the local domain for each process. 
+!!                                  The variable must be a real and can have 1, 2 or 3 dimensions. It can not be a scalar.
+!!                  - restput_p :   Write a variable to restart file. The master process will call the subroutine restput in IOIPSL. 
+!!                                  The input variable must be given on the local domain for each process.
+!!                                  The variable must be a real and can have 1, 2 or 3 dimensions. It can not be a scalar.
+!!                  - histwrite_p : Write a variable to history file. The master process will call the subroutine histwrite in IOIPSL. 
+!!                                  The input variable must be given on the local domain for each process. 
+!!                                  The variable must be a real and can have 1, 2 or 3 dimensions. It can not be a scalar.
+!!
+!!                 Note that these subroutines must be called by all MPI processes and all OMP thredds because they contain 
+!!                 all a MPI blocker function. 
+!!                    
+!!                    
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ ==============================================================================================================================
+  
+  MODULE ioipsl_para
+  USE ioipsl
+  USE mod_orchidee_para_var
+  USE mod_orchidee_transfert_para
+  USE constantes_var
+!-
+  IMPLICIT NONE
+
+  INTEGER, SAVE :: orch_domain_id 
+!-
+   INTEGER :: orch_ipslout=6, orch_ilv_cur=0, orch_ilv_max=0
+!$OMP THREADPRIVATE( orch_ipslout, orch_ilv_cur, orch_ilv_max )
+
+!-
+!-
+#include "src_parallel.h"
+!-
+  !! ============================================================================================================================
+  !! INTERFACE    : getin_p
+  !!
+  !>\BRIEF          interface to parallelize the call to getin in IOIPSL
+  !!
+  !! DESCRIPTION  : get a variable from a text input file. Needs to be called by all processes
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  INTERFACE getin_p
+    MODULE PROCEDURE getin_p_c,getin_p_c1,   &
+         getin_p_i,getin_p_i1,getin_p_i2,&
+         getin_p_r,getin_p_r1,getin_p_r2,&
+         getin_p_l,getin_p_l1,getin_p_l2
+  END INTERFACE
+!-
+  !! ============================================================================================================================
+  !! INTERFACE    : restput_p
+  !! 
+  !>\BRIEF          interface to parallelize the call to restput in IOIPSL
+  !!
+  !! DESCRIPTION  : allows to re-index data onto the original grid of the restart file. Need to be call by all process
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  INTERFACE restput_p
+     MODULE PROCEDURE &
+          restput_p_r3d, restput_p_r2d, restput_p_r1d, &
+          restput_p_opp_r5d, restput_p_opp_r4d, restput_p_opp_r3d, &
+          restput_p_opp_r2d, restput_p_opp_r1d, restput_p_nogrid_r1d, &
+          restput_p_nogrid_i_scal, restput_p_nogrid_r_scal
+  END INTERFACE
+!-
+  !! ============================================================================================================================ 
+  !! INTERFACE    : restget_p 
+  !! 
+  !>\BRIEF          interface to parallelize the call to restget in IOIPSL      
+  !! 
+  !! DESCRIPTION  : Transform the data from the restart file onto the model grid.  
+  !! 
+  !! \n 
+  !_ ============================================================================================================================ 
+
+  INTERFACE restget_p
+     MODULE PROCEDURE &
+          restget_p_r3d, restget_p_r2d, restget_p_r1d, &
+          restget_p_opp_r5d, restget_p_opp_r4d, restget_p_opp_r3d, &
+          restget_p_opp_r2d, restget_p_opp_r1d, restget_p_nogrid_r1d, &
+          restget_p_nogrid_r_scal, restget_p_nogrid_i_scal
+  END INTERFACE
+!-
+  !! ============================================================================================================================ 
+  !! INTERFACE    : histwrite_p 
+  !! 
+  !>\BRIEF          interface to parallelize the call to histwrite in IOIPSL 
+  !! 
+  !! DESCRIPTION  : give the data to the IOIPSL system (if we don't use XIOS). Needs to be call by all process 
+  !! 
+  !! \n 
+  !_ ============================================================================================================================
+
+  INTERFACE histwrite_p
+     MODULE PROCEDURE &
+     histwrite_r1d_p,histwrite_r2d_p,histwrite_r3d_p     
+  END INTERFACE
+
+CONTAINS
+
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : Init_ioipsl_para
+  !!
+  !>\BRIEF          call to IOIPSL routine : flio_dom_set
+  !!
+  !! DESCRIPTION  : Sets up the domain activity of IOIPSL. Needs to be call by all process
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE Init_ioipsl_para
+
+    IMPLICIT NONE
+    
+    INTEGER,DIMENSION(2) :: ddid
+    INTEGER,DIMENSION(2) :: dsg
+    INTEGER,DIMENSION(2) :: dsl
+    INTEGER,DIMENSION(2) :: dpf
+    INTEGER,DIMENSION(2) :: dpl
+    INTEGER,DIMENSION(2) :: dhs
+    INTEGER,DIMENSION(2) :: dhe 
+
+    IF (is_omp_root) THEN
+      ddid=(/ 1,2 /)
+      dsg=(/ iim_g, jjm_g /)
+      dsl=(/ iim_g, jj_nb /)
+      dpf=(/ 1,jj_begin /)
+      dpl=(/ iim_g, jj_end /)
+      dhs=(/ ii_begin-1,0 /)
+      if (mpi_rank==mpi_size-1) then
+        dhe=(/0,0/)
+      else
+         dhe=(/ iim_g-ii_end,0 /)  
+      endif
+    
+      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
+                        'APPLE',orch_domain_id)
+     ENDIF
+     
+  END SUBROUTINE Init_ioipsl_para
+
+  !! =============================================================================================================================
+  !! SUBROUTINE   : ioconf_setatt_p
+  !!
+  !>\BRIEF          parallelisation of the call to IOIPSL routine ioconf_setatt 
+  !!
+  !! DESCRIPTION  : NONE
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE ioconf_setatt_p (attname,attvalue)
+    !---------------------------------------------------------------------
+    IMPLICIT NONE
+    !-
+    CHARACTER(LEN=*), INTENT(in) :: attname,attvalue
+    !---------------------------------------------------------------------
+
+    IF (is_root_prc) THEN 
+       CALL ioconf_setatt(attname,attvalue)
+    ENDIF
+
+  END SUBROUTINE ioconf_setatt_p
+
+  !! =============================================================================================================================
+  !! SUBROUTINE   : ipslnlf_p
+  !!
+  !>\BRIEF          parallelisation of the call to IOIPSL routine ipslnlf
+  !!
+  !! DESCRIPTION  : The "ipslnlf" routine allows to know and modify the current logical number for the messages.
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE ipslnlf_p (new_number,old_number)
+    !!--------------------------------------------------------------------
+    !! SUBROUTINE ipslnlf (new_number,old_number)
+    !!
+    !! Optional INPUT argument
+    !!
+    !! (I) new_number : new logical number of the file
+    !!
+    !! Optional OUTPUT argument
+    !!
+    !! (I) old_number : current logical number of the file
+    !!--------------------------------------------------------------------
+    IMPLICIT NONE
+    !-
+    INTEGER,OPTIONAL,INTENT(IN)  :: new_number
+    INTEGER,OPTIONAL,INTENT(OUT) :: old_number
+    !---------------------------------------------------------------------
+    IF (PRESENT(old_number)) THEN
+
+#ifndef CPP_OMP
+       CALL ipslnlf(old_number=orch_ipslout)
+#endif
+       old_number = orch_ipslout
+    ENDIF
+    IF (PRESENT(new_number)) THEN
+       orch_ipslout = new_number
+#ifndef CPP_OMP
+       CALL ipslnlf(new_number=orch_ipslout)
+#endif
+    ENDIF
+  END SUBROUTINE ipslnlf_p
+
+  !! =============================================================================================================================
+  !! SUBROUTINE   : ipslerr_p
+  !!
+  !>\BRIEF          allows to handle the messages to the user.    
+  !!
+  !! DESCRIPTION  : NONE
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+  !===
+  SUBROUTINE ipslerr_p (plev,pcname,pstr1,pstr2,pstr3)
+    !---------------------------------------------------------------------
+    !! The "ipslerr_p" routine
+    !! allows to handle the messages to the user.
+    !!
+    !! parallel version of IOIPSL ipslerr
+    !!
+    !! INPUT
+    !!
+    !! plev   : Category of message to be reported to the user
+    !!          1 = Note to the user
+    !!          2 = Warning to the user
+    !!          3 = Fatal error
+    !! pcname : Name of subroutine which has called ipslerr
+    !! pstr1   
+    !! pstr2  : Strings containing the explanations to the user
+    !! pstr3
+    !---------------------------------------------------------------------
+    IMPLICIT NONE
+    !-
+    INTEGER :: plev
+    CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+    !-
+    CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+         &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+         &     "WARNING FROM ROUTINE          ", &
+         &     "FATAL ERROR FROM ROUTINE      " /)
+    !---------------------------------------------------------------------
+    IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+       orch_ilv_cur = plev
+       orch_ilv_max = MAX(orch_ilv_max,plev)
+       WRITE(orch_ipslout,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+       WRITE(orch_ipslout,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
+    ENDIF
+    IF (plev == 3) THEN
+       WRITE(orch_ipslout,'("Fatal error from ORCHIDEE. STOP in ipslerr_p with code")')
+
+#if defined (__INTEL_COMPILER) || defined(__GFORTRAN__)
+       CALL FLUSH(orch_ipslout)
+#endif 
+#ifdef CPP_PARA
+       CALL MPI_ABORT(plev)
+#endif     
+       STOP 1
+    ENDIF
+
+  END SUBROUTINE ipslerr_p
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : getin_p_c 
+  !!
+  !>\BRIEF          get a character variable in text input file      
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes         
+  !!
+  !! \n
+  !_ ============================================================================================================================
+  
+  SUBROUTINE getin_p_c(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    CHARACTER(LEN=*),INTENT(INOUT) :: VarOut    
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_c  
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : getin_p_c1 
+  !!
+  !>\BRIEF          get a character 1D array in text input file 
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes 
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE getin_p_c1(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    CHARACTER(LEN=*),INTENT(INOUT) :: VarOut(:)    
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_c1 
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : getin_p_i  
+  !!
+  !>\BRIEF          get an integer variable in text input file     
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes 
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  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 
+  !!
+  !>\BRIEF          get an integer 1D array in text input file 
+  !!
+  !! DESCRIPTION  : Needs to be called by all process 
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  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 
+  !!
+  !>\BRIEF          get an integer 2D array in text input file        
+  !!
+  !! DESCRIPTION  : Needs to be called by all process         
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  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
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : getin_p_r
+  !!
+  !>\BRIEF          get a float variable in text input file                
+  !!
+  !! DESCRIPTION  : Need to be call by all process 
+  !!
+  !! \n
+  !_ ============================================================================================================================
+ 
+  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 
+  !!
+  !>\BRIEF          get a float 1D array in text input file  
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes 
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  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 
+  !!
+  !>\BRIEF          get a float 2D array in text input file  
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes  
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  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
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : getin_p_l 
+  !!
+  !>\BRIEF          get a logical variable in text input file 
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes 
+  !!
+  !! \n
+  !_ ============================================================================================================================
+  
+  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
+  !!
+  !>\BRIEF          get a logical 1D array in text input file        
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  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 
+  !!
+  !>\BRIEF          get a logical 2D array in text input file 
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  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 
+  !!
+  !>\BRIEF          Transform the data (real 1D) from the restart file onto the model grid with the operation MY_OPERATOR
+  !!
+  !! DESCRIPTION  : do not use this function with non grid variable
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restget_p_opp_r1d &
+  (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+   var, MY_OPERATOR, nbindex, ijndex)
+! DO NOT USE THIS FUNCTION WITH NON GRID VARIABLE !
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL def_beha
+    REAL :: var(:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+       ALLOCATE( temp_g(1) )
+    ENDIF
+        
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+            temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_opp_r1d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restget_p_opp_r2d 
+  !! 
+  !>\BRIEF          Transform the data (real 2D) from the restart file onto the model grid with the operation MY_OPERATOR  
+  !! 
+  !! DESCRIPTION  : do not use this function with non grid variable.  Needs to be called by all processes. 
+  !! 
+  !! \n 
+  !_ ============================================================================================================================
+
+  SUBROUTINE restget_p_opp_r2d &
+  (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+   var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+    !-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL def_beha
+    REAL :: var(:,:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim,jjm) )
+    ELSE
+      ALLOCATE( temp_g(1,1) )
+    ENDIF
+
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+            temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_opp_r2d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restget_p_opp_r3d
+  !!
+  !>\BRIEF          Transform the data (real 3D) from the restart file onto the model grid with the operation MY_OPERATOR
+  !!
+  !! DESCRIPTION  : do not use this function with non grid variable. 
+  !!
+  !! \n
+  !_ ============================================================================================================================ 
+
+  SUBROUTINE restget_p_opp_r3d &
+  (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,llm) )
+    ELSE
+      ALLOCATE( temp_g(1,1,1) )
+    ENDIF
+
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+            temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+
+  END SUBROUTINE restget_p_opp_r3d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restget_p_opp_r4d
+  !!
+  !>\BRIEF          Transform the data (real 4D) from the restart file onto the model grid with the operation MY_OPERATOR
+  !!
+  !! DESCRIPTION  : do not use this function with non grid variable.  
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restget_p_opp_r4d &
+  (fid, vname_q, iim, jjm, llm, zzm, itau, def_beha, &
+   var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+    !-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, zzm, 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,zzm) )
+    ELSE
+      ALLOCATE( temp_g(1,1,1,1) )
+    ENDIF
+
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid, vname_q, iim, jjm, llm, zzm, itau, def_beha,  &
+            temp_g, MY_OPERATOR, nbindex, ijndex)
+   ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+
+  END SUBROUTINE restget_p_opp_r4d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restget_p_opp_r5d
+  !!
+  !>\BRIEF          Transform the data (real 5D) from the restart file onto the model grid with the operation MY_OPERATOR
+  !!
+  !! DESCRIPTION  : do not use this function with non grid variable.  
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restget_p_opp_r5d &
+  (fid, vname_q, iim, jjm, llm, zzm, wwm, itau, def_beha, &
+   var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+    !-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, zzm, wwm, 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,zzm,wwm) )
+    ELSE
+      ALLOCATE( temp_g(1,1,1,1,1) )
+    ENDIF
+
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid, vname_q, iim, jjm, llm, zzm, wwm, itau, def_beha,  &
+            temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+
+  END SUBROUTINE restget_p_opp_r5d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restget_p_r1d
+  !!
+  !>\BRIEF          Transform the data (real 1D) from the restart file onto the model grid   
+  !!
+  !! DESCRIPTION  : do not use this function with non grid variable.  Needs to be called by all processes.
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restget_p_r1d &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+! DO NOT USE THIS FUNCTION WITH NON GRID VARIABLE !
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL :: def_beha
+    REAL :: var(:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+       ALLOCATE( temp_g(1) )
+    ENDIF
+
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
+    ENDIF
+    CALL scatter2D_mpi(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_r1d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restget_p_r2d
+  !!
+  !>\BRIEF          Transform the data (real 2D) from the restart file onto the model grid   
+  !!
+  !! DESCRIPTION  : do not use this function with non grid variable.  Needs to be called by all processes.
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restget_p_r2d &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL :: def_beha
+    REAL :: var(:,:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim,jjm) )
+    ELSE
+       ALLOCATE( temp_g(1,1) )
+    ENDIF
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
+    ENDIF
+    CALL scatter2D_mpi(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_r2d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restget_p_r3d
+  !!
+  !>\BRIEF          Transform the data (real 3D) from the restart file onto the model grid
+  !!
+  !! DESCRIPTION  : do not use this function with non grid variable.  Needs to be called by all processes.
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restget_p_r3d &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL def_beha
+    REAL :: var(:,:,:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:,:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim,jjm,llm) )
+    ELSE 
+       ALLOCATE( temp_g(1,1,1) )
+    ENDIF
+    
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
+    ENDIF
+    CALL scatter2D_mpi(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_r3d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restget_p_nogrid_r1d
+  !!
+  !>\BRIEF          
+  !!
+  !! DESCRIPTION  : 
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restget_p_nogrid_r1d &
+  (fid,vname_q,itau,def_beha,def_val,var)
+! 
+    IMPLICIT NONE
+!-
+    INTEGER, INTENT(in)             :: fid
+    CHARACTER(LEN=*), INTENT(in)    :: vname_q
+    INTEGER, INTENT(in)             :: itau
+    LOGICAL, INTENT(in)             :: def_beha
+    REAL, INTENT(in)                :: def_val
+    REAL, DIMENSION(:), INTENT(out) :: var
+    !-------------------------
+    IF (is_root_prc) THEN
+       var = val_exp
+       CALL restget (fid, vname_q, 1 ,1  , 1, itau, def_beha, var)
+       IF(ALL(var == val_exp)) var = def_val 
+    ENDIF
+    CALL bcast(var)
+
+  END SUBROUTINE restget_p_nogrid_r1d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restget_p_nogrid_r_scal
+  !!
+  !>\BRIEF          
+  !!
+  !! DESCRIPTION  : 
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restget_p_nogrid_r_scal &
+  (fid,vname_q,itau,def_beha,def_val,var)
+! 
+    IMPLICIT NONE
+!-
+    INTEGER, INTENT(in)             :: fid
+    CHARACTER(LEN=*), INTENT(in)    :: vname_q
+    INTEGER, INTENT(in)             :: itau
+    LOGICAL, INTENT(in)             :: def_beha
+    REAL, INTENT(in)                :: def_val
+    REAL, INTENT(out) :: var
+    !-------------------------
+    REAL, DIMENSION(1) :: tmp
+
+    tmp(1) = var
+    IF (is_root_prc) THEN
+       var = val_exp
+       CALL restget (fid, vname_q, 1 ,1  , 1, itau, def_beha, tmp)
+       var = tmp(1)
+       IF(var == val_exp) var = def_val 
+    ENDIF
+    CALL bcast(var)
+
+  END SUBROUTINE restget_p_nogrid_r_scal
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restget_p_nogrid_i_scal
+  !!
+  !>\BRIEF
+  !!
+  !! DESCRIPTION  :
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restget_p_nogrid_i_scal &
+  (fid,vname_q,itau,def_beha,def_val,varint)
+! 
+    IMPLICIT NONE
+!-
+    INTEGER, INTENT(in)             :: fid
+    CHARACTER(LEN=*), INTENT(in)    :: vname_q
+    INTEGER, INTENT(in)             :: itau
+    LOGICAL, INTENT(in)             :: def_beha
+    REAL, INTENT(in)                :: def_val
+    INTEGER, INTENT(out) :: varint
+    !-------------------------
+    REAL :: tmp
+
+    CALL restget_p_nogrid_r_scal(fid, vname_q, itau, def_beha, def_val, tmp)
+    varint = INT(tmp)
+  END SUBROUTINE restget_p_nogrid_i_scal
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restput_p_opp_r1d 
+  !!
+  !>\BRIEF          allows to re-index data (real 1D) onto the original grid of the restart file with the operation MY_OPERATOR       
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restput_p_opp_r1d &
+  (fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
+
+    IF (is_root_prc) THEN 
+      ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+      ALLOCATE ( temp_g(1) )
+    ENDIF
+    
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput &
+            (fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_opp_r1d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restput_p_opp_r2d
+  !!
+  !>\BRIEF          allows to re-index data (real 2D) onto the original grid of the restart file with the operation MY_OPERATOR
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restput_p_opp_r2d &
+  (fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:,:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim,jjm) )
+    ELSE
+      ALLOCATE( temp_g(1,1) )
+    ENDIF
+          
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput &
+            (fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_opp_r2d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restput_p_opp_r3d
+  !!
+  !>\BRIEF          allows to re-index data (real 3D) onto the original grid of the restart file with the operation MY_OPERATOR
+  !!
+  !! DESCRIPTION  :   
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restput_p_opp_r3d &
+  (fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:,:,:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:,:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim,jjm,llm) )
+    ELSE
+      ALLOCATE( temp_g(1,1,1) )
+    ENDIF
+          
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput &
+            (fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    DEALLOCATE( temp_g )
+
+          
+  END SUBROUTINE restput_p_opp_r3d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restput_p_opp_r4d
+  !!
+  !>\BRIEF          allows to re-index data (real 4D) onto the original grid of the restart file with the operation MY_OPERATOR
+  !!
+  !! DESCRIPTION  :   
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restput_p_opp_r4d &
+  (fid, vname_q, iim, jjm, llm, zzm, itau, var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, zzm, itau
+    REAL :: var(:,:,:,:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim,jjm,llm,zzm) )
+    ELSE
+      ALLOCATE( temp_g(1,1,1,1) )
+    ENDIF
+          
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput &
+            (fid, vname_q, iim, jjm, llm, zzm, itau, &
+                 temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    DEALLOCATE( temp_g )
+
+          
+  END SUBROUTINE restput_p_opp_r4d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restput_p_opp_r5d
+  !!
+  !>\BRIEF          allows to re-index data (real 5D) onto the original grid of the restart file with the operation MY_OPERATOR
+  !!
+  !! DESCRIPTION  :
+  !! \n
+  !_ ============================================================================================================================
+  
+  SUBROUTINE restput_p_opp_r5d &
+  (fid, vname_q, iim, jjm, llm, zzm, wwm, itau, var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, zzm, wwm, itau
+    REAL :: var(:,:,:,:,:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim,jjm,llm,zzm,wwm) )
+    ELSE
+      ALLOCATE( temp_g(1,1,1,1,1) )
+    ENDIF
+          
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput &
+            (fid, vname_q, iim, jjm, llm, zzm, wwm, itau, &
+                 temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    DEALLOCATE( temp_g )
+
+          
+  END SUBROUTINE restput_p_opp_r5d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restput_p_r1d
+  !!
+  !>\BRIEF          allows to re-index data (real 1D) onto the original grid of the restart file
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restput_p_r1d (fid,vname_q,iim,jjm,llm,itau,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+      ALLOCATE( temp_g(1) )
+    ENDIF
+    
+    CALL gather2D_mpi(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_r1d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restput_p_r2d
+  !!
+  !>\BRIEF          allows to re-index data (real 2D) onto the original grid of the restart file
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restput_p_r2d (fid,vname_q,iim,jjm,llm,itau,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:,:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim,jjm) )
+    ELSE
+      ALLOCATE( temp_g(1,1) )
+    ENDIF
+    
+    CALL gather2D_mpi(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_r2d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restput_p_r3d
+  !!
+  !>\BRIEF          allows to re-index data (real 3D) onto the original grid of the restart file
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes
+  !!
+  !! \n
+  !_ ============================================================================================================================ 
+
+  SUBROUTINE restput_p_r3d (fid,vname_q,iim,jjm,llm,itau,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:,:,:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:,:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim,jjm,llm) )
+    ELSE
+      ALLOCATE( temp_g(1,1,1) )
+    ENDIF
+    
+    CALL gather2D_mpi(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_r3d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restput_p_nogrid_r1d
+  !!
+  !>\BRIEF          
+  !!
+  !! DESCRIPTION  : 
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restput_p_nogrid_r1d (fid,vname_q,itau,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: itau
+    REAL,DIMENSION(:) :: var
+    !-----------------------------
+
+    IF (is_root_prc) THEN
+       CALL restput (fid, vname_q, 1, 1, 1, itau, var)
+    ENDIF
+
+  END SUBROUTINE restput_p_nogrid_r1d
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restput_p_nogrid_r_scal
+  !!
+  !>\BRIEF          
+  !!
+  !! DESCRIPTION  : 
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restput_p_nogrid_r_scal (fid,vname_q,itau,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: itau
+    REAL :: var
+    !-----------------------------
+    REAL :: xtmp(1)
+
+    IF (is_root_prc) THEN
+       xtmp(1) = var
+       CALL restput (fid, vname_q, 1, 1, 1, itau, xtmp)
+    ENDIF
+          
+  END SUBROUTINE restput_p_nogrid_r_scal
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : restput_p_nogrid_i_scal
+  !!
+  !>\BRIEF
+  !!
+  !! DESCRIPTION  :  
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE restput_p_nogrid_i_scal (fid,vname_q,itau,var)
+    IMPLICIT NONE
+
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: itau
+    INTEGER :: var
+    !-----------------------------
+    REAL :: xtmp(1)
+    REAL :: realvar
+
+    IF (is_root_prc) THEN
+       realvar = REAL(var,r_std)
+       xtmp(1) = realvar
+       CALL restput (fid, vname_q, 1, 1, 1, itau, xtmp)
+    ENDIF
+          
+  END SUBROUTINE restput_p_nogrid_i_scal
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : histwrite_r1d_p
+  !!
+  !>\BRIEF          give the data (real 1D) to the IOIPSL system (if we don't use XIOS).          
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes
+  !!
+  !! \n
+  !_ ============================================================================================================================  
+
+  SUBROUTINE histwrite_r1d_p(pfileid,pvarname,pitau,pdata,nbindex,nindex)
+    IMPLICIT NONE
+!-
+    INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex)
+    REAL,DIMENSION(:),INTENT(IN) :: pdata
+    CHARACTER(LEN=*),INTENT(IN) :: pvarname
+    
+    REAL,DIMENSION(nbp_mpi)    :: pdata_mpi
+    
+    IF (pfileid > 0) THEN 
+       ! Continue only if the file is initilalized
+       CALL gather_omp(pdata,pdata_mpi)
+       IF (is_omp_root) THEN
+          CALL histwrite(pfileid,pvarname,pitau,pdata_mpi,nbp_mpi,kindex_mpi) 
+       ENDIF
+    END IF
+      
+  END SUBROUTINE histwrite_r1d_p
+  
+  !! ============================================================================================================================
+  !! SUBROUTINE   : histwrite_r2d_p
+  !!
+  !>\BRIEF          give the data (real 2D) to the IOIPSL system (if we don't use XIOS).
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE histwrite_r2d_p(pfileid,pvarname,pitau,pdata,nbindex,nindex)
+    IMPLICIT NONE
+!-
+    INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex)
+    REAL,DIMENSION(:,:),INTENT(IN) :: pdata
+    CHARACTER(LEN=*),INTENT(IN) :: pvarname
+
+    IF (pfileid > 0) THEN 
+       ! Continue only if the file is initilalized
+       CALL body(size(pdata,2),nindex)
+    END IF
+
+  CONTAINS 
+
+    SUBROUTINE body(dim,nindex)
+    INTEGER :: dim
+    INTEGER :: nindex(nbp_omp,dim)
+    
+    INTEGER :: nindex_mpi(nbp_mpi,dim)
+    REAL    :: pdata_mpi(nbp_mpi,dim)
+    
+      CALL gather_omp(pdata,pdata_mpi)
+      CALL gather_omp(nindex,nindex_mpi)
+    
+      IF (is_omp_root) THEN
+       CALL histwrite(pfileid,pvarname,pitau,pdata_mpi,nbp_mpi*dim,reshape(nindex_mpi,(/nbp_mpi*dim/)))
+      ENDIF
+    END SUBROUTINE body
+       
+  END SUBROUTINE histwrite_r2d_p
+
+  !! ============================================================================================================================
+  !! SUBROUTINE   : histwrite_r3d_p
+  !!
+  !>\BRIEF          give the data (real 3D) to the IOIPSL system (if we don't use XIOS).
+  !!
+  !! DESCRIPTION  : Needs to be called by all processes
+  !!
+  !! \n
+  !_ ============================================================================================================================
+
+  SUBROUTINE histwrite_r3d_p(pfileid,pvarname,pitau,pdata,nbindex,nindex)
+    IMPLICIT NONE
+!-
+    INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex)
+    REAL,DIMENSION(:,:,:),INTENT(IN) :: pdata
+    CHARACTER(LEN=*),INTENT(IN) :: pvarname
+
+    CHARACTER(LEN=10) :: part_str
+    CHARACTER(LEN=LEN(part_str) + LEN(pvarname) + 1) :: var_name
+    REAL,DIMENSION(SIZE(pdata, 1),SIZE(pdata, 2)) :: tmparr
+    INTEGER :: jv
+
+    DO jv = 1, SIZE(pdata, 3)
+       WRITE(part_str,'(I2)') jv
+       IF (jv < 10) part_str(1:1) = '0'
+       var_name = TRIM(pvarname)//'_'//part_str(1:LEN_TRIM(part_str))
+       tmparr = pdata(:,:,jv)
+       CALL histwrite_r2d_p(pfileid, var_name, pitau, tmparr, nbindex, nindex)
+    ENDDO
+      
+  END SUBROUTINE histwrite_r3d_p
+
+
+END MODULE ioipsl_para
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_mpi_data.F90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_mpi_data.F90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_mpi_data.F90	(revision 6412)
@@ -0,0 +1,504 @@
+! ==============================================================================================================================
+! MODULE            : mod_orchidee_mpi_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              All routines needed for the initialization of the MPI parallelization of Orchidee (coupled and offline) 
+!!
+!!\n DESCRIPTION    : Definition and allocation of parallel datas for MPI.
+!!                    Initialization of parallel or sequentiel IOs.
+!!                    Definition of Load Balancing functions.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE mod_orchidee_mpi_data
+
+!-
+  USE defprec
+  USE ioipsl
+  USE ioipsl_para
+  USE xios_orchidee
+  USE mod_orchidee_para_var
+
+  IMPLICIT NONE
+
+!-
+#include "src_parallel.h"
+!-
+!-
+
+CONTAINS
+
+  !! =============================================================================================================================
+  !! SUBROUTINE  : Init_orchidee_mpi
+  !!
+  !>\BRIEF	   Initialization of the mpi parallelization in ORCHIDEE offline mode. 
+  !!
+  !! DESCRIPTION : Initialization of the mpi parallelization in ORCHIDEE offline mode. 
+  !!
+  !! \n
+  !_ ============================================================================================================================= 
+
+  SUBROUTINE Init_orchidee_mpi(communicator)
+
+    IMPLICIT NONE
+    INTEGER, OPTIONAL, INTENT(in) :: communicator
+    INTEGER :: COMM
+    INTEGER :: ierr
+    
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    !Config Key   = XIOS_ORCHIDEE_OK
+    !Config Desc  = Use XIOS for writing diagnostics file
+    !Config If    = 
+    !Config Def   = y
+    !Config Help  = If XIOS_ORCHIDEE_OK=y then no output with IOIPSL can be done
+    !Config Units = [FLAG]
+    CALL getin('XIOS_ORCHIDEE_OK',xios_orchidee_ok)
+    WRITE(numout,*)'In init_ochidee_mpi : xios_orchidee_ok=',xios_orchidee_ok
+
+#ifdef CPP_PARA
+    IF ( xios_orchidee_ok ) THEN
+       CALL MPI_INIT(ierr)
+       CALL xios_orchidee_comm_init(COMM)
+    ELSE IF ( PRESENT(communicator) ) THEN
+       COMM=communicator
+    ELSE
+       CALL MPI_INIT(ierr)
+       COMM=MPI_COMM_WORLD
+    ENDIF
+    CALL MPI_COMM_SIZE(COMM,mpi_size,ierr)
+    CALL MPI_COMM_RANK(COMM,mpi_rank,ierr)
+    is_ok_mpi=.TRUE.
+#else
+    mpi_rank=0
+    mpi_size=1
+    is_ok_mpi=.FALSE.
+    ! It is not possible to use XIOS without MPI
+    WRITE(numout,*)'XIOS cannot be run without MPI. xios_orchidee_ok is set to false.'
+    xios_orchidee_ok=.FALSE.
+#endif
+    
+    mpi_rank_root=0
+
+    IF (mpi_rank==mpi_rank_root) THEN 
+      is_mpi_root=.TRUE.
+    ELSE
+      is_mpi_root=.FALSE.
+    ENDIF
+  
+    CALL Init_const_mpi(COMM)
+      
+  END SUBROUTINE Init_orchidee_mpi
+
+
+  !! =============================================================================================================================
+  !! SUBROUTINE  : Init_orchidee_mpi_data
+  !!
+  !>\BRIEF	   Initialization of the mpi parallelization  
+  !!
+  !! DESCRIPTION : Initialization of the mpi parallelization. This subroutine is called from Init_orchidee_data_para 
+  !!               which is called both in offline and coupled mode.
+  !!
+  !! \n
+  !_ ============================================================================================================================= 
+
+  SUBROUTINE Init_orchidee_mpi_data(arg_nbp_mpi,arg_kindex_mpi,arg_offset_mpi,COMM)
+
+  IMPLICIT NONE
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER, INTENT(IN) :: arg_nbp_mpi
+    INTEGER, INTENT(IN) :: arg_kindex_mpi(arg_nbp_mpi)
+    INTEGER, INTENT(IN) :: arg_offset_mpi
+    INTEGER, INTENT(IN) :: COMM
+
+    INTEGER :: i
+  
+#ifdef CPP_PARA
+    INTEGER :: ierr
+    is_ok_mpi=.TRUE.
+#else
+    is_ok_mpi=.FALSE.
+#endif
+
+    ! Initialization of MPI_COMM_ORCH 
+    CALL init_const_mpi(COMM)
+    IF (is_ok_mpi) THEN    
+#ifdef CPP_PARA
+      CALL MPI_COMM_SIZE(MPI_COMM_ORCH,mpi_size,ierr)    
+      CALL MPI_COMM_RANK(MPI_COMM_ORCH,mpi_rank,ierr)
+#endif
+    ELSE
+      mpi_size=1
+      mpi_rank=0
+    ENDIF   
+    
+    IF (mpi_rank == 0) THEN
+      mpi_rank_root = 0
+      is_mpi_root = .true.
+    ENDIF
+    
+    ! Test if there are enough land grid cells on each MPI process.
+    ! At least 2 grid cells are needed for each process if running in parallel. Stop if this is not the case.
+    IF (arg_nbp_mpi < 2 .AND. mpi_size > 1) THEN
+       PRINT*,'Init_orchidee_mpi_data: nbp_mpi(number of grid-cells for current MPI process)=',arg_nbp_mpi
+       PRINT*,'nbp_mpi is too small. It must be 2 or bigger for each MPI process. Stop now.'
+       CALL ipslerr_p(3, "Init_orchidee_mpi_data","Not all MPI processes has enough land grid cells",&
+            "Make the region bigger or use a lower number of MPI processes.","")
+    END IF
+
+    ALLOCATE(nbp_mpi_para(0:mpi_size-1))
+    ALLOCATE(nbp_mpi_para_begin(0:mpi_size-1))
+    ALLOCATE(nbp_mpi_para_end(0:mpi_size-1))    
+    ALLOCATE(jj_para_nb(0:mpi_size-1))
+    ALLOCATE(jj_para_begin(0:mpi_size-1))
+    ALLOCATE(jj_para_end(0:mpi_size-1))
+    ALLOCATE(ii_para_begin(0:mpi_size-1))
+    ALLOCATE(ii_para_end(0:mpi_size-1))    
+    ALLOCATE(ij_para_nb(0:mpi_size-1))
+    ALLOCATE(ij_para_begin(0:mpi_size-1))
+    ALLOCATE(ij_para_end(0:mpi_size-1))
+    
+
+    nbp_mpi=arg_nbp_mpi
+    ALLOCATE(kindex_mpi(nbp_mpi))
+    kindex_mpi(:)=arg_kindex_mpi(:)
+    
+    offset_mpi=arg_offset_mpi
+    
+    IF (is_ok_mpi) THEN
+#ifdef CPP_PARA
+      CALL MPI_AllGather(nbp_mpi,1,MPI_INT_ORCH,nbp_mpi_para,1,MPI_INT_ORCH,MPI_COMM_ORCH,ierr)
+#endif
+    ELSE
+      nbp_mpi_para(0)=nbp_mpi
+    ENDIF
+    
+    nbp_mpi_para_begin(0)=1
+    nbp_mpi_para_end(0)=nbp_mpi_para(0)
+    DO i=1,mpi_size-1
+      nbp_mpi_para_begin(i)=nbp_mpi_para_end(i-1)+1
+      nbp_mpi_para_end(i)=nbp_mpi_para_begin(i)+nbp_mpi_para(i)-1
+    ENDDO
+    nbp_mpi_begin=nbp_mpi_para_begin(mpi_rank)
+    nbp_mpi_end=nbp_mpi_para_end(mpi_rank)
+    
+    
+    IF (mpi_rank==mpi_size-1) THEN
+      ij_end=iim_g*jjm_g
+    ELSE
+      ij_end=kindex_mpi(nbp_mpi)+offset_mpi
+    ENDIF
+
+    IF (is_ok_mpi) THEN    
+#ifdef CPP_PARA    
+      CALL MPI_Allgather(ij_end,1,MPI_INT_ORCH,ij_para_end,1,MPI_INT_ORCH,MPI_COMM_ORCH,ierr)
+#endif
+    ELSE
+      ij_para_end(0)=ij_end
+    ENDIF
+    
+    ij_para_begin(0)=1
+    ij_para_nb(0)=ij_para_end(0)-ij_para_begin(0)+1
+    
+    DO i=1,mpi_size-1
+      ij_para_begin(i)=ij_para_end(i-1)+1
+      ij_para_nb(i)=ij_para_end(i)-ij_para_begin(i)+1
+    ENDDO
+    
+    DO i=0,mpi_size-1
+      jj_para_begin(i)=(ij_para_begin(i)-1)/iim_g + 1
+      jj_para_end(i)=(ij_para_end(i)-1)/iim_g + 1
+      jj_para_nb(i)=jj_para_end(i)-jj_para_begin(i)+1
+          
+      ii_para_begin(i)=MOD(ij_para_begin(i)-1,iim_g)+1
+      ii_para_end(i)=MOD(ij_para_end(i)-1,iim_g)+1
+    ENDDO
+
+   
+    ij_nb=ij_para_nb(mpi_rank)
+    ij_begin=ij_para_begin(mpi_rank)
+    ij_end=ij_para_end(mpi_rank)
+        
+    jj_nb=jj_para_nb(mpi_rank)
+    jj_begin=jj_para_begin(mpi_rank)
+    jj_end=jj_para_end(mpi_rank)
+    
+    ii_begin=ii_para_begin(mpi_rank)
+    ii_end=ii_para_end(mpi_rank)
+        
+      
+    CALL print_mpi_data
+  
+    
+  END SUBROUTINE Init_orchidee_mpi_data
+  
+
+  !! =============================================================================================================================
+  !! SUBROUTINE  : init_const_mpi
+  !!
+  !>\BRIEF	   Initialization of some constants related to the MPI parallelization 
+  !!
+  !! DESCRIPTION : Initialization of some constants related to the MPI parallelization
+  !!
+  !! \n
+  !_ ============================================================================================================================= 
+
+  SUBROUTINE init_const_mpi(COMM)
+
+  IMPLICIT NONE
+    INTEGER :: COMM
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+    
+    MPI_COMM_ORCH=COMM
+    
+    IF (i_std==i_4) THEN
+       MPI_INT_ORCH=MPI_INTEGER4
+    ELSEIF (i_std==i_8) THEN
+       MPI_INT_ORCH=MPI_INTEGER8
+    ELSE
+       MPI_INT_ORCH=MPI_INTEGER
+    ENDIF
+         
+    IF (r_std==r_4) THEN
+       MPI_REAL_ORCH=MPI_REAL4
+    ELSEIF (r_std==r_8) THEN
+       MPI_REAL_ORCH=MPI_REAL8
+    ELSE
+       MPI_REAL_ORCH=MPI_REAL
+    ENDIF
+#endif
+
+  END SUBROUTINE init_const_mpi
+
+
+  !! =============================================================================================================================
+  !! SUBROUTINE  : Finalize_mpi
+  !!
+  !>\BRIEF	   Close the MPI parallelization 
+  !!
+  !! DESCRIPTION : Close the MPI parallelization. The context XIOS will be closed before call to MPI_finalize routine
+  !!
+  !! \n
+  !_ ============================================================================================================================= 
+
+  SUBROUTINE Finalize_mpi
+
+  IMPLICIT NONE
+#ifdef CPP_PARA
+  include 'mpif.h'  
+  INTEGER :: ierr
+
+  CALL xios_orchidee_finalize
+
+  CALL MPI_FINALIZE(ierr)
+#endif
+   
+  END SUBROUTINE Finalize_mpi
+  
+
+  !! =============================================================================================================================
+  !! SUBROUTINE  : print_mpi_data
+  !!
+  !>\BRIEF	   Print all data specific to MPI parallelization of ORCHIDEE 
+  !!
+  !! DESCRIPTION : Print all data specific to MPI parallelization of ORCHIDEE 	
+  !!
+  !! \n
+  !_ ============================================================================================================================= 
+
+  SUBROUTINE print_mpi_data
+
+  IMPLICIT NONE
+    
+    WRITE(numout,*) '==== MPI DOMAIN ===='
+    WRITE(numout,*) '     ----------     '
+    WRITE(numout,*) 'mpi_size',mpi_size
+    WRITE(numout,*) 'mpi_rank',mpi_rank
+    WRITE(numout,*) 'is_mpi_root',is_mpi_root
+    WRITE(numout,*) 'mpi_rank_root',mpi_rank_root
+
+    WRITE(numout,*) 'nbp_mpi_begin=',nbp_mpi_begin
+    WRITE(numout,*) 'nbp_mpi_end  =',nbp_mpi_end
+    WRITE(numout,*) 'nbp_mpi=',nbp_mpi
+          
+    WRITE(numout,*) 'ij_begin=',ij_begin
+    WRITE(numout,*) 'ij_end=',ij_end
+    WRITE(numout,*) 'ij_nb=',ij_nb
+    WRITE(numout,*) 'jj_begin=',jj_begin
+    WRITE(numout,*) 'jj_end=',jj_end
+    WRITE(numout,*) 'jj_nb=',jj_nb	
+    WRITE(numout,*) 'ii_begin=',ii_begin
+    WRITE(numout,*) 'ii_end=',ii_end
+    
+    WRITE(numout,*) 'offset_mpi',offset_mpi
+    WRITE(numout,*) 'nbp_mpi_para_begin=',nbp_mpi_para_begin
+    WRITE(numout,*) 'nbp_mpi_para_end  =',nbp_mpi_para_end
+    WRITE(numout,*) 'nbp_mpi_para=',nbp_mpi_para
+          
+    WRITE(numout,*) 'ij_para_begin=',ij_para_begin
+    WRITE(numout,*) 'ij_para_end=',ij_para_end
+    WRITE(numout,*) 'ij_para_nb=',ij_para_nb
+    WRITE(numout,*) 'jj_para_begin=',jj_para_begin
+    WRITE(numout,*) 'jj_para_end=',jj_para_end
+    WRITE(numout,*) 'jj_para_nb=',jj_para_nb	
+    WRITE(numout,*) 'ii_para_begin=',ii_para_begin
+    WRITE(numout,*) 'ii_para_end=',ii_para_end
+  
+  END SUBROUTINE print_mpi_data
+  
+
+  !! =============================================================================================================================
+  !! SUBROUTINE  : Read_Load_balance
+  !!
+  !>\BRIEF	   Read load balance file.
+  !!
+  !! DESCRIPTION : Read load balance file. This is only done in offline mode.
+  !!               The load balance file contains information about the MPI partitionning on the different processes.
+  !!
+  !! \n
+  !_ ============================================================================================================================= 
+
+ SUBROUTINE Read_Load_balance(NbPoints,Nbpoints_loc)
+
+    IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: NbPoints
+    INTEGER,INTENT(OUT) :: Nbpoints_loc(0:mpi_size-1)
+    INTEGER :: i,s
+    INTEGER :: ierr
+    
+#ifdef CPP_PARA
+    CHARACTER(len=255)  :: filename='Load_balance_orchidee.dat'
+    INTEGER :: j
+    INTEGER :: unit_number=10
+#endif   
+
+#ifdef CPP_PARA
+    OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='old',FORM='formatted',IOSTAT=ierr) 
+#else
+    ierr=1
+#endif   
+    Nbpoints_loc(:) = 0
+
+    s=0
+#ifdef CPP_PARA  
+    IF (ierr==0) THEN
+       i=0
+       !- Reading for any balancing file (even with a bad structure)
+       DO WHILE (i < mpi_size .AND. ierr == 0) 
+          READ (unit_number,*,IOSTAT=ierr) j,Nbpoints_loc(i)
+          s=s+Nbpoints_loc(i)
+          i=i+1
+       ENDDO
+       CLOSE(unit_number)
+    ENDIF
+#endif   
+    
+    !- Correction of bad balancing file (or an empty file) => same nb of points for each procs
+    IF (ierr/=0 .OR. s/=Nbpoints) THEN
+       DO i=0,mpi_size-1
+          Nbpoints_loc(i)=Nbpoints/mpi_size
+          IF (MOD(Nbpoints,mpi_size) > i) Nbpoints_loc(i)=Nbpoints_loc(i)+1
+       ENDDO
+    ENDIF
+    
+  END SUBROUTINE Read_Load_balance
+  
+
+  !! =============================================================================================================================
+  !! SUBROUTINE  : Write_Load_balance
+  !!
+  !>\BRIEF	   Write the load balance file.
+  !!
+  !! DESCRIPTION : Write the load balance file. This is only done in offline mode. 
+  !!               The load balance file contains information about the MPI partitionning on the different processes.
+  !!
+  !! \n
+  !_ =============================================================================================================================
+
+  SUBROUTINE Write_Load_balance(times)
+    IMPLICIT NONE
+    REAL,INTENT(IN) :: times
+  
+    CHARACTER(len=255)  :: filename='Load_balance_orchidee.dat'
+    INTEGER :: unit_number=10
+    INTEGER :: i,ierr
+    REAL :: All_Times(0:mpi_size-1)
+    REAL :: average
+    REAL :: efficiency
+    INTEGER :: dp,S
+    INTEGER :: New_nbpoints(0:mpi_size-1)
+    
+    WRITE(numout,*) 'time',times
+
+    IF (is_ok_mpi) THEN
+#ifdef CPP_PARA
+      CALL MPI_GATHER(times,1,MPI_REAL_ORCH,All_times,1,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+#endif
+    ELSE
+      All_times(:)=times
+    ENDIF
+    
+    IF (is_mpi_root) WRITE(numout,*) 'ALL_times',All_times
+
+    IF (is_mpi_root) THEN
+     
+       OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='replace',FORM='formatted',IOSTAT=ierr)
+       
+       average=sum(All_times(:))/mpi_size
+       DO i=0,mpi_size-1
+          efficiency=All_times(i)/nbp_mpi_para(i)
+          New_nbpoints(i)=Nbp_mpi_para(i)-(All_times(i)-average)/efficiency
+       ENDDO
+       
+       S=sum(new_nbpoints(:))
+       dp=nbp_glo-S
+       
+       IF ( dp > 0 ) THEN
+          DO WHILE ( dp > 0 )
+             New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))+1
+             dp=dp-1
+          ENDDO
+       ELSE
+          dp=-dp
+          DO WHILE ( dp > 0 )
+             New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))-1
+             dp=dp-1
+          ENDDO
+       ENDIF
+       
+
+       ! If this algorithm diverge, we use previous repartition.
+       IF ( ANY(New_nbpoints(:) .LE. 0) ) THEN
+          New_nbpoints(:)=Nbp_mpi_para(:)
+       ENDIF
+       
+       DO i=0,mpi_size-1
+          WRITE(Unit_number,*) i,New_nbpoints(i)
+       ENDDO
+       CLOSE(Unit_number)
+    ENDIF
+
+  END SUBROUTINE Write_Load_Balance
+  
+END MODULE mod_orchidee_mpi_data
+
+#include "mpi_dummy.h"
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_mpi_transfert.F90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_mpi_transfert.F90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_mpi_transfert.F90	(revision 6412)
@@ -0,0 +1,3184 @@
+! ==============================================================================================================================
+! MODULE            : mod_orchidee_mpi_transfert
+!
+! CONTACT           : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE           : IPSL (2006)
+!                     This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF              Low level MPI parallel communication encapsulations for ORCHIDEE.
+!!
+!!\n DESCRIPTION    : This module contains low level interfaces to communicate information to all MPI processes. 
+!!                    The interfaces in this module are only used by mod_orchidee_transfert_para to create high level interfaces.
+!!                    Note that these interfaces are only called by the master OMP thread on each MPI process.
+!!                    The interfaces in this module are:
+!!                    - bcast_mpi, scatter_mpi, gather_mpi_s, scatter_2D_mpi, gather_2D_mpi, reduced_sum_mpi                  
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE mod_orchidee_mpi_transfert
+  !-
+  USE defprec
+  USE mod_orchidee_para_var
+  USE timer
+  !-
+  IMPLICIT NONE
+  !-
+#include "src_parallel.h"
+
+  !! ==============================================================================================================================
+  !! INTERFACE    : bcast_mpi
+  !!
+  !>\BRIEF          Send a variable from root process to all MPI processes 
+  !!
+  !! DESCRIPTION  : Send a variable from root process to all MPI processes. Need to be call under OMP MASTER
+  !!
+  !! \n
+  !_ ================================================================================================================================
+
+  INTERFACE bcast_mpi
+     MODULE PROCEDURE bcast_mpi_c, bcast_mpi_c1,                           &
+          bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
+          bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
+          bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
+  END INTERFACE
+
+  !! ==============================================================================================================================
+  !! INTERFACE    : scatter_mpi
+  !!
+  !>\BRIEF          Distribute a global field from the root process to the local domain on each MPI processes (on kjpindex)
+  !!
+  !! DESCRIPTION  : Distribute a global field from the root process to the local domain on each MPI processes.  
+  !!                Need to be call under OMP MASTER
+  !!
+  !! \n
+  !_ ================================================================================================================================
+
+  INTERFACE scatter_mpi
+     MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3,scatter_mpi_i4, &
+          scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3,scatter_mpi_r4, &
+          scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3,scatter_mpi_l4
+  END INTERFACE
+
+  !! ==============================================================================================================================
+  !! INTERFACE    : gather_mpi_s
+  !!
+  !>\BRIEF          gather a variable (on kjpindex) on the global grid. (With call of suspend time)
+  !!
+  !! DESCRIPTION  : gather a variable on the global grid. (With call of suspend time) 
+  !!
+  !! \n
+  !_ ================================================================================================================================
+
+  INTERFACE gather_mpi_s
+     MODULE PROCEDURE gather_mpi_is, &
+          gather_mpi_rs, &
+          gather_mpi_ls
+  END INTERFACE
+
+  !! ==============================================================================================================================
+  !! INTERFACE    : gather_mpi 
+  !!
+  !>\BRIEF          Each process MPI send their local field  (on kjpindex) to the root process which will recieve 
+  !!                the field on the global domain
+  !!
+  !! DESCRIPTION  : Each process MPI send their local field  (on kjpindex) to the root process which will recieve 
+  !!                the field on the global domain.
+  !!                Need to be call under OMP MASTER
+  !!
+  !! \n
+  !_ ================================================================================================================================
+
+  INTERFACE gather_mpi
+     MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3,gather_mpi_i4, &
+          gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3,gather_mpi_r4, &
+          gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3,gather_mpi_l4  
+  END INTERFACE
+
+  !! ==============================================================================================================================
+  !! INTERFACE    : scatter2D_mpi
+  !!
+  !>\BRIEF          Distribute a global field (lon,lat) from the root process to the local domain on each processes MPI
+  !!
+  !! DESCRIPTION  : Distribute a global field (lon,lat) from the root process to the local domain on each processes MPI
+  !!
+  !! \n
+  !_ ================================================================================================================================
+
+  INTERFACE scatter2D_mpi
+     MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, &
+          scatter2D_mpi_r0,scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, &
+          scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
+  END INTERFACE
+
+  !! ==============================================================================================================================
+  !! INTERFACE    : gather2D_mpi
+  !!
+  !>\BRIEF          Each process MPI send their local field  (on lon,lat) to the root process which will recieve 
+  !!                the field on the global domain
+  !!
+  !! DESCRIPTION  :
+  !!
+  !! \n
+  !_ ================================================================================================================================
+
+  INTERFACE gather2D_mpi
+     MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, &
+          gather2D_mpi_r0,gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, &
+          gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
+  END INTERFACE
+
+  !! ==============================================================================================================================
+  !! INTERFACE    : reduce_sum_mpi
+  !!
+  !>\BRIEF          The root process will recieve the sum of the values from all processe 
+  !!
+  !! DESCRIPTION  : The root process will recieve the sum of the values from all processe. Need to be call under OMP MASTER
+  !!
+  !! \n
+  !_ ================================================================================================================================
+
+  INTERFACE reduce_sum_mpi
+     MODULE PROCEDURE reduce_sum_mpi_i,reduce_sum_mpi_i1,reduce_sum_mpi_i2,reduce_sum_mpi_i3,reduce_sum_mpi_i4, &
+          reduce_sum_mpi_r,reduce_sum_mpi_r1,reduce_sum_mpi_r2,reduce_sum_mpi_r3,reduce_sum_mpi_r4
+  END INTERFACE
+
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition of Broadcast 1D --> 4D !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !! -- Character string -- !!
+
+  SUBROUTINE bcast_mpi_c(var)
+    IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    CHARACTER(LEN=len(Var)),DIMENSION(1) :: Var1
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_mpi_root) &
+         Var1(1)=Var
+    CALL orch_bcast_mpi_cgen(Var1,1)
+    Var=Var1(1)
+#endif
+  END SUBROUTINE bcast_mpi_c
+
+  SUBROUTINE bcast_mpi_c1(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var(:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_cgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_c1
+
+
+  !! -- Integers -- !!
+
+  SUBROUTINE bcast_mpi_i(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var
+    INTEGER(i_std),DIMENSION(1) :: Var1
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_mpi_root) &
+         Var1(1)=Var
+    CALL orch_bcast_mpi_igen(Var1,1)
+    Var=Var1(1)
+#endif
+  END SUBROUTINE bcast_mpi_i
+
+  SUBROUTINE bcast_mpi_i1(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var(:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_i1
+
+  SUBROUTINE bcast_mpi_i2(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var(:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_i2
+
+  SUBROUTINE bcast_mpi_i3(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var(:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_i3
+
+  SUBROUTINE bcast_mpi_i4(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var(:,:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_i4
+
+
+  !! -- Reals -- !!
+
+  SUBROUTINE bcast_mpi_r(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var
+    REAL(r_std),DIMENSION(1) :: Var1
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_mpi_root) &
+         Var1(1)=Var
+    CALL orch_bcast_mpi_rgen(Var1,1)
+    Var=Var1(1)
+#endif
+  END SUBROUTINE bcast_mpi_r
+
+  SUBROUTINE bcast_mpi_r1(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var(:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_r1
+
+  SUBROUTINE bcast_mpi_r2(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var(:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_r2
+
+  SUBROUTINE bcast_mpi_r3(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var(:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_r3
+
+  SUBROUTINE bcast_mpi_r4(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var(:,:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_r4
+
+  !! -- Logicals -- !!
+
+  SUBROUTINE bcast_mpi_l(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL,DIMENSION(1) :: Var1
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_mpi_root) &
+         Var1(1)=Var
+    CALL orch_bcast_mpi_lgen(Var1,1)
+    Var=Var1(1)
+#endif
+  END SUBROUTINE bcast_mpi_l
+
+  SUBROUTINE bcast_mpi_l1(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_l1
+
+  SUBROUTINE bcast_mpi_l2(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_l2
+
+  SUBROUTINE bcast_mpi_l3(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_l3
+
+  SUBROUTINE bcast_mpi_l4(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_l4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition of Scatter  1D --> 4D  !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(nbp_glo) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi) :: VarOut
+
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_mpi_igen(dummy,Varout,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_i
+
+  SUBROUTINE scatter_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_i1
+
+  SUBROUTINE scatter_mpi_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else    
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_i2
+
+  SUBROUTINE scatter_mpi_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else    
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_i3
+
+  SUBROUTINE scatter_mpi_i4(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else    
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_i4
+
+  SUBROUTINE scatter_mpi_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,1)
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_r
+
+  SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_r1
+
+  SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_r2
+
+  SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_r3
+
+  SUBROUTINE scatter_mpi_r4(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_r4
+
+
+  SUBROUTINE scatter_mpi_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,1)
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l
+
+  SUBROUTINE scatter_mpi_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l1
+
+  SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l2
+
+  SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l3
+
+  SUBROUTINE scatter_mpi_l4(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition of Gather   1D --> 4D  !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather_mpi_is(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER(i_std),INTENT(IN) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std) :: nb,i,index_para,rank
+    INTEGER(i_std) :: ierr
+    LOGICAL :: flag=.FALSE.
+    LOGICAL, PARAMETER :: check=.FALSE.
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn
+    RETURN
+#else
+
+    IF (timer_state(timer_mpi)==running) THEN
+      flag=.TRUE.
+    ELSE
+      flag=.FALSE.
+    ENDIF
+    
+    IF (flag) CALL suspend_timer(timer_mpi)
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_is VarIn=",VarIn    
+
+#ifdef CPP_PARA
+    CALL MPI_GATHER(VarIn,1,MPI_INT_ORCH,VarOut,1,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+#endif
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_is VarOut=",VarOut
+    IF (flag) CALL resume_timer(timer_mpi)
+#endif
+  END SUBROUTINE gather_mpi_is
+
+  SUBROUTINE gather_mpi_rs(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    REAL(r_std),INTENT(IN) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std) :: nb,i,index_para,rank
+    INTEGER(i_std) :: ierr
+    LOGICAL :: flag=.FALSE.
+    LOGICAL, PARAMETER :: check=.FALSE.
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn
+    RETURN
+#else
+
+    IF (timer_state(timer_mpi)==running) THEN
+      flag=.TRUE.
+    ELSE
+      flag=.FALSE.
+    ENDIF
+    
+    IF (flag) CALL suspend_timer(timer_mpi)
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_rs VarIn=",VarIn    
+
+#ifdef CPP_PARA
+    CALL MPI_GATHER(VarIn,1,MPI_REAL_ORCH,VarOut,1,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+#endif
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_rs VarOut=",VarOut
+
+    IF (flag) CALL resume_timer(timer_mpi)
+#endif
+  END SUBROUTINE gather_mpi_rs
+
+  SUBROUTINE gather_mpi_ls(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    LOGICAL,INTENT(IN) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std) :: nb,i,index_para,rank
+    INTEGER(i_std) :: ierr
+    LOGICAL :: flag=.FALSE.
+    LOGICAL, PARAMETER :: check=.FALSE.
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn
+    RETURN
+#else
+
+    IF (timer_state(timer_mpi)==running) THEN
+      flag=.TRUE.
+    ELSE
+      flag=.FALSE.
+    ENDIF
+    
+    IF (flag) CALL suspend_timer(timer_mpi)
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_ls VarIn=",VarIn    
+
+#ifdef CPP_PARA
+    CALL MPI_GATHER(VarIn,1,MPI_LOGICAL,VarOut,1,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr)
+#endif
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_ls VarOut=",VarOut
+    IF (flag) CALL resume_timer(timer_mpi)
+#endif
+  END SUBROUTINE gather_mpi_ls
+
+!!!!! --> Integers
+
+  SUBROUTINE gather_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather_mpi_igen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_i
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
+    ELSE
+       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_i1
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_i2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_i3
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i4(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_i4
+
+!!!!! --> Reals
+
+  SUBROUTINE gather_mpi_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather_mpi_rgen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_r
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
+    ELSE
+       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_r1
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_r2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_r3
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r4(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_r4
+
+!!!!! --> Logicals
+
+  SUBROUTINE gather_mpi_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather_mpi_lgen(VarIn,dummy,1,1)      
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_l
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarIn,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
+    ELSE
+       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_l1
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_l2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_l3
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l4(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_l4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition of Scatter2D   --> 4D  !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter2D_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
+    ELSE
+       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,1)
+    ENDIF
+
+
+#endif
+  END SUBROUTINE scatter2D_mpi_i
+
+  SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_i1
+
+  SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+
+
+#endif
+  END SUBROUTINE scatter2D_mpi_i2
+
+  SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_i3
+
+
+  SUBROUTINE scatter2D_mpi_r0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1)      
+    ENDIF
+
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r0
+
+  SUBROUTINE scatter2D_mpi_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL(r_std),INTENT(INOUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r
+
+  SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r1
+
+  SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r2
+
+  SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:)  :: VarIn
+    REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r3
+
+
+  SUBROUTINE scatter2D_mpi_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
+    ELSE
+       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_l
+
+  SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(INOUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_l1
+
+  SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_l2
+
+  SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:)  :: VarIn
+    LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition of Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather2D_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
+    ELSE
+       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_i
+
+  SUBROUTINE gather2D_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_i1
+
+  SUBROUTINE gather2D_mpi_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_i2
+
+  SUBROUTINE gather2D_mpi_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_i3
+
+
+  SUBROUTINE gather2D_mpi_r0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r0
+
+  SUBROUTINE gather2D_mpi_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r
+
+  SUBROUTINE gather2D_mpi_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r1
+
+  SUBROUTINE gather2D_mpi_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r2
+
+  SUBROUTINE gather2D_mpi_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r3
+
+
+  SUBROUTINE gather2D_mpi_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
+    ELSE
+       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_l
+
+  SUBROUTINE gather2D_mpi_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_l1
+
+  SUBROUTINE gather2D_mpi_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_l2
+
+  SUBROUTINE gather2D_mpi_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition of reduce_sum    --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN)  :: VarIn
+    INTEGER(i_std),INTENT(OUT) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: Var1
+    INTEGER(i_std),DIMENSION(1) :: Var2
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut=VarIn
+    RETURN
+#else
+    Var1(1)=VarIn
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(Var1,Var2,1)
+       VarOut=Var2(1)
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(Var1,dummy,1)
+       VarOut=VarIn
+    ENDIF
+#endif
+  END SUBROUTINE reduce_sum_mpi_i
+
+  SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_i1
+
+  SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_i2
+
+  SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_i3
+
+  SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_i4
+
+
+  SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN)  :: VarIn
+    REAL(r_std),INTENT(OUT) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: Var1
+    REAL(r_std),DIMENSION(1) :: Var2
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut=VarIn
+    RETURN
+#else
+
+    Var1(1)=VarIn
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(Var1,Var2,1)
+       VarOut=Var2(1)
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(Var1,dummy,1)
+       VarOut=VarIn
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r
+
+  SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r1
+
+  SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r2
+
+  SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r3
+
+  SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r4
+
+
+END MODULE mod_orchidee_mpi_transfert
+
+#ifdef CPP_PARA
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION OF GENERIC TRANSFERT SUBROUTINES           !! 
+!! These subroutines are only used localy in this module !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE orch_bcast_mpi_cgen(var,nb)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  CHARACTER(LEN=*),DIMENSION(nb),INTENT(INOUT) :: Var
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+  
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+  
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_cgen before bcast Var",Var    
+  IF (flag) CALL suspend_timer(timer_mpi)
+  CALL MPI_BCAST(Var,nb*LEN(Var(1)),MPI_CHARACTER,mpi_rank_root,MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_cgen after bcast Var",Var
+
+END SUBROUTINE orch_bcast_mpi_cgen
+
+SUBROUTINE orch_bcast_mpi_igen(var,nb)
+  USE mod_orchidee_para_var
+  USE timer
+  IMPLICIT NONE
+
+  INTEGER(i_std),DIMENSION(nb),INTENT(INOUT) :: Var
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_igen before bcast Var",Var
+  CALL MPI_BCAST(Var,nb,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_igen after bcast Var",Var    
+
+END SUBROUTINE orch_bcast_mpi_igen
+
+SUBROUTINE orch_bcast_mpi_rgen(var,nb)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  REAL(r_std),DIMENSION(nb),INTENT(INOUT) :: Var
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_rgen before bcast Var",Var
+  IF (flag) CALL suspend_timer(timer_mpi)
+  CALL MPI_BCAST(Var,nb,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_rgen after bcast Var",Var
+
+END SUBROUTINE orch_bcast_mpi_rgen
+
+SUBROUTINE orch_bcast_mpi_lgen(var,nb)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_lgen before bcast Var",Var
+  IF (flag) CALL suspend_timer(timer_mpi)
+  CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_lgen after bcast Var",Var
+
+END SUBROUTINE orch_bcast_mpi_lgen
+
+
+SUBROUTINE orch_scatter_mpi_igen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: nbp
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
+  INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  INTEGER(i_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_Para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_Para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter_mpi_igen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter_mpi_igen VarTmp",VarTmp
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INT_ORCH,VarOut,nbp_mpi*dimsize,   &
+       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter_mpi_igen VarOut",VarOut
+
+END SUBROUTINE orch_scatter_mpi_igen
+
+SUBROUTINE orch_scatter_mpi_rgen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  REAL(r_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
+  REAL(r_std),INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  REAL(r_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter_mpi_rgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter_mpi_rgen VarTmp",VarTmp
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_ORCH,VarOut,nbp_mpi*dimsize,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter_mpi_rgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter_mpi_rgen
+
+SUBROUTINE orch_scatter_mpi_lgen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  LOGICAL,INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter_mpi_lgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter_mpi_lgen VarTmp",VarTmp
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,nbp_mpi*dimsize,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter_mpi_lgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter_mpi_lgen
+
+SUBROUTINE orch_gather_mpi_igen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  INTEGER(i_std),INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  INTEGER(i_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  INTEGER(i_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather_mpi_igen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+
+  ENDIF
+
+  CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_INT_ORCH,VarTmp,counts,displs,   &
+       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        DO i=1,dimsize
+           VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_igen VarOut=",VarOut
+  IF (flag) CALL resume_timer(timer_mpi)
+
+END SUBROUTINE orch_gather_mpi_igen
+
+SUBROUTINE orch_gather_mpi_rgen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  REAL(r_std),INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  REAL(r_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  REAL(r_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather_mpi_rgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_rgen VarIn=",VarIn    
+  CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_REAL_ORCH,VarTmp,counts,displs,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_rgen dimsize,VarTmp=",dimsize,VarTmp
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        DO i=1,dimsize
+           VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_rgen VarOut=",VarOut
+  IF (flag) CALL resume_timer(timer_mpi)
+
+END SUBROUTINE orch_gather_mpi_rgen
+
+SUBROUTINE orch_gather_mpi_lgen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  LOGICAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather_mpi_lgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_lgen VarIn=",VarIn    
+  CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_lgen dimsize,VarTmp=",dimsize,VarTmp
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        DO i=1,dimsize
+           VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_lgen VarOut=",VarOut
+  IF (flag) CALL resume_timer(timer_mpi)
+
+END SUBROUTINE orch_gather_mpi_lgen
+
+
+SUBROUTINE orch_scatter2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  INTEGER(i_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
+  INTEGER(i_std),INTENT(OUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: counts
+  INTEGER(i_std),DIMENSION(dimsize*iim*jjm)   :: VarTmp1
+  INTEGER(i_std),DIMENSION(ij_nb,dimsize)     :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter2D_mpi_igen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp1",VarTmp1
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_INT_ORCH,VarTmp2,ij_nb*dimsize,   &
+       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp2",VarTmp2
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
+     ENDDO
+  ENDDO
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_igen VarOut",VarOut
+
+END SUBROUTINE orch_scatter2D_mpi_igen
+
+SUBROUTINE orch_scatter2D_mpi_rgen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  REAL(r_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
+  REAL(r_std),INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: counts
+  REAL(r_std),DIMENSION(dimsize*iim*jjm)   :: VarTmp1
+  REAL(r_std),DIMENSION(ij_nb,dimsize)     :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter2D_mpi_rgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp1",VarTmp1
+     ENDIF
+  ENDIF
+  nb=ij_nb*dimsize
+  IF (check) &
+       WRITE(numout,*) "ij_nb*dimsize",ij_nb*dimsize
+
+  CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_REAL_ORCH,VarTmp2,nb,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp2",VarTmp2
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
+     ENDDO
+  ENDDO
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_rgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter2D_mpi_rgen
+
+SUBROUTINE orch_scatter2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  LOGICAL,INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
+  LOGICAL,INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: counts
+  LOGICAL,DIMENSION(dimsize*iim*jjm)   :: VarTmp1
+  LOGICAL,DIMENSION(ij_nb,dimsize)     :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter2D_mpi_lgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp1",VarTmp1
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_LOGICAL,VarTmp2,ij_nb*dimsize,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp2",VarTmp2
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
+     ENDDO
+  ENDDO
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_lgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter2D_mpi_lgen
+
+
+SUBROUTINE orch_gather2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  INTEGER(i_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize)  :: VarIn
+  INTEGER(i_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: counts
+  INTEGER(i_std),DIMENSION(ij_nb,dimsize)   :: VarTmp1
+  INTEGER(i_std),DIMENSION(dimsize*iim*jjm) :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL,PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather2D_mpi_igen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+  ENDIF
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
+     ENDDO
+  ENDDO
+
+  IF (check) THEN
+     WRITE(numout,*) "orch_gather2D_mpi_igen VarIn=",VarIn    
+     WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp1=",VarTmp1
+  ENDIF
+  CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_INT_ORCH,VarTmp2,counts,displs,   &
+       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp2=",VarTmp2
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        DO i=1,dimsize
+           VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_igen VarOut=",VarOut
+
+END SUBROUTINE orch_gather2D_mpi_igen
+
+SUBROUTINE orch_gather2D_mpi_rgen(VarIn, VarOut, nbp2D,dimsize)
+  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  REAL(r_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize)  :: VarIn
+  REAL(r_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: counts
+  REAL(r_std),DIMENSION(ij_nb,dimsize)   :: VarTmp1
+  REAL(r_std),DIMENSION(dimsize*iim*jjm) :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL,PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather2D_mpi_rgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
+     ENDDO
+  ENDDO
+
+  IF (check) THEN
+     WRITE(numout,*) "orch_gather2D_mpi_rgen VarIn=",VarIn    
+     WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp1=",VarTmp1
+  ENDIF
+  CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_REAL_ORCH,VarTmp2,counts,displs,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp2=",VarTmp2
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        DO i=1,dimsize
+           VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_rgen VarOut=",VarOut
+
+END SUBROUTINE orch_gather2D_mpi_rgen
+
+SUBROUTINE orch_gather2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  LOGICAL,INTENT(IN),DIMENSION(iim*jj_nb,dimsize)  :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: counts
+  LOGICAL,DIMENSION(ij_nb,dimsize)   :: VarTmp1
+  LOGICAL,DIMENSION(dimsize*iim*jjm) :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL,PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather2D_mpi_lgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
+     ENDDO
+  ENDDO
+
+  IF (check) THEN
+     WRITE(numout,*) "orch_gather2D_mpi_lgen VarIn=",VarIn    
+     WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp1=",VarTmp1
+  ENDIF
+  CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_LOGICAL,VarTmp2,counts,displs,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp2=",VarTmp2
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        DO i=1,dimsize
+           VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_lgen VarOut=",VarOut
+
+END SUBROUTINE orch_gather2D_mpi_lgen
+
+SUBROUTINE orch_reduce_sum_mpi_igen(VarIn,VarOut,nb)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),DIMENSION(nb),INTENT(IN) :: VarIn
+  INTEGER(i_std),DIMENSION(nb),INTENT(OUT) :: VarOut    
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_reduce_sum_mpi_igen VarIn",VarIn
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INT_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr)
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_reduce_sum_mpi_igen VarOut",VarOut
+
+END SUBROUTINE orch_reduce_sum_mpi_igen
+
+SUBROUTINE orch_reduce_sum_mpi_rgen(VarIn,VarOut,nb)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  REAL(r_std),DIMENSION(nb),INTENT(IN) :: VarIn
+  REAL(r_std),DIMENSION(nb),INTENT(OUT) :: VarOut    
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarIn",VarIn
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr)
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarOut",VarOut
+
+END SUBROUTINE orch_reduce_sum_mpi_rgen
+
+#endif
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_omp_data.F90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_omp_data.F90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_omp_data.F90	(revision 6412)
@@ -0,0 +1,334 @@
+! ===============================================================================================================================
+! MODULE            : mod_orchidee_omp_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              Contains initialization and allocation of variables and functions related to OpenMP parallelization.
+!!
+!! \n DESCRIPTION   : Contains subroutines for initialization and allocation of variables and functions related to 
+!!                    OpenMP parallelization.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE mod_orchidee_omp_data
+
+!-
+  USE defprec
+  USE ioipsl
+  USE mod_orchidee_para_var
+
+  IMPLICIT NONE
+
+CONTAINS
+
+
+
+!! =============================================================================================================================
+!! SUBROUTINE   : barrier2_omp
+!!
+!>\BRIEF       	  this routine call two omp barrier to prevent a specific bug when orchidee is coupled to lmdz
+!!
+!! DESCRIPTION  : this routine call two omp barrier to prevent a specific bug when orchidee is coupled to lmdz
+!!
+!!                
+!! \n
+!_ ==============================================================================================================================
+
+    SUBROUTINE barrier2_omp()
+
+    IMPLICIT NONE
+
+!$OMP BARRIER
+!$OMP BARRIER
+
+  END SUBROUTINE barrier2_omp
+
+
+
+  
+!! =============================================================================================================================
+!! SUBROUTINE   : Init_orchidee_omp 
+!!
+!>\BRIEF          define the variables is_ok_omp, is_omp_root, omp_size and omp_rank  in the offline case
+!!
+!! DESCRIPTION  : define the variables is_ok_omp, is_omp_root, omp_size and omp_rank  in the offline case
+!!
+!!                
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE Init_orchidee_omp
+  IMPLICIT NONE
+  
+#ifdef CPP_OMP
+    IF (is_omp_root) THEN
+        is_ok_omp=.TRUE.
+    ENDIF
+#else    
+    is_ok_omp=.FALSE.
+#endif
+
+
+    IF (is_ok_omp) THEN
+      STOP 'Open MP is not yet implemented for driver'
+    ELSE
+      omp_size=1
+      omp_rank=0
+      is_omp_root=.TRUE.
+    ENDIF
+
+  END SUBROUTINE Init_orchidee_omp
+
+
+!! =============================================================================================================================
+!! SUBROUTINE   : Init_numout_omp  
+!!
+!>\BRIEF          Define a number for the output file specific to the omp thread. 	  
+!!
+!! DESCRIPTION  : Define a number for the output file specific to the omp thread. 	  
+!!
+!!                
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE Init_numout_omp(numout)
+    INTEGER, INTENT(in) :: numout
+    numout_omp=numout
+  END SUBROUTINE Init_numout_omp
+
+!! =============================================================================================================================
+!! SUBROUTINE   : Init_orchidee_omp_data  
+!!
+!>\BRIEF	  Omp parallelisation in the coupled case. 
+!!
+!! DESCRIPTION  : Omp parallelisation in the coupled case. In this routine we will define all omp variables
+!!                is_omp_root, omp_size, omp_rank, nbp_omp_para_nb, nbp_omp_para_begin, nbp_omp_para_end
+!!                 nbp_omp_begin, nbp_omp_end, nbp_omp
+!!
+!!                
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE Init_orchidee_omp_data(arg_omp_size,arg_omp_rank,arg_nbp_omp,arg_offset_omp)
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: arg_omp_size
+    INTEGER, INTENT(IN) :: arg_omp_rank
+    INTEGER, INTENT(IN) :: arg_nbp_omp
+    INTEGER, INTENT(IN) :: arg_offset_omp
+    
+    INTEGER    :: i
+    
+    
+    IF (arg_omp_rank==0) THEN
+      is_omp_root=.TRUE.
+    ELSE
+      is_omp_root=.FALSE.
+    ENDIF
+    
+#ifdef CPP_OMP
+    IF (is_omp_root) THEN
+        is_ok_omp=.TRUE.
+    ENDIF
+#else    
+    is_ok_omp=.FALSE.
+#endif
+
+    IF (is_omp_root) omp_size=arg_omp_size
+
+    CALL barrier2_omp()
+
+     omp_rank=arg_omp_rank
+    
+    IF (is_omp_root) THEN 
+      ALLOCATE(nbp_omp_para_nb(0:omp_size-1))
+      ALLOCATE(nbp_omp_para_begin(0:omp_size-1))
+      ALLOCATE(nbp_omp_para_end(0:omp_size-1))
+    ENDIF
+    
+    CALL barrier2_omp()
+    nbp_omp_para_nb(omp_rank)=arg_nbp_omp
+    CALL barrier2_omp()
+    
+    IF (is_omp_root) THEN
+
+      nbp_omp_para_begin(0)=1
+      nbp_omp_para_end(0)=nbp_omp_para_nb(0)
+
+      DO i=1,omp_size-1
+        nbp_omp_para_begin(i)=nbp_omp_para_end(i-1)+1
+        nbp_omp_para_end(i)=nbp_omp_para_begin(i)+nbp_omp_para_nb(i)-1
+      ENDDO
+
+    ENDIF
+
+    CALL barrier2_omp()
+     
+    nbp_omp=nbp_omp_para_nb(omp_rank)
+    nbp_omp_begin=nbp_omp_para_begin(omp_rank)
+    nbp_omp_end=nbp_omp_para_end(omp_rank)
+    
+    offset_omp=arg_offset_omp          
+    CALL Print_omp_data
+    
+    CALL Init_synchro_omp()
+    
+  END SUBROUTINE Init_orchidee_omp_data
+
+!! =============================================================================================================================
+!! SUBROUTINE   : print_omp_data
+!!
+!>\BRIEF	  print specific omp parallelisation variables 
+!!
+!! DESCRIPTION  : print specific omp parallelisation variables 
+!!
+!!                
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE print_omp_data
+  IMPLICIT NONE
+
+!$OMP CRITICAL  
+  PRINT *,'--------> ORCHIDEE TASK ',omp_rank
+  PRINT *,'omp_size =',omp_size
+  PRINT *,'omp_rank =',omp_rank
+  PRINT *,'is_omp_root =',is_omp_root
+  PRINT *,'offset_omp',offset_omp
+  PRINT *,'nbp_omp_para_nb =',nbp_omp_para_nb
+  PRINT *,'nbp_omp_para_begin =',nbp_omp_para_begin
+  PRINT *,'nbp_omp_para_end =',nbp_omp_para_end    
+  PRINT *,'nbp_omp =',nbp_omp
+  PRINT *,'nbp_omp_begin =',nbp_omp_begin
+  PRINT *,'nbp_omp_end =',nbp_omp_end    
+!$OMP END CRITICAL
+
+  END SUBROUTINE print_omp_data
+
+!! =============================================================================================================================
+!! SUBROUTINE   : Init_synchro_omp  
+!!
+!>\BRIEF          initialization of  some variables use for the synchronisation of omp threads
+!!
+!! DESCRIPTION  : initialization of  some variables use for the synchronisation of omp threads
+!!
+!!                
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE Init_synchro_omp
+  IMPLICIT NONE
+    
+    IF (is_omp_root) THEN
+      ALLOCATE(proc_synchro_omp(0:omp_size-1))
+      proc_synchro_omp(:)=.FALSE.
+
+      IF ( check_all_transfert ) THEN
+         ALLOCATE(omp_function(0:omp_size-1))
+         omp_function(:)=-1
+      ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+  END SUBROUTINE Init_Synchro_omp
+  
+!! =============================================================================================================================
+!! SUBROUTINE   : Synchro_omp 
+!!
+!>\BRIEF          routine to make synchronisation of omp threads after a call to a omp routine	  
+!!
+!! DESCRIPTION  : routine to make synchronisation of omp threads after a call to a omp routine
+!!                add a control to check the time waited for the synchronisation. 
+!!                
+!! \n
+!_ ==============================================================================================================================
+ 
+  SUBROUTINE Synchro_omp
+  IMPLICIT NONE
+    INTEGER iter
+    LOGICAL, PARAMETER :: check=.TRUE.
+    INTEGER, PARAMETER :: iter_max=1
+    INTEGER, PARAMETER :: print_iter=1
+
+    proc_synchro_omp(omp_rank)=.TRUE.
+    CALL barrier2_omp()
+
+    iter=0
+    DO WHILE (.NOT. ALL(proc_synchro_omp))
+       iter=iter+1
+       IF ( mod(iter,print_iter) == 0 ) THEN
+          IF (numout_omp > 0) THEN
+             WRITE(numout_omp,*) "ORCHIDEE SYNCHRO OMP : iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
+          ELSE
+             WRITE(*,*) "ORCHIDEE SYNCHRO OMP : iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
+          ENDIF
+       ENDIF
+       IF (check) THEN
+          IF (iter > iter_max) THEN
+             IF (numout_omp > 0) THEN
+                WRITE(numout_omp,*) "TOO MUCH WAIT in Synchro_Omp !! iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
+                WRITE(numout_omp,*) "We stop here"
+                WRITE(numout_omp,*) "omp_function : ",omp_function(:)
+             ELSE
+                WRITE(*,*) "TOO MUCH WAIT in Synchro_Omp !! iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
+                WRITE(*,*) "We stop here"
+                WRITE(*,*) "omp_function : ",omp_function(:)
+             ENDIF
+#ifdef CPP_PARA
+             CALL MPI_ABORT(4)
+#endif     
+             STOP 'Fatal error from ORCHIDEE : Synchro_Omp failed'
+          ENDIF
+       ENDIF
+    CALL barrier2_omp()
+    ENDDO
+    CALL barrier2_omp()
+    proc_synchro_omp(omp_rank)=.FALSE.
+    CALL barrier2_omp()
+
+   END SUBROUTINE Synchro_omp
+
+!! =============================================================================================================================
+!! SUBROUTINE   : print_omp_function
+!!
+!>\BRIEF	  
+!!
+!! DESCRIPTION:	  
+!!
+!!                
+!! \n
+!_ ==============================================================================================================================
+
+   SUBROUTINE print_omp_function ()
+
+     IF ( check_all_transfert ) THEN
+        CALL barrier2_omp()
+        IF (numout_omp > 0) THEN
+           WRITE(numout_omp,*) omp_rank,&
+                " : ",omp_fct_name(omp_previous),'->',omp_fct_name(omp_function(omp_rank))
+           IF (MINVAL(omp_function(:)).LT.MAXVAL(omp_function(:))) &
+                WRITE(numout_omp,*) "!!! OMP ERROR : NO MORE SYNCHRO  !!!  ",omp_function(:)
+        ELSE
+           WRITE(*,*) omp_rank,&
+                " : ",omp_fct_name(omp_previous),'->',omp_fct_name(omp_function(omp_rank))
+           IF (MINVAL(omp_function(:)).LT.MAXVAL(omp_function(:))) &
+                WRITE(*,*) "!!! OMP ERROR : NO MORE SYNCHRO  !!!  ",omp_function(:)
+        ENDIF
+        CALL barrier2_omp()
+     ENDIF
+
+  END SUBROUTINE print_omp_function
+
+
+END MODULE mod_orchidee_omp_data
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_omp_transfert.F90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_omp_transfert.F90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_omp_transfert.F90	(revision 6412)
@@ -0,0 +1,2381 @@
+! ==============================================================================================================================
+! MODULE            : mod_orchidee_omp_transfert
+!
+! CONTACT           : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE           : IPSL (2006)
+!                     This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF              Low level OpenMP parallel communication encapsulations for ORCHIDEE.
+!!
+!!\n DESCRIPTION    : Low level OpenMP parallel communication encapsulations for ORCHIDEE.
+!!                    The interfaces in this module are only used by mod_orchidee_transfert_para to create high level interfaces.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE mod_orchidee_omp_transfert
+  !-
+  USE mod_orchidee_omp_data
+  USE ioipsl
+  !-
+  IMPLICIT NONE
+
+  PRIVATE
+  
+#ifdef CPP_OMP
+  ! Check OpenMP buffer sizes increase.
+  LOGICAL, PARAMETER :: check_size = .FALSE.
+
+  INTEGER,PARAMETER :: grow_factor=1.5
+  INTEGER,PARAMETER :: size_min=1024
+  PUBLIC size_min
+
+  INTEGER(i_std),SAVE,ALLOCATABLE,DIMENSION(:) :: omp_ibuffer
+  INTEGER,SAVE                            :: size_i=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: omp_lbuffer
+  INTEGER,SAVE                            :: size_l=0
+  REAL(r_std),SAVE,ALLOCATABLE,DIMENSION(:) :: omp_rbuffer
+  INTEGER,SAVE                            :: size_r=0
+  CHARACTER(len=size_min), SAVE,ALLOCATABLE,DIMENSION(:) :: omp_cbuffer
+  INTEGER,SAVE                            :: size_c=0
+
+#endif
+
+  !! ==============================================================================================================================
+  !! INTERFACE   :  bcast_omp
+  !!
+  !>\BRIEF          Send a variable from master thread to all threads OMP  
+  !!
+  !! DESCRIPTION : NONE
+  !!
+  !! \n
+  !_ ================================================================================================================================
+
+  INTERFACE bcast_omp
+     MODULE PROCEDURE bcast_omp_c, bcast_omp_c1,                                       &
+          bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, &
+          bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, &
+          bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
+  END INTERFACE
+
+  !! ==============================================================================================================================
+  !! INTERFACE   : scatter_omp
+  !!
+  !>\BRIEF         Distribute a  field on the process MPI grid from the master thread to the local domain on each threads omp
+  !!
+  !! DESCRIPTION : NONE
+  !!
+  !! \n
+  !_ ================================================================================================================================
+
+  INTERFACE scatter_omp
+     MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3,scatter_omp_i4, &
+          scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3,scatter_omp_r4, &
+          scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3,scatter_omp_l4
+  END INTERFACE
+
+  !! ==============================================================================================================================
+  !! INTERFACE   : gather_omp
+  !!
+  !>\BRIEF         Each thread OMP  send their local field to the master thread which will recieve 
+  !!               the field on the MPI domain 
+  !!
+  !! DESCRIPTION : NONE
+  !!
+  !! \n
+  !_ ================================================================================================================================
+
+  INTERFACE gather_omp
+     MODULE PROCEDURE gather_omp_i0,gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3,gather_omp_i4,gather_omp_i5, &
+          gather_omp_r0,gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3,gather_omp_r4,gather_omp_r5, &
+          gather_omp_l0,gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3,gather_omp_l4,gather_omp_l5
+  END INTERFACE
+
+  !! ==============================================================================================================================
+  !! INTERFACE    : reduce_sum_omp
+  !! 
+  !>\BRIEF          The master thread will recieve the sum of the values from all threads 
+  !!
+  !! DESCRIPTION  : NONE
+  !!
+  !! \n
+  !_ ================================================================================================================================
+
+  INTERFACE reduce_sum_omp
+     MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, &
+          reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4
+  END INTERFACE
+
+  PUBLIC  bcast_omp,scatter_omp,gather_omp,reduce_sum_omp
+
+  CONTAINS
+
+  SUBROUTINE check_buffer_c(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 72 
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+    IF (is_omp_root) THEN
+       IF (buff_size>size_c) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for strings : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for strings : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_cbuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_cbuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_cbuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_cbuffer)) DEALLOCATE(omp_cbuffer)
+          size_c=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_c
+             ELSE
+               WRITE(*,*) size_c
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_cbuffer(size_c))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_c
+
+  SUBROUTINE check_buffer_i(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 1 
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+
+    IF (is_omp_root) THEN
+       IF (buff_size>size_i) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for integers : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for integers : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_ibuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_ibuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_ibuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_ibuffer)) DEALLOCATE(omp_ibuffer)
+          size_i=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_i
+             ELSE
+               WRITE(*,*) size_i
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_ibuffer(size_i))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_i
+  
+  SUBROUTINE check_buffer_r(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 2
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+
+    IF (is_omp_root) THEN
+       IF (buff_size>size_r) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for reals : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for reals : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_rbuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_rbuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_rbuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_rbuffer)) DEALLOCATE(omp_rbuffer)
+          size_r=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_r
+             ELSE
+               WRITE(*,*) size_r
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_rbuffer(size_r))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_r
+  
+  SUBROUTINE check_buffer_l(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 3
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+
+    IF (is_omp_root) THEN
+       IF (buff_size>size_l) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for logicals : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for logicals : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_lbuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_lbuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_lbuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_lbuffer)) DEALLOCATE(omp_lbuffer)
+          size_l=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_l
+             ELSE
+               WRITE(*,*) size_l
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_lbuffer(size_l))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_l
+    
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition of Broadcast 1D --> 4D !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !! -- Character Strings -- !!
+
+  SUBROUTINE bcast_omp_c(Var)
+    IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    CHARACTER(LEN=80),DIMENSION(1) :: Var1
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 4
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var1(1)=Var
+    CALL check_buffer_c(1)
+    CALL orch_bcast_omp_cgen(Var1,1,omp_cbuffer)
+    Var=Var1(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_c
+
+  SUBROUTINE bcast_omp_c1(Var)
+    IMPLICIT NONE
+    CHARACTER(LEN=*),DIMENSION(:),INTENT(INOUT) :: Var
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 4
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_c(size(Var))
+    CALL orch_bcast_omp_cgen(Var,size(Var),omp_cbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_c1
+
+  !! -- Integers -- !!
+
+  SUBROUTINE bcast_omp_i(var1)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var1
+
+    INTEGER,DIMENSION(1) :: Var
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 5
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var(1)=Var1
+    CALL check_buffer_i(1)
+    CALL orch_bcast_omp_igen(Var,1,omp_ibuffer)
+    Var1=Var(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i
+
+  SUBROUTINE bcast_omp_i1(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 6
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i1
+
+  SUBROUTINE bcast_omp_i2(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 7
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i2
+
+  SUBROUTINE bcast_omp_i3(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 8
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i3
+
+  SUBROUTINE bcast_omp_i4(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 9
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i4
+
+
+  !! -- Reals -- !!
+
+  SUBROUTINE bcast_omp_r(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+
+    REAL,DIMENSION(1) :: Var1
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=10
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var1(1)=Var
+    CALL check_buffer_r(1)
+    CALL orch_bcast_omp_rgen(Var1,1,omp_rbuffer)
+    Var=Var1(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r
+
+  SUBROUTINE bcast_omp_r1(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=11
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r1
+
+  SUBROUTINE bcast_omp_r2(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=12
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r2
+
+  SUBROUTINE bcast_omp_r3(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=13
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r3
+
+  SUBROUTINE bcast_omp_r4(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=14
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r4
+
+  !! -- Logicals -- !!
+
+  SUBROUTINE bcast_omp_l(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+
+    LOGICAL,DIMENSION(1) :: Var1
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=15
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var1(1)=Var
+    CALL check_buffer_l(1)
+    CALL orch_bcast_omp_lgen(Var1,1,omp_lbuffer)
+    Var=Var1(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l
+
+  SUBROUTINE bcast_omp_l1(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=16
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l1
+
+  SUBROUTINE bcast_omp_l2(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=17
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l2
+
+  SUBROUTINE bcast_omp_l3(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=18
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l3
+
+  SUBROUTINE bcast_omp_l4(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=19
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!  Definition of Scatter 1D --> 4D  !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_omp_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=20
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i
+
+  SUBROUTINE scatter_omp_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=21
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i1
+
+  SUBROUTINE scatter_omp_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=22
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else    
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i2
+
+  SUBROUTINE scatter_omp_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=23
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else    
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i3
+
+  SUBROUTINE scatter_omp_i4(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=23
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else    
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i4
+
+
+  SUBROUTINE scatter_omp_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=24
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r
+
+  SUBROUTINE scatter_omp_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=25
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r1
+
+  SUBROUTINE scatter_omp_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=26
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r2
+
+  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=27
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r3
+
+  SUBROUTINE scatter_omp_r4(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=27
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r4
+
+
+  SUBROUTINE scatter_omp_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=28
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,1,omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l
+
+  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=29
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l1
+
+  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=30
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l2
+
+  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=31
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_lbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l3
+
+  SUBROUTINE scatter_omp_l4(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=31
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5),omp_lbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!  Definition of Gather 1D --> 4D  !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather_omp_i0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN)               :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=32
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_simple_igen(VarIn,Varout,omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i0
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_omp_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=33
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i
+
+
+  SUBROUTINE gather_omp_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=34
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i1
+
+
+  SUBROUTINE gather_omp_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=35
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i2
+
+
+  SUBROUTINE gather_omp_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=36
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i3
+
+  SUBROUTINE gather_omp_i4(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=36
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i4
+
+  SUBROUTINE gather_omp_i5(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=36
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:,:,:)=VarIn(:,:,:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)*SIZE(VarIn,6),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i5
+
+!!!!! --> Reals
+
+  SUBROUTINE gather_omp_r0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN)               :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=37
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_simple_rgen(VarIn,Varout,omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r0
+
+  SUBROUTINE gather_omp_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=38
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r
+
+
+  SUBROUTINE gather_omp_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=39
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r1
+
+
+  SUBROUTINE gather_omp_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=40
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r2
+
+
+  SUBROUTINE gather_omp_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=41
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r3
+
+
+  SUBROUTINE gather_omp_r4(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=41
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r4
+
+
+  SUBROUTINE gather_omp_r5(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=41
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:,:,:)=VarIn(:,:,:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)*SIZE(VarIn,6),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r5
+
+!!!!! --> Logicals
+
+  SUBROUTINE gather_omp_l0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN)               :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=42
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_simple_lgen(VarIn,Varout,omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l0
+
+  SUBROUTINE gather_omp_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=43
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,1,omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l
+
+
+  SUBROUTINE gather_omp_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=44
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l1
+
+
+  SUBROUTINE gather_omp_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=45
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l2
+
+
+  SUBROUTINE gather_omp_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=46
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l3
+
+
+  SUBROUTINE gather_omp_l4(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=46
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l4
+
+
+  SUBROUTINE gather_omp_l5(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=46
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:,:,:)=VarIn(:,:,:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)*SIZE(VarIn,6),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l5
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition of reduce_sum 1D --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=47
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut=VarIn
+    RETURN
+#else
+    CALL check_buffer_i(1)   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i
+
+  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=48
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif   
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i1
+
+  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=49
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i2
+
+  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=50
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i3
+
+  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=51
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i4
+
+
+  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=52
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut=VarIn
+    RETURN
+#else
+    CALL check_buffer_r(1)   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r
+
+  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=53
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif   
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r1
+
+  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=54
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r2
+
+  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=55
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r3
+
+  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=56
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r4
+
+END MODULE mod_orchidee_omp_transfert
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+#ifdef CPP_OMP
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION OF GENERIC TRANSFERT SUBROUTINES     !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE orch_bcast_omp_cgen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+  USE mod_orchidee_omp_transfert, ONLY : size_min
+
+  IMPLICIT NONE
+  INTEGER,INTENT(IN)              :: Nb 
+  CHARACTER(LEN=*),DIMENSION(Nb),INTENT(INOUT) :: Var
+  CHARACTER(LEN=*),DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER :: i
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=57
+    CALL print_omp_function()
+  ENDIF
+
+  IF (check) THEN
+     IF (numout_omp > 0) THEN
+        WRITE(numout_omp,*) "orch_bcast_omp_cgen before bcast Var",Var
+     ELSE
+        WRITE(*,*) "orch_bcast_omp_cgen before bcast Var",Var
+     ENDIF
+  ENDIF
+
+  IF (is_omp_root) THEN
+     IF ( len(Var) > size_min ) &
+          CALL ipslerr (3,'orch_bcast_omp_cgen', &
+          &          'Error with omp_cbuffer.', 'len(Var) > size_min', &
+          &          '(Increase size_min in mod_orchidee_omp_transfert.)')
+     DO i=1,Nb
+        Buff(i)=TRIM(Var(i))
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+  CALL barrier2_omp()
+      
+  IF (check) THEN
+     IF (numout_omp > 0) THEN
+        WRITE(numout_omp,*) "orch_bcast_omp_cgen after bcast Var",Var
+     ELSE
+        WRITE(*,*) "orch_bcast_omp_cgen after bcast Var",Var
+     ENDIF
+  ENDIF
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_cgen
+
+
+
+SUBROUTINE orch_bcast_omp_igen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
+  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER,INTENT(IN) :: Nb  
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=58
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,Nb
+        Buff(i)=Var(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_igen
+
+
+
+SUBROUTINE orch_bcast_omp_rgen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+  REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER,INTENT(IN) :: Nb
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=59
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,Nb
+        Buff(i)=Var(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_rgen
+
+
+
+SUBROUTINE orch_bcast_omp_lgen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER,INTENT(IN) :: Nb
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=60
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,Nb
+        Buff(i)=Var(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_lgen
+
+
+
+SUBROUTINE orch_scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  INTEGER,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=61
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_omp_igen
+
+
+SUBROUTINE orch_scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  REAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  REAL,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=62
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_omp_rgen
+
+
+SUBROUTINE orch_scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  LOGICAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=63
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_omp_lgen
+
+
+
+SUBROUTINE orch_gather_omp_simple_igen(VarIn,VarOut,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN)                            :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
+
+  Buff(omp_rank)=VarIn
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=64
+    CALL print_omp_function()
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_simple_igen
+
+SUBROUTINE orch_gather_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  INTEGER,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=65
+    CALL print_omp_function()
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           VarOut(ij,i)=Buff(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_igen
+
+
+SUBROUTINE orch_gather_omp_simple_rgen(VarIn,VarOut,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  REAL,INTENT(IN)                            :: VarIn
+  REAL,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=66
+    CALL print_omp_function()
+  ENDIF
+
+  Buff(omp_rank)=VarIn
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_simple_rgen
+
+
+SUBROUTINE orch_gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  REAL,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
+  REAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=67
+    CALL print_omp_function()
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           VarOut(ij,i)=Buff(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_rgen
+
+
+SUBROUTINE orch_gather_omp_simple_lgen(VarIn,VarOut,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  LOGICAL,INTENT(IN)                            :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=68
+    CALL print_omp_function()
+  ENDIF
+
+  Buff(omp_rank)=VarIn
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_simple_lgen
+
+
+SUBROUTINE orch_gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  LOGICAL,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=69
+    CALL print_omp_function()
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           VarOut(ij,i)=Buff(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_lgen
+
+
+
+SUBROUTINE orch_reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=70
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) Buff(:)=0
+
+  CALL barrier2_omp()
+
+!$OMP CRITICAL     
+  DO i=1,dimsize
+     Buff(i)=Buff(i)+VarIn(i)
+  ENDDO
+!$OMP END CRITICAL
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        VarOut(i)=Buff(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_reduce_sum_omp_igen
+
+
+SUBROUTINE orch_reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
+  REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=71
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) Buff(:)=0
+
+  CALL barrier2_omp()
+
+!$OMP CRITICAL     
+  DO i=1,dimsize
+     Buff(i)=Buff(i)+VarIn(i)
+  ENDDO
+!$OMP END CRITICAL
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        VarOut(i)=Buff(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_reduce_sum_omp_rgen
+
+#endif
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_para.F90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_para.F90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_para.F90	(revision 6412)
@@ -0,0 +1,310 @@
+! ==============================================================================================================================
+! MODULE          : mod_orchidee_para
+!
+! CONTACT         : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE         : IPSL (2006)
+!                   This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF            Initialization of MPI and OpenMP parallelization.
+!!
+!!\n DESCRIPTION  : This module contains subroutines to be called for the initialization of MPI and OpenMP parallelization. 
+!!                  Note that some subroutines are called only for the offline case such as init_orchidee_para and 
+!!                  init_orchidee_data_para_driver.
+!!
+!! SVN            :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE mod_orchidee_para
+
+  USE mod_orchidee_para_var
+  USE mod_orchidee_mpi_data
+  USE mod_orchidee_omp_data
+  USE mod_orchidee_transfert_para
+    
+CONTAINS
+    
+  !! =============================================================================================================================
+  !! SUBROUTINE   : Init_orchidee_para
+  !!
+  !>\BRIEF	    Initialization of MPI and OpenMP parallelization in offline case
+  !!
+  !! DESCRIPTION  : First subroutine for initialization to be called for the initialization of the MPI and OpenMP parallelization
+  !!                in offline mode. This routine will call the successively the initialization for OMP then for MPI.
+  !!                We define in this routine the variable "is_root_prc = is_mpi_root AND is_omp_root".
+  !!
+  !! \n
+  !_ ============================================================================================================================== 
+
+  SUBROUTINE Init_orchidee_para(communicator)
+    IMPLICIT NONE
+    INTEGER,OPTIONAL,INTENT(in) :: communicator	
+
+    CALL Init_orchidee_omp
+
+
+    IF ( PRESENT(communicator) ) THEN
+       CALL Init_orchidee_mpi(communicator)
+    ELSE
+       CALL Init_orchidee_mpi
+    ENDIF
+
+
+    IF (is_mpi_root .AND. is_omp_root) THEN
+       is_root_prc=.TRUE.
+    ELSE
+       is_root_prc=.FALSE.
+    ENDIF
+  END SUBROUTINE Init_orchidee_para
+    
+  
+  !! =============================================================================================================================
+  !! SUBROUTINE   : Init_orchidee_data_para_driver
+  !!
+  !>\BRIEF	    Initialization of variables related to the local domain decomposition called by the offline driver.
+  !!
+  !! DESCRIPTION  : Initialization of variables related to the local domain decomposition.
+  !!                This subroutine is only called in offline mode by the driver. 
+  !!
+  !! \n
+  !_ ============================================================================================================================== 
+
+  SUBROUTINE Init_orchidee_data_para_driver(nbp,kindex_glo)
+
+    IMPLICIT NONE
+    INTEGER,INTENT(IN) :: nbp
+    INTEGER,INTENT(IN) :: kindex_glo(nbp)
+      
+    INTEGER :: first_point
+    INTEGER :: last_point
+    INTEGER :: nbp_loc
+    INTEGER :: nbp_loc_para(0:mpi_size-1)
+    INTEGER,ALLOCATABLE :: kindex_loc(:)
+    INTEGER :: offset
+    INTEGER :: i
+    
+      
+    last_point=0
+    
+    CALL read_load_balance(nbp,nbp_loc_para)    
+    
+    DO i=0,mpi_rank
+       nbp_loc=nbp_loc_para(i)
+       First_point=last_point+1
+       Last_point=last_point+nbp_loc
+    ENDDO
+    
+    ALLOCATE(kindex_loc(nbp_loc))
+    DO i=1,nbp_loc
+       kindex_loc(i)=kindex_glo(i+First_Point-1)
+    ENDDO
+    
+    IF (mpi_rank==0) THEN
+       offset=0
+    ELSE
+       offset=kindex_glo(First_point-1)-MOD(kindex_glo(First_point-1),iim_g)
+    ENDIF
+
+    kindex_loc(:)=kindex_loc(:)-offset
+
+    CALL Init_orchidee_data_para(nbp_loc,kindex_loc,offset,omp_size,omp_rank,MPI_COMM_ORCH)
+    CALL Set_stdout_file('out_orchidee')
+    CALL ipslnlf(new_number=numout)
+        
+  END SUBROUTINE Init_orchidee_data_para_driver
+    
+  
+  !! =============================================================================================================================
+  !! SUBROUTINE   : Init_orchidee_data_para
+  !!
+  !>\BRIEF	    Initialization of MPI and OpenMP parallelization.
+  !!
+  !! DESCRIPTION  : Initialization of MPI and OpenMP parallelization.
+  !!                This subroutine is called from both the offline driver and from the initialization routine for the coupled mode. 
+  !!                This routine will call the successively the initialization for omp and then for mpi.
+  !!                We define in this routine the variable "is_root_prc = is_mpi_root AND is_omp_root".
+  !!
+  !! \n
+  !_ ============================================================================================================================== 
+
+  SUBROUTINE Init_orchidee_data_para(nbp,kindex,arg_offset,arg_omp_size,arg_omp_rank,COMM)
+
+    IMPLICIT NONE
+    INTEGER,INTENT(IN)     :: nbp
+    INTEGER,INTENT(IN)     :: kindex(nbp)
+    INTEGER,INTENT(IN)     :: arg_offset
+    INTEGER,INTENT(IN)     :: arg_omp_size
+    INTEGER,INTENT(IN)     :: arg_omp_rank
+    INTEGER,INTENT(IN)     :: COMM
+    
+    INTEGER,SAVE              :: arg_nbp_mpi
+    INTEGER,ALLOCATABLE,SAVE  :: kindex_mpi(:)
+    
+    offset=arg_offset 
+    CALL init_orchidee_omp_data(arg_omp_size,arg_omp_rank,nbp,offset)
+    
+    IF (is_omp_root) THEN
+       arg_nbp_mpi=SUM(nbp_omp_para_nb(:))
+       ALLOCATE(kindex_mpi(arg_nbp_mpi))
+    ENDIF
+
+    CALL barrier2_omp()
+    kindex_mpi(nbp_omp_begin:nbp_omp_end)=kindex(:)+offset
+    CALL barrier2_omp()
+      
+    IF (is_omp_root) THEN      
+       kindex_mpi(:)=kindex_mpi(:)-offset
+       CALL init_orchidee_mpi_data(arg_nbp_mpi,kindex_mpi,offset,COMM)
+       nbp_glo=SUM(nbp_mpi_para(:))
+    ENDIF
+    CALL barrier2_omp()
+
+    nbp_loc=nbp
+
+    ! Define is_root_prc
+    ! Note that this is already done in init_orchidee_para for the offline case but it is done here again for the coupled case. 
+    IF (is_mpi_root .AND. is_omp_root) THEN
+       is_root_prc=.TRUE.
+    ELSE
+       is_root_prc=.FALSE.
+    ENDIF
+    
+    CALL Test_orchidee_para
+
+  END SUBROUTINE Init_orchidee_data_para
+    
+  !! =============================================================================================================================
+  !! SUBROUTINE   : Set_stdout_file
+  !!
+  !>\BRIEF	    for each output file will give a unit number for the write function
+  !!
+  !! DESCRIPTION  : for each output file will give a unit number for the write function
+  !!
+  !! \n
+  !_ ============================================================================================================================== 
+
+  SUBROUTINE Set_stdout_file(filename)
+
+    IMPLICIT NONE
+
+    CHARACTER(len=*), INTENT(IN) :: filename
+    CHARACTER(len=255) :: fileout
+    CHARACTER(len=4)  :: num_mpi
+    CHARACTER(len=4)  :: num_omp
+    INTEGER,PARAMETER :: base_numout=100
+    INTEGER           :: ierr
+
+    IF (is_ok_mpi) THEN
+       WRITE(num_mpi,'(I4.4)') mpi_rank
+    ENDIF
+    
+    IF (is_ok_omp) THEN
+       WRITE(num_omp,'(I4.4)') omp_rank
+    ENDIF
+    
+     
+    IF (is_ok_mpi .AND. is_ok_omp) THEN
+       fileout=TRIM(filename)//'_'//num_mpi//'.'//num_omp
+       numout=base_numout+omp_rank
+    ELSE IF (is_ok_mpi .AND. (.NOT. is_ok_omp)) THEN
+       fileout=TRIM(filename)//'_'//num_mpi
+       numout=base_numout
+    ELSE IF ((.NOT. is_ok_mpi) .AND. is_ok_omp) THEN
+       fileout=TRIM(filename)//'_'//num_omp
+       numout=base_numout+omp_rank
+    ELSE
+       fileout=TRIM(filename)
+       numout=base_numout
+    ENDIF
+!$OMP CRITICAL  
+    WRITE(*,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
+!$OMP END CRITICAL
+    
+    OPEN(UNIT=numout,FILE=TRIM(fileout),ACTION='write',STATUS='unknown',FORM='formatted',IOSTAT=ierr) 
+    IF (ierr /= 0) THEN
+#ifdef CPP_PARA
+       CALL MPI_FINALIZE(ierr)
+#endif
+       WRITE(*,*) "In Set_stdout_file : Erreur can't open file ", filename
+       STOP 1
+    ENDIF
+ 
+!$OMP CRITICAL  
+    WRITE(numout,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
+!$OMP END CRITICAL
+
+    CALL Init_numout_omp(numout)
+
+  END SUBROUTINE Set_stdout_file
+      
+  !! =============================================================================================================================
+  !! SUBROUTINE   : Test_orchidee_para
+  !!
+  !>\BRIEF	 
+  !!
+  !! DESCRIPTION  :	
+  !!
+  !! \n
+  !_ ============================================================================================================================== 
+
+  SUBROUTINE Test_orchidee_para
+
+    IMPLICIT NONE
+
+    INTEGER,PARAMETER :: dimsize=3
+    REAL :: Array(nbp_loc,dimsize)
+    REAL :: Array_glo(nbp_glo,dimsize)
+    REAL :: Array_glo_tmp(nbp_glo,dimsize)
+    REAL :: Array2D_loc(iim_g,jj_nb)
+    REAL :: Array2D_glo(iim_g,jjm_g)
+    REAL :: sum1,sum2,sum3
+    
+    INTEGER :: i,j
+    
+    DO j=1,dimsize
+       DO i=1,nbp_loc
+          Array(i,j)=10*j+omp_rank+i*1000
+       ENDDO
+    ENDDO
+      
+    CALL gather(Array,Array_glo)
+    CALL bcast(Array_glo)
+    CALL scatter(Array_glo,array)
+    CALL gather(array,array_glo_tmp)
+    CALL bcast(array_glo_tmp)    
+    WRITE(*,*) "1) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",SUM(array_glo-array_glo_tmp)
+
+    sum1=SUM(array)
+    CALL reduce_sum(sum1,sum2)
+    CALL bcast(sum2)
+    sum3=SUM(array_glo)
+    WRITE(*,*) "2) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum2
+    
+    IF (is_omp_root) THEN
+       DO j=1,jjm_g
+          DO i=1,iim_g
+             Array2D_glo(i,j)=(j-1)*iim_g+i
+          ENDDO
+       ENDDO
+        
+       array2D_loc(:,:)=0
+       CALL scatter2D_mpi(array2D_glo,array2D_loc)
+       array2D_glo(:,:)=0
+       CALL gather2D_mpi(array2D_loc,array2D_glo)
+       CALL bcast_mpi(array2D_glo)
+       sum1=SUM(array2D_glo)
+       sum2=SUM(array2D_loc)
+       CALL reduce_sum_mpi(sum2,sum3)
+       CALL bcast_mpi(sum3)
+       
+       WRITE(*,*) "3) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum1
+    ENDIF
+    CALL barrier2_omp()
+
+  END SUBROUTINE  Test_orchidee_para
+  
+END MODULE mod_orchidee_para
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_para_var.F90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_para_var.F90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_para_var.F90	(revision 6412)
@@ -0,0 +1,255 @@
+! ================================================================================================================================
+!  MODULE          : mod_orchidee_para_var
+!
+!  CONTACT         : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE         : IPSL (2006)
+!                    This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF             This module contains public variables for parallelization and domain decomposition.
+!!
+!!\n DESCRIPTION   : This module contains public variables for parallelization and domain decomposition. 
+!!                   The variables in here can be used by USE mod_orchidee_para. Only at some specific cases it it needed to 
+!!                   use this module directly to avoid depencendy problems.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	   : None
+!!
+!! SVN             :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE mod_orchidee_para_var
+
+  USE defprec
+
+  !
+  ! 1. Variables related to the MPI parallelization and the MPI horizontal domain decompostion. 
+  !    These variables were previously declared in mod_orchidee_mpi_data
+  !
+
+  ! Unit for output messages
+  INTEGER(i_std), SAVE :: numout = 6
+  !$OMP THREADPRIVATE(numout)
+
+  INTEGER,SAVE :: mpi_size                                            !! Number of parallel processes
+  INTEGER,SAVE :: mpi_rank                                            !! my rank num
+  INTEGER,SAVE :: mpi_rank_root                                       !! rank of MPI root
+  LOGICAL,SAVE :: is_mpi_root                                         !! Only MPI root proc is true
+  LOGICAL,SAVE :: is_ok_mpi                                           
+
+  INTEGER(i_std),SAVE              :: nbp_mpi                         !! number of local continental points in each mpi group
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_mpi_para
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_mpi_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_mpi_para_end 
+
+  INTEGER,SAVE :: nbp_mpi_begin
+  INTEGER,SAVE :: nbp_mpi_end
+
+  ! i x j 2D points (not land points) index
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_nb           ! Number of 2D points for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_begin        ! First 2D point for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_end          ! Last 2D point for each mpi_rank block
+  ! i 2D index 
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_begin        ! First i index of 2D point for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_end          ! Last i index of 2D point for each mpi_rank block
+  ! j 2D index
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_nb           ! Number of complete j lines for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_begin        ! First j index of 2D point for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_end          ! Last j index of 2D point for each mpi_rank block
+
+  INTEGER,SAVE :: ii_begin
+  INTEGER,SAVE :: ii_end
+  INTEGER,SAVE :: jj_begin
+  INTEGER,SAVE :: jj_end
+  INTEGER,SAVE :: jj_nb
+  INTEGER,SAVE :: ij_begin
+  INTEGER,SAVE :: ij_end
+  INTEGER,SAVE :: ij_nb
+
+  INTEGER,SAVE :: MPI_COMM_ORCH
+  INTEGER,SAVE :: MPI_REAL_ORCH
+  INTEGER,SAVE :: MPI_INT_ORCH
+  LOGICAL, SAVE :: cpl_lmdz
+
+  INTEGER,SAVE,ALLOCATABLE :: kindex_mpi (:)
+  INTEGER,SAVE             :: offset_mpi
+
+
+  !
+  ! 2. Variables related to the OpenMP paralelization and OpenMP horizontal domain decomposition 
+  !    These variables were previously declared in mod_orchidee_omp_data
+  !
+
+  ! Check all OpenMP transferts in ORCHIDEE : use this flag to debug synchronism with OpenMP 
+  LOGICAL, PARAMETER :: check_all_transfert=.FALSE.
+
+
+  INTEGER(i_std),SAVE :: omp_size
+  INTEGER(i_std),SAVE :: omp_rank
+  LOGICAL,SAVE :: is_omp_root
+  LOGICAL,SAVE :: is_ok_omp
+  !$OMP  THREADPRIVATE(omp_rank,is_omp_root)
+
+  INTEGER(i_std),SAVE,DIMENSION(:),ALLOCATABLE :: nbp_omp_para_nb
+  INTEGER(i_std),SAVE,DIMENSION(:),ALLOCATABLE :: nbp_omp_para_begin
+  INTEGER(i_std),SAVE,DIMENSION(:),ALLOCATABLE :: nbp_omp_para_end    
+
+  INTEGER(i_std),SAVE :: nbp_omp
+  INTEGER(i_std),SAVE :: nbp_omp_begin
+  INTEGER(i_std),SAVE :: nbp_omp_end
+  INTEGER(i_std),SAVE :: offset_omp
+  !$OMP  THREADPRIVATE(nbp_omp,nbp_omp_begin,nbp_omp_end,offset_omp)
+
+  ! Flag for each OMP process for ORCHIDEE to verify synchronization if function Synchro_Omp is used
+  LOGICAL,SAVE,ALLOCATABLE :: proc_synchro_omp(:)
+
+  INTEGER, SAVE :: numout_omp = -1
+  !$OMP  THREADPRIVATE(numout_omp)
+
+  ! For debugging OpenMP processes : id of OMP function for each task.
+  ! If one task is not in the same function, we can see it.
+  INTEGER(i_std),SAVE,ALLOCATABLE,DIMENSION(:) :: omp_function
+  ! It is not SHARED.
+  ! List of values :
+  CHARACTER(LEN=28), PARAMETER :: omp_fct_name(-1:72) = (/ &
+       "Initialization              ", &
+       "Synchro_Omp                 ", &
+       "check_buffer_i              ", &
+       "check_buffer_r              ", &
+       "check_buffer_l              ", &
+       "bcast_omp_c                 ", &
+       "bcast_omp_i                 ", &
+       "bcast_omp_i1                ", &
+       "bcast_omp_i2                ", &
+       "bcast_omp_i3                ", &
+       "bcast_omp_i4                ", &
+       "bcast_omp_r                 ", &
+       "bcast_omp_r1                ", &
+       "bcast_omp_r2                ", &
+       "bcast_omp_r3                ", &
+       "bcast_omp_r4                ", &
+       "bcast_omp_l                 ", &
+       "bcast_omp_l1                ", &
+       "bcast_omp_l2                ", &
+       "bcast_omp_l3                ", &
+       "bcast_omp_l4                ", &
+       "scatter_omp_i               ", &
+       "scatter_omp_i1              ", &
+       "scatter_omp_i2              ", &
+       "scatter_omp_i3              ", &
+       "scatter_omp_r               ", &
+       "scatter_omp_r1              ", &
+       "scatter_omp_r2              ", &
+       "scatter_omp_r3              ", &
+       "scatter_omp_l               ", &
+       "scatter_omp_l1              ", &
+       "scatter_omp_l2              ", &
+       "scatter_omp_l3              ", &
+       "gather_omp_i0               ", &
+       "gather_omp_i                ", &
+       "gather_omp_i1               ", &
+       "gather_omp_i2               ", &
+       "gather_omp_i3               ", &
+       "gather_omp_r0               ", &
+       "gather_omp_r                ", &
+       "gather_omp_r1               ", &
+       "gather_omp_r2               ", &
+       "gather_omp_r3               ", &
+       "gather_omp_l0               ", &
+       "gather_omp_l                ", &
+       "gather_omp_l1               ", &
+       "gather_omp_l2               ", &
+       "gather_omp_l3               ", &
+       "reduce_sum_omp_i            ", &
+       "reduce_sum_omp_i1           ", &
+       "reduce_sum_omp_i2           ", &
+       "reduce_sum_omp_i3           ", &
+       "reduce_sum_omp_i4           ", &
+       "reduce_sum_omp_r            ", &
+       "reduce_sum_omp_r1           ", &
+       "reduce_sum_omp_r2           ", &
+       "reduce_sum_omp_r3           ", &
+       "reduce_sum_omp_r4           ", &
+       "orch_bcast_omp_cgen         ", &
+       "orch_bcast_omp_igen         ", &
+       "orch_bcast_omp_rgen         ", &
+       "orch_bcast_omp_lgen         ", &
+       "orch_scatter_omp_igen       ", &
+       "orch_scatter_omp_rgen       ", &
+       "orch_scatter_omp_lgen       ", &
+       "orch_gather_omp_simple_igen ", &
+       "orch_gather_omp_igen        ", &
+       "orch_gather_omp_simple_rgen ", &
+       "orch_gather_omp_rgen        ", &
+       "orch_gather_omp_simple_lgen ", &
+       "orch_gather_omp_lgen        ", &
+       "orch_reduce_sum_omp_igen    ", &
+       "orch_reduce_sum_omp_rgen    ", &
+       "check_buffer_c              " /)
+
+  ! Previous value for own omp_function
+  INTEGER, SAVE :: omp_previous
+  !$OMP  THREADPRIVATE(omp_previous)
+
+  ! 
+  !! 3. Variables previously declared in mod_orchide_para
+  !
+
+  INTEGER,SAVE :: nbp_loc                                             !! number of local continental points
+  !$OMP THREADPRIVATE(nbp_loc)
+  INTEGER,SAVE :: offset
+  !$OMP THREADPRIVATE(offset)
+
+  LOGICAL,SAVE :: is_root_prc = .FALSE.                               !! Only root proc for MPI and OpenMP is true
+  !$OMP THREADPRIVATE(is_root_prc)
+  !
+  !! Global grid arrays used by stomate and sechiba and available on each processor
+  !! They need to be broadcasted after initilisation of the parallelisation
+  !-
+  ! Dimensions
+  INTEGER(i_std),SAVE              :: iim_g                           !! Dimension of global fields for longitude
+  INTEGER(i_std),SAVE              :: jjm_g                           !! Dimension of global fields for latitude
+  INTEGER(i_std),SAVE              :: nbp_glo                         !! number of global continental points
+  ! Fields
+  !! 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
+  !-
+  ! Heading of the direction out of the grid box either through the vertex 
+  ! of the mid-segment of the polygon.
+  !
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:), SAVE      :: headings_g
+  !
+  ! Length of segments of the polygon.
+  !
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:), SAVE      :: seglength_g
+  !
+  ! Area of the grid box
+  !
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE        :: area_g
+  !
+  ! Coordinats of the vertices
+  !
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:), SAVE    :: corners_g
+  !
+  ! TEMPORARY !!!!!
+  !
+  !! resolution at each grid point in m (1=E-W, 2=N-S)
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:),SAVE    :: resolution_g 
+  !-
+  !! Geographical coordinates
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:),SAVE    :: lalo_g
+  ! Global grid, for all process
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:), SAVE     :: lon_g, lat_g, zlev_g
+  !-
+  !! Fraction of continents
+  REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE      :: contfrac_g  
+  !
+END MODULE mod_orchidee_para_var
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_transfert_para.F90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_transfert_para.F90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mod_orchidee_transfert_para.F90	(revision 6412)
@@ -0,0 +1,946 @@
+! ===============================================================================================================================
+! MODULE            : mod_orchidee_transfert_para
+!
+! CONTACT           : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE           : IPSL (2006)
+!                     This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF              Contains the interfaces bcast, scatter, gather and reduce_sum
+!!
+!! \n DESCRIPTION   : High level MPI/OpenMP parallel communication encapsulations for ORCHIDEE.
+!!                    These interfaces should be called by all procesess (all MPI processes and all OMP threads)
+!!          bcast      : send a variable from the root process to all processes
+!!          scatter    : distribute a global field known on the root process to the local domain for each processes
+!!          gather     : each process sends their local field to the root process which will recieve the field on the global domain
+!!          reduce_sum : the root process will recieve the sum of the values from all processes
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-CN/src_parallel/mod_orchidee_transfert_para.F90 $
+!! $Date: 2016-08-24 12:24:51 +0200 (Wed, 24 Aug 2016) $
+!! $Revision: 3714 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE mod_orchidee_transfert_para
+
+  USE mod_orchidee_para_var
+  USE mod_orchidee_mpi_transfert
+  USE mod_orchidee_omp_transfert 
+  
+
+! ===============================================================================================================================
+!! INTERFACE        : bcast
+!!
+!>\BRIEF              Send a variable from root process to all processes
+!!
+!! \n DESCRIPTION   : Send a variable from root process to all processes. Note that all processes must make the call.
+!!
+!!  Usage : CALL bcast(Var)
+!!  The variable Var must be known before the call on the root process. After the call, all processes know the variable. 
+!!  The variable has the same dimension on all processes. The variable can be a character string, integer, real or logical. 
+!!  It can have rank 1 to 4. 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCES(S)    : None
+!!
+!! \n
+!_ ================================================================================================================================
+
+  INTERFACE bcast
+    MODULE PROCEDURE bcast_c, bcast_c1,                           &
+                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
+                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
+		     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
+  END INTERFACE
+
+! ===============================================================================================================================
+!! INTERFACE        : scatter
+!!
+!>\BRIEF              Distribute a global field from the root process to the local domain on each processes
+!!
+!! \n DESCRIPTION   : Distribute the global field known on the root process to the local domain for each processes.
+!!                    Note that all processes must make the call.
+!!
+!! Usage: CALL scatter(VarIn, VarOut)
+!! VarIn must be known on the root process before the call is done. 
+!! After the call, VarOut contains the variable on the local domain on each process.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCES(S)    : None
+!!
+!! \n
+!_ ================================================================================================================================
+
+  INTERFACE scatter
+    MODULE PROCEDURE scatter_i,scatter_i1,scatter_i2,scatter_i3,scatter_i4, &
+                     scatter_r,scatter_r1,scatter_r2,scatter_r3,scatter_r4, &
+		     scatter_l,scatter_l1,scatter_l2,scatter_l3,scatter_l4
+  END INTERFACE
+
+  
+! ===============================================================================================================================
+!! INTERFACE        : gather
+!!
+!>\BRIEF              Each process send their local field to the root process which will recieve the field on the global domain
+!!
+!! \n DESCRIPTION   : Each process send their local field to the root process which will recieve the field on the global domain.
+!!                    Note that all processes must make the call.
+!!
+!! Usage: CALL gather(VarIn, VarOut)
+!! VarIn is the variable on the local domain on each process, known before the call. After the call, VarOut is recieved on the
+!! root process containing the variable on the global domain.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCES(S)    : None
+!!
+!! \n
+!_ ================================================================================================================================
+
+  INTERFACE gather
+    MODULE PROCEDURE gather_i,gather_i1,gather_i2,gather_i3,gather_i4, &
+                     gather_r,gather_r1,gather_r2,gather_r3,gather_r4, &
+		     gather_l,gather_l1,gather_l2,gather_l3,gather_l4  
+  END INTERFACE
+  
+
+! ===============================================================================================================================
+!! INTERFACE        : reduce_sum
+!!
+!>\BRIEF              The root process will recieve the sum of the values from all processes
+!!
+!! \n DESCRIPTION   : The root process will recieve the sum of the values from all processes
+!!                    Note that all processes must make the call.
+!!
+!! Usage: CALL reduce_sum(VarIn, VarOut)
+!! VarIn is the value on each process. VarOut is the sum of these values on the root process.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCES(S)    : None
+!!
+!! \n
+!_ ================================================================================================================================
+
+  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 of Broadcast 1D --> 4D !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Character string -- !!
+
+  SUBROUTINE bcast_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_c
+
+  SUBROUTINE bcast_c1(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var(:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_c1
+
+!! -- Integers -- !!
+  
+  SUBROUTINE bcast_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i
+
+  SUBROUTINE bcast_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i1
+
+
+  SUBROUTINE bcast_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i2
+
+
+  SUBROUTINE bcast_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i3
+
+
+  SUBROUTINE bcast_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i4
+
+ 
+!! -- Reals -- !!
+  
+  SUBROUTINE bcast_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r
+
+  SUBROUTINE bcast_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r1
+
+
+  SUBROUTINE bcast_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r2
+
+
+  SUBROUTINE bcast_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r3
+
+
+  SUBROUTINE bcast_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r4 
+
+!! -- Logicals -- !!
+  
+  SUBROUTINE bcast_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l
+
+
+  SUBROUTINE bcast_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l1
+
+
+  SUBROUTINE bcast_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l2
+
+
+  SUBROUTINE bcast_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l3
+
+
+  SUBROUTINE bcast_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+     
+    IF (is_omp_root) CALL bcast_mpi(Var)
+
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l4
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition of Scatter  1D --> 4D  !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_i(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(nbp_mpi) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i
+
+
+  SUBROUTINE scatter_i1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i1
+
+
+  SUBROUTINE scatter_i2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i2
+
+
+  SUBROUTINE scatter_i3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_i3
+
+
+  SUBROUTINE scatter_i4(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_i4
+
+  SUBROUTINE scatter_r(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(nbp_mpi) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r
+
+
+  SUBROUTINE scatter_r1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r1
+
+
+  SUBROUTINE scatter_r2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r2
+
+
+  SUBROUTINE scatter_r3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_r3
+  
+
+  SUBROUTINE scatter_r4(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_r4
+  
+
+  SUBROUTINE scatter_l(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(nbp_mpi) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l
+
+
+  SUBROUTINE scatter_l1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l1
+
+
+  SUBROUTINE scatter_l2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l2
+
+
+  SUBROUTINE scatter_l3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_l3
+
+  SUBROUTINE scatter_l4(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4),SIZE(Varout,5)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_l4
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition of Gather  1D --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Integers
+
+  SUBROUTINE gather_i(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER, DIMENSION(nbp_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
+  
+  END SUBROUTINE gather_i
+
+
+  SUBROUTINE gather_i1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
+
+  
+  END SUBROUTINE gather_i1
+
+
+  SUBROUTINE gather_i2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_i2
+
+
+  SUBROUTINE gather_i3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE gather_i3
+
+
+  SUBROUTINE gather_i4(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_i4
+
+!!!!! --> Reals
+
+  SUBROUTINE gather_r(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL, DIMENSION(nbp_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE gather_r
+
+
+  SUBROUTINE gather_r1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+
+  
+  END SUBROUTINE gather_r1
+
+
+  SUBROUTINE gather_r2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_r2
+
+
+  SUBROUTINE gather_r3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_r3
+
+  SUBROUTINE gather_r4(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_r4
+
+!!!!! --> Logiclas
+
+  SUBROUTINE gather_l(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    LOGICAL, DIMENSION(nbp_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_l
+
+
+  SUBROUTINE gather_l1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_l1
+
+
+  SUBROUTINE gather_l2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_l2
+
+
+  SUBROUTINE gather_l3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_l3
+
+
+  SUBROUTINE gather_l4(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4),SIZE(VarIn,5)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_l4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition of reduce_sum for integers and reals   1D --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Reduced sum subroutines for integers
+
+  SUBROUTINE reduce_sum_i(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    
+    INTEGER             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_i  
+
+
+  SUBROUTINE reduce_sum_i1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_i1  
+
+
+  SUBROUTINE reduce_sum_i2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE reduce_sum_i2  
+  
+
+  SUBROUTINE reduce_sum_i3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_i3  
+
+
+  SUBROUTINE reduce_sum_i4(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_i4  
+
+! Reduce sum subroutines for reals
+
+  SUBROUTINE reduce_sum_r(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    
+    REAL             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r  
+
+
+  SUBROUTINE reduce_sum_r1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r1  
+
+
+  SUBROUTINE reduce_sum_r2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r2  
+  
+
+  SUBROUTINE reduce_sum_r3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r3  
+
+
+  SUBROUTINE reduce_sum_r4(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r4  
+
+   
+END MODULE mod_orchidee_transfert_para
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mpi_dummy.h
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mpi_dummy.h	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/mpi_dummy.h	(revision 6412)
@@ -0,0 +1,78 @@
+! ==============================================================================================================================
+! INCLUDE           : mpi_dummy.h
+!
+! CONTACT           : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE           : IPSL (2006)
+!                     This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF              Overlap of MPI functions not present in some MPI implementations.
+!!
+!!\n DESCRIPTION    : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+#ifdef MPI_SECOND__
+
+SUBROUTINE MPI_NULL_COPY_FN
+END SUBROUTINE MPI_NULL_COPY_FN
+
+SUBROUTINE MPI_NULL_DELETE_FN
+END SUBROUTINE MPI_NULL_DELETE_FN
+
+SUBROUTINE MPI_COMM_NULL_COPY_FN
+END SUBROUTINE MPI_COMM_NULL_COPY_FN
+
+SUBROUTINE MPI_COMM_NULL_DELETE_FN
+END SUBROUTINE MPI_COMM_NULL_DELETE_FN
+
+SUBROUTINE MPI_TYPE_NULL_COPY_FN
+END SUBROUTINE MPI_TYPE_NULL_COPY_FN
+
+SUBROUTINE MPI_TYPE_NULL_DELETE_FN
+END SUBROUTINE MPI_TYPE_NULL_DELETE_FN
+
+SUBROUTINE MPI_WIN_NULL_COPY_FN
+END SUBROUTINE MPI_WIN_NULL_COPY_FN
+
+SUBROUTINE MPI_WIN_NULL_DELETE_FN
+END SUBROUTINE MPI_WIN_NULL_DELETE_FN
+
+SUBROUTINE MPI_DUP_FN
+END SUBROUTINE MPI_DUP_FN
+
+SUBROUTINE MPI_COMM_DUP_FN
+END SUBROUTINE MPI_COMM_DUP_FN
+
+SUBROUTINE MPI_TYPE_DUP_FN
+END SUBROUTINE MPI_TYPE_DUP_FN
+
+SUBROUTINE MPI_WIN_DUP_FN
+END SUBROUTINE MPI_WIN_DUP_FN
+
+FUNCTION MPI_WTIME () RESULT (R)
+  DOUBLE PRECISION R
+END FUNCTION MPI_WTIME
+
+FUNCTION MPI_WTICK () RESULT (R)
+  DOUBLE PRECISION :: R
+END FUNCTION MPI_WTICK
+
+FUNCTION PMPI_WTIME () RESULT (R)
+  DOUBLE PRECISION R
+END FUNCTION PMPI_WTIME
+
+FUNCTION PMPI_WTICK () RESULT (R)
+  DOUBLE PRECISION R
+END FUNCTION PMPI_WTICK
+
+#endif
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/orch_write_field.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/orch_write_field.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/orch_write_field.f90	(revision 6412)
@@ -0,0 +1,319 @@
+! ==============================================================================================================================
+! MODULE   : orch_Write_Field
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF     Set of low level interfaces to create netcdf output files to test values of variables in sequentiel mode  
+!!
+!!\n DESCRIPTION  : Set of low level interfaces to create netcdf output files to test values of variables in sequentiel mode.
+!!                  The interfaces in this module are only used by orch_write_field_p to create high level interfaces.
+!!                  These interfaces should only be called by the master process.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+MODULE orch_Write_Field
+  
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+
+  INTEGER, PARAMETER :: MaxWriteField = 100
+  INTEGER, DIMENSION(MaxWriteField),SAVE :: FieldId
+  INTEGER, DIMENSION(MaxWriteField),SAVE :: FieldVarId
+  INTEGER, DIMENSION(MaxWriteField),SAVE :: FieldIndex
+  CHARACTER(len=255), DIMENSION(MaxWriteField) ::  FieldName
+  
+  INTEGER, SAVE,DIMENSION(:), ALLOCATABLE :: Index_Write_Field
+  INTEGER,SAVE :: iim
+  INTEGER,SAVE :: jjm
+  INTEGER,SAVE :: NbPoint
+  REAL, PARAMETER :: undef_var=0.
+  
+  INTEGER,SAVE :: NbField = 0
+  
+  !! ==============================================================================================================================
+  !! INTERFACE   :  WriteField
+  !!
+  !>\BRIEF         set of routines to write real fields (of 1d, 2d, 3d, 4d) in netcdf output file 
+  !!
+  !! DESCRIPTION  : set of routines to write real fields (of 1d, 2d, 3d, 4d) in netcdf output file 
+  !!                CALL WriteField("MyVariable", variable_array) 
+  !!                will create a file MyVariable.nc with all value of variable_array
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  INTERFACE WriteField
+    MODULE PROCEDURE WriteField_4d,WriteField_3d,WriteField_2d,WriteField_1d
+  END INTERFACE WriteField
+ 
+  !! ==============================================================================================================================
+  !! INTERFACE   :  WriteFieldI
+  !!
+  !>\BRIEF         set of routines to write integer fields (of 1d, 2d, 3d, 4d) in netcdf output file 
+  !!
+  !! DESCRIPTION  : set of routines to write integer fields (of 1d, 2d, 3d, 4d) in netcdf output file 
+  !!                CALL WriteFieldI("MyVariable", variable_array) 
+  !!                will create a file MyVariable.nc with all value of variable_array
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  INTERFACE WriteFieldI
+    MODULE PROCEDURE WriteFieldI_3d,WriteFieldI_2d,WriteFieldI_1d
+  END INTERFACE WriteFieldI
+
+  PRIVATE :: iim,jjm,NbPoint 
+  CONTAINS
+  
+    SUBROUTINE Init_WriteField(iim0,jjm0,NbPoint0,Index0)
+    IMPLICIT NONE
+      INTEGER,INTENT(in) :: iim0
+      INTEGER,INTENT(in) :: jjm0
+      INTEGER,INTENT(in) :: NbPoint0
+      INTEGER,INTENT(in) :: Index0(NbPoint0)
+    
+      iim=iim0
+      jjm=jjm0
+      Nbpoint=Nbpoint0
+      ALLOCATE(Index_Write_Field(NbPoint))
+      Index_Write_Field(:)=Index0(:)
+    END SUBROUTINE Init_WriteField
+    
+    FUNCTION GetFieldIndex(name)
+    IMPLICIT NONE
+      INTEGER          :: GetFieldindex
+      CHARACTER(len=*) :: name
+    
+      CHARACTER(len=255) :: TrueName
+      INTEGER            :: i
+       
+      
+      TrueName=TRIM(ADJUSTL(name))
+    
+      GetFieldIndex=-1
+      DO i=1,NbField
+        IF (TrueName==FieldName(i)) THEN
+          GetFieldIndex=i
+          EXIT
+        ENDIF
+      ENDDO
+    END FUNCTION GetFieldIndex
+
+    SUBROUTINE WriteFieldI_3d(name,Field)
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:,:) :: Field 
+      INTEGER, DIMENSION(3) :: Dim
+      INTEGER,DIMENSION(4) :: Dim_tmp
+      INTEGER :: i
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: Field_tmp 
+      
+      Dim=SHAPE(Field)
+      ALLOCATE(Field_tmp(iim*jjm,DIM(2),DIM(3)))
+      field_tmp(:,:,:)=undef_var
+      
+      DO i=1,NbPoint
+        field_tmp(Index_Write_Field(i),:,:)=Field(i,:,:)
+      ENDDO
+      
+      Dim_tmp(1)=iim
+      Dim_tmp(2)=jjm
+      Dim_tmp(3)=DIM(2)
+      Dim_tmp(4)=DIM(3)
+      CALL WriteField_gen(name,Field_tmp,4,Dim_tmp)  
+  
+      DEALLOCATE(Field_tmp)
+    END SUBROUTINE WriteFieldI_3d
+
+    SUBROUTINE WriteFieldI_2d(name,Field)
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:) :: Field 
+      INTEGER, DIMENSION(2) :: Dim
+      INTEGER,DIMENSION(3) :: Dim_tmp
+      INTEGER :: i
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: Field_tmp 
+      
+      Dim=SHAPE(Field)
+      ALLOCATE(Field_tmp(iim*jjm,DIM(2)))
+      field_tmp(:,:)=undef_var
+      
+      DO i=1,NbPoint
+        field_tmp(Index_Write_Field(i),:)=Field(i,:)
+      ENDDO
+      
+      Dim_tmp(1)=iim
+      Dim_tmp(2)=jjm
+      Dim_tmp(3)=DIM(2)
+
+      CALL WriteField_gen(name,Field_tmp,3,Dim_tmp)  
+  
+      DEALLOCATE(Field_tmp)
+    END SUBROUTINE WriteFieldI_2d
+
+    SUBROUTINE WriteFieldI_1d(name,Field)
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:) :: Field 
+      INTEGER, DIMENSION(1) :: Dim
+      INTEGER,DIMENSION(2) :: Dim_tmp
+      INTEGER :: i
+      
+      REAL, ALLOCATABLE, DIMENSION(:) :: Field_tmp 
+      
+      Dim=SHAPE(Field)
+      ALLOCATE(Field_tmp(iim*jjm))
+      field_tmp(:)=undef_var
+      
+      DO i=1,NbPoint
+        field_tmp(Index_Write_Field(i))=Field(i)
+      ENDDO
+      
+      Dim_tmp(1)=iim
+      Dim_tmp(2)=jjm
+
+      CALL WriteField_gen(name,Field_tmp,2,Dim_tmp)  
+  
+      DEALLOCATE(Field_tmp)
+    END SUBROUTINE WriteFieldI_1d
+        
+    SUBROUTINE WriteField_4d(name,Field)
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:,:,:) :: Field 
+      INTEGER, DIMENSION(4) :: Dim
+      
+      Dim=SHAPE(Field)
+      CALL WriteField_gen(name,Field,4,Dim)  
+  
+    END SUBROUTINE WriteField_4d
+     
+    SUBROUTINE WriteField_3d(name,Field)
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:,:) :: Field 
+      INTEGER, DIMENSION(3) :: Dim
+      
+      Dim=SHAPE(Field)
+      CALL WriteField_gen(name,Field,3,Dim)  
+  
+    END SUBROUTINE WriteField_3d
+    
+    SUBROUTINE WriteField_2d(name,Field)
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:) :: Field 
+      INTEGER, DIMENSION(2) :: Dim
+      
+      Dim=SHAPE(Field)
+      CALL WriteField_gen(name,Field,2,Dim)  
+  
+    END SUBROUTINE WriteField_2d
+    
+    SUBROUTINE WriteField_1d(name,Field)
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:) :: Field 
+      INTEGER, DIMENSION(1) :: Dim
+      
+      Dim=SHAPE(Field)
+      CALL WriteField_gen(name,Field,1,Dim)  
+  
+    END SUBROUTINE WriteField_1d
+        
+    SUBROUTINE CreateNewField(name,NbDim,DimSize)
+    USE ioipsl
+    IMPLICIT NONE
+    INCLUDE 'netcdf.inc'  
+      CHARACTER(len=*) :: name
+      INTEGER :: NbDim
+      INTEGER :: DimSize(NbDim)
+      INTEGER :: TabDim(NbDim+1)
+      INTEGER :: status
+      
+      
+      NbField=NbField+1
+      FieldName(NbField)=TRIM(ADJUSTL(name))
+      FieldIndex(NbField)=1
+      
+      WRITE(numout,*) 'CREATE_NEW_FIELD ',name,NbDim,DimSize
+      CALL FLUSH(6)
+      status = NF_CREATE(TRIM(ADJUSTL(name))//'.nc', NF_CLOBBER, FieldId(NbField))
+      IF (NbDim>=1) status = NF_DEF_DIM(FieldId(NbField),'I',DimSize(1),TabDim(1))
+      IF (NbDim>=2) status = NF_DEF_DIM(FieldId(NbField),'J',DimSize(2),TabDim(2))
+      IF (NbDim>=3) status = NF_DEF_DIM(FieldId(NbField),'K',DimSize(3),TabDim(3))
+      IF (NbDim>=4) status = NF_DEF_DIM(FieldId(NbField),'L',DimSize(4),TabDim(4))
+      status = NF_DEF_DIM(FieldId(NbField),'iter',NF_UNLIMITED,TabDim(NbDim+1))
+      status = NF_DEF_VAR(FieldId(NbField),FieldName(NbField),NF_DOUBLE,NbDim+1,TabDim,FieldVarId(NbField))
+      status = NF_ENDDEF(FieldId(NbField))
+
+    END SUBROUTINE CreateNewField
+    
+  FUNCTION int2str(int)
+    IMPLICIT NONE
+    INTEGER, PARAMETER :: MaxLen=10
+    INTEGER,INTENT(in) :: int
+    CHARACTER(len=MaxLen) :: int2str
+    LOGICAL :: flag
+    INTEGER :: i
+    flag=.TRUE.
+    
+    i=int
+    
+    int2str=''
+    DO WHILE (flag)
+      int2str=CHAR(MOD(i,10)+48)//int2str
+      i=i/10
+      IF (i==0) flag=.FALSE.
+    ENDDO
+  END FUNCTION int2str
+
+
+END MODULE Orch_Write_Field
+
+    SUBROUTINE WriteField_gen(name,Field,NbDim,DimSize)
+    USE orch_write_field
+    IMPLICIT NONE
+    INCLUDE 'netcdf.inc'
+      CHARACTER(len=*) :: name
+      INTEGER :: NbDim
+      INTEGER,DIMENSION(NbDim) :: DimSize
+      REAL,DIMENSION(*) :: Field
+      
+      INTEGER :: status
+      INTEGER :: ind
+      INTEGER :: start(NbDim+1)
+      INTEGER :: COUNT(NbDim+1)
+      INTEGER :: i
+           
+      Ind=GetFieldIndex(name)
+      IF (Ind==-1) THEN
+        CALL CreateNewField(name,NbDim,DimSize)
+	Ind=GetFieldIndex(name)
+      ELSE
+        FieldIndex(Ind)=FieldIndex(Ind)+1
+      ENDIF
+      
+      DO i=1,NbDim
+        start(i)=1
+        COUNT(i)=DimSize(i)
+      ENDDO
+      start(NbDim+1)=FieldIndex(Ind)
+      COUNT(NbDim+1)=1
+
+      status = NF_PUT_VARA_DOUBLE(FieldId(Ind),FieldVarId(Ind),start,count,Field)
+      status = NF_SYNC(FieldId(Ind))
+      
+    END SUBROUTINE WriteField_gen
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/orch_write_field_p.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/orch_write_field_p.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/orch_write_field_p.f90	(revision 6412)
@@ -0,0 +1,193 @@
+! ==============================================================================================================================
+! MODULE   : orch_Write_Field_p
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF     Set of interfaces to create netcdf output files to test values of variables in parallel mode.
+!!
+!! \n DESCRIPTION  : Set of interfaces to create netcdf output files to test values of variables in parallel mode. 
+!!                   IMPORTANT NOTICE: These subroutines have not been tested in hybrid run mode using MPI-OMP paralelization
+!!                                     using more than 1 threds OMP. It will probably not work!
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+MODULE Orch_Write_field_p
+  
+  !! ==============================================================================================================================
+  !! INTERFACE   :  WriteField_p
+  !!
+  !>\BRIEF         set of routines to write real fields (of 1d, 2d, 3d, 4d) in netcdf output file 
+  !!
+  !! DESCRIPTION  : set of routines to write real fields (of 1d, 2d, 3d, 4d) in netcdf output file 
+  !!                CALL WriteField_p("MyVariable", variable_array) 
+  !!                will create a file MyVariable.nc with all value of variable_array
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  INTERFACE WriteField_p
+    MODULE PROCEDURE WriteField_4d_p,WriteField_3d_p,WriteField_2d_p
+  END INTERFACE WriteField_p
+ 
+  !! ==============================================================================================================================
+  !! INTERFACE   :  WriteFieldI_p
+  !!
+  !>\BRIEF         set of routines to write integer fields (of 1d, 2d, 3d, 4d) in netcdf output file 
+  !!
+  !! DESCRIPTION  : set of routines to write integer fields (of 1d, 2d, 3d, 4d) in netcdf output file 
+  !!                CALL WriteFieldI_p("MyVariable", variable_array) 
+  !!                will create a file MyVariable.nc with all value of variable_array
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  INTERFACE WriteFieldI_p
+    MODULE PROCEDURE WriteFieldI_3d_p,WriteFieldI_2d_p,WriteFieldI_1d_p
+  END INTERFACE WriteFieldI_p  
+  
+  
+CONTAINS
+
+  SUBROUTINE init_WriteField_p
+  USE mod_orchidee_para
+  USE Orch_Write_Field, ONLY : Init_WriteField
+  IMPLICIT NONE
+    IF (is_root_prc) CALL Init_WriteField(iim_g,jjm_g,nbp_glo,index_g)
+    
+  END SUBROUTINE init_WriteField_p
+
+  SUBROUTINE WriteField_4d_p(name,Field)
+    USE mod_orchidee_para
+    USE Orch_Write_Field, ONLY : WriteField
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:,:,:) :: Field 
+      INTEGER, DIMENSION(4) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: Field_g
+      
+      Dim=SHAPE(Field)
+      
+      ALLOCATE(Field_g(iim_g,jjm_g,DIM(3),DIM(4)))
+      CALL Gather2D_mpi(Field,Field_g)
+
+      IF (is_root_prc) CALL WriteField(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteField_4d_p
+    
+  SUBROUTINE WriteField_3d_p(name,Field)
+    USE mod_orchidee_para
+    USE Orch_Write_Field, ONLY : WriteField
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:,:) :: Field 
+      INTEGER, DIMENSION(3) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: Field_g
+      
+      
+      Dim=SHAPE(Field)
+      
+      ALLOCATE(Field_g(iim_g,jjm_g,DIM(3)))
+      CALL Gather2D_mpi(Field,Field_g)
+
+      IF (is_root_prc) CALL WriteField(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteField_3d_p
+
+  SUBROUTINE WriteField_2d_p(name,Field)
+    USE mod_orchidee_para
+    USE Orch_Write_Field, ONLY : WriteField
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:) :: Field 
+      INTEGER, DIMENSION(2) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: Field_g
+      
+      
+      Dim=SHAPE(Field)
+      
+      ALLOCATE(Field_g(iim_g,jjm_g))
+      CALL Gather2D_mpi(Field,Field_g)
+
+      IF (is_root_prc) CALL WriteField_gen(name,Field_g,2,Dim)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteField_2d_p
+
+  SUBROUTINE WriteFieldI_3d_p(name,Field)
+    USE mod_orchidee_para
+    USE Orch_Write_Field, ONLY : WriteFieldI
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:,:) :: Field 
+      INTEGER, DIMENSION(3) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: Field_g
+      
+      
+      Dim=SHAPE(Field)
+      
+      ALLOCATE(Field_g(nbp_glo,DIM(2),DIM(3)))
+      CALL gather(Field,Field_g)
+      
+      IF (is_root_prc) CALL WriteFieldI(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteFieldI_3d_p
+
+  SUBROUTINE WriteFieldI_2d_p(name,Field)
+    USE mod_orchidee_para
+    USE Orch_Write_Field, ONLY : WriteFieldI
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:) :: Field 
+      INTEGER, DIMENSION(2) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: Field_g
+      
+      
+      Dim=SHAPE(Field)
+      
+      ALLOCATE(Field_g(nbp_glo,DIM(2)))
+      CALL gather(Field,Field_g)
+      
+      IF (is_root_prc) CALL WriteFieldI(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteFieldI_2d_p    
+
+  SUBROUTINE WriteFieldI_1d_p(name,Field)
+    USE mod_orchidee_para
+    USE Orch_Write_Field, ONLY : WriteFieldI
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:) :: Field 
+      INTEGER, DIMENSION(1) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:) :: Field_g
+      
+      
+      Dim=SHAPE(Field)
+      
+      ALLOCATE(Field_g(nbp_glo))
+      CALL gather(Field,Field_g)
+      
+      IF (is_root_prc) CALL WriteFieldI(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteFieldI_1d_p    
+    
+END MODULE Orch_Write_field_p
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/src_parallel.h
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/src_parallel.h	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/src_parallel.h	(revision 6412)
@@ -0,0 +1,663 @@
+! ==============================================================================================================================
+! INCLUDE           : src_parallel.h
+!
+! CONTACT           : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE           : IPSL (2006)
+!                     This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF              Redefinition of MPI functions if not second underscore in MPI library.
+!!
+!!\n DESCRIPTION    : Redefinition of MPI functions if not second underscore in MPI library.
+!!                    One must use -DMPI_SECOND__ in precompilation to activate those definitions.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+#ifdef MPI_SECOND__
+
+#define MPI_BARRIER MPI_BARRIER_
+#define MPI_FINALIZE MPI_FINALIZE_
+#define MPI_COMM_SIZE MPI_COMM_SIZE_
+#define MPI_INIT MPI_INIT_
+#define MPI_COMM_RANK MPI_COMM_RANK_
+#define MPI_GATHER MPI_GATHER_
+#define MPI_GATHERV MPI_GATHERV_
+#define MPI_BCAST MPI_BCAST_
+#define MPI_SCATTERV MPI_SCATTERV_
+#define MPI_REDUCE MPI_REDUCE_
+
+#endif
+
+#ifdef NF_SECOND__
+
+
+#define nf_get_varm_double nf_get_varm_double_
+#define nf_get_vara_text nf_get_vara_text_
+#define nf_get_vara_real nf_get_vara_real_
+#define nf_get_varm_int1 nf_get_varm_int1_
+#define nf_get_varm_int2 nf_get_varm_int2_
+#define nf_get_varm_text nf_get_varm_text_
+#define nf_get_varm_real nf_get_varm_real_
+#define nf_get_vars_int1 nf_get_vars_int1_
+#define nf_get_vars_int nf_get_vars_int_
+#define nf_get_vars_double nf_get_vars_double_
+#define nf_get_vars_text nf_get_vars_text_
+#define nf_inq_att nf_inq_att_
+#define nf_inq_attid nf_inq_attid_
+#define nf_inq_atttype nf_inq_atttype_
+#define nf_inq_attname nf_inq_attname_
+#define nf_inq_attlen nf_inq_attlen_
+#define nf_inq nf_inq_
+#define nf_inq_dim nf_inq_dim_
+#define nf_inq_dimlen nf_inq_dimlen_
+#define nf_inq_dimid nf_inq_dimid_
+#define nf_inq_libvers nf_inq_libvers_
+#define nf_inq_format nf_inq_format_
+#define nf_inq_natts nf_inq_natts_
+#define nf_inq_dimname nf_inq_dimname_
+#define nf_inq_base_pe nf_inq_base_pe_
+#define nf_get_vars_real nf_get_vars_real_
+#define nf_inq_nvars nf_inq_nvars_
+#define nf_inq_ndims nf_inq_ndims_
+#define nf_get_vars_int2 nf_get_vars_int2_
+#define nf_inq_var nf_inq_var_
+#define nf_inq_vardimid nf_inq_vardimid_
+#define nf_inq_varid nf_inq_varid_
+#define nf_inq_varnatts nf_inq_varnatts_
+#define nf_inq_varndims nf_inq_varndims_
+#define nf_inq_vartype nf_inq_vartype_
+#define nf_inq_varname nf_inq_varname_
+#define nf_issyserr nf_issyserr_
+#define nf_put_att_double nf_put_att_double_
+#define nf_open nf_open_
+#define nf_put_att_int1 nf_put_att_int1_
+#define nf_put_att_int nf_put_att_int_
+#define nf_put_att_text nf_put_att_text_
+#define nf_put_att_real nf_put_att_real_
+#define nf_put_att_int2 nf_put_att_int2_
+#define nf_inq_unlimdim nf_inq_unlimdim_
+#define nf_get_varm_int nf_get_varm_int_
+#define nf_put_var1_int nf_put_var1_int_
+#define nf_put_var1_int2 nf_put_var1_int2_
+#define nf_put_var1_int1 nf_put_var1_int1_
+#define nf_put_var1_text nf_put_var1_text_
+#define nf_put_var_int nf_put_var_int_
+#define nf_put_var_double nf_put_var_double_
+#define nf_put_var1_real nf_put_var1_real_
+#define nf_put_var_real nf_put_var_real_
+#define nf_put_vara_int2 nf_put_vara_int2_
+#define nf_put_vara_int1 nf_put_vara_int1_
+#define nf_put_vara_int nf_put_vara_int_
+#define nf_put_vara_double nf_put_vara_double_
+#define nf_put_vara_text nf_put_vara_text_
+#define nf_put_varm_int1 nf_put_varm_int1_
+#define nf_put_varm_int2 nf_put_varm_int2_
+#define nf_put_varm_int nf_put_varm_int_
+#define nf_put_varm_double nf_put_varm_double_
+#define nf_put_varm_real nf_put_varm_real_
+#define nf_put_vara_real nf_put_vara_real_
+#define nf_put_var_text nf_put_var_text_
+#define nf_put_var_int2 nf_put_var_int2_
+#define nf_put_var_int1 nf_put_var_int1_
+#define nf_put_vars_double nf_put_vars_double_
+#define nf_put_varm_text nf_put_varm_text_
+#define nf_put_var1_double nf_put_var1_double_
+#define nf_put_vars_int1 nf_put_vars_int1_
+#define nf_put_vars_int2 nf_put_vars_int2_
+#define nf_put_vars_text nf_put_vars_text_
+#define nf_put_vars_real nf_put_vars_real_
+#define nf_rename_att nf_rename_att_
+#define nf_set_base_pe nf_set_base_pe_
+#define nf_rename_var nf_rename_var_
+#define nf_rename_dim nf_rename_dim_
+#define nf_redef nf_redef_
+#define nf_sync nf_sync_
+#define nf_strerror nf_strerror_
+#define nf_set_fill nf_set_fill_
+#define nf_set_default_format nf_set_default_format_
+#define nf_put_vars_int nf_put_vars_int_
+#define nf_get_var_int2 nf_get_var_int2_
+#define nf__create_mp nf__create_mp_
+#define nf__open nf__open_
+#define nf__open_mp nf__open_mp_
+#define nf__enddef nf__enddef_
+#define nf_abort nf_abort_
+#define nf__create nf__create_
+#define nf_copy_att nf_copy_att_
+#define nf_create nf_create_
+#define nf_def_dim nf_def_dim_
+#define nf_copy_var nf_copy_var_
+#define nf_close nf_close_
+#define nf_del_att nf_del_att_
+#define nf_delete nf_delete_
+#define nf_def_var nf_def_var_
+#define nf_enddef nf_enddef_
+#define nf_get_att_real nf_get_att_real_
+#define nf_get_att_double nf_get_att_double_
+#define nf_get_att_int nf_get_att_int_
+#define nf_get_att_int2 nf_get_att_int2_
+#define nf_get_att_int1 nf_get_att_int1_
+#define nf_get_att_text nf_get_att_text_
+#define nf_get_var1_int nf_get_var1_int_
+#define nf_get_var1_int1 nf_get_var1_int1_
+#define nf_get_var1_text nf_get_var1_text_
+#define nf_get_var1_real nf_get_var1_real_
+#define nf_get_var1_int2 nf_get_var1_int2_
+#define nf_get_var1_double nf_get_var1_double_
+#define nf_get_var_int nf_get_var_int_
+#define nf_get_var_int2 nf_get_var_int2_
+#define nf_get_var_real nf_get_var_real_
+#define nf_get_var_int1 nf_get_var_int1_
+#define nf_get_var_text nf_get_var_text_
+#define nf_get_vara_int1 nf_get_vara_int1_
+#define nf_get_vara_int nf_get_vara_int_
+#define nf_get_vara_int2 nf_get_vara_int2_
+#define nf_get_vara_double nf_get_vara_double_
+#define nf_get_var_double nf_get_var_double_
+#define nf_get_varm_int nf_get_varm_int_
+#define nf_get_varm_double nf_get_varm_double_
+#define nf_get_varm_int2 nf_get_varm_int2_
+#define nf_get_vars_double nf_get_vars_double_
+#define nf_get_varm_text nf_get_varm_text_
+#define nf_get_varm_real nf_get_varm_real_
+#define nf_get_varm_int1 nf_get_varm_int1_
+#define nf_get_vara_text nf_get_vara_text_
+#define nf_get_vars_text nf_get_vars_text_
+#define nf_get_vars_real nf_get_vars_real_
+#define nf_get_vars_int2 nf_get_vars_int2_
+#define nf_get_vars_int1 nf_get_vars_int1_
+#define nf_inq_att nf_inq_att_
+#define nf_inq_attid nf_inq_attid_
+#define nf_inq nf_inq_
+#define nf_inq_atttype nf_inq_atttype_
+#define nf_inq_attname nf_inq_attname_
+#define nf_inq_dimlen nf_inq_dimlen_
+#define nf_inq_dimid nf_inq_dimid_
+#define nf_inq_libvers nf_inq_libvers_
+#define nf_inq_format nf_inq_format_
+#define nf_inq_dimname nf_inq_dimname_
+#define nf_inq_dim nf_inq_dim_
+#define nf_inq_base_pe nf_inq_base_pe_
+#define nf_inq_ndims nf_inq_ndims_
+#define nf_inq_unlimdim nf_inq_unlimdim_
+#define nf_inq_nvars nf_inq_nvars_
+#define nf_inq_var nf_inq_var_
+#define nf_inq_natts nf_inq_natts_
+#define nf_inq_varid nf_inq_varid_
+#define nf_inq_varname nf_inq_varname_
+#define nf_inq_varnatts nf_inq_varnatts_
+#define nf_inq_vardimid nf_inq_vardimid_
+#define nf_inq_attlen nf_inq_attlen_
+#define nf_get_vars_int nf_get_vars_int_
+#define nf_get_vara_real nf_get_vara_real_
+#define nf_inq_vartype nf_inq_vartype_
+#define nf_issyserr nf_issyserr_
+#define nf_open nf_open_
+#define nf_put_att_int1 nf_put_att_int1_
+#define nf_put_att_int2 nf_put_att_int2_
+#define nf_put_att_text nf_put_att_text_
+#define nf_put_var1_int nf_put_var1_int_
+#define nf_put_var1_int1 nf_put_var1_int1_
+#define nf_put_var1_double nf_put_var1_double_
+#define nf_put_var1_int2 nf_put_var1_int2_
+#define nf_put_var1_real nf_put_var1_real_
+#define nf_put_att_real nf_put_att_real_
+#define nf_put_var1_text nf_put_var1_text_
+#define nf_put_att_int nf_put_att_int_
+#define nf_put_att_double nf_put_att_double_
+#define nf_put_var_double nf_put_var_double_
+#define nf_put_var_int2 nf_put_var_int2_
+#define nf_put_var_int1 nf_put_var_int1_
+#define nf_put_var_real nf_put_var_real_
+#define nf_put_var_int nf_put_var_int_
+#define nf_inq_varndims nf_inq_varndims_
+#define nf_put_vara_int1 nf_put_vara_int1_
+#define nf_put_vara_text nf_put_vara_text_
+#define nf_put_vara_real nf_put_vara_real_
+#define nf_put_varm_int nf_put_varm_int_
+#define nf_put_varm_double nf_put_varm_double_
+#define nf_put_vara_int2 nf_put_vara_int2_
+#define nf_put_varm_int1 nf_put_varm_int1_
+#define nf_put_varm_real nf_put_varm_real_
+#define nf_put_varm_text nf_put_varm_text_
+#define nf_put_vars_int1 nf_put_vars_int1_
+#define nf_put_vars_int nf_put_vars_int_
+#define nf_put_vars_real nf_put_vars_real_
+#define nf_put_vars_int2 nf_put_vars_int2_
+#define nf_put_vars_text nf_put_vars_text_
+#define nf_put_vars_double nf_put_vars_double_
+#define nf_put_varm_int2 nf_put_varm_int2_
+#define nf_rename_dim nf_rename_dim_
+#define nf_rename_att nf_rename_att_
+#define nf_redef nf_redef_
+#define nf_set_base_pe nf_set_base_pe_
+#define nf_set_default_format nf_set_default_format_
+#define nf_rename_var nf_rename_var_
+#define nf_put_vara_int nf_put_vara_int_
+#define nf_strerror nf_strerror_
+#define nf_set_fill nf_set_fill_
+#define nf_put_var_text nf_put_var_text_
+        
+#define NF_GET_VARM_DOUBLE NF_GET_VARM_DOUBLE_
+#define NF_GET_VARA_TEXT NF_GET_VARA_TEXT_
+#define NF_GET_VARA_REAL NF_GET_VARA_REAL_
+#define NF_GET_VARM_INT1 NF_GET_VARM_INT1_
+#define NF_GET_VARM_INT2 NF_GET_VARM_INT2_
+#define NF_GET_VARM_TEXT NF_GET_VARM_TEXT_
+#define NF_GET_VARM_REAL NF_GET_VARM_REAL_
+#define NF_GET_VARS_INT1 NF_GET_VARS_INT1_
+#define NF_GET_VARS_INT NF_GET_VARS_INT_
+#define NF_GET_VARS_DOUBLE NF_GET_VARS_DOUBLE_
+#define NF_GET_VARS_TEXT NF_GET_VARS_TEXT_
+#define NF_INQ_ATT NF_INQ_ATT_
+#define NF_INQ_ATTID NF_INQ_ATTID_
+#define NF_INQ_ATTTYPE NF_INQ_ATTTYPE_
+#define NF_INQ_ATTNAME NF_INQ_ATTNAME_
+#define NF_INQ_ATTLEN NF_INQ_ATTLEN_
+#define NF_INQ NF_INQ_
+#define NF_INQ_DIM NF_INQ_DIM_
+#define NF_INQ_DIMLEN NF_INQ_DIMLEN_
+#define NF_INQ_DIMID NF_INQ_DIMID_
+#define NF_INQ_LIBVERS NF_INQ_LIBVERS_
+#define NF_INQ_FORMAT NF_INQ_FORMAT_
+#define NF_INQ_NATTS NF_INQ_NATTS_
+#define NF_INQ_DIMNAME NF_INQ_DIMNAME_
+#define NF_INQ_BASE_PE NF_INQ_BASE_PE_
+#define NF_GET_VARS_REAL NF_GET_VARS_REAL_
+#define NF_INQ_NVARS NF_INQ_NVARS_
+#define NF_INQ_NDIMS NF_INQ_NDIMS_
+#define NF_GET_VARS_INT2 NF_GET_VARS_INT2_
+#define NF_INQ_VAR NF_INQ_VAR_
+#define NF_INQ_VARDIMID NF_INQ_VARDIMID_
+#define NF_INQ_VARID NF_INQ_VARID_
+#define NF_INQ_VARNATTS NF_INQ_VARNATTS_
+#define NF_INQ_VARNDIMS NF_INQ_VARNDIMS_
+#define NF_INQ_VARTYPE NF_INQ_VARTYPE_
+#define NF_INQ_VARNAME NF_INQ_VARNAME_
+#define NF_ISSYSERR NF_ISSYSERR_
+#define NF_PUT_ATT_DOUBLE NF_PUT_ATT_DOUBLE_
+#define NF_OPEN NF_OPEN_
+#define NF_PUT_ATT_INT1 NF_PUT_ATT_INT1_
+#define NF_PUT_ATT_INT NF_PUT_ATT_INT_
+#define NF_PUT_ATT_TEXT NF_PUT_ATT_TEXT_
+#define NF_PUT_ATT_REAL NF_PUT_ATT_REAL_
+#define NF_PUT_ATT_INT2 NF_PUT_ATT_INT2_
+#define NF_INQ_UNLIMDIM NF_INQ_UNLIMDIM_
+#define NF_GET_VARM_INT NF_GET_VARM_INT_
+#define NF_PUT_VAR1_INT NF_PUT_VAR1_INT_
+#define NF_PUT_VAR1_INT2 NF_PUT_VAR1_INT2_
+#define NF_PUT_VAR1_INT1 NF_PUT_VAR1_INT1_
+#define NF_PUT_VAR1_TEXT NF_PUT_VAR1_TEXT_
+#define NF_PUT_VAR_INT NF_PUT_VAR_INT_
+#define NF_PUT_VAR_DOUBLE NF_PUT_VAR_DOUBLE_
+#define NF_PUT_VAR1_REAL NF_PUT_VAR1_REAL_
+#define NF_PUT_VAR_REAL NF_PUT_VAR_REAL_
+#define NF_PUT_VARA_INT2 NF_PUT_VARA_INT2_
+#define NF_PUT_VARA_INT1 NF_PUT_VARA_INT1_
+#define NF_PUT_VARA_INT NF_PUT_VARA_INT_
+#define NF_PUT_VARA_DOUBLE NF_PUT_VARA_DOUBLE_
+#define NF_PUT_VARA_TEXT NF_PUT_VARA_TEXT_
+#define NF_PUT_VARM_INT1 NF_PUT_VARM_INT1_
+#define NF_PUT_VARM_INT2 NF_PUT_VARM_INT2_
+#define NF_PUT_VARM_INT NF_PUT_VARM_INT_
+#define NF_PUT_VARM_DOUBLE NF_PUT_VARM_DOUBLE_
+#define NF_PUT_VARM_REAL NF_PUT_VARM_REAL_
+#define NF_PUT_VARA_REAL NF_PUT_VARA_REAL_
+#define NF_PUT_VAR_TEXT NF_PUT_VAR_TEXT_
+#define NF_PUT_VAR_INT2 NF_PUT_VAR_INT2_
+#define NF_PUT_VAR_INT1 NF_PUT_VAR_INT1_
+#define NF_PUT_VARS_DOUBLE NF_PUT_VARS_DOUBLE_
+#define NF_PUT_VARM_TEXT NF_PUT_VARM_TEXT_
+#define NF_PUT_VAR1_DOUBLE NF_PUT_VAR1_DOUBLE_
+#define NF_PUT_VARS_INT1 NF_PUT_VARS_INT1_
+#define NF_PUT_VARS_INT2 NF_PUT_VARS_INT2_
+#define NF_PUT_VARS_TEXT NF_PUT_VARS_TEXT_
+#define NF_PUT_VARS_REAL NF_PUT_VARS_REAL_
+#define NF_RENAME_ATT NF_RENAME_ATT_
+#define NF_SET_BASE_PE NF_SET_BASE_PE_
+#define NF_RENAME_VAR NF_RENAME_VAR_
+#define NF_RENAME_DIM NF_RENAME_DIM_
+#define NF_REDEF NF_REDEF_
+#define NF_SYNC NF_SYNC_
+#define NF_STRERROR NF_STRERROR_
+#define NF_SET_FILL NF_SET_FILL_
+#define NF_SET_DEFAULT_FORMAT NF_SET_DEFAULT_FORMAT_
+#define NF_PUT_VARS_INT NF_PUT_VARS_INT_
+#define NF_GET_VAR_INT2 NF_GET_VAR_INT2_
+#define NF__CREATE_MP NF__CREATE_MP_
+#define NF__OPEN NF__OPEN_
+#define NF__OPEN_MP NF__OPEN_MP_
+#define NF__ENDDEF NF__ENDDEF_
+#define NF_ABORT NF_ABORT_
+#define NF__CREATE NF__CREATE_
+#define NF_COPY_ATT NF_COPY_ATT_
+#define NF_CREATE NF_CREATE_
+#define NF_DEF_DIM NF_DEF_DIM_
+#define NF_COPY_VAR NF_COPY_VAR_
+#define NF_CLOSE NF_CLOSE_
+#define NF_DEL_ATT NF_DEL_ATT_
+#define NF_DELETE NF_DELETE_
+#define NF_DEF_VAR NF_DEF_VAR_
+#define NF_ENDDEF NF_ENDDEF_
+#define NF_GET_ATT_REAL NF_GET_ATT_REAL_
+#define NF_GET_ATT_DOUBLE NF_GET_ATT_DOUBLE_
+#define NF_GET_ATT_INT NF_GET_ATT_INT_
+#define NF_GET_ATT_INT2 NF_GET_ATT_INT2_
+#define NF_GET_ATT_INT1 NF_GET_ATT_INT1_
+#define NF_GET_ATT_TEXT NF_GET_ATT_TEXT_
+#define NF_GET_VAR1_INT NF_GET_VAR1_INT_
+#define NF_GET_VAR1_INT1 NF_GET_VAR1_INT1_
+#define NF_GET_VAR1_TEXT NF_GET_VAR1_TEXT_
+#define NF_GET_VAR1_REAL NF_GET_VAR1_REAL_
+#define NF_GET_VAR1_INT2 NF_GET_VAR1_INT2_
+#define NF_GET_VAR1_DOUBLE NF_GET_VAR1_DOUBLE_
+#define NF_GET_VAR_INT NF_GET_VAR_INT_
+#define NF_GET_VAR_INT2 NF_GET_VAR_INT2_
+#define NF_GET_VAR_REAL NF_GET_VAR_REAL_
+#define NF_GET_VAR_INT1 NF_GET_VAR_INT1_
+#define NF_GET_VAR_TEXT NF_GET_VAR_TEXT_
+#define NF_GET_VARA_INT1 NF_GET_VARA_INT1_
+#define NF_GET_VARA_INT NF_GET_VARA_INT_
+#define NF_GET_VARA_INT2 NF_GET_VARA_INT2_
+#define NF_GET_VARA_DOUBLE NF_GET_VARA_DOUBLE_
+#define NF_GET_VAR_DOUBLE NF_GET_VAR_DOUBLE_
+#define NF_GET_VARM_INT NF_GET_VARM_INT_
+#define NF_GET_VARM_DOUBLE NF_GET_VARM_DOUBLE_
+#define NF_GET_VARM_INT2 NF_GET_VARM_INT2_
+#define NF_GET_VARS_DOUBLE NF_GET_VARS_DOUBLE_
+#define NF_GET_VARM_TEXT NF_GET_VARM_TEXT_
+#define NF_GET_VARM_REAL NF_GET_VARM_REAL_
+#define NF_GET_VARM_INT1 NF_GET_VARM_INT1_
+#define NF_GET_VARA_TEXT NF_GET_VARA_TEXT_
+#define NF_GET_VARS_TEXT NF_GET_VARS_TEXT_
+#define NF_GET_VARS_REAL NF_GET_VARS_REAL_
+#define NF_GET_VARS_INT2 NF_GET_VARS_INT2_
+#define NF_GET_VARS_INT1 NF_GET_VARS_INT1_
+#define NF_INQ_ATT NF_INQ_ATT_
+#define NF_INQ_ATTID NF_INQ_ATTID_
+#define NF_INQ NF_INQ_
+#define NF_INQ_ATTTYPE NF_INQ_ATTTYPE_
+#define NF_INQ_ATTNAME NF_INQ_ATTNAME_
+#define NF_INQ_DIMLEN NF_INQ_DIMLEN_
+#define NF_INQ_DIMID NF_INQ_DIMID_
+#define NF_INQ_LIBVERS NF_INQ_LIBVERS_
+#define NF_INQ_FORMAT NF_INQ_FORMAT_
+#define NF_INQ_DIMNAME NF_INQ_DIMNAME_
+#define NF_INQ_DIM NF_INQ_DIM_
+#define NF_INQ_BASE_PE NF_INQ_BASE_PE_
+#define NF_INQ_NDIMS NF_INQ_NDIMS_
+#define NF_INQ_UNLIMDIM NF_INQ_UNLIMDIM_
+#define NF_INQ_NVARS NF_INQ_NVARS_
+#define NF_INQ_VAR NF_INQ_VAR_
+#define NF_INQ_NATTS NF_INQ_NATTS_
+#define NF_INQ_VARID NF_INQ_VARID_
+#define NF_INQ_VARNAME NF_INQ_VARNAME_
+#define NF_INQ_VARNATTS NF_INQ_VARNATTS_
+#define NF_INQ_VARDIMID NF_INQ_VARDIMID_
+#define NF_INQ_ATTLEN NF_INQ_ATTLEN_
+#define NF_GET_VARS_INT NF_GET_VARS_INT_
+#define NF_GET_VARA_REAL NF_GET_VARA_REAL_
+#define NF_INQ_VARTYPE NF_INQ_VARTYPE_
+#define NF_ISSYSERR NF_ISSYSERR_
+#define NF_OPEN NF_OPEN_
+#define NF_PUT_ATT_INT1 NF_PUT_ATT_INT1_
+#define NF_PUT_ATT_INT2 NF_PUT_ATT_INT2_
+#define NF_PUT_ATT_TEXT NF_PUT_ATT_TEXT_
+#define NF_PUT_VAR1_INT NF_PUT_VAR1_INT_
+#define NF_PUT_VAR1_INT1 NF_PUT_VAR1_INT1_
+#define NF_PUT_VAR1_DOUBLE NF_PUT_VAR1_DOUBLE_
+#define NF_PUT_VAR1_INT2 NF_PUT_VAR1_INT2_
+#define NF_PUT_VAR1_REAL NF_PUT_VAR1_REAL_
+#define NF_PUT_ATT_REAL NF_PUT_ATT_REAL_
+#define NF_PUT_VAR1_TEXT NF_PUT_VAR1_TEXT_
+#define NF_PUT_ATT_INT NF_PUT_ATT_INT_
+#define NF_PUT_ATT_DOUBLE NF_PUT_ATT_DOUBLE_
+#define NF_PUT_VAR_DOUBLE NF_PUT_VAR_DOUBLE_
+#define NF_PUT_VAR_INT2 NF_PUT_VAR_INT2_
+#define NF_PUT_VAR_INT1 NF_PUT_VAR_INT1_
+#define NF_PUT_VAR_REAL NF_PUT_VAR_REAL_
+#define NF_PUT_VAR_INT NF_PUT_VAR_INT_
+#define NF_INQ_VARNDIMS NF_INQ_VARNDIMS_
+#define NF_PUT_VARA_INT1 NF_PUT_VARA_INT1_
+#define NF_PUT_VARA_TEXT NF_PUT_VARA_TEXT_
+#define NF_PUT_VARA_REAL NF_PUT_VARA_REAL_
+#define NF_PUT_VARM_INT NF_PUT_VARM_INT_
+#define NF_PUT_VARM_DOUBLE NF_PUT_VARM_DOUBLE_
+#define NF_PUT_VARA_INT2 NF_PUT_VARA_INT2_
+#define NF_PUT_VARM_INT1 NF_PUT_VARM_INT1_
+#define NF_PUT_VARM_REAL NF_PUT_VARM_REAL_
+#define NF_PUT_VARM_TEXT NF_PUT_VARM_TEXT_
+#define NF_PUT_VARS_INT1 NF_PUT_VARS_INT1_
+#define NF_PUT_VARS_INT NF_PUT_VARS_INT_
+#define NF_PUT_VARS_REAL NF_PUT_VARS_REAL_
+#define NF_PUT_VARS_INT2 NF_PUT_VARS_INT2_
+#define NF_PUT_VARS_TEXT NF_PUT_VARS_TEXT_
+#define NF_PUT_VARS_DOUBLE NF_PUT_VARS_DOUBLE_
+#define NF_PUT_VARM_INT2 NF_PUT_VARM_INT2_
+#define NF_RENAME_DIM NF_RENAME_DIM_
+#define NF_RENAME_ATT NF_RENAME_ATT_
+#define NF_REDEF NF_REDEF_
+#define NF_SET_BASE_PE NF_SET_BASE_PE_
+#define NF_SET_DEFAULT_FORMAT NF_SET_DEFAULT_FORMAT_
+#define NF_RENAME_VAR NF_RENAME_VAR_
+#define NF_PUT_VARA_INT NF_PUT_VARA_INT_
+#define NF_STRERROR NF_STRERROR_
+#define NF_SET_FILL NF_SET_FILL_
+#define NF_PUT_VAR_TEXT NF_PUT_VAR_TEXT_
+
+#endif
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/timer.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/timer.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/timer.f90	(revision 6412)
@@ -0,0 +1,279 @@
+! ==============================================================================================================================
+! MODULE            : timer
+!
+! CONTACT           : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE           : IPSL (2006)
+!                     This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF              Timer functions to calculate MPI time consumption.
+!!
+!!\n DESCRIPTION    : Timer functions to calculate MPI time consumption (global time and mpi time). 
+!!                    - store in timer_state the state of the simulation (running, stopped, suspended)
+!!                    - calcutate the cpu time in cpu_timer / the real time in real_timer
+!!               
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE timer
+
+  USE mod_orchidee_para_var, ONLY : numout
+  
+  INTEGER, PARAMETER :: nb_timer=2
+  INTEGER, PARAMETER :: timer_global=1
+  INTEGER, PARAMETER :: timer_mpi=2
+  INTEGER, PARAMETER :: stopped = 1
+  INTEGER, PARAMETER :: running = 2
+  INTEGER, PARAMETER :: suspended = 3
+  
+  DOUBLE PRECISION, DIMENSION(nb_timer),SAVE :: cpu_timer
+  DOUBLE PRECISION, DIMENSION(nb_timer),SAVE :: real_timer
+  INTEGER, DIMENSION(nb_timer),SAVE :: timer_state
+  DOUBLE PRECISION, DIMENSION(nb_timer),SAVE :: last_cpu_time
+  INTEGER, DIMENSION(nb_timer),SAVE :: last_real_time
+  
+   
+  CONTAINS
+  
+  !! =============================================================================================================================
+  !! SUBROUTINE   : init_timer
+  !!
+  !>\BRIEF          Initialization of the timer. 
+  !!
+  !! DESCRIPTION  : Initialization of the timer. Need to be called at the beginning of 
+  !!                the simulation by the master threads OMP on each process mpi. 
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+
+  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
+  !!
+  !>\BRIEF	    Start all timer variables for the type of timer which was choosen (global timer or mpi timer) 
+  !!
+  !! DESCRIPTION  : Start all timer variables for the type of timer which was choosen (global timer or mpi timer) 
+  !!                Need to be call by the master threads on each process mpi. 	 
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+
+  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
+  !!
+  !>\BRIEF	    This subroutine will change the value of timer_state from "running" to "stopped"
+  !!
+  !! DESCRIPTION  : This subroutine will change the value of timer_state from "running" to "stopped"	 
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+
+  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
+  !!
+  !>\BRIEF	    This subroutine will change the value of timer_state from suspended to running and update diff_cpu_time and diff_real_time
+  !!
+  !! DESCRIPTION  : This subroutine will change the value of timer_state from suspended to running and 
+  !!                update diff_cpu_time and diff_real_time
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+
+  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
+  !!
+  !>\BRIEF	    This subroutine will change the value of timer_state from running to suspended and update cpu_timer
+  !!
+  !! DESCRIPTION  : This subroutine will change the value of timer_state from running to suspended and update cpu_timer
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+
+  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
+  !!
+  !>\BRIEF	   Calculate the increment of real time since the last call to diff_real_time
+  !!
+  !! DESCRIPTION : Calculate the increment of real time since the last call to diff_real_time
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+
+  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
+  !!
+  !>\BRIEF         Calculate the increment of cpu time since the last call to diff_real_time	
+  !!
+  !! DESCRIPTION : Calculate the increment of cpu time since the last call to diff_real_time	
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+
+  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
+  !!
+  !>\BRIEF	   Return the value of cpu_timer 
+  !!
+  !! DESCRIPTION : This subroutine will return the value of cpu_timer 
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+
+  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
+  !!
+  !>\BRIEF         Return the value of real_timer
+  !!
+  !! DESCRIPTION : This subroutine will return the value of real_timer
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+
+  FUNCTION Get_real_time(no_timer)
+  IMPLICIT NONE
+  INTEGER :: no_timer
+  DOUBLE PRECISION :: Get_real_time
+  
+    IF (timer_state(no_timer)==running) THEN
+      CALL suspend_timer(no_timer)
+      Get_real_time=real_timer(no_timer)
+      CALL resume_timer(no_timer)
+    ELSE
+      Get_real_time=real_timer(no_timer)
+    ENDIF
+  
+  END FUNCTION Get_real_time
+  
+END MODULE Timer
+  
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/tools_para.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/tools_para.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/tools_para.f90	(revision 6412)
@@ -0,0 +1,24 @@
+! Obsolete parallel tools : Barrier
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE tools_para
+!-
+  USE mod_orchidee_para_var, ONLY : MPI_COMM_ORCH
+!-
+#include "src_parallel.h"
+!-
+CONTAINS
+
+  SUBROUTINE barrier_para()
+#ifdef CPP_PARA
+    CALL MPI_BARRIER(MPI_COMM_ORCH,ierr)
+#endif
+  END SUBROUTINE barrier_para
+
+END MODULE tools_para
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/write_field.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/write_field.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/write_field.f90	(revision 6412)
@@ -0,0 +1,12 @@
+! Yann Meurdesoif module for sequentiel tests.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE Write_Field
+  USE Orch_Write_Field
+END MODULE Write_Field
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/write_field_p.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/write_field_p.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/write_field_p.f90	(revision 6412)
@@ -0,0 +1,12 @@
+! Yann Meurdesoif module for parallel tests.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE Write_field_p
+  USE Orch_Write_Field_p
+END MODULE Write_field_p
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/xios_orchidee.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/xios_orchidee.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parallel/xios_orchidee.f90	(revision 6412)
@@ -0,0 +1,790 @@
+! ================================================================================================================================
+!  MODULE       : xios_orchidee
+!
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF   This module contains the initialization and interface to the XIOS code.
+!!
+!!\n DESCRIPTION: This module contains the interface for the use of the XIOS code. All call to XIOS are done in this module.
+!!                Revision 965 of XIOS/trunk or later is needed. This version is also called XIOS2. 
+!!                Older revisions and XIOS1 can not be used.
+!!                
+!!                Summury of subroutines
+!!                      xios_orchidee_comm_init       : First call to XIOS to get the MPI communicator 
+!!                      xios_orchidee_init            : Initialize variables needed for use of XIOS 
+!!                                                      Deactivation of fields not calculated due specific run options
+!!                      xios_orchidee_update_calendar : Update the calandar in XIOS
+!!                      xios_orchidee_finalize        : Last call to XIOS for finalization
+!!                      xios_orchidee_send_field      : Interface to send fields with 1, 2 or 3 dimensions to XIOS
+!!                      xios_orchidee_send_field_r1d  : Internal subroutine for 1D(array) fields
+!!                      xios_orchidee_send_field_r2d  : Internal subroutine for 2D fields
+!!                      xios_orchidee_send_field_r3d  : Internal subroutine for 3D fields
+!!
+!!                It is only possible to use XIOS2. Note that compilation must be done with the preprocessing key XIOS 
+!!                and CPP_PARA. Compiling without these keys makes it impossible to activate XIOS. 
+!!                To activate running using XIOS, the flag XIOS_ORCHIDEE_OK=y must be set in run.def and the file iodef.xml must exist.  
+!!
+!! RECENT CHANGE(S): Created by Arnaud Caubel(LSCE), Josefine Ghattas (IPSL) 2013
+!!                   Removed possibility to use XIOS1, 21/10/2016
+!!
+!! REFERENCE(S) : None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE xios_orchidee
+
+#ifdef XIOS
+  USE xios
+#endif
+  USE defprec
+  USE pft_parameters_var, ONLY : nvm
+  USE constantes_var
+  USE constantes_soil_var, ONLY : nstm, diaglev, check_cwrr, ok_freeze_cwrr
+  USE vertical_soil_var, ONLY : ngrnd, nslm, nbdl
+  USE IOIPSL, ONLY : ioget_calendar, ju2ymds
+  USE mod_orchidee_para_var
+  USE mod_orchidee_transfert_para
+  USE ioipsl_para
+  USE grid_var, ONLY : GridType
+
+  IMPLICIT NONE
+  PRIVATE
+  PUBLIC :: xios_orchidee_comm_init, xios_orchidee_init, xios_orchidee_change_context, &
+            xios_orchidee_update_calendar, xios_orchidee_context_finalize, xios_orchidee_finalize, &
+            xios_orchidee_send_field
+
+  !
+  !! Declaration of public variables
+  !
+  LOGICAL, PUBLIC, SAVE           :: xios_orchidee_ok=.TRUE.     !! Use XIOS for diagnostic files
+  !$OMP THREADPRIVATE(xios_orchidee_ok)
+
+  !
+  !! Declaration of internal variables
+  !
+#ifdef XIOS
+  TYPE(xios_context)              :: ctx_hdl_orchidee      !! Handel for ORCHIDEE
+  !$OMP THREADPRIVATE(ctx_hdl_orchidee)
+#endif
+  CHARACTER(len=*),PARAMETER      :: id="client"           !! Id for initialization of ORCHIDEE in XIOS
+
+
+
+  !! ==============================================================================================================================
+  !! INTERFACE   : xios_orchidee_send_field
+  !!
+  !>\BRIEF         Send a field to XIOS.
+  !!
+  !! DESCRIPTION  :\n Send a field to XIOS. The field can have 1, 2 or 3 dimensions.
+  !!                  This interface should be called at each time-step for each output varaiables.
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  INTERFACE xios_orchidee_send_field
+     MODULE PROCEDURE xios_orchidee_send_field_r1d, xios_orchidee_send_field_r2d, xios_orchidee_send_field_r3d, &
+                      xios_orchidee_send_field_r4d, xios_orchidee_send_field_r5d
+  END INTERFACE
+
+
+CONTAINS
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_comm_init 
+  !!
+  !>\BRIEF         Get the MPI communicator.
+  !!
+  !! DESCRIPTION  :\n First call to XIOS to get the MPI communicator. 
+  !!                  Note that it is XIOS that initialize the MPI communicator.
+  !!                  This subroutine is only called in ORCHIDEE offline mode. When running in coupled mode, the 
+  !!                  atmospheric model must initlialize XIOS at the same time as initializing MPI. 
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_comm_init(comm_local)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !!    Output variables
+    INTEGER, INTENT(OUT) :: comm_local
+
+    !_ ================================================================================================================================
+
+    IF (is_omp_root) THEN
+#ifdef XIOS
+       CALL xios_initialize(id,return_comm=comm_local)
+#else
+       CALL ipslerr_p(3, 'xios_orchidee_comm_init', 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS', &
+            'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def','')
+#endif
+    END IF
+  END SUBROUTINE xios_orchidee_comm_init
+
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_init 
+  !!
+  !>\BRIEF         Initialize variables needed for use of XIOS.
+  !!
+  !! DESCRIPTION  :\n Initialization of specific varaiables needed to use XIOS such as model domain and time step. 
+  !!
+  !!                  In this subroutine also a section containg deactivation of some fields is found. The variables are 
+  !!                  deactivated of not according to the corresponding control flag. For exemple the variables cacluated by the 
+  !!                  routing scheme will be deactivated if the routing is deactivated. This is done to be able to keep the same 
+  !!                  iodef.xml input file for several options without geting empty fields in the output file. Note that a field that
+  !!                  is activated in the code can always be deactivated from the iodef.xml external file. 
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_init(MPI_COMM_ORCH,               &
+       date0,    year,      month,             day,          &
+       lon_mpi,  lat_mpi,   soilth_lev )
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                            :: MPI_COMM_ORCH    !! Orchidee MPI communicator (from module mod_orchidee_mpi_data)
+    REAL(r_std), INTENT(in)                               :: date0            !! Julian day at first time step
+    INTEGER(i_std), INTENT(in)                            :: year, month, day !! Current date information
+    REAL(r_std),DIMENSION (iim_g,jj_nb), INTENT(in)       :: lon_mpi, lat_mpi !! Longitudes and latitudes on MPI local domain 2D domain
+    REAL(r_std),DIMENSION (ngrnd), INTENT(in)             :: soilth_lev       !! Vertical soil levels for thermal scheme (m)
+    !
+    !! 0.2 Local variables
+    !
+#ifdef XIOS
+
+    TYPE(xios_duration)            :: dtime_xios
+    TYPE(xios_date)                :: start_date
+    TYPE(xios_date)                :: time_origin
+    TYPE(xios_fieldgroup)          :: fieldgroup_handle
+    TYPE(xios_field)               :: field_handle
+    TYPE(xios_file)                :: file_handle
+#endif
+    INTEGER(i_std)                 :: i
+    INTEGER(i_std)                 :: year0, month0, day0 !! Time origin date information
+    REAL(r_std)                    :: sec0                !! Time origin date information
+    CHARACTER(LEN=20)              :: calendar_str        !! Name of current calendar
+    CHARACTER(LEN=30)              :: start_str           !! Current date as character string
+    CHARACTER(LEN=30)              :: startorig_str       !! Time origin date as character string
+    !_ ================================================================================================================================
+    
+    
+    IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_init'
+
+    !Config Key   = XIOS_ORCHIDEE_OK
+    !Config Desc  = Use XIOS for writing diagnostics file
+    !Config If    = 
+    !Config Def   = y 
+    !Config Help  = Compiling and linking with XIOS library is necessary. 
+    !Config Units = [FLAG]
+    CALL getin_p('XIOS_ORCHIDEE_OK',xios_orchidee_ok)
+    WRITE(numout,*)'In xios_orchidee_init, xios_orchidee_ok=',xios_orchidee_ok
+
+    ! Coherence test between flag and preprocessing key
+#ifndef XIOS
+    IF (xios_orchidee_ok) THEN
+       CALL ipslerr_p(3,'xios_orchidee_init', 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS',&
+            'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def', '')
+    END IF
+#endif
+
+
+    !
+    !! 1. Set date and calendar information on the format needed by XIOS
+    !
+
+    ! Get the calendar from IOIPSL and modify the string to correspond to what XIOS expects
+    CALL ioget_calendar(calendar_str)
+
+    IF (calendar_str == 'gregorian') THEN
+       calendar_str='gregorian'
+    ELSE IF (calendar_str == 'noleap') THEN
+       calendar_str='noleap'
+    ELSE IF (calendar_str == '360d') THEN
+       calendar_str='d360'
+    END IF
+
+    ! Transform the time origin from julian days into year, month, day and seconds
+    CALL ju2ymds(date0, year0, month0, day0, sec0)
+
+
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+#ifdef XIOS
+       !
+       !! 2. Context initialization
+       !
+       CALL xios_context_initialize("orchidee",MPI_COMM_ORCH)
+       CALL xios_get_handle("orchidee",ctx_hdl_orchidee)
+       CALL xios_set_current_context(ctx_hdl_orchidee)
+
+       !
+       !! 2. Calendar, timstep and date definition
+       !
+       dtime_xios%second=dt_sechiba
+
+       CALL xios_define_calendar(type=calendar_str, start_date=xios_date(year,month,day,0,0,0), &
+            time_origin=xios_date(year0,month0,day0,0,0,0), timestep=dtime_xios)
+
+       !
+       !! 3. Domain definition
+       !
+       ! Global domain
+       CALL xios_set_domain_attr("domain_landpoints", ni_glo=iim_g, nj_glo=jjm_g)
+
+       ! Local MPI domain
+       IF ( GridType == "RegLonLat" ) THEN
+          CALL xios_set_domain_attr("domain_landpoints",type="rectilinear", ibegin=0, ni=iim_g, jbegin=jj_begin-1, nj=jj_nb)
+       ELSE IF ( GridType == "RegXY" ) THEN
+          CALL xios_set_domain_attr("domain_landpoints",type="curvilinear", ibegin=0, ni=iim_g, jbegin=jj_begin-1, nj=jj_nb)
+       ELSE
+          WRITE(numout,*) 'Following GridType is not supported: GridType =', GridType
+          CALL ipslerr_p(3, 'xios_orchidee_init', 'GridType not yet supported.','Problem for defining local MPI domain','')
+       ENDIF
+
+       ! Define how data is stored on memory : 1D array for only continental points
+       CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ibegin=0, data_ni=nbp_mpi)
+       CALL xios_set_domain_attr("domain_landpoints",data_ni=nbp_mpi, data_i_index=kindex_mpi-1)     
+
+       ! Define longitudes and latitudes on local MPI domain depending on GridType
+       IF ( GridType == "RegLonLat" ) THEN
+          CALL xios_set_domain_attr("domain_landpoints",lonvalue_1d=lon_mpi(:,1),latvalue_1d=lat_mpi(1,:))
+       ELSE IF ( GridType == "RegXY" ) THEN
+          CALL xios_set_domain_attr("domain_landpoints",lonvalue_2d=lon_mpi,latvalue_2d=lat_mpi)
+       ELSE
+          WRITE(numout,*) 'Following GridType is not supported: GridType =', GridType
+          CALL ipslerr_p(3, 'xios_orchidee_init', 'GridType not yet supported. ','Problem for defining longitudes and latitudes','')
+       ENDIF
+
+       !
+       !! 4. Axis definition
+       !
+       CALL xios_set_axis_attr("nvm",n_glo=nvm ,VALUE=(/(REAL(i,r_std),i=1,nvm)/))
+       CALL xios_set_axis_attr("nlaip1", n_glo=nlai+1,VALUE=(/(REAL(i,r_std),i=1,nlai+1)/))
+       CALL xios_set_axis_attr("ngrnd",n_glo=ngrnd ,VALUE=soilth_lev(:))
+       CALL xios_set_axis_attr("nstm", n_glo=nstm,VALUE=(/(REAL(i,r_std),i=1,nstm)/))
+       CALL xios_set_axis_attr("nnobio", n_glo=nnobio,VALUE=(/(REAL(i,r_std),i=1,nnobio)/))
+       CALL xios_set_axis_attr("albtyp", n_glo=2,VALUE=(/(REAL(i,r_std),i=1,2)/))
+       CALL xios_set_axis_attr("nslm", n_glo=nslm,VALUE=(/(REAL(i,r_std),i=1,nslm)/))
+       CALL xios_set_axis_attr("nbdl", n_glo=nbdl,VALUE=diaglev(:))
+       CALL xios_set_axis_attr("P10", n_glo=10,VALUE=(/(REAL(i,r_std), i=1,10)/))
+       CALL xios_set_axis_attr("P100", n_glo=100,VALUE=(/(REAL(i,r_std), i=1,100)/))
+       CALL xios_set_axis_attr("P11", n_glo=11,VALUE=(/(REAL(i,r_std), i=1,11)/))
+       CALL xios_set_axis_attr("P101", n_glo=101,VALUE=(/(REAL(i,r_std), i=1,101)/))
+       CALL xios_set_axis_attr("nshort",n_glo=nshort,VALUE=(/(REAL(i,r_std),i=1,nshort)/))
+       CALL xios_set_axis_attr("nmedium", n_glo=nmedium,VALUE=(/(REAL(i,r_std),i=1,nmedium)/))
+       CALL xios_set_axis_attr("nlong",n_glo=nlong,VALUE=(/(REAL(i,r_std),i=1,nlong)/))
+       CALL xios_set_axis_attr("nshort1",n_glo=nshort+1,VALUE=(/(REAL(i,r_std),i=1,nshort+1)/))
+       CALL xios_set_axis_attr("nmedium1",n_glo=nmedium+1,VALUE=(/(REAL(i,r_std),i=1,nmedium+1)/))
+       CALL xios_set_axis_attr("nlong1",n_glo=nlong+1,VALUE=(/(REAL(i,r_std),i=1,nlong+1)/))
+       CALL xios_set_axis_attr("ncirc", n_glo=ncirc,VALUE=(/(REAL(i,r_std),i=1,ncirc)/))
+       CALL xios_set_axis_attr("nlevels_tot", n_glo=nlevels_tot,VALUE=(/(REAL(i,r_std),i=1,nlevels_tot)/))
+       CALL xios_set_axis_attr("ngrnd",n_glo=ngrnd,VALUE=(/(REAL(i,r_std),i=1,ngrnd)/))
+       CALL xios_set_axis_attr("nsnow", n_glo=nsnow,VALUE=(/(REAL(i,r_std),i=1,nsnow)/))
+       CALL xios_set_axis_attr("ncut", n_glo=ncut_times,VALUE=(/(REAL(i,r_std),i=1,ncut_times)/))
+       !
+       !! 5. Deactivation of some fields if they are not calculated
+       !
+       IF ( OFF_LINE_MODE ) THEN
+          CALL xios_set_field_attr("q2m",enabled=.FALSE.)
+          CALL xios_set_field_attr("t2m",enabled=.FALSE.)
+          CALL xios_set_field_attr("riverflow_cpl",enabled=.FALSE.)
+          CALL xios_set_field_attr("coastalflow_cpl",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. river_routing ) THEN
+          CALL xios_set_field_attr("basinmap",enabled=.FALSE.)
+          CALL xios_set_field_attr("nbrivers",enabled=.FALSE.)
+          CALL xios_set_field_attr("riversret",enabled=.FALSE.)
+          CALL xios_set_field_attr("hydrographs",enabled=.FALSE.)
+          CALL xios_set_field_attr("fastr",enabled=.FALSE.)
+          CALL xios_set_field_attr("slowr",enabled=.FALSE.)
+          CALL xios_set_field_attr("streamr",enabled=.FALSE.)
+          CALL xios_set_field_attr("laker",enabled=.FALSE.)
+          CALL xios_set_field_attr("lake_overflow",enabled=.FALSE.)
+          CALL xios_set_field_attr("mask_coast",enabled=.FALSE.)
+          CALL xios_set_field_attr("pondr",enabled=.FALSE.)
+          CALL xios_set_field_attr("floodr",enabled=.FALSE.)
+          CALL xios_set_field_attr("slowflow",enabled=.FALSE.)
+          CALL xios_set_field_attr("delfastr",enabled=.FALSE.)
+          CALL xios_set_field_attr("delslowr",enabled=.FALSE.)
+          CALL xios_set_field_attr("delstreamr",enabled=.FALSE.)
+          CALL xios_set_field_attr("dellaker",enabled=.FALSE.)
+          CALL xios_set_field_attr("delpondr",enabled=.FALSE.)
+          CALL xios_set_field_attr("delfloodr",enabled=.FALSE.)
+          CALL xios_set_field_attr("irrigmap",enabled=.FALSE.)
+          CALL xios_set_field_attr("swampmap",enabled=.FALSE.)
+          CALL xios_set_field_attr("wbr_stream",enabled=.FALSE.)
+          CALL xios_set_field_attr("wbr_fast",enabled=.FALSE.)
+          CALL xios_set_field_attr("wbr_slow",enabled=.FALSE.)
+          CALL xios_set_field_attr("wbr_lake",enabled=.FALSE.)
+          CALL xios_set_field_attr("reinfiltration",enabled=.FALSE.)
+          CALL xios_set_field_attr("irrigation",enabled=.FALSE.)
+          CALL xios_set_field_attr("netirrig",enabled=.FALSE.)
+          CALL xios_set_field_attr("SurfStor",enabled=.FALSE.)
+       END IF
+
+
+       IF (.NOT. ok_freeze_cwrr) THEN
+          CALL xios_set_field_attr("profil_froz_hydro",enabled=.FALSE.)
+          CALL xios_set_field_attr("temp_hydro",enabled=.FALSE.)
+          CALL xios_set_field_attr("kk_moy",enabled=.FALSE.)
+          CALL xios_set_field_attr("profil_froz_hydro_ns",enabled=.FALSE.)
+       END IF
+
+       
+       IF (.NOT. check_cwrr) THEN
+          CALL xios_set_field_attr("check_infilt",enabled=.FALSE.)
+          CALL xios_set_field_attr("check_tr",enabled=.FALSE.)
+          CALL xios_set_field_attr("check_over",enabled=.FALSE.)
+          CALL xios_set_field_attr("check_under",enabled=.FALSE.)
+          CALL xios_set_field_attr("check_top",enabled=.FALSE.) 
+          CALL xios_set_field_attr("qflux",enabled=.FALSE.) 
+       END IF
+
+       IF ( .NOT. do_floodplains ) THEN
+          CALL xios_set_field_attr("floodmap",enabled=.FALSE.)
+          CALL xios_set_field_attr("floodh",enabled=.FALSE.)       
+          CALL xios_set_field_attr("floodout",enabled=.FALSE.)       
+       END IF
+
+       ! Deactivate some stomate fields. 
+       ! These fields were traditionally added in sechiba_history.nc output file.
+       IF ( .NOT. ok_stomate ) THEN
+          CALL xios_set_field_attr("nee",enabled=.FALSE.)
+          CALL xios_set_field_attr("maint_resp",enabled=.FALSE.)
+          CALL xios_set_field_attr("hetero_resp",enabled=.FALSE.)
+          CALL xios_set_field_attr("growth_resp",enabled=.FALSE.)
+          CALL xios_set_field_attr("npp",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. do_irrigation ) THEN
+          CALL xios_set_field_attr("irrigation",enabled=.FALSE.)
+          CALL xios_set_field_attr("netirrig",enabled=.FALSE.)
+          CALL xios_set_field_attr("irrigmap",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. ok_bvoc)THEN
+          CALL xios_set_field_attr("PAR",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_fertil_no",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_iso",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_mono",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_ORVOC",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_MBO",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_methanol",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_acetone",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_acetal",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_formal",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_acetic",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_formic",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_no_soil",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_no",enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_apinen'   ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_bpinen'   ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_limonen'  ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_myrcen'   ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_sabinen'  ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_camphen'  ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_3caren'   ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_tbocimen' ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_othermono',enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_sesquiter',enabled=.FALSE.)
+          CALL xios_set_field_attr("CRF",enabled=.FALSE.)
+          CALL xios_set_field_attr("fco2",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy ) THEN
+          CALL xios_set_field_attr("PARdf",enabled=.FALSE.)
+          CALL xios_set_field_attr("PARdr",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy .OR. .NOT. ok_multilayer ) THEN
+          CALL xios_set_field_attr( 'PARsuntab',enabled=.FALSE.)
+          CALL xios_set_field_attr( 'PARshtab' ,enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy .OR. ok_multilayer ) THEN
+          CALL xios_set_field_attr("PARsun",enabled=.FALSE.)
+          CALL xios_set_field_attr("PARsh",enabled=.FALSE.)
+          CALL xios_set_field_attr("laisun",enabled=.FALSE.)
+          CALL xios_set_field_attr("laish",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. ok_bvoc .OR. .NOT. ok_bbgfertil_Nox) THEN
+          CALL xios_set_field_attr("flx_co2_bbg_year",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. ok_bvoc .OR. .NOT. ok_cropsfertil_Nox) THEN
+          CALL xios_set_field_attr("N_qt_WRICE_year",enabled=.FALSE.)
+          CALL xios_set_field_attr("N_qt_OTHER_year",enabled=.FALSE.)
+       END IF
+
+       IF (impaze) THEN
+          CALL xios_set_field_attr("soilalb_vis",enabled=.FALSE.)
+          CALL xios_set_field_attr("soilalb_nir",enabled=.FALSE.)
+          CALL xios_set_field_attr("vegalb_vis",enabled=.FALSE.)
+          CALL xios_set_field_attr("vegalb_nir",enabled=.FALSE.)
+       END IF
+
+       !
+       !! 6. Close context
+       !
+       CALL xios_close_context_definition()      
+
+
+       !
+       !! 7. Activate almaoutput if needed 
+       !! Some extra calculations have to be done for the variables  
+       !! delsoilmoist, delintercept, delswe and soilwet.
+       !! Set almaoutput=true if at least one of these variables are defined in an output file. 
+       !! If not, keep the initial value of almaoutput. 
+       IF ( xios_field_is_active("delsoilmoist") .OR. xios_field_is_active("delintercept") .OR. &
+            xios_field_is_active("delswe")       .OR. xios_field_is_active("soilwet")      .OR. &
+            xios_field_is_active("twbr")) THEN
+
+          almaoutput=.TRUE.
+          WRITE(numout,*) 'The flag almaoutput has been activated in xios_orchidee_init'
+       END IF
+#endif
+    END IF
+
+    IF (xios_orchidee_ok) THEN
+       ! Send variable almaoutput to all processes
+       CALL bcast(almaoutput)
+    END IF
+
+    IF (printlev>=3) WRITE(numout,*) 'Exit xios_orchidee_init'
+  END SUBROUTINE xios_orchidee_init
+
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_change_context
+  !!
+  !>\BRIEF         Use this subroutine to switch between different context.
+  !!               This subroutine must be called when running in coupled mode at each time ORCHIDEE is called, in the
+  !!               begining and end of intersurf_gathered. First call is done after xios_orchidee_init is done. 
+  !!
+  !! DESCRIPTION  :\n 
+  !!                  
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_change_context(new_context)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !!    Input variable
+    CHARACTER(LEN=*),INTENT(IN)              :: new_context
+
+    !! Local variables
+#ifdef XIOS
+    TYPE(xios_context) :: ctx_hdl
+#endif
+    !_ ================================================================================================================================
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+#ifdef XIOS
+       CALL xios_get_handle(new_context,ctx_hdl)
+       CALL xios_set_current_context(ctx_hdl)
+#endif
+    END IF
+    
+  END SUBROUTINE xios_orchidee_change_context
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_update_calendar
+  !!
+  !>\BRIEF          Update the calandar in XIOS.
+  !!
+  !! DESCRIPTION  :\n Update the calendar in XIOS : let XIOS know that ORCHIDEE avanced one time-step.
+  !!                  This subroutine should be called in the beginning of each time-step. The first 
+  !!                  time-step in a new execution should always start at 1. Therefore, first calculate
+  !!                  an offset that is substracted to the current time step in sechiba. 
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_update_calendar(itau_sechiba)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(IN) :: itau_sechiba    !! Current time step of the model
+    !
+    !! 0.2 Local variables
+    !
+    LOGICAL, SAVE         :: first=.TRUE.         !! Flag for first entering in subroutine
+    INTEGER(i_std), SAVE  :: offset               !! Offset to substract from itau_sechiba
+    INTEGER(i_std)        :: itau_xios            !! Current time step for XIOS
+
+    !_ ================================================================================================================================
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+#ifdef XIOS
+       ! Calculate the offset
+       IF (first) THEN
+          offset=itau_sechiba-1
+          first=.FALSE.
+       END IF
+
+       ! Substract the offset to the current time step in sechiba
+       itau_xios=itau_sechiba-offset
+
+       ! Send the new time step to XIOS
+       IF (printlev>=3) WRITE(numout,*) 'xios_orchidee_update_calendar: itau_sechiba, itau_xios=',itau_sechiba,itau_xios
+       CALL xios_update_calendar(itau_xios)
+#endif
+    END IF
+  END SUBROUTINE xios_orchidee_update_calendar
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_context_finalize
+  !!
+  !>\BRIEF         Finalize orchidee context.
+  !!
+  !! DESCRIPTION  :\n This subroutine finalizes the orchidee context without finalizing XIOS. In coupled mode, the atmospheric
+  !!                  modele must finalize XIOS. This subroutine is called in the end of the execution of ORCHIDEE only in 
+  !!                  coupeld mode.
+  !!                  
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_context_finalize
+
+    !_ ================================================================================================================================
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+       IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_context_finalize'
+#ifdef XIOS
+       CALL xios_context_finalize()
+#endif
+    END IF
+  END SUBROUTINE xios_orchidee_context_finalize
+
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_finalize
+  !!
+  !>\BRIEF         Last call to XIOS for finalization.
+  !!
+  !! DESCRIPTION  :\n Last call to XIOS for finalization of the orchidee context and XIOS.
+  !!                  This subroutine is called only when ORCHIDEE is run in offline mode. In coupled mode it is the atmospheric
+  !!                  model that finalizes XIOS. In that case, the context orchidee must be finalized using the 
+  !!                  subroutine xios_orchidee_context_finalize
+  !!                  
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_finalize
+
+    !_ ================================================================================================================================
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+       IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_finalize'
+#ifdef XIOS
+       CALL xios_context_finalize()
+       CALL xios_finalize()
+#endif
+    END IF
+  END SUBROUTINE xios_orchidee_finalize
+
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_send_field_r1d
+  !!
+  !>\BRIEF          Subroutine for sending 1D (array) fields to XIOS.
+  !!
+  !! DESCRIPTION  :\n Send one field to XIOS. This is the interface for 1D fields (array).
+  !!                  NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_send_field_r1d(field_id,field)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    CHARACTER(len=*), INTENT(IN)          :: field_id
+    REAL(r_std), DIMENSION(:), INTENT(IN) :: field
+
+    !! 0.2 Local variables
+    REAL(r_std), DIMENSION(nbp_mpi) :: field_mpi
+
+    !_ ================================================================================================================================
+    IF (xios_orchidee_ok) THEN
+       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r1d, field_id=',field_id
+
+       ! Gather all omp domains on the mpi domains
+       CALL gather_omp(field, field_mpi)
+
+       ! All master threads send the field to XIOS
+       IF (is_omp_root) THEN
+#ifdef XIOS
+          CALL xios_send_field(field_id,field_mpi)
+#endif
+       END IF
+    END IF
+  END SUBROUTINE xios_orchidee_send_field_r1d
+
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_send_field_r2d
+  !!
+  !>\BRIEF          Subroutine for sending 2D fields to XIOS.
+  !!
+  !! DESCRIPTION  :\n Send one field to XIOS. This is the interface for 2D fields.
+  !!                  NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_send_field_r2d(field_id,field)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    CHARACTER(len=*), INTENT(IN)            :: field_id
+    REAL(r_std), DIMENSION(:,:), INTENT(IN) :: field
+
+    !! 0.2 Local variables
+    REAL(r_std), DIMENSION(nbp_mpi,size(field,2)) :: field_mpi
+
+    !_ ================================================================================================================================
+    IF (xios_orchidee_ok) THEN
+       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r2d, field_id=',field_id
+
+       ! Gather all omp domains on the mpi domains
+       CALL gather_omp(field, field_mpi)
+
+       ! All master threads send the field to XIOS
+       IF (is_omp_root) THEN
+#ifdef XIOS
+          CALL xios_send_field(field_id,field_mpi)
+#endif
+       END IF
+    END IF
+  END SUBROUTINE xios_orchidee_send_field_r2d
+
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_send_field_r3d
+  !!
+  !>\BRIEF          Subroutine for sending 3D fields to XIOS. 
+  !!
+  !! DESCRIPTION  :\n Send one field to XIOS. This is the interface for 3D fields.
+  !!                  NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_send_field_r3d(field_id,field)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    CHARACTER(len=*), INTENT(IN)              :: field_id
+    REAL(r_std), DIMENSION(:,:,:), INTENT(IN) :: field
+
+    !! 0.2 Local variables
+    REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3)) :: field_mpi
+
+    !_ ================================================================================================================================
+    IF (xios_orchidee_ok) THEN
+       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r3d, field_id=',field_id
+
+       ! Gather all omp domains on the mpi domains
+       CALL gather_omp(field, field_mpi)
+
+       ! All master threads send the field to XIOS
+       IF (is_omp_root) THEN
+#ifdef XIOS
+          CALL xios_send_field(field_id,field_mpi)
+#endif
+       END IF
+    END IF
+  END SUBROUTINE xios_orchidee_send_field_r3d
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_send_field_r4d
+  !!
+  !>\BRIEF          Subroutine for sending 4D fields to XIOS. 
+  !!
+  !! DESCRIPTION  :\n Send one field to XIOS. This is the interface for 4D fields.
+  !!                  NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_send_field_r4d(field_id,field)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    CHARACTER(len=*), INTENT(IN)              :: field_id
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(IN) :: field
+
+    !! 0.2 Local variables
+    INTEGER :: jv
+    REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3),size(field,4)) :: field_mpi
+
+    !_ ================================================================================================================================
+    IF (xios_orchidee_ok) THEN
+       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r4d, field_id=',field_id
+
+       ! Gather all omp domains on the mpi domains
+       CALL gather_omp(field, field_mpi)
+
+       ! All master threads send the field to XIOS
+       IF (is_omp_root) THEN
+#ifdef XIOS
+          CALL xios_send_field(field_id,field_mpi)
+#endif
+       END IF
+    END IF
+  END SUBROUTINE xios_orchidee_send_field_r4d
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_send_field_r5d
+  !!
+  !>\BRIEF          Subroutine for sending 5D fields to XIOS. 
+  !!
+  !! DESCRIPTION  :\n Send one field to XIOS. This is the interface for 5D fields.
+  !!                  NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_send_field_r5d(field_id,field)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    CHARACTER(len=*), INTENT(IN)              :: field_id
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(IN) :: field
+
+    !! 0.2 Local variables
+    INTEGER :: jv
+    REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3),size(field,4),size(field,5)) :: field_mpi
+
+    !_ ================================================================================================================================
+    IF (xios_orchidee_ok) THEN
+       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r5d, field_id=',field_id
+
+       ! Gather all omp domains on the mpi domains
+       CALL gather_omp(field, field_mpi)
+
+       ! All master threads send the field to XIOS
+       IF (is_omp_root) THEN
+#ifdef XIOS
+          CALL xios_send_field(field_id,field_mpi)
+#endif
+       END IF
+    END IF
+  END SUBROUTINE xios_orchidee_send_field_r5d
+ 
+END MODULE xios_orchidee
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/AA_make
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/AA_make	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/AA_make	(revision 6412)
@@ -0,0 +1,97 @@
+#-
+#- $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 = vertical_soil.f90 \
+        vertical_soil_var.f90 \
+      	constantes.f90 \
+	constantes_var.f90   \
+	constantes_soil.f90   \
+	constantes_soil_var.f90   \
+	function_library.f90 \
+	constantes_mtc.f90   \
+	control.f90        \
+	pft_parameters.f90 \
+	pft_parameters_var.f90 
+#
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libioipsl
+	$(M_K) libparallel
+	$(M_K) m_all
+	@echo parameter is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+
+libioipsl:
+	(cd ../../IOIPSL/src; $(M_K) -f Makefile)
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o): %.f90
+	$(F_C) $(F_O) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+
+config:
+	$(BINDIR)/Fparser -name PARAMETERS  $(MODS1)
+	echo 'Configuration of PARAMETERS done'
+ 
+clean:
+	$(RM) $(MODEL_LIB)
+$(MODEL_LIB)(vertical_soil_var.o): \
+  $(MODEL_LIB)(vertical_soil.o) 			
+$(MODEL_LIB)(constantes_soil_var.o): \
+  $(MODEL_LIB)(vertical_soil_var.o)  
+$(MODEL_LIB)(pft_parameters.o): \
+  $(MODEL_LIB)(pft_parameters_var.o) \
+  $(MODEL_LIB)(constantes_mtc.o)
+$(MODEL_LIB)(constantes_soil.o): \
+  $(MODEL_LIB)(constantes_soil_var.o) \
+  $(MODEL_LIB)(constantes.o)
+$(MODEL_LIB)(control.o): \
+  $(MODEL_LIB)(constantes_soil.o) \
+  $(MODEL_LIB)(constantes_var.o)  \
+  $(MODEL_LIB)(pft_parameters.o)
+$(MODEL_LIB)(function_library.o): \
+  $(MODEL_LIB)(pft_parameters.o)
+
+$(MODEL_LIB)(constantes.o): \
+  $(MODEL_LIB)(constantes_var.o) \
+  $(MODEL_LIB)(constantes_soil_var.o) \
+  $(PARALLEL_LIB) \
+  $(IOIPSL_LIB)
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/AA_make.ldef
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/AA_make.ldef	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/AA_make.ldef	(revision 6412)
@@ -0,0 +1,19 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a PARAMETER
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/libparameters.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxparameters.a
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes.f90	(revision 6412)
@@ -0,0 +1,3287 @@
+! =================================================================================================================================
+! MODULE       : constantes
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        "constantes" module contains subroutines to initialize most of the exernalized parameters. This module
+!!              also make a use to the module constantes_var where the parameters are declared.
+!!
+!!\n DESCRIPTION: This module contains subroutines to initialize most of the exernalized parameters. This module
+!!                also make a use to the module constantes_var where the parameters are declared.\n
+!!                This module can be used to acces the subroutines and the constantes. The constantes declarations
+!!                can also be used seperatly with "USE constantes_var".
+!!
+!! RECENT CHANGE(S): Didier Solyga : This module contains now all the externalized parameters of ORCHIDEE 
+!!                   listed by modules which are not pft-dependent  
+!!                   Josefine Ghattas 2013 : The declaration part has been extracted and moved to module constates_var
+!!
+!! REFERENCE(S)	: 
+!! - Louis, Jean-Francois (1979), A parametric model of vertical eddy fluxes in the atmosphere. 
+!! Boundary Layer Meteorology, 187-202.
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes
+
+  USE constantes_var
+  USE defprec
+  USE ioipsl_para, ONLY : getin_p, ipslerr
+  USE mod_orchidee_para, ONLY : numout
+
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : activate_sub_models
+!!
+!>\BRIEF         This subroutine reads the flags in the configuration file to
+!! activate some sub-models like routing, irrigation, fire, herbivory, ...  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE activate_sub_models()
+
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+!_ ================================================================================================================================
+
+     !Config Key   = SLA_DYN
+     !Config Desc  = Account for a dynamic SLA
+     !Config Def   = n
+     !Config if    = OK_STOMATE
+     !Config Help  = If this flag is set to true (y) then the SLA
+     !Config         is computed dynamically, varying with leaf biomass
+     !Config Units = [FLAG]
+     CALL getin_p('SLA_DYN',sla_dyn)    
+
+     !Config Key   = HERBIVORES
+     !Config Desc  = herbivores allowed?
+     !Config If    = OK_STOMATE 
+     !Config Def   = n
+     !Config Help  = With this variable, you can determine
+     !Config         if herbivores are activated
+     !Config Units = [FLAG]
+     CALL getin_p('HERBIVORES', ok_herbivores)
+     !
+     !Config Key   = TREAT_EXPANSION
+     !Config Desc  = treat expansion of PFTs across a grid cell?
+     !Config If    = OK_STOMATE 
+     !Config Def   = n
+     !Config Help  = With this variable, you can determine
+     !Config         whether we treat expansion of PFTs across a
+     !Config         grid cell.
+     !Config Units = [FLAG]
+     CALL getin_p('TREAT_EXPANSION', treat_expansion)
+
+     !Config Key   = LPJ_GAP_CONST_MORT
+     !Config Desc  = Constant mortality
+     !Config If    = OK_STOMATE AND NOT OK_DGVM
+     !Config Def   = y/n depending on OK_DGVM
+     !Config Help  = set to TRUE if constant mortality is to be activated
+     !Config         
+     !Config Units = [FLAG]
+
+     ! Set Default value different if DGVM is activated.
+     IF ( ok_dgvm ) THEN
+        lpj_gap_const_mort=.FALSE.
+     ELSE
+        lpj_gap_const_mort=.TRUE.
+     END IF
+     CALL getin_p('LPJ_GAP_CONST_MORT', lpj_gap_const_mort)
+
+     IF (ok_dgvm .AND. lpj_gap_const_mort) THEN
+        CALL ipslerr(1,"activate_sub_models",&
+             "Both OK_DGVM and LPJ_GAP_CONST_MORT are activated.",&
+             "This combination is possible but unusual",&
+             "The simulation will continue with these flags activated." )
+     END IF
+
+     !Config Key   = HARVEST_AGRI
+     !Config Desc  = Harvest model for agricultural PFTs.
+     !Config If    = OK_STOMATE 
+     !Config Def   = y
+     !Config Help  = Compute harvest above ground biomass for agriculture.
+     !Config         Change daily turnover.
+     !Config Units = [FLAG]
+     CALL getin_p('HARVEST_AGRI', harvest_agri)
+     !
+     !Config Key   = FIRE_DISABLE
+     !Config Desc  = no fire allowed
+     !Config If    = OK_STOMATE 
+     !Config Def   = n
+     !Config Help  = With this variable, you can allow or not
+     !Config         the estimation of CO2 lost by fire
+     !Config Units = [FLAG]
+     CALL getin_p('FIRE_DISABLE', disable_fire)
+     !
+     !Config Key   = SPINUP_ANALYTIC
+     !Config Desc  = Activation of the analytic resolution of the spinup.
+     !Config If    = OK_STOMATE
+     !Config Def   = n
+     !Config Help  = Activate this option if you want to solve the spinup 
+     !               by the Gauss-Jordan method.
+     !Config Units = BOOLEAN    
+     CALL getin_p('SPINUP_ANALYTIC',spinup_analytic)
+     !
+     !
+     ! HACKS
+     !
+     !Config Key   = HACK_ENERBIL_HYDROL
+     !Config Desc  = Flag to skip a particular block of code in enerbil.f90 
+     !               which results in incorrect results for large scale simulations.
+     !Config If    = OK_STOMATE
+     !Config Def   = n
+     !Config Help  =
+     !Config Units = BOOLEAN
+     CALL getin_p('HACK_ENERBIL_HYDROL',hack_enerbil_hydrol)
+     !
+     !Config Key   = HACK_CIRC_CLASS
+     !Config Desc  = There is a bug somewhere which allows the circumference classes to
+     !               deviate from monotonically increasing order, which can cause a problem.
+     !               Setting this to TRUE disables the check for this condition and 
+     !               impliments a small patch for the one problem which has manifested.
+     !               This needs to be found.
+     !Config If    = OK_STOMATE, functional allocation 
+     !Config Def   = FALSE 
+     !Config Help  = 
+     !Config Units = [-]
+     CALL getin_p('HACK_CIRC_CLASS',hack_circ_class)  
+     !
+     !Config Key   = HACK_LCC
+     !Config Desc  = Ignore a few STOP statements related to land cover change.
+     !Config If    = LAND_USE
+     !Config Def   = n 
+     !Config Help  = If this is set to TRUE, a few error messages which would 
+     !               ordinarly produce program exits now produce warnings and 
+     !               the code continues. This is only to be used in some very 
+     !               specific circumstances (for example, between an analyical and 
+     !               transient spinup where land cover maps have changed slightly).
+     !               If you didn't add this option yourself, you probably shouldn't 
+     !               be using it.
+     CALL getin_p('HACK_LCC',hack_lcc)
+     !
+
+     ! Check consistency (see later)
+     !
+!!$        IF(.NOT.(ok_routing) .AND. (doirrigation .OR. dofloodplains)) THEN
+!!$           CALL ipslerr(2,'activate_sub_models', &
+!!$               &     'Problem :you tried to activate the irrigation and floodplains without activating the routing',&
+!!$               &     'Are you sure ?', &
+!!$               &     '(check your parameters).')
+!!$        ENDIF
+       
+!!$        IF(.NOT.(ok_stomate) .AND. (ok_herbivores .OR. treat_expansion .OR. lpj_gap_const_mort &
+!!$            & .OR. harvest_agri .OR. disable_fire)) THEN
+!!$          CALL ipslerr(2,'activate_sub_models', &
+!!$               &     'Problem : try to activate the following options : herbivory, treat_expansion, fire,',&
+!!$               &     'harvest_agri and constant mortality without stomate activated.',&
+!!$               &     '(check your parameters).')
+!!$        ENDIF
+
+   END SUBROUTINE activate_sub_models
+
+!! ================================================================================================================================
+!! SUBROUTINE   : veget_config
+!!
+!>\BRIEF         This subroutine reads the flags controlling the configuration for
+!! the vegetation : impveg, veget_mpa, lai_map, etc...       
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE veget_config
+
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+!_ ================================================================================================================================
+
+     !Config Key   = NCIRC
+     !Config Desc  = Number of basal area classes in allocation scheme
+     !               circ classes could be considered as cohorts within a stand 
+     !Config If    = OK_SECHIBA or OK_STOMATE 
+     !Config Def   = 3 
+     !Config Help  = 
+     !Config Units = [-]
+     CALL getin_p('NCIRC', ncirc)
+
+     !Config Key   = AGRICULTURE
+     !Config Desc  = agriculture allowed?
+     !Config If    = OK_SECHIBA or OK_STOMATE
+     !Config Def   = y
+     !Config Help  = With this variable, you can determine
+     !Config         whether agriculture is allowed
+     !Config Units = [FLAG]
+     CALL getin_p('AGRICULTURE', agriculture)
+     !
+     !Config Key   = IMPOSE_VEG
+     !Config Desc  = Should the vegetation be prescribed ?
+     !Config If    = OK_SECHIBA or OK_STOMATE
+     !Config Def   = n
+     !Config Help  = This flag allows the user to impose a vegetation distribution
+     !Config         and its characteristics. It is espacially interesting for 0D
+     !Config         simulations. On the globe it does not make too much sense as
+     !Config         it imposes the same vegetation everywhere
+     !Config Units = [FLAG]
+     CALL getin_p('IMPOSE_VEG', impveg)
+
+     !Config Key   = IMPOSE_SOILT
+     !Config Desc  = Should the soil type be prescribed ?
+     !Config Def   = n
+     !Config If    = IMPOSE_VEG
+     !Config Help  = This flag allows the user to impose a soil type distribution.
+     !Config         It is espacially interesting for 0D
+     !Config         simulations. On the globe it does not make too much sense as
+     !Config         it imposes the same soil everywhere
+     !Config Units = [FLAG]
+     CALL getin_p('IMPOSE_SOILT', impsoilt)     
+
+    !Config Key   = IMPOSE_NINPUT_DEP
+    !Config Desc  = Should the N inputs be prescribed ?
+    !Config Def   = n
+    !Config If    = NOT IMPOSE_CN
+    !Config Help  = This flag allows the user to impose N inputs 
+    !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 N inputs everywhere
+    !Config Units = [FLAG]
+    CALL getin_p('IMPOSE_NINPUT_DEP', impose_ninput_dep)
+    !Config Key   = IMPOSE_NINPUT_FERT                                                     
+    !Config Desc  = Should the N inputs be prescribed ?                               
+    !Config Def   = n                                                                 
+    !Config If    = -                                                                 
+    !Config Help  = This flag allows the user to impose N inputs                      
+    !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 N inputs everywhere                           
+    !Config Units = [FLAG]                                                            
+    CALL getin_p('IMPOSE_NINPUT_FERT', impose_ninput_fert)
+
+    !Config Key   = IMPOSE_NINPUT_MANURE                                                     
+    !Config Desc  = Should the N inputs be prescribed ?                               
+    !Config Def   = n                                                                 
+    !Config If    = -                                                                 
+    !Config Help  = This flag allows the user to impose N inputs                      
+    !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 N inputs everywhere                           
+    !Config Units = [FLAG]                                                            
+    CALL getin_p('IMPOSE_NINPUT_MANURE', impose_ninput_manure)
+
+    !Config Key   = IMPOSE_NINPUT_BNF                                                     
+    !Config Desc  = Should the N inputs be prescribed ?                               
+    !Config Def   = n                                                                 
+    !Config If    = -                                                                 
+    !Config Help  = This flag allows the user to impose N inputs                      
+    !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 N inputs everywhere                           
+    !Config Units = [FLAG]                                                            
+    CALL getin_p('IMPOSE_NINPUT_BNF', impose_ninput_bnf)
+
+    ! 
+    !asla IF(impose_cn) impose_ninput=.TRUE.
+
+     !Config Key   = LAI_MAP
+     !Config Desc  = Read the LAI map
+     !Config If    = OK_SECHIBA or OK_STOMATE
+     !Config Def   = n
+     !Config Help  = It is possible to read a 12 month LAI map which will
+     !Config         then be interpolated to daily values as needed.
+     !Config Units = [FLAG]
+     CALL getin_p('LAI_MAP',read_lai)
+
+     !Config Key   = VEGET_REINIT
+     !Config Desc  = booleen to indicate that a new LAND USE file will be used.
+     !Config If    = 
+     !Config Def   = y
+     !Config Help  = The parameter is used to bypass veget_year count 
+     !Config         and reinitialize it with VEGET_YEAR parameter.
+     !Config         Then it is possible to change LAND USE file.
+     !Config Units = [FLAG] 
+     CALL getin_p('VEGET_REINIT', veget_reinit)
+     
+     !Config Key   = VEGET_YEAR
+     !Config Desc  = Year of the vegetation map to be read
+     !Config If    = 
+     !Config Def   = 1
+     !Config Help  = First year for land use vegetation (2D map by pft).
+     !Config         If VEGET_YEAR is set to 0, this means there is no time axis.
+     !Config Units = [FLAG] 
+     CALL getin_p('VEGET_YEAR', veget_year_orig)
+  
+     !Config Key   = NINPUT_REINIT
+     !Config Desc  = booleen to indicate that a new N INPUT file will be used.
+     !Config If    = -
+     !Config Def   = y
+     !Config Help  = The parameter is used to bypass ninput_year count 
+     !Config         and reinitialize it with NINPUT_YEAR parameter.
+     !Config         Then it is possible to change N INPUT file.
+     !Config Units = [FLAG] 
+     CALL getin_p('NINPUT_REINIT', ninput_reinit)
+     
+     !Config Key   = NINPUT_YEAR
+     !Config Desc  = Year of the N input map to be read
+     !Config If    = -
+     !Config Def   = 1
+     !Config Help  = First year for N inputs vegetation
+     !Config         If NINPUT_YEAR is set to 0, this means there is no time axis.
+     !Config Units = [FLAG] 
+     CALL getin_p('NINPUT_YEAR', ninput_year_orig)
+
+     !Config Key   = NINPUT_SUFFIX_YEAR
+     !Config Desc  = Do the input dataset have a 'year' suffix
+     !Config If    = -
+     !Config Def   = false
+     !Config Help  = First year for N inputs vegetation
+     !Config         If NINPUT_YEAR is set to true, one adds a suffix for 
+     !               the 'year' in the Ninput datasets
+     !Config Units = [FLAG] 
+     CALL getin_p('NINPUT_SUFFIX_YEAR', ninput_suffix_year)
+        
+   END SUBROUTINE veget_config
+
+!! ================================================================================================================================
+!! SUBROUTINE   : veget_config
+!!
+!>\BRIEF         This subroutine reads in the configuration file the imposed values of the parameters for all SECHIBA modules.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE config_sechiba_parameters
+
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+     !! 0.4 Local variables
+     
+     INTEGER       ::  ilevel                 !! index
+
+!_ ================================================================================================================================
+     
+     ! Global : parameters used by many modules
+     CALL getin_p('TESTPFT',testpft)
+
+     !
+     !Config Key   = MAXMASS_SNOW
+     !Config Desc  = The maximum mass of a snow
+     !Config If    = OK_SECHIBA
+     !Config Def   = 3000.
+     !Config Help  = 
+     !Config Units = [kg/m^2]  
+     CALL getin_p('MAXMASS_SNOW',maxmass_snow)
+     !
+     !Config Key   = SNOWCRI
+     !Config Desc  = Sets the amount above which only sublimation occures 
+     !Config If    = OK_SECHIBA
+     !Config Def   = 1.5
+     !Config Help  = 
+     !Config Units = [kg/m^2]  
+     CALL getin_p('SNOWCRI',snowcri)
+     !
+     !! Initialization of sneige
+     sneige = snowcri/mille
+     !
+     !Config Key   = MIN_WIND
+     !Config Desc  = Minimum wind speed
+     !Config If    = OK_SECHIBA
+     !Config Def   = 0.1
+     !Config Help  = 
+     !Config Units = [m/s]
+     CALL getin_p('MIN_WIND',min_wind)
+     !
+     !Config Key   = MAX_SNOW_AGE
+     !Config Desc  = Maximum period of snow aging 
+     !Config If    = OK_SECHIBA
+     !Config Def   = 50.
+     !Config Help  = 
+     !Config Units = [days?]
+     CALL getin_p('MAX_SNOW_AGE',max_snow_age)
+     !
+     !Config Key   = SNOW_TRANS
+     !Config Desc  = Transformation time constant for snow
+     !Config If    = OK_SECHIBA
+     !Config Def   = 0.2
+     !Config Help  = optimized on 04/07/2016
+     !Config Units = [m]   
+     CALL getin_p('SNOW_TRANS',snow_trans)
+
+     !-
+     ! condveg
+     !-
+     !Config Key   = HEIGHT_DISPLACEMENT
+     !Config Desc  = Magic number which relates the height to the displacement height.
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 0.75
+     !Config Help  = 
+     !Config Units = [m]  
+     CALL getin_p('HEIGHT_DISPLACEMENT',height_displacement)
+     !
+     !Config Key   = Z0_BARE
+     !Config Desc  = bare soil roughness length
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 0.01 
+     !Config Help  = 
+     !Config Units = [m]   
+     CALL getin_p('Z0_BARE',z0_bare)
+     !
+     !Config Key   = Z0_ICE
+     !Config Desc  = ice roughness length
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 0.001
+     !Config Help  = 
+     !Config Units = [m]   
+     CALL getin_p('Z0_ICE',z0_ice)
+     !
+     !Config Key   = TCST_SNOWA
+     !Config Desc  = Time constant of the albedo decay of snow
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 10.0 
+     !Config Help  = optimized on 04/07/2016
+     !Config Units = [days]
+     CALL getin_p('TCST_SNOWA',tcst_snowa)
+     !
+     !Config Key   = SNOWCRI_ALB
+     !Config Desc  = Critical value for computation of snow albedo
+     !Config If    = OK_SECHIBA
+     !Config Def   = 10. 
+     !Config Help  = 
+     !Config Units = [cm]  
+     CALL getin_p('SNOWCRI_ALB',snowcri_alb)
+     !
+     !
+     !Config Key   = VIS_DRY
+     !Config Desc  = The correspondance table for the soil color numbers and their albedo 
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.27
+     !Config Help  = 
+     !Config Units = [-]  
+     CALL getin_p('VIS_DRY',vis_dry)
+     !
+     !Config Key   = NIR_DRY
+     !Config Desc  = The correspondance table for the soil color numbers and their albedo 
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 0.48, 0.44, 0.40, 0.36, 0.32, 0.28, 0.24, 0.20, 0.55
+     !Config Help  = 
+     !Config Units = [-]   
+     CALL getin_p('NIR_DRY',nir_dry)
+     !
+     !Config Key   = VIS_WET 
+     !Config Desc  = The correspondance table for the soil color numbers and their albedo
+     !Config If    = OK_SECHIBA  
+     !Config Def   = 0.12, 0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05, 0.15
+     !Config Help  = 
+     !Config Units = [-]   
+     CALL getin_p('VIS_WET',vis_wet)
+     !
+     !Config Key   = NIR_WET
+     !Config Desc  = The correspondance table for the soil color numbers and their albedo 
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.31
+     !Config Help  = 
+     !Config Units = [-]    
+     CALL getin_p('NIR_WET',nir_wet)
+     !
+     !Config Key   = ALBSOIL_VIS
+     !Config Desc  = 
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 0.18, 0.16, 0.16, 0.15, 0.12, 0.105, 0.09, 0.075, 0.25
+     !Config Help  = 
+     !Config Units = [-]  
+     CALL getin_p('ALBSOIL_VIS',albsoil_vis)
+     !
+     !Config Key   = ALBSOIL_NIR 
+     !Config Desc  = 
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 0.36, 0.34, 0.34, 0.33, 0.30, 0.25, 0.20, 0.15, 0.45
+     !Config Help  = 
+     !Config Units = [-]  
+     CALL getin_p('ALBSOIL_NIR',albsoil_nir)
+     !-
+     !
+     !Config Key   = ALB_DEADLEAF 
+     !Config Desc  = albedo of dead leaves, VIS+NIR 
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 0.12, 0.35
+     !Config Help  = 
+     !Config Units = [-]     
+     CALL getin_p('ALB_DEADLEAF',alb_deadleaf)
+     !
+     !Config Key   = ALB_ICE
+     !Config Desc  = albedo of ice, VIS+NIR
+     !Config If    = OK_SECHIBA
+     !Config Def   = 0.60, 0.20
+     !Config Help  = 
+     !Config Units = [-]  
+     CALL getin_p('ALB_ICE',alb_ice)
+     !
+     ! Get the fixed snow albedo if needed
+     !
+     !Config Key   = CONDVEG_SNOWA
+     !Config Desc  = The snow albedo used by SECHIBA
+     !Config Def   = 1.E+20
+     !Config if    = OK_SECHIBA
+     !Config Help  = This option allows the user to impose a snow albedo.
+     !Config         Default behaviour is to use the model of snow albedo
+     !Config         developed by Chalita (1993).
+     !Config Units = [-]
+     CALL getin_p('CONDVEG_SNOWA',fixed_snow_albedo)
+     !
+     !Config Key   = ALB_BARE_MODEL
+     !Config Desc  = Switch bare soil albedo dependent (if TRUE) on soil wetness
+     !Config Def   = n
+     !Config if    = OK_SECHIBA
+     !Config Help  = If TRUE, the model for bare soil albedo is the old formulation.
+     !Config         Then it depend on the soil dry or wetness. If FALSE, it is the 
+     !Config         new computation that is taken, it is the mean of soil albedo.
+     !Config Units = [FLAG]
+     CALL getin_p('ALB_BARE_MODEL',alb_bare_model)
+     !
+     !Config Key   = ALB_BG_MODIS
+     !Config Desc  = Read bare soil albedo from file with background MODIS data
+     !Config Def   = n
+     !Config if    = OK_SECHIBA
+     !Config Help  = If TRUE, the bare soil albedo is read from file
+     !Config         based on background MODIS data.  
+     !Config         If FALSE, computaion depends on ALB_BARE_MODEL
+     !Config Units = [FLAG]
+     CALL getin_p('ALB_BG_MODIS',alb_bg_modis)
+     !
+     !Config Key   = IMPOSE_AZE
+     !Config Desc  = Should the surface parameters be prescribed
+     !Config Def   = n
+     !Config if    = OK_SECHIBA
+     !Config Help  = This flag allows the user to impose the surface parameters
+     !Config         (Albedo Roughness and Emissivity). It is espacially interesting for 0D
+     !Config         simulations. On the globe it does not make too much sense as
+     !Config         it imposes the same vegetation everywhere
+     !Config Units = [FLAG]
+     CALL getin_p('IMPOSE_AZE',impaze)
+     !
+     IF(impaze) THEN
+        !
+        !Config Key   = CONDVEG_Z0
+        !Config Desc  = Surface roughness
+        !Config Def   = 0.15
+        !Config If    = IMPOSE_AZE
+        !Config Help  = Surface rougness to be used on the point if a 0-dim version
+        !Config         of SECHIBA is used. Look at the description of the forcing  
+        !Config         data for the correct value.
+        !Config Units = [m]
+        CALL getin_p('CONDVEG_Z0', z0_scal)  
+        !
+        !Config Key   = ROUGHHEIGHT
+        !Config Desc  = Height to be added to the height of the first level
+        !Config Def   = 0.0
+        !Config If    = IMPOSE_AZE
+        !Config Help  = ORCHIDEE assumes that the atmospheric level height is counted
+        !Config         from the zero wind level. Thus to take into account the roughness
+        !Config         of tall vegetation we need to correct this by a certain fraction
+        !Config         of the vegetation height. This is called the roughness height in
+        !Config         ORCHIDEE talk.
+        !Config Units = [m] 
+        CALL getin_p('ROUGHHEIGHT', roughheight_scal)
+        ! 
+        !Config Key   = CONDVEG_ALBVIS
+        !Config Desc  = SW visible albedo for the surface
+        !Config Def   = 0.25
+        !Config If    = IMPOSE_AZE
+        !Config Help  = Surface albedo in visible wavelengths to be used 
+        !Config         on the point if a 0-dim version of SECHIBA is used. 
+        !Config         Look at the description of the forcing data for 
+        !Config         the correct value.
+        !Config Units = [-]
+        CALL getin_p('CONDVEG_ALBVIS', albedo_scal(ivis))
+        !
+        !Config Key   = CONDVEG_ALBNIR
+        !Config Desc  = SW near infrared albedo for the surface
+        !Config Def   = 0.25
+        !Config If    = IMPOSE_AZE
+        !Config Help  = Surface albedo in near infrared wavelengths to be used 
+        !Config         on the point if a 0-dim version of SECHIBA is used. 
+        !Config         Look at the description of the forcing data for 
+        !Config         the correct value.
+        !Config Units = [-]  
+        CALL getin_p('CONDVEG_ALBNIR', albedo_scal(inir))
+        !
+        !Config Key   = CONDVEG_EMIS
+        !Config Desc  = Emissivity of the surface for LW radiation
+        !Config Def   = 1.0
+        !Config If    = IMPOSE_AZE
+        !Config Help  = The surface emissivity used for compution the 
+        !Config         LE emission of the surface in a 0-dim version. 
+        !Config         Values range between 
+        !Config         0.97 and 1.. The GCM uses 0.98.
+        !Config Units = [-] 
+        CALL getin_p('CONDVEG_EMIS', emis_scal)
+     ENDIF
+
+     CALL getin_p('NEW_WATSTRESS',new_watstress) 
+     IF(new_watstress) THEN 
+        CALL getin_p('ALPHA_WATSTRESS',alpha_watstress) 
+     ENDIF 
+
+     !Config Key   = ROUGH_DYN
+     !Config Desc  = Account for a dynamic roughness height
+     !Config Def   = y
+     !Config if    = OK_SECHIBA
+     !Config Help  = If this flag is set to true (y) then the roughness
+     !Config         height is computed dynamically, varying with LAI
+     !Config Units = [FLAG]
+     CALL getin_p('ROUGH_DYN',rough_dyn)
+
+     IF ( rough_dyn ) THEN
+        !
+        !Config Key   = C1
+        !Config Desc  = Constant used in the formulation of the ratio of 
+        !Config         the ratio of friction velocity to the wind speed
+        !Config         at the canopy top 
+        !Config         See Ershadi et al. (2015) for more info
+        !Config Def   = 0.32
+        !Config If    = ROUGH_DYN
+        !Config Help  = 
+        !Config Units = [-] 
+        CALL getin_p('C1', c1)
+        !
+        !Config Key   = C2
+        !Config Desc  = Constant used in the formulation of the ratio of 
+        !Config         the ratio of friction velocity to the wind speed
+        !Config         at the canopy top 
+        !Config         See Ershadi et al. (2015) for more info
+        !Config Def   = 0.264
+        !Config If    = ROUGH_DYN
+        !Config Help  = 
+        !Config Units = [-] 
+        CALL getin_p('C2', c2)
+        !
+        !Config Key   = C3
+        !Config Desc  = Constant used in the formulation of the ratio of 
+        !Config         the ratio of friction velocity to the wind speed
+        !Config         at the canopy top 
+        !Config         See Ershadi et al. (2015) for more info
+        !Config Def   = 15.1
+        !Config If    = ROUGH_DYN
+        !Config Help  = 
+        !Config Units = [-] 
+        CALL getin_p('C3', c3)
+        !
+        !Config Key   = Cdrag_foliage
+        !Config Desc  = Drag coefficient of the foliage
+        !Config         See Ershadi et al. (2015) and Su et al. (2001) 
+        !Config         for more info
+        !Config Def   = 0.2
+        !Config If    = ROUGH_DYN
+        !Config Help  = 
+        !Config Units = [-] 
+        CALL getin_p('CDRAG_FOLIAGE', Cdrag_foliage)
+        !
+        !Config Key   = Ct
+        !Config Desc  = Heat transfer coefficient of the leaf
+        !Config         See Ershadi et al. (2015) and Su et al. (2001) 
+        !Config         for more info
+        !Config Def   = 0.01
+        !Config If    = ROUGH_DYN
+        !Config Help  = 
+        !Config Units = [-] 
+        CALL getin_p('CT', Ct)
+        !
+        !Config Key   = Prandtl
+        !Config Desc  = Prandtl number used in the calculation of Ct*
+        !Config         See Su et al. (2001) for more info
+        !Config Def   = 0.71
+        !Config If    = ROUGH_DYN
+        !Config Help  = 
+        !Config Units = [-] 
+        CALL getin_p('PRANDTL', Prandtl)
+     ENDIF
+
+     !- 
+     ! Variables related to the explicitsnow module
+     !-
+     !Config Key = xansmax 
+     !Config Desc = maximum snow albedo
+     !Config If = OK_SECHIBA
+     !Config Def = 0.85
+     !Config Help = 
+     !Config Units = [-] 
+     CALL getin_p('XANSMAX',xansmax)
+     !
+     !Config Key = xansmin 
+     !Config Desc = minimum snow albedo
+     !Config If = OK_SECHIBA
+     !Config Def = 0.50
+     !Config Help = 
+     !Config Units = [-] 
+     CALL getin_p('XANSMIN',xansmin)
+     !
+     !Config Key = xans_todry 
+     !Config Desc = albedo decay rate for the dry snow 
+     !Config If = OK_SECHIBA
+     !Config Def = 0.008
+     !Config Help = 
+     !Config Units = [S-1] 
+     CALL getin_p('XANSDRY',xans_todry)
+     !
+     !Config Key = xans_t 
+     !Config Desc = albedo decay rate for the wet snow 
+     !Config If = OK_SECHIBA
+     !Config Def = 0.24
+     !Config Help = 
+     !Config Units = [S-1] 
+     CALL getin_p('XANS_T',xans_t)
+
+     !Config Key = xrhosmax 
+     !Config Desc = maximum snow density 
+     !Config If = OK_SECHIBA
+     !Config Def = 750
+     !Config Help = 
+     !Config Units = [-] 
+     CALL getin_p('XRHOSMAX',xrhosmax)
+     !
+     !Config Key = xwsnowholdmax1
+     !Config Desc = snow holding capacity 1
+     !Config If = OK_SECHIBA
+     !Config Def = 0.03
+     !Config Help = 
+     !Config Units = [-] 
+     CALL getin_p('XWSNOWHOLDMAX1',xwsnowholdmax1)
+     !
+     !Config Key = xwsnowholdmax2
+     !Config Desc = snow holding capacity 2
+     !Config If = OK_SECHIBA
+     !Config Def = 0.10
+     !Config Help = 
+     !Config Units = [-] 
+     CALL getin_p('XWSNOWHOLDMAX2',xwsnowholdmax2)
+     !
+     !Config Key = xsnowrhohold 
+     !Config Desc = snow density 
+     !Config If = OK_SECHIBA
+     !Config Def = 200.0
+     !Config Help = 
+     !Config Units = [kg/m3] 
+     CALL getin_p('XSNOWRHOHOLD',xsnowrhohold)
+     ! 
+     !Config Key = ZSNOWTHRMCOND1
+     !Config Desc = Thermal conductivity Coef 1
+     !Config If = OK_SECHIBA
+     !Config Def = 0.02 
+     !Config Help = 
+     !Config Units = [W/m/K] 
+     CALL getin_p('ZSNOWTHRMCOND1',ZSNOWTHRMCOND1)
+     !
+     !Config Key = ZSNOWTHRMCOND2
+     !Config Desc = Thermal conductivity Coef 2
+     !Config If = OK_SECHIBA
+     !Config Def = 2.5E-6
+     !Config Help = 
+     !Config Units = [W m5/(kg2 K)] 
+     CALL getin_p('ZSNOWTHRMCOND2',ZSNOWTHRMCOND2)
+     !
+     !Config Key = ZSNOWTHRMCOND_AVAP
+     !Config Desc = Thermal conductivity Coef 1 water vapor
+     !Config If = OK_SECHIBA
+     !Config Def = -0.06023
+     !Config Help = 
+     !Config Units = [W/m/K] 
+     CALL getin_p('ZSNOWTHRMCOND_AVAP',ZSNOWTHRMCOND_AVAP)
+     !
+     !Config Key = ZSNOWTHRMCOND_BVAP
+     !Config Desc = Thermal conductivity Coef 2 water vapor
+     !Config If = OK_SECHIBA
+     !Config Def = -2.5425
+     !Config Help = 
+     !Config Units = [W/m] 
+     CALL getin_p('ZSNOWTHRMCOND_BVAP',ZSNOWTHRMCOND_BVAP)
+     !
+     !Config Key = ZSNOWTHRMCOND_CVAP
+     !Config Desc = Thermal conductivity Coef 3 water vapor
+     !Config If = OK_SECHIBA
+     !Config Def = -289.99
+     !Config Help = 
+     !Config Units = [K] 
+     CALL getin_p('ZSNOWTHRMCOND_CVAP',ZSNOWTHRMCOND_CVAP)
+
+     !Snow compaction factors
+     !Config Key = ZSNOWCMPCT_RHOD
+     !Config Desc = Snow compaction coefficent
+     !Config If = OK_SECHIBA
+     !Config Def = 150.0
+     !Config Help = 
+     !Config Units = [kg/m3]
+     CALL getin_p('ZSNOWCMPCT_RHOD',ZSNOWCMPCT_RHOD)
+
+     !Config Key = ZSNOWCMPCT_ACM
+     !Config Desc = Coefficent for the thermal conductivity
+     !Config If = OK_SECHIBA
+     !Config Def = 2.8e-6
+     !Config Help = 
+     !Config Units = [1/s]
+     CALL getin_p('ZSNOWCMPCT_ACM',ZSNOWCMPCT_ACM)
+
+     !Config Key = ZSNOWCMPCT_BCM
+     !Config Desc = Coefficent for the thermal conductivity
+     !Config If = OK_SECHIBA
+     !Config Def = 0.04
+     !Config Help = 
+     !Config Units = [1/K]
+     CALL getin_p('ZSNOWCMPCT_BCM',ZSNOWCMPCT_BCM)
+
+     !Config Key = ZSNOWCMPCT_CCM
+     !Config Desc = Coefficent for the thermal conductivity
+     !Config If = OK_SECHIBA
+     !Config Def = 460.
+     !Config Help = 
+     !Config Units = [m3/kg] 
+     CALL getin_p('ZSNOWCMPCT_CCM',ZSNOWCMPCT_CCM)
+
+     !Config Key = ZSNOWCMPCT_V0
+     !Config Desc = Vapor coefficent for the thermal conductivity
+     !Config If = OK_SECHIBA
+     !Config Def = 3.7e7
+     !Config Help = 
+     !Config Units = [Pa/s]
+     CALL getin_p('ZSNOWCMPCT_V0',ZSNOWCMPCT_V0)
+
+     !Config Key = ZSNOWCMPCT_VT
+     !Config Desc = Vapor coefficent for the thermal conductivity
+     !Config If = OK_SECHIBA
+     !Config Def = 0.081
+     !Config Help = 
+     !Config Units = [1/K]
+     CALL getin_p('ZSNOWCMPCT_VT',ZSNOWCMPCT_VT)
+
+     !Config Key = ZSNOWCMPCT_VR
+     !Config Desc = Vapor coefficent for the thermal conductivity
+     !Config If = OK_SECHIBA
+     !Config Def = 0.018
+     !Config Help = 
+     !Config Units = [m3/kg]
+     CALL getin_p('ZSNOWCMPCT_VR',ZSNOWCMPCT_VR)
+
+
+     !Surface resistance
+     !
+     !Config Key = CB
+     !Config Desc = Constant of the Louis scheme 
+     !Config If = OK_SECHIBA
+     !Config Def = 5.0
+     !Config Help = 
+     !Config Units = [-] 
+     CALL getin_p('CB',cb)
+     !
+     !Config Key = CC
+     !Config Desc = Constant of the Louis scheme 
+     !Config If = OK_SECHIBA
+     !Config Def = 5.0
+     !Config Help = 
+     !Config Units = [-] 
+     CALL getin_p('CC',cc)
+     !
+     !Config Key = CD
+     !Config Desc = Constant of the Louis scheme 
+     !Config If = OK_SECHIBA
+     !Config Def = 5.0
+     !Config Help = 
+     !Config Units = [-] 
+     CALL getin_p('CD',cd)
+     !
+     !Config Key = RAYT_CSTE
+     !Config Desc = Constant in the computation of surface resistance  
+     !Config If = OK_SECHIBA
+     !Config Def = 125
+     !Config Help = 
+     !Config Units = [W.m^{-2}] 
+     CALL getin_p('RAYT_CSTE',rayt_cste)
+     !
+     !Config Key = DEFC_PLUS
+     !Config Desc = Constant in the computation of surface resistance  
+     !Config If = OK_SECHIBA
+     !Config Def = 23.E-3
+     !Config Help = 
+     !Config Units = [K.W^{-1}] 
+     CALL getin_p('DEFC_PLUS',defc_plus)
+     !
+     !Config Key = DEFC_MULT
+     !Config Desc = Constant in the computation of surface resistance  
+     !Config If = OK_SECHIBA
+     !Config Def = 1.5
+     !Config Help = 
+     !Config Units = [K.W^{-1}] 
+     CALL getin_p('DEFC_MULT',defc_mult)
+
+     !+++CHECK+++
+     ! We can add some consistency checks and possibly
+     ! simplify the definition of the canopy layering 
+     ! (reduce the number of variables)
+     !
+     ! Configuration : The number of canopy levels to use in 
+     !                 the albedo and energy budget
+     !
+     !Config Key   = NLEVELS_PHOTO
+     !Config Desc  = number of photosyntheis canopy levels 
+     !Config If    = OK_SECHIBA
+     !Config Def   = 4
+     !Config Help  = The number of canopy levels to be used in 
+     !Config Help  = per enegy budget canopy level photosynthesis 
+     !Config Units = [-]
+     nlevels_photo=10
+     CALL getin_p("NLEVELS_PHOTO",nlevels_photo)
+     WRITE(numout,'(I4,A)') nlevels_photo,' levels are used for each canopy ' &
+          // 'level to calculate photosynthesis.'
+
+     ! This is a variable that we'll pass around for convenience, in particular
+     ! when going into a subroutine.
+     nlevels_tot = nlevels * nlevels_photo
+     DO ilevel=1,nlevels
+        WRITE(numout,*) 'Albedo canopy level ',ilevel,&
+             ' has a lower boundary at ',z_level(ilevel),' meters.'
+     ENDDO
+
+     ! Sets the levels for the energy calculations based on the
+     ! multi_layer_control flag. 
+     IF( multi_layer_control .EQ. 1 ) THEN        ! single layer
+
+        jnlvls = 1
+        jnlvls_under = 0
+        jnlvls_canopy = 1
+        jnlvls_over = 0    
+
+     ELSEIF( multi_layer_control .EQ. 2 ) THEN   ! multi-layer
+
+        jnlvls = 29
+        jnlvls_under = 10
+        jnlvls_canopy = 10
+        jnlvls_over = 9
+
+     ELSEIF( multi_layer_control .EQ. 3 ) THEN  ! run.def specified
+        !Config Key   = JNLVLS
+        !Config Desc  = number of photosyntheis canopy levels 
+        !Config If    = OK_SECHIBA
+        !Config Def   = 29
+        !Config Help  = The total number of layers in the 
+        !Config       = multi-layer energy budget calculations
+        !Config Units = [-]
+        jnlvls = 29
+        CALL getin_p("JNLVLS",jnlvls)
+
+        !Config Key   = JNLVLS_UNDER
+        !Config Desc  = number of energy layers under the canopy 
+        !Config If    = OK_SECHIBA
+        !Config Def   = 10
+        !Config Help  = Number of energy layers under the canopy
+        !Config       = used for multi-layer energy budget calculations
+        !Config Units = [-]
+        jnlvls_under = 10
+        CALL getin_p("JNLVLS_UNDER",jnlvls_under)
+
+        !Config Key   = JNLVLS_CANOPY
+        !Config Desc  = number of energy layers in the canopy 
+        !Config If    = OK_SECHIBA
+        !Config Def   = 10
+        !Config Help  = Number of energy, albedo and photosynthesis 
+        !Config       = layers in the canopy used for multi-layer 
+        !Confog       = energy budget calculations
+        !Config Units = [-]
+        jnlvls_canopy = 10
+        CALL getin_p("JNLVLS_CANOPY",jnlvls_canopy)
+
+        !Config Key   = JNLVLS_OVER
+        !Config Desc  = number of energy layers over the canopy 
+        !Config If    = OK_SECHIBA
+        !Config Def   = 10
+        !Config Help  = Number of energy layers over the canopy
+        !Config       = used for multi-layer energy budget calculations
+        !Config Units = [-]
+        jnlvls_over = 9
+        CALL getin_p("JNLVLS_OVER",jnlvls_over)
+     ENDIF ! (multi_layer_control)
+
+     WRITE(numout,*)'The set JNLVLS levels', jnlvls, jnlvls_under,jnlvls_canopy,jnlvls_over 
+
+     !Config Key   = NLEV_TOP
+     !Config Desc  = Maximum number of canopy levels that are 
+     !               used to construct the "top" layer of the 
+     !               canopy. The top layer is used in the 
+     !               calculation transpiration. 
+     !               Should not exceed nlevels_photo
+     !Config If    = OK_SECHIBA
+     !Config Def   = 10
+     !Config Help  = 
+     !Config Units = [-]
+     nlev_top = 10
+     CALL getin_p('NLEV_TOP',nlev_top)        
+     IF(nlev_top .GT. nlevels_photo) THEN
+        nlev_top = nlevels_photo
+        WRITE(numout,*) 'The numbers of levels in the "top" was '
+        WRITE(numout,*) '  larger than the total number of levels'
+        WRITE(numout,*) '  AUTO CORRECT: nlev_top now = ',nlev_top
+     ENDIF
+
+     !+++++++++++
+
+     !
+     !-
+     ! diffuco 
+     !-
+     !
+     !Config Key   = NLAI
+     !Config Desc  = Number of LAI levels
+     !Config If    = OK_SECHIBA
+     !Config Def   = 20
+     !Config Help  = 
+     !Config Units = [-]  
+     CALL getin_p('NLAI',nlai)
+     !
+!!$     !Config Key   = LAIMAX
+!!$     !Config Desc  = Maximum LAI
+!!$     !Config If    = OK_SECHIBA
+!!$     !Config Def   = 
+!!$     !Config Help  = 
+!!$     !Config Units = [m^2/m^2]   
+!!$     CALL getin_p('LAIMAX',laimax)
+     !
+     !Config Key   = DEW_VEG_POLY_COEFF
+     !Config Desc  = coefficients of the polynome of degree 5 for the dew
+     !Config If    = OK_SECHIBA
+     !Config Def   = 0.887773, 0.205673, 0.110112, 0.014843, 0.000824, 0.000017 
+     !Config Help  = 
+     !Config Units = [-]   
+     CALL getin_p('DEW_VEG_POLY_COEFF',dew_veg_poly_coeff)
+     !
+     !Config Key   = DOWNREGULATION_CO2
+     !Config Desc  = Activation of CO2 downregulation
+     !Config If    = OK_SECHIBA
+     !Config Def   = n 
+     !Config Help  = 
+     !Config Units = [FLAG]   
+     CALL getin_p('DOWNREGULATION_CO2',downregulation_co2)
+     !
+     !Config Key   = DOWNREGULATION_CO2_BASELEVEL
+     !Config Desc  = CO2 base level
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 280.
+     !Config Help  = 
+     !Config Units = [ppm]   
+     CALL getin_p('DOWNREGULATION_CO2_BASELEVEL',downregulation_co2_baselevel)
+     !
+     !Config Key   = GB_REF 
+     !Config Desc  = Leaf bulk boundary layer resistance 
+     !Config If    = 
+     !Config Def   = 1./25. 
+     !Config Help  =  
+     !Config Units = [s m-1]    
+     CALL getin_p('GB_REF',gb_ref)
+     !
+     !-
+     ! slowproc
+     !-
+     !
+     !Config Key   = CLAYFRACTION_DEFAULT
+     !Config Desc  = default fraction of clay
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 0.2 
+     !Config Help  = 
+     !Config Units = [-]   
+     CALL getin_p('CLAYFRACTION_DEFAULT',clayfraction_default)
+     !
+     !Config Key   = SANDFRACTION_DEFAULT
+     !Config Desc  = default fraction of clay
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 0.3 
+     !Config Help  = 
+     !Config Units = [-]   
+     CALL getin_p('SANDFRACTION_DEFAULT',sandfraction_default)
+     !
+     !Config Key   = SILTFRACTION_DEFAULT
+     !Config Desc  = default fraction of silt
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 0.5 
+     !Config Help  = 
+     !Config Units = [-]   
+     CALL getin_p('SILTFRACTION_DEFAULT',siltfraction_default)
+     !
+     !Config Key   = BULK_DEFAULT
+     !Config Desc  = default bulk density
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 1000
+     !Config Help  = 
+     !Config Units = [kg/m3]   
+     CALL getin_p('BULK_DEFAULT',bulk_default)
+     !
+     !Config Key   = PH_DEFAULT
+     !Config Desc  = default soil pH
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 5.5
+     !Config Help  = 
+     !Config Units = [-]   
+     CALL getin_p('PH_DEFAULT',ph_default)
+     !
+     !Config Key   = MIN_VEGFRAC 
+     !Config Desc  = Minimal fraction of mesh a vegetation type can occupy 
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 0.001 
+     !Config Help  = 
+     !Config Units = [-]  
+     CALL getin_p('MIN_VEGFRAC',min_vegfrac)
+     !
+     !Config Key   = STEMPDIAG_BID 
+     !Config Desc  = only needed for an initial LAI if there is no restart file
+     !Config If    = OK_SECHIBA 
+     !Config Def   = 280.
+     !Config Help  = 
+     !Config Units = [K]
+     CALL getin_p('STEMPDIAG_BID',stempdiag_bid)
+     !
+     !Config Key   = MIN_N
+     !Config Desc  = Minimum allowable n_mineralisation in som_dynamics
+     !Config If    = OK_SECHIBA
+     !Config Def   = 0.0001
+     !Config Help  =
+     !Config Units = gNH4-N/m^2/day
+     CALL getin_p('MIN_N',min_n)    
+     !
+     !Config Key   = MAX_CN
+     !Config Desc  = Maximum allowable ratio of som_input_total(:,icarbon)
+     !               to som_input_total(:,initrogen).
+     !Config If    = OK_SECHIBA
+     !Config Def   = 250
+     !Config Help  =
+     !Config Units =
+     CALL getin_p('MAX_CN',max_cn) 
+     !
+     !Config Key   = LAIEFF_SOLAR_ANGLE
+     !Config Desc  = The solar zenith angle used in the calculation of the 
+     !               effective LAI.  Pinty recommends a value of 60 degrees.
+     !Config If    = 
+     !Config Def   = 60
+     !Config Help  = 
+     !Config Units = [degrees]
+     laieff_solar_angle=60.0_r_std
+     CALL getin_p('LAIEFF_SOLAR_ANGLE',laieff_solar_angle) 
+     WRITE(numout,*) 'Maximum number of optimization steps'//&
+          'tried for albedo n-layer optimization [degrees]: ',laieff_solar_angle
+     ! convert to radians
+     laieff_solar_angle=laieff_solar_angle/180.0_r_std*pi 
+     !
+     !Config Key   = LAIEFF_ZERO_CUTOFF
+     !Config Desc  = This is an arbitrary cutoff to make sure we don't pass 
+     !               zero values of crown diameter and trunk diameter
+     !               to a subroutine that will choke on them
+     !Config If    = 
+     !Config Def   = 0.0000001
+     !Config Help  = 
+     !Config Units = [-]
+     laieff_zero_cutoff=0.0000001_r_std
+     CALL getin_p('LAIEFF_ZERO_CUTOFF',laieff_zero_cutoff) 
+     WRITE(numout,*) 'A minimum threshold for trunk and crown '//&
+          'diameters for numerical stability: ',laieff_zero_cutoff
+     
+   END SUBROUTINE config_sechiba_parameters
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_co2_parameters 
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters when impose_param=TRUE 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE config_co2_parameters
+     
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+!_ ================================================================================================================================
+     
+     !Config Key   = Oi
+     !Config Desc  = Intercellular oxygen partial pressure
+     !Config If    = 
+     !Config Def   = 210000.
+     !Config Help  = See Legend of Figure 6 of Yin et al. (2009)
+     !Config Units = [ubar]  
+     CALL getin_p('Oi',Oi)
+     !
+     !Config Key   = THRESHOLD_C13_ASSIM
+     !Config Desc  = If assimilation falls below this threshold
+     !               the delta_c13 is set to zero 
+     !Config If    = OK_C13
+     !Config Def   = 0.01 
+     !Config Help  = 
+     !Config Units = [-]  
+     CALL getin_p('THRESHOLD_C13_ASSIM',threshold_c13_assim)
+     !
+     !Config Key   = C13_A
+     !Config Desc  = Coefficient for fractionation occurring 
+     !               due to diffusion in air 
+     !Config If    = OK_C13
+     !Config Def   = 0.01 
+     !Config Help  = 
+     !Config Units = [-]  
+     CALL getin_p('C13_A',c13_a)
+     !
+     !Config Key   = C13_B
+     !Config Desc  = Coefficient for fractionation caused by 
+     !               carboxylation 
+     !Config If    = OK_C13
+     !Config Def   = 0.01 
+     !Config Help  = 
+     !Config Units = [-]  
+     CALL getin_p('C13_B',c13_b)
+     
+   END SUBROUTINE config_co2_parameters
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_stomate_parameters 
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters 
+!! needed when stomate is activated (ie : when OK_STOMATE is set to true).
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE config_stomate_parameters
+     
+    IMPLICIT NONE
+    
+    !! 0. Variables and parameters declaration
+
+!_ ================================================================================================================================
+    
+    ! constraints_parameters
+    !-
+    !
+    !Config Key   = TOO_LONG 
+    !Config Desc  = longest sustainable time without regeneration (vernalization)
+    !Config If    = OK_STOMATE
+    !Config Def   = 5.
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TOO_LONG',too_long)
+
+    !-
+    ! fire parameters
+    !-
+    !
+    !Config Key   = TAU_FIRE 
+    !Config Desc  = Time scale for memory of the fire index (days). Validated for one year in the DGVM. 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 30.
+    !Config Help  = 
+    !Config Units = [days]    
+    CALL getin_p('TAU_FIRE',tau_fire)
+    !
+    !Config Key   = LITTER_CRIT
+    !Config Desc  = Critical litter quantity for fire
+    !Config If    = OK_STOMATE 
+    !Config Def   = 200.
+    !Config Help  = 
+    !Config Units = [gC/m^2]  
+    CALL getin_p('LITTER_CRIT',litter_crit)
+    !
+    !Config Key   = FIRE_RESIST_LIGNIN
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('FIRE_RESIST_LIGNIN',fire_resist_lignin)
+    !
+    !
+    !Config Key   = CO2FRAC
+    !Config Desc  = What fraction of a burned plant compartment goes into the atmosphere
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.95, 0.95, 0., 0.3, 0., 0., 0.95, 0.95
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('CO2FRAC',co2frac)
+    !
+    !Config Key   = BCFRAC_COEFF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.3, 1.3, 88.2 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('BCFRAC_COEFF',bcfrac_coeff)
+    !
+    !Config Key   = FIREFRAC_COEFF 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.45, 0.8, 0.6, 0.13
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('FIREFRAC_COEFF',firefrac_coeff)
+
+    !Config Key   = REF_GREFF
+    !Config Desc  = Asymptotic maximum mortality rate
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.035
+    !Config Help  = Set asymptotic maximum mortality rate from Sitch 2003
+    !Config         (they use 0.01) (year^{-1})
+    !Config Units = [1/year]  
+    CALL getin_p('REF_GREFF',ref_greff)
+
+    !-
+    ! data parameters
+    !-
+    !
+    !
+    !Config Key   = PRECIP_CRIT 
+    !Config Desc  = minimum precip
+    !Config If    = OK_STOMATE 
+    !Config Def   = 100.
+    !Config Help  = 
+    !Config Units = [mm/year]  
+    CALL getin_p('PRECIP_CRIT',precip_crit)
+    !
+    !Config Key   = GDD_CRIT_ESTAB
+    !Config Desc  = minimum gdd for establishment of saplings
+    !Config If    = OK_STOMATE 
+    !Config Def   = 150. 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('GDD_CRIT_ESTAB',gdd_crit_estab)
+     !
+    !Config Key   = FPC_CRIT
+    !Config Desc  = critical fpc, needed for light competition and establishment
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.95
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('FPC_CRIT',fpc_crit)
+    !
+    !Config Key   = ALPHA_GRASS
+    !Config Desc  = sapling characteristics : alpha's
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('ALPHA_GRASS',alpha_grass)
+    !
+    !Config Key   = ALPHA_TREE
+    !Config Desc  = sapling characteristics : alpha's 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('ALPHA_TREE',alpha_tree)
+    !-
+    !
+    !Config Key   = STRUCT_TO_LEAVES
+    !Config Desc  = Fraction of structural carbon in grass and crops as a share of the leaf
+    ! carbon pool. Only used for grasses and crops (thus NOT for trees)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('STRUCT_TO_LEAVES',struct_to_leaves)
+    !-
+    !
+    !Config Key   = LABILE_TO_TOTAL
+    !Config Desc  = Fraction of the labile pool in trees, grasses and crops as a share of the
+    ! total carbon pool (accounting for the N-content of the different tissues).
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.01
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('LABILE_TO_TOTAL',labile_to_total)
+    !
+    !Config Key   = TAU_HUM_MONTH
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20. 
+    !Config Help  = 
+    !Config Units = [days]  
+    CALL getin_p('TAU_HUM_MONTH',tau_hum_month)
+    !
+    !Config Key   = TAU_HUM_WEEK
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 7.
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TAU_HUM_WEEK',tau_hum_week)
+    !
+    !Config Key   = TAU_T2M_MONTH
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20.
+    !Config Help  = 
+    !Config Units = [days]     
+    CALL getin_p('TAU_T2M_MONTH',tau_t2m_month)
+    !
+    !Config Key   = TAU_T2M_WEEK
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 7.
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TAU_T2M_WEEK',tau_t2m_week)
+    !
+    !Config Key   = TAU_TSOIL_MONTH 
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20. 
+    !Config Help  = 
+    !Config Units = [days]     
+    CALL getin_p('TAU_TSOIL_MONTH',tau_tsoil_month)
+    !
+    !Config Key   = TAU_SOILHUM_MONTH
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20. 
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TAU_SOILHUM_MONTH',tau_soilhum_month)
+    !
+    !Config Key   = TAU_GPP_WEEK 
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 7. 
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TAU_GPP_WEEK',tau_gpp_week)
+    !
+    !Config Key   = TAU_GDD
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 40. 
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TAU_GDD',tau_gdd)
+    !
+    !Config Key   = TAU_NGD
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 50.
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TAU_NGD',tau_ngd)
+    !
+    !Config Key   = COEFF_TAU_LONGTERM
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 3. 
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('COEFF_TAU_LONGTERM',coeff_tau_longterm)
+    !-
+    !
+    !Config Key   = BM_SAPL_CARBRES 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 5. 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('BM_SAPL_CARBRES',bm_sapl_carbres)
+    !-
+    !
+    !Config Key   = BM_SAPL_LABILE 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 5. 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('BM_SAPL_LABILE',bm_sapl_labile)
+    !
+    !Config Key   = BM_SAPL_SAPABOVE
+    !Config Desc  = 
+    !Config If    = OK_STOMATE
+    !Config Def   = 0.5 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('BM_SAPL_SAPABOVE',bm_sapl_sapabove)
+    !
+    !Config Key   = BM_SAPL_HEARTABOVE 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 2.
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('BM_SAPL_HEARTABOVE',bm_sapl_heartabove)
+    !
+    !Config Key   = BM_SAPL_HEARTBELOW 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 2. 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('BM_SAPL_HEARTBELOW',bm_sapl_heartbelow)
+    !
+    !Config Key   = INIT_SAPL_MASS_LEAF_NAT
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.1 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('INIT_SAPL_MASS_LEAF_NAT',init_sapl_mass_leaf_nat)
+    !
+    !Config Key   = INIT_SAPL_MASS_LEAF_AGRI
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1. 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('INIT_SAPL_MASS_LEAF_AGRI',init_sapl_mass_leaf_agri)
+    !
+    !Config Key   = INIT_SAPL_MASS_CARBRES
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 5. 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('INIT_SAPL_MASS_CARBRES',init_sapl_mass_carbres)
+    !
+    !Config Key   = INIT_SAPL_MASS_LABILE
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 5. 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('INIT_SAPL_MASS_LABILE',init_sapl_mass_labile)
+    !
+    !Config Key   = INIT_SAPL_MASS_ROOT
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.1 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('INIT_SAPL_MASS_ROOT',init_sapl_mass_root)
+    !
+    !Config Key   = INIT_SAPL_MASS_FRUIT
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.3 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('INIT_SAPL_MASS_FRUIT',init_sapl_mass_fruit)
+    !
+    !Config Key   = CN_SAPL_INIT 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('CN_SAPL_INIT',cn_sapl_init)
+    !
+    !Config Key   = MIGRATE_TREE 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 10000.
+    !Config Help  = 
+    !Config Units = [m/year]   
+    CALL getin_p('MIGRATE_TREE',migrate_tree)
+    !
+    !Config Key   = MIGRATE_GRASS
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 10000.
+    !Config Help  = 
+    !Config Units = [m/year]   
+    CALL getin_p('MIGRATE_GRASS',migrate_grass)
+    !
+    !Config Key   = LAI_INITMIN_TREE
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.3
+    !Config Help  = 
+    !Config Units = [m^2/m^2]  
+    CALL getin_p('LAI_INITMIN_TREE',lai_initmin_tree)
+    !
+    !Config Key   = LAI_INITMIN_GRASS 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.1
+    !Config Help  = 
+    !Config Units = [m^2/m^2]    
+    CALL getin_p('LAI_INITMIN_GRASS',lai_initmin_grass)
+    !
+    !Config Key   = DIA_COEFF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 4., 0.5
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('DIA_COEFF',dia_coeff)
+    !
+    !Config Key   = MAXDIA_COEFF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 100., 0.01 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('MAXDIA_COEFF',maxdia_coeff)
+    !
+    !Config Key   = BM_SAPL_LEAF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 4., 4., 0.8, 5. 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('BM_SAPL_LEAF',bm_sapl_leaf)
+
+    !-
+    ! litter parameters
+    !-
+    !
+    !Config Key   = METABOLIC_REF_FRAC
+    !Config Desc  =
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.85  
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('METABOLIC_REF_FRAC',metabolic_ref_frac)
+    !
+    !Config Key   = Z_DECOMP
+    !Config Desc  = scaling depth for soil activity
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.2
+    !Config Help  = 
+    !Config Units = [m]   
+    CALL getin_p('Z_DECOMP',z_decomp)
+    !
+    !Config Key   = CN
+    !Config Desc  = C/N ratio
+    !Config If    = OK_STOMATE 
+    !Config Def   = 40., 40., 40., 40., 40., 40., 40., 40.
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('CN',CN_fix)
+    !
+    !Config Key   = FRAC_SOIL_STRUCT_SUA
+    !Config Desc  = frac_soil(istructural,isurface,iabove)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.55
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('FRAC_SOIL_STRUCT_SUA',frac_soil_struct_sua)
+    !
+    !Config Key   = FRAC_SOIL_STRUCT_AB 
+    !Config Desc  = frac_soil(istructural,iactive,ibelow)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.45
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('FRAC_SOIL_STRUCT_AB',frac_soil_struct_ab)
+    !
+    !Config Key   = FRAC_SOIL_STRUCT_SA
+    !Config Desc  = frac_soil(istructural,islow,iabove)
+    !Config If    = OK_STOMATE
+    !Config Def   = 0.7  
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('FRAC_SOIL_STRUCT_SA',frac_soil_struct_sa)
+    !
+    !Config Key   = FRAC_SOIL_STRUCT_SB
+    !Config Desc  = frac_soil(istructural,islow,ibelow) 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.7  
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('FRAC_SOIL_STRUCT_SB',frac_soil_struct_sb)
+    !
+    !Config Key   = FRAC_SOIL_METAB_SUA 
+    !Config Desc  = frac_soil(imetabolic,isurface,iabove) 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.4 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('FRAC_SOIL_METAB_SUA',frac_soil_metab_sua)
+    !
+    !Config Key   = FRAC_SOIL_METAB_AB 
+    !Config Desc  = frac_soil(imetabolic,iactive,ibelow)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.45  
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('FRAC_SOIL_METAB_AB',frac_soil_metab_ab)
+    !
+    !
+    !Config Key   = METABOLIC_LN_RATIO
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.018  
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('METABOLIC_LN_RATIO',metabolic_LN_ratio) 
+    !
+    !Config Key   = TURN_METABOLIC
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.066
+    !Config Help  = 
+    !Config Units = [days] 
+    CALL getin_p('TURN_METABOLIC',turn_metabolic)
+    !
+    !Config Key   = TURN_STRUCT 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.245 
+    !Config Help  = 
+    !Config Units = [days]
+    CALL getin_p('TURN_STRUCT',turn_struct)
+    !
+    !Config Key   = TURN_WOODY
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.75
+    !Config Help  = 
+    !Config Units = [days]
+    CALL getin_p('TURN_WOODY',turn_woody)
+    !
+    !Config Key   = SOIL_Q10
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.69 (=ln2)
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('SOIL_Q10',soil_Q10)
+    !
+    !Config Key   = TSOIL_REF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 30. 
+    !Config Help  = 
+    !Config Units = [C]   
+    CALL getin_p('TSOIL_REF',tsoil_ref)
+    !
+    !Config Key   = LITTER_STRUCT_COEF 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 3. 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('LITTER_STRUCT_COEF',litter_struct_coef)
+    !
+    !Config Key   = MOIST_COEFF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.1, 2.4, 0.29
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('MOIST_COEFF',moist_coeff)
+    !
+    !Config Key   = MOISTCONT_MIN
+    !Config Desc  = minimum soil wetness to limit the heterotrophic respiration
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.25
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('MOISTCONT_MIN',moistcont_min)
+    !
+    !Config Key   = FUNGIVORES
+    !Config Desc  = N released for plant uptake due to fungivore consumption
+    !Config If    = OK_STOMATE
+    !Config Def   = 0.3
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('FUNGIVORES',fungivores)
+    !
+    !Config Key   = FRAC_WOODY
+    !Config Desc  = Coefficient for determining the lignin fraction of woody litter
+    !Config If    = OK_STOMATE
+    !Config Def   = 0.65
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('FRAC_WOODY',frac_woody)
+    !      
+ 
+    !-
+    ! lpj parameters
+    !-
+    !
+    !Config Key   = FRAC_TURNOVER_DAILY 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.55
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('FRAC_TURNOVER_DAILY',frac_turnover_daily)   
+
+    !-
+    ! npp parameters
+    !-
+    !
+    !Config Key   = TAX_MAX
+    !Config Desc  = maximum fraction of allocatable biomass used for maintenance respiration
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.8
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('TAX_MAX',tax_max) 
+
+    !-
+    ! phenology parameters
+    !-
+    !
+    !Config Key   = ALWAYS_INIT
+    !Config Desc  = take carbon from atmosphere if carbohydrate reserve too small? 
+    !Config If    = OK_STOMATE 
+    !Config Def   = n 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('ALWAYS_INIT',always_init)
+    !
+    !Config Key   = MIN_GROWTHINIT_TIME 
+    !Config Desc  = minimum time since last beginning of a growing season
+    !Config If    = OK_STOMATE 
+    !Config Def   = 300. 
+    !Config Help  = 
+    !Config Units = [days]  
+    CALL getin_p('MIN_GROWTHINIT_TIME',min_growthinit_time)
+    !
+    !Config Key   = MOIAVAIL_ALWAYS_TREE
+    !Config Desc  = moisture availability above which moisture tendency doesn't matter 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.0 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('MOIAVAIL_ALWAYS_TREE',moiavail_always_tree)
+    !
+    !Config Key   = MOIAVAIL_ALWAYS_GRASS 
+    !Config Desc  = moisture availability above which moisture tendency doesn't matter
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.6 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('MOIAVAIL_ALWAYS_GRASS',moiavail_always_grass)
+    !
+    !Config Key   = T_ALWAYS_ADD
+    !Config Desc  = monthly temp. above which temp. tendency doesn't matter 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 10.
+    !Config Help  = 
+    !Config Units = [C]    
+    CALL getin_p('T_ALWAYS_ADD',t_always_add)
+    !
+    !
+    !Config Key   = GDDNCD_REF 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 603. 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('GDDNCD_REF',gddncd_ref)
+    !
+    !Config Key   = GDDNCD_CURVE
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.0091 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('GDDNCD_CURVE',gddncd_curve)
+    !
+    !Config Key   = GDDNCD_OFFSET
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 64. 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('GDDNCD_OFFSET',gddncd_offset)
+    !-
+    ! prescribe parameters
+    !-
+    !
+    !Config Key   = BM_SAPL_RESCALE 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 40. 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('BM_SAPL_RESCALE',bm_sapl_rescale)
+
+    !-
+    ! respiration parameters
+    !-
+    !
+
+    !
+    !Config Key   = MAINT_RESP_MIN_VMAX
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.3
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('MAINT_RESP_MIN_VMAX',maint_resp_min_vmax)  
+    !
+    !Config Key   = MAINT_RESP_COEFF 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.4 
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('MAINT_RESP_COEFF',maint_resp_coeff)
+
+    !-
+    ! soilcarbon parameters 
+    !-
+    !
+    !Config Key   = ACTIVE_TO_PASS_REF_FRAC
+    !Config Desc  = Fixed fraction from Active to Passive pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.003
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('ACTIVE_TO_PASS_REF_FRAC',active_to_pass_ref_frac)  
+    !
+    !Config Key   = SURF_TO_SLOW_REF_FRAC
+    !Config Desc  = Fixed fraction from Surface to Slow pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.4
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('SURF_TO_SLOW_REF_FRAC',surf_to_slow_ref_frac)  
+    !
+    !Config Key   = ACTIVE_TO_CO2_REF_FRAC
+    !Config Desc  = Fixed fraction from Active pool to CO2 emission
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.85
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('ACTIVE_TO_CO2_REF_FRAC',active_to_co2_ref_frac)  
+    !
+    !Config Key   = SLOW_TO_PASS_REF_FRAC
+    !Config Desc  = Fixed fraction from Slow to Passive pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.003
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('SLOW_TO_PASS_REF_FRAC',slow_to_pass_ref_frac)  
+    !
+    !Config Key   = SLOW_TO_CO2_REF_FRAC
+    !Config Desc  = Fixed fraction from Slow pool to CO2 emission
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.55
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('SLOW_TO_CO2_REF_FRAC',slow_to_co2_ref_frac)  
+    !
+    !Config Key   = PASS_TO_ACTIVE_REF_FRAC
+    !Config Desc  = Fixed fraction from Passive to Active pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.45
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('PASS_TO_ACTIVE_REF_FRAC',pass_to_active_ref_frac)  
+    !
+    !Config Key   = PASS_TO_SLOW_REF_FRAC
+    !Config Desc  = Fixed fraction from Passive to Slow pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('PASS_TO_SLOW_REF_FRAC',pass_to_slow_ref_frac)  
+    !
+    !Config Key   = ACTIVE_TO_PASS_CLAY_FRAC
+    !Config Desc  = Clay-dependant fraction from Active to Passive pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.032
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('ACTIVE_TO_PASS_CLAY_FRAC',active_to_pass_clay_frac)  
+    !
+    !Config Key   = ACTIVE_TO_CO2_CLAY_SILT_FRAC
+    !Config Desc  = Clay-Silt-dependant fraction from Active pool to CO2 emission
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.68
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('ACTIVE_TO_CO2_CLAY_SILT_FRAC',active_to_co2_clay_silt_frac)  
+    !
+    !Config Key   = SLOW_TO_PASS_CLAY_FRAC
+    !Config Desc  = Clay-dependant fraction from Slow to Passive pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = -0.009
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('SLOW_TO_PASS_CLAY_FRAC',slow_to_pass_clay_frac)  
+    !
+    !Config Key   = SOM_TURN_IACTIVE
+    !Config Desc  = turnover in active pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = 7.3
+    !Config Help  =
+    !Config Units =  [year-1] 
+    CALL getin_p('SOM_TURN_IACTIVE',som_turn_iactive)
+    !
+    !Config Key   = SOM_TURN_ISLOW
+    !Config Desc  = turnover in slow pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.2
+    !Config Help  =
+    !Config Units = [year-1]
+    CALL getin_p('SOM_TURN_ISLOW',som_turn_islow)
+    !
+    !Config Key   = SOM_TURN_IPASSIVE
+    !Config Desc  = turnover in passive pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.0045
+    !Config Help  = 
+    !Config Units = [year-1] 
+    CALL getin_p('SOM_TURN_IPASSIVE',som_turn_ipassive)
+    !
+    !Config Key   = SOM_TURN_IACTIVE_CLAY_FRAC
+    !Config Desc  = clay-dependant parameter impacting on turnover rate of active pool - Tm parameter of Parton et al. 1993 (-)
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.75
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('SOM_TURN_IACTIVE_CLAY_FRAC',som_turn_iactive_clay_frac)
+    !
+    !Config Key   = SOM_INIT_ACTIVE
+    !Config Desc  = Initial active SOM carbon 
+    !Config if    = OK_STOMATE
+    !Config Def   = 1000
+    !Config Help  =
+    !Config Units = [g m-2]
+    CALL getin_p('SOM_INIT_ACTIVE',som_init_active)
+    !
+    !Config Key   = SOM_INIT_SLOW
+    !Config Desc  = Initial slow SOM carbon
+    !Config if    = OK_STOMATE
+    !Config Def   = 3000
+    !Config Help  =
+    !Config Units = [g m-2]
+    CALL getin_p('SOM_INIT_SLOW',som_init_slow)
+    !
+    !Config Key   = SOM_INIT_PASSIVE
+    !Config Desc  = Initial passive SOM carbon
+    !Config if    = OK_STOMATE
+    !Config Def   = 3000
+    !Config Help  =
+    !Config Units = [g m-2]
+    CALL getin_p('SOM_INIT_PASSIVE',som_init_passive)
+    !
+    !Config Key   = SOM_INIT_SURFACE
+    !Config Desc  = Initial surface SOM carbon
+    !Config if    = OK_STOMATE
+    !Config Def   = 1000
+    !Config Help  =
+    !Config Units = [g m-2]
+    CALL getin_p('SOM_INIT_SURFACE',som_init_surface)
+    !
+    !Config Key   = CN_TARGET_IACTIVE_REF
+    !Config Desc  = CN target ratio of active pool for soil min N = 0
+    !Config if    = OK_STOMATE 
+    !Config Def   = 15.
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('CN_TARGET_IACTIVE_REF',CN_target_iactive_ref)
+    !
+    !Config Key   = CN_TARGET_ISLOW_REF
+    !Config Desc  = CN target ratio of slow pool for soil min N = 0
+    !Config if    = OK_STOMATE 
+    !Config Def   = 20.
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('CN_TARGET_ISLOW_REF',CN_target_islow_ref)
+    !
+    !Config Key   = CN_TARGET_IPASSIVE_REF
+    !Config Desc  = CN target ratio of passive pool for soil min N = 0
+    !Config if    = OK_STOMATE 
+    !Config Def   = 10.
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('CN_TARGET_IPASSIVE_REF',CN_target_ipassive_ref)
+    !
+    !Config Key   = CN_TARGET_IACTIVE_NMIN
+    !Config Desc  = CN target ratio change per mineral N unit (g m-2) for active pool 
+    !Config if    = OK_STOMATE 
+    !Config Def   = -6.
+    !Config Help  = 
+    !Config Units = [(g m-2)-1] 
+    CALL getin_p('CN_TARGET_IACTIVE_NMIN',CN_target_iactive_Nmin)
+    !
+    !Config Key   = CN_TARGET_ISLOW_NMIN
+    !Config Desc  = CN target ratio change per mineral N unit (g m-2) for slow pool 
+    !Config if    = OK_STOMATE 
+    !Config Def   = -4.
+    !Config Help  = 
+    !Config Units = [(g m-2)-1] 
+    CALL getin_p('CN_TARGET_ISLOW_NMIN',CN_target_islow_Nmin)
+    !
+    !Config Key   = CN_TARGET_IPASSIVE_NMIN
+    !Config Desc  = CN target ratio change per mineral N unit (g m-2) for passive pool 
+    !Config if    = OK_STOMATE 
+    !Config Def   = -1.5
+    !Config Help  = 
+    !Config Units = [(g m-2)-1] 
+    CALL getin_p('CN_TARGET_IPASSIVE_NMIN',CN_target_ipassive_Nmin)
+
+
+    !-
+    ! turnover parameters
+    !-
+    !
+    !Config Key   = NEW_TURNOVER_TIME_REF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20. 
+    !Config Help  = 
+    !Config Units = [days]  
+    CALL getin_p('NEW_TURNOVER_TIME_REF',new_turnover_time_ref)
+    
+    !Config Key   = LEAF_AGE_CRIT_TREF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20. 
+    !Config Help  = 
+    !Config Units = [days]  
+    CALL getin_p('LEAF_AGE_CRIT_TREF',leaf_age_crit_tref)
+    !
+    !Config Key   = LEAF_AGE_CRIT_COEFF 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.5, 0.75, 10. 
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('LEAF_AGE_CRIT_COEFF',leaf_age_crit_coeff)
+
+    !-
+    ! vmax parameters
+    !-
+    !
+    !Config Key   = VMAX_OFFSET 
+    !Config Desc  = offset (minimum relative vcmax)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.3
+    !Config Help  = offset (minimum vcmax/vmax_opt)
+    !Config Units = [-]  
+    CALL getin_p('VMAX_OFFSET',vmax_offset)
+    !
+    !Config Key   = LEAFAGE_FIRSTMAX
+    !Config Desc  = leaf age at which vmax attains vcmax_opt (in fraction of critical leaf age)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.03 
+    !Config Help  = relative leaf age at which vmax attains vcmax_opt
+    !Config Units = [-] 
+    CALL getin_p('LEAFAGE_FIRSTMAX',leafage_firstmax)
+    !
+    !Config Key   = LEAFAGE_LASTMAX 
+    !Config Desc  = leaf age at which vmax falls below vcmax_opt (in fraction of critical leaf age) 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5 
+    !Config Help  = relative leaf age at which vmax falls below vcmax_opt
+    !Config Units = [-]  
+    CALL getin_p('LEAFAGE_LASTMAX',leafage_lastmax)
+    !
+    !Config Key   = LEAFAGE_OLD 
+    !Config Desc  = leaf age at which vmax attains its minimum (in fraction of critical leaf age)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.
+    !Config Help  = relative leaf age at which vmax attains its minimum
+    !Config Units = [-]  
+    CALL getin_p('LEAFAGE_OLD',leafage_old)
+
+
+    !-
+    ! soil nitrogen dynamic parameters
+    !-
+    !Config Key   = H_SAXTON
+    !Config Desc  = Coefficient h for defining maximum porosity
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.332
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('H_SAXTON',h_saxton)
+    !-
+    !Config Key   = H_SAXTON
+    !Config Desc  = Coefficient j for defining maximum porosity
+    !Config If    = OK_STOMATE 
+    !Config Def   = -7.251*1e-4 
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('J_SAXTON',j_saxton)
+    !-
+    !Config Key   = K_SAXTON
+    !Config Desc  = Coefficient k for defining maximum porosity
+    !Config If    = OK_STOMATE 
+    !Config Def   = O.1276
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('K_SAXTON',K_saxton)
+    !-
+    !Config Key   = DIFFUSIONO2_POWER_1
+    !Config Desc  = Power used in the equation defining the diffusion of oxygen in soil
+    !Config If    = OK_STOMATE 
+    !Config Def   = 3.33
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('DIFFUSIONO2_POWER_1',diffusionO2_power_1)
+    !-
+    !Config Key   = DIFFUSIONO2_POWER_2
+    !Config Desc  = Power used in the equation defining the diffusion of oxygen in soil
+    !Config If    = OK_STOMATE 
+    !Config Def   = 2.0
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('DIFFUSIONO2_POWER_2',diffusionO2_power_2)
+    !-
+    !Config Key   = F_NOFROST
+    !Config Desc  = Temperature-related Factor impacting on Oxygen diffusion rate
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.2
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('F_NOFROST',F_nofrost)
+    !-
+    !Config Key   = F_FROST
+    !Config Desc  = Temperature-related Factor impacting on Oxygen diffusion rate
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.8
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('F_FROST',F_frost)
+    !-
+    !Config Key   = A_ANVF
+    !Config Desc  = Coefficient used in the calculation of Volumetric fraction of anaerobic microsites
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.85
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('A_ANVF',a_anvf)
+    !-
+    !Config Key   = B_ANVF
+    !Config Desc  = Coefficient used in the calculation of Volumetric fraction of anaerobic microsites
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('B_ANVF',b_anvf)
+    !-
+    !Config Key   = A_FIXNH4
+    !Config Desc  = Coefficient used in the calculation of the Fraction of adsorbed NH4+
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.41
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('A_FIXNH4',a_FixNH4)
+    !-
+    !Config Key   = B_FIXNH4
+    !Config Desc  = Coefficient used in the calculation of the Fraction of adsorbed NH4+
+    !Config If    = OK_STOMATE 
+    !Config Def   = -0.47
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('B_FIXNH4',b_FixNH4)
+    !-
+    !Config Key   = CLAY_MAX
+    !Config Desc  = Coefficient used in the calculation of the Fraction of adsorbed NH4+
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.63
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('CLAY_MAX',clay_max)
+    !-
+    !Config Key   = FW_0
+    !Config Desc  = Coefficient used in the calculation of the Response of Nitrification to soil moisture
+    !Config If    = OK_STOMATE 
+    !Config Def   = -0.0243
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FW_0',fw_0)
+    !-
+    !Config Key   = FW_1
+    !Config Desc  = Coefficient used in the calculation of the Response of Nitrification to soil moisture
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.9975
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FW_1',fw_1)
+    !-
+    !Config Key   = FW_2
+    !Config Desc  = Coefficient used in the calculation of the Response of Nitrification to soil moisture
+    !Config If    = OK_STOMATE 
+    !Config Def   = -5.5368
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FW_2',fw_2)
+    !-
+    !Config Key   = FW_3
+    !Config Desc  = Coefficient used in the calculation of the Response of Nitrification to soil moisture
+    !Config If    = OK_STOMATE 
+    !Config Def   = 17.651
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FW_3',fw_3)
+    !-
+    !Config Key   = FW_4
+    !Config Desc  = Coefficient used in the calculation of the Response of Nitrification to soil moisture
+    !Config If    = OK_STOMATE 
+    !Config Def   = -12.904
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FW_4',fw_4)
+    !-
+    !Config Key   = FT_NIT_0
+    !Config Desc  = Coefficient used in the calculation of the Response of Nitrification to Temperature
+    !Config If    = OK_STOMATE 
+    !Config Def   = -0.0233
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FT_NIT_0',ft_nit_0)
+    !-
+    !Config Key   = FT_NIT_1
+    !Config Desc  = Coefficient used in the calculation of the Response of Nitrification to Temperature
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.3094
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FT_NIT_1',ft_nit_1)
+    !-
+    !Config Key   = FT_NIT_2
+    !Config Desc  = Coefficient used in the calculation of the Response of Nitrification to Temperature
+    !Config If    = OK_STOMATE 
+    !Config Def   = -0.2234
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FT_NIT_2',ft_nit_2)
+    !-
+    !Config Key   = FT_NIT_3
+    !Config Desc  = Coefficient used in the calculation of the Response of Nitrification to Temperature
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.1566
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FT_NIT_3',ft_nit_3)
+    !-
+    !Config Key   = FT_NIT_4
+    !Config Desc  = Coefficient used in the calculation of the Response of Nitrification to Temperature
+    !Config If    = OK_STOMATE 
+    !Config Def   = -0.0272
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FT_NIT_4',ft_nit_4)
+    !-
+    !Config Key   = FPH_0
+    !Config Desc  = Coefficient used in the calculation of the Response of Nitrification to pH
+    !Config If    = OK_STOMATE 
+    !Config Def   = -1.2314
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FPH_0',fph_0)
+    !-
+    !Config Key   = FPH_1
+    !Config Desc  = Coefficient used in the calculation of the Response of Nitrification to pH
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.7347
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FPH_1',fph_1)
+    !-
+    !Config Key   = FPH_2
+    !Config Desc  = Coefficient used in the calculation of the Response of Nitrification to pH
+    !Config If    = OK_STOMATE 
+    !Config Def   = -0.0604
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FPH_2',fph_2)
+    !-
+    !Config Key   = FTV_0
+    !Config Desc  = Coefficient used in the calculation of the response of NO2 or NO production during nitrificationof to Temperature
+    !Config If    = OK_STOMATE 
+    !Config Def   = 2.72
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FTV_0',ftv_0)
+    !-
+    !Config Key   = FTV_1
+    !Config Desc  = Coefficient used in the calculation of the response of NO2 or NO production during nitrificationof to Temperature
+    !Config If    = OK_STOMATE 
+    !Config Def   = 34.6
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FTV_1',ftv_1)
+    !-
+    !Config Key   = FTV_2
+    !Config Desc  = Coefficient used in the calculation of the response of NO2 or NO production during nitrificationof to Temperature
+    !Config If    = OK_STOMATE 
+    !Config Def   = 9615.
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FTV_2',ftv_2)
+    !-
+    !Config Key   = K_NITRIF
+    !Config Desc  = Nitrification rate at 20 âŠC and field capacity
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.2
+    !Config Help  =
+    !Config Units = [day**-1]  
+    CALL getin_p('K_NITRIF',k_nitrif)
+    !-
+    !Config Key   = N2O_NITRIF_P
+    !Config Desc  = Reference n2o production per N-NO3 produced g N-N2O
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.0006
+    !Config Help  =
+    !Config Units = [gN-N2O (gN-NO3)-1]  
+    CALL getin_p('N2O_NITRIF_P',n2o_nitrif_p)
+    !-
+    !Config Key   = NO_NITRIF_P
+    !Config Desc  = Reference NO production per N-NO3 produced g N-N2O
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.0025
+    !Config Help  =
+    !Config Units = [gN-NO (gN-NO3)-1]  
+    CALL getin_p('NO_NITRIF_P',no_nitrif_p)
+    !-
+    !Config Key   = CHEMO_T0
+    !Config Desc  = Coefficient used in the calculation of the Response of NO production from chemodenitrification to Temperature
+    !Config If    = OK_STOMATE 
+    !Config Def   = -31494
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('CHEMO_T0',chemo_t0)
+    !-
+    !Config Key   = CHEMO_PH0
+    !Config Desc  = Coefficient used in the calculation of the Response of NO production from chemodenitrification to pH
+    !Config If    = OK_STOMATE 
+    !Config Def   = -1.62
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('CHEMO_PH0',chemo_ph0)
+    !-
+    !Config Key   = CHEMO_0
+    !Config Desc  = Coefficient used in the calculation of NO production from chemodenitrification
+    !Config If    = OK_STOMATE 
+    !Config Def   = 30.
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('CHEMO_0',chemo_0)
+    !-
+    !Config Key   = CHEMO_1
+    !Config Desc  = Coefficient used in the calculation of NO production from chemodenitrification
+    !Config If    = OK_STOMATE 
+    !Config Def   = 16565
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('CHEMO_1',chemo_1)
+    !-
+    !Config Key   = FT_DENIT_0
+    !Config Desc  = Coefficient used in the response of relative growth rate of total denitrifiers to Temperature
+    !Config If    = OK_STOMATE 
+    !Config Def   = 2.
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FT_DENIT_0',ft_denit_0)
+    !-
+    !Config Key   = FT_DENIT_1
+    !Config Desc  = Coefficient used in the response of relative growth rate of total denitrifiers to Temperature
+    !Config If    = OK_STOMATE 
+    !Config Def   = 22.5
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FT_DENIT_1',ft_denit_1)
+    !-
+    !Config Key   = FT_DENIT_2
+    !Config Desc  = Coefficient used in the response of relative growth rate of total denitrifiers to Temperature
+    !Config If    = OK_STOMATE 
+    !Config Def   = 10
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FT_DENIT_2',ft_denit_2)
+    !-
+    !Config Key   = FPH_NO3_0
+    !Config Desc  = Coefficient used in the response of relative growth rate of NO3 denitrifiers to pH
+    !Config If    = OK_STOMATE 
+    !Config Def   = 4.25
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FPH_NO3_0',fph_no3_0)
+    !-
+    !Config Key   = FPH_NO3_1
+    !Config Desc  = Coefficient used in the response of relative growth rate of NO3 denitrifiers to pH
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FPH_NO3_1',fph_no3_1)
+    !-
+    !Config Key   = FPH_NO_0
+    !Config Desc  = Coefficient used in the response of relative growth rate of NO denitrifiers to pH
+    !Config If    = OK_STOMATE 
+    !Config Def   = 5.25
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FPH_NO_0',fph_no_0)
+    !-
+    !Config Key   = FPH_NO_1
+    !Config Desc  = Coefficient used in the response of relative growth rate of NO denitrifiers to pH
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FPH_NO_1',fph_no_1)
+    !-
+    !Config Key   = FPH_N2O_0
+    !Config Desc  = Coefficient used in the response of relative growth rate of N2O denitrifiers to pH
+    !Config If    = OK_STOMATE 
+    !Config Def   = 6.25
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FPH_N2O_0',fph_n2o_0)
+    !-
+    !Config Key   = FPH_N2O_1
+    !Config Desc  = Coefficient used in the response of relative growth rate of N2O denitrifiers to pH
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.5
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('FPH_N2O_1',fph_n2o_1)
+    !-
+    !Config Key   = KN
+    !Config Desc  = Half Saturation of N oxydes 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.083
+    !Config Help  =
+    !Config Units = [kgN/m**3]  
+    CALL getin_p('KN',Kn)
+    !-
+    !Config Key   = MU_NO3_MAX
+    !Config Desc  = Maximum Relative growth rate of NO3 denitrifiers
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.67
+    !Config Help  =
+    !Config Units = [hour**-1]  
+    CALL getin_p('MU_NO3_MAX',mu_no3_max)
+    !-
+    !Config Key   = MU_NO_MAX
+    !Config Desc  = Maximum Relative growth rate of NO denitrifiers
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.34
+    !Config Help  =
+    !Config Units = [hour**-1]  
+    CALL getin_p('MU_NO_MAX',mu_no_max)
+    !-
+    !Config Key   = MU_N2O_MAX
+    !Config Desc  = Maximum Relative growth rate of N2O denitrifiers
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.34
+    !Config Help  =
+    !Config Units = [hour**-1]  
+    CALL getin_p('MU_N2O_MAX',mu_n2o_max)
+    !-
+    !Config Key   = Y_NO3
+    !Config Desc  = Maximum growth yield of NO3 denitrifiers on N oxydes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.401
+    !Config Help  =
+    !Config Units = [kgC / kgN]  
+    CALL getin_p('Y_NO3',Y_no3)
+    !-
+    !Config Key   = Y_NO
+    !Config Desc  = Maximum growth yield of NO denitrifiers on N oxydes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.428
+    !Config Help  =
+    !Config Units = [kgC / kgN]  
+    CALL getin_p('Y_NO',Y_no)
+    !-
+    !Config Key   = Y_N2O
+    !Config Desc  = Maximum growth yield of N2O denitrifiers on N oxydes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.151
+    !Config Help  =
+    !Config Units = [kgC / kgN]  
+    CALL getin_p('Y_N2O',Y_n2O)
+    !-
+    !Config Key   = M_NO3
+    !Config Desc  = Maintenance coefficient on NO3
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.09
+    !Config Help  =
+    !Config Units = [kgN / kgC / hour]  
+    CALL getin_p('M_NO3',M_no3)
+    !-
+    !Config Key   = M_NO
+    !Config Desc  = Maintenance coefficient on NO
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.035
+    !Config Help  =
+    !Config Units = [kgN / kgC / hour]  
+    CALL getin_p('M_NO',M_no)
+    !-
+    !Config Key   = M_N2O
+    !Config Desc  = Maintenance coefficient on N2O
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.079
+    !Config Help  =
+    !Config Units = [kgN / kgC / hour]  
+    CALL getin_p('M_N2O',M_n2o)
+    !-
+    !Config Key   = MAINT_C
+    !Config Desc  = Maintenance coefficient of carbon
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.0076
+    !Config Help  =
+    !Config Units = [kgC / kgC / hour]  
+    CALL getin_p('MAINT_C',Maint_c)
+    !-
+    !Config Key   = YC
+    !Config Desc  = Maximum growth yield on soluble carbon
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.503
+    !Config Help  =
+    !Config Units = [kgC / kgC ]  
+    CALL getin_p('YC',Yc)
+    !-
+    !Config Key   = F_CLAY_0
+    !Config Desc  = Coefficient used in the eq. defining the response of N-emission to clay fraction
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.13
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('F_CLAY_0',F_clay_0)
+    !-
+    !Config Key   = F_CLAY_1
+    !Config Desc  = Coefficient used in the eq. defining the response of N-emission to clay fraction
+    !Config If    = OK_STOMATE 
+    !Config Def   = -0.079
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('F_CLAY_1',F_clay_1)
+    !-
+    !Config Key   = RATIO_NH4_FERT
+    !Config Desc  = Proportion of ammonium in the fertilizers (ammo-nitrate) 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.875
+    !Config Help  =
+    !Config Units = [-]  
+    CALL getin_p('RATIO_NH4_FERT',ratio_nh4_fert)
+    !-
+    ! Arrays
+    !-
+    !-
+    !Config Key   = VMAX_UPTAKE
+    !Config Desc  = Vmax of nitrogen uptake by plants for Ammonium (ind.1) and Nitrate (ind.2)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 3. 3.
+    !Config Help  =
+    !Config Units = [umol (g DryWeight_root)-1 h-1)]  
+    CALL getin_p('VMAX_UPTAKE',vmax_uptake)
+    !-
+    !Config Key   = K_N_MIN
+    !Config Desc  = [NH4+] and [NO3-] for which the Nuptake equals vmax/2. 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 30. 30.
+    !Config Help  =
+    !Config Units = [umol per litter]  
+    CALL getin_p('K_N_min',K_N_min)
+    !-
+    !Config Key   = LOW_K_N_MIN
+    !Config Desc  = Rate of N uptake not associated with Michaelis- Menten Kinetics for Ammonium
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.0002 0.0002
+    !Config Help  =
+    !Config Units = [umol**-1]  
+    CALL getin_p('LOW_K_N_min',low_K_N_min)
+
+    !-
+    !Config Key   = DMAX
+    !Config Desc  = ?????????????
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.25
+    !Config Help  =
+    !Config Units = ???
+    CALL getin_p('LEAF_N_DMAX',DMAX)
+
+    !
+    !Config Key   = RESERVE_TIME_TREE 
+    !Config Desc  = maximum time during which reserve is used (trees) 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 30.
+    !Config Help  = 
+    !Config Units = [days]    
+    CALL getin_p('RESERVE_TIME_TREE',reserve_time_tree)
+    !
+    !Config Key   = RESERVE_TIME_GRASS 
+    !Config Desc  = maximum time during which reserve is used (grasses) 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20. 
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('RESERVE_TIME_GRASS',reserve_time_grass)
+
+    !-
+    ! season parameters
+    !-
+    !
+    !Config Key   = GPPFRAC_DORMANCE 
+    !Config Desc  = rapport maximal GPP/GGP_max pour dormance
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.2 
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('GPPFRAC_DORMANCE',gppfrac_dormance)
+    !
+    !Config Key   = TAU_CLIMATOLOGY
+    !Config Desc  = tau for "climatologic variables 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20
+    !Config Help  = 
+    !Config Units = [days]
+    CALL getin_p('TAU_CLIMATOLOGY',tau_climatology)
+    !
+    !Config Key   = HVC1 
+    !Config Desc  = parameters for herbivore activity
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.019
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('HVC1',hvc1)
+    !
+    !Config Key   = HVC2 
+    !Config Desc  = parameters for herbivore activity 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.38
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('HVC2',hvc2)
+    !
+    !Config Key   = LEAF_FRAC_HVC
+    !Config Desc  = parameters for herbivore activity 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.33
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('LEAF_FRAC_HVC',leaf_frac_hvc)
+    !
+    !Config Key   = TLONG_REF_MAX
+    !Config Desc  = maximum reference long term temperature 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 303.1
+    !Config Help  = 
+    !Config Units = [K]  
+    CALL getin_p('TLONG_REF_MAX',tlong_ref_max)
+    !
+    !Config Key   = TLONG_REF_MIN 
+    !Config Desc  = minimum reference long term temperature 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 253.1
+    !Config Help  = 
+    !Config Units = [K]  
+    CALL getin_p('TLONG_REF_MIN',tlong_ref_min)
+    !
+    !Config Key   = NCD_MAX_YEAR
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 3. 
+    !Config Help  = NCD : Number of Chilling Days
+    !Config Units = [days]
+    CALL getin_p('NCD_MAX_YEAR',ncd_max_year)
+    !
+    !Config Key   = GDD_THRESHOLD 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 5. 
+    !Config Help  = GDD : Growing-Degree-Day
+    !Config Units = [days] 
+    CALL getin_p('GDD_THRESHOLD',gdd_threshold)
+    !
+    !Config Key   = GREEN_AGE_EVER 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 2. 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('GREEN_AGE_EVER',green_age_ever)
+    !
+    !Config Key   = GREEN_AGE_DEC
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5 
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('GREEN_AGE_DEC',green_age_dec)
+    !
+    !Config Key   = NGD_MIN_DORMANCE
+    !Config Desc  = Minimum length (days) of the dormance period
+    !               for species with the ngd phenology type
+    !Config If    = OK_STOMATE 
+    !Config Def   = 90.
+    !Config Help  = 
+    !Config Units = [days] 
+    CALL getin_p('NGD_MIN_DORMANCE',ngd_min_dormance)
+ 
+    !-
+    !Config Key   = NAGEC
+    !Config Desc  = Number of age classes in forestry and lcchange
+    !               age classes could be considered age classes across stands in the same pixel 
+    !Config If    = OK_STOMATE, forestry and/or lcchange 
+    !Config Def   = 1 
+    !Config Help  = 
+    !Config Units = [-]
+    nagec = 1
+    CALL getin_p('NAGEC',nagec)  
+    !
+    !Config Key   = SYNC_THRESHOLD
+    !Config Desc  = The threshold value for a warning when we sync biomass
+    !Config If    = OK_STOMATE, functional allocation 
+    !Config Def   = 0.1 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('SYNC_THRESHOLD',sync_threshold)
+    !
+    !Config Key   = TEST_GRID
+    !Config Desc  = grid cell for which extra output is written to the out_execution file
+    !Config If    = OK_STOMATE
+    !Config Def   = 1
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('TEST_GRID',test_grid)   
+    !
+    !Config Key   = TEST_PFT
+    !Config Desc  = pft for which extra output is written to the out_execution file
+    !Config If    = OK_STOMATE
+    !Config Def   = 6
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('TEST_PFT',test_pft)   
+
+!!     CALL getin_p('LD_FAKE_HEIGHT', ld_fake_height)
+!!
+!!     CALL getin_p('LD_ALLOC', ld_alloc)
+    
+    !
+    !Config Key   = MIN_WATER_STRESS
+    !Config Desc  = Minimal value for wstress_fac
+    !Config If    = OK_STOMATE, functional allocation 
+    !Config Def   = 0.1 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('MIN_WATER_STRESS',min_water_stress)
+    !
+    !Config Key   = MAX_DELTA_KF
+    !Config Desc  = Maximum change in KF from one time step to another
+    !Config If    = OK_STOMATE, functional allocation 
+    !Config Def   = 0.1 
+    !Config Help  = 
+    !Config Units = [m]  
+    CALL getin_p('MAX_DELTA_KF',max_delta_KF)
+    !
+    !Config Key   = MAINT_FROM_GPP
+    !Config Desc  = Some carbon needs to remain to support the growth, hence, 
+    !               respiration will be limited. In this case resp_maint 
+    !               (gC m-2 dt-1) should not be more than 80% (::maint_from_gpp) 
+    !               of the GPP (gC m-2 s-1)
+    !Config If    = OK_STOMATE, functional allocation 
+    !Config Def   = 0.8
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('MAINT_FROM_GPP',maint_from_gpp)  
+    !
+    !Config Key   = NDIA_HARVEST
+    !Config Desc  = Number of basal area classes in which the harvest
+    !               is stored. This is useful when harvest is further
+    !               used in a wood-use module
+    !Config If    = OK_STOMATE, functional allocation 
+    !Config Def   = 5 
+    !Config Help  = 
+    !Config Units = [-]
+    ndia_harvest = 5
+    CALL getin_p('NDIA_HARVEST',ndia_harvest)
+    !
+    !Config Key   = MAX_HARVEST_DIA
+    !Config Desc  = The maximum diamter of tree [m] which can be 
+    !               harvested.  Notice that we will create a class 
+    !               that is one size larger than this to make sure
+    !               we keep track of all the wood.
+    !Config If    = OK_STOMATE, functional allocation 
+    !Config Def   = 1.0
+    !Config Help  = 
+    !Config Units = [-]
+    max_harvest_dia = un
+    CALL getin_p('MAX_HARVEST_DIA',max_harvest_dia) 
+
+    !Config Key   = N_PAI
+    !Config Desc  = Number of years used for the calculation of the 
+    !               periodic annual increment
+    !Config If    = OK_STOMATE, functional allocation 
+    !Config Def   = 5 
+    !Config Help  = 
+    !Config Units = [-]
+    n_pai=5
+    CALL getin_p('N_PAI',n_pai)
+    !
+    !Config Key   = NTREES_PROFIT
+    !Config Desc  = 
+    !Config If    = FOREST_MANAGEMENT  
+    !Config Def   = 100 
+    !Config Help  = 
+    !Config Units = (number of trees)
+    ntrees_profit=1
+    CALL getin_p('NTREES_PROFIT',ntrees_profit)
+    !
+    !Config Key   = RDI_LIMIT_UPPER
+    !Config Desc  = Replace yield relationship by this values in 
+    !               case small inconsistencies exist between the 
+    !               fitted self-tinning and fitted yield relationships
+    !Config If    = OK_STOMATE, functional allocation 
+    !Config Def   = 0.9 
+    !Config Help  = 
+    !Config Units = [-]
+    rdi_limit_upper = 0.9
+    CALL getin_p('RDI_LIMIT_UPPER',rdi_limit_upper)
+    !
+    ! If we don't read the new species from a map, we will use veget_max
+    ! instead. So we will replant with the current species. This will
+    ! only happen if species_change_force equals -9999. If 
+    ! species_change_force has a different value in the run.def that
+    ! value will be used. Note that species_change_force is intended for
+    ! testing and debugging.
+    !Config Key   = SPECIES_CHANGE_FORCE
+    !Config Desc  =
+    !Config If    = OK_STOMATE
+    !Config Def   = 1
+    !Config Help  =
+    !Config Units =
+    species_change_force=-9999
+    CALL getin_p('SPECIES_CHANGE_FORCE',species_change_force)
+
+    ! If we don't read the new speciesFM strategies from a map, we 
+    ! will force it with this variable.
+    !Config Key   = FM_CHANGE_FORCE
+    !Config Desc  = Mainly for testing. Follozing a harvest all
+    !               management will be set to unmanaged.
+    !Config If    = OK_STOMATE, LCHANGE_SPECIES
+    !Config Def   = 1
+    !Config Help  =
+    !Config Units =
+    species_change_force = ifm_none
+    CALL getin_p('FM_CHANGE_FORCE',fm_change_force)      
+
+    !-
+    ! windthrow
+    !-
+    !Config Key   = OK_WINDTHROW
+    !Config Desc  = This is a nonlinear tunning factor for daily maximum wind
+    !speed used in windthrow module
+    !
+    !Config If    = OK_WINDTHROW, stomate main program
+    !Config Def   = 1.000
+    !Config Help  =
+    !Config Units = [-]
+    daily_max_tune = 1.000
+    CALL getin_p('DAILY_MAX_TUNE',daily_max_tune)
+
+    ! The code distinguishes between two options to check for mass balance
+    ! problems: (1) MB_ACTION = 1 is recommended when running global
+    ! long-term simulations. Under this option, mass balance closure is
+    ! checked for all biogeochemical processes but only at the highest level
+    ! thus stomate.f90 and stomate_lpj.f90. Although the mass balance checks
+    ! are not very expensive in terms of computer time, skipping the numerous
+    ! lower level checks is expected to save some time. Under this option the
+    ! mass balance error is only written to the history file. No information
+    ! is provided in which subroutine the problem occurred. (2) MB_ACTION = 2
+    ! is recommended when developing and testing the model. Now the mass
+    ! balance is explicitly checked in stomate.f90, stomate_lpj.f90 and all
+    ! its subroutines. Under this option the mass balance error is written to
+    ! the history file and if the mass balance is not closed, the warning
+    ! message will indicate in which subroutine the problem likely
+    ! originated. (MB_ACTION) = 3 is recommended when having a problem with
+    ! mass balance closure. The mass balance is explicitly checked in
+    ! stomate.f90, stomate_lpj.f90 and all its subroutines. If a mass balance
+    ! occurs, the model is stopped.
+    !Config Key   = ERR_ACT
+    !Config Desc  = Action following an error. (1) write to history file, (2)
+    !               warn and write to history file and (3) stop the code.
+    !Config If    = OK_STOMATE
+    !Config Def   = 1
+    !Config Help  = 
+    !Config Units = [-]
+    err_act = 1
+    CALL getin_p('ERR_ACT',err_act)
+
+    SELECT CASE (err_act)
+    CASE(1)
+        WRITE(numout,*) 'Many ipserr messages will be skipped'
+        plev = 0
+    CASE(2)
+        WRITE(numout,*) 'In case of an error the user will be warned'
+        plev = 2
+    CASE(3)
+        WRITE(numout,*) 'In case of an error the model will be stopped'
+        plev = 3
+    CASE DEFAULT
+        CALL ipslerr(3,'Error in constantes.f90',&
+            'Unknown value for ERR_ACT',&
+            'Not clear how to treat errors','')   
+    ENDSELECT
+
+    
+  END SUBROUTINE config_stomate_parameters
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_dgvm_parameters 
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters 
+!! needed when the DGVM model is activated (ie : when ok_dgvm is set to true).
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE config_dgvm_parameters   
+    
+    IMPLICIT NONE
+    
+    !! 0. Variables and parameters declaration
+
+!_ ================================================================================================================================    
+
+    ! establish parameters
+    !-
+    !
+    !Config Key   = ESTAB_MAX_TREE
+    !Config Desc  = Maximum tree establishment rate 
+    !Config If    = OK_DGVM
+    !Config Def   = 0.12 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('ESTAB_MAX_TREE',estab_max_tree)
+    !
+    !Config Key   = ESTAB_MAX_GRASS
+    !Config Desc  = Maximum grass establishment rate
+    !Config If    = OK_DGVM
+    !Config Def   = 0.12 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('ESTAB_MAX_GRASS',estab_max_grass)
+    !
+    !Config Key   = ESTABLISH_SCAL_FACT
+    !Config Desc  = 
+    !Config If    = OK_DGVM 
+    !Config Def   = 5.
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('ESTABLISH_SCAL_FACT',establish_scal_fact)
+    !
+    !Config Key   = MAX_TREE_COVERAGE 
+    !Config Desc  = 
+    !Config If    = OK_DGVM 
+    !Config Def   = 0.98
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('MAX_TREE_COVERAGE',max_tree_coverage)
+    !
+    !Config Key   = IND_0_ESTAB
+    !Config Desc  = 
+    !Config If    = OK_DGVM 
+    !Config Def   = 0.2
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('IND_0_ESTAB',ind_0_estab)
+
+    !-
+    ! light parameters
+    !-
+    !
+    !Config Key   = ANNUAL_INCREASE
+    !Config Desc  = for diagnosis of fpc increase, compare today's fpc to last year's maximum (T) or to fpc of last time step (F)?
+    !Config If    = OK_DGVM
+    !Config Def   = y
+    !Config Help  = 
+    !Config Units = [FLAG]
+    CALL getin_p('ANNUAL_INCREASE',annual_increase)
+    !
+    !Config Key   = MIN_COVER 
+    !Config Desc  = For trees, minimum fraction of crown area occupied 
+    !Config If    = OK_DGVM
+    !Config Def   = 0.05 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('MIN_COVER',min_cover)
+
+    !-
+    ! pftinout parameters
+    !
+    !Config Key   = IND_0 
+    !Config Desc  = initial density of individuals
+    !Config If    = OK_DGVM
+    !Config Def   = 0.02 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('IND_0',ind_0)
+    !
+    !Config Key   = MIN_AVAIL
+    !Config Desc  = minimum availability
+    !Config If    = OK_DGVM
+    !Config Def   = 0.01
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('MIN_AVAIL',min_avail)
+    !
+    !Config Key   = RIP_TIME_MIN
+    !Config Desc  = 
+    !Config If    = OK_DGVM
+    !Config Def   = 1.25 
+    !Config Help  = 
+    !Config Units = [year]  
+    CALL getin_p('RIP_TIME_MIN',RIP_time_min)
+    !
+    !Config Key   = NPP_LONGTERM_INIT
+    !Config Desc  = 
+    !Config If    = OK_DGVM
+    !Config Def   = 10.
+    !Config Help  = 
+    !Config Units = [gC/m^2/year]
+    CALL getin_p('NPP_LONGTERM_INIT',npp_longterm_init)
+    !
+    !Config Key   = EVERYWHERE_INIT
+    !Config Desc  = 
+    !Config If    = OK_DGVM
+    !Config Def   = 0.05 
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('EVERYWHERE_INIT',everywhere_init)
+       
+    
+  END SUBROUTINE config_dgvm_parameters
+
+
+!! ================================================================================================================================
+!! FUNCTION   : get_printlev
+!!
+!>\BRIEF        Read global PRINTLEV parmeter and local PRINTLEV_modname
+!!
+!! DESCRIPTION  : The first time this function is called the parameter PRINTLEV is read from run.def file. 
+!!                It is stored in the variable named printlev which is declared in constantes_var.f90. printlev 
+!!                can be accesed each module in ORCHIDEE which makes use of constantes_var module. 
+!!
+!!                This function also reads the parameter PRINTLEV_modname for run.def file. modname is the 
+!!                intent(in) character string to this function. If the variable is set in run.def file, the corresponding 
+!!                value is returned. Otherwise the value of printlev is returnd as default. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): The local output level for the module set as intent(in) argument.
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION get_printlev ( modname )
+
+    !! 0.1 Input arguments
+    CHARACTER(LEN=*), INTENT(IN) :: modname
+
+    !! 0.2 Returned variable
+    INTEGER       :: get_printlev
+
+    !! 0.3 Local variables
+    LOGICAL, SAVE :: first=.TRUE.
+
+!_ ================================================================================================================================
+
+    !! 1.0  Read the global PRINTLEV from run.def. This is only done at first call to this function. 
+    IF (first) THEN
+       !Config Key   = PRINTLEV
+       !Config Desc  = Print level for text output
+       !Config If    = 
+       !Config Help  = Possible values are:
+       !Config         0    No output, 
+       !Config         1    Minimum writing for long simulations, 
+       !Config         2    More basic information for long simulations, 
+       !Config         3    First debug level, 
+       !Config         4    Higher debug level
+       !Config Def   = 2
+       !Config Units = [0, 1, 2, 3, 4]
+       ! Default value is set in constantes_var
+       CALL getin_p('PRINTLEV',printlev)
+       first=.FALSE.
+
+       !Config Key   = PRINTLEV_modname
+       !Config Desc  = Specific print level of text output for the module "modname". Default as PRINTLEV.
+       !Config Def   = PRINTLEV
+       !Config If    =
+       !Config Help  = Use this option to activate a different level of text output 
+       !Config         for a specific module. This can be activated for several modules 
+       !Config         at the same time. Use for example PRINTLEV_sechiba.
+       !Config Units = [0, 1, 2, 3, 4]
+       ! Set default value as the standard printlev
+       get_printlev=printlev
+       ! Read optional value from run.def file
+       CALL getin_p('PRINTLEV_'//modname, get_printlev)
+ 
+    END IF
+
+    ! Set default value as the standard printlev
+    get_printlev=printlev
+    ! Read optional value from run.def file
+    CALL getin_p('PRINTLEV_'//modname, get_printlev)
+    
+  END FUNCTION get_printlev
+
+END MODULE constantes
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes_mtc.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes_mtc.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes_mtc.f90	(revision 6412)
@@ -0,0 +1,1526 @@
+! =================================================================================================================================
+! MODULE       : constantes_mtc
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         This module contains the standard values of the parameters for the 13 metaclasses of vegetation used by ORCHIDEE.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): 
+!!
+!! REFERENCE(S)	: 
+!! - Kuppel, S. (2012): Doctoral Thesis, Assimilation de mesures de flux turbulents d'eau et de carbone dans un modÃšle de la biosphÃšre 
+!! continentale 
+!! - Kuppel, S., Peylin, P., Chevallier, F., Bacour, C., Maignan, F., and Richardson, A. D. (2012). Constraining a global ecosystem
+!! model with multi-site eddy-covariance data, Biogeosciences, 9, 3757-3776, DOI 10.5194/bg-9-3757-2012.
+!! - Wohlfahrt, G., M. Bahn, E. Haubner, I. Horak, W. Michaeler, K.Rottmar, U. Tappeiner, and A. Cemusca, 1999: Inter-specific 
+!! variation of the biochemical limitation to photosynthesis and related leaf traits of 30 species from mountain grassland 
+!! ecosystems under different land use. Plant Cell Environ., 22, 12811296.
+!! - Malhi, Y., Doughty, C., and Galbraith, D. (2011). The allocation of ecosystem net primary productivity in tropical forests, 
+!! Philosophical Transactions of the Royal Society B-Biological Sciences, 366, 3225-3245, DOI 10.1098/rstb.2011.0062.
+!! - Earles, J. M., Yeh, S., and Skog, K. E. (2012). Timing of carbon emissions from global forest clearance, Nature Climate Change, 2, 
+!! 682-685, Doi 10.1038/Nclimate1535.
+!! - Piao, S. L., Luyssaert, S., Ciais, P., Janssens, I. A., Chen, A. P., Cao, C., Fang, J. Y., Friedlingstein, P., Luo, Y. Q., and 
+!! Wang, S. P. (2010). Forest annual carbon cost: A global-scale analysis of autotrophic respiration, Ecology, 91, 652-661, 
+!! Doi 10.1890/08-2176.1.
+!! - Verbeeck, H., Peylin, P., Bacour, C., Bonal, D., Steppe, K., and Ciais, P. (2011). Seasonal patterns of co2 fluxes in amazon 
+!! forests: Fusion of eddy covariance data and the orchidee model, Journal of Geophysical Research-Biogeosciences, 116, 
+!! Artn G02018, Doi 10.1029/2010jg001544.
+!! - McDowell, N., Barnard, H., Bond, B.J., Hinckley, T., Hubbard, R.M., Ishii, H., KÃ¶stner, B., 
+!! Magnani, F. Marshall, J.D., Meinzer, F.C., Phillips, N., Ryan, M.G., Whitehead D. 2002. The 
+!! relationship between tree height and leaf area: sapwood area ratio. Oecologia, 132:12â20 
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_mtc
+
+  USE defprec
+  USE constantes
+
+  IMPLICIT NONE
+
+  !
+  ! METACLASSES CHARACTERISTICS
+  !
+
+  INTEGER(i_std), PARAMETER :: nvmc = 13                         !! Number of MTCS fixed in the code (unitless)
+
+  CHARACTER(len=34), PARAMETER, DIMENSION(nvmc) :: MTC_name = &  !! description of the MTC (unitless)
+  & (/ 'bare ground                       ', &          !  1
+  &    'tropical  broad-leaved evergreen  ', &          !  2
+  &    'tropical  broad-leaved raingreen  ', &          !  3
+  &    'temperate needleleaf   evergreen  ', &          !  4
+  &    'temperate broad-leaved evergreen  ', &          !  5
+  &    'temperate broad-leaved summergreen', &          !  6
+  &    'boreal    needleleaf   evergreen  ', &          !  7
+  &    'boreal    broad-leaved summergreen', &          !  8
+  &    'boreal    needleleaf   summergreen', &          !  9
+  &    '          C3           grass      ', &          ! 10
+  &    '          C4           grass      ', &          ! 11
+  &    '          C3           agriculture', &          ! 12
+  &    '          C4           agriculture'  /)         ! 13
+
+
+  !
+  ! VEGETATION STRUCTURE
+  !
+  INTEGER(i_std),PARAMETER, DIMENSION(nvmc) :: leaf_tab_mtc  =  &                 !! leaf type (1-4, unitless)
+  & (/  4,   1,   1,   2,   1,   1,   2,   &                                      !! 1=broad leaved tree, 2=needle leaved tree
+  &     1,   2,   3,   3,   3,   3   /)                                           !! 3=grass 4=bare ground
+
+  CHARACTER(len=6), PARAMETER, DIMENSION(nvmc) :: pheno_model_mtc  =  &  !! which phenology model is used? (tabulated) 
+  & (/  'none  ',   'none  ',   'moi   ',   'none  ',   'none  ',  &
+  &     'ncdgdd',   'none  ',   'ncdgdd',   'ngd   ',   'moigdd',  &
+  &     'moigdd',   'moigdd',   'moigdd'  /) 
+
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: is_tropical_mtc  =  &                       !! Is PFT tropical ? (true/false)
+  & (/ .FALSE.,   .TRUE.,    .TRUE.,    .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,  &
+  &    .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE. /)    
+
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: is_temperate_mtc  =  &         !! Is PFT temperate ? (true/false)
+  & (/ .FALSE.,   .FALSE.,   .FALSE.,   .TRUE.,    .TRUE.,    .TRUE.,   .FALSE.,  &
+  &    .FALSE.,   .FALSE.,   .TRUE.,    .FALSE.,   .TRUE.,    .FALSE. /)
+
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: is_boreal_mtc = &              !! Is PFT boreal ? (true/false)
+  & (/ .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .TRUE.,  &
+  &    .TRUE.,    .TRUE.,    .FALSE.,   .FALSE.,   .FALSE.,   .FALSE. /)
+
+  CHARACTER(LEN=5), PARAMETER, DIMENSION(nvmc) :: type_of_lai_mtc  =  &  !! Type of behaviour of the LAI evolution algorithm
+  & (/ 'inter', 'inter', 'inter', 'inter', 'inter',  &                   !! for each vegetation type. (unitless)
+  &    'inter', 'inter', 'inter', 'inter', 'inter',  &                   !! Value of type_of_lai : mean or interp
+  &    'inter', 'inter', 'inter' /)
+
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: natural_mtc =  &                         !! natural?  (true/false)
+  & (/ .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,    .TRUE.,   .TRUE.,  &
+  &    .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,   .FALSE.,   .FALSE.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: veget_ori_fixed_mtc  =  &  !! Value for veget_ori for tests in
+  & (/ 0.2,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                !! 0-dim simulations (0-1, unitless)
+  &    0.0,   0.0,   0.8,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: llaimax_mtc  =  &          !! laimax for maximum
+  & (/ 0.0,   8.0,   8.0,   4.0,   4.5,   4.5,   4.0,  &                !! See also type of lai interpolation
+  &    4.5,   4.0,   2.0,   2.0,   2.0,   2.0  /)                       !! @tex $(m^2.m^{-2})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: llaimin_mtc  = &           !! laimin for minimum lai
+  & (/ 0.0,   8.0,   0.0,   4.0,   4.5,   0.0,   4.0,  &                !! See also type of lai interpolation (m^2.m^{-2})
+  &    0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)                       !! @tex $(m^2.m^{-2})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: height_presc_mtc  =  &     !! prescribed height of vegetation (m)
+  & (/  0.0,   30.0,   30.0,   20.0,   20.0,   20.0,   15.0,  &         !! Value for height_presc : one for each vegetation type
+  &    15.0,   15.0,    0.5,    0.6,    1.0,    1.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: z0_over_height_mtc = &         !! Factor to calculate roughness height from 
+  & (/  0.0, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625,  &         !! vegetation height (unitless)   
+  &  0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ratio_z0m_z0h_mtc = &      !! Ratio between z0m and z0h values (roughness height for momentum and for heat)
+  & (/  1.0,    1.0,    1.0,    1.0,    1.0,    1.0,    1.0,  &         
+  &     1.0,    1.0,    1.0,    1.0,    1.0,    1.0  /)
+
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: rveg_mtc  =  &             !! Potentiometer to set vegetation resistance (unitless)
+  & (/ 1.0,   1.0,   1.0,   1.0,   1.0,   1.0,   1.0,  &                !! Nathalie on March 28th, 2006 - from Fred Hourdin,
+  &    1.0,   1.0,   1.0,   1.0,   1.0,   1.0   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: sla_mtc  =  &                       !! specif leaf area @tex $(m^2.gC^{-1})$ @endtex
+  & (/ 1.5E-2,   1.53E-2,   2.6E-2,   9.26E-3,     2E-2,   2.6E-2,   9.26E-3,  &
+  &    2.6E-2,    1.9E-2,   2.6E-2,    2.6E-2,   2.6E-2,   2.6E-2  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: slainit_mtc  =  &                       !! specif leaf area @tex $(m^2.gC^{-1})$ @endtex
+  & (/ 2.6E-2,    2.6E-2,   4.4E-2,    1.4E-2,   3.0E-2,   3.9E-2,   1.3E-2,  &
+  &    3.7E-2,    2.4E-2,   3.1E-2,    3.1E-2,   3.9E-2,   3.9E-2  /) 
+
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: availability_fact_mtc  =  &     !! calculate mortality in lpj_gap
+  & (/ undef,   0.14,  0.14,   0.10,   0.10,   0.10,   0.05,  &
+  &     0.05,   0.05,  undef,  undef,  undef,  undef  /)
+
+  !
+  ! EVAPOTRANSPIRATION (sechiba)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: rstruct_const_mtc  =  &  !! Structural resistance.
+  & (/ 0.0,   25.0,   25.0,   25.0,   25.0,   25.0,   25.0,  &        !! @tex $(s.m^{-1})$ @endtex
+  &   25.0,   25.0,    2.5,    2.0,    2.0,    2.0   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: kzero_mtc  =  &                  !! A vegetation dependent constant used in the 
+  & (/    0.0,   12.E-5,   12.E-5,   12.E-5,   12.E-5,   25.E-5,   12.E-5,  & !! calculation  of the surface resistance. 
+  &    25.E-5,   25.E-5,   30.E-5,   30.E-5,   30.E-5,   30.E-5  /)           !! @tex $(kg.m^2.s^{-1})$ @endtex
+
+
+  !
+  ! WATER (sechiba)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: wmax_veg_mtc  =  &        !! Volumetric available soil water capacity in each PFT
+  & (/ 150.0,   150.0,   150.0,   150.0,   150.0,   150.0,   150.0,  & !! @tex $(kg.m^{-3} of soil)$ @endtex
+  &    150.0,   150.0,   150.0,   150.0,   150.0,   150.0  /)         
+                                                                      
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: humcste_ref4m  =  &       !! Root profile description for the different 
+  & (/ 5.0,   0.4,   0.4,   1.0,   0.8,   0.8,   1.0,  &               !! vegetations types. @tex $(m^{-1})$ @endtex
+  &    1.0,   0.8,   4.0,   1.0,   4.0,   1.0  /)                      !! These are the factor in the exponential which gets       
+                                                                       !! the root density as a function of depth
+                                                                       !! Values for zmaxh = 4.0  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: humcste_ref2m  =  &       !! Root profile description for the different
+  & (/ 5.0,   0.8,   0.8,   1.0,   0.8,   0.8,   1.0,  &               !! vegetations types.  @tex $(m^{-1})$ @endtex
+  &    1.0,   0.8,   4.0,   4.0,   4.0,   4.0  /)                      !! These are the factor in the exponential which gets       
+                                                                       !! the root density as a function of depth
+                                                                       !! Values for zmaxh = 2.0
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: throughfall_by_mtc  =  &  !! Fraction of rain intercepted by the canopy
+  & (/ 30.0,   30.0,   30.0,   30.0,   30.0,   30.0,   30.0,  &        !! (0-100, unitless)
+  &    30.0,   30.0,   30.0,   30.0,   30.0,   30.0  /)
+
+
+  !
+  ! ALBEDO (sechiba)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: snowa_aged_mtc  =  &      !! Minimum snow albedo value for each vegetation type
+  & (/ 0.35,    0.0,    0.0,   0.14,   0.14,   0.14,   0.14,  &        !! after aging (dirty old snow) (unitless), near infrared albedo
+  &    0.14,   0.14,   0.18,   0.18,   0.18,   0.18  /)                !! Source : Values are from the Thesis of S. Chalita (1992)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: snowa_dec_mtc  =  &       !! Decay rate of snow albedo value for each vegetation type
+  & (/ 0.45,    0.0,    0.0,   0.06,   0.06,   0.11,   0.06,  &        !! as it will be used in condveg_snow (unitless), near infrared albedo
+  &    0.11,   0.11,   0.52,   0.52,   0.52,   0.52  /)                !! Source : Values are from the Thesis of S. Chalita (1992)
+
+  ! albedo values for albedo type 'pinty'
+  ! these next values were determined by fitting to global MODIS data and using the inversion scheme of
+  ! Pinty et al (see Pinty B,Andredakis I, Clerici M, et al. (2011) ! 'Exploiting the MODIS albedos 
+  ! with the Two-stream Inversion Package (JRC-TIP): 1. Effective leaf area index,
+  ! vegetation, and soil properties'. Journal of Geophysical Research.
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leaf_ssa_vis_mtc  =  &           !! leaf single scattering albedo, visible light (unitless)
+  (/ 0.17192, 0.12560, 0.16230, 0.13838, 0.13202, 0.14720,  &
+  0.14680, 0.14415, 0.15485, 0.17544, 0.17384, 0.17302, 0.17116 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leaf_ssa_nir_mtc  =  &           !! leaf single scattering albedo, near infrared (unitless)
+  (/ 0.70253, 0.68189, 0.69684, 0.68778, 0.68356, 0.69533, &
+   0.69520, 0.69195, 0.69180, 0.71236, 0.71904, 0.71220, 0.71190 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leaf_psd_vis_mtc  =  &           !! leaf preferred scattering direction, visible light (unitless)
+  (/ 1.00170, 0.96776, 0.99250, 0.97170, 0.97119, 0.98077, &
+     0.97672, 0.97810, 0.98605, 1.00490, 1.00360, 1.00320, 1.00130 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leaf_psd_nir_mtc  =  &           !! leaf preferred scattering direction, NIR light (unitless)
+  (/ 2.00520, 1.95120, 1.98990, 1.97020, 1.95900, 1.98190, &
+     1.98890, 1.97400, 1.97780, 2.02430, 2.03350, 2.02070, 2.02150 /)
+    
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: bgd_reflectance_vis_mtc  =  &    !! background reflectance, visible light (unitless)
+  (/ 0.13796, 0.08311, 0.08784, 0.04339, 0.07228, 0.06460, &
+     0.03170, 0.06029, 0.06403, 0.12459, 0.14366, 0.11012, 0.12245 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: bgd_reflectance_nir_mtc  =  &    !! background reflectance, NIR light (unitless)
+  (/ 0.26520, 0.14605, 0.14937, 0.06608, 0.12334, 0.10534, &
+     0.04443, 0.09455, 0.09770, 0.23034, 0.29221, 0.20508, 0.23339 /)
+
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leaf_to_shoot_clumping_mtc  =  & !! The clumping factor for leaves to shoots in the 
+  & (/ un,   un,   un,   un,   un,   un,   un,  &                    !! effective LAI calculation...notice this should be
+  &   un,   un,   un,   un,   un,   un /)                            !! equal to unity for grasslands/croplands
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: lai_correction_factor_mtc  =  &  !! see the note about this variable in pft_parameters
+  & (/ un,   un,   un,   un,   un,   un,   un,  &  
+  &   un,   un,   un,   un,   un,   un /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: min_level_sep_mtc  =  & !! The minimum level thickness for photosynthesis [m]
+  & (/ un,   0.1,   0.1,   0.1,   0.1,   0.1,   0.1,  &              !! This number is arbitrary at the moment.  The idea
+  &   0.1,   0.1,   0.1,   0.1,   0.1,   0.1 /)                      !! is to have a small number to make as many levels
+                                                                     !! as possible in the canopies, but not too small which
+                                                                     !! results in too little LAI in all the levels.  If all your
+                                                                     !! levels have less than 0.1 LAI in them, that's probably 
+                                                                     !! too small.
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: lai_top_mtc = &                  !! Diffuco.f90 calculates the stomatal conductance of the
+  (/ un,   0.1,   0.1,   0.1,   0.1,   0.1,   0.1,  &                         !! top layer of the canopy. Because the top layer can contain
+     0.1,   0.1,   0.1,   0.1,   0.1,   0.1 /)                                !! diiferent amounts of LAI depending on the crown diameter
+                                                                              !! we had to define top layer in terms of the LAI it contains.
+                                                                              !! stomatal conductance in the top layer contributes to the 
+                                                                              !! transpiration (m2 m-2). Arbitrary values.
+  !
+
+  !
+  ! SOIL - VEGETATION
+  !
+  INTEGER(i_std), PARAMETER, DIMENSION(nvmc) :: pref_soil_veg_mtc  =  &       !! The soil tile number for each vegetation
+  & (/ 1,   2,   2,   2,   2,   2,   2,  &                                    
+  &    2,   2,   3,   3,   3,   3  /)                                         
+
+  !
+  ! VEGETATION - AGE CLASSES
+  !
+  INTEGER(i_std), PARAMETER, DIMENSION(nvmc) :: agec_group_mtc  =  &       !! The age class group that each PFT belongs to.
+       (/ 1,   2,   3,   4,   5,   6,   7,  &                                    
+       8,   9,   10,   11,   12,   13  /)
+
+  !
+  ! PHOTOSYNTHESIS
+  !
+  !-
+  ! 1 .CO2
+  !-
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: is_c4_mtc  =  &                            !! flag for C4 vegetation types (true/false)
+  & (/ .FALSE.,  .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,  &
+  &    .FALSE.,  .FALSE.,   .FALSE.,   .TRUE.,    .FALSE.,   .TRUE.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: vcmax_fix_mtc  =  &     !! values used for vcmax when STOMATE is not
+  & (/  0.0,   40.0,   50.0,   30.0,   35.0,   40.0,   30.0,  &      !! activated @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+  &    40.0,   35.0,   60.0,   60.0,   70.0,   70.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: downregulation_co2_coeff_mtc  =  &  !! coefficient for CO2 downregulation 
+  & (/  0.0,   0.38,   0.38,   0.28,   0.28,   0.28,   0.22,  &
+  &     0.22,  0.22,   0.26,   0.26,   0.26,   0.26 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_KmC_mtc  = &            !! Energy of activation for KmC (J mol-1)
+  & (/undef,  79430.,  79430.,  79430.,  79430.,  79430.,  79430.,  &  !! See Medlyn et al. (2002) 
+  &  79430.,  79430.,  79430.,  79430.,  79430.,  79430.  /)           !! from Bernacchi al. (2001)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_KmO_mtc  = &            !! Energy of activation for KmO (J mol-1)
+  & (/undef,  36380.,  36380.,  36380.,  36380.,  36380.,  36380.,  &  !! See Medlyn et al. (2002) 
+  &  36380.,  36380.,  36380.,  36380.,  36380.,  36380.  /)           !! from Bernacchi al. (2001)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_Sco_mtc  = &            !! Energy of activation for Sco (J mol-1)
+  & (/undef, -24460., -24460., -24460., -24460., -24460., -24460.,  &  !! See Table 2 of Yin et al. (2009)  
+  & -24460., -24460., -24460., -24460., -24460., -24460.  /)           !! Value for C4 plants is not mentioned - We use C3 for all plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_gamma_star_mtc  = &     !! Energy of activation for gamma_star (J mol-1)
+  & (/undef,  37830.,  37830.,  37830.,  37830.,  37830.,  37830.,  &  !! See Medlyn et al. (2002) from Bernacchi al. (2001) 
+  &  37830.,  37830.,  37830.,  37830.,  37830.,  37830.  /)           !! for C3 plants - We use the same values for C4 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_Vcmax_mtc  = &          !! Energy of activation for Vcmax (J mol-1)
+  & (/undef,  71513.,  71513.,  71513.,  71513.,  71513.,  71513.,  &  !! See Table 2 of Yin et al. (2009) for C4 plants
+  &  71513.,  71513.,  71513.,  67300.,  71513.,  67300.  /)           !! and Kattge & Knorr (2007) for C3 plants (table 3)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_Jmax_mtc  = &            !! Energy of activation for Jmax (J mol-1)
+  & (/undef,  49884.,  49884.,  49884.,  49884.,  49884.,  49884.,  &   !! See Table 2 of Yin et al. (2009) for C4 plants
+  &  49884.,  49884.,  49884.,  77900.,  49884.,  77900.  /)            !! and Kattge & Knorr (2007) for C3 plants (table 3)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: aSV_mtc     = &            !! a coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax (J K-1 mol-1)
+  & (/undef,  668.39,  668.39,  668.39,  668.39,  668.39,  668.39,  &   !! See Table 3 of Kattge & Knorr (2007)
+  &  668.39,  668.39,  668.39,  641.64,  668.39,  641.64  /)            !! For C4 plants, we assume that there is no
+                                                                        !! acclimation and that at for a temperature of 25Â°C, aSV is the same for both C4 and C3 plants (no strong jusitification - need further parametrization)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: bSV_mtc     = &            !! b coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax (J K-1 mol-1 Â°C-1)
+  & (/undef,   -1.07,   -1.07,   -1.07,   -1.07,   -1.07,   -1.07,  &   !! See Table 3 of Kattge & Knorr (2007)
+  &   -1.07,   -1.07,   -1.07,      0.,   -1.07,      0.  /)            !! We assume No acclimation term for C4 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tphoto_min_mtc  =  &       !! minimum photosynthesis temperature (deg C) 
+  & (/  undef,   -4.0,    -4.0,   -4.0,   -4.0,   -4.0,   -4.0,  & 
+  &      -4.0,   -4.0,    -4.0,   -4.0,   -4.0,   -4.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tphoto_max_mtc  =  &       !! maximum photosynthesis temperature (deg C) 
+  & (/  undef,   55.0,    55.0,   55.0,   55.0,   55.0,   55.0,  & 
+  &      55.0,   55.0,    55.0,   55.0,   55.0,   55.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: aSJ_mtc     = &            !! a coefficient of the linear regression (a+bT) defining the Entropy term for Jmax (J K-1 mol-1)
+  & (/undef,  659.70,  659.70,  659.70,  659.70,  659.70,  659.70,  &   !! See Table 3 of Kattge & Knorr (2007)
+  &  659.70,  659.70,  659.70,    630.,  659.70,    630.  /)            !! and Table 2 of Yin et al. (2009) for C4 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: bSJ_mtc     = &            !! b coefficient of the linear regression (a+bT) defining the Entropy term for Jmax (J K-1 mol-1 Â°C-1)
+  & (/undef,   -0.75,   -0.75,   -0.75,   -0.75,   -0.75,   -0.75,  &   !! See Table 3 of Kattge & Knorr (2007)
+  &   -0.75,   -0.75,   -0.75,      0.,   -0.75,      0.  /)            !! We assume no acclimation term for C4 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: D_Vcmax_mtc  = &           !! Energy of deactivation for Vcmax (J mol-1)
+  & (/undef, 200000., 200000., 200000., 200000., 200000., 200000.,  &   !! Medlyn et al. (2002) also uses 200000. for C3 plants (same value than D_Jmax)
+  & 200000., 200000., 200000., 192000., 200000., 192000.  /)            !! 'Consequently', we use the value of D_Jmax for C4 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: D_Jmax_mtc  = &            !! Energy of deactivation for Jmax (J mol-1)
+  & (/undef, 200000., 200000., 200000., 200000., 200000., 200000.,  &   !! See Table 2 of Yin et al. (2009)
+  & 200000., 200000., 200000., 192000., 200000., 192000.  /)            !! Medlyn et al. (2002) also uses 200000. for C3 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_gm_mtc  = &              !! Energy of activation for gm (J mol-1) 
+  & (/undef,  49600.,  49600.,  49600.,  49600.,  49600.,  49600.,  &   !! See Table 2 of Yin et al. (2009) 
+  &  49600.,  49600.,  49600.,   undef,  49600.,   undef  /)            
+                  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: S_gm_mtc  = &              !! Entropy term for gm (J K-1 mol-1) 
+  & (/undef,   1400.,   1400.,   1400.,   1400.,   1400.,   1400.,  &   !! See Table 2 of Yin et al. (2009) 
+  &   1400.,   1400.,   1400.,   undef,   1400.,   undef  /) 
+                  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: D_gm_mtc  = &              !! Energy of deactivation for gm (J mol-1) 
+  & (/undef, 437400., 437400., 437400., 437400., 437400., 437400.,  &   !! See Table 2 of Yin et al. (2009) 
+  & 437400., 437400., 437400.,   undef, 437400.,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_Rd_mtc  = &              !! Energy of activation for Rd (J mol-1)
+  & (/undef,  46390.,  46390.,  46390.,  46390.,  46390.,  46390.,  &   !! See Table 2 of Yin et al. (2009)
+  &  46390.,  46390.,  46390.,  46390.,  46390.,  46390.  /)           
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: Vcmax25_mtc  =  &          !! Maximum rate of Rubisco activity-limited carboxylation at 25Â°C
+  & (/ undef,   50.0,    65.0,    45.0,   45.0,   55.0,   45.0,  &      !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+  &     45.0,   35.0,    70.0,    70.0,   70.0,   70.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: arJV_mtc    = &            !! a coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio (mu mol e- (mu mol CO2)-1)
+  & (/undef,    2.59,    2.59,    2.59,    2.59,    2.59,    2.59,  &   !! See Table 3 of Kattge & Knorr (2007)
+  &    2.59,    2.59,    2.59,   1.715,    2.59,   1.715  /)            !! For C4 plants, we assume that there is no
+                                                                        !! acclimation and that for a temperature of 25Â°C, aSV is the same for both C4 and C3 plants (no strong jusitification - need further parametrization)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: brJV_mtc    = &            !! b coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio ((mu mol e- (mu mol CO2)-1) (Â°C)-1)
+  & (/undef,  -0.035,  -0.035,  -0.035,  -0.035,  -0.035,  -0.035,  &   !! See Table 3 of Kattge & Knorr (2007)
+  &  -0.035,  -0.035,  -0.035,      0.,  -0.035,      0.  /)            !! We assume No acclimation term for C4 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: KmC25_mtc  = &             !! MichaelisâMenten constant of Rubisco for CO2 at 25Â°C (ubar)
+  & (/undef,   404.9,   404.9,   404.9,   404.9,  404.9,   404.9,  &    !! See Table 2 of Yin et al. (2009) for C4
+  &   404.9,   404.9,   404.9,    650.,   404.9,   650.  /)             !! and Medlyn et al (2002) for C3
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: KmO25_mtc  = &             !! MichaelisâMenten constant of Rubisco for O2 at 25Â°C (ubar)
+  & (/undef, 278400., 278400., 278400., 278400., 278400., 278400.,  &   !! See Table 2 of Yin et al. (2009) for C4 plants and Medlyn et al. (2002) for C3
+  & 278400., 278400., 278400., 450000., 278400., 450000.  /)           
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: Sco25_mtc  = &             !! Relative CO2 /O2 specificity factor for Rubisco at 25ÃÂÃÂ°C (bar bar-1)
+  & (/undef,   2800.,   2800.,   2800.,   2800.,   2800.,   2800.,  &   !! See Table 2 of Yin et al. (2009)
+  &   2800.,   2800.,   2800.,   2590.,   2800.,   2590.  /)           
+    
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: gm25_mtc  = &              !! Mesophyll diffusion conductance at 25ÃÂÃÂ°C (mol m-2 s-1 bar-1)
+  & (/undef,     0.4,     0.4,     0.4,     0.4,    0.4,      0.4,  &   !! See legend of Figure 6 of Yin et al. (2009)
+  &     0.4,     0.4,     0.4,   undef,     0.4,  undef  /)             !! and review by Flexas et al. (2008) - gm is not used for C4 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: gamma_star25_mtc  = &      !! Ci-based CO2 compensation point in the absence of Rd at 25Â°C (ubar)
+  & (/undef,   42.75,   42.75,   42.75,   42.75,   42.75,   42.75,  &   !! See Medlyn et al. (2002) for C3 plants - For C4 plants, we use the same value (probably uncorrect)
+  &   42.75,   42.75,   42.75,   42.75,   42.75,   42.75  /)    
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: a1_mtc  = &                !! Empirical factor involved in the calculation of fvpd (-)
+  & (/undef,    0.85,    0.85,    0.85,    0.85,    0.85,  0.85,  &     !! See Table 2 of Yin et al. (2009)
+  &    0.85,    0.85,    0.85,    0.72,    0.85,    0.72  /)           
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: b1_mtc  = &                !! Empirical factor involved in the calculation of fvpd (-)
+  & (/undef,    0.14,    0.14,    0.14,    0.14,    0.14,  0.14,  &     !! See Table 2 of Yin et al. (2009)
+  &    0.14,    0.14,    0.14,    0.20,    0.14,    0.20  /)           
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: g0_mtc  = &                !! Residual stomatal conductance when irradiance approaches zero (mol CO2 mâ2 sâ1 barâ1)
+  & (/undef, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625,  &   !! Value from ORCHIDEE - No other reference.
+  & 0.00625, 0.00625, 0.00625, 0.01875, 0.00625, 0.01875  /)            !! modofy to account for the conversion for conductance to H2O to CO2 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: h_protons_mtc  = &         !! Number of protons required to produce one ATP (mol mol-1)
+  & (/undef,      4.,      4.,      4.,      4.,      4.,    4.,  &     !! See Table 2 of Yin et al. (2009) - h parameter
+  &      4.,      4.,      4.,      4.,      4.,      4.  /)           
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: fpsir_mtc = &              !! Fraction of PSII eâ transport rate 
+  & (/undef,   undef,   undef,   undef,   undef,  undef,  undef,  &     !! partitioned to the C4 cycle (-)
+  &   undef,   undef,   undef,     0.4,   undef,    0.4  /)             !! See Table 2 of Yin et al. (2009) - x parameter        
+ 
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: fQ_mtc = &                 !! Fraction of electrons at reduced plastoquinone 
+  & (/undef,   undef,   undef,   undef,   undef,  undef,  undef,  &     !! that follow the Q-cycle (-) - Values for C3 platns are not used
+  &   undef,   undef,   undef,      1.,   undef,     1.  /)             !! See Table 2 of Yin et al. (2009)          
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: fpseudo_mtc = &            !! Fraction of electrons at PSI that follow 
+  & (/undef,   undef,   undef,   undef,   undef,  undef,  undef,  &     !! pseudocyclic transport (-) - Values for C3 platns are not used
+  &   undef,   undef,   undef,     0.1,   undef,    0.1  /)             !! See Table 2 of Yin et al. (2009)    
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: kp_mtc = &                 !! Initial carboxylation efficiency of the PEP carboxylase (mol mâ2 sâ1 barâ1) 
+  & (/undef,   undef,   undef,   undef,   undef,  undef,  undef,  &     !! See Table 2 of Yin et al. (2009)
+  &   undef,   undef,   undef,     0.7,   undef,    0.7  /)                 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alpha_mtc = &              !! Fraction of PSII activity in the bundle sheath (-)
+  & (/undef,   undef,   undef,   undef,   undef,  undef,  undef,  &     !! See legend of Figure 6 of Yin et al. (2009)
+  &   undef,   undef,   undef,     0.1,   undef,    0.1  /)                 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: gbs_mtc = &                !! Bundle-sheath conductance (mol mâ2 sâ1 barâ1)
+  & (/undef,   undef,   undef,   undef,   undef,  undef,  undef,  &     !! See legend of Figure 6 of Yin et al. (2009)
+  &   undef,   undef,   undef,   0.003,   undef,  0.003  /)    
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: theta_mtc = &              !! Convexity factor for response of J to irradiance (-)
+  & (/undef,     0.7,     0.7,     0.7,     0.7,    0.7,    0.7,  &     !! See Table 2 of Yin et al. (2009) 
+  &     0.7,     0.7,     0.7,     0.7,     0.7,    0.7  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alpha_LL_mtc = &           !! Conversion efficiency of absorbed light into J at strictly limiting light (mol eâ (mol photon)â1)
+  & (/undef,     0.3,     0.3,     0.3,     0.3,    0.3,    0.3,  &     !! See comment from Yin et al. (2009) after eq. 4
+  &     0.3,     0.3,     0.3,     0.3,     0.3,    0.3  /)             !! alpha value from Medlyn et al. (2002)   
+                                                                        !! 0.093 mol CO2 fixed per mol absorbed photons
+                                                                        !! times 4 mol e- per mol CO2 produced
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: stress_vcmax_mtc = &       !! Water stress on vcmax
+  & (/    1.,     1.,     1.,       1.,      1.,     1.,      1., &
+  &      1.,     1.,     1.,       1.,      1.,     1.  /)
+     
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: stress_gs_mtc = &          !! Water stress on gs
+  & (/    0.,     0.,     0.,       0.,      0.,     0.,      0., &
+  &      0.,     0.,     0.,       0.,      0.,     0.  /)
+     
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: stress_gm_mtc = &          !! Water stress on gm
+  & (/    0.,     0.,     0.,       0.,      0.,     0.,      0., &
+  &      0.,     0.,     0.,       0.,      0.,     0.  /)
+  
+  !-
+  ! 2 .Stomate
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ext_coeff_mtc  =  &     !! extinction coefficient of the Monsi&Saeki
+  & (/ 0.5,   0.5,   0.5,   0.5,   0.5,   0.5,   0.5,  &             !! relationship (1953) ((m2[ground]) (m-2[leaf])) 
+  &    0.5,   0.5,   0.5,   0.5,   0.5,   0.5  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ext_coeff_vegetfrac_mtc  =  &     !! extinction coefficient used for defining the fraction
+  & (/ 1.0,   1.0,   1.0,   1.0,   1.0,   1.0,   1.0,  &                       !!  of bare soil (unitless)
+  &    1.0,   1.0,   1.0,   1.0,   1.0,   1.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ext_coeff_N_mtc  =  &    !! extinction coefficient of the leaf N content profile within the canopy
+  & (/ 0.15,  0.15,  0.15,  0.15,  0.15,  0.15,  0.15,  &             !! ((m2[ground]) (m-2[leaf]))
+  &    0.15,  0.15,  0.15,  0.15,  0.15,  0.15  /)                    !! based on Dewar et al. (2012, value of 0.18), on Carswell et al. (2000, value of 0.11 used in OCN) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: nue_opt_mtc = &           !! Nitrogen use efficiency of Vcmax 
+  & (/ undef,   22.,    22.,    20.,    33.,    33.,    20., &         !! ((mumol[CO2] s-1) (gN[leaf])-1)
+  &      33.,   22.,    45.,    45.,    60.,    60.     /)             !! based on the work of Kattge et al. (2009, GCB)
+      
+!!$  !
+!!$  ! ALLOCATION (stomate)
+!!$  ! 
+!!$  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: R0_mtc = &              !! Default root allocation (0-1, unitless)
+!!$  & (/ undef,   0.30,   0.30,   0.30,   0.30,  0.30,    0.30, &
+!!$  &     0.30,   0.30,   0.30,   0.30,   0.30,  0.30 /)                   
+!!$
+!!$  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: S0_mtc = &              !! Default sapwood allocation (0-1, unitless)
+!!$  & (/ undef,   0.25,   0.25,   0.30,   0.30,  0.30,    0.30, &
+!!$  &     0.30,   0.30,   0.30,   0.30,   0.30,  0.30 /)                   
+
+  !
+  ! RESPIRATION (stomate)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: frac_growthresp_mtc  =  &  !! fraction of GPP which is lost as growth respiration
+  & (/  undef,   0.28,   0.28,   0.28,   0.28,   0.28,   0.28,  &
+  &      0.28,   0.28,   0.28,   0.28,   0.28,   0.28  /)
+
+   REAL(r_std), PARAMETER, DIMENSION(nvmc) :: maint_resp_slope_c_mtc  =  &  !! slope of maintenance respiration coefficient (1/K),
+  & (/  undef,   0.20,   0.20,   0.16,   0.16,   0.16,   0.16,  &          !! constant c of aT^2+bT+c, tabulated
+  &      0.16,   0.16,   0.16,   0.12,   0.16,   0.12  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: maint_resp_slope_b_mtc  =  &  !! slope of maintenance respiration coefficient (1/K),
+  & (/  undef,   0.0,        0.0,   0.0,        0.0,   0.0,   0.0,  &      !! constant b of aT^2+bT+c, tabulated
+  &       0.0,   0.0,   -0.00133,   0.0,   -0.00133,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: maint_resp_slope_a_mtc  =  &  !! slope of maintenance respiration coefficient (1/K),
+  & (/  undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                !! constant a of aT^2+bT+c, tabulated
+  &       0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_maint_init_mtc  =   &              !! maintenance respiration coefficient
+  & (/   undef,   1.81E-2,   1.81E-2,   3.84E-2,   3.84E-2,   3.84E-2,   3.84E-2,  &  !! at 10 deg C - from Sitch et al. 2003 and Zaehle (OCN)
+  &    3.84E-2,   3.84E-2,   3.84E-2,   2.74E-2,   3.84E-2,   2.74E-2  /)             !! @tex $(gC.gN^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tref_maint_resp_mtc  =   &              !! maintenance respiration Temperature coefficient (deg C)
+  & (/   undef,     10.02,     10.02,     10.02,     10.02,     10.02,     10.02,  &  
+  &      10.02,     10.02,     10.02,     10.02,     10.02,     10.02  /)             
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tmin_maint_resp_mtc  =   &              !! maintenance respiration Temperature coefficient (deg C)
+  & (/   undef,    -46.02,    -46.02,    -46.02,    -46.02,    -46.02,    -46.02,  &  
+  &     -46.02,    -46.02,    -46.02,    -46.02,    -46.02,    -46.02  /)             
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: e0_maint_resp_mtc  =   &              !! maintenance respiration Temperature coefficient (unitless)
+  & (/   undef,   308.56,     308.56,   308.56,     308.56,   308.56,     308.56,  &  
+  &     308.56,   308.56,     308.56,   308.56,     308.56,   308.56  /)             
+
+  !
+  ! SOM decomposition (stomate)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: LC_leaf_mtc = &        !! Lignin/C ratio of leaf pool (unitless)
+  & (/   0.15,   0.18,   0.18,   0.24,   0.18,   0.18,   0.24,  &   !! based on CN from White et al. (2000)       
+  &      0.18,   0.24,   0.09,   0.09,   0.09,   0.09  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: LC_sapabove_mtc = &    !! Lignin/C ratio of sapabove pool (unitless)
+  & (/   0.15,   0.23,   0.23,   0.29,   0.23,   0.23,   0.29,  &   !! based on CN from White et al. (2000)       
+  &      0.23,   0.29,   0.09,   0.09,   0.09,   0.09  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: LC_sapbelow_mtc = &    !! Lignin/C ratio of sapbelow pool (unitless)
+  & (/   0.15,   0.23,   0.23,   0.29,   0.23,   0.23,   0.29,  &   !! based on CN from White et al. (2000)       
+  &      0.23,   0.29,   0.09,   0.09,   0.09,   0.09  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: LC_heartabove_mtc = &  !! Lignin/C ratio of heartabove pool (unitless)
+  & (/   0.15,   0.23,   0.23,   0.29,   0.23,   0.23,   0.29,  &   !! based on CN from White et al. (2000)       
+  &      0.23,   0.29,   0.09,   0.09,   0.09,   0.09  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: LC_heartbelow_mtc = &  !! Lignin/C ratio of heartbelow pool (unitless)
+  & (/   0.15,   0.23,   0.23,   0.29,   0.23,   0.23,   0.29,  &   !! based on CN from White et al. (2000)       
+  &      0.23,   0.29,   0.09,   0.09,   0.09,   0.09  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: LC_fruit_mtc = &       !! Lignin/C ratio of fruit pool (unitless)
+  & (/   0.09,   0.09,   0.09,   0.09,   0.09,   0.09,   0.09,  &   !! based on CN from White et al. (2000)       
+  &      0.09,   0.09,   0.09,   0.09,   0.09,   0.09  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: LC_root_mtc = &        !! Lignin/C ratio of root pool (unitless)
+  & (/   0.22,   0.22,   0.22,   0.22,   0.22,   0.22,   0.22,  &   !! based on CN from White et al. (2000)       
+  &      0.22,   0.22,   0.22,   0.22,   0.22,   0.22  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: LC_carbres_mtc = &     !! Lignin/C ratio of carbres pool (unitless)
+  & (/   0.15,   0.18,   0.18,   0.24,   0.18,   0.18,   0.24,  &   !! based on CN from White et al. (2000)       
+  &      0.18,   0.24,   0.09,   0.09,   0.09,   0.09  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: LC_labile_mtc = &      !! Lignin/C ratio of labile pool (unitless)
+  & (/   0.15,   0.18,   0.18,   0.24,   0.18,   0.18,   0.24,  &   !! based on CN from White et al. (2000)       
+  &      0.18,   0.24,   0.09,   0.09,   0.09,   0.09  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: decomp_factor_mtc  =  &  !! Multpliactive factor modifying the standard decomposition factor for each SOM pool
+  & (/     1.,     1.,     1.,     1.,     1.,     1.,     1.,  &          
+  &        1.,     1.,     1.,     1.,    1.2,    1.4  /)
+  !
+  ! STAND STRUCTURE
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tree_ff_mtc = &                          !! Tree form factor to reduce
+	  &(/ undef,  0.6,    0.6,   0.6,   0.6,   0.6,   0.8, &                              !! the volume of a cylinder
+	  &     0.8,  0.8,  undef, undef, undef, undef /)                                     !! to the volume of the real tree shape
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pipe_density_mtc = &                     !! Wood density @tex $(gC.m^{-3})$ @endtex
+  &(/   0.0,   2.e5,   2.e5,   2.e5,   2.e5,   2.e5,   2.e5,  &                       !! Current values are taken from the trunk. 
+  &    2.e5,  2.e5,    2.e5,   2.e5,   2.e5,   2.e5  /)                               !! forestry-branch has more realistic values 
+                                                                                      !! in it. Source: AFOCEL 2006
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pipe_tune1_mtc = &                       !! cn_area = pipe_tune1*...
+  &(/ undef,  100.,  100.,  100.,  100.,  100.,  100., &                              !!    stem diameter**pipe_tune_exp_coeff
+  &    100.,  100., undef, undef, undef, undef /) 
+       
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pipe_tune2_mtc = &                       !! height=pipe_tune2 * diameter**pipe_tune3
+  &(/ undef,   40.,   40.,   40.,   40.,   40.,   40., &
+  &     40.,   40., undef, undef, undef, undef /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pipe_tune3_mtc = &                       !! height=pipe_tune2 * diameter**pipe_tune3
+  &(/ undef,   0.5,   0.5,   0.5,   0.5,   0.5,  0.5, &
+  &     0.5,   0.5, undef, undef, undef, undef /)   
+      
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pipe_tune4_mtc = &                       !! CHECK - needed for stem diameter
+  &(/ undef,   0.3,   0.3,   0.3,   0.3,   0.3,   0.3, &
+        0.3,   0.3, undef, undef, undef, undef /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pipe_k1_mtc = &                          !! CHECK 
+  &(/ undef,  8.e3,  8.e3,  8.e3,  8.e3,  8.e3,  8.e3, &
+  &    8.e3,  8.e3, undef, undef, undef, undef /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pipe_tune_exp_coeff_mtc = &              !! cn_area = pipe_tune1*...  
+  &(/ undef,   1.6,   1.6,   1.6,   1.6,   1.6,   1.6, &                              !!    stem diameter**pipe_tune_exp_coeff
+  &     1.6,   1.6, undef, undef, undef, undef /)  
+      
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: mass_ratio_heart_sap_mtc = &             !! mass ratio (heartwood+sapwood)/heartwood 
+  &(/ undef,    3.,    3.,    3.,    3.,    3.,    3., &
+  &      3.,    3., undef, undef, undef, undef /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: canopy_cover_mtc = &                     !! Prescribed canopy cover (1-gap fraction) 
+  & (/ undef,    0.9,   0.9,   0.7,   0.7,   0.7,   0.6, &                            !! of a canopy (unitless)
+  &      0.5,    0.5,   0.9,   0.9,   0.9,   0.9 /)  
+
+  INTEGER(i_std), PARAMETER, DIMENSION(nvmc) :: nmaxtrees_mtc = &                     !! Initial number of trees per ha. This parameter is 
+  & (/  -9999,   2000,   2000,   7333,   8000,  15000, 15000,  &                      !! used at .firstcall. and after clearcuts
+  &     15000,  15000,  10000,  10000,  10000,  10000 /)                              !! the value is used by the allometric allocation
+                                                                                      !! and forestry subroutines.
+                                                                                      !! Values from DOFOCO run.def
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: height_init_min_mtc = &                  !! The minimum height (m) of a tree sapling when a forest 
+  &(/ undef,    2.,    2.,    2.,    2.,    2.,    3., &                              !! stand is established. Owing to the allometric 
+  &      3.,    3.,   0.1,   0.1,   0.1,   0.1 /)                                     !! relationship this setting determines all
+                                                                                      !! biomass components of a newly establised stand
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: height_init_max_mtc = &                  !! The maximum height (m) of a tree sapling when a forest 
+  &(/ undef,    3.,    3.,    3.,    3.,    3.,    4., &                              !! stand is established. 
+  &      4.,    4.,   0.2,   0.2,   0.2,   0.2 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alpha_self_thinning_mtc = &              !! Coefficient of the self-thinning relationship D=alpha*N^beta 
+  &(/ undef,  3000.,  3000.,  1462.,  2262.,  1900.,  960., &                         !! estimated from German, French, Spanish and Swedish 
+  &     939.,  1046.,  undef,  undef,  undef,  undef/)                                !! forest inventories
+ 
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: beta_self_thinning_mtc = &               !! Exponent of the self-thinning relationship D=alpha*N^beta 
+  &(/ undef,  -0.57,  -0.57,  -0.55,  -0.61,  -0.58,  -0.55, &                        !! estimated from German, French, Spanish and Swedish 
+  &    -0.56, -0.56,  undef,  undef,  undef,  undef/)                                 !! forest inventories
+
+  !
+  ! RECRUITMENT (stomate)  
+  !                                                                       
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: recruitment_pft_mtc = &                      !! Do recruitment? (true/false)  
+  & (/ .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,  &  
+  &    .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE. /)    
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: recruitment_height_mtc = &               !! Prescribed height for the recruited stems @tex $(m)$ @endtex  
+  & (/ undef, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, &
+  &    undef, undef, undef, undef/)        
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: recruitment_alpha_mtc = &                !! Alpha parameter for the power function (log-log)   
+  & (/ undef, -3.0, -3.0, -3.0, -3.0, -3.0, -3.0, -3.0, -3.0, &                       !! used to model recruitment from light @tex $(unitless)$ @endtex. 
+  &    undef, undef, undef, undef/)                                                   !! It represents a measure of the mean log10 of the number of   
+                                                                                      !! recruits to be expected in 25 m2 at average light conditions 
+                                                                                      !! (2% at BCI). Observed values for individual species in a tropical 
+                                                                                      !! forest in Panama (BCI 50-ha plot) varied between -4.28 and -0.55 
+                                                                                      !! with a community mean of -3.0 for typical light levels <20%.   
+                                                                                      !! For details see Ruger et al (2009), J. of Ecol., 
+                                                                                      !! doi:10.1111/j.1365-2745.2009.01552.x   
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: recruitment_beta_mtc = &                 !! Beta parameter for the power function (log-log) used to model 
+  &(/ undef, 0.8, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, &                                !! recruitment from light @tex $(unitless)$ @endtex. It measures 
+  &   undef, undef, undef, undef/)                                                    !! the strength of the light response. Observed values
+                                                                                      !! for individual species in a tropical  forest in Panama (BCI 50-ha plot) 
+                                                                                      !! varied between -0.72 and 3.28 with a community mean of 0.8 
+                                                                                      !! (nearly linear response) for typical light levels <20%.
+                                                                                      !! For beta < 0, the number of recruits decreases with increasing light.  
+                                                                                      !! For 0<beta<1, the number of recruits increases in a decelerating 
+                                                                                      !! way with increasing light. For beta=1 it is a linear relationship, 
+                                                                                      !! and for beta>1 the number of recruits increases in an  
+                                                                                      !! accelerating way with light. For details see Ruger et al (2009), 
+                                                                                      !! J. of Ecol., doi: 10.1111/j.1365-2745.2009.01552.x  
+
+  !
+  ! WINDFALL (stomate)
+  !
+
+  ! At the moment, species-related parameters are scarce (more tree pulling tests are needed), therefore defining parameters for metaclasses
+  ! is far from being straightforward.
+
+  ! NOTE:  All the parameter values below were originated from six needle-leaf species:
+  ! SS: Sitka Spruce 
+  ! NS: Norway Spruce
+  ! SP: Scots Pine
+  ! LP: Lodgepople Pine
+  ! CP: Corsican Pine  
+  ! EL: European Larch
+  !     and three broad leaved species:
+  ! BI: Beech (Fagus)
+  ! BE: Birch (Betula)
+  ! OK: Oak   (Quercus)
+  ! see the parameter table for the detail of combination of species to PFT
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: streamlining_c_leaf_mtc  =  &   !! Streamlining parameter. @tex $(unitless)$ @endtex. Streamlining is the
+  & (/  undef,   2.34,   2.34,   2.70,   2.66,   2.34,   2.71, &            !! change of shape of the crowns due to wind. Used in the calculation of the
+  &      2.15,   3.07,   undef,  undef,  undef,  undef  /)                   !! critical wind speed according to the GALES (Hale et al. 2015) model.
+                                                                            !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: streamlining_c_leafless_mtc = & !! Streamlining parameter. @tex $(unitless)$ @endtex. Streamlining is the
+  & (/  undef,   2.34,   2.34,   2.70,   2.66,   2.34,   2.71, &            !! change of shape of the crowns due to wind. Used in the calculation of the
+  &      2.15,   3.07,   undef,  undef,  undef,  undef  /)                   !! critical wind speed according to the GALES (Hale et al. 2015) model.
+                                                                            !! In this case, the tree is leafless.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: streamlining_n_leaf_mtc  =  &   !! Streamlining parameter. @tex $(unitless)$ @endtex. Streamlining is the
+  & (/  undef,   0.88,   0.88,   0.64,   0.85,   0.88,   0.63, &            !! change of shape of the crowns due to wind. Used in the calculation of the
+  &      0.88,   0.75,   undef,  undef,  undef,  undef  /)                   !! critical wind speed according to the GALES (Hale et al. 2015) model.
+                                                                            !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: streamlining_n_leafless_mtc = & !! Streamlining parameter. @tex $(unitless)$ @endtex. Streamlining is the
+  & (/  undef,   0.88,   0.88,   0.64,   0.85,   0.88,   0.63, &            !! change of shape of the crowns due to wind. Used in the calculation of the
+  &      0.88,   0.75,   undef,  undef,  undef,  undef  /)                   !! critical wind speed according to the GALES (Hale et al. 2015) model.
+                                                                            !! In this case, the tree is leafless.
+
+!  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: streamlining_rb_leaf_mtc  =  &  !! Streamlining parameter. @tex $(unitless)$ @endtex. Streamlining is the
+!  & (/  undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0, &                  !! change of shape of the crowns due to wind. Used in the calculation of the
+!  &      0.0,   0.0,   undef,  undef, undef, undef  /)                         !! critical wind speed according to the GALES (Hale et al. 2015) model.
+                                                                            !! In this case, the tree is in leaf.
+
+!  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: streamlining_rb_leafless_mtc =& !! Streamlining parameter. @tex $(unitless)$ @endtex. Streamlining is the
+!  & (/  undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0, &                  !! change of shape of the crowns due to wind. Used in the calculation of the
+!  &      0.0,   0.0,   undef,  undef, undef, undef  /)                         !! critical wind speed according to the GALES (Hale et al. 2015) model.
+                                                                            !! In this case, the tree is leafless.
+
+!  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: canopy_density_leaf_mtc  =  &   !! Density of the tree canopy @tex $(kg/m^{3})$ @endtex, i.e. of the 
+!  & (/  undef,   2.5,   2.5,   2.5,   2.5,   2.5,   2.5, &                  !! branches and leaves. Used in the calculation of the critical wind speed
+!  &      2.5,   2.5,   undef, undef,  undef, undef  /)                         !! according to the GALES (Hale et al. 2015) model.
+
+!  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: canopy_density_leafless_mtc = & !! Density of the tree canopy @tex $(kg/m^{3})$ @endtex, i.e. of the 
+!  & (/  undef,   2.5,   2.5,   2.5,   2.5,   2.5,   2.5, &                  !! branches (no leaves). Used in the calculation of the critical wind speed
+!  &      2.5,   2.5,   undef, undef,  undef, undef  /)                         !! according to the GALES (Hale et al. 2015) model.
+
+!  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: intercept_breadth_mtc  =  &      !! Intercept in the equation for calculating the canopy breadth.
+!  & (/  undef,   0.5824,   0.5824,   0.5824,   0.5824,   0.5824,   0.5824, & !! @tex $(unitless)$ @endtex
+!  &      0.5824,   0.5824,  undef,  undef,   undef,  undef /)
+
+!  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: slope_breadth_mtc  =  &          !! Slope in the equation for calculating the canopy breadth.
+!  & (/  undef,   0.115,   0.115,   0.115,   0.115,   0.115,   0.115, &       !! @tex $(unitless)$ @endtex
+!  &      0.115,   0.115,  undef,  undef,  undef, undef  /)
+
+!  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: intercept_depth_mtc  =  &        !! Intercept in the equation for calculating the canopy depth.
+!  & (/  undef,   0.4206,   0.4206,   0.4206,   0.4206,   0.4206,   0.4206, & !! @tex $(unitless)$ @endtex
+!  &      0.4206,   0.4206,  undef,   undef,   undef,   undef  /)
+
+!  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: slope_depth_mtc  =  &            !! Slope in the equation for calculating the canopy depth.
+!  & (/  undef,   0.4368,   0.4368,   0.4368,   0.4368,   0.4368,   0.4368, & !! @tex $(unitless)$ @endtex
+!  &      0.4368,   0.4368,   undef,  undef,  undef,  undef /)
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: modulus_rupture_mtc  =  &  !! Modulus of rupture @tex $(Pa)$ @endtex. The measure of a speciesâ strength
+  & (/  undef,   6.23E7, 6.23E7, 4.13E7, 5.90E7, 6.23E7,  4.10E7, &    !! before rupture when being bent. Used in the calculation of the critical
+  &      6.27E7, 5.30E7,  undef,  undef,  undef,  undef  /)            !! wind speed according to the GALES (Hale et al. 2015) model. IMPORTANT:
+                                                                       !! greenwood values are used and not the more frequently available drywood
+                                                                       !! modulus of rupture.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: f_knot_mtc  =  &           !! Knot Factor @tex $(unitless)$ @endtex. This modifier represents the knots
+  & (/  undef,   1.0,   1.0,   0.87, 1.0,  1.0,   0.88, &              !! in the wood, and hence the decrease in structural strength. Used in the
+  &      1.0,   0.85,   undef, undef, undef, undef /)                  !! calculation of the critical wind speed according to the GALES
+                                                                       !! (Hale et al. 2015) model.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_free_draining_shallow_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   175.3,   175.3,   134.7,  198.5,   175.3,  132.6, &   !! This is derived from the generic soil type (free_draining mineral soils;
+  &      152.0,  145.2,   undef,   undef,  undef,   undef /)           !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_free_draining_shallow_leafless_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   175.3,  175.3,   134.7,   198.5,   175.3,  132.6,   & !! This is derived from the generic soil type (free_draining mineral soils;
+  &      152.0,  145.2,  undef,   undef,   undef,   undef /)           !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is leafless.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_free_draining_deep_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   203.8,   203.8,   157.2,   230.8,   230.8,   154.8, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &     176.7,   169.4,  undef,   undef,   undef,   undef  /)          !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_free_draining_deep_leafless_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   203.8,   203.8,   157.2,   230.8,   230.8,   154.8, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &      176.7,  169.4,   undef,  undef,   undef,  undef  /)           !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is leafless.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_free_draining_average_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   178.7,   178.7,   137.8,   202.4,   178.7,   135.7, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &      155.0,  148.6,   undef,   undef,  undef,   undef  /)          !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_free_draining_average_leafless_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   178.7,   178.7,   137.8,   202.4,   178.7,   135.7, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &      155.0,  148.6,   undef,   undef,   undef,   undef  /)         !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is leafless.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_gleyed_shallow_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   155.4,   155.4,   119.4,   176.0,   155.4,   117.6, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &      134.8,  128.7,   undef,   undef,   undef,   undef  /)         !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_gleyed_shallow_leafless_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   155.4,   155.4,   119.4,   176.0,   155.4,   117.6, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &      134.8,  128.7,   undef,   undef,   undef,   undef  /)         !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is leafless.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_gleyed_deep_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   180.6,   180.6,   139.3,   204.6,   180.6,   137.2, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &     156.7,   150.2,   undef,   undef,   undef,   undef  /)         !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_gleyed_deep_leafless_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   180.6,   180.6,   139.3,   204.6,   180.6,   137.2, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &     156.7,   150.2,   undef,   undef,   undef,   undef  /)         !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is leafless.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_gleyed_average_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   158.5,   158.5,   122.2,   179.5,   158.5,  120.3, &  !! This is derived from the generic soil type (free_draining mineral soils;
+  &     137.4,   131.7,   undef,   undef,   undef,   undef  /)         !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_gleyed_average_leafless_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   158.8,   158.5,   122.2,   179.5,   158.5,   120.3, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &     137.4,   131.7,   undef,   undef,   undef,   undef /)          !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is leafless.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_peaty_shallow_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   169.7,   169.7,   130.4,   192.2,   169.7,   128.4, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &      147.2,  140.6,   undef,   undef,   undef,   undef  /)         !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_peaty_shallow_leafless_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   169.7,   169.7,   130.4,   192.2,   169.7,   128.4, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &      147.2,  140.6,   undef,   undef,   undef,   undef  /)         !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is leafless.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_peaty_deep_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   191.4,   191.4,   152.1,   223.5,   191.4,   141.9, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &      159.2,  164.0,   undef,   undef,   undef,   undef  /)         !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_peaty_deep_leafless_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   191.4,   191.4,   152.1,   223.5,   191.4,   141.9, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &      159.2,  164.0,   undef,   undef,   undef,   undef  /)         !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is leafless.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_peaty_average_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   178.9,   178.9,   133.4,   195.9,   178.9,  131.4, &  !! This is derived from the generic soil type (free_draining mineral soils;
+  &     162.0,   143.8,   undef,   undef,   undef,   undef  /)         !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_peaty_average_leafless_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   178.9,   178.9,   133.4,   195.9,   178.9,  131.4, &  !! This is derived from the generic soil type (free_draining mineral soils;
+  &     162.0,   143.8,   undef,   undef,   undef,   undef  /)         !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is leafless.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_peat_shallow_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   193.0,   193.0,   148.3,  218.6,  193.0,   146.0, &   !! This is derived from the generic soil type (free_draining mineral soils;
+  &     167.4,   159.9,   undef,   undef,  undef,  undef  /)           !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_peat_shallow_leafless_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   193.0,   193.0,   148.3,   218.6, 193.0,   146.0, &   !! This is derived from the generic soil type (free_draining mineral soils;
+  &     167.4,   159.9,   undef,   undef,   undef, undef  /)           !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is leafless.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_peat_deep_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   224.4,  224.4,  173.1,   254.2,  224.4,  170.4, &     !! This is derived from the generic soil type (free_draining mineral soils;
+  &     194.7,   186.6,  undef,  undef,   undef,  undef  /)            !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_peat_deep_leafless_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,  224.4,   224.4,  173.1,  254.2,  224.4,   170.4, &     !! This is derived from the generic soil type (free_draining mineral soils;
+  &     194.7,  186.6,   undef,  undef,  undef,  undef  /)             !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is leafless.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_peat_average_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,   196.9,   196.9,   151.8,   223.0,   196.9,   149.4, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &     170.8,   163.6,   undef,   undef,   undef,   undef  /)         !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is in leaf.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: overturning_peat_average_leafless_mtc  =  &  !! Overturning moment multiplier @tex $(Nm/kg)$ @endtex.
+  & (/  undef,  196.9,   196.9,   151.8,   223.0,   196.9,    149.4, & !! This is derived from the generic soil type (free_draining mineral soils;
+  &     170.8,  163.6,   undef,   undef,   undef,   undef  /)          !! Gleyed mineral soils; Peaty mineral soils; Deep peats) and the soil depth
+                                                                       !! (shallow, deep, average). Used in the calculation of the critical wind speed
+                                                                       !! according to the GALES (Hale et al. 2015) model.
+                                                                       !! In this case, the tree is leafless.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: max_damage_further_mtc = & !! A tunning parameter for determining wind damage rate/level @text $(unitless)$ @endtex.  
+  & (/    undef,   0.8,   0.8,   0.8,   0.8,   0.8,   0.8, &           !! The value of this tunning parameter is suggested by filed observation data for
+  &       0.8,   0.8,  undef,   undef,   undef, undef /)               !! different PFTs.
+  
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: max_damage_closer_mtc = &  !! A tunning parameter for determining wind damage rate/level @text $(unitless)$ @endtex. 
+  & (/    undef,   0.8,   0.8,   0.8,   0.8,   0.8,   0.8, &           !! The value of this tunning parameter is suggested by filed observation data for
+  &       0.8,   0.8,  undef,   undef,  undef, undef /)                !! different PFTs.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: sfactor_further_mtc  =  &  !! A tunning parameter for determining wind damage rate/level @text $(unitless)$ @endtex. 
+  & (/    undef,   0.8,   0.8,   0.8,   0.8,   0.8,   0.8, &           !! The value of this tunning parameter is suggested by filed observation data for
+  &       0.8,   0.8,  undef,   undef,  undef,  undef /)               !! different PFTs.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: sfactor_closer_mtc  =  &   !! A tunning parameter for determining wind damage rate/level @text $(unitless)$ @endtex. 
+  & (/    undef,   0.8,   0.8,   0.8,   0.8,   0.8,   0.8, &           !! The value of this tunning parameter is suggested by filed observation data for
+  &       0.8,   0.8,  undef,  undef,  undef,  undef /)                !! different PFTs.
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: green_density_mtc  =  &    !! The green wood density of the meta classes sepcies @text $(kg/m^3)$ @endtex.
+  & (/    undef,  1007.,   1007.,   985.,  1060., 1007., 990.,    &    !!  
+  &       968.,    900.,   undef,  undef,  undef, undef /)             !! 
+
+  !
+  ! FIRE (stomate)
+  !
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: flam_mtc  =  &         !! flamability: critical fraction of water 
+  & (/  undef,   0.15,   0.25,   0.25,   0.25,   0.25,   0.25,  &  !! holding capacity (0-1, unitless)
+  &      0.25,   0.25,   0.25,   0.25,   0.35,   0.35  /)
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: resist_mtc  =  &       !! fire resistance (0-1, unitless)
+  & (/ undef,   0.95,   0.90,   0.90,   0.90,   0.90,   0.90,  &
+  &    0.90,    0.90,    0.0,    0.0,    0.0,    0.0 /) 
+
+
+  !
+  ! FLUX - LUC
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_1_mtc  =  &   !! Coeff of biomass export for the year
+  & (/  undef,   0.897,   0.897,   0.597,   0.597,   0.597,   0.597,  &   !! (0-1, unitless)
+  &     0.597,   0.597,   1.000,   1.000,   1.000,   1.000  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_10_mtc  =  &  !! Coeff of biomass export for the decade 
+  & (/  undef,   0.103,   0.103,   0.299,   0.299,   0.299,   0.299,  &   !! (0-1, unitless)
+  &     0.299,   0.299,   0.000,   0.000,   0.000,   0.000  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_100_mtc  =  & !! Coeff of biomass export for the century
+  & (/  undef,     0.0,     0.0,   0.104,   0.104,   0.104,   0.104,  &   !! (0-1, unitless)
+  &     0.104,   0.104,     0.0,   0.000,   0.000,   0.000  /)
+
+  !
+  ! FLUX - LUC
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_s_mtc  =  &   !! Coeff of biomass export for the year
+  & (/  undef,   0.897,   0.897,   0.597,   0.597,   0.597,   0.597,  &   !! (0-1, unitless)
+  &     0.597,   0.597,   1.000,   1.000,   1.000,   1.000  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_m_mtc  =  &   !! Coeff of biomass export for the decade
+  & (/  undef,   0.103,   0.103,   0.299,   0.299,   0.299,   0.299,  &   !! (0-1, unitless)
+  &     0.299,   0.299,   0.000,   0.000,   0.000,   0.000  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_l_mtc  =  &   !! Coeff of biomass export for the century
+  & (/  undef,     0.0,     0.0,   0.104,   0.104,   0.104,   0.104,  &   !! (0-1, unitless)
+  &     0.104,   0.104,     0.0,   0.000,   0.000,   0.000  /)
+
+
+
+  !
+  ! PHENOLOGY
+  !
+  !-
+  ! 1. Stomate
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: lai_max_to_happy_mtc  =  &  !! threshold of LAI below which plant uses carbohydrate reserves
+  & (/  undef,   0.5,   0.5,   0.5,   0.5,   0.5,   0.5,  &
+  &       0.5,   0.5,   0.5,   0.5,   0.5,   0.5  /)
+
+  REAL(r_std), PARAMETER, DIMENSION (nvmc) :: lai_max_mtc  =  &          !! maximum LAI, PFT-specific 
+  & (/ undef,   7.0,   7.0,   5.0,   5.0,   5.0,   4.5,  &               !! @tex $(m^2.m^{-2})$ @endtex
+  &      4.5,   3.0,   2.5,   2.5,   5.0,   5.0  /)
+
+  INTEGER(i_std), PARAMETER, DIMENSION(nvmc) :: pheno_type_mtc  =  &     !! type of phenology (0-4, unitless)
+  & (/  0,   1,   3,   1,   1,   2,   1,  &                              !! 0=bare ground 1=evergreen,  2=summergreen, 
+  &     2,   2,   4,   4,   2,   3  /)                                   !! 3=raingreen,  4=perennial
+  !-
+  ! 2. Leaf Onset
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_gdd_crit_c_mtc  =  &    !! critical gdd, tabulated (C),
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &    !! constant c of aT^2+bT+c
+  &     undef,   undef,   320.0,   400.0,   320.0,   700.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_gdd_crit_b_mtc  =  &    !! critical gdd, tabulated (C),
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &    !! constant b of aT^2+bT+c
+  &     undef,   undef,    6.25,     0.0,    6.25,     0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_gdd_crit_a_mtc  =  &    !! critical gdd, tabulated (C),
+  & (/  undef,   undef,     undef,   undef,   undef,   undef,   undef,  &  !! constant a of aT^2+bT+c
+  &     undef,   undef,   0.03125,     0.0,  0.0315,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_moigdd_t_crit_mtc  = &  !! temperature threshold for C4 grass(C)
+  & (/  undef,   undef,     undef,   undef,   undef,   undef,   undef,  &  
+  &     undef,   undef,     undef,    22.0,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ngd_crit_mtc  =  &            !! critical ngd, tabulated. 
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &    !! Threshold -5 degrees (days)
+  &     undef,    17.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ncdgdd_temp_mtc  =  &         !! critical temperature for the ncd vs. gdd 
+  & (/  undef,   undef,   undef,   undef,   undef,     5.0,   undef,  &    !! function in phenology (C)
+  &       0.0,   5.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: hum_frac_mtc  =  &            !! critical humidity (relative to min/max) 
+  & (/  undef,   undef,   0.5,   undef,   undef,   undef,   undef, &       !! for phenology (unitless)
+  &     undef,   undef,   0.5,     0.5,     0.5,     0.5  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: hum_min_time_mtc  =  &        !! minimum time elapsed since
+  & (/  undef,   undef,   50.0,   undef,   undef,   undef,   undef,  &     !! moisture minimum (days)
+  &     undef,   undef,   36.0,    35.0,    75.0,    75.0  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tau_root_mtc  =  &            !! roots longevity (days)
+  & (/  undef,  365.,   365.,    365.,    365.,   365.,   365.,  &
+  &      365.,  365.,   365.,    365.,    365.,   365.  /)
+
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tau_sap_mtc  =  &             !! time (days)  
+  & (/  undef,   730.0,   730.0,   730.0,   730.0,   730.0,   730.0,  &
+  &     730.0,   730.0,   730.0,   730.0,   730.0,   730.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tau_leaf_mtc  =  &            !! leaf longevity (days)
+  & (/  undef,   730.,   180.,    910.,   730.,   160.62,   910.,  &
+  &      240.,   89.57,   89.57,    120.,    90.,    90.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tau_leafinit_mtc  =  &  !! time to attain the initial foliage using the carbohydrate reserve
+  & (/  undef,   10.,   10.,   10.,   10.,   10.,   10.,  &
+  &       10.,   10.,   10.,   10.,   10.,   10.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tau_fruit_mtc  =  &           !! fruit lifetime (days)
+  & (/  undef,  90.0,    90.0,    90.0,    90.0,   90.0,   90.0,  &
+  &      90.0,  90.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ecureuil_mtc  =  &            !! fraction of primary leaf and root allocation
+  & (/  undef,   0.0,   1.0,   0.0,   0.0,   1.0,   0.0,  &                !! put into reserve (0-1, unitless)
+  &       1.0,   1.0,   1.0,   1.0,   1.0,   1.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alloc_min_mtc  =  &           !! NEW - allocation above/below = f(age) 
+  & (/  undef,   0.2,     0.2,     0.2,     0.2,    0.2,   0.2,  &         !! - 30/01/04 NV/JO/PF
+  &       0.2,   0.2,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alloc_max_mtc  =  &           !! NEW - allocation above/below = f(age) 
+  & (/  undef,   0.8,     0.8,     0.8,     0.8,    0.8,   0.8,  &         !! - 30/01/04 NV/JO/PF
+  &       0.8,   0.8,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: demi_alloc_mtc  =  &          !! NEW - allocation above/below = f(age) 
+  & (/  undef,   5.0,     5.0,     5.0,     5.0,    5.0,   5.0,  &         !! - 30/01/04 NV/JO/PF
+  &       5.0,   5.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leaflife_mtc  =  &            !! leaf longevity, tabulated (??units??)
+  & (/  undef,   0.5,   2.0,   0.33,   1.0,   2.0,   0.33,  &
+  &       2.0,   2.0,   2.0,   2.0,    2.0,   2.0  /)
+  !-
+  ! 3. Senescence
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leaffall_mtc  =  &             !! length of death of leaves, tabulated (days)
+  & (/  undef,   undef,   10.0,   undef,   undef,   30.0,   undef,  &
+  &      5.0,    10.0,   10.0,    10.0,    10.0,   10.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leafagecrit_mtc  =  &          !! critical leaf age, tabulated (days)
+  & (/  undef,   730.0,   180.0,   910.0,   730.0,   180.0,   910.0,  &
+  &     220.0,   120.0,    80.0,   120.0,    90.0,    90.0  /)
+
+  CHARACTER(LEN=6), PARAMETER, DIMENSION(nvmc) :: senescence_type_mtc  =  & !! type of senescence, tabulated (unitless)
+  & (/  'none  ',  'none  ',   'dry   ',  'none  ',  'none  ',  &
+  &     'cold  ',  'none  ',   'cold  ',  'cold  ',  'mixed ',  &
+  &     'mixed ',  'crop  ',   'crop  '            /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescence_hum_mtc  =  &       !! critical relative moisture availability
+  & (/  undef,   undef,   0.3,   undef,   undef,   undef,   undef,  &       !! for senescence (0-1, unitless)
+  &     undef,   undef,   0.2,     0.2,     0.3,     0.2  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: nosenescence_hum_mtc  =  &     !! relative moisture availability above which 
+  & (/  undef,   undef,   0.8,   undef,   undef,   undef,   undef,  &       !! there is no humidity-related senescence
+  &     undef,   undef,   0.6,     0.3,     0.3,     0.3  /)                !! (0-1, unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: max_turnover_time_mtc  =  &    !! maximum turnover time for grasses (days)
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &
+  &     undef,   undef,    80.0,    80.0,    80.0,    80.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: min_turnover_time_mtc  =  &    !! minimum turnover time for grasses (days)
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &
+  &     undef,   undef,    10.0,    10.0,    10.0,    10.0  /)
+ 
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: recycle_leaf_mtc = &           !! Fraction of N leaf that is recycled when leaves are senescent
+  & (/  undef,     0.5,     0.5,     0.5,     0.5,     0.5,     0.5,  &
+  &       0.5,     0.5,     0.5,     0.5,     0.5,     0.5  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: recycle_root_mtc = &           !! Fraction of N leaf that is recycled when leaves are senescent
+  & (/  undef,     0.2,     0.2,     0.2,     0.2,     0.2,     0.2,  &
+  &       0.2,     0.2,     0.2,     0.2,     0.2,     0.2  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: min_leaf_age_for_senescence_mtc  =  &  !! minimum leaf age to allow 
+  & (/  undef,   undef,   90.0,   undef,   undef,   90.0,   undef,  &               !! senescence g (days)
+  &      60.0,    60.0,   30.0,    30.0,    30.0,   30.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescence_temp_c_mtc  =  &    !! critical temperature for senescence (C)
+  & (/  undef,   undef,    undef,   undef,   undef,   16.0,   undef,  &     !! constant c of aT^2+bT+c, tabulated
+  &       14.0,     10.0,   5.0,     5.0,    5.0,    10.0  /)              !! (unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescence_temp_b_mtc  =  &    !! critical temperature for senescence (C), 
+  & (/  undef,   undef,   undef,   undef,   undef,   0.0,   undef,  &       !! constant b of aT^2+bT+c, tabulated
+  &       0.0,     0.0,     0.1,     0.0,     0.0,   0.0  /)                !! (unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescence_temp_a_mtc  =  &    !! critical temperature for senescence (C), 
+  & (/  undef,   undef,     undef,   undef,   undef,   0.0,   undef,  &     !! constant a of aT^2+bT+c, tabulated
+  &       0.0,     0.0,   0.00375,     0.0,     0.0,   0.0  /)              !! (unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: gdd_senescence_mtc  =  &       !! minimum gdd to allow senescence of crops (days)
+  & (/  undef,   undef,    undef,   undef,     undef,    undef,    undef,  &
+  &     undef,   undef,    undef,   undef,      950.,    4000.  /)
+
+  !-
+  ! 4. N cycle
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cn_leaf_min_mtc  = &            !! minimum CN ratio of leaves 
+  & (/  undef,     16.,      16.,     28.,       16.,      16.,      28., &  !! (gC/gN)
+  &       16.,     16.,      16.,     16.,       16.,      16.   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cn_leaf_max_mtc  = &            !! maximum CN ratio of leaves 
+ & (/   undef,     45.,      45.,     75.,       45.,      45.,      75.,  & !! (gC/gN) 
+ &        45.,     45.,      45.,     45.,       45.,      45.   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: max_soil_n_bnf_mtc   = &        !! Value of total N (NH4+NO3) 
+ & (/     0.0,     1.5,      1.5,     1.5,       1.5,      1.5,      1.5,  & 
+ &        1.5,     1.5,       2.,      2.,        2.,       2.   /)          !! above which we stop adding N via BNF
+                                                                             !! (gN/m**2)
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: manure_pftweight_mtc = &        !! Weight of the distribution of manure over the PFT surface
+ & (/   0.,     0.,      0.,     0.,       0.,      0.,      0.,  &          !!(to a same number correspond the same concentration) 
+ &        0.,     0.,      1.,     1.,       1.,      1.   /)
+
+
+  !
+  ! DGVM
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: residence_time_mtc  =  &    !! residence time of trees (years)
+  & (/  undef,   500.0,   500.0,   500.0,   500.0,   500.0,   500.0,  &
+  &      500.0,   500.0,    0.0,    0.0,    0.0,    0.0  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tmin_crit_mtc  =  &
+  & (/  undef,     0.0,     0.0,   -30.0,   -14.0,   -30.0,   -45.0,  &  !! critical tmin, tabulated (C)
+  &     -45.0,   undef,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tcm_crit_mtc  =  &
+  & (/  undef,   undef,   undef,     5.0,    15.5,    15.5,   -8.0,  &   !! critical tcm, tabulated (C)
+  &      -8.0,    -8.0,   undef,   undef,   undef,   undef  /)
+
+REAL(r_std), PARAMETER, DIMENSION(nvmc) :: mortality_min_mtc = &       !! Asymptotic mortality if plant growth exceeds long term
+  & (/  undef,  0.01,  0.01,  0.01,  0.01,  0.01,  0.01,  &               !! NPP (thus a strongly growing PFT)
+  &      0.01,  0.01,  0.01,  0.01,  0.01,  0.01  /)                      !! @tex $(year^{-1})$ @endtex
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: mortality_max_mtc = &       !! Maximum mortality if plants hardly grows thus 
+  & (/  undef,  0.1,  0.1,  0.1,  0.1,  0.1,  0.1,  &                      !! NPP << NPPlongterm @tex $(year^{-1})$ @endtex
+  &       0.1,  0.1,  0.1,  0.1,  0.1,  0.1  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ref_mortality_mtc = &       !! Reference mortality rate used to calculate mortality
+  & (/  undef,  0.035,  0.035,  0.035,  0.035,  0.035,  0.035,  &        !! as a function of the plant vigor 
+  &     0.035,  0.035,  0.035,  0.035,  0.035,  0.035  /)                !! @tex $(year^{-1})$ @endtex
+
+  !
+  ! Biogenic Volatile Organic Compounds
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_isoprene_mtc = &     !! Isoprene emission factor 
+  & (/  0.,    24.,   24.,    8.,   16.,   45.,   8.,  &                    !!
+  &    18.,    0.5,   12.,   18.,    5.,    5.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_monoterpene_mtc = &  !! Monoterpene emission factor
+  & (/   0.,   2.0,    2.0,   1.8,    1.4,    1.6,    1.8,  &               !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &    1.4,    1.8,    0.8,   0.8,    0.22,     0.22  /)
+
+  REAL(r_std), PARAMETER :: LDF_mono_mtc = 0.6                                  !! monoterpenes fraction dependancy to light
+  REAL(r_std), PARAMETER :: LDF_sesq_mtc = 0.5                                  !! sesquiterpenes fraction dependancy to light
+  REAL(r_std), PARAMETER :: LDF_meth_mtc = 0.8                                  !! methanol fraction dependancy to light
+  REAL(r_std), PARAMETER :: LDF_acet_mtc = 0.2                                  !! acetone fraction dependancy to light
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_apinene_mtc = &      !! Alfa pinene emission factor percentage
+  & (/   0.,   0.395,   0.395,   0.354,   0.463,   0.326,   0.354, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.316,   0.662,   0.231,   0.200,   0.277,   0.277 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_bpinene_mtc = &      !! Beta pinene emission factor  percentage      
+  & (/   0.,   0.110,   0.110,   0.146,   0.122,   0.087,   0.146, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.063,   0.150,   0.123,   0.080,   0.154,   0.154  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_limonene_mtc = &     !! Limonene emission factor percentage
+  & (/   0.,   0.092,   0.092,   0.083,   0.122,   0.061,   0.083, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.071,   0.037,   0.146,   0.280,   0.092,   0.092  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_myrcene_mtc = &      !! Myrcene emission factor percentage
+  & (/   0.,   0.073,   0.073,   0.050,   0.054,   0.028,   0.050, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.019,   0.025,   0.062,   0.057,   0.046,   0.046  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_sabinene_mtc = &     !! Sabinene emission factor percentage
+  & (/   0.,   0.073,   0.073,   0.050,   0.083,   0.304,   0.050, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.263,   0.030,   0.065,   0.050,   0.062,   0.062  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_camphene_mtc = &     !! Camphene emission factor percentage
+  & (/   0.,   0.055,   0.055,   0.042,   0.049,   0.004,   0.042, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.005,   0.023,   0.054,   0.053,   0.031,   0.031  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_3carene_mtc = &      !! 3-carene emission factor percentage
+  & (/   0.,   0.048,   0.048,   0.175,   0.010,   0.024,   0.175, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.013,   0.042,   0.065,   0.057,   0.200,   0.200  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_tbocimene_mtc = &    !! T-beta-ocimene emission factor percentage
+  & (/   0.,   0.092,   0.092,   0.054,   0.044,   0.113,   0.054, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.105,   0.028,   0.138,   0.120,   0.031,   0.031  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_othermonot_mtc = &   !! Other monoterpenes emission factor percentage
+  & (/   0.,   0.062,   0.062,   0.046,   0.054,   0.052,   0.046, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.144,   0.003,   0.115,   0.103,   0.108,   0.108  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_sesquiterp_mtc = &   !! Sesquiterpene emission factor
+  & (/   0.,  0.45,   0.45,   0.13,   0.30,   0.36,   0.15, &               !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &    0.30,  0.25,   0.60,   0.60,   0.08,   0.08  /)
+
+  REAL(r_std), PARAMETER :: beta_mono_mtc = 0.10                            !! Monoterpenes temperature dependency coefficient 
+  REAL(r_std), PARAMETER :: beta_sesq_mtc = 0.17                            !! Sesquiterpenes temperature dependency coefficient 
+  REAL(r_std), PARAMETER :: beta_meth_mtc = 0.08                            !! Methanol temperature dependency coefficient 
+  REAL(r_std), PARAMETER :: beta_acet_mtc = 0.10                            !! Acetone temperature dependency coefficient 
+  REAL(r_std), PARAMETER :: beta_oxyVOC_mtc = 0.13                          !! Other oxygenated BVOC temperature dependency coefficient 
+
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_ORVOC_mtc = &        !! ORVOC emissions factor 
+  &  (/  0.,    1.5,    1.5,    1.5,    1.5,   1.5,    1.5,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &     1.5,    1.5,    1.5,    1.5,    1.5,   1.5  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_OVOC_mtc = &         !! OVOC emissions factor 
+  &  (/  0.,    1.5,    1.5,    1.5,    1.5,   1.5,    1.5,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &     1.5,    1.5,    1.5,    1.5,    1.5,   1.5  /)
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_MBO_mtc = &          !! MBO emissions factor
+  & (/     0., 2.e-5, 2.e-5,   1.4, 2.e-5, 2.e-5, 0.14,  &                  !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &     2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5  /)  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_methanol_mtc = &     !! Methanol emissions factor 
+  & (/  0.,    0.8,   0.8,   1.8,   0.9,   1.9,   1.8,  &                   !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &    1.8,    1.8,   0.7,   0.9,    2.,     2.  /)  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_acetone_mtc = &      !! Acetone emissions factor
+  & (/  0.,   0.25,   0.25,   0.30,   0.20,   0.33,   0.30,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.25,   0.25,   0.20,   0.20,   0.08,   0.08  /)
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_acetal_mtc = &       !! Acetaldehyde emissions factor 
+  & (/  0.,   0.2,    0.2,     0.2,   0.2,   0.25,   0.25,   0.16,   &      !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.16,   0.12,   0.12,   0.035,   0.020  /)  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_formal_mtc = &       !! Formaldehyde emissions factor
+  & (/  0.,   0.04,   0.04,  0.08,    0.04,    0.04,  0.04,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.04,   0.04,  0.025, 0.025,   0.013,   0.013  /)  
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_acetic_mtc = &       !! Acetic Acid emissions factor
+  & (/   0.,   0.025,   0.025,   0.025,   0.022,   0.08,   0.025,   &      !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.022,   0.013,   0.012,   0.012,   0.008,   0.008  /)  
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_formic_mtc = &       !! Formic Acid emissions factor
+  & (/  0.,  0.015,  0.015,   0.02,    0.02,   0.025,  0.025,  &            !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &  0.015,  0.015,  0.010,  0.010,   0.008,   0.008  /)  
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: em_factor_no_wet_mtc = &        !! NOx emissions factor soil emissions and exponential
+  & (/  0.,   2.6,   0.06,   0.03,   0.03,   0.03,   0.03,  &               !! dependancy factor for wet soils
+  &  0.03,   0.03,   0.36,   0.36,   0.36,   0.36  /)                       !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: em_factor_no_dry_mtc = &        !! NOx emissions factor soil emissions and exponential
+  & (/  0.,   8.60,   0.40,   0.22,   0.22,   0.22,   0.22,  &              !! dependancy factor for dry soils
+  &   0.22,   0.22,   2.65,   2.65,   2.65,   2.65  /)                      !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
+
+  !
+  ! MORTALITY (stomate)
+  !
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: death_distribution_factor_mtc = &    !!  The scale factor between the smallest and largest
+       (/ undef,  100.,  100.,  100.,  100.,  100.,  100.,  &                     !! circ class for tree mortality in stomate_mark_kill.
+            100.,  100., undef, undef, undef, undef /)                            !! (unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: npp_reset_value_mtc = &  !! The value of the NPP that the long-term value is
+       (/ undef,  undef,  undef,  undef,  undef,  undef,  undef,  &   !! reset to after a PFT dies in stomate_kill.  This
+          undef,  undef,   500.,   500.,   500.,   500. /)            !! only seems to be used for non-trees.
+                                                                      !! @tex $(gC m^{-2})$ @endtex 
+
+  !
+  ! ALLOCATION and related
+  !
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: Larch_mtc = &                  !! Larcher 1991 SAI/LAI ratio (unitless)
+  & (/   0.,   0.015,   0.015,   0.003,   0.005,   0.005,   0.003,  &
+  &   0.005,   0.003,   0.005,   0.005,   0.008,   0.008  /)  
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: k_latosa_max_mtc = &  !! Maximum leaf-to-sapwood area ratio as defined in McDowell et al
+  & (/ undef,  5000.,  5000.,  5000.,  3000.,  5000.,  5000.,  &   !! 2002, Oecologia and compiled in Hickler et al 2006, Appendix S2 
+  &    5000.,  5000.,  0.833,  0.833,  0.833,  0.833 /)                      !! The values for grasses and crops are tuned. More work is needed
+                                                                   !! to fully justify this approach for the herbacuous PFTs (unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: k_latosa_min_mtc = &  !! Minimum leaf-to-sapwood area ratio as defined in McDowell et al
+  & (/ undef,  5000.,  5000.,  5000.,  3000.,  5000.,  5000.,  &   !! 2002, Oecologia and compiled in Hickler et al 2006, Appendix S2 
+  &    5000.,  5000.,  0.833,  0.833,  0.833,  0.833  /)           !! The values for grasses and crops are tuned. More work is needed
+                                                                   !! to fully justify this approach for the herbacuous PFTs (unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: lai_to_height_mtc = &                    !! Convertion from lai to height for grasses
+  &(/ undef, undef, undef, undef, undef, undef, undef, &                              !! and cropland. Convert lai because that way a dynamic
+  &   undef, undef,   0.1,   0.2,   0.1,   0.2 /)                                     !! sla is accounted for  
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: deleuze_a_mtc = &                          !! intercept of the intra-tree competition within a stand
+  & (/ undef,  0.23,  0.23,  0.23,  0.23,  0.23,  0.23, &                               !! based on the competion rule of Deleuze and Dhote 2004
+  &     0.23,  0.23, undef, undef, undef, undef /)                                      !! Used when n_circ > 6
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: deleuze_b_mtc = &                          !! slope of the intra-tree competition within a stand
+  & (/ undef,  0.58,  0.58,  0.58,  0.58,  0.58,  0.58, &                               !! based on the competion rule of Deleuze and Dhote 2004
+  &     0.58,  0.58, undef, undef, undef, undef /)                                      !! Used when n_circ > 6
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: deleuze_p_all_mtc = &                      !! Percentile of the circumferences that receives photosynthates
+  & (/ undef,  0.50,  0.50,  0.70,  0.70,  0.70,  0.70, &                               !! based on the competion rule of Deleuze and Dhote 2004
+  &     0.70,  0.70, undef, undef, undef, undef /)                                      !! Used when n_circ > 6 for FM1, FM2 and FM4
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: deleuze_p_coppice_mtc = &                  !! Percentile of the circumferences that receives photosynthates
+  & (/ undef,  0.50,  0.50,  0.50,  0.50,  0.50,  0.50, &                               !! based on the competion rule of Deleuze and Dhote 2004
+  &     0.50,  0.50, undef, undef, undef, undef /)                                      !! Used when n_circ > 6 for FM3
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: deleuze_power_mtc = &                      !! Divisor of the power for the slope of intra-tree
+  & (/ undef,  2.0,  2.0,  2.0,  2.0,  2.0,  2.0, &                                     !! competition whithin a stand
+  &     2.0,  2.0, undef, undef, undef, undef /)                                        !! based on the competition rule of Deleuze and Dhote 2004
+
+
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: m_dv_mtc = &                               !! Parameter in the Deleuze & Dhote allocation 
+  & (/ undef,  1.05,  1.05,  1.05,  1.05,  1.05,  1.05, &                               !! rule that relaxes the cut-off imposed by
+  &     1.05,  1.05,    0.,    0.,    0.,    0. /)                                      !! ::sigma. Owing to m_relax trees still grow
+                                                                                        !! a little when their ::circ is below ::sigma
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: fruit_alloc_mtc = &   !! Fraction of biomass allocated to fruit production (0-1)
+  & (/ undef,   0.1,    0.1,    0.1,     0.1,     0.1,    0.1, &   !! currently only parameterized for forest PFTs 
+  &      0.1,   0.1,     0.,     0.,      0.,      0. /)  
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: frac_growthresp_res_lim_mtc = &          !! Fraction of growth respiration expressed as 
+  &(/  0.28,   0.28,   0.28,   0.28,   0.28,   0.28,   0.28, &                        !! share of the total C that is to be allocated
+  &    0.28,   0.28,   0.28,   0.28,   0.28,   0.28 /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: frac_growthresp_fun_all_mtc = &          !! Fraction of growth respiration expressed as
+  &(/  0.28,   0.28,   0.28,   0.28,   0.28,   0.28,   0.28, &                        !! share of the total C that is to be allocated
+  &    0.28,   0.28,   0.28,   0.28,   0.28,   0.28 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: labile_reserve_mtc = &                   !! The lab_fac is divided by this value to obtain 
+  &(/  0.,  60.,  30.,  60.,  60.,  30.,  60., &                                      !! a new parameter. This new parameter is a fraction 
+  &    30.,  30.,  30.,  30.,  30.,  30.  /)                                          !! that is multiplied with the plant biomass to obatin 
+                                                                                      !! the optimal size of the labile pool. The dependency
+                                                                                      !! on lab_fac is a nice feature but the whole 
+                                                                                      !! parameterization is arbitrary
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cn_leaf_prescribed_mtc = &  !! C/N of leaves according to stich et al 2003
+  & (/ undef,  29.,  29.,  29.,  29.,  29.,  29.,  &
+  &      29.,  29.,  29.,  29.,  29.,  29.   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: evergreen_reserve_mtc = &                !! Fraction of sapwood mass stored in the reserve pool of evergreen 
+  &(/ undef, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, &                                    !! trees (unitless, 0-1)
+  &    0.05,  0.05, 0.05, 0.05, 0.05, 0.05 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescense_reserve_mtc = &               !! Fraction of sapwood mass stored in the reserve pool of deciduous 
+  &(/ undef, 0.15, 0.15, 0.15, 0.15, 0.15, 0.15, &                                    !! trees during senescense(unitless, 0-1)
+  &    0.15,  0.15, 0.15, 0.15, 0.15, 0.15 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: deciduous_reserve_mtc = &                !! Fraction of sapwood mass stored in the reserve pool of deciduous 
+  &(/ undef, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, &                                    !! trees during the growing season (unitless, 0-1) 
+  &    0.12,  0.12, 0.12, 0.12, 0.12, 0.12 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: fcn_root_mtc = &      !! N/C of "root" for allocation relative to leaf N/C  according 
+  & (/ undef,   .86,    .86,    .86,    .86,    .86,   .86,   &    !! to stich et al 2003
+  &      .86,   .86,    .86,    .86,    .86,    .86   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: fcn_wood_mtc = &      !! N/C of "wood" for allocation relative to leaf N/C  according 
+  & (/ undef,    .087,   .087,   .087,   .087,   .087,  .087,  &   !! to stich et al 2003
+  &     .087,    .087,     1.,     1.,     1.,     1.   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cn_leaf_init_mtc = &  !! C/N of leaves according to stich et al 2003
+   & (/ undef,  29.,  29.,  29.,  29.,  29.,  29.,  &
+   &      29.,  29.,  29.,  29.,  29.,  29.   /)
+!asla To use for impose_CN=yes test cases 
+!asla  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cn_leaf_init_mtc  = &            !! minimum CN ratio of leaves 
+!asla  & (/  undef,     16.,      16.,     28.,       16.,      16.,      28., &  !!(gC/gN)
+!asla  &       16.,     16.,      16.,     16.,       16.,      16.   /)
+
+
+  !
+  ! CROP MANAGEMENT
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: harvest_ratio_mtc = &                      !! Share of biomass that is removed from the site during harvest
+  & (/ undef,  undef,  undef,  undef,  undef,  undef,  undef, &                         !! A high value indicates a high harvest efficiency and thus a 
+  &    undef,  undef,  undef,  undef,    0.5,    0.5 /)                                 !! input of residuals. (unitless, 0-1). 
+
+  !
+  ! FOREST MANAGEMENT
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: h_first_mtc = &                            !! Height at which thinning will start (m)            
+  & (/   0.0,   10.0,   10.0,   10.0,   10.0,   10.0,  10.0,   &
+  &     10.0,   10.0,    0.0,    0.0,    0.0,    0.0   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: dens_target_mtc =  &                       !! Minimal density. Below this density the forest
+  & (/   0.0,   100.0,   100.0,   200.0,   100.0,   100.0,   300.0,  &                  !! will be clearcut (trees.ha-1)
+  &    100.0,   200.0,     0.0,     0.0,     0.0,     0.0   /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: thinstrat_mtc =  &                         !! Thinning strategy. The FM code distinguished
+  & (/   0.0,   1.0,   1.0,   1.0,   1.0,   1.0,   1.0,  &                              !! thinning from above (<0) or from below (>0).  
+  &    1.0,   1.0,     0.0,     0.0,     0.0,     0.0   /)                              
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: taumin_mtc =  &                            !! Minimum probability that a tree get thinned (unitless)
+  & (/   0.0,   0.01,   0.01,   0.01,   0.01,   0.01,   0.01,  &
+  &    0.01,   0.01,     0.0,     0.0,     0.0,     0.0   /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: taumax_mtc =  &                            !! Maximum probability that a tree get thinned (unitless)
+  & (/   0.0,   0.05,   0.05,   0.05,   0.05,   0.05,   0.05,  &
+  &    0.05,   0.05,     0.0,     0.0,     0.0,     0.0   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alpha_rdi_upper_mtc = &                    !! Coefficient of the yield-table derived thinning relationship 
+  &(/ undef,  3000.,  3000.,  592.,  862.,  504.,  1287., &                             !! D=alpha*N^beta estimated from JRC yield table database 
+  &    984.,   589.,  undef,  undef,  undef,  undef/)                                  
+ 
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: beta_rdi_upper_mtc = &                     !! Coefficient of the yield-table derived thinning relationship 
+  &(/ undef,  -0.57,  -0.57,  -0.46,  -0.51,  -0.44,  -0.59, &                          !! D=alpha*N^beta estimated from JRC yield table database 
+  &   -0.57,  -0.48,  undef,  undef,  undef,  undef/)                                   
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alpha_rdi_lower_mtc = &                    !! Coefficient of the yield-table derived thinning relationship 
+  &(/ undef,  2999.,  2999.,  433.,  445.,  369.,  1022., &                             !! D=alpha*N^beta estimated from JRC yield table database 
+  &    828.,   385.,  undef,  undef,  undef,  undef/)                                  
+ 
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: beta_rdi_lower_mtc = &                     !! Coefficient of the yield-table derived thinning relationship 
+  &(/ undef,  -0.57,  -0.57,  -0.46,  -0.51,  -0.44,  -0.59, &                          !! D=alpha*N^beta estimated from JRC yield table database 
+  &   -0.57,  -0.48,  undef,  undef,  undef,  undef/) 
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: largest_tree_dia_mtc =  &                  !! Maximal tree diameter (m). If this diameter is exceeded a
+  & (/   0.0,   .45,   .45,   .45,   .45,   .45,   .45,  &                              !! a clearcut will happen.
+  &   .45,    .45,     0.0,     0.0,     0.0,     0.0   /) 
+
+   REAL(r_std), PARAMETER, DIMENSION(nvmc) :: fuelwood_diameter_mtc = &                !! Diameter below which the wood harvest is used as fuelwood (m)
+  &(/ undef,   0.3,   0.3,   0.2,   0.3,   0.3,   0.2, &                              !! Affects the way the wood is used in the dim_product_use   
+  &     0.2,   0.2, undef, undef, undef, undef/)                                      !! subroutine 
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coppice_kill_be_wood_mtc = &             !! The fraction of the belowground wood killed during coppicing.
+  &(/ undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0, &                              !! (unitless)
+  &     0.0,   0.0, undef, undef, undef, undef/) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: branch_ratio_mtc =  &                      !! Ratio of branches to total woody biomass (unitless)
+  & (/  0.0,   0.38,   0.38,   0.25,   0.38,   0.38,   0.25,  &
+  &    0.38,   0.25,    0.0,    0.0,    0.0,    0.0 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: branch_harvest_mtc =  &                    !! Ratio of branches harvested in FM2 management.
+  & (/  0.0,   1.0,   1.0,   1.0,   1.0,   1.0,   1.0,  &
+  &    1.0,   1.0,    0.0,    0.0,    0.0,    0.0 /)
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coppice_diameter_mtc = &                   !! The trunk diameter above which one coppices
+  & (/ undef,  0.20,  0.20,  0.20,  0.20,  0.20,  0.20, &                               !! trees. (m)
+  &     0.20,  0.20,    0.,    0.,    0.,    0. /)                                      
+  INTEGER(i_std), PARAMETER, DIMENSION(nvmc) :: shoots_per_stool_mtc = &                !! The number of shoots which regrow on a stool after
+  (/ 9999,  6,     6,     6,      6,     6,     6, &                                    !! coppicing. 
+  6,  6, 9999, 9999,  9999, 9999 /)   
+  INTEGER(i_std), PARAMETER, DIMENSION(nvmc) :: src_rot_length_mtc = &                  !! The number of years between SRC cuttings.
+  (/ 9999,   3,     3,     3,     3,     3,     3, &                                    !! (-)
+  3,   3, 9999, 9999, 9999, 9999 /)                            
+  INTEGER(i_std), PARAMETER, DIMENSION(nvmc) :: src_nrots_mtc = &                       !! The number of SRC rotations before the whole stand
+  (/ 9999,   10,    10,    10,    10,    10,    10, &                                   !! is harvested (-)
+  10,  10, 9999, 9999, 9999, 9999 /)
+
+
+
+  !
+  ! HYDRAULIC ARCHITECTURE
+  ! 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: k_root_mtc = &        !! Fine root specific conductivity. Values compiled in T. Hickler     
+  & (/ undef,    4.,    4.,   4.,   4.,   4.,   4.,       &        !! et al. 2006. @tex $(m^{3} kg^{-1} s^{-1} MPa^{-1})$ @endtex    
+  &       4.,    4.,   50.,  50.,  50.,  50.   /)*1.e-7         
+                                                                       
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: k_sap_mtc = &         !! Maximal sapwood specific conductivity. Values compiled in T. Hickler 
+  & (/ undef,   50.,   10.,    8.,    5.,   30.,    8.,    &       !! et al. 2006. @tex $(m^{2} s^{-1} MPa^{-1})$ @endtex 
+  &      20.,    8., undef, undef, undef, undef    /)*1.e-4 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: k_leaf_mtc = &        !! Leaf conductivity. Values compiled in T. Hickler et al 2006
+  & (/ undef,  1.5,  1.5,  1.5,  1.5,  1.5,  1.5,         &        !! @tex $(m s^{-1} MPa^{-1})$ @endtex
+         1.5,  1.5,  1.5,  1.5,  1.5,  1.5         /)*1.e-7
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: psi_leaf_mtc = &      !! Minimal leaf water potential. Values in T. Hickler et al 2006
+  & (/ undef, -2.2, -2.2, -2.2, -3.5, -2.2, -2.2,   &              !! @tex $(MPa)$ @endtex
+        -2.2, -2.2, -2.2, -2.2, -2.2, -2.2        /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: psi_50_mtc = &        !! Sapwood leaf water potential that causes 50% loss of xylem
+  & (/ undef, -0.3, -1.3, -2.0, -1.7, -1.0, -2.0, &                !! conductivity through cavitation. @tex $(MPa)$ @endtex
+        -1.0, -2.0, undef, undef, undef, undef /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: c_cavitation_mtc = &  !! Shape parameter for loss of conductance Machado & Tyree, 1994
+  & (/ undef,  5.,  3.,  3.,  3.,  3.,  3.,  &                     !! (unitless)
+          3.,  3., undef, undef, undef, undef /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: psi_soil_tune_mtc = & !! Additive tuning parameter to account for soil-root interactions
+  & (/ undef,  0.,  0.,  0.,  0.,  0.,  0.,  &                     !! @tex $(MPa)$ @endtex
+          0.,  0.,  0.,  0.,  0.,  0. /)                                  
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: lai_happy_mtc = &     !! Lai threshold below which carbohydrate
+  & (/ undef,  1.,  1.,  1.,  1.,  1.,  1.,  &                     !! reserve may be used in functional allocation.
+          1.,  1.,  1.,  1.,  1.,  1. /)                           !! Also used in phenology to see if mixed classes
+                                                                   !! should die.  These seem completely arbitrary.
+                                                                   !! @tex $(m^2.m^{-2})$ @endtex
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: srl_mtc = &           !! Specific root length (m gâ»1). Values are obtained from Metcalfe 
+   & (/ undef,  10.,   10.,   9.2,  9.2,    14.,  18.3,  &         !! et al. 2008 and Ostonen et al. 2007  
+         18.3, 18.3,   18.,  18.0, 18.0,   18.0 /)         
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: r_froot_mtc = &       !! Fine root radius (m). Values are obtained from Bonan  
+   & (/ undef,  0.29E-3, 0.29E-3,  0.29E-3,  0.29E-3, &            !! et al.2014 and Ostonen et al. 2007 (Tree physiology)   
+   &  0.29E-3,  0.24E-3, 0.21E-3,  0.21E-3,  0.075E-3, &
+   &  0.075E-3,  0.18E-3,  0.18E-3 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: psi_root_mtc = &      !! The minimum root water potential. Tested by Emilie joetzjer
+   & (/ undef,  -4.,   -4.,   -4.,  -4.,   -3.,  -4.,  &           !! that -4 works for tropical PFT. Difficult to find values for 
+   &      -3., -4., -4., -4.,-4.,-4. /)                            !! this parameter. Thus for now, use -4 for all. 
+
+
+
+END MODULE constantes_mtc
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes_soil.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes_soil.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes_soil.f90	(revision 6412)
@@ -0,0 +1,361 @@
+! =================================================================================================================================
+! MODULE 	: constantes_soil
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         "constantes_soil" module contains subroutine to initialize the parameters related to soil and hydrology.
+!!
+!!\n DESCRIPTION : "constantes_soil" module contains subroutine to initialize the parameters related to soil and hydrology.
+!!                 This module alos USE constates_soil and can therfor be used to acces the subroutines and the constantes.
+!!                 The constantes declarations can also be used seperatly with "USE constantes_soil_var".
+!!
+!! RECENT CHANGE(S): 
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_soil
+
+  USE constantes_soil_var
+  USE constantes
+  USE ioipsl_para 
+
+  IMPLICIT NONE
+
+CONTAINS
+
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : config_soil_parameters
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters related to soil and hydrology. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE config_soil_parameters()
+     
+    USE ioipsl
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+
+    INTEGER(i_std), PARAMETER      :: error_level = 3         !! Switch to 2 to turn fatal errors into warnings.(1-3, unitless)
+    LOGICAL                        :: ok_freeze               !! Local variable used to set default values for all flags 
+                                                               !! controling the soil freezing scheme
+
+!_ ================================================================================================================================
+     
+    ! Following initializations are only done for option impose_param
+    IF ( ok_sechiba .AND. impose_param ) THEN
+
+    !Config Key   = DRY_SOIL_HEAT_CAPACITY
+    !Config Desc  = Dry soil Heat capacity of soils
+    !Config If    = OK_SECHIBA 
+    !Config Def   = 1.80e+6
+    !Config Help  = Values taken from : PIELKE,'MESOSCALE METEOROLOGICAL MODELING',P.384.
+    !Config Units = [J.m^{-3}.K^{-1}] 
+    CALL getin_p("DRY_SOIL_HEAT_CAPACITY",so_capa_dry)
+    
+    !! Check parameter value (correct range)
+    IF ( so_capa_dry <= zero ) THEN
+       CALL ipslerr_p(error_level, "config_soil_parameters.", &
+            &     "Wrong parameter value for DRY_SOIL_HEAT_CAPACITY.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+    
+
+    !Config Key   = DRY_SOIL_HEAT_COND
+    !Config Desc  = Dry soil Thermal Conductivity of soils
+    !Config If    = OK_SECHIBA
+    !Config Def   = 0.40 
+    !Config Help  = Values taken from : PIELKE,'MESOSCALE METEOROLOGICAL MODELING',P.384.
+    !Config Units = [W.m^{-2}.K^{-1}] 
+    CALL getin_p("DRY_SOIL_HEAT_COND",so_cond_dry)
+
+    !! Check parameter value (correct range)
+    IF ( so_cond_dry <= zero ) THEN
+       CALL ipslerr_p(error_level, "config_soil_parameters.", &
+            &     "Wrong parameter value for DRY_SOIL_HEAT_COND.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = WET_SOIL_HEAT_CAPACITY
+    !Config Desc  = Wet soil Heat capacity of soils 
+    !Config If    = OK_SECHIBA
+    !Config Def   = 3.03e+6
+    !Config Help  = 
+    !Config Units = [J.m^{-3}.K^{-1}]
+    CALL getin_p("WET_SOIL_HEAT_CAPACITY",so_capa_wet)
+
+    !! Check parameter value (correct range)
+    IF ( so_capa_wet <= zero ) THEN
+       CALL ipslerr_p(error_level, "config_soil_parameters.", &
+           &     "Wrong parameter value for WET_SOIL_HEAT_CAPACITY.", &
+           &     "This parameter should be positive. ", &
+           &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = WET_SOIL_HEAT_COND
+    !Config Desc  = Wet soil Thermal Conductivity of soils
+    !Config If    = OK_SECHIBA 
+    !Config Def   = 1.89 
+    !Config Help  = 
+    !Config Units = [W.m^{-2}.K^{-1}]
+    CALL getin_p("WET_SOIL_HEAT_COND",so_cond_wet)
+
+    !! Check parameter value (correct range)
+    IF ( so_cond_wet <= zero ) THEN
+       CALL ipslerr_p(error_level, "config_soil_parameters.", &
+           &     "Wrong parameter value for WET_SOIL_HEAT_COND.", &
+           &     "This parameter should be positive. ", &
+           &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = SNOW_HEAT_COND
+    !Config Desc  = Thermal Conductivity of snow
+    !Config If    = OK_SECHIBA  
+    !Config Def   = 0.3
+    !Config Help  = 
+    !Config Units = [W.m^{-2}.K^{-1}]
+    CALL getin_p("SNOW_HEAT_COND",sn_cond)
+
+    !! Check
+    IF ( sn_cond <= zero ) THEN
+       CALL ipslerr_p(error_level, "config_soil_parameters.", &
+           &     "Wrong parameter value for SNOW_HEAT_COND.", &
+           &     "This parameter should be positive. ", &
+           &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = SNOW_DENSITY
+    !Config Desc  = Snow density for the soil thermodynamics 
+    !Config If    = OK_SECHIBA 
+    !Config Def   = 330.0
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p("SNOW_DENSITY",sn_dens)
+    
+    !! Check parameter value (correct range)
+    IF ( sn_dens <= zero ) THEN
+      CALL ipslerr_p(error_level, "config_soil_parameters.", &
+           &     "Wrong parameter value for SNOW_DENSITY.", &
+           &     "This parameter should be positive. ", &
+           &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !! Calculation of snow capacity
+    !! If sn_dens is redefined by the user, sn_capa needs to be reset
+    sn_capa = 2100.0_r_std*sn_dens
+
+
+    !Config Key   = NOBIO_WATER_CAPAC_VOLUMETRI
+    !Config Desc  = 
+    !Config If    = OK_SECHIBA
+    !Config Def   = 150.
+    !Config Help  = 
+    !Config Units = [s/m^2]
+    CALL getin_p('NOBIO_WATER_CAPAC_VOLUMETRI',mx_eau_nobio)
+
+    ! Check parameter value (correct range)
+    IF ( mx_eau_nobio <= zero ) THEN
+       CALL ipslerr_p(error_level, "config_soil_parameters.", &
+           &     "Wrong parameter value for NOBIO_WATER_CAPAC_VOLUMETRI.", &
+           &     "This parameter should be positive. ", &
+           &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = SECHIBA_QSINT 
+    !Config Desc  = Interception reservoir coefficient
+    !Config If    = OK_SECHIBA 
+    !Config Def   = 0.1
+    !Config Help  = Transforms leaf area index into size of interception reservoir
+    !Config         for slowproc_derivvar or stomate
+    !Config Units = [m]
+    CALL getin_p('SECHIBA_QSINT',qsintcst)
+
+    !! Check parameter value (correct range)
+    IF ( qsintcst <= zero ) THEN
+       CALL ipslerr_p(error_level, "config_soil_parameters.", &
+            &     "Wrong parameter value for SECHIBA_QSINT.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    END IF ! IF ( ok_sechiba .AND. impose_param ) THEN
+
+
+
+    !! Variables related to soil freezing in thermosoil module
+    !
+    !Config Key  = OK_FREEZE
+    !Config Desc = Activate the complet soil freezing scheme
+    !Config If   = OK_SECHIBA 
+    !Config Def  = FALSE
+    !Config Help = Activate soil freezing thermal effects. Activates soil freezing hydrological effects in CWRR scheme.
+    !Config Units= [FLAG]
+
+    ! ok_freeze is a flag that controls the default values for several flags controling 
+    ! the different soil freezing processes
+    ! Set ok_freeze=true for the complete soil freezing scheme
+    ! ok_freeze is a local variable only used in this subroutine
+    ok_freeze = .FALSE.
+    CALL getin_p('OK_FREEZE',ok_freeze)
+
+
+    !Config Key  = READ_REFTEMP
+    !Config Desc = Initialize soil temperature using climatological temperature
+    !Config If   = 
+    !Config Def  = True/False depening on OK_FREEZE
+    !Config Help = 
+    !Config Units= [FLAG]
+
+    IF (ok_freeze) THEN
+       read_reftemp = .TRUE.
+    ELSE
+       read_reftemp = .FALSE.
+    END IF
+    CALL getin_p ('READ_REFTEMP',read_reftemp)
+
+    !Config Key  = OK_FREEZE_THERMIX
+    !Config Desc = Activate thermal part of the soil freezing scheme
+    !Config If   = 
+    !Config Def  = True if OK_FREEZE else false
+    !Config Help = 
+    !Config Units= [FLAG]
+
+    IF (ok_freeze) THEN
+       ok_freeze_thermix = .TRUE.
+    ELSE
+       ok_freeze_thermix = .FALSE.
+    END IF
+    CALL getin_p ('OK_FREEZE_THERMIX',ok_freeze_thermix)
+
+
+    !Config Key  = OK_ECORR
+    !Config Desc = Energy correction for freezing
+    !Config If   = OK_FREEZE_THERMIX
+    !Config Def  = True if OK_FREEZE else false
+    !Config Help = Energy conservation : Correction to make sure that the same latent heat is 
+    !Config        released and consumed during freezing and thawing
+    !Config Units= [FLAG]
+    IF (ok_freeze) THEN
+       ok_Ecorr = .TRUE.
+    ELSE
+       ok_Ecorr = .FALSE.
+    END IF
+    CALL getin_p ('OK_ECORR',ok_Ecorr)
+    IF (ok_Ecorr .AND. .NOT. ok_freeze_thermix) THEN
+       CALL ipslerr_p(3,'thermosoil_init','OK_ECORR cannot be activated without OK_FREEZE_THERMIX', &
+            'Adapt run parameters with OK_FREEZE_THERMIX=y','')
+    END IF
+
+    !Config Key = POROS
+    !Config Desc = Soil porosity 
+    !Config If = OK_SECHIBA
+    !Config Def = 0.41
+    !Config Help = From USDA classification, mean value
+    !Config Units = [-] 
+    poros=0.41
+    CALL getin_p('POROS',poros)
+
+
+    !Config Key = fr_dT
+    !Config Desc = Freezing window    
+    !Config If = OK_SECHIBA
+    !Config Def = 2.0
+    !Config Help = 
+    !Config Units = [K] 
+    fr_dT=2.0
+    CALL getin_p('FR_DT',fr_dT)
+          
+
+    !! Variables related to soil Freezing in diffuco module
+
+    !Config Key  = OK_SNOWFACT
+    !Config Desc = Activates the smoothering of landscapes by snow,
+    !       e.g. reduces of the surface roughness length when snow is present.
+    !Config If   = 
+    !Config Def  = True if OK_FREEZE else false
+    !Config Help = 
+    !Config Units= [FLAG]
+
+    IF (ok_freeze) THEN
+       ok_snowfact = .TRUE.
+    ELSE
+       ok_snowfact = .FALSE.
+    END IF
+    CALL getin_p('OK_SNOWFACT', ok_snowfact)
+
+
+    !! Variables related to soil Freezing in hydrol module
+
+    !Config Key  = OK_FREEZE_CWRR
+    !Config Desc = CWRR freezing scheme by I. Gouttevin
+    !Config If   = 
+    !Config Def  = True if OK_FREEZE else false
+    !Config Help =
+    !Config Units= [FLAG]
+
+    IF (ok_freeze) THEN
+       ok_freeze_cwrr = .TRUE.
+    ELSE
+       ok_freeze_cwrr = .FALSE.
+    END IF
+    CALL getin_p('OK_FREEZE_CWRR',ok_freeze_cwrr)
+
+
+    IF (ok_freeze_cwrr) THEN
+       !Config Key  = OK_THERMODYNAMICAL_FREEZING
+       !Config Desc = Calculate frozen fraction thermodynamically 
+       !Config If   = OK_FREEZE_CWRR
+       !Config Def  = True
+       !Config Help = Calculate frozen fraction thermodynamically if true,
+       !Config      = else calculate frozen fraction linearly 
+       !Config Units= [FLAG]
+       ok_thermodynamical_freezing = .TRUE.
+       CALL getin_p('OK_THERMODYNAMICAL_FREEZING',ok_thermodynamical_freezing)
+    END IF
+
+
+    !Config Key   = CHECK_CWRR
+    !Config Desc  = Calculate diagnostics to check CWRR water balance
+    !Config Def   = n
+    !Config If    = 
+    !Config Help  = Diagnostics from module hydrol. The verifictaions are done in post-treatement 
+    !Config Units = [FLAG]
+    check_cwrr = .FALSE.
+    CALL getin_p('CHECK_CWRR', check_cwrr)
+    
+   END SUBROUTINE config_soil_parameters
+   
+
+END MODULE constantes_soil
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes_soil_var.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes_soil_var.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes_soil_var.f90	(revision 6412)
@@ -0,0 +1,284 @@
+! =================================================================================================================================
+! MODULE 	: constantes_soil_var
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         "constantes_soil_var" module contains the parameters related to soil and hydrology.
+!!
+!!\n DESCRIPTION : The non saturated hydraulic properties are defined from the  
+!!                 formulations of van Genuchten (1980) and Mualem (1976), combined as  
+!!                 explained in d'Orgeval (2006). \n
+!!                 The related parameters for main soil textures (coarse, medium and fine if "fao", 
+!!                 12 USDA testures if "usda") come from Carsel and Parrish (1988).
+!!
+!! RECENT CHANGE(S): AD: mcw and mcf depend now on soil texture, based on Van Genuchten equations 
+!!                   and classical matric potential values, and pcent is adapted
+!!
+!! REFERENCE(S)	:
+!!- Roger A.Pielke, (2002), Mesoscale meteorological modeling, Academic Press Inc. 
+!!- Polcher, J., Laval, K., DÃŒmenil, L., Lean, J., et Rowntree, P. R. (1996).
+!! Comparing three land surface schemes used in general circulation models. Journal of Hydrology, 180(1-4), 373--394.
+!!- Ducharne, A., Laval, K., et Polcher, J. (1998). Sensitivity of the hydrological cycle
+!! to the parametrization of soil hydrology in a GCM. Climate Dynamics, 14, 307--327. 
+!!- Rosnay, P. de et Polcher, J. (1999). Modelling root water uptake in a complex land surface
+!! scheme coupled to a GCM. Hydrol. Earth Syst. Sci., 2(2/3), 239--255.
+!!- d'Orgeval, T. et Polcher, J. (2008). Impacts of precipitation events and land-use changes
+!! on West African river discharges during the years 1951--2000. Climate Dynamics, 31(2), 249--262. 
+!!- Carsel, R. and Parrish, R.: Developing joint probability distributions of soil water
+!! retention characteristics, Water Resour. Res.,24, 755â769, 1988.
+!!- Mualem Y (1976) A new model for predicting the hydraulic conductivity  
+!! of unsaturated porous media. Water Resources Research 12(3):513-522
+!!- Van Genuchten M (1980) A closed-form equation for predicting the  
+!! hydraulic conductivity of unsaturated soils. Soil Sci Soc Am J, 44(5):892-898
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_soil_var
+
+  USE defprec
+  USE vertical_soil_var
+
+  IMPLICIT NONE
+
+  LOGICAL, SAVE             :: check_cwrr              !! Calculate diagnostics to check the water balance in hydrol (true/false)
+!$OMP THREADPRIVATE(check_cwrr)
+
+  
+
+  !! Number of soil classes
+
+  INTEGER(i_std), PARAMETER :: ntext=3                  !! Number of soil textures (Silt, Sand, Clay)
+  INTEGER(i_std), PARAMETER :: nstm=3                   !! Number of soil tiles (unitless)
+  CHARACTER(LEN=30)         :: soil_classif             !! Type of classification used for the map of soil types.
+                                                        !! It must be consistent with soil file given by 
+                                                        !! SOILCLASS_FILE parameter.
+!$OMP THREADPRIVATE(soil_classif)  
+  INTEGER(i_std), PARAMETER :: nscm_fao=3               !! For FAO Classification (unitless)
+  INTEGER(i_std), PARAMETER :: nscm_usda=12             !! For USDA Classification (unitless)
+  INTEGER(i_std), SAVE      :: nscm=nscm_fao            !! Default value for nscm
+!$OMP THREADPRIVATE(nscm)
+
+  !! Soil types for stomate_windthrow
+  INTEGER(i_std), PARAMETER :: n_soil_types = 4         !! Total number of soil types used in
+                                                        !! windthrow according to
+                                                        !! referencer data
+  INTEGER(i_std), PARAMETER :: ifree_draining = 1       !! Free-draining mineral soil
+  INTEGER(i_std), PARAMETER :: igleyed = 2              !! Gleyed mineral soil
+  INTEGER(i_std), PARAMETER :: ipeaty = 3               !! Peaty mineral soil
+  INTEGER(i_std), PARAMETER :: ipeat = 4                !! Deep peat
+  INTEGER(i_std), PARAMETER :: n_soil_depths = 3        !! Total number of soil depths used in
+                                                        !! windthrow according to
+                                                        !! reference data
+  INTEGER(i_std), PARAMETER :: ideep = 1                !! Deep-rooted
+  INTEGER(i_std), PARAMETER :: ishallow = 2             !! Shallow-rooted
+  INTEGER(i_std), PARAMETER :: iaverage = 3             !! Average-rooted
+
+  !! Parameters for soil thermodynamics
+
+  REAL(r_std), SAVE :: so_capa_dry = 1.80e+6            !! Dry soil Heat capacity of soils 
+                                                        !! @tex $(J.m^{-3}.K^{-1})$ @endtex 
+!$OMP THREADPRIVATE(so_capa_dry)
+  REAL(r_std), SAVE :: so_cond_dry = 0.40               !! Dry soil Thermal Conductivity of soils
+                                                        !! @tex $(W.m^{-2}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(so_cond_dry)
+  REAL(r_std), SAVE :: so_capa_wet = 3.03e+6            !! Wet soil Heat capacity of soils 
+                                                        !! @tex $(J.m^{-3}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(so_capa_wet)
+  REAL(r_std), SAVE :: so_cond_wet = 1.89               !! Wet soil Thermal Conductivity of soils 
+                                                        !! @tex $(W.m^{-2}.K^{-1})$ @endtex 
+!$OMP THREADPRIVATE(so_cond_wet)
+  REAL(r_std), SAVE :: sn_cond = 0.3                    !! Thermal Conductivity of snow 
+                                                        !! @tex $(W.m^{-2}.K^{-1})$ @endtex  
+!$OMP THREADPRIVATE(sn_cond)
+  REAL(r_std), SAVE :: sn_dens = 330.0                  !! Snow density for the soil thermodynamics
+                                                        !! (kg/m3)
+!$OMP THREADPRIVATE(sn_dens)
+  REAL(r_std), SAVE :: sn_capa                          !! Heat capacity for snow 
+                                                        !! @tex $(J.m^{-3}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(sn_capa)
+  REAL(r_std), SAVE :: water_capa = 4.18e+6             !! Water heat capacity 
+                                                        !! @tex $(J.m^{-3}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(water_capa)
+  REAL(r_std), SAVE :: brk_capa = 2.0e+6                !! Heat capacity of generic rock
+                                                        !! @tex $(J.m^{-3}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(brk_capa)
+  REAL(r_std), SAVE :: brk_cond = 3.0                   !! Thermal conductivity of saturated granitic rock
+                                                        !! @tex $(W.m^{-1}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(brk_cond)
+  REAL(r_std), SAVE :: qsintcst = 0.1                   !! Transforms leaf area index into size of interception reservoir
+                                                        !! (unitless)
+!$OMP THREADPRIVATE(qsintcst)
+  REAL(r_std), SAVE :: mx_eau_nobio = 150.              !! Volumetric available soil water capacity in nobio fractions
+                                                        !! @tex $(kg.m^{-3} of soil)$ @endtex
+!$OMP THREADPRIVATE(mx_eau_nobio)
+
+  !! Parameters specific for the CWRR hydrology.
+
+  !!  1. Parameters for FAO Classification
+
+  !! Parameters for soil type distribution
+
+  REAL(r_std),DIMENSION(nscm_fao),SAVE :: soilclass_default_fao = &   !! Default soil texture distribution for fao :
+ & (/ 0.28, 0.52, 0.20 /)                                             !! in the following order : COARSE, MEDIUM, FINE (unitless)
+!$OMP THREADPRIVATE(soilclass_default_fao)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: nvan_fao = &            !! Van Genuchten coefficient n (unitless)
+ & (/ 1.89_r_std, 1.56_r_std, 1.31_r_std /)                             !  RK: 1/n=1-m
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: avan_fao = &            !! Van Genuchten coefficient a 
+  & (/ 0.0075_r_std, 0.0036_r_std, 0.0019_r_std /)                     !!  @tex $(mm^{-1})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mcr_fao = &             !! Residual volumetric water content 
+ & (/ 0.065_r_std, 0.078_r_std, 0.095_r_std /)                         !!  @tex $(m^{3} m^{-3})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mcs_fao = &             !! Saturated volumetric water content 
+ & (/ 0.41_r_std, 0.43_r_std, 0.41_r_std /)                            !!  @tex $(m^{3} m^{-3})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: ks_fao = &              !! Hydraulic conductivity at saturation 
+ & (/ 1060.8_r_std, 249.6_r_std, 62.4_r_std /)                         !!  @tex $(mm d^{-1})$ @endtex
+
+! The max available water content is smaller when mcw and mcf depend on texture,
+! so we increase pcent to a classical value of 80%
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: pcent_fao = &           !! Fraction of saturated volumetric soil moisture 
+ & (/ 0.8_r_std, 0.8_r_std, 0.8_r_std /)                               !! above which transpir is max (0-1, unitless)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: free_drain_max_fao = &  !! Max=default value of the permeability coeff  
+ & (/ 1.0_r_std, 1.0_r_std, 1.0_r_std /)                               !! at the bottom of the soil (0-1, unitless)
+
+!! We use the VG relationships to derive mcw and mcf depending on soil texture
+!! assuming that the matric potential for wilting point and field capacity is
+!! -150m (permanent WP) and -3.3m respectively
+!! (-1m for FC for the three sandy soils following Richards, L.A. and Weaver, L.R. (1944)
+!! Note that mcw GE mcr
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mcf_fao = &             !! Volumetric water content at field capacity 
+ & (/ 0.1218_r_std, 0.1654_r_std, 0.2697_r_std /)                      !!  @tex $(m^{3} m^{-3})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mcw_fao = &             !! Volumetric water content at wilting point 
+ & (/ 0.0657_r_std,  0.0884_r_std, 0.1496_r_std/)                      !!  @tex $(m^{3} m^{-3})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mc_awet_fao = &         !! Vol. wat. cont. above which albedo is cst 
+ & (/ 0.25_r_std, 0.25_r_std, 0.25_r_std /)                            !!  @tex $(m^{3} m^{-3})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mc_adry_fao = &         !! Vol. wat. cont. below which albedo is cst
+ & (/ 0.1_r_std, 0.1_r_std, 0.1_r_std /)                               !!  @tex $(m^{3} m^{-3})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: SMCMAX_fao = &          !! porosity
+ & (/ 0.41_r_std, 0.43_r_std, 0.41_r_std /)                            !! & (/ 0.434_r_std, 0.439_r_std, 0.465_r_std /) !!noah lsm
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: QZ_fao = &              !! QUARTZ CONTENT (SOIL TYPE DEPENDENT)
+ & (/ 0.60_r_std, 0.40_r_std, 0.35_r_std /)                            !! Peters et al [1998]
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: so_capa_dry_ns_fao = &  !! Dry soil Heat capacity of soils,J.m^{-3}.K^{-1}
+ & (/ 1.34e+6_r_std, 1.21e+6_r_std, 1.23e+6_r_std /)                   !! Pielke [2002, 2013]
+
+  !!  2. Parameters for USDA Classification
+
+  !! Parameters for soil type distribution :
+  !! Sand, Loamy Sand, Sandy Loam, Silt Loam, Silt, Loam, Sandy Clay Loam, Silty Clay Loam, Clay Loam, Sandy Clay, Silty Clay, Clay
+
+  REAL(r_std),DIMENSION(nscm_usda),SAVE :: soilclass_default_usda = &    !! Default soil texture distribution in the above order :
+ & (/ 0.28, 0.52, 0.20, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 /)   !! Thus different from "FAO"'s COARSE, MEDIUM, FINE
+                                                                         !! which have indices 3,6,9 in the 12-texture vector
+  !$OMP THREADPRIVATE(soilclass_default_usda)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: nvan_usda = &            !! Van Genuchten coefficient n (unitless)
+ & (/ 2.68_r_std, 2.28_r_std, 1.89_r_std, 1.41_r_std, &                   !  RK: 1/n=1-m
+ &    1.37_r_std, 1.56_r_std, 1.48_r_std, 1.23_r_std, &
+ &    1.31_r_std, 1.23_r_std, 1.09_r_std, 1.09_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: avan_usda = &            !! Van Genuchten coefficient a 
+ & (/ 0.0145_r_std, 0.0124_r_std, 0.0075_r_std, 0.0020_r_std, &          !!  @tex $(mm^{-1})$ @endtex
+ &    0.0016_r_std, 0.0036_r_std, 0.0059_r_std, 0.0010_r_std, &
+ &    0.0019_r_std, 0.0027_r_std, 0.0005_r_std, 0.0008_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mcr_usda = &             !! Residual volumetric water content 
+ & (/ 0.045_r_std, 0.057_r_std, 0.065_r_std, 0.067_r_std, &              !!  @tex $(m^{3} m^{-3})$ @endtex
+ &    0.034_r_std, 0.078_r_std, 0.100_r_std, 0.089_r_std, &
+ &    0.095_r_std, 0.100_r_std, 0.070_r_std, 0.068_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mcs_usda = &             !! Saturated volumetric water content 
+ & (/ 0.43_r_std, 0.41_r_std, 0.41_r_std, 0.45_r_std, &                  !!  @tex $(m^{3} m^{-3})$ @endtex
+ &    0.46_r_std, 0.43_r_std, 0.39_r_std, 0.43_r_std, &
+ &    0.41_r_std, 0.38_r_std, 0.36_r_std, 0.38_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: ks_usda = &              !! Hydraulic conductivity at saturation
+ & (/ 7128.0_r_std, 3501.6_r_std, 1060.8_r_std, 108.0_r_std, &           !!  @tex $(mm d^{-1})$ @endtex
+ &    60.0_r_std, 249.6_r_std, 314.4_r_std, 16.8_r_std, &
+ &    62.4_r_std, 28.8_r_std, 4.8_r_std, 48.0_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: pcent_usda = &           !! Fraction of saturated volumetric soil moisture
+ & (/ 0.8_r_std, 0.8_r_std, 0.8_r_std, 0.8_r_std, &                      !! above which transpir is max (0-1, unitless)
+ &    0.8_r_std, 0.8_r_std, 0.8_r_std, 0.8_r_std, &
+ &    0.8_r_std, 0.8_r_std, 0.8_r_std, 0.8_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: free_drain_max_usda = &  !! Max=default value of the permeability coeff 
+ & (/ 1.0_r_std, 1.0_r_std, 1.0_r_std, 1.0_r_std, &                      !! at the bottom of the soil (0-1, unitless)
+ &    1.0_r_std, 1.0_r_std, 1.0_r_std, 1.0_r_std, &
+ &    1.0_r_std, 1.0_r_std, 1.0_r_std, 1.0_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mcf_usda = &             !! Volumetric water content at field capacity
+ & (/ 0.0493_r_std, 0.0710_r_std, 0.1218_r_std, 0.2402_r_std, &          !!  @tex $(m^{3} m^{-3})$ @endtex
+      0.2582_r_std, 0.1654_r_std, 0.1695_r_std, 0.3383_r_std, &
+      0.2697_r_std, 0.2672_r_std, 0.3370_r_std, 0.3469_r_std /)
+  
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mcw_usda = &             !! Volumetric water content at wilting point
+ & (/ 0.0450_r_std, 0.0570_r_std, 0.0657_r_std, 0.1039_r_std, &          !!  @tex $(m^{3} m^{-3})$ @endtex
+      0.0901_r_std, 0.0884_r_std, 0.1112_r_std, 0.1967_r_std, &
+      0.1496_r_std, 0.1704_r_std, 0.2665_r_std, 0.2707_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mc_awet_usda = &         !! Vol. wat. cont. above which albedo is cst
+ & (/ 0.25_r_std, 0.25_r_std, 0.25_r_std, 0.25_r_std, &                  !!  @tex $(m^{3} m^{-3})$ @endtex
+ &    0.25_r_std, 0.25_r_std, 0.25_r_std, 0.25_r_std, &
+ &    0.25_r_std, 0.25_r_std, 0.25_r_std, 0.25_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mc_adry_usda = &         !! Vol. wat. cont. below which albedo is cst
+ & (/ 0.1_r_std, 0.1_r_std, 0.1_r_std, 0.1_r_std, &                      !!  @tex $(m^{3} m^{-3})$ @endtex
+ &    0.1_r_std, 0.1_r_std, 0.1_r_std, 0.1_r_std, &
+ &    0.1_r_std, 0.1_r_std, 0.1_r_std, 0.1_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: SMCMAX_usda = &          !! porosity
+ & (/ 0.43_r_std, 0.41_r_std, 0.41_r_std, 0.45_r_std, &
+ &    0.46_r_std, 0.43_r_std, 0.39_r_std, 0.43_r_std, &
+ &    0.41_r_std, 0.38_r_std, 0.36_r_std, 0.38_r_std /)
+ 
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: QZ_usda = &              !! QUARTZ CONTENT (SOIL TYPE DEPENDENT)
+ & (/ 0.92_r_std, 0.82_r_std, 0.60_r_std, 0.25_r_std, &
+ &    0.10_r_std, 0.40_r_std, 0.60_r_std, 0.10_r_std, &
+ &    0.35_r_std, 0.52_r_std, 0.10_r_std, 0.25_r_std /)                  !! Peters et al [1998]
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: so_capa_dry_ns_usda = &  !! Dry soil Heat capacity of soils,J.m^{-3}.K^{-1}
+ & (/ 1.47e+6_r_std, 1.41e+6_r_std, 1.34e+6_r_std, 1.27e+6_r_std, &
+ &    1.21e+6_r_std, 1.21e+6_r_std, 1.18e+6_r_std, 1.32e+6_r_std, &
+ &    1.23e+6_r_std, 1.18e+6_r_std, 1.15e+6_r_std, 1.09e+6_r_std /)      !! Pielke [2002, 2013]
+  
+  !! Parameters for the numerical scheme used by CWRR
+
+  INTEGER(i_std), PARAMETER :: imin = 1                                 !! Start for CWRR linearisation (unitless)
+  INTEGER(i_std), PARAMETER :: nbint = 50                               !! Number of interval for CWRR linearisation (unitless)
+  INTEGER(i_std), PARAMETER :: imax = nbint+1                           !! Number of points for CWRR linearisation (unitless)
+  REAL(r_std), PARAMETER    :: w_time = 1.0_r_std                       !! Time weighting for CWRR numerical integration (unitless)
+
+  !! Variables related to soil freezing, in thermosoil : 
+  LOGICAL, SAVE        :: ok_Ecorr                    !! Flag for energy conservation correction
+  LOGICAL, SAVE        :: ok_freeze_thermix           !! Flag to activate thermal part of the soil freezing scheme
+  LOGICAL, SAVE        :: read_reftemp                !! Flag to initialize soil temperature using climatological temperature
+  REAL(r_std), SAVE    :: poros                       !! Soil porosity (from USDA classification, mean value)(-)
+  REAL(r_std), SAVE    :: fr_dT                       !! Freezing window (K)
+
+  !! Variables related to soil freezing, in diffuco : 
+  LOGICAL, SAVE        ::  ok_snowfact                !! Activate snow smoothering
+
+  !! Variables related to soil freezing, in hydrol : 
+  LOGICAL, SAVE        :: ok_freeze_cwrr              !! CWRR freezing scheme by I. Gouttevin
+  LOGICAL, SAVE        :: ok_thermodynamical_freezing !! Calculate frozen fraction thermodynamically
+
+  
+END MODULE constantes_soil_var
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes_var.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes_var.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/constantes_var.f90	(revision 6412)
@@ -0,0 +1,1978 @@
+! =================================================================================================================================
+! MODULE       : constantes_var
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        constantes_var module contains most constantes like pi, Earth radius, etc...
+!!              and all externalized parameters except pft-dependent constants.
+!!
+!!\n DESCRIPTION: This module contains most constantes and the externalized parameters of ORCHIDEE which 
+!!                are not pft-dependent.\n
+!!                In this module, you can set the flag diag_qsat in order to detect the pixel where the
+!!                temperature is out of range (look qsatcalc and dev_qsatcalc in qsat_moisture.f90).\n
+!!                The Earth radius is approximated by the Equatorial radius.The Earth's equatorial radius a,
+!!                or semi-major axis, is the distance from its center to the equator and equals 6,378.1370 km.
+!!                The equatorial radius is often used to compare Earth with other planets.\n
+!!                The meridional mean is well approximated by the semicubic mean of the two axe yielding 
+!!                6367.4491 km or less accurately by the quadratic mean of the two axes about 6,367.454 km
+!!                or even just the mean of the two axes about 6,367.445 km.\n
+!!                This module is already USE in module constantes. Therefor no need to USE it seperatly except
+!!                if the subroutines in module constantes are not needed.\n
+!!                
+!! RECENT CHANGE(S):
+!!
+!! REFERENCE(S)	: 
+!! - Louis, Jean-Francois (1979), A parametric model of vertical eddy fluxes in the atmosphere. 
+!! Boundary Layer Meteorology, 187-202.\n
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_var
+
+  USE defprec
+
+  IMPLICIT NONE
+!-
+
+                         !-----------------------!
+                         !  ORCHIDEE CONSTANTS   !
+                         !-----------------------!
+
+  !
+  ! FLAGS 
+  !
+  LOGICAL :: river_routing      !! activate river routing
+!$OMP THREADPRIVATE(river_routing)
+  LOGICAL :: do_floodplains     !! activate flood plains
+!$OMP THREADPRIVATE(do_floodplains)
+  LOGICAL :: do_irrigation      !! activate computation of irrigation flux
+!$OMP THREADPRIVATE(do_irrigation)
+  LOGICAL :: ok_sechiba         !! activate physic of the model
+!$OMP THREADPRIVATE(ok_sechiba)
+  LOGICAL :: ok_stomate         !! activate carbon cycle
+!$OMP THREADPRIVATE(ok_stomate)
+  LOGICAL :: ok_ncycle          !! activate nitrogen cycle
+!$OMP THREADPRIVATE(ok_ncycle)
+  LOGICAL :: impose_cn          !! impose the CN ratio of leaves
+!$OMP THREADPRIVATE(impose_cn)
+  LOGICAL :: ok_dgvm            !! activate dynamic vegetation
+!$OMP THREADPRIVATE(ok_dgvm)
+  LOGICAL :: ok_pheno           !! activate the calculation of lai using stomate rather than a prescription
+!$OMP THREADPRIVATE(ok_pheno)
+  LOGICAL :: ok_bvoc            !! activate biogenic volatile organic coumpounds
+!$OMP THREADPRIVATE(ok_bvoc)
+  LOGICAL :: ok_leafage         !! activate leafage
+!$OMP THREADPRIVATE(ok_leafage)
+  LOGICAL :: ok_radcanopy       !! use canopy radiative transfer model
+!$OMP THREADPRIVATE(ok_radcanopy)
+  LOGICAL :: ok_multilayer      !! use canopy radiative transfer model with multi-layers (BVOCs)
+!$OMP THREADPRIVATE(ok_multilayer)
+  LOGICAL :: ok_pulse_NOx       !! calculate NOx emissions with pulse
+!$OMP THREADPRIVATE(ok_pulse_NOx)
+  LOGICAL :: ok_bbgfertil_NOx   !! calculate NOx emissions with bbg fertilizing effect
+!$OMP THREADPRIVATE(ok_bbgfertil_NOx)
+  LOGICAL :: ok_cropsfertil_NOx !! calculate NOx emissions with fertilizers use
+!$OMP THREADPRIVATE(ok_cropsfertil_NOx)
+
+  LOGICAL :: ok_co2bvoc_poss    !! CO2 inhibition on isoprene activated following Possell et al. (2005) model
+!$OMP THREADPRIVATE(ok_co2bvoc_poss)
+  LOGICAL :: ok_co2bvoc_wilk    !! CO2 inhibition on isoprene activated following Wilkinson et al. (2006) model
+!$OMP THREADPRIVATE(ok_co2bvoc_wilk)
+  INTEGER       :: multi_layer_control                        !! Flag that automatically controls several other flags related to 
+                                                              !! multi-layering (1/2/3).
+                                                              !! 1 - single layer: ok_hydrol_arch, ok_gs_feedback, ok_impose_canopy_structure 
+                                                              !! and ok_mleb all true, but the energy budget is only calculated for a single layer 
+                                                              !! (jnlvls=1,jnlvls_under=0,jnlvls_canopy=1,jnlvls_over=0).
+                                                              !! 2 - multi-layer: ok_hydrol_arch, ok_gs_feedback,  ok_impose_canopy_structure,
+                                                              !! ok_mleb all true, and the energy budget is calculated for multiple layers 
+                                                              !! (jnlvls=29,jnlvls_under=10,jnlvls_canopy=10,jnlvls_over=9).    
+                                                              !! 3 - user specific: user specific settings for these controls 
+                                                              !! and layers as defined in the run.def by the user.
+!$OMP THREADPRIVATE(multi_layer_control)
+  LOGICAL       :: ok_hydrol_arch                             !! Flag that activates the hydraulic architecture routine (true/false)
+                                                              !! The trunk version of ORCHIDEE (false) uses soil water as a 
+                                                              !! proxy for water stress and applies the stress to Vcmax.
+                                                              !! When set to true the hydraulic architecture of the vegetation
+                                                              !! is accounted for to calculate the amount of water that 
+                                                              !! can be transported through the plant given the soil and leaf
+                                                              !! potential and the conductivities of the roots, wood and 
+                                                              !! leaves. Water supply through the plant is compared against
+                                                              !! the atmospheric demand for water. If the supply is smaller
+                                                              !! then the demand, the plant experiences water stress and the
+                                                              !! stomata will be closed (water stress is now on gs rather 
+                                                              !! than Vcmax). Note that whether stomatal regulation is used or 
+                                                              !! not is controled by a separate flag: ok_gs_feedback.
+!$OMP THREADPRIVATE(ok_hydrol_arch)
+
+  LOGICAL       :: ok_gs_feedback                             !! Flag that activates water stress on stomata (true/false)
+                                                              !! This flag is for debugging only! It allows developers
+                                                              !! to calculate GPP without any water stress. If the model is 
+                                                              !! used in production mode and ok_hydrol_arch is true this 
+                                                              !! flag should be true as well.
+!$OMP THREADPRIVATE(ok_gs_feedback)   
+  LOGICAL       :: ok_mleb                                    !! Flag that activates the multilayer energy budget (true/false)
+                                                              !! The model uses 10 (default) canopy layers to calculate
+                                                              !! the albedo, transmittance, absorbance and GPP. These canopy
+                                                              !! layers can be combined with 10 (default) layers below and 
+                                                              !! 10 layers above the canopy to calculate the energy budget
+                                                              !! (ok_mleb=y). If set to no, this flag will make the model
+                                                              !! use 10 layers for the canopy albedo, transmittance, 
+                                                              !! absorbance and GPP and just a single layer for the energy 
+                                                              !! budget. Be aware that if you wish to run with hydraulic 
+                                                              !! architechture ok_mleb needs to be se to true as well. Furthermore
+                                                              !! if you  wish to run with the original energy scheme (enerbil),
+                                                              !! set the layers for mleb to 1.
+!$OMP THREADPRIVATE(ok_mleb)
+  LOGICAL       :: ok_impose_can_structure                    !! This flag is for debugging only! It allows developers
+                                                              !! to use a prescribed canopy structure rather then the 
+                                                              !! structure calculate by ORCHIDEE. The flag activates the 
+                                                              !! sections of code which directly link the energy budget 
+                                                              !! scheme to the the size and LAI profile of the canopy for the 
+                                                              !! respective PFT and age class that is calculated in stomate, 
+                                                              !! for the albedo. If set to TRUE and the multi-layer budget 
+                                                              !! is activated the model takes LAI profile information and 
+                                                              !! canopy level heights from the run.def. If set to FALSE, and 
+                                                              !! the multi-layer energy budget is used the profile 
+                                                              !! information and canopy levels heights comes from the
+                                                              !! PGap-based processes for calculation of stand profile 
+                                                              !! information in stomate.
+!$OMP THREADPRIVATE(ok_impose_can_structure)
+  LOGICAL       :: ok_mleb_history_file                       !! Flag that controls the writing of an output file with the 
+                                                              !! multi-layer energy simulations (true/false). Note that this
+                                                              !! is a large file and writing it slows down the code. 
+!$OMP THREADPRIVATE(ok_mleb_history_file)
+  LOGICAL, SAVE :: ok_read_fm_map = .FALSE.                   !! A logical flag determining if we read
+                                                              !! in the forest management strategy from a map.
+                                                              !! This should be .TRUE. for all applications
+                                                              !! except for debugging and pixel-level simulations.
+!$OMP THREADPRIVATE(ok_read_fm_map)
+  LOGICAL, SAVE :: ok_change_species = .FALSE.                !! A logical flag determining if we change
+                                                              !! species after a clearcut
+!$OMP THREADPRIVATE(ok_change_species)
+  LOGICAL, SAVE :: ok_read_species_change_map = .FALSE.       !! A logical flag determining if we read
+                                                              !! in a map which changes species after a clearcut
+                                                              !! To be used with ok_change_species = .TRUE. or
+                                                              !! set species_change_force (see below)
+!$OMP THREADPRIVATE(ok_read_species_change_map)
+  LOGICAL, SAVE :: ok_read_desired_fm_map = .FALSE.           !! A logical flag determining if we read
+                                                              !! in the desired forest management strategy from a map.
+                                                              !! To be used with ok_change_species = .TRUE. or set
+                                                              !! fm_change_force (see below)
+!$OMP THREADPRIVATE(ok_read_desired_fm_map)
+  LOGICAL, SAVE :: ok_litter_raking = .FALSE.                 !! If TRUE, this flag will simulate litter raking in
+	                                                      !! in grid squares.  This has the effect of moving litter
+	                                                      !! once a year from forest PFTs to agricultural PFTs, if they
+	                                                      !! are present on this pixel.  If TRUE, you must also provide
+	                                                      !! a map with the litter demand so we know how much litter
+	                                                      !! to remove for each pixel. Litter raking is a historical
+                                                              !! land use so you reconstrauctions to use this option.
+!$OMP THREADPRIVATE(ok_litter_raking)
+ 
+  LOGICAL       :: ok_dimensional_product_use = .TRUE.        !! Once the wood is harvested it ends up in wood product pools
+                                                              !! Two options were coded: (1) the product use and thus 
+                                                              !! its on longevity depends on the dimensions of the harvest
+                                                              !! (2) the dimensions are ignored and the wood is used according
+                                                              !! to fixed ratios.
+ 
+!$OMP THREADPRIVATE(ok_dimensional_product_use)
+
+  LOGICAL       :: ok_constant_mortality                      !! Use constant mortality or calculate mortality 
+                                                              !! as a function of last yearsÂŽs NPP
+!$OMP THREADPRIVATE(ok_constant_mortality)
+
+  LOGICAL, SAVE :: ok_c13                                     !! Activate carbon isotope concetration of biomass
+!$OMP THREADPRIVATE(ok_c13)
+
+  LOGICAL :: ok_recruitment                                   !! Activate the recruitment module. Note that recruitment has
+                                                              !! a double control. When this flag is .TRUE. recruitment will
+                                                              !! only be simulated for those PFTs for which ::recruitment_pft
+                                                              !! is set to .TRUE. The ::ok_recruitment flag is convenient for
+                                                              !! debugging and testing but it is redundant and can be removed
+!$OMP THREADPRIVATE(ok_recruitment)
+
+  LOGICAL, SAVE :: ok_windthrow = .FALSE.                     !! Activate the wind throw module. Trees will be killed
+                                                              !! if the wind speed exceeds the critical wind speed of
+                                                              !! of the forest (PFT).                             
+!$OMP THREADPRIVATE(ok_windthrow)
+ 
+  LOGICAL, SAVE :: ok_bare_soil_new = .FALSE.                 !! Choose between the two options to calculate the bare soil.
+                                                              !! False = classic view: gaps within a canopy should be treated
+                                                              !! bare soil. True = ecological view: gaps within a canopy are
+                                                              !! part of the ecosystem and should be treated as such.
+!$OMP THREADPRIVATE(ok_bare_soil_new)
+
+
+
+  LOGICAL, SAVE :: OFF_LINE_MODE = .FALSE.                    !! ORCHIDEE detects if it is coupled with a GCM or 
+                                                              !! just use with one driver in OFF-LINE. (true/false)
+!$OMP THREADPRIVATE(OFF_LINE_MODE)  
+  LOGICAL, SAVE :: impose_param = .TRUE.                      !! Flag impos_param : read all the parameters in the run.def file
+!$OMP THREADPRIVATE(impose_param)
+  CHARACTER(LEN=80), SAVE :: restname_in = 'NONE'             !! Input Restart files name for Sechiba component  
+!$OMP THREADPRIVATE(restname_in)
+  CHARACTER(LEN=80), SAVE :: restname_out = 'sechiba_rest_out.nc'  !! Output Restart files name for Sechiba component
+!$OMP THREADPRIVATE(restname_out)
+  CHARACTER(LEN=80), SAVE :: stom_restname_in = 'NONE'        !! Input Restart files name for Stomate component
+!$OMP THREADPRIVATE(stom_restname_in)
+  CHARACTER(LEN=80), SAVE :: stom_restname_out = 'stomate_rest_out.nc'  !! Output Restart files name for Stomate component
+!$OMP THREADPRIVATE(stom_restname_out)
+  INTEGER, SAVE :: printlev=2                                 !! Standard level for text output [0, 1, 2, 3]
+!$OMP THREADPRIVATE(printlev)
+  INTEGER, SAVE :: printlev_loc=1                             !! local level for text output [0, 1, 2, 3]
+!$OMP THREADPRIVATE(printlev_loc)
+  !
+  ! HACKS
+  !
+  LOGICAL, SAVE :: hack_enerbil_hydrol = .TRUE.!! For debugging only! Flag to skip a particular block of code in enerbil.f90 which results in 
+                                               !! incorrect results for large scale simulations. 
+!$OMP THREADPRIVATE(hack_enerbil_hydrol)
+  LOGICAL, SAVE :: hack_lcc = .TRUE.           !! Set to .TRUE. if you want the code to keep running past
+                                               !! a few places in land cover change where it would ordinarily
+                                               !! stop.  Only use in very specific cases!
+!$OMP THREADPRIVATE(hack_lcc)
+  LOGICAL, SAVE :: hack_circ_class = .TRUE.    !! Set to true for a temporary patch of a known bug, though the underlying
+!$OMP THREADPRIVATE(hack_circ_class)
+  REAL(r_std), SAVE :: min_n = 0.00001         !! Minimum allowable n_mineralisation when truncating som_input_total(:,initrogen) in stomate_litter. 
+!$OMP THREADPRIVATE(min_n)
+  REAL(r_std), SAVE :: max_cn = 250            !! Maximum allowable ratio of som_input_total(:,icarbon) to som_input_total(:,initrogen).
+!$OMP THREADPRIVATE(max_cn)
+
+  !
+  ! TIME
+  !
+  REAL(r_std), SAVE :: one_day  !! One day in seconds (s)
+!$OMP THREADPRIVATE(one_day)
+  REAL(r_std), SAVE :: one_year !! One year in days
+!$OMP THREADPRIVATE(one_year)
+  REAL(r_std), PARAMETER :: one_hour = 3600.0  !! One hour in seconds (s)
+  INTEGER(i_std), PARAMETER  :: spring_days_max = 40  !! Maximum number of days during which we watch for possible spring frost damage
+
+  ! TIME STEP
+  REAL(r_std)            :: dt_sechiba         !! Time step in sechiba
+!$OMP THREADPRIVATE(dt_sechiba)
+  REAL(r_std)            :: dt_stomate         !! Time step in stomate
+!$OMP THREADPRIVATE(dt_stomate)
+
+  !
+  ! SPECIAL VALUES 
+  !
+  INTEGER(i_std), PARAMETER :: undef_int = 999999999     !! undef integer for integer arrays (unitless)
+  !-
+  REAL(r_std), SAVE :: val_exp = 999999.                 !! Specific value if no restart value  (unitless)
+!$OMP THREADPRIVATE(val_exp)
+  REAL(r_std), PARAMETER :: undef = -9999.               !! Special value for stomate (unitless)
+  
+  REAL(r_std), PARAMETER :: min_sechiba = 1.E-8_r_std    !! Epsilon to detect a near zero floating point (unitless)
+  REAL(r_std), PARAMETER :: undef_sechiba = 1.E+20_r_std !! The undef value used in SECHIBA (unitless)
+  
+  REAL(r_std), PARAMETER :: min_stomate = 1.E-8_r_std    !! Epsilon to detect a near zero floating point (unitless)
+  REAL(r_std), PARAMETER :: large_value = 1.E33_r_std    !! some large value (for stomate) (unitless)
+
+  !
+  ! DIFFERENCE TESTS
+  !
+  INTEGER(i_std), PARAMETER :: istart = 1        !! Index to store values at the start
+  INTEGER(i_std), PARAMETER :: iend = 2          !! Index to store values at the end
+
+  !
+  !  DIMENSIONING AND INDICES PARAMETERS  
+  !
+  INTEGER(i_std), PARAMETER :: ibare_sechiba = 1 !! Index for bare soil in Sechiba (unitless)
+  INTEGER(i_std), PARAMETER :: ivis = 1          !! index for albedo in visible range (unitless)
+  INTEGER(i_std), PARAMETER :: inir = 2          !! index for albeod i near-infrared range (unitless) 
+  INTEGER(i_std), PARAMETER :: n_spectralbands=2 !! number of spectral bands
+  INTEGER(i_std), PARAMETER :: nnobio = 1        !! Number of other surface types: land ice (lakes,cities, ...) (unitless)
+  INTEGER(i_std), PARAMETER :: iice = 1          !! Index for land ice (see nnobio) (unitless)
+  !-
+  !! Soil
+  INTEGER(i_std), PARAMETER :: classnb = 9       !! Levels of soil colour classification (unitless)
+  !-
+  INTEGER(i_std), PARAMETER :: nleafages = 4     !! leaf age discretisation ( 1 = no discretisation )(unitless)
+  !-
+  !! litter fractions: indices (unitless)
+  INTEGER(i_std), PARAMETER :: ileaf = 1         !! Index for leaf compartment (unitless)
+  INTEGER(i_std), PARAMETER :: isapabove = 2     !! Index for sapwood above compartment (unitless)
+  INTEGER(i_std), PARAMETER :: isapbelow = 3     !! Index for sapwood below compartment (unitless)
+  INTEGER(i_std), PARAMETER :: iheartabove = 4   !! Index for heartwood above compartment (unitless)
+  INTEGER(i_std), PARAMETER :: iheartbelow = 5   !! Index for heartwood below compartment (unitless)
+  INTEGER(i_std), PARAMETER :: iroot = 6         !! Index for roots compartment (unitless)
+  INTEGER(i_std), PARAMETER :: ifruit = 7        !! Index for fruits compartment (unitless)
+  INTEGER(i_std), PARAMETER :: icarbres = 8      !! Index for reserve compartment (unitless)
+  INTEGER(i_std), PARAMETER :: ilabile = 9       !! Index for reserve compartment (unitless) 
+  INTEGER(i_std), PARAMETER :: nparts = 9        !! Number of biomass compartments (unitless)
+  !-
+  !! indices for assimilation parameters 
+  INTEGER(i_std), PARAMETER :: ivcmax = 1        !! Index for vcmax (assimilation parameters) (unitless)
+  INTEGER(i_std), PARAMETER :: inue = 2          !! Index for nue (assimilationbn parameters) (unitless)
+  INTEGER(i_std), PARAMETER :: ileafN = 3        !! Index for leaf N (assimilationbn parameters) (unitless)
+  INTEGER(i_std), PARAMETER :: npco2 = 3         !! Number of assimilation parameters (unitless)
+  !-
+  !! trees and litter: indices for the parts of heart-
+  !! and sapwood above and below the ground 
+  INTEGER(i_std), PARAMETER :: iabove = 1       !! Index for above part (unitless)
+  INTEGER(i_std), PARAMETER :: ibelow = 2       !! Index for below part (unitless)
+  INTEGER(i_std), PARAMETER :: nlevs = 2        !! Number of levels for trees and litter (unitless)
+  !-
+  !! litter: indices for metabolic and structural part
+  INTEGER(i_std), PARAMETER :: imetabolic = 1   !! Index for metabolic litter (unitless)
+  INTEGER(i_std), PARAMETER :: istructural = 2  !! Index for structural litter (unitless)
+  INTEGER(i_std), PARAMETER :: iwoody = 3       !! Index for woody litter (unitless)
+  INTEGER(i_std), PARAMETER :: nlitt = 3        !! Number of levels for litter compartments (unitless)
+  !-
+  !! carbon pools: indices
+  INTEGER(i_std), PARAMETER :: iactive = 1      !! Index for active carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: islow = 2        !! Index for slow carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive = 3     !! Index for passive carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: isurface = 4     !! Index for passive carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: ncarb = 4        !! Number of soil carbon pools (unitless)
+  !-
+  !! For isotopes and nitrogen
+  INTEGER(i_std), PARAMETER :: nelements = 2    !! Number of isotopes considered
+  INTEGER(i_std), PARAMETER :: icarbon = 1      !! Index for carbon 
+  INTEGER(i_std), PARAMETER :: initrogen = 2    !! Index for nitrogen 
+  !! N-cycle : indices
+  INTEGER(i_std), PARAMETER :: iammonium = 1    !! Index for Ammonium 
+  INTEGER(i_std), PARAMETER :: initrate  = 2    !! Index for Nitrate
+  INTEGER(i_std), PARAMETER :: inox      = 3    !! Index for NOX
+  INTEGER(i_std), PARAMETER :: initrous  = 4    !! Index for N2O
+  INTEGER(i_std), PARAMETER :: idinitro  = 5    !! Index for N2
+  INTEGER(i_std), PARAMETER :: nionspec  = 2    !! Number of ionics form considered (ammonium, nitrate)
+  INTEGER(i_std), PARAMETER :: nnspec    = 5    !! Number of N-species considered
+
+  INTEGER(i_std), PARAMETER :: iatm_ammo = 1    !! Index for N input from Ammonium N atmospheric deposition
+  INTEGER(i_std), PARAMETER :: iatm_nitr = 2    !! Index for N input from Nitrate N atmospheric deposition
+  INTEGER(i_std), PARAMETER :: ibnf      = 3    !! Index for N input from BNF
+  INTEGER(i_std), PARAMETER :: ifert     = 4    !! Index for N input from Fertilisation
+  INTEGER(i_std), PARAMETER :: imanure   = 5    !! Index for N input from Manure
+  INTEGER(i_std), PARAMETER :: ninput    = 5    !! Number of N-input considered  
+
+  INTEGER(i_std), PARAMETER :: i_nh4_to_no3 = 1 !! Index for NO3 production
+  INTEGER(i_std), PARAMETER :: i_nh4_to_no  = 2 !! Index for NO production
+  INTEGER(i_std), PARAMETER :: i_nh4_to_n2o = 3 !! Index for N2O production
+  INTEGER(i_std), PARAMETER :: n_nh4_to_x = 3   !! Number of NH4 pathways
+
+  INTEGER(i_std), PARAMETER :: i_no3_to_nox = 1  !! Index for NO3 consumption
+  INTEGER(i_std), PARAMETER :: i_nox_to_n2o  = 2 !! Index for NO/Nox consumption
+  INTEGER(i_std), PARAMETER :: i_n2o_to_n2 = 3   !! Index for N2O consumption
+  INTEGER(i_std), PARAMETER :: n_n_to_x = 3      !! Number of N pathways
+
+  INTEGER(i_std), PARAMETER :: nmonth = 12       !! Months in a year; used for input .nc files with monthly arrays
+  
+  !! Updates for the mass balance closure in stomate_lpj
+  INTEGER(i_std), PARAMETER :: ibeg      = 1    !! At the begining of the routine
+  INTEGER(i_std), PARAMETER :: ipre      = 2    !! After precribe
+  INTEGER(i_std), PARAMETER :: iphe      = 3    !! After phenology
+  INTEGER(i_std), PARAMETER :: igro      = 4    !! After growth functional allocation
+  INTEGER(i_std), PARAMETER :: iage      = 5    !! After Age class distribution
+  INTEGER(i_std), PARAMETER :: ilcc      = 6    !! After land cover change
+  INTEGER(i_std), PARAMETER :: imor      = 7    !! After mortality_clean
+  INTEGER(i_std), PARAMETER :: ispc      = 8    !! After Species Change
+  INTEGER(i_std), PARAMETER :: irec      = 9    !! After recruitment
+  INTEGER(i_std), PARAMETER :: nupdates  = 9    !! Number of step in stomate_lpj where veget_max and atm_to_bm is update 
+
+
+  ! These next sets of parameters are now used for both circ_class_kill and
+  ! for the harvest_pool.  One source of confusion is what to do with trees that
+  ! die from self-thinning or forest dieoffs.  These happen in all forests, regardless
+  ! of management strategy.  I decided to put death of this kind into ifm_none, since
+  ! it is the only type of mortality found in an unmanaged forest.  If the mortality
+  ! does not kill the whole forest (e.g. self thinning), it goes into icut_thin.  If it
+  ! does (forest dieoff), it goes into icut_clear.  The biomass is killed in lpj_gap.
+
+  !! Indices used for forest management strategies
+  INTEGER(i_std), PARAMETER :: nfm_types = 6             !! The total number of forest management 
+                                                         !! strategies we can use
+  INTEGER(i_std), PARAMETER :: ifm_none = 1              !! No human intervention in the forests.
+  INTEGER(i_std), PARAMETER :: ifm_thin = 2              !! Regular thinning and harvesting of 
+                                                         !! wood based on RDI.
+  INTEGER(i_std), PARAMETER :: ifm_cop = 3               !! Coppicing for fuelwood.
+  INTEGER(i_std), PARAMETER :: ifm_src = 4               !! Short rotation coppices for biomass 
+                                                         !! production.
+  INTEGER(i_std), PARAMETER :: ifm_crop = 5              !! Crop harvest
+  INTEGER(i_std), PARAMETER :: ifm_grass = 6             !! Grazing or cutting
+ 
+  !! Indices used for harvest pools
+  INTEGER(i_std), PARAMETER :: ncut_times = 11           !! The total number of times when trees 
+                                                         !! are cut and wood harvested.
+  INTEGER(i_std), PARAMETER :: icut_clear = 1            !! A clearcut where all biomass is removed.
+  INTEGER(i_std), PARAMETER :: icut_thin = 2             !! Thinning of biomass to reduce the 
+                                                         !! number of trees.
+  INTEGER(i_std), PARAMETER :: icut_lcc_wood = 3         !! Wood harvest following land cover 
+                                                         !! change (LCC)
+  INTEGER(i_std), PARAMETER :: icut_lcc_res = 4          !! Site clearing, removal of the stumps 
+                                                         !! and branches following LCC
+  INTEGER(i_std), PARAMETER :: icut_crop = 5             !! Crop harvest
+  INTEGER(i_std), PARAMETER :: icut_grass = 6            !! Grazing or cutting
+  INTEGER(i_std), PARAMETER :: icut_cop1 = 7             !! The first coppice cut
+  INTEGER(i_std), PARAMETER :: icut_cop2 = 8             !! The second (and subsequent) coppice cut
+  INTEGER(i_std), PARAMETER :: icut_cop3 = 9             !! The last coppice cut (only for SRC)
+  INTEGER(i_std), PARAMETER :: icut_storm_break = 10     !! Stem breakage due to storm
+  INTEGER(i_std), PARAMETER :: icut_storm_uproot = 11    !! Tee uprooting due to storm
+
+  !! Indices used to define the product pools
+  !! Numbers based on Eggers 2008 - EFI report
+  INTEGER(i_std), PARAMETER :: nshort = 1                !! Length in years of the short-lived product pool (GE 1)
+  INTEGER(i_std), PARAMETER :: nmedium =17              !! Length in years of the medium-lived product pool (GT 4)
+  INTEGER(i_std), PARAMETER :: nlong = 50                !! Length in years of the long-lived product pool (GT 4)
+
+  !! Indices used to check the mass balance closure
+  INTEGER(i_std), PARAMETER :: nmbcomp = 5               !! The total number of components in 
+                                                         !! our mass balance check
+  INTEGER(i_std), PARAMETER :: iatm2land = 1             !! atmosphere to land fluxes such as GPP 
+                                                         !! and co2_2_bm
+  INTEGER(i_std), PARAMETER :: iland2atm = 2             !! land to atmosphere fluxes such as Rh, 
+                                                         !! Ra and product decomposition
+  INTEGER(i_std), PARAMETER :: ilat2out = 3              !! outgoing lateral flux i.e. DOC leaching 
+                                                         !! for the litter routine
+  INTEGER(i_std), PARAMETER :: ilat2in = 4               !! incoming lateral flux i.e. N deposition 
+                                                         !! for the land
+  INTEGER(i_std), PARAMETER :: ipoolchange = 5           !! change in pool size i.e. change in 
+                                                         !! biomass
+
+  !! Indices used for warning tracking
+  INTEGER(i_std), PARAMETER :: nwarns = 1                !! The total number of warnings we track
+  INTEGER(i_std), PARAMETER :: iwphoto = 1               !! A warning about division by zero in photosynthesis
+
+  !! Indices used for wind damage  
+  INTEGER(i_std), PARAMETER :: ibreakage = 1             !! The index for stem breakage dur to wind damage
+  INTEGER(i_std), PARAMETER :: ioverturning = 2          !! The index for the tree overtuning due to wind damage
+
+  !! Indices for orphan fluxes
+  INTEGER(i_std), PARAMETER :: norphans = 8              !! Total number of orphan fluxes (unitless)
+  INTEGER(i_std), PARAMETER :: ivegold = 1               !! Index for veget_max before LCC
+  INTEGER(i_std), PARAMETER :: ivegnew = 2               !! Index for veget_max before LCC (includes veget_max of orphan fluxes)
+  INTEGER(i_std), PARAMETER :: igpp = 3                  !! Index for gpp_daily
+  INTEGER(i_std), PARAMETER :: ico2bm = 4                !! Index for co2_to_bm
+  INTEGER(i_std), PARAMETER :: irmain = 5                !! Index for maintenance respiration
+  INTEGER(i_std), PARAMETER :: irgrow = 6                !! Index for growth respiration 
+  INTEGER(i_std), PARAMETER :: inpp = 7                  !! Index for npp_daily
+  INTEGER(i_std), PARAMETER :: irhet = 8                 !! Index for total heterotrophic respiration
+  !
+
+  !! Indices for phenology
+  ! The variable ::plant_status replaces several variables (senescence, 
+  ! begin_leaves and allow_phenoinit) that describe the phenological status of the plant
+  ! by storing these different aspects of phenology in a single variable, inconsistencies
+  ! become impossible or at least easier to check.
+  ! When the model starts from scratch the status is set to iprescribe this allows us
+  ! to grow leaves from the first year onwards. The plant should then go through the 
+  ! different growth phases: ibudsavail, ibudbreak, icanopy, isenescent, idormant and 
+  ! finally idead. Following idormant the status should return ibudsavail to initiate 
+  ! another cycle in the subsequent growing season. Following idead new vegetation 
+  ! should be prescribed.
+  INTEGER(i_std), PARAMETER :: inone = 0                 !! No plants thus no status
+  INTEGER(i_std), PARAMETER :: iprescribe = 1            !! Prescribe a PFT
+  INTEGER(i_std), PARAMETER :: ibudsavail = 2            !! Buds are present
+  INTEGER(i_std), PARAMETER :: ibudbreak = 3             !! Day that the buds break and leaf 
+                                                         !! on-set begins
+  INTEGER(i_std), PARAMETER :: icanopy = 4               !! Canopy is present
+  INTEGER(i_std), PARAMETER :: isenescent = 5            !! The plant is senescent
+  INTEGER(i_std), PARAMETER :: idormant = 6              !! The plant is dormant
+  INTEGER(i_std), PARAMETER :: idead = 7                 !! The plant was killed
+
+  !
+  !! Indices used for analytical spin-up
+  INTEGER(i_std), PARAMETER :: nbpools = 10              !! Total number of carbon pools (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_above = 1    !! Index for structural litter above (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below = 2    !! Index for structural litter below (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_above = 3     !! Index for metabolic litter above (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below = 4     !! Index for metabolic litter below (unitless)
+  INTEGER(i_std), PARAMETER :: iwoody_above = 5         !! Index for woody litter above (unitless)
+  INTEGER(i_std), PARAMETER :: iwoody_below = 6         !! Index for woody litter below (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool = 7         !! Index for active carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool   = 8         !! Index for slow carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool = 9        !! Index for passive carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: isurface_pool = 10       !! Index for surface carbon pool (unitless)
+
+  !
+  !! Indices used for canopy structure (Pgap & eff lai) 
+  INTEGER(i_std),PARAMETER   :: ndist_types=6           !! the number of distributions we need in the LAI effective routines
+  INTEGER(i_std),PARAMETER   :: iheight=1               !! the tree height distribution
+  INTEGER(i_std),PARAMETER   :: idiameter=2             !! the trunk diameter distribution
+  INTEGER(i_std),PARAMETER   :: icnvol=3                !! the crown volume distribution
+  INTEGER(i_std),PARAMETER   :: icnarea=4               !! the crown area distribution
+  INTEGER(i_std),PARAMETER   :: icndiaver=5             !! the verticle crown diameter distribution
+  INTEGER(i_std),PARAMETER   :: icndiahor=6             !! the horizontal crown diameter distribution
+  !
+  ! NUMERICAL AND PHYSICS CONSTANTS
+  !
+  !
+
+  !-
+  ! 1. Mathematical and numerical constants
+  !-
+  REAL(r_std), PARAMETER :: pi = 3.141592653589793238   !! pi souce : http://mathworld.wolfram.com/Pi.html (unitless)
+  REAL(r_std), PARAMETER :: euler = 2.71828182845904523 !! e source : http://mathworld.wolfram.com/e.html (unitless)
+  REAL(r_std), PARAMETER :: zero = 0._r_std             !! Numerical constant set to 0 (unitless)
+  REAL(r_std), PARAMETER :: undemi = 0.5_r_std          !! Numerical constant set to 1/2 (unitless)
+  REAL(r_std), PARAMETER :: un = 1._r_std               !! Numerical constant set to 1 (unitless)
+  REAL(r_std), PARAMETER :: moins_un = -1._r_std        !! Numerical constant set to -1 (unitless)
+  REAL(r_std), PARAMETER :: deux = 2._r_std             !! Numerical constant set to 2 (unitless)
+  REAL(r_std), PARAMETER :: trois = 3._r_std            !! Numerical constant set to 3 (unitless)
+  REAL(r_std), PARAMETER :: quatre = 4._r_std           !! Numerical constant set to 4 (unitless)
+  REAL(r_std), PARAMETER :: cinq = 5._r_std             !![DISPENSABLE] Numerical constant set to 5 (unitless)
+  REAL(r_std), PARAMETER :: six = 6._r_std              !![DISPENSABLE] Numerical constant set to 6 (unitless)
+  REAL(r_std), PARAMETER :: huit = 8._r_std             !! Numerical constant set to 8 (unitless)
+  REAL(r_std), PARAMETER :: mille = 1000._r_std         !! Numerical constant set to 1000 (unitless)
+
+  !-
+  ! 2 . Physics
+  !-
+  REAL(r_std), PARAMETER :: R_Earth = 6378000.              !! radius of the Earth : Earth radius ~= Equatorial radius (m)
+  REAL(r_std), PARAMETER :: mincos  = 0.0001                !! Minimum cosine value used for interpolation (unitless) 
+  REAL(r_std), PARAMETER :: pb_std = 1013.                  !! standard pressure (hPa)
+  REAL(r_std), PARAMETER :: ZeroCelsius = 273.15            !! 0 degre Celsius in degre Kelvin (K)
+  REAL(r_std), PARAMETER :: tp_00 = 273.15                  !! 0 degre Celsius in degre Kelvin (K)
+  REAL(r_std), PARAMETER :: chalsu0 = 2.8345E06             !! Latent heat of sublimation (J.kg^{-1})
+  REAL(r_std), PARAMETER :: chalev0 = 2.5008E06             !! Latent heat of evaporation (J.kg^{-1}) 
+  REAL(r_std), PARAMETER :: chalfu0 = chalsu0-chalev0       !! Latent heat of fusion (J.kg^{-1}) 
+  REAL(r_std), PARAMETER :: c_stefan = 5.6697E-8            !! Stefan-Boltzman constant (W.m^{-2}.K^{-4})
+  REAL(r_std), PARAMETER :: cp_air = 1004.675               !! Specific heat of dry air (J.kg^{-1}.K^{-1}) 
+  REAL(r_std), PARAMETER :: cte_molr = 287.05               !! Specific constant of dry air (kg.mol^{-1}) 
+  REAL(r_std), PARAMETER :: kappa = cte_molr/cp_air         !! Kappa : ratio between specific constant and specific heat 
+                                                            !! of dry air (unitless)
+  REAL(r_std), PARAMETER :: msmlr_air = 28.964E-03          !! Molecular weight of dry air (kg.mol^{-1})
+  REAL(r_std), PARAMETER :: msmlr_h2o = 18.02E-03           !! Molecular weight of water vapor (kg.mol^{-1}) 
+  REAL(r_std), PARAMETER :: cp_h2o = &                      !! Specific heat of water vapor (J.kg^{-1}.K^{-1}) 
+       & cp_air*(quatre*msmlr_air)/( 3.5_r_std*msmlr_h2o) 
+  REAL(r_std), PARAMETER :: cte_molr_h2o = cte_molr/quatre  !! Specific constant of water vapor (J.kg^{-1}.K^{-1}) 
+  REAL(r_std), PARAMETER :: retv = msmlr_air/msmlr_h2o-un   !! Ratio between molecular weight of dry air and water 
+                                                            !! vapor minus 1(unitless)  
+  REAL(r_std), PARAMETER :: rvtmp2 = cp_h2o/cp_air-un       !! Ratio between specific heat of water vapor and dry air
+  
+  REAL(r_std), PARAMETER :: rho_h2o= 0.9991_r_std           !! Density of water at 15Â°C (g cm-3)                                                          !! minus 1 (unitless)
+  REAL(r_std), PARAMETER :: cepdu2 = (0.1_r_std)**2         !! Squared wind shear (m^2.s^{-2}) 
+  REAL(r_std), PARAMETER :: ct_karman = 0.41_r_std          !! Van Karmann Constant (unitless)
+  REAL(r_std), PARAMETER :: cte_grav = 9.80665_r_std        !! Acceleration of the gravity (m.s^{-2})
+  REAL(r_std), PARAMETER :: pa_par_hpa = 100._r_std         !! Transform pascal into hectopascal (unitless)
+  REAL(r_std), PARAMETER :: RR = 8.314                      !! Ideal gas constant (J.mol^{-1}.K^{-1})
+  REAL(r_std), PARAMETER :: Sct = 1370.                     !! Solar constant (W.m^{-2}) 
+
+  REAL(r_std), PARAMETER :: mm_m = 1000._r_std              !! conversion from milimeters to meters
+
+  INTEGER(i_std), SAVE :: testpft = 6
+  !-
+  ! 3. Climatic constants
+  !-
+  !! Constantes of the Louis scheme 
+  REAL(r_std), SAVE :: cb = 5._r_std              !! Constant of the Louis scheme (unitless);
+                                                  !! reference to Louis (1979)
+!$OMP THREADPRIVATE(cb)
+  REAL(r_std), SAVE :: cc = 5._r_std              !! Constant of the Louis scheme (unitless);
+                                                  !! reference to Louis (1979)
+!$OMP THREADPRIVATE(cc)
+  REAL(r_std), SAVE :: cd = 5._r_std              !! Constant of the Louis scheme (unitless);
+                                                  !! reference to Louis (1979)
+!$OMP THREADPRIVATE(cd)
+  REAL(r_std), SAVE :: rayt_cste = 125.           !! Constant in the computation of surface resistance (W.m^{-2})
+!$OMP THREADPRIVATE(rayt_cste)
+  REAL(r_std), SAVE :: defc_plus = 23.E-3         !! Constant in the computation of surface resistance (K.W^{-1})
+!$OMP THREADPRIVATE(defc_plus)
+  REAL(r_std), SAVE :: defc_mult = 1.5            !! Constant in the computation of surface resistance (K.W^{-1})
+!$OMP THREADPRIVATE(defc_mult)
+
+  !-
+  ! 4. Soil thermodynamics constants
+  !-
+  ! Look at constantes_soil.f90
+
+
+  !
+  ! OPTIONAL PARTS OF THE MODEL
+  !
+  LOGICAL,PARAMETER :: diag_qsat = .TRUE.         !! One of the most frequent problems is a temperature out of range
+                                                  !! we provide here a way to catch that in the calling procedure. 
+                                                  !! (from Jan Polcher)(true/false) 
+  LOGICAL, SAVE     :: almaoutput =.FALSE.        !! Selects the type of output for the model.(true/false)
+                                                  !! Value is read from run.def in intersurf_history
+!$OMP THREADPRIVATE(almaoutput)
+
+  !
+  ! DIVERSE
+  !
+  CHARACTER(LEN=100), SAVE :: stomate_forcing_name='NONE'  !! NV080800 Name of STOMATE forcing file (unitless)
+                                                           ! Compatibility with Nicolas Viovy driver.
+!$OMP THREADPRIVATE(stomate_forcing_name)
+  CHARACTER(LEN=100), SAVE :: stomate_Cforcing_name='NONE' !! NV080800 Name of soil forcing file (unitless)
+                                                           ! Compatibility with Nicolas Viovy driver.
+!$OMP THREADPRIVATE(stomate_Cforcing_name)
+  INTEGER(i_std), SAVE :: forcing_id                 !! Index of the forcing file (unitless)
+!$OMP THREADPRIVATE(forcing_id)
+  LOGICAL, SAVE :: allow_forcing_write=.TRUE.        !! Allow writing of stomate_forcing file. 
+                                                     !! This variable will be set to false for teststomate. 
+
+
+
+                         !------------------------!
+                         !  SECHIBA PARAMETERS    !
+                         !------------------------!
+ 
+
+  !
+  ! GLOBAL PARAMETERS   
+  !
+  REAL(r_std), SAVE :: min_wind = 0.1      !! The minimum wind (m.s^{-1})
+!$OMP THREADPRIVATE(min_wind)
+  REAL(r_std), SAVE :: snowcri = 1.5       !! Sets the amount above which only sublimation occurs (kg.m^{-2})
+!$OMP THREADPRIVATE(snowcri)
+
+
+  !
+  ! FLAGS ACTIVATING SUB-MODELS
+  !
+  LOGICAL, SAVE :: treat_expansion = .FALSE.   !! Do we treat PFT expansion across a grid point after introduction? (true/false)
+!$OMP THREADPRIVATE(treat_expansion)
+  LOGICAL, SAVE :: ok_herbivores = .FALSE.     !! flag to activate herbivores (true/false)
+!$OMP THREADPRIVATE(ok_herbivores)
+  LOGICAL, SAVE :: harvest_agri = .TRUE.       !! flag to harvest aboveground biomass from agricultural PFTs)(true/false)
+!$OMP THREADPRIVATE(harvest_agri)
+  LOGICAL, SAVE :: lpj_gap_const_mort          !! constant moratlity (true/false). Default value depend on OK_DGVM.
+!$OMP THREADPRIVATE(lpj_gap_const_mort)
+  LOGICAL, SAVE :: disable_fire = .FALSE.      !! flag that disable fire (true/false)
+!$OMP THREADPRIVATE(disable_fire)
+  LOGICAL, SAVE :: spinup_analytic = .FALSE.   !! Flag to activate analytical resolution for spinup (true/false)
+!$OMP THREADPRIVATE(spinup_analytic)
+
+  !
+  ! CONFIGURATION VEGETATION
+  !
+  LOGICAL, SAVE :: agriculture = .TRUE.    !! allow agricultural PFTs (true/false)
+!$OMP THREADPRIVATE(agriculture)
+  LOGICAL, SAVE :: impveg = .FALSE.        !! Impose vegetation ? (true/false)
+!$OMP THREADPRIVATE(impveg)
+  LOGICAL, SAVE :: impsoilt = .FALSE.      !! Impose soil ? (true/false)
+!$OMP THREADPRIVATE(impsoilt)
+  LOGICAL, SAVE :: impose_ninput_dep = .FALSE. !! Impose N input values ? (true/false)
+!$OMP THREADPRIVATE(impose_ninput_dep)
+  LOGICAL, SAVE :: impose_ninput_fert = .FALSE. !! Impose N input values ? (true/false)        
+!$OMP THREADPRIVATE(impose_ninput_fert)    
+ LOGICAL, SAVE :: impose_ninput_manure = .FALSE. !! Impose N input values ? (true/false)        
+!$OMP THREADPRIVATE(impose_ninput_manure)                     
+  LOGICAL, SAVE :: impose_ninput_bnf = .FALSE. !! Impose N input values ? (true/false)        
+!$OMP THREADPRIVATE(impose_ninput_bnf)
+  LOGICAL, SAVE :: do_now_stomate_lcchange = .FALSE.  !! Time to call lcchange in stomate_lpj
+!$OMP THREADPRIVATE(do_now_stomate_lcchange)
+  LOGICAL, SAVE :: done_stomate_lcchange = .FALSE.    !! If true, call lcchange in stomate_lpj has just been done. 
+!$OMP THREADPRIVATE(done_stomate_lcchange)
+  LOGICAL, SAVE :: read_lai = .FALSE.      !! Flag to read a map of LAI if STOMATE is not activated (true/false)
+!$OMP THREADPRIVATE(read_lai)
+  LOGICAL, SAVE :: veget_reinit = .TRUE.   !! To change LAND USE file in a run. (true/false)
+!$OMP THREADPRIVATE(veget_reinit)
+  LOGICAL, SAVE :: ninput_reinit = .TRUE.  !! To change N INPUT file in a run. (true/false)
+!$OMP THREADPRIVATE(ninput_reinit)
+
+  !
+  ! PARAMETERS USED BY BOTH HYDROLOGY MODELS
+  !
+  REAL(r_std), SAVE :: max_snow_age = 50._r_std !! Maximum period of snow aging (days)
+!$OMP THREADPRIVATE(max_snow_age)
+  REAL(r_std), SAVE :: snow_trans = 0.2_r_std   !! Transformation time constant for snow (m), reduced from the value 0.3 (04/07/2016)
+!$OMP THREADPRIVATE(snow_trans)
+  REAL(r_std), SAVE :: sneige                   !! Lower limit of snow amount (kg.m^{-2})
+!$OMP THREADPRIVATE(sneige)
+  REAL(r_std), SAVE :: maxmass_snow = 3000.     !! The maximum mass of snow (kg.m^{-2})
+!$OMP THREADPRIVATE(maxmass_snow)
+
+  !! Heat capacity
+  REAL(r_std), PARAMETER :: capa_ice = 2.228*1.E3       !! Heat capacity of ice (J/kg/K)
+  REAL(r_std), SAVE      :: so_capa_ice                 !! Heat capacity of saturated frozen soil (J/K/m3)
+!$OMP THREADPRIVATE(so_capa_ice)
+  REAL(r_std), PARAMETER :: rho_water = 1000.           !! Density of water (kg/m3)
+  REAL(r_std), PARAMETER :: rho_ice = 920.              !! Density of ice (kg/m3)
+
+  !! Thermal conductivities
+  REAL(r_std), PARAMETER :: cond_water = 0.6            !! Thermal conductivity of liquid water (W/m/K)
+  REAL(r_std), PARAMETER :: cond_ice = 2.2              !! Thermal conductivity of ice (W/m/K)
+  REAL(r_std), PARAMETER :: cond_solid = 2.32           !! Thermal conductivity of mineral soil particles (W/m/K)
+
+  !! Time constant of long-term soil humidity (s) 
+  REAL(r_std), PARAMETER :: lhf = 0.3336*1.E6           !! Latent heat of fusion (J/kg)
+
+  INTEGER(i_std), PARAMETER :: nsnow=3                  !! Number of levels in the snow for explicit snow scheme   
+  REAL(r_std), PARAMETER    :: XMD    = 28.9644E-3 
+  REAL(r_std), PARAMETER    :: XBOLTZ      = 1.380658E-23 
+  REAL(r_std), PARAMETER    :: XAVOGADRO   = 6.0221367E+23 
+  REAL(r_std), PARAMETER    :: XRD    = XAVOGADRO * XBOLTZ / XMD 
+  REAL(r_std), PARAMETER    :: XCPD   = 7.* XRD /2. 
+  REAL(r_std), PARAMETER    :: phigeoth = 0.057 ! 0. DKtest 
+  REAL(r_std), PARAMETER    :: thick_min_snow = .01 
+
+  !! The maximum snow density and water holding characterisicts 
+  REAL(r_std), SAVE         :: xrhosmax         = 750.  !! (kg m-3) 
+  REAL(r_std), SAVE         :: xwsnowholdmax1   = 0.03  !! (-) 
+  REAL(r_std), SAVE         :: xwsnowholdmax2   = 0.10  !! (-) 
+  REAL(r_std), SAVE         :: xsnowrhohold     = 200.0 !! (kg/m3) 
+  REAL(r_std), SAVE         :: xrhosmin = 50. 
+  REAL(r_std), PARAMETER    :: xci = 2.106e+3 
+  REAL(r_std), PARAMETER    :: xrv = 6.0221367e+23 * 1.380658e-23 /18.0153e-3 
+
+  !! ISBA-ES Critical snow depth at which snow grid thicknesses constant 
+  REAL(r_std), PARAMETER    :: xsnowcritd = 0.03  ! (m) 
+
+  !! The threshold of snow depth used for preventing numerical problem in thermal calculations
+  REAL(r_std), PARAMETER    :: snowcritd_thermal = 0.01  ! (m)  
+  
+  !! ISBA-ES CROCUS (Pahaut 1976): snowfall density coefficients: 
+  REAL(r_std), PARAMETER       :: snowfall_a_sn = 109.0  !! (kg/m3) 
+  REAL(r_std), PARAMETER       :: snowfall_b_sn =   6.0  !! (kg/m3/K) 
+  REAL(r_std), PARAMETER       :: snowfall_c_sn =  26.0  !! [kg/(m7/2 s1/2)] 
+
+  REAL(r_std), PARAMETER       :: dgrain_new_max=  2.0e-4!! (m) : Maximum grain size of new snowfall 
+  
+  !! Used in explicitsnow to prevent numerical problems as snow becomes vanishingly thin. 
+  REAL(r_std), PARAMETER                :: psnowdzmin = .0001   ! m 
+  REAL(r_std), PARAMETER                :: xsnowdmin = .000001  ! m 
+
+  REAL(r_std), PARAMETER                :: ph2o = 1000.         !! Water density [kg/m3] 
+  
+  ! ISBA-ES Thermal conductivity coefficients from Anderson (1976): 
+  ! see Boone, Meteo-France/CNRM Note de Centre No. 70 (2002) 
+  REAL(r_std), SAVE                     :: ZSNOWTHRMCOND1 = 0.02    ! [W/m/K] 
+  REAL(r_std), SAVE                     :: ZSNOWTHRMCOND2 = 2.5E-6  ! [W m5/(kg2 K)] 
+  
+  ! ISBA-ES Thermal conductivity: Implicit vapor diffn effects 
+  ! (sig only for new snow OR high altitudes) 
+  ! from Sun et al. (1999): based on data from Jordan (1991) 
+  ! see Boone, Meteo-France/CNRM Note de Centre No. 70 (2002) 
+  ! 
+  REAL(r_std), SAVE         :: ZSNOWTHRMCOND_AVAP  = -0.06023 !! (W/m/K) 
+  REAL(r_std), SAVE         :: ZSNOWTHRMCOND_BVAP  = -2.5425  !! (W/m) 
+  REAL(r_std), SAVE         :: ZSNOWTHRMCOND_CVAP  = -289.99  !! (K) 
+  
+  REAL(r_std),SAVE          :: xansmax = 0.85                 !! Maxmimum snow albedo
+  REAL(r_std),SAVE          :: xansmin = 0.50                 !! Miniumum snow albedo
+  REAL(r_std),SAVE          :: xans_todry = 0.008             !! Albedo decay rate for dry snow
+  REAL(r_std),SAVE          :: xans_t = 0.240                 !! Albedo decay rate for wet snow
+
+  ! ISBA-ES Thermal conductivity coefficients from Anderson (1976):
+  ! see Boone, Meteo-France/CNRM Note de Centre No. 70 (2002)
+  REAL(r_std), PARAMETER                  :: XP00 = 1.E5
+
+  ! ISBA-ES Thermal conductivity: Implicit vapor diffn effects
+  ! (sig only for new snow OR high altitudes)
+  ! from Sun et al. (1999): based on data from Jordan (1991)
+  ! see Boone, Meteo-France/CNRM Note de Centre No. 70 (2002)
+  !
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_RHOD  = 150.0        !! (kg/m3)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_ACM   = 2.8e-6       !! (1/s)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_BCM   = 0.04         !! (1/K) 
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_CCM   = 460.         !! (m3/kg)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_V0    = 3.7e7        !! (Pa/s) 
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_VT    = 0.081        !! (1/K)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_VR    = 0.018        !! (m3/kg)
+
+    !
+  ! PARAMETERS USED FOR CANOPY LAYERS (Albedo, photosynthesis, energy budget)
+  !
+
+  INTEGER(i_std), PARAMETER   :: nlevels = 1                  !! Originally the number of levels in the canopy used in  
+                                                              !! calculation of the energy budget. After the
+                                                              !! mleb calculations have been implemented in enerbil, 
+                                                              !! the jnlvls levels are determining the levels used 
+                                                              !! within the multi-layer energy budget calculations. However, 
+                                                              !! nlevels are still used in calculate_z_level_photo. Cannot 
+                                                              !! be deleted before any decision regarding the vertical 
+                                                              !! layering has been made.
+
+  INTEGER(i_std), SAVE        :: nlevels_photo                !! Number of levels in the canopy used in the photosynthesis
+                                                              !! routine per level dictacted by nlevels. For example, if
+                                                              !! if nlevels = 2 and nlevels_photo = 3, the photosynthesis
+                                                              !! will be calculated for 2*3=6 total levels. 
+!$OMP THREADPRIVATE(nlevels_photo)
+  INTEGER(i_std), SAVE        :: nlevels_tot                  !! Total number of levels, nlevels*nlevels_photo. Currently, 
+                                                              !! nlevels=1 is used, thus nlevels_tot=nevels_photo.
+                                                              !! Note that when using the multi-layer budget nlevels_photo 
+                                                              !! needs to be nlevels_photo=jnlvls_canopy+1
+
+!$OMP THREADPRIVATE(nlevels_tot)
+  INTEGER(i_std), SAVE        :: jnlvls=29                    !! Number of levels in the multilayer energy budget scheme
+!$OMP THREADPRIVATE(jnlvls)
+  INTEGER(i_std), SAVE        :: jnlvls_under=10              !! Number of levels in the understorey of the multilayer energy budget scheme
+!$OMP THREADPRIVATE(jnlvls_under)
+  INTEGER(i_std), SAVE        :: jnlvls_canopy=10             !! Number of levels in the canopy of the multilayer energy budget scheme
+!$OMP THREADPRIVATE(jnlvls_canopy)
+  INTEGER(i_std), SAVE        :: jnlvls_over=9                !! Number of levels in the overstorey of the multilayer energy budget scheme
+!$OMP THREADPRIVATE(jnlvls_over)
+
+
+  INTEGER(i_std), SAVE        :: nlev_top                     !! Maximum number of canopy levels that are used to construct the "top"
+                                                              !! layer of the canopy. The top layer is used in the calculation
+                                                              !! transpiration.
+!$OMP THREADPRIVATE(nlev_top) 
+  REAL(r_std), PARAMETER, &
+         DIMENSION (nlevels) :: z_level = (/ 0.0 /)           !! The height of the bottom of each canopy layer                                              
+                                                              !! @tex $(m)$ @endtex
+!$OMP THREADPRIVATE(z_level)
+
+
+
+  !
+  ! Parameters for determining the effective LAI for use in Pinty's albedo scheme
+  !
+  REAL(r_std), SAVE          ::  laieff_solar_angle           !! the zenith angle of the sun which determines our effective LAI
+                                                              !! Pinty et al recommend a value of 60 degrees for this regadless of the true
+                                                              !! solar zenith angle
+!$OMP THREADPRIVATE(laieff_solar_angle)
+  REAL(r_std), SAVE          ::  laieff_zero_cutoff           !! an arbitrary cutoff to prevent too low of values from being passed to
+                                                              !! routines in the calculation of the effective LAI
+!$OMP THREADPRIVATE(laieff_zero_cutoff)
+
+
+  !
+  ! PARAMETERS FOR HYDRAULIC ARCHITECTURE
+  !
+
+  REAL(r_std), SAVE, DIMENSION(2)         :: a_viscosity = (/0.556,0.022/) !! Empirical parameters to adjust the resistance of fine
+                                                                           !! root and sapwood to the temperature dependency of the
+                                                                           !! viscosity of water Cochard et al 2000
+!$OMP THREADPRIVATE(a_viscosity)
+
+  !
+  ! BVOC : Biogenic activity  for each age class
+  !
+  REAL(r_std), SAVE, DIMENSION(nleafages) :: iso_activity = (/0.5, 1.5, 1.5, 0.5/)     !! Biogenic activity for each 
+                                                                                       !! age class : isoprene (unitless)
+!$OMP THREADPRIVATE(iso_activity)
+  REAL(r_std), SAVE, DIMENSION(nleafages) :: methanol_activity = (/1., 1., 0.5, 0.5/)  !! Biogenic activity for each
+                                                                                       !! age class : methanol (unnitless)
+!$OMP THREADPRIVATE(methanol_activity)
+
+  !
+  ! condveg.f90
+  !
+
+  ! 1. Scalar
+
+  ! 1.1 Flags used inside the module
+
+  LOGICAL, SAVE :: alb_bare_model = .FALSE. !! Switch for choosing values of bare soil 
+                                            !! albedo (see header of subroutine)
+                                            !! (true/false)
+!$OMP THREADPRIVATE(alb_bare_model)
+  LOGICAL, SAVE :: alb_bg_modis = .FALSE.   !! Switch for choosing values of bare soil 
+                                            !! albedo read from file
+                                            !! (true/false)
+!$OMP THREADPRIVATE(alb_bg_modis)
+  LOGICAL, SAVE :: impaze = .FALSE.         !! Switch for choosing surface parameters
+                                            !! (see header of subroutine).  
+                                            !! (true/false)
+!$OMP THREADPRIVATE(impaze)
+  LOGICAL, SAVE :: rough_dyn = .FALSE.      !! Chooses between two methods to calculate the 
+                                            !! the roughness height : static or dynamic (varying with LAI)
+                                            !! (true/false)
+!$OMP THREADPRIVATE(rough_dyn)
+
+  LOGICAL, SAVE :: new_watstress = .FALSE.
+!$OMP THREADPRIVATE(new_watstress)
+     
+  REAL(r_std), SAVE :: alpha_watstress = 1.
+!$OMP THREADPRIVATE(alpha_watstress)
+
+  LOGICAL, SAVE :: sla_dyn = .FALSE.        !! Chooses between two methods to calculate the 
+                                            !! specific leaf area: static or dynamic (varying with LAI or biomass)
+                                            !! (true/false)
+!$OMP THREADPRIVATE(sla_dyn)  
+  
+  ! 1.2 Others 
+
+  REAL(r_std), SAVE :: height_displacement = 0.66        !! Factor to calculate the zero-plane displacement
+                                                         !! height from vegetation height (m)
+!$OMP THREADPRIVATE(height_displacement)
+  REAL(r_std), SAVE :: z0_bare = 0.01                    !! bare soil roughness length (m)
+!$OMP THREADPRIVATE(z0_bare)
+  REAL(r_std), SAVE :: z0_ice = 0.001                    !! ice roughness length (m)
+!$OMP THREADPRIVATE(z0_ice)
+  REAL(r_std), SAVE :: tcst_snowa = 10.0                 !! Time constant of the albedo decay of snow (days), increased from the value 5.0 (04/07/2016)
+!$OMP THREADPRIVATE(tcst_snowa)
+  REAL(r_std), SAVE :: snowcri_alb = 10.                 !! Critical value for computation of snow albedo (cm)
+!$OMP THREADPRIVATE(snowcri_alb)
+  REAL(r_std), SAVE :: fixed_snow_albedo = undef_sechiba !! To choose a fixed snow albedo value (unitless)
+!$OMP THREADPRIVATE(fixed_snow_albedo)
+  REAL(r_std), SAVE :: z0_scal = 0.15                    !! Surface roughness height imposed (m)
+!$OMP THREADPRIVATE(z0_scal)
+  REAL(r_std), SAVE :: roughheight_scal = zero           !! Effective roughness Height depending on zero-plane 
+                                                         !! displacement height (m) (imposed)
+!$OMP THREADPRIVATE(roughheight_scal)
+  REAL(r_std), SAVE :: emis_scal = 1.0                   !! Surface emissivity imposed (unitless)
+!$OMP THREADPRIVATE(emis_scal)
+
+  REAL(r_std), SAVE :: c1 = 0.32                         !! Constant used in the formulation of the ratio of 
+!$OMP THREADPRIVATE(c1)                                  !! friction velocity to the wind speed at the canopy top
+                                                         !! see Ershadi et al. (2015) for more info
+  REAL(r_std), SAVE :: c2 = 0.264                        !! Constant used in the formulation of the ratio of 
+!$OMP THREADPRIVATE(c2)                                  !! friction velocity to the wind speed at the canopy top
+                                                         !! see Ershadi et al. (2015) for more info
+  REAL(r_std), SAVE :: c3 = 15.1                         !! Constant used in the formulation of the ratio of 
+!$OMP THREADPRIVATE(c3)                                  !! friction velocity to the wind speed at the canopy top
+                                                         !! see Ershadi et al. (2015) for more info
+  REAL(r_std), SAVE :: Cdrag_foliage = 0.2               !! Drag coefficient of the foliage
+!$OMP THREADPRIVATE(Cdrag_foliage)                       !! See Ershadi et al. (2015) and Su et. al (2001) for more info
+  REAL(r_std), SAVE :: Ct = 0.01                         !! Heat transfer coefficient of the leaf
+!$OMP THREADPRIVATE(Ct)                                  !! See Ershadi et al. (2015) and Su et. al (2001) for more info
+  REAL(r_std), SAVE :: Prandtl = 0.71                    !! Prandtl number used in the calculation of Ct_star
+!$OMP THREADPRIVATE(Prandtl)                             !! See Su et. al (2001) for more info
+
+  
+! 2. Arrays
+ 
+  REAL(r_std), SAVE, DIMENSION(2) :: alb_deadleaf = (/ .12, .35/)    !! albedo of dead leaves, VIS+NIR (unitless)
+!$OMP THREADPRIVATE(alb_deadleaf)
+  REAL(r_std), SAVE, DIMENSION(2) :: alb_ice = (/ .60, .20/)         !! albedo of ice, VIS+NIR (unitless)
+!$OMP THREADPRIVATE(alb_ice)
+  REAL(r_std), SAVE, DIMENSION(2) :: albedo_scal = (/ 0.25, 0.25 /)  !! Albedo values for visible and near-infrared 
+                                                                     !! used imposed (unitless) 
+!$OMP THREADPRIVATE(albedo_scal)
+  REAL(r_std) , SAVE, DIMENSION(classnb) :: vis_dry = (/0.24,&
+       &0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.27/)  !! Soil albedo values to soil colour classification:
+                                                          !! dry soil albedo values in visible range
+!$OMP THREADPRIVATE(vis_dry)
+  REAL(r_std), SAVE, DIMENSION(classnb) :: nir_dry = (/0.48,&
+       &0.44, 0.40, 0.36, 0.32, 0.28, 0.24, 0.20, 0.55/)  !! Soil albedo values to soil colour classification:
+                                                          !! dry soil albedo values in near-infrared range 
+!$OMP THREADPRIVATE(nir_dry)
+  REAL(r_std), SAVE, DIMENSION(classnb) :: vis_wet = (/0.12,&
+       &0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05, 0.15/)  !! Soil albedo values to soil colour classification:
+                                                          !! wet soil albedo values in visible range 
+!$OMP THREADPRIVATE(vis_wet)
+  REAL(r_std), SAVE, DIMENSION(classnb) :: nir_wet = (/0.24,&
+       &0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.31/)  !! Soil albedo values to soil colour classification:
+                                                          !! wet soil albedo values in near-infrared range
+!$OMP THREADPRIVATE(nir_wet)
+  REAL(r_std), SAVE, DIMENSION(classnb) :: albsoil_vis = (/ &
+       &0.18, 0.16, 0.16, 0.15, 0.12, 0.105, 0.09, 0.075, 0.25/)   !! Soil albedo values to soil colour classification:
+                                                                   !! Averaged of wet and dry soil albedo values
+                                                                   !! in visible and near-infrared range
+!$OMP THREADPRIVATE(albsoil_vis) 
+  REAL(r_std), SAVE, DIMENSION(classnb) :: albsoil_nir = (/ &
+       &0.36, 0.34, 0.34, 0.33, 0.30, 0.25, 0.20, 0.15, 0.45/)  !! Soil albedo values to soil colour classification:
+                                                                !! Averaged of wet and dry soil albedo values
+                                                                !! in visible and near-infrared range
+!$OMP THREADPRIVATE(albsoil_nir)
+  REAL(r_std) :: alb_threshold = 0.0000000001_r_std       !! A threshold for the iteration of the
+                                                          !! multilevel albedo.  Could be externalised.
+                                                          !! Fairly arbitrary, although if a level has
+                                                          !! no LAI the absorption often ends up being
+                                                          !! equal to this value, so it should not
+                                                          !! be high.
+!$OMP THREADPRIVATE(alb_threshold)
+
+
+
+  !
+  ! diffuco.f90
+  !
+
+  ! 0. Constants
+
+  REAL(r_std), PARAMETER :: Tetens_1 = 0.622         !! Ratio between molecular weight of water vapor and molecular weight  
+                                                     !! of dry air (unitless)
+  REAL(r_std), PARAMETER :: Tetens_2 = 0.378         !!
+  REAL(r_std), PARAMETER :: ratio_H2O_to_CO2 = 1.6   !! Ratio of water vapor diffusivity to the CO2 diffusivity (unitless)
+  REAL(r_std), PARAMETER :: mol_to_m_1 = 0.0244      !!
+  REAL(r_std), PARAMETER :: RG_to_PAR = 0.5          !!
+  REAL(r_std), PARAMETER :: W_to_mol = 4.6           !! W_to_mmol * RG_to_PAR = 2.3
+
+  ! 1. Scalar
+
+  INTEGER(i_std), SAVE :: nlai = 10             !! Number of LAI levels (unitless)
+!$OMP THREADPRIVATE(nlai)
+  LOGICAL, SAVE :: ldq_cdrag_from_gcm = .FALSE. !! Set to .TRUE. if you want q_cdrag coming from GCM
+!$OMP THREADPRIVATE(ldq_cdrag_from_gcm)
+  REAL(r_std), SAVE :: laimax = 12.             !! Maximal LAI used for splitting LAI into N layers (m^2.m^{-2})
+!$OMP THREADPRIVATE(laimax)
+  LOGICAL, SAVE :: downregulation_co2 = .FALSE.            !! Set to .TRUE. if you want CO2 downregulation.
+!$OMP THREADPRIVATE(downregulation_co2)
+  REAL(r_std), SAVE :: downregulation_co2_baselevel = 280. !! CO2 base level (ppm)
+!$OMP THREADPRIVATE(downregulation_co2_baselevel)
+  REAL(r_std), SAVE :: gb_ref = 1./25.                     !! Leaf bulk boundary layer resistance (s m-1)
+!$OMP THREADPRIVATE(gb_ref)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: lai_level_depth = 0.15  !!
+!$OMP THREADPRIVATE(lai_level_depth)
+!
+  REAL(r_std), SAVE :: x1_coef =  0.177        !! Multiplicative factor for calculating the pseudo first order rate constant
+                                               !! of assimilation response to
+                                               !co2 kt (unitless)
+!$OMP THREADPRIVATE(x1_coef)
+  REAL(r_std), SAVE :: x1_Q10 =  0.069         !! Exponential factor in the equation defining kt (unitless)
+!$OMP THREADPRIVATE(x1_Q10)
+  REAL(r_std), SAVE :: quantum_yield =  0.092  !!
+!$OMP THREADPRIVATE(quantum_yield)
+  REAL(r_std), SAVE :: kt_coef = 0.7           !! Multiplicative factor in the equation defining kt (unitless)
+!$OMP THREADPRIVATE(kt_coef)
+  REAL(r_std), SAVE :: kc_coef = 39.09         !! Multiplicative factor for calculating the Michaelis-Menten
+                                               !! coefficient Kc (unitless)
+!$OMP THREADPRIVATE(kc_coef)
+  REAL(r_std), SAVE :: Ko_Q10 = 0.085          !! Exponential factor for calculating the Michaelis-Menten coefficients
+                                               !! Kc and Ko (unitless)
+!$OMP THREADPRIVATE(Ko_Q10)
+  REAL(r_std), SAVE :: Oa = 210000.            !! Intercellular concentration of O2 (ppm)
+!$OMP THREADPRIVATE(Oa)
+  REAL(r_std), SAVE :: Ko_coef =  2.412        !! Multiplicative factor for calculating the Michaelis-Menten 
+                                               !! coefficient Ko (unitless)
+!$OMP THREADPRIVATE(Ko_coef)
+  REAL(r_std), SAVE :: CP_0 = 42.              !! Multiplicative factor for calculating the CO2 compensation 
+                                               !! point CP (unitless)
+!$OMP THREADPRIVATE(CP_0)
+  REAL(r_std), SAVE :: CP_temp_coef = 9.46     !! Exponential factor for calculating the CO2 compensation point CP (unitless)
+!$OMP THREADPRIVATE(CP_temp_coef)
+  REAL(r_std), SAVE :: CP_temp_ref = 25.       !! Reference temperature for the CO2 compensation point CP (C)
+!$OMP THREADPRIVATE(CP_temp_ref)
+  !
+  REAL(r_std), SAVE, DIMENSION(2) :: rt_coef = (/ 0.8, 1.3 /)    !!
+!$OMP THREADPRIVATE(rt_coef)
+  REAL(r_std), SAVE, DIMENSION(2) :: vc_coef = (/ 0.39, 0.3 /)   !!
+!$OMP THREADPRIVATE(vc_coef)
+  REAL(r_std), SAVE               :: c13_a = 4.4      !! fractionation against during diffusion
+!$OMP THREADPRIVATE(c13_a)
+  REAL(r_std), SAVE               :: c13_b = 27.      !! fractionation against during carboxylation
+!$OMP THREADPRIVATE(c13_b)
+  REAL(r_std), SAVE               :: threshold_c13_assim = 0.01 !! If assimilation falls below this threshold
+                                                                !! the delta_c13
+                                                                !is set to zero
+  !
+  REAL(r_std), SAVE, DIMENSION(6) :: dew_veg_poly_coeff = &            !! coefficients of the 5 degree polynomomial used
+  & (/ 0.887773, 0.205673, 0.110112, 0.014843,  0.000824,  0.000017 /) !! in the equation of coeff_dew_veg
+!$OMP THREADPRIVATE(dew_veg_poly_coeff)
+!
+  REAL(r_std), SAVE               :: Oi=210000.    !! Intercellular oxygen partial pressure (ubar)
+!$OMP THREADPRIVATE(Oi)
+  !
+  ! slowproc.f90 
+  !
+
+  ! 1. Scalar
+
+  INTEGER(i_std), SAVE :: veget_year_orig = 0        !!  first year for landuse (number)
+!$OMP THREADPRIVATE(veget_year_orig)
+  INTEGER(i_std), SAVE :: ninput_year_orig = 0       !!  first year for N inputs (number)
+!$OMP THREADPRIVATE(ninput_year_orig)
+  LOGICAL, SAVE :: ninput_suffix_year = .FALSE.      !! Do the Ninput datasets have a 'year' suffix ? (y/n)  
+!$OMP THREADPRIVATE(ninput_suffix_year)
+  REAL(r_std), SAVE :: clayfraction_default = 0.2    !! Default value for clay fraction (0-1, unitless)
+!$OMP THREADPRIVATE(clayfraction_default)
+  REAL(r_std), SAVE :: sandfraction_default = 0.3    !! Default value for sand fraction (0-1, unitless)
+!$OMP THREADPRIVATE(clayfraction_default)
+  REAL(r_std), SAVE :: siltfraction_default = 0.5    !! Default value for silt fraction (0-1, unitless)
+!$OMP THREADPRIVATE(siltfraction_default)
+  REAL(r_std), SAVE :: bulk_default = 1000           !! Default value for bulk density of soil (kg/m3)
+!$OMP THREADPRIVATE(bulk_default)
+  REAL(r_std), SAVE :: ph_default = 5.5              !! Default value for pH of soil (-)
+!$OMP THREADPRIVATE(ph_default)
+  REAL(r_std), SAVE :: min_vegfrac = 0.001           !! Minimal fraction of mesh a vegetation type can occupy (0-1, unitless)
+!$OMP THREADPRIVATE(min_vegfrac)
+  REAL(r_std), SAVE :: frac_nobio_fixed_test_1 = 0.0 !! Value for frac_nobio for tests in 0-dim simulations (0-1, unitless)
+!$OMP THREADPRIVATE(frac_nobio_fixed_test_1)
+  
+  REAL(r_std), SAVE :: stempdiag_bid = 280.          !! only needed for an initial LAI if there is no restart file
+!$OMP THREADPRIVATE(stempdiag_bid)
+
+
+                           !-----------------------------!
+                           !  STOMATE AND LPJ PARAMETERS !
+                           !-----------------------------!
+
+
+  !
+  ! lpj_constraints.f90
+  !
+  
+  ! 1. Scalar
+
+  REAL(r_std), SAVE  :: too_long = 5.      !! longest sustainable time without 
+                                           !! regeneration (vernalization) (years)
+!$OMP THREADPRIVATE(too_long)
+
+
+  !
+  ! lpj_establish.f90
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: estab_max_tree = 0.12   !! Maximum tree establishment rate (ind/m2/dt_stomate)
+!$OMP THREADPRIVATE(estab_max_tree)
+  REAL(r_std), SAVE :: estab_max_grass = 0.12  !! Maximum grass establishment rate (ind/m2/dt_stomate)
+!$OMP THREADPRIVATE(estab_max_grass)
+  
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: establish_scal_fact = 5.  !!
+!$OMP THREADPRIVATE(establish_scal_fact)
+  REAL(r_std), SAVE :: max_tree_coverage = 0.98  !! (0-1, unitless)
+!$OMP THREADPRIVATE(max_tree_coverage)
+  REAL(r_std), SAVE :: ind_0_estab = 0.2         !! = ind_0 * 10.
+!$OMP THREADPRIVATE(ind_0_estab)
+
+
+  !
+  ! lpj_fire.f90
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: tau_fire = 30.           !! Time scale for memory of the fire index (days).
+!$OMP THREADPRIVATE(tau_fire)
+  REAL(r_std), SAVE :: litter_crit = 200.       !! Critical litter quantity for fire
+                                                !! below which iginitions extinguish 
+                                                !! @tex $(gC m^{-2})$ @endtex
+!$OMP THREADPRIVATE(litter_crit)
+  REAL(r_std), SAVE :: fire_resist_lignin = 0.5 !!
+!$OMP THREADPRIVATE(fire_resist_lignin)
+  ! 2. Arrays
+
+  REAL(r_std), SAVE, DIMENSION(nparts) :: co2frac = &    !! The fraction of the different biomass 
+       & (/ .95, .95, 0., 0.3, 0., 0., .95, .95, .95 /)       !! compartments emitted to the atmosphere 
+!$OMP THREADPRIVATE(co2frac)                                                         !! when burned (unitless, 0-1)  
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE, DIMENSION(3) :: bcfrac_coeff = (/ .3,  1.3,  88.2 /)         !! (unitless)
+!$OMP THREADPRIVATE(bcfrac_coeff)
+  REAL(r_std), SAVE, DIMENSION(4) :: firefrac_coeff = (/ 0.45, 0.8, 0.6, 0.13 /)  !! (unitless)
+!$OMP THREADPRIVATE(firefrac_coeff)
+
+  !
+  ! lpj_gap.f90
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: ref_greff = 0.035         !! Asymptotic maximum mortality rate
+                                                 !! @tex $(year^{-1})$ @endtex
+!$OMP THREADPRIVATE(ref_greff)
+
+  !               
+  ! lpj_light.f90 
+  !              
+
+  ! 1. Scalar
+  
+  LOGICAL, SAVE :: annual_increase = .TRUE. !! for diagnosis of fpc increase, compare today's fpc to last year's maximum (T) or
+                                            !! to fpc of last time step (F)? (true/false)
+!$OMP THREADPRIVATE(annual_increase)
+  REAL(r_std), SAVE :: min_cover = 0.05     !! For trees, minimum fraction of crown area occupied
+                                            !! (due to its branches etc.) (0-1, unitless)
+                                            !! This means that only a small fraction of its crown area
+                                            !! can be invaded by other trees.
+!$OMP THREADPRIVATE(min_cover)
+  !
+  ! lpj_pftinout.f90 
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: min_avail = 0.01         !! minimum availability
+!$OMP THREADPRIVATE(min_avail)
+  REAL(r_std), SAVE :: ind_0 = 0.02             !! initial density of individuals
+!$OMP THREADPRIVATE(ind_0)
+  ! 3. Coefficients of equations
+  
+  REAL(r_std), SAVE :: RIP_time_min = 1.25      !! test whether the PFT has been eliminated lately (years)
+!$OMP THREADPRIVATE(RIP_time_min)
+  REAL(r_std), SAVE :: npp_longterm_init = 10.  !! Initialisation value for npp_longterm (gC.m^{-2}.year^{-1})
+!$OMP THREADPRIVATE(npp_longterm_init)
+  REAL(r_std), SAVE :: everywhere_init = 0.05   !!
+!$OMP THREADPRIVATE(everywhere_init)
+
+
+
+
+  !
+  ! stomate_data.f90 
+  !
+
+  ! 1. Scalar 
+
+  ! 1.2 climatic parameters 
+
+  REAL(r_std), SAVE :: precip_crit = 100.        !! minimum precip, in (mm/year)
+!$OMP THREADPRIVATE(precip_crit)
+  REAL(r_std), SAVE :: gdd_crit_estab = 150.     !! minimum gdd for establishment of saplings
+!$OMP THREADPRIVATE(gdd_crit_estab)
+  REAL(r_std), SAVE :: fpc_crit = 0.95           !! critical fpc, needed for light competition and establishment (0-1, unitless)
+!$OMP THREADPRIVATE(fpc_crit)
+
+  ! 1.3 sapling characteristics
+
+  REAL(r_std), SAVE :: alpha_grass = 0.5         !! alpha coefficient for grasses (unitless)
+!$OMP THREADPRIVATE(alpha_grass)
+  REAL(r_std), SAVE :: alpha_tree = 1.           !! alpha coefficient for trees (unitless)
+!$OMP THREADPRIVATE(alpha_tree)
+  REAL(r_std), SAVE :: struct_to_leaves = 0.05  !! Fraction of structural carbon in grass and crops as a share of the leaf
+                                                !! carbon pool. Only used for grasses and crops (thus NOT for trees)
+	                                        !! (unitless)
+!$OMP THREADPRIVATE(struct_to_leaves)
+
+  REAL(r_std), SAVE :: labile_to_total = 0.01   !! Fraction of the labile pool in trees, grasses and crops as a share of the
+                                                !! total carbon pool (accounting for the N-content of the different tissues).
+                                                !! (unitless)
+!$OMP THREADPRIVATE(labile_to_total)
+
+
+
+  ! 1.4  time scales for phenology and other processes (in days)
+  REAL(r_std), SAVE :: tau_hum_month = 20.        !! (days)       
+!$OMP THREADPRIVATE(tau_hum_month)
+  REAL(r_std), SAVE :: tau_hum_week = 7.          !! (days)  
+!$OMP THREADPRIVATE(tau_hum_week)
+  REAL(r_std), SAVE :: tau_t2m_month = 20.        !! (days)      
+!$OMP THREADPRIVATE(tau_t2m_month)
+  REAL(r_std), SAVE :: tau_t2m_week = 7.          !! (days)  
+!$OMP THREADPRIVATE(tau_t2m_week)
+  REAL(r_std), SAVE :: tau_tsoil_month = 20.      !! (days)     
+!$OMP THREADPRIVATE(tau_tsoil_month)
+  REAL(r_std), SAVE :: tau_soilhum_month = 20.    !! (days)     
+!$OMP THREADPRIVATE(tau_soilhum_month)
+  REAL(r_std), SAVE :: tau_gpp_week = 7.          !! (days)  
+!$OMP THREADPRIVATE(tau_gpp_week)
+  REAL(r_std), SAVE :: tau_gdd = 40.              !! (days)  
+!$OMP THREADPRIVATE(tau_gdd)
+  REAL(r_std), SAVE :: tau_ngd = 50.              !! (days)  
+!$OMP THREADPRIVATE(tau_ngd)
+  REAL(r_std), SAVE :: coeff_tau_longterm = 3.    !! (unitless)
+!$OMP THREADPRIVATE(coeff_tau_longterm)
+  REAL(r_std), SAVE :: tau_longterm_max           !! (days)  
+!$OMP THREADPRIVATE(tau_longterm_max)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: bm_sapl_carbres = 5.             !!
+!$OMP THREADPRIVATE(bm_sapl_carbres)
+  REAL(r_std), SAVE :: bm_sapl_labile = 5.             !!
+!$OMP THREADPRIVATE(bm_sapl_carbres)
+  REAL(r_std), SAVE :: bm_sapl_sapabove = 0.5           !!
+!$OMP THREADPRIVATE(bm_sapl_sapabove)
+  REAL(r_std), SAVE :: bm_sapl_heartabove = 2.          !!
+!$OMP THREADPRIVATE(bm_sapl_heartabove)
+  REAL(r_std), SAVE :: bm_sapl_heartbelow = 2.          !!
+!$OMP THREADPRIVATE(bm_sapl_heartbelow)
+  REAL(r_std), SAVE :: init_sapl_mass_leaf_nat = 0.1    !!
+!$OMP THREADPRIVATE(init_sapl_mass_leaf_nat)
+  REAL(r_std), SAVE :: init_sapl_mass_leaf_agri = 1.    !!
+!$OMP THREADPRIVATE(init_sapl_mass_leaf_agri)
+  REAL(r_std), SAVE :: init_sapl_mass_carbres = 5.      !!
+!$OMP THREADPRIVATE(init_sapl_mass_carbres)
+  REAL(r_std), SAVE :: init_sapl_mass_labile = 5.      !!
+!$OMP THREADPRIVATE(init_sapl_mass_carbres)
+  REAL(r_std), SAVE :: init_sapl_mass_root = 0.1        !!
+!$OMP THREADPRIVATE(init_sapl_mass_root)
+  REAL(r_std), SAVE :: init_sapl_mass_fruit = 0.3       !!  
+!$OMP THREADPRIVATE(init_sapl_mass_fruit)
+  REAL(r_std), SAVE :: cn_sapl_init = 0.5               !!
+!$OMP THREADPRIVATE(cn_sapl_init)
+  REAL(r_std), SAVE :: migrate_tree = 10.*1.E3          !!
+!$OMP THREADPRIVATE(migrate_tree)
+  REAL(r_std), SAVE :: migrate_grass = 10.*1.E3         !!
+!$OMP THREADPRIVATE(migrate_grass)
+  REAL(r_std), SAVE :: lai_initmin_tree = 0.3           !!
+!$OMP THREADPRIVATE(lai_initmin_tree)
+  REAL(r_std), SAVE :: lai_initmin_grass = 0.1          !!
+!$OMP THREADPRIVATE(lai_initmin_grass)
+  REAL(r_std), SAVE, DIMENSION(2) :: dia_coeff = (/ 4., 0.5 /)            !!
+!$OMP THREADPRIVATE(dia_coeff)
+  REAL(r_std), SAVE, DIMENSION(2) :: maxdia_coeff =(/ 100., 0.01/)        !!
+!$OMP THREADPRIVATE(maxdia_coeff)
+  REAL(r_std), SAVE, DIMENSION(4) :: bm_sapl_leaf = (/ 4., 4., 0.8, 5./)  !!
+!$OMP THREADPRIVATE(bm_sapl_leaf)
+
+
+  !
+  ! stomate_litter.f90 
+  !
+
+  ! 0. Constants
+
+  REAL(r_std), PARAMETER :: Q10 = 10.               !!
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: z_decomp = 0.2               !!  Maximum depth for soil decomposer's activity (m)
+!$OMP THREADPRIVATE(z_decomp)
+
+  ! 2. Arrays
+
+  REAL(r_std), SAVE :: frac_soil_struct_sua = 0.4    !! corresponding to frac_soil(istructural,isurface,iabove) 
+!$OMP THREADPRIVATE(frac_soil_struct_sua)
+  REAL(r_std), SAVE :: frac_soil_struct_ab = 0.45   !! corresponding to frac_soil(istructural,iactive,ibelow)
+!$OMP THREADPRIVATE(frac_soil_struct_ab)
+  REAL(r_std), SAVE :: frac_soil_struct_sa = 0.7    !! corresponding to frac_soil(istructural,islow,iabove)
+!$OMP THREADPRIVATE(frac_soil_struct_sa)
+  REAL(r_std), SAVE :: frac_soil_struct_sb = 0.7    !! corresponding to frac_soil(istructural,islow,ibelow)
+!$OMP THREADPRIVATE(frac_soil_struct_sb)
+  REAL(r_std), SAVE :: frac_soil_metab_sua = 0.4    !! corresponding to frac_soil(imetabolic,iactive,iabove)
+!$OMP THREADPRIVATE(frac_soil_metab_sua)
+  REAL(r_std), SAVE :: frac_soil_metab_ab = 0.45    !! corresponding to frac_soil(imetabolic,iactive,ibelow)
+!$OMP THREADPRIVATE(frac_soil_metab_ab)
+  REAL(r_std), SAVE :: fungivores = 0.3    !! Fraction of decomposed litter consumed by fungivores    
+!$OMP THREADPRIVATE(fungivores)
+  REAL(r_std), SAVE :: frac_woody = 0.65   !! Coefficient for determining the lignin fraction of woody litter
+!$OMP THREADPRIVATE(frac_woody)
+  REAL(r_std), SAVE, DIMENSION(nparts) :: CN_fix = & !! C/N ratio of each plant pool (0-100, unitless)
+       & (/ 40., 40., 40., 40., 40., 40., 40., 40., 40. /) 
+!$OMP THREADPRIVATE(CN_fix)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: metabolic_ref_frac = 0.85    !! used by litter and soilcarbon (0-1, unitless)
+!$OMP THREADPRIVATE(metabolic_ref_frac)
+  REAL(r_std), SAVE :: metabolic_LN_ratio = 0.018   !! (0-1, unitless)   
+!$OMP THREADPRIVATE(metabolic_LN_ratio)
+  ! Turnover rate (yr-1) - From Parton et al., 1993
+  REAL(r_std), SAVE :: turn_metabolic = 15           !!
+!$OMP THREADPRIVATE(turn_metabolic)
+  REAL(r_std), SAVE :: turn_struct = 4                !!
+!$OMP THREADPRIVATE(turn_struct)
+  REAL(r_std), SAVE :: turn_woody = 1.33              !! from DOFOCO
+!$OMP THREADPRIVATE(turn_woody)
+  REAL(r_std), SAVE :: soil_Q10 = 0.69              !!= ln 2
+!$OMP THREADPRIVATE(soil_Q10)
+  REAL(r_std), SAVE :: tsoil_ref = 30.              !!
+!$OMP THREADPRIVATE(tsoil_ref)
+  REAL(r_std), SAVE :: litter_struct_coef = 3.      !! 
+!$OMP THREADPRIVATE(litter_struct_coef)
+  REAL(r_std), SAVE, DIMENSION(3) :: moist_coeff = (/ 1.1,  2.4,  0.29 /) !!
+!$OMP THREADPRIVATE(moist_coeff)
+  REAL(r_std), SAVE :: moistcont_min = 0.25  !! minimum soil wetness to limit the heterotrophic respiration
+!$OMP THREADPRIVATE(moistcont_min)
+
+
+  !
+  ! stomate_lpj.f90
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: frac_turnover_daily = 0.55  !! (0-1, unitless)
+!$OMP THREADPRIVATE(frac_turnover_daily)
+
+
+  !
+  ! stomate_npp.f90 
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: tax_max = 0.8 !! Maximum fraction of allocatable biomass used 
+                                     !! for maintenance respiration (0-1, unitless)
+!$OMP THREADPRIVATE(tax_max)
+
+
+  !
+  ! stomate_phenology.f90
+  !
+
+  ! 1. Scalar
+
+  LOGICAL, SAVE :: always_init = .FALSE.           !! take carbon from atmosphere if carbohydrate reserve too small? (true/false)
+!$OMP THREADPRIVATE(always_init)
+  REAL(r_std), SAVE :: min_growthinit_time = 300.  !! minimum time since last beginning of a growing season (days)
+!$OMP THREADPRIVATE(min_growthinit_time)
+  REAL(r_std), SAVE :: moiavail_always_tree = 1.0  !! moisture monthly availability above which moisture tendency doesn't matter
+                                                   !!  - for trees (0-1, unitless)
+!$OMP THREADPRIVATE(moiavail_always_tree)
+  REAL(r_std), SAVE :: moiavail_always_grass = 0.6 !! moisture monthly availability above which moisture tendency doesn't matter
+                                                   !! - for grass (0-1, unitless)
+!$OMP THREADPRIVATE(moiavail_always_grass)
+  REAL(r_std), SAVE :: t_always                    !! monthly temp. above which temp. tendency doesn't matter
+!$OMP THREADPRIVATE(t_always)
+  REAL(r_std), SAVE :: t_always_add = 10.          !! monthly temp. above which temp. tendency doesn't matter (C)
+!$OMP THREADPRIVATE(t_always_add)
+
+  ! 3. Coefficients of equations
+  
+  REAL(r_std), SAVE :: gddncd_ref = 603.           !!
+!$OMP THREADPRIVATE(gddncd_ref)
+  REAL(r_std), SAVE :: gddncd_curve = 0.0091       !!
+!$OMP THREADPRIVATE(gddncd_curve)
+  REAL(r_std), SAVE :: gddncd_offset = 64.         !!
+!$OMP THREADPRIVATE(gddncd_offset)
+
+
+  !
+  ! stomate_prescribe.f90
+  !
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: bm_sapl_rescale = 40.       !!
+!$OMP THREADPRIVATE(bm_sapl_rescale)
+
+
+  !
+  ! stomate_resp.f90
+  !
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: maint_resp_min_vmax = 0.3   !!
+!$OMP THREADPRIVATE(maint_resp_min_vmax)
+  REAL(r_std), SAVE :: maint_resp_coeff = 1.4      !!
+!$OMP THREADPRIVATE(maint_resp_coeff)
+
+
+  !
+  ! stomate_som_dynamics.f90 (in stomate_soilcarbon.f90)   
+  !
+
+  ! 2. Arrays 
+
+  ! 2.1 Fixed fraction from one pool to another (or to CO2 emission)
+
+  REAL(r_std), SAVE :: active_to_pass_ref_frac = 0.003  !! from active pool: depends on clay content  (0-1, unitless)
+                                                        !! corresponding to frac_carb(:,iactive,ipassive)
+  REAL(r_std), SAVE :: surf_to_slow_ref_frac = 0.4      !! from surface pool
+                                                        !! corresponding to frac_carb(:,isurf,islow)
+  REAL(r_std), SAVE :: active_to_CO2_ref_frac  = 0.85   !! from active pool: depends on clay content  (0-1, unitless)
+                                                        !! corresponding to frac_resp(:,iactive)
+!$OMP THREADPRIVATE(active_to_CO2_ref_frac)
+  REAL(r_std), SAVE :: slow_to_pass_ref_frac   = 0.003  !! from slow pool: depends on clay content  (0-1, unitless) 
+                                                        !! corresponding to frac_carb(:,islow,ipassive)
+!$OMP THREADPRIVATE(slow_to_pass_ref_frac)
+  REAL(r_std), SAVE :: slow_to_CO2_ref_frac    = 0.55   !! from slow pool (0-1, unitless) 
+                                                        !! corresponding to frac_resp(:,islow)
+!$OMP THREADPRIVATE(slow_to_CO2_ref_frac)
+  REAL(r_std), SAVE :: pass_to_active_ref_frac = 0.45   !! from passive pool (0-1, unitless)
+                                                        !! corresponding to frac_carb(:,ipassive,iactive)
+!$OMP THREADPRIVATE(pass_to_active_ref_frac)
+  REAL(r_std), SAVE :: pass_to_slow_ref_frac   = 0.0    !! from passive pool (0-1, unitless)
+                                                        !! corresponding to frac_carb(:,ipassive,islow)
+!$OMP THREADPRIVATE(pass_to_slow_ref_frac)
+
+  ! 2.2 som carbon pools
+
+  REAL(r_std), SAVE :: som_init_active = 1000           !! Initial active SOM carbon (g m-2) 
+!$OMP THREADPRIVATE(som_init_active)
+  REAL(r_std), SAVE :: som_init_slow = 3000             !! Initial slow SOM carbon (g m-2)
+!$OMP THREADPRIVATE(som_init_slow)
+  REAL(r_std), SAVE :: som_init_passive = 3000          !! Initial passive SOM carbon (g m-2)
+!$OMP THREADPRIVATE(som_init_passive
+  REAL(r_std), SAVE :: som_init_surface = 1000          !! Initial surface SOM carbon (g m-2)
+!$OMP THREADPRIVATE(som_init_surface)
+
+  ! 3. Define Variable fraction from one pool to another (function of silt and clay fraction)
+  REAL(r_std), SAVE :: active_to_pass_clay_frac     = 0.032
+!$OMP THREADPRIVATE(active_to_pass_clay_frac)
+  !! residence times in carbon pools (days)
+
+  REAL(r_std), SAVE :: active_to_CO2_clay_silt_frac = 0.68
+!$OMP THREADPRIVATE(active_to_pass_clay_frac)
+  REAL(r_std), SAVE :: slow_to_pass_clay_frac   = -0.009 
+!$OMP THREADPRIVATE(slow_to_pass_clay_frac)
+
+  ! C to N target ratios of differnt pools
+  REAL(r_std), SAVE ::  CN_target_iactive_ref  = 15. !! CN target ratio of active pool for soil min N = 0
+!$OMP THREADPRIVATE(CN_target_iactive_ref)
+  REAL(r_std), SAVE ::  CN_target_islow_ref    = 20. !! CN target ratio of slow pool for soil min N = 0
+!$OMP THREADPRIVATE(CN_target_islow_ref)
+  REAL(r_std), SAVE ::  CN_target_ipassive_ref = 10. !! CN target ratio of passive pool for soil min N = 0
+!$OMP THREADPRIVATE(CN_target_ipassive_ref)
+  REAL(r_std), SAVE ::  CN_target_isurface_ref = 20. !! CN target ratio of surface pool for litter nitrogen content = 0
+!$OMP THREADPRIVATE(CN_target_isurface_ref)
+
+  REAL(r_std), SAVE ::  CN_target_iactive_Nmin  = -6.  !! CN target ratio change per mineral N unit (g m-2) for active pool 
+  REAL(r_std), SAVE ::  CN_target_islow_Nmin    = -4.  !! CN target ratio change per mineral N unit (g m-2) for slow pool 
+  REAL(r_std), SAVE ::  CN_target_ipassive_Nmin = -1.5 !! CN target ratio change per mineral N unit (g m-2) for passive pool 
+  REAL(r_std), SAVE ::  CN_target_isurface_pnc  = -5.  !! CN target ratio change per plant nitrogen content unit (%) for surface pool
+  !! Turnover in SOM pools (year-1)
+  REAL(r_std), SAVE :: som_turn_isurface    = 6.0      !! turnover of surface pool (year-1)
+!$OMP THREADPRIVATE(som_turn_isurface)
+  REAL(r_std), SAVE :: som_turn_iactive     = 7.3      !! turnover of active pool (year-1)
+!$OMP THREADPRIVATE(som_turn_iactive)
+  REAL(r_std), SAVE :: som_turn_islow       = 0.2      !! turnover of slow pool (year-1)
+!$OMP THREADPRIVATE(som_turn_islow)
+  REAL(r_std), SAVE :: som_turn_ipassive    = 0.0045   !! turnover of passive pool (year-1)
+!$OMP THREADPRIVATE(som_turn_ipassive)
+
+
+  REAL(r_std), SAVE :: som_turn_iactive_clay_frac = 0.75 !! clay-dependant parameter impacting on turnover rate of active pool 
+                                                         !! Tm parameter of Parton et al. 1993 (-)
+!$OMP THREADPRIVATE(som_turn_iactive_clay_frac)
+
+  !
+  ! stomate_turnover.f90
+  !
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: new_turnover_time_ref = 20. !!(days)
+!$OMP THREADPRIVATE(new_turnover_time_ref)
+  REAL(r_std), SAVE :: leaf_age_crit_tref = 20.    !! (C)
+!$OMP THREADPRIVATE(leaf_age_crit_tref)
+  REAL(r_std), SAVE, DIMENSION(3) :: leaf_age_crit_coeff = (/ 1.5, 0.75, 10./) !! (unitless)
+!$OMP THREADPRIVATE(leaf_age_crit_coeff)
+
+
+  !
+  ! stomate_vmax.f90
+  !
+ 
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: vmax_offset = 0.3        !! minimum leaf efficiency (unitless)
+!$OMP THREADPRIVATE(vmax_offset)
+  REAL(r_std), SAVE :: leafage_firstmax = 0.03  !! relative leaf age at which efficiency
+                                                !! reaches 1 (unitless)
+!$OMP THREADPRIVATE(leafage_firstmax)
+  REAL(r_std), SAVE :: leafage_lastmax = 0.5    !! relative leaf age at which efficiency
+                                                !! falls below 1 (unitless)
+!$OMP THREADPRIVATE(leafage_lastmax)
+  REAL(r_std), SAVE :: leafage_old = 1.         !! relative leaf age at which efficiency
+                                                !! reaches its minimum (vmax_offset) 
+                                                !! (unitless)
+!$OMP THREADPRIVATE(leafage_old)
+
+
+  !
+  ! nitrogen_dynamics (in stomate_soilcarbon.f90) 
+  !
+
+  ! 0. Constants
+  REAL(r_std), PARAMETER :: D_air = 1.73664     !! Oxygen diffusion rate in the air = 0.07236 m2/h
+                                               !! from Table 2 of Li et al, 2000
+                                               !! (m**2/day)
+
+  REAL(r_std), PARAMETER :: C_molar_mass = 12  !! Carbon Molar mass (gC mol-1) 
+
+  REAL(r_std), PARAMETER :: Pa_to_hPa    = 0.01      !! Conversion factor from Pa to hPa (-)
+  REAL(r_std), PARAMETER :: V_O2         = 0.209476  !! Volumetric fraction of O2 in air (-)
+
+  REAL(r_std), PARAMETER :: pk_NH4 = 9.25      !! The negative logarithm of the acid dissociation constant K_NH4     
+                                               !! See Table 4 of Li et al. 1992 and Appendix A of Zhang et al. 2002    
+
+                                     
+  ! 1. Scalar
+
+  ! Coefficients for defining maximum porosity
+  ! From Saxton, K.E., Rawls, W.J., Romberger, J.S., Papendick, R.I., 1986
+  ! Estimationg generalized soil-water characteristics from texture. 
+  ! Soil Sci. Soc. Am. J. 50, 1031-1036
+  ! Cited in Table 5 (page 444) of
+  ! Y. Pachepsky, W.J. Rawls
+  ! Development of Pedotransfer Functions in Soil Hydrology
+  ! Elsevier, 23 nov. 2004 - 542 pages
+  ! http://books.google.fr/books?id=ar_lPXaJ8QkC&printsec=frontcover&hl=fr#v=onepage&q&f=false
+  REAL(r_std), SAVE :: h_saxton = 0.332          !! h coefficient 
+!$OMP THREADPRIVATE(h_saxton)
+  REAL(r_std), SAVE :: j_saxton = -7.251*1e-4    !! j coefficient 
+!$OMP THREADPRIVATE(j_saxton)
+  REAL(r_std), SAVE :: k_saxton = 0.1276         !! k coefficient
+!$OMP THREADPRIVATE(k_saxton)
+
+  ! Values of the power used in the equation defining the diffusion of oxygen in soil
+  ! from Table 2 of Li et al, 2000
+  REAL(r_std), SAVE :: diffusionO2_power_1 = 3.33 !! (unitless)
+!$OMP THREADPRIVATE(diffusionO2_power_1)
+  REAL(r_std), SAVE :: diffusionO2_power_2 = 2.0  !! (unitless) 
+!$OMP THREADPRIVATE(diffusionO2_power_2)
+
+  ! Temperature-related Factors impacting on Oxygen diffusion rate
+  ! From eq. 2 of Table 2 (Li et al, 2000)
+  REAL(r_std), SAVE ::   F_nofrost = 1.2          !! (unitless)
+!$OMP THREADPRIVATE(F_nofrost)
+  REAL(r_std), SAVE ::   F_frost   = 0.8          !! (unitless)
+!$OMP THREADPRIVATE(F_frost)
+
+  ! Coefficients used in the calculation of Volumetric fraction of anaerobic microsites 
+  ! a and b constants are not specified in Li et al., 2000
+  ! S. Zaehle used a=0.85 and b=1 without mention to any publication
+  REAL(r_std), SAVE ::   a_anvf    = 0.85 !! (-)
+!$OMP THREADPRIVATE(a_anvf)
+  REAL(r_std), SAVE ::   b_anvf    = 1.   !! (-)
+!$OMP THREADPRIVATE(b_anvf)
+
+  ! Coefficients used in the calculation of the Fraction of adsorbed NH4+
+  ! Li et al. 1992, JGR, Table 4
+  REAL(r_std), SAVE ::   a_FixNH4 = 0.41  !! (-)
+!$OMP THREADPRIVATE(a_FixNH4)
+  REAL(r_std), SAVE ::   b_FixNH4 = -0.47 !! (-)
+!$OMP THREADPRIVATE(b_FixNH4)
+  REAL(r_std), SAVE ::   clay_max = 0.63  !! (-)
+!$OMP THREADPRIVATE(clay_max)
+
+  ! Coefficients used in the calculation of the Response of Nitrification
+  ! to soil moisture
+  ! Zhang et al. 2002, Ecological Modelling, appendix A, page 101
+  REAL(r_std), SAVE ::   fw_0 =  -0.0243  !! (-)
+!$OMP THREADPRIVATE(fw_0)
+  REAL(r_std), SAVE ::   fw_1 =   0.9975  !! (-)
+!$OMP THREADPRIVATE(fw_1)
+  REAL(r_std), SAVE ::   fw_2 =  -5.5368  !! (-)
+!$OMP THREADPRIVATE(fw_2)
+  REAL(r_std), SAVE ::   fw_3 =  17.651   !! (-)
+!$OMP THREADPRIVATE(fw_3)
+  REAL(r_std), SAVE ::   fw_4 = -12.904   !! (-)
+!$OMP THREADPRIVATE(fw_4)
+
+  ! Coefficients used in the calculation of the Response of Nitrification
+  ! to Temperature
+  ! Zhang et al. 2002, Ecological Modelling, appendix A, page 101
+  REAL(r_std), SAVE ::   ft_nit_0 =  -0.0233 !! (-)
+!$OMP THREADPRIVATE(ft_nit_0)
+  REAL(r_std), SAVE ::   ft_nit_1 =   0.3094 !! (-)
+!$OMP THREADPRIVATE(ft_nit_1)
+  REAL(r_std), SAVE ::   ft_nit_2 =  -0.2234 !! (-)
+!$OMP THREADPRIVATE(ft_nit_2)
+  REAL(r_std), SAVE ::   ft_nit_3 =   0.1566 !! (-)
+!$OMP THREADPRIVATE(ft_nit_3)
+  REAL(r_std), SAVE ::   ft_nit_4 =  -0.0272 !! (-)
+!$OMP THREADPRIVATE(ft_nit_4)
+
+  ! Coefficients used in the calculation of the Response of Nitrification
+  ! to pH
+  ! Zhang et al. 2002, Ecological Modelling, appendix A, page 101
+  REAL(r_std), SAVE ::   fph_0 = -1.2314  !! (-)
+!$OMP THREADPRIVATE(fph_0)
+  REAL(r_std), SAVE ::   fph_1 = 0.7347   !! (-)
+!$OMP THREADPRIVATE(fph_1)
+  REAL(r_std), SAVE ::   fph_2 = -0.0604  !! (-)
+!$OMP THREADPRIVATE(fph_2)
+
+  ! Coefficients used in the calculation of the response of NO2 or NO 
+  ! production during nitrificationof to Temperature
+  ! Zhang et al. 2002, Ecological Modelling, appendix A, page 102
+  REAL(r_std), SAVE ::   ftv_0 = 2.72   !! (-)
+!$OMP THREADPRIVATE(ftv_0)
+  REAL(r_std), SAVE ::   ftv_1 = 34.6   !! (-)
+!$OMP THREADPRIVATE(ftv_1)
+  REAL(r_std), SAVE ::   ftv_2 = 9615.  !! (-) 
+!$OMP THREADPRIVATE(ftv_2)
+
+  REAL(r_std), SAVE ::   k_nitrif = 0.2         !! Nitrification rate at 20 âŠC and field capacity (day-1)
+                                                !! from Schmid et al., 2001
+!$OMP THREADPRIVATE(k_nitrif)
+
+  REAL(r_std), SAVE ::   n2o_nitrif_p = 0.0006  !! Reference n2o production per N-NO3 produced g N-N2O  (g N-NO3)-1
+                                                !! From Zhang et al., 2002 - Appendix A p. 102
+!$OMP THREADPRIVATE(n2o_nitrif_p)
+  REAL(r_std), SAVE ::   no_nitrif_p = 0.0025   !! Reference NO production per N-NO3 produced g N-NO  (g N-NO3)-1
+                                                !! From Zhang et al., 2002 - Appendix A p. 102
+!$OMP THREADPRIVATE(no_nitrif_p)
+
+  ! NO production from chemodenitrification
+  ! based on Kesik et al., 2005, Biogeosciences
+  ! Coefficients used in the calculation of the Response to Temperature
+  REAL(r_std), SAVE ::   chemo_t0  = -31494. !! (-)
+!$OMP THREADPRIVATE(chemo_t0)
+  ! Coefficients use in the calculation of the Response to pH
+  REAL(r_std), SAVE ::   chemo_ph0 = -1.62   !! (-)
+!$OMP THREADPRIVATE(chemo_ph0)
+  ! Coefficients used in the calculation of NO production from chemodenitrification
+  REAL(r_std), SAVE ::   chemo_0   = 30.     !! (-)
+!$OMP THREADPRIVATE(chemo_0)
+  REAL(r_std), SAVE ::   chemo_1   = 16565.  !! (-)
+!$OMP THREADPRIVATE(chemo_1)
+
+  ! Denitrification processes
+  ! Li et al, 2000, JGR Table 4 eq 1, 2 and 4
+  !
+  ! Coefficients used in the Temperature response of 
+  ! relative growth rate of total denitrifiers - Eq. 2 Table 4 of Li et al., 2000
+  REAL(r_std), SAVE ::   ft_denit_0 = 2.     !! (-)
+!$OMP THREADPRIVATE(ft_denit_0)
+  REAL(r_std), SAVE ::   ft_denit_1 = 22.5   !! (-)
+!$OMP THREADPRIVATE(ft_denit_1)
+  REAL(r_std), SAVE ::   ft_denit_2 = 10.    !! (-)
+!$OMP THREADPRIVATE(ft_denit_2)
+  !
+  ! Coefficients used in the pH response of 
+  ! relative growth rate of total denitrifiers - Eq. 2 Table 4 of Li et al., 2000
+  REAL(r_std), SAVE ::   fph_no3_0  = 4.25    !! (-) 
+!$OMP THREADPRIVATE(fph_no3_0)
+  REAL(r_std), SAVE ::   fph_no3_1  = 0.5     !! (-)
+!$OMP THREADPRIVATE(fph_no3_1)
+  REAL(r_std), SAVE ::   fph_no_0  = 5.25     !! (-)
+!$OMP THREADPRIVATE(fph_no_0)
+  REAL(r_std), SAVE ::   fph_no_1  = 1.       !! (-)
+!$OMP THREADPRIVATE(fph_no_1)
+  REAL(r_std), SAVE ::   fph_n2o_0  = 6.25    !! (-)
+!$OMP THREADPRIVATE(fph_n2o_0)
+  REAL(r_std), SAVE ::   fph_n2o_1  = 1.5     !! (-)
+!$OMP THREADPRIVATE(fph_n2o_1)
+
+  REAL(r_std), SAVE ::   Kn = 0.083           !! Half Saturation of N oxydes (kgN/m3)
+                                              !! Table 4 of Li et al., 2000
+!$OMP THREADPRIVATE(Kn)
+
+  ! Maximum Relative growth rate of Nox denitrifiers
+  ! Eq.1 Table 4 Li et al., 2000 
+  REAL(r_std), SAVE ::   mu_no3_max = 0.67   !! (hour-1)
+!$OMP THREADPRIVATE(mu_no3_max)
+  REAL(r_std), SAVE ::   mu_no_max  = 0.34   !! (hour-1)
+!$OMP THREADPRIVATE(mu_no_max)
+  REAL(r_std), SAVE ::   mu_n2o_max = 0.34   !! (hour-1)
+!$OMP THREADPRIVATE(mu_n2o_max)
+
+  ! Maximum growth yield of NOx denitrifiers on N oxydes
+  ! Table 4 Li et al., 2000
+  REAL(r_std), SAVE ::   Y_no3 = 0.401 !! (kgC / kgN)
+!$OMP THREADPRIVATE(Y_no3)
+  REAL(r_std), SAVE ::   Y_no  = 0.428 !! (kgC / kgN)
+!$OMP THREADPRIVATE(Y_no)
+  REAL(r_std), SAVE ::   Y_n2o = 0.151 !! (kgC / kgN)
+!$OMP THREADPRIVATE(Y_n2o)
+
+  ! Maintenance coefficient on N oxyde
+  ! Table 4 Li et al., 2000
+  REAL(r_std), SAVE ::   M_no3 = 0.09   !! (kgN / kgC / hour)
+!$OMP THREADPRIVATE(M_no3)
+  REAL(r_std), SAVE ::   M_no  = 0.035  !! (kgN / kgC / hour)
+!$OMP THREADPRIVATE(M_no)
+  REAL(r_std), SAVE ::   M_n2o = 0.079  !! (kgN / kgC / hour)
+!$OMP THREADPRIVATE(M_n2o)
+
+        
+  REAL(r_std), SAVE ::   Maint_c = 0.0076    !! Maintenance coefficient of carbon (kgC/kgC/h)
+                                        !! Table 4 Li et al., 2000
+!$OMP THREADPRIVATE(Maint_c)
+  REAL(r_std), SAVE ::   Yc = 0.503     !! Maximum growth yield on soluble carbon (kgC/kgC)
+                                        !! Table 4 Li et al., 2000
+!$OMP THREADPRIVATE(Yc)
+
+  !! Coefficients used in the eq. defining the response of N-emission to clay fraction (-)
+  !! from  Table 4, Li et al. 2000
+  REAL(r_std), SAVE ::   F_clay_0 = 0.13   
+!$OMP THREADPRIVATE(F_clay_0) 
+  REAL(r_std), SAVE ::   F_clay_1 = -0.079
+!$OMP THREADPRIVATE(F_clay_1)
+
+
+  REAL(r_std), SAVE ::   ratio_nh4_fert = 0.875  !! Proportion of ammonium in the fertilizers (ammo-nitrate) 
+                                                 !! = 7./8. (-)
+!$OMP THREADPRIVATE(ratio_nh4_fert)
+
+  ! 2. Arrays
+  REAL(r_std), SAVE, DIMENSION(2)  :: vmax_uptake = (/ 3. , 3. /) !! Vmax of nitrogen uptake by plants 
+                                                                  !! for Ammonium (ind.1) and Nitrate (ind.2)
+                                                                  !! (in umol (g DryWeight_root)-1 h-1)
+                                                                  !! from  Kronzucker et al. (1995, 1996)
+!$OMP THREADPRIVATE(vmax_uptake)
+  REAL(r_std), SAVE, DIMENSION(2)  :: vmax_n_uptake = (/ 5.4 , 5.4 /) !! Vmax of nitrogen uptake by plants
+                                                                      !! for Ammonium (ind.1) and Nitrate (ind.2)
+                                                                      !! (in umol (g DryWeight_root)-1 h-1)
+                                                                      !! from Zaehle & Friend (2010) "calibrated"
+!$OMP THREADPRIVATE(vmax_n_uptake)
+
+  REAL(r_std), SAVE, DIMENSION(2)  :: K_N_min = (/ 30., 30. /)    !! [NH4+] (resp. [NO3-]) for which the Nuptake 
+                                                                  !! equals vmax/2.   (umol per litter)
+                                                                  !! from Kronzucker, 1995
+!$OMP THREADPRIVATE(K_N_min)
+
+  REAL(r_std), SAVE, DIMENSION(2)  :: low_K_N_min = (/ 0.0002, 0.0002 /) !! Rate of N uptake not associated with 
+                                                                         !! Michaelis- Menten Kinetics for Ammonium 
+                                                                         !! (ind.1) and Nitrate (ind.2)
+                                                                         !! from Kronzucker, 1995 ((umol)-1)
+!$OMP THREADPRIVATE(low_K_N_min)
+
+
+  !! Other N-related parameters
+  REAL(r_std), SAVE                                  :: Dmax = 0.25      !! Parameter te be clarified (what it is, units, ...)
+                                                                         !! used in stomate_growth_fun_all
+
+  REAL(r_std), SAVE :: reserve_time_tree = 30.     !! Maximum number of days during which
+                                                   !! carbohydrate reserve may be used for 
+                                                   !! trees (days)
+!$OMP THREADPRIVATE(reserve_time_tree)
+  
+  REAL(r_std), SAVE :: reserve_time_grass = 20.    !! Maximum number of days during which
+                                                   !! carbohydrate reserve may be used for 
+                                                   !! grasses (days)
+!$OMP THREADPRIVATE(reserve_time_grass)
+
+
+  !
+  ! stomate_windthrow.f90
+  !
+
+  ! 0. Constants
+
+  REAL(r_std), SAVE :: one_third = 0.333              !! This value is used on multiple occasions in
+                                                      !! stomate_windthrow.f90
+                                                      !!(unitless)
+!$OMP THREADPRIVATE(one_third)
+  REAL(r_std), SAVE :: dbh_height_standard = 1.3      !! The height where the diameter of the tree stem is
+                                                      !! measured by default.
+                                                      !@tex $(m)$ @endtex
+!$OMP THREADPRIVATE(dbh_height_standard)
+  REAL(r_std), SAVE :: dbh_height_stump = zero        !! The height where the diameter of the tree stem is
+                                                      !! measured if the middle of the canopy is below 1.3 m.
+                                                      !! @tex $(m)$ @endtex
+!$OMP THREADPRIVATE(dbh_height_stump)
+  REAL(r_std), SAVE :: snow_density = 150.0           !! Density of snow (kg/m3). It should be considered
+                                                      !! to calculate this value for simulations during
+                                                      !  future development.
+!$OMP THREADPRIVATE(snow_density)
+  REAL(r_std), SAVE :: clear_cut_max = 20000.0        !! The maximum contiguous area allowed to be clearfelled
+                                                      !! @tex $(m^{2})$ @endtex
+!$OMP THREADPRIVATE(clear_cut_max)
+  REAL(r_std), SAVE :: c_surface = 0.003              !! Surface Drag Coefficient (Raupach 1994) (unitless)
+!$OMP THREADPRIVATE(c_surface)
+  REAL(r_std), SAVE :: c_drag = 0.3                   !! Element Drag Coefficient (Raupach 1994) (unitless)
+!$OMP THREADPRIVATE(c_drag)
+  REAL(r_std), SAVE :: c_displacement = 7.5           !! Used by Raupach to calculate the zero-plane displacement (Raupach 1994) (unitless)
+!$OMP THREADPRIVATE(c_displacement)
+  REAL(r_std), SAVE :: c_roughness = 2.0              !! Used by Raupach to calculate the surface roughness length (Raupach 1994) (unitless)
+!$OMP THREADPRIVATE(c_roughness)
+  REAL(r_std), SAVE :: air_density = 1.2226           !! The value of air density (kg*m-3). If needed, this can be derived dynamically from
+                                                      !! other modules of ORCHIDEE, but considering the range of values it can hold, it is probably
+                                                      !! not worth additional calculations for being used in WINDTHROW.
+!$OMP THREADPRIVATE(air_density)
+  REAL(r_std), SAVE :: f_crown_weight = 1.136         !! This factor represents the weight of the overhanging crown when the tree stem is bent.
+                                                      !! The origin of 1.136 is described in the supplementary material of Hale et al. 2015.
+!$OMP THREADPRIVATE(f_crown_weight)
+
+  INTEGER(i_std), SAVE :: wind_years = 5              !! The years used to calculate the total harvest area with in wind_years and the default is 5 years.
+!$OMP THREADPRIVATE(wind_years)
+
+! 1. Scalar
+  REAL(r_std), SAVE :: daily_max_tune=0.1155          !! This is a linear tunning factor to adjust the calculated daily maximum wind speed from forcing dataset.
+!@OMP THREADPRIVATE(daily_max_tune)
+
+
+  !
+  ! stomate_season.f90 
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: gppfrac_dormance = 0.2  !! report maximal GPP/GGP_max for dormance (0-1, unitless)
+!$OMP THREADPRIVATE(gppfrac_dormance)
+  REAL(r_std), SAVE :: tau_climatology = 20.   !! tau for "climatologic variables (years)
+!$OMP THREADPRIVATE(tau_climatology)
+  REAL(r_std), SAVE :: hvc1 = 0.019            !! parameters for herbivore activity (unitless)
+!$OMP THREADPRIVATE(hvc1)
+  REAL(r_std), SAVE :: hvc2 = 1.38             !! parameters for herbivore activity (unitless)
+!$OMP THREADPRIVATE(hvc2)
+  REAL(r_std), SAVE :: leaf_frac_hvc = 0.33    !! leaf fraction (0-1, unitless)
+!$OMP THREADPRIVATE(leaf_frac_hvc)
+  REAL(r_std), SAVE :: tlong_ref_max = 303.1   !! maximum reference long term temperature (K)
+!$OMP THREADPRIVATE(tlong_ref_max)
+  REAL(r_std), SAVE :: tlong_ref_min = 253.1   !! minimum reference long term temperature (K)
+!$OMP THREADPRIVATE(tlong_ref_min)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: ncd_max_year = 3.
+!$OMP THREADPRIVATE(ncd_max_year)
+  REAL(r_std), SAVE :: gdd_threshold = 5.
+!$OMP THREADPRIVATE(gdd_threshold)
+  REAL(r_std), SAVE :: green_age_ever = 2.
+!$OMP THREADPRIVATE(green_age_ever)
+  REAL(r_std), SAVE :: green_age_dec = 0.5
+!$OMP THREADPRIVATE(green_age_dec)
+  
+  REAL(r_std), SAVE :: ngd_min_dormance = 120.
+!$OMP THREADPRIVATE(ngd_min_dormance)
+
+  !
+  ! sapiens_forestry.f90
+  !
+
+  INTEGER(i_std), SAVE      :: ncirc = 1                !! Number of circumference classes used to calculate C allocation
+!$OMP THREADPRIVATE(ncirc)
+
+  LOGICAL, SAVE             :: lbypass_cc = .FALSE.     !! Set to true for a temporary patch of a known bug, though the underlying
+!$OMP THREADPRIVATE(lbypass_cc)
+  LOGICAL, SAVE             :: ld_fake_height=.TRUE.    !! a flag to turn on the statements
+!$OMP THREADPRIVATE(ld_fake_height)
+  LOGICAL,PARAMETER         :: ld_biomass=.FALSE.       !! a flag to turn on debug statements
+  INTEGER(i_std), SAVE      :: test_pft = 31             !! Number of PFT for which detailed output 
+!$OMP THREADPRIVATE(test_pft)
+
+!!! If the default value is not one, this can cause crashes in debugging for small regions.
+  INTEGER(i_std), SAVE      :: test_grid = 1            !! Number of the grid square for which detailed output 
+!$OMP THREADPRIVATE(test_grid)
+
+  INTEGER(i_std), SAVE      :: nagec = 1                !! Number of age classes used to calculate C allocation
+                                                        !! Used in forestry.f90 and lcchange.f90 - this mimics age classes
+!$OMP THREADPRIVATE(nagec)
+
+  INTEGER(i_std), SAVE      :: ndia_harvest             !! The number of diameter classes used for 
+                                                        !! the wood harvest pools.
+!$OMP THREADPRIVATE(ndia_harvest)
+
+  REAL(r_std), SAVE         :: max_harvest_dia          !! The largest diameter for the harvest pools to
+                                                        !! keep track of harvested wood from forests.
+!$OMP THREADPRIVATE(max_harvest_dia)
+
+  INTEGER(i_std), SAVE      :: n_pai                    !! The number of years used for the cumulative
+                                                        !! averages of the periodic annual increment.                      
+!$OMP THREADPRIVATE(n_pai)
+
+  INTEGER(i_std), SAVE      :: ntrees_profit            !! The number of trees over which the average
+                                                        !! height is calculated to determine if the
+                                                        !! stand will be profitable to thin.
+!$OMP THREADPRIVATE(ntrees_profit)
+ 
+ REAL(r_std), SAVE         :: rdi_limit_upper=1         !! The parameters for self-thinning and yield come
+                                                        !! from different data sets and are not necsassirly
+                                                        !! fully consistent. The forestry code was written
+                                                        !! such that it accounts for this consistency issue.
+                                                        !! However, we still need a parameter that gives
+                                                        !! us the upper_rdi_harvest in case the inconsistency
+                                                        !! occurs.
+ !$OMP THREADPRIVATE(rdi_limit_upper)
+
+INTEGER, SAVE             :: species_change_force      !! This is the PFT number which is replanted after a
+  	                                               !! clearcut, if such a thing is being done.
+                                                       !! To be used with lchange_species = .TRUE. and
+	                                               !! lread_species_change_map = .FALSE. The
+	                                               !! forced value is mainly useful for debugging
+!$OMP THREADPRIVATE(species_change_force)
+
+INTEGER, SAVE             :: fm_change_force           !! This is the FM strategy which is used for the replant
+	                                               !! after a clearcut, if such a thing is being done.
+ 	                                               !! To be used with lchange_species = .TRUE. and
+       	                                               !! lread_desired_fm_map = .FALSE. The forced value is
+	                                               !! mainly useful for debugging
+!$OMP THREADPRIVATE(fm_change_force)
+
+ REAL(r_std), SAVE        :: min_water_stress = 0.1    !! Minimal value for wstress_fac (unitless, 0-1)
+!$OMP THREADPRIVATE(min_water_stress)
+
+REAL(r_std), SAVE         :: max_delta_KF = 0.1        !! Maximum change in KF from one time step to another (m)
+                                                       !! This is a bit arbitrary. 
+!$OMP THREADPRIVATE(max_delta_KF)
+
+REAL(r_std), SAVE         :: maint_from_gpp = 0.8      !! Some carbon needs to remain to support the growth, hence, 
+                                                       !! respiration will be limited. In this case resp_maint 
+                                                       !! (gC m-2 dt-1) should not be more than 80% (::maint_from_gpp) 
+                                                       !! of the GPP (gC m-2 s-1)
+!$OMP THREADPRIVATE(maint_from_gpp)
+ 
+  REAL(r_std), PARAMETER :: m2_to_ha = 10000.          !! Conversion from m2 to hectares
+  REAL(r_std), PARAMETER :: ha_to_m2 = 0.0001          !! Conversion from hectares (forestry) to m2 (rest of the code)
+  REAL(r_std), PARAMETER :: m_to_cm = 100.             !! Conversion from m to cm
+  REAL(r_std), PARAMETER :: cm_to_m = 0.01             !! Conversion from cm to m
+  REAL(r_std), PARAMETER :: peta_to_unit = 1.0E15      !! Convert Peta to unit
+  REAL(r_std), PARAMETER :: tera_to_unit = 1.0E12      !! Convert Tera to unit 
+  REAL(r_std), PARAMETER :: giga_to_unit = 1.0E09      !! Convert Giga to unit
+  REAL(r_std), PARAMETER :: mega_to_unit = 1.0E06      !! Convert Mega to unit
+  REAL(r_std), PARAMETER :: kilo_to_unit = 1.0E03      !! Convert Kilo to unit
+  REAL(r_std), PARAMETER :: centi_to_unit = 1.0E02     !! Convert centi to unit
+  REAL(r_std), PARAMETER :: milli_to_unit = 1.0E-03    !! Convert milli to unit
+  REAL(r_std), PARAMETER :: carbon_to_kilo = 2.0E-03   !! Convert g carbon to kilo biomass
+
+  !
+  ! Debugging
+  !
+  INTEGER(i_std), SAVE :: err_act = 1                  !! There are three levels of error checking 
+                                                       !! see constantes.f90 for more details
+!$OMP THREADPRIVATE(err_act)
+  INTEGER(i_std), SAVE :: plev = 0                     !! print level of the subroutine ipslerr_p 
+                                                       !! (1:note, 2: warn and 3:stop) 
+!$OMP THREADPRIVATE(plev) 
+  REAL(r_std), SAVE    :: sync_threshold = 0.0001      !! The threshold above which a warning is generated when the
+!$OMP THREADPRIVATE(sync_threshold) 
+
+END MODULE constantes_var
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/control.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/control.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/control.f90	(revision 6412)
@@ -0,0 +1,889 @@
+! =================================================================================================================================
+! MODULE       : control
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        "control" module contains subroutines to initialize run time control parameters. 
+!!
+!!\n DESCRIPTION: 
+!!
+!! SVN          :
+!! $HeadURL: 
+!! $Date:  
+!! $Revision: 
+!! \n
+!_ ================================================================================================================================
+
+MODULE control
+  
+  USE constantes_soil
+  USE constantes_var
+  USE pft_parameters
+  USE vertical_soil
+
+  IMPLICIT NONE
+
+CONTAINS
+!! ================================================================================================================================
+!! SUBROUTINE   : control_initialize 
+!!
+!>\BRIEF        This subroutine reads the configuration flags which control the behaviour of the model
+!!              This subroutine was previsouly named intsurf_config and located in intersurf module. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE control_initialize(dt)
+
+    IMPLICIT NONE
+    
+    REAL(r_std), INTENT(in)                    :: dt                    !! Time step in seconds
+    INTEGER(i_std)                             :: jv                    !! Local index variable
+    INTEGER(i_std)                             :: ier                   !! Error handeling
+    LOGICAL                                    :: hydrol_cwrr_test      !! Temporary test variable
+    LOGICAL                                    :: ok_co2_test           !! Temporary test variable
+    LOGICAL                                    :: ok_explicitsnow_test  !! Temporary test variable
+    LOGICAL                                    :: conflict              !! Check whether there are conflicts
+    LOGICAL                                    :: temp                  !! Temp to check for conflicts  
+
+    ! Archive the sechiba time step into module constantes_var 
+    dt_sechiba=dt
+
+    ! control initialisation with sechiba
+    ok_sechiba = .TRUE.
+
+    ! Start reading options from parameter file 
+
+    !Config Key   = SOILTYPE_CLASSIF
+    !Config Desc  = Type of classification used for the map of soil types 
+    !Config Def   = zobler
+    !Config If    = !IMPOSE_VEG
+    !Config Help  = The classification used in the file that we use here 
+    !Config         There are three classification supported:  
+    !Config         Zobler (7 converted to 3) and USDA (12) 
+    !Config Units = [-]
+    !
+    !-tdo- Suivant le type de classification utilisee pour le sol, on adapte nscm 
+    soil_classif = 'zobler'
+    CALL getin_p('SOILTYPE_CLASSIF',soil_classif)
+    SELECTCASE (soil_classif)
+    CASE ('zobler','none')
+       nscm = nscm_fao
+    CASE ('usda')
+       nscm = nscm_usda
+    CASE DEFAULT
+       WRITE(numout,*) "Unsupported soil type classification: soil_classif=",soil_classif
+       WRITE(numout,*) "Choose between zobler, usda and none according to the map"
+       CALL ipslerr(3,'control_initialize','Bad choice of soil_classif',&
+            'Choose between zobler, usda and none','')
+    ENDSELECT
+    WRITE(numout,*)'soil_classif,nscm', soil_classif, nscm
+
+    !Config Key   = OK_BARE_SOIL_NEW
+    !Config Desc  = Flag that controls the view on and calculation of bare soil
+    !Config If    = OK_SECHIBA or OK_STOMATE 
+    !Config Def   = TRUE
+    !Config Help  = Choose between the two options to calculate the bare soil.
+    !Config         False = classic view: gaps within a canopy should be treated
+    !Config         bare soil. True = ecological view: gaps within a canopy are
+    !Config         part of the ecosystem and should be treated as such.
+    !Config Units = [-]
+    CALL getin_p('OK_BARE_SOIL_NEW', ok_bare_soil_new) 
+
+    !Config Key   = MULTI_LAYER_CONTROL
+    !Config Desc  = A flag that controls severeal other flags related to the multi layer settings
+    !Config Def   = y
+    !Config Help  = Flag that automatically controls several other flags related
+    !Config Help    to multi-layering (1/2/3). 1 - single layer: ok_hydrol_arch,
+    !Config Help    ok_gs_feedback, ok_impose_canopy_structure  and and ok_mleb all
+    !Config Help    TRUE, but The energy budget is only calculated for a single
+    !Config Help    layer (jnlvls=1,jnlvls_under=0,jnlvls_canopy=1,jnlvls_over=0).
+    !Config Help    No mleb output, ok_mleb_history_file is set to  FALSE.
+    !Config Help    2 - multi-layer: ok_hydrol_arch, ok_gs_feedback
+    !Config Help    and ok_mleb all TRUE. ok_impose_canopy_structure is False, and the
+    !Config Help    energy budget is calculated for multiple layers 
+    !Config Help    (jnlvls=29,jnlvls_under=10,jnlvls_canopy=10,jnlvls_over=9).    
+    !Config Help    No mleb output, ok_mleb_history_file is set to  FALSE.
+    !Config Help    3 user specific: user specific settings for these
+    !Config Help    controls and layers as defined in the run.def by the user.
+    !Config Units = [FLAG]
+    MULTI_LAYER_CONTROL = 1 
+    CALL getin_p('MULTI_LAYER_CONTROL', multi_layer_control)
+
+    ! set flags according to the multi_layer_control flag.
+
+    IF( multi_layer_control .EQ. 1 ) THEN  ! single layer
+
+       ok_hydrol_arch = .TRUE.
+       ok_gs_feedback = .TRUE.
+       ok_mleb = .TRUE.
+       ok_impose_can_structure = .TRUE.
+       ok_mleb_history_file = .FALSE.
+
+       ! Search for possible conflicts
+       conflict = .FALSE.
+       CALL getin_p('OK_HYDROL_ARCH', temp)
+       IF (ok_hydrol_arch .NE. temp) conflict = .TRUE.
+       CALL getin_p('OK_GS_FEEDBACK', temp)
+       IF (ok_gs_feedback .NE. temp) conflict = .TRUE.
+       CALL getin_p('OK_MLEB', temp)
+       IF (ok_mleb .NE. temp) conflict = .TRUE.
+       CALL getin_p('OK_IMPOSE_CAN_STRUCTURE', temp)
+       IF (ok_impose_can_structure .NE. temp) conflict = .TRUE.
+       CALL getin_p('OK_MLEB_HISTORY_FILE', temp)
+       IF (ok_mleb_history_file .NE. temp) conflict = .TRUE.
+       IF (conflict) THEN
+          CALL ipslerr(2,'control_initialize', &
+               'Some of the parameter values set in the', &
+               'run.def or set as a default are overwritten by the',&
+               'values implied by the MULTI_LAYER_CONTROL flag')
+       ENDIF
+
+    ELSEIF( multi_layer_control .EQ. 2 ) THEN  ! multi-layer
+
+       ok_hydrol_arch = .TRUE.
+       ok_gs_feedback = .TRUE.
+       ok_mleb = .TRUE.
+       ok_impose_can_structure = .FALSE.
+       ok_mleb_history_file = .FALSE.
+
+       ! Search for conflicts
+       conflict = .FALSE.
+       CALL getin_p('OK_HYDROL_ARCH', temp)
+       IF (ok_hydrol_arch .NE. temp) conflict = .TRUE.
+       CALL getin_p('OK_GS_FEEDBACK', temp)
+       IF (ok_gs_feedback .NE. temp) conflict = .TRUE.
+       CALL getin_p('OK_MLEB', temp)
+       IF (ok_mleb .NE. temp) conflict = .TRUE.
+       CALL getin_p('OK_IMPOSE_CAN_STRUCTURE', temp)
+       IF (ok_impose_can_structure .NE. temp) conflict = .TRUE.
+       CALL getin_p('OK_MLEB_HISTORY_FILE', temp)
+       IF (ok_mleb_history_file .NE. temp) conflict = .TRUE.
+       IF (conflict) THEN
+          CALL ipslerr(2,'control_initialize', &
+               'Some of the parameter values set in the', &
+               'run.def or set as a default are overwritten by the',&
+               'values implied by the MULTI_LAYER_CONTROL flag')
+       ENDIF
+
+    ELSEIF( multi_layer_control .EQ. 3 ) THEN 
+
+       !Config Key   = OK_HYDROL_ARCH
+       !Config Desc  = Activates the hydraulic architecture
+       !Config If    = OK_SECHIBA
+       !Config Def   = y
+       !Config Help  = Flag that activates the hydraulic architecture routine (true/false)
+       !Config Help    The trunk version of ORCHIDEE (false) uses soil water as a 
+       !Config Help    proxy for water stress and applies the stress to Vcmax.
+       !Config Help    When set to true the hydraulic architecture of the vegetation
+       !Config Help    is accounted for to calculate the amount of water that 
+       !Config Help    can be transported through the plant given the soil and leaf
+       !Config Help    potential and the conductivities of the roots, wood and 
+       !Config Help    leaves. Water supply through the plant is compared against
+       !Config Help    the atmospheric demand for water. If the supply is smaller
+       !Config Help    then the demand, the plant experiences water stress and the
+       !Config Help    stomata will be closed (water stress is now on gs rather 
+       !Config Help    than Vcmax). Note that whether stomatal regulation is used or 
+       !Config Help    not is controled by a separate flag: ok_gs_feedback.
+       !Config Units = [FLAG]
+       ok_hydrol_arch = .TRUE.
+       CALL getin_p('OK_HYDROL_ARCH', ok_hydrol_arch)
+
+       !Config Key   = OK_GS_FEEDBACK
+       !Config Desc  = Debug option for OK_HYDROL_ARCH  
+       !Config If    = OK_SECHIBA, OK_HYDROL_ARCH
+       !Config Def   = y
+       !Config Help  = Flag that activates water stress on stomata (true/false)
+       !Config Help    This flag is for debugging only! It allows developers
+       !Config Help    to calculate GPP without any water stress. If the model is 
+       !Config Help    used in production mode and ok_hydrol_arch is true this 
+       !Config Help    flag should be true as well.
+       !Config Units = [FLAG]
+       ok_gs_feedback = .TRUE.
+       CALL getin_p('OK_GS_FEEDBACK', ok_gs_feedback)
+
+       !Config Key   = OK_MLEB
+       !Config Desc  = Activate multi-layer energy budget  
+       !Config If    = OK_SECHIBA
+       !Config Def   = y
+       !Config Help  = Flag that activates the multilayer energy budget (true/false)
+       !Config Help    The model uses 10 (default) canopy layers to calculate
+       !Config Help    the albedo, transmittance, absorbance and GPP. These canopy
+       !Config Help    layers can be combined with 10 (default) layers below and 
+       !Config Help    10 layers above the canopy to calculate the energy budget
+       !Config Help    (ok_mleb=y). If set to no, this flag will make the model
+       !Config Help    use 10 layers for the canopy albedo, transmittance, 
+       !Config Help    absorbance and GPP and just a single layer for the energy 
+       !Config Help    budget.
+       !Config Units = [FLAG]
+       ok_mleb = .FALSE.
+       CALL getin_p('OK_MLEB', ok_mleb)
+
+       !+++CHECK+++
+       ! This may no longer be needed. One could get the same functionality
+       ! by reading an biomass map in shechiba (lai_map) and not using stomate.
+       !Config Key   = OK_IMPOSE_CAN_STRUCTURE
+       !Config Desc  = Debug option for OK_MLEB 
+       !Config If    = OK_SECHIBA, OK_MLEB
+       !Config Def   = n
+       !Config Help  = This flag is for debugging only! It allows developers
+       !Config Help    to use a prescribed canopy structure rather then the 
+       !Config Help    structure calculate by ORCHIDEE. The flag activates the 
+       !Config Help    sections of code which directly link the energy budget 
+       !Config Help    scheme to the the size and LAI profile of the canopy for the 
+       !Config Help    respective PFT and age class that is calculated in stomate, 
+       !Config Help    for the albedo. If set to TRUE and the multi-layer budget 
+       !Config Help    is activated the model takes LAI profile information and 
+       !Config Help    canopy level heights from the run.def. If set to FALSE, and 
+       !Config Help    and the multi-layer energy budget is used the profile 
+       !Config Help    infomation and canopy levels heights comes from the
+       !Config Help    PGap-based processes for calculation of stand profile 
+       !Config Help    information in stomate.
+       !Config Units = [FLAG]
+       ok_impose_can_structure = .FALSE.
+       CALL getin_p('OK_IMPOSE_CAN_STRUCTURE', ok_impose_can_structure)
+       !++++++++++
+
+       !Config Key   = MLEB_NETCDF_FLAG
+       !Config Desc  = Debug option for OK_MLEB 
+       !Config If    = OK_SECHIBA, OK_MLEB
+       !Config Def   = n
+       !Config Help  = Flag that controls the writing of an output file with the 
+       !Config Help    multi-layer energy simulations (true/false). Note that this
+       !Config Help    a large file and writing it slows down the code.+++CHECK constantes_var+++
+       !Config Units = [FLAG]
+       ok_mleb_history_file = .FALSE.
+       CALL getin_p('OK_MLEB_HISTORY_FILE', ok_mleb_history_file)
+
+    ENDIF ! (multi_layer_control)
+
+    WRITE(numout,*) 'multi_layer_control', multi_layer_control
+    WRITE(numout,*) 'ok_hydrol_arch', ok_hydrol_arch
+    WRITE(numout,*) 'ok_gs_feedback', ok_gs_feedback
+    WRITE(numout,*) 'ok_mleb', ok_mleb
+    WRITE(numout,*) 'ok_impose_can_structure', ok_impose_can_structure
+    WRITE(numout,*) 'ok_mleb_history_file',ok_mleb_history_file       
+
+    !Config Key   = RIVER_ROUTING
+    !Config Desc  = Decides if we route the water or not
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = This flag allows the user to decide if the runoff
+    !Config         and drainage should be routed to the ocean
+    !Config         and to downstream grid boxes.
+    !Config Units = [FLAG]
+    river_routing = .FALSE.
+    CALL getin_p('RIVER_ROUTING', river_routing)
+    WRITE(numout,*) "RIVER routing is activated : ",river_routing
+
+    ! Control for the option HYDROL_CWRR which is not longer existing in the model. 
+    ! Check here if in run.def HYDROL_CWRR=n. If that's the case then stop the model and ask the user to remove the flag from run.def
+    hydrol_cwrr_test = .TRUE.
+    CALL getin_p('HYDROL_CWRR', hydrol_cwrr_test)
+    IF (.NOT. hydrol_cwrr_test) THEN
+       CALL ipslerr(3,'control_initialize',&
+            'HYDROL_CWRR=n is set in run.def but this option does not exist any more in ORCHIDEE', &
+            'Choisnel hydrolology has been removed and CWRR is now the only hydrology module in ORCHIDEE',&
+            'Remove parameter HYDROL_CWRR from run.def')
+    END IF
+    
+    !Config Key   = DO_IRRIGATION
+    !Config Desc  = Should we compute an irrigation flux 
+    !Config If    = RIVER_ROUTING 
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to compute an irigation flux. This performed for the
+    !Config         on very simple hypothesis. The idea is to have a good
+    !Config         map of irrigated areas and a simple function which estimates
+    !Config         the need to irrigate.
+    !Config Units = [FLAG]
+    do_irrigation = .FALSE.
+    IF ( river_routing ) CALL getin_p('DO_IRRIGATION', do_irrigation)
+    
+    !Config Key   = DO_FLOODPLAINS
+    !Config Desc  = Should we include floodplains 
+    !Config If    = RIVER_ROUTING 
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the flood plains and return 
+    !Config         the water into the soil moisture. It then can go 
+    !Config         back to the atmopshere. This tried to simulate 
+    !Config         internal deltas of rivers.
+    !Config Units = [FLAG]  
+    do_floodplains = .FALSE.
+    IF ( river_routing ) CALL getin_p('DO_FLOODPLAINS', do_floodplains)
+    
+    ! Control of option OK_EXPLICITSNOW which is not longer existing in the model. 
+    ! Check here if in run.def OK_EXPLICITSNOW=n. If that's the case then stop the model and ask the user to remove the flag from run.def.
+    ok_explicitsnow_test = .TRUE.
+    CALL getin_p('OK_EXPLICITSNOW', ok_explicitsnow_test)
+    IF (.NOT. ok_explicitsnow_test) THEN
+       CALL ipslerr(3,'control_initialize',&
+            'OK_EXPLICITSNOW=n is set in run.def but this option does not exist any more in ORCHIDEE', &
+            'Explicit snow scheme is now always used in ORCHIDEE.',&
+            'Remove parameter OK_EXPLICITSNOW from run.def')
+    END IF
+
+    !Config Key   = STOMATE_OK_STOMATE
+    !Config Desc  = Activate STOMATE?
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = set to TRUE if STOMATE is to be activated
+    !Config Units = [FLAG]
+    ok_stomate = .TRUE.
+    CALL getin_p('STOMATE_OK_STOMATE',ok_stomate)
+    IF (printlev>=1) WRITE(numout,*) 'STOMATE is activated: ',ok_stomate
+
+    ! Control for the option STOMATE_OK_CO2 which is not longer existing in the model.
+    ! Check here if in run.def STOMATE_OK_CO2=n. If that's the case then stop the model and ask the user to remove the flag from run.def
+    ok_co2_test = .TRUE.
+    CALL getin_p('STOMATE_OK_CO2', ok_co2_test) 
+    IF (.NOT. ok_co2_test) THEN 
+       CALL ipslerr(3,'control_initialize',& 
+            'STOMATE_OK_CO2=n is set in run.def but this option does not exist any more in ORCHIDEE', & 
+            'Calculation of beta coefficient using Jarvis formulation has been removed and Farquar formulation is now always used',& 
+            'Remove parameter STOMATE_OK_CO2 from run.def') 
+    END IF
+
+    !
+    !Config Key   = STOMATE_OK_NCYCLE 
+    !Config Desc  = Activate dynamic N cycle 
+    !Config If    = OK_STOMATE 
+    !Config Def   = n 
+    !Config Help  = set to TRUE if N cycle is to be activated 
+    !Config Units = [FLAG]  
+    ok_ncycle = .FALSE. 
+    CALL getin_p('STOMATE_OK_NCYCLE',ok_ncycle) 
+    WRITE(numout,*) 'N cycle is activated: ',ok_ncycle  
+   
+    !Config Key   = STOMATE_IMPOSE_CN
+    !Config Desc  = Impose the CN ratio of leaves 
+    !Config If    = OK_STOMATE 
+    !Config Def   = n 
+    !Config Help  = set to TRUE if IMPOSE_CN is to be activated 
+    !Config Units = [FLAG] 
+    impose_cn = .FALSE. 
+    CALL getin_p('STOMATE_IMPOSE_CN',impose_cn) 
+    WRITE(numout,*) 'CN ratio is imposed: ',impose_cn  
+    
+    !Config Key   = STOMATE_OK_DGVM
+    !Config Desc  = Activate DGVM?
+    !Config If    = OK_STOMATE
+    !Config Def   = n
+    !Config Help  = set to TRUE if DGVM is to be activated
+    !Config Units = [FLAG]
+    ok_dgvm = .FALSE.
+    CALL getin_p('STOMATE_OK_DGVM',ok_dgvm)
+
+    !Config Key   = CHEMISTRY_BVOC
+    !Config Desc  = Activate calculations for BVOC
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = set to TRUE if biogenic emissions calculation is to be activated
+    !Config Units = [FLAG]
+    ok_bvoc = .FALSE.
+    CALL getin_p('CHEMISTRY_BVOC', ok_bvoc)
+    WRITE(numout,*) 'Biogenic emissions: ', ok_bvoc
+
+    IF ( ok_bvoc ) THEN 
+       ok_leafage         = .TRUE. 
+       ok_radcanopy       = .TRUE. 
+       ok_multilayer      = .TRUE.
+       ok_pulse_NOx       = .TRUE.
+       ok_bbgfertil_NOx   = .TRUE.
+       ok_cropsfertil_NOx = .TRUE.
+
+       ! Search for conflicts
+       conflict = .FALSE.
+       CALL getin_p('CHEMISTRY_LEAFAGE', temp)
+       IF (ok_leafage .NE. temp) conflict = .TRUE.
+       CALL getin_p('CANOPY_EXTINCTION', temp)
+       IF (ok_radcanopy .NE. temp) conflict = .TRUE.
+       CALL getin_p('CANOPY_MULTILAYER', temp)
+       IF (ok_multilayer .NE. temp) conflict = .TRUE.
+       CALL getin_p('NOx_RAIN_PULSE', temp)
+       IF (ok_pulse_NOx .NE. temp) conflict = .TRUE.
+       CALL getin_p('NOx_BBG_FERTIL', temp)
+       IF (ok_bbgfertil_NOx .NE. temp) conflict = .TRUE.
+       CALL getin_p('NOx_FERTILIZERS_USE', temp)
+       IF (ok_cropsfertil_NOx .NE. temp) conflict = .TRUE.
+       IF (conflict) THEN
+          CALL ipslerr(2,'control_initialize', &
+               'Some of the parameter values set in the', &
+               'run.def or set as a default are overwritten by the',&
+               'values implied by the OK_BVOC flag')
+       ENDIF
+
+    ELSE
+
+       ok_leafage         = .FALSE. 
+       ok_radcanopy       = .FALSE. 
+       ok_multilayer      = .FALSE.
+       ok_pulse_NOx       = .FALSE.
+       ok_bbgfertil_NOx   = .FALSE.
+       ok_cropsfertil_NOx = .FALSE.
+
+       ! Search for conflicts
+       conflict = .FALSE.
+       CALL getin_p('CHEMISTRY_LEAFAGE', temp)
+       IF (ok_leafage .NE. temp) conflict = .TRUE.
+       CALL getin_p('CANOPY_EXTINCTION', temp)
+       IF (ok_radcanopy .NE. temp) conflict = .TRUE.
+       CALL getin_p('CANOPY_MULTILAYER', temp)
+       IF (ok_multilayer .NE. temp) conflict = .TRUE.
+       CALL getin_p('NOx_RAIN_PULSE', temp)
+       IF (ok_pulse_NOx .NE. temp) conflict = .TRUE.
+       CALL getin_p('NOx_BBG_FERTIL', temp)
+       IF (ok_bbgfertil_NOx .NE. temp) conflict = .TRUE.
+       CALL getin_p('NOx_FERTILIZERS_USE', temp)
+       IF (ok_cropsfertil_NOx .NE. temp) conflict = .TRUE.
+       IF (conflict) THEN
+          CALL ipslerr(2,'control_initialize', &
+               'Some of the parameter values set in the', &
+               'run.def or set as a default are overwritten by the',&
+               'values implied by the OK_BVOC flag')
+       ENDIF
+
+    ENDIF
+    !
+    !Config Key   = CHEMISTRY_LEAFAGE
+    !Config Desc  = Activate LEAFAGE?
+    !Config If    = CHEMISTRY_BVOC
+    !Config Def   = n
+    !Config Help  = set to TRUE if biogenic emissions calculation takes leaf age into account
+    !Config Units = [FLAG]
+    CALL getin_p('CHEMISTRY_LEAFAGE', ok_leafage)
+    WRITE(numout,*) 'Leaf Age: ', ok_leafage
+    
+    !Config Key   = CANOPY_EXTINCTION 
+    !Config Desc  = Use canopy radiative transfer model?
+    !Config If    = CHEMISTRY_BVOC 
+    !Config Def   = n
+    !Config Help  = set to TRUE if canopy radiative transfer model is used for biogenic emissions 
+    !Config Units = [FLAG]
+    CALL getin_p('CANOPY_EXTINCTION', ok_radcanopy)
+    WRITE(numout,*) 'Canopy radiative transfer model: ', ok_radcanopy
+    
+    !Config Key   = CANOPY_MULTILAYER
+    !Config Desc  = Use canopy radiative transfer model with multi-layers
+    !Config If    = CANOPY_EXTINCTION 
+    !Config Def   = n
+    !Config Help  = set to TRUE if canopy radiative transfer model is with 
+    !Config         multiple layers. DO NOT CONFUSE with the settings for the
+    !Config         multi-layer energy budget.  
+    !Config Units = [FLAG]
+    CALL getin_p('CANOPY_MULTILAYER', ok_multilayer)
+    WRITE(numout,*) 'Multi-layer Canopy model: ', ok_multilayer
+    
+    !Config Key   = NOx_RAIN_PULSE
+    !Config Desc  = Calculate NOx emissions with pulse?
+    !Config If    = CHEMISTRY_BVOC 
+    !Config Def   = n
+    !Config Help  = set to TRUE if NOx rain pulse is taken into account
+    !Config Units = [FLAG]
+    CALL getin_p('NOx_RAIN_PULSE', ok_pulse_NOx)
+    WRITE(numout,*) 'Rain NOx pulsing: ', ok_pulse_NOx
+    
+    !Config Key   = NOx_BBG_FERTIL
+    !Config Desc  = Calculate NOx emissions with bbg fertilizing effect?
+    !Config If    = CHEMISTRY_BVOC 
+    !Config Def   = n
+    !Config Help  = set to TRUE if NOx emissions are calculated with bbg effect 
+    !Config         Fertil effect of bbg on NOx soil emissions 
+    !Config Units = [FLAG]
+    CALL getin_p('NOx_BBG_FERTIL', ok_bbgfertil_NOx)
+    WRITE(numout,*) 'NOx bbg fertil effect: ', ok_bbgfertil_NOx
+    
+    !Config Key   = NOx_FERTILIZERS_USE
+    !Config Desc  = Calculate NOx emissions with fertilizers use?
+    !Config If    = CHEMISTRY_BVOC 
+    !Config Def   = n
+    !Config Help  = set to TRUE if NOx emissions are calculated with fertilizers use
+    !Config         Fertilizers use effect on NOx soil emissions  
+    !Config Units = [FLAG] 
+    CALL getin_p('NOx_FERTILIZERS_USE', ok_cropsfertil_NOx)
+    WRITE(numout,*) 'NOx Fertilizers use: ', ok_cropsfertil_NOx
+    
+    !Config Key  = Is CO2 impact on BVOC accounted for using Possell 2005 ?
+    !Config Desc = In this case we use Possell 2005 parameterisation 
+    !Config Desc = to take into account the impact of CO2 on biogenic emissions for 
+    !Config Desc = isoprene 
+    !Config Def  = n 
+    !Config Help = set to TRUE if Possell parameterisation has to be considered for the CO2 impact
+    !
+    ok_co2bvoc_poss = .FALSE.
+    CALL getin_p('CO2_FOR_BVOC_POSSELL', ok_co2bvoc_poss)
+    WRITE(*,*) 'CO2 impact on BVOC - Possell parameterisation: ', ok_co2bvoc_poss
+    !
+    !Config Key  = Is CO2 impact on BVOC accounted for using Wilkinson 2009 ? 
+    !Config Desc = In this case we use Wilkinson 2009 parameterisation 
+    !Config Desc = to take into account the impact of CO2 on biogenic emissions for 
+    !Config Desc = isoprene 
+    !Config Def  = n 
+    !Config Help = set to TRUE if Wilkinson parameterisation has to be considered for the CO2 impact
+    !
+    ok_co2bvoc_wilk = .FALSE.
+    CALL getin_p('CO2_FOR_BVOC_WILKINSON', ok_co2bvoc_wilk)
+    WRITE(*,*) 'CO2 impact on BVOC - Wilkinson parameterisation: ', ok_co2bvoc_wilk
+    !
+    !+++CHECK+++
+    ! No longer in CN but still in CN.CAN
+    !Config Key  = CONSTANT_MORTALITY
+    !Config Desc = Assume constant prescribed mortality or calculate &
+    !              mortality as a function of last year's NPP
+    !Config If   = OK_STOMATE
+    !Config Def  = y
+    !Config Help = set to TRUE if constant mortality is to be assumed
+    ok_constant_mortality = .TRUE.
+    CALL getin_p('CONSTANT_MORTALITY',ok_constant_mortality)
+    WRITE(numout,*) 'MORTALITY is assumed to be constant ',&
+         '(instead of being a function of vigor): ', &
+         ok_constant_mortality
+    !+++++++++++
+    
+    ! Changes following forest management
+    !
+    !Config Key   = OK_READ_FM_MAP
+    !Config Desc  = We need to have the option to read the forest 
+    !               management strategy from a map (NetCDF file).  
+    !               If this option is equal to TRUE, we will overwrite 
+    !               the forest_managed_forced option, so you should be 
+    !               careful to only use one or the other.  
+    !Config If    = OK_STOMATE
+    !Config Def   = N
+    !Config Help  =
+    !Config Units =
+    ok_read_fm_map=.FALSE.
+    CALL getin_p('OK_READ_FM_MAP',ok_read_fm_map)
+    
+    !Config Key   = OK_SPECIES_CHANGE
+    !Config Desc  = Sometimes it's a good idea to change species 
+    !               after a clearcut on managed forest.  If this 
+    !               flag is true, we do this. If not, the same PFT 
+    !               is always replanted.
+    !Config If    = OK_STOMATE
+    !Config Def   = N
+    !Config Help  =
+    !Config Units =
+    ok_change_species=.FALSE.
+    CALL getin_p('OK_CHANGE_SPECIES',ok_change_species)
+    
+    !Config Key   = READ_SPECIES_CHANGE_MAP
+    !Config Desc  = If we change the species after a clearcut, do we 
+    !               want to read the new PFT from a map?
+    !Config If    = OK_STOMATE
+    !Config Def   = N
+    !Config Help  =
+    !Config Units =
+    ok_read_species_change_map=.FALSE.
+    CALL getin_p('OK_READ_SPECIES_CHANGE_MAP',ok_read_species_change_map)
+    
+    !Config Key   = OK_READ_DESIRED_FM_MAP
+    !Config Desc  = If we change the species after a clearcut, do 
+    !               we want to read the new FM strategy from a map?
+    !Config If    = OK_STOMATE, OK_CHANGE_SPECIES
+    !Config Def   = N
+    !Config Help  =
+    !Config Units =
+    ok_read_desired_fm_map=.FALSE.
+    CALL getin_p('OK_READ_DESIRED_FM_MAP',ok_read_desired_fm_map)
+    
+    !Config Key   = OK_LITTER_RAKING
+    !Config Desc  = Check to see if we are interested in using a litter 
+    !               demand map to remove litter from forest PFTs and put 
+    !               it into agricultural PFTs. This simulations the 
+    !               practice of litter raking.
+    !Config If    = OK_STOMATE
+    !Config Def   = N
+    !Config Help  =
+    !Config Units =
+    ok_litter_raking=.FALSE.
+    CALL getin_p('LITTER_RAKING',ok_litter_raking)
+       
+    !Config Key   = OK_DIMENSIONAL_PRODUCT_USE
+    !Config Desc  = Once the wood is harvested (through management or
+    !               LCC) it ends up in wood product pools. Two options were 
+    !               implemeted: (1) the product use and thus its on longevity,
+    !               depends on the dimensions of the harvest. (2) the 
+    !               dimensions are ignored and the wood is used according
+    !               to fixed ratios.
+    !Config If    = OK_STOMATE
+    !Config Def   = N
+    !Config Help  =
+    !Config Units = 
+    ok_dimensional_product_use=.TRUE.
+    CALL getin_p('DIMENSIONAL_PRODUCT_USE',ok_dimensional_product_use)
+
+    ! Check for consistency
+    IF (ok_change_species .AND. ok_litter_raking)THEN
+
+       ! There is no obvious conflict in combining species change
+       ! and litter raking but it was never tested. Better not to
+       ! combine these settings
+       WRITE(numout,*) 'ERROR - conflicting settings in run.def'
+       WRITE(numout,*) 'Trying to jointly use litter raking and species change'
+       WRITE(numout,*) 'This should be tested first'
+       CALL ipslerr(3,'ERROR: run.def',&
+            'ERROR - Trying to use litter raking',&
+            'at the same time of species change',&
+            'The code was not developed or tested for this combination')       
+    ENDIF
+
+    !+++CHECK+++
+    ! veget_update is not known as this point. How can we test whether 
+    ! land cover change is activated? Alternatively we could move this
+    ! test but this is the best place to have it.
+!!$    IF (ok_change_species .AND. veget_update.GT.zero)THEN
+!!$
+!!$       ! There is no obvious conflict in combining species change
+!!$       ! and land cover change but it was never tested. Better not to
+!!$       ! combine these settings
+!!$       WRITE(numout,*) 'control.f90 - conflicting settings in stomate_lpj'
+!!$       WRITE(numout,*) 'Trying to jointly use land use and species change'
+!!$       WRITE(numout,*) 'This should be tested first'
+!!$       CALL ipslerr(3,'ERROR: run.def',&
+!!$            'ERROR - Trying to use land use ',&
+!!$            'at the same time of species change',&
+!!$            'The code was not loped or tested for this combination')
+!!$    ENDIF
+    !++++++++++
+
+    WRITE(numout,*) 'OK_HYDROL_ARCH is activated, ',ok_hydrol_arch
+    WRITE(numout,*) 'OK_GS_FEEDBACK is activated, ',ok_gs_feedback
+    IF (ok_hydrol_arch .AND. ok_gs_feedback)THEN
+
+       ! This is the default set-up for running hydraulic architecture 
+       ! in production mode. Using full functionality
+       WRITE(numout,*) 'Hydraulic architecture, stomatal feedback'
+       WRITE(numout,*) 'and the energy budget are (re)calculated'
+
+    ELSEIF (.NOT. ok_hydrol_arch .AND. ok_gs_feedback) THEN
+
+       ! The debug options should not be used. Not clear whether
+       ! the user want to use hydraulic architecture or not
+       WRITE(numout,*) 'Hydraulic architecture is not used'
+       WRITE(numout,*) 'but the debug option was set to TRUE'
+       WRITE(numout,*) 'Not clear whether you want to use '
+       WRITE(numout,*) 'hydraulic architecture or not'
+       CALL ipslerr(3,'control.f90 - run.def',&
+            'setting for stomatal feedback was in conflict with',&
+            'the setting of hydraulic architecture','')
+
+    ELSEIF (ok_hydrol_arch .AND. .NOT.ok_gs_feedback) THEN
+
+       ! Warning
+       CALL ipslerr(2,'control.f90 - hydraulic architecture',&
+            'is run in DEBUG mode',&
+            'stomatal feedback is not used','')
+
+    ENDIF
+
+    WRITE(numout,*) 'OK_MLEB is activated, ',ok_mleb
+    WRITE(numout,*) 'OK_IMPOSE_CAN_STRUCTURE is activated, ',ok_impose_can_structure
+    WRITE(numout,*) 'OK_MLEB_HISTORY_FILE is activated, ',ok_mleb_history_file
+    IF (ok_mleb .AND. ok_impose_can_structure) THEN
+
+       ! Warning
+       CALL ipslerr(2,'control.f90 - multi-layer energy budget',&
+            'is run in debug mode',&
+            'The canopy structure is fixed and imposed','')
+
+    ELSEIF (ok_mleb .AND. .NOT.ok_mleb_history_file) THEN
+    
+       ! Warning
+       CALL ipslerr(2,'control.f90 - multi-layer energy budget',&
+            'There won be any output files for the multi-layer energy budget',&
+            'If this is not intended, change the run.def','')
+
+    ELSEIF ((.NOT.ok_mleb .AND. ok_impose_can_structure) .OR. &
+         (.NOT.ok_mleb .AND. ok_mleb_history_file)) THEN
+       
+       ! The debug options should not be used. Not clear whether
+       ! the user want to use hydraulic architecture or not
+       WRITE(numout,*) 'The multi-layer energy budget is not used'
+       WRITE(numout,*) 'Debug options are set to FALSE'
+       CALL ipslerr(3,'control.f90 - run.def',&
+            'inconsistent settings of de debug options',&
+            'because the multi-level enery budget itself is not used','')
+
+    ENDIF
+    
+    IF ( ok_dgvm ) THEN
+
+       ok_stomate = .TRUE.
+       CALL ipslerr(2,'control_initialize', &
+            'If you want to use the DGVM you need STOMATE',&
+            'activating the flag OK_STOMATE',&
+            'We set OK_STOMATE to TRUE to ensure consistency')
+    ENDIF
+
+    IF ( ok_multilayer .AND. .NOT.(ok_radcanopy) ) THEN
+
+       ok_radcanopy  = .TRUE.
+       CALL ipslerr(2,'control_initialize', &
+               'You want to use the multilayer model without ', &
+               'activating the flag CANOPY_EXTINCTION',&
+               'We set CANOPY_EXTINCTION to TRUE to ensure consistency')
+    ENDIF
+    !
+    !Config Key   = OK_C13
+    !Config Desc  = Calculate C13 fractionation
+    !Config If    = OK_SECHIBA 
+    !Config Def   = n
+    !Config Help  = set to TRUE if C13 is to be calculated
+    !Config Units = [FLAG]
+    ok_c13 = .FALSE.
+    CALL getin_p('OK_C13', ok_c13)
+    WRITE(numout,*) 'C13 fractionation is calculated: ', ok_c13
+    ! 
+    !Config Key  = RECRUITMENT 
+    !Config Desc = Activate recruitment. The default is no recruitment 
+    !Config Def  = n 
+    !Config Help = Set to TRUE if recruitment is activated 
+    !Config Units = [FLAG]  
+    ok_recruitment = .FALSE. 
+    CALL getin_p('OK_RECRUITMENT',ok_recruitment) 
+    WRITE(numout,*) 'Recruitment is activated: ',ok_recruitment 
+
+    ok_windthrow = .FALSE.
+    CALL getin_p('OK_WINDTHROW',ok_windthrow) 
+    WRITE(numout,*) 'Windthrow is activated: ',ok_windthrow
+
+    !
+    ! Here we need the same initialisation as above
+    !
+    ok_pheno = .TRUE.
+
+    !
+    ! Configuration : number of PFTs and parameters
+    !
+
+    ! 1. Number of PFTs defined by the user
+
+    !Config Key   = NVM
+    !Config Desc  = number of PFTs  
+    !Config If    = OK_SECHIBA or OK_STOMATE
+    !Config Def   = 13
+    !Config Help  = The number of vegetation types define by the user
+    !Config Units = [-]
+    !
+    CALL getin_p('NVM',nvm)
+    WRITE(numout,*)'the number of pfts used by the model is : ', nvm
+
+    ! 2. Should we read the parameters in the run.def file ?
+
+    !Config Key   = IMPOSE_PARAM
+    !Config Desc  = Do you impose the values of the parameters?
+    !Config if    = OK_SECHIBA or OK_STOMATE
+    !Config Def   = y
+    !Config Help  = This flag can deactivate the reading of some parameters.
+    !               Useful if you want to use the standard values without commenting 
+    !               the run.def
+    !Config Units = [FLAG]
+    !
+    CALL getin_p('IMPOSE_PARAM',impose_param)
+
+
+    !! Initialize vertical discretization
+    !! All initialization is done in the vertical module
+    !! Calculate ngrnd and nslm
+    CALL vertical_soil_init
+    
+    
+    ! 3. Allocate and intialize the pft parameters
+
+    CALL pft_parameters_main()
+
+    ! 4. Activation sub-models of ORCHIDEE
+
+    CALL activate_sub_models()
+
+    ! 5. Vegetation configuration
+
+    CALL veget_config
+
+    ! 6. Read the parameters in the run.def file  according the flags
+
+    IF (impose_param ) THEN 
+       CALL config_pft_parameters
+    ENDIF
+
+    IF ( ok_sechiba ) THEN
+       IF (impose_param ) THEN
+          IF (printlev>=2) WRITE(numout,*)'In control_initialize: &
+              & call config_sechiba_parameters and config_sechiba_pft_parameters' 
+          CALL config_sechiba_parameters
+          CALL config_sechiba_pft_parameters()
+       ENDIF
+    ENDIF
+
+
+    ! Initialize variables in constantes_soil
+    CALL config_soil_parameters()
+
+
+    ! Coherence check for depth of thermosoil for long term simulation where 
+    ! soil thermal inertia matters
+    ! ok_freeze_thermix is defined in config_soil_parameters
+    IF (ok_freeze_thermix .AND. zmaxt < 11) THEN
+       WRITE(numout,*) 'ERROR : Incoherence between ok_freeze_thermix activated &
+            and soil depth too small. '
+       WRITE(numout,*) 'Here a soil depth of ', zmaxt, 'm is used for the soil &
+            thermodynamics'
+       WRITE(numout,*) 'Set DEPTH_MAX_T=11 or higher in run.def parameter file or &
+            deactivate soil freezing'
+       CALL ipslerr(3,'control_initialize','Too shallow soil chosen for the &
+            thermodynamic for soil freezing', &
+            'Adapt run.def with at least DEPTH_MAX=11','')
+    END IF
+        
+    ! Define diaglev
+    ! We take the top nslm (number of layer in CWRR) layer of the thermodynamics 
+    ! for the diagnostics. The layers in the hydrology and the thermodynamics are
+    ! placed a the same depth (the top nslm layers) but the upper boundary condition
+    ! is simpler in the thermodynamics. 
+    nbdl = nslm
+    ALLOCATE(diaglev(nbdl), stat=ier)
+    IF (ier /= 0) CALL ipslerr(3,'control_initialize','Pb in allocation of diaglev','','')
+
+    ! Get diaglev from module vertical for CWRR
+    diaglev=znt(1:nbdl)
+    IF (printlev>=2) WRITE(numout,*) 'In control_initialize, diaglev = ',diaglev
+
+    IF ( impose_param ) THEN
+       IF (printlev>=2) WRITE(numout,*)'In control_initialize: call &
+            & config_co2_parameters'
+       CALL config_co2_parameters
+    ENDIF
+    
+    IF ( ok_stomate ) THEN
+       IF ( impose_param ) THEN
+          IF (printlev>=2) WRITE(numout,*)'In control_initialize: &
+              & call config_stomate_parameters'
+          CALL config_stomate_parameters
+          CALL config_stomate_pft_parameters
+       ENDIF
+    ENDIF
+    
+    IF ( ok_dgvm ) THEN
+       IF ( impose_param ) THEN
+          IF (printlev>=2) WRITE(numout,*)'In control_initialize: &
+             & call config_dgvm_parameters'
+          CALL config_dgvm_parameters
+       ENDIF
+    ENDIF    
+  END SUBROUTINE control_initialize
+  
+END MODULE control
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/function_library.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/function_library.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/function_library.f90	(revision 6412)
@@ -0,0 +1,3101 @@
+! MODULE       : function_library
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Collection of functions that are used throughout the ORCHIDEE code
+!!
+!!\n DESCRIPTION: Collection of modules to : (1) convert one variable into another i.e. basal area
+!! to diameter, diamter to tree height, diameter to crown area, etc. (2) ...
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-DOFOCO/ORCHIDEE/src_stomate/stomate_prescribe.f90 $
+!! $Date: 2013-01-04 16:50:56 +0100 (Fri, 04 Jan 2013) $
+!! $Revision: 1126 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE function_library
+
+  ! modules used:
+
+!$  USE ioipsl_para
+  USE pft_parameters
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC calculate_c0_alloc, &
+       wood_to_ba_old, &
+       wood_to_ba_eff, &
+       wood_to_ba, &
+       wood_to_height, &
+       wood_to_qmheight, &
+       wood_to_height_eff, &
+       wood_to_volume, &
+       wood_to_dia, &
+       wood_to_qmdia,  &
+       wood_to_dia_eff, &
+       wood_to_circ, &
+       wood_to_cv_eff, &
+       wood_to_cn,&
+       wood_to_cn_eff, &
+       cc_to_biomass, &
+       biomass_to_cc, &
+       cc_to_lai, &
+       biomass_to_lai, &
+       lai_to_biomass, &
+       Nmax, &
+       Nmaxyield, &
+       Nminyield, &
+       calculate_rdi, &
+       check_biomass_sync, &
+       check_surface_area, &
+       check_mass_balance, &
+       biomass_to_coupled_lai, &
+       sort_circ_class_biomass
+
+  INTERFACE biomass_to_lai
+     MODULE PROCEDURE biomass_to_lai_0d, biomass_to_lai_1d
+  END INTERFACE
+
+  INTERFACE lai_to_biomass
+     MODULE PROCEDURE lai_to_biomass_0d,  lai_to_biomass_1d
+  END INTERFACE
+
+  INTERFACE cc_to_biomass
+     MODULE PROCEDURE cc_to_biomass_2d, cc_to_biomass_4d
+  END INTERFACE cc_to_biomass
+
+  INTERFACE biomass_to_cc
+     MODULE PROCEDURE biomass_to_cc_1d, biomass_to_cc_3d
+  END INTERFACE biomass_to_cc
+
+  INTERFACE cc_to_lai
+     MODULE PROCEDURE cc_to_lai_0d, cc_to_lai_1d
+  END INTERFACE
+
+  CONTAINS
+
+
+!! ================================================================================================================================
+!! FUNCTION    : biomass_to_coupled_lai
+!!
+!>\BRIEF        Calculate the coupled_LAI based on biomass and veget of each pft
+!!
+!! DESCRIPTION : Calculates the lai that is coupled with the atmosphere  
+!! 
+!!             
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : ::coupled_lai (m2/m2)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION biomass_to_coupled_lai(biomass_leaf, veget, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std)                                       :: pft                    !! PFT number (-)
+    REAL(r_std)                                          :: veget                  !! 1-Pgap or the vegetation cover
+    REAL(r_std)                                          :: biomass_leaf           !! Biomass of an individual tree within a circ 
+                                                                                   !! class @tex $(m^{2} ind^{-1})$ @endtex 
+
+    !! 0.2 Output variables         
+    REAL(r_std)                                          :: biomass_to_coupled_lai !! The fraction of the LAI that is assumed to interact
+                                                                                   !! with the atmosphere @tex $(m^{2} m^{-2})$ @endtex
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std)                                          :: lai                    !! Leaf area index 
+                                                                                   !! @tex $(m^{2} m^{-2})$ @endtex               
+!_ ================================================================================================================================
+ 
+    lai = biomass_to_lai(biomass_leaf, pft) 
+   
+    !+++CHECK+++
+    ! In a closed canopy not all the leaves fully interact with the 
+    ! atmosphere because leaves can shelter each other. In a more 
+    ! open canopy most leaves can interact with the atmosphere.
+    ! For the moment we are not clear how to calculate the fraction of
+    ! the canopy that is coupled to the atmosphere. Also, based on the
+    ! simulated evapotranspiration we need the entire canopy to be
+    ! coupled to the atmosphere to obtain simulations which are close
+    ! to the observations (Jung's upscaled product).
+    IF (veget .GT. min_sechiba) THEN
+     
+       biomass_to_coupled_lai = lai   
+
+    ELSE
+   
+       ! There are so many gaps that veget is extremely small. It is fair to
+       ! assume that the whole canopy is coupled to the atmosphere.
+       biomass_to_coupled_lai = lai
+      
+    ENDIF
+
+  END FUNCTION biomass_to_coupled_lai
+ 
+
+!! ================================================================================================================================
+!! FUNCTION     : biomass_to_lai_0d
+!!
+!>\BRIEF        Calculate the LAI based on the leaf biomass
+!!
+!! DESCRIPTION : Calculates the LAI of a PFT/grid square based on the leaf biomass
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : ::LAI [m**2 m**{-2}]
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION biomass_to_lai_0d(leaf_biomass, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                                          :: pft               !! PFT number (-)
+    REAL(r_std)                                             :: leaf_biomass      !! Biomass of the leaves
+                                                                                 !! @tex $(gC m^{-2})$ @endtex 
+
+
+    !! 0.2 Output variables
+                
+    REAL(r_std)                                             :: biomass_to_lai_0d !! Leaf area index 
+                                                                                 !! @tex $(m^{2} m^{-2})$ @endtex 
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std)                                             :: impose_lai         !! LAI read from run.def
+!_ ================================================================================================================================
+ 
+    !! 1. Calculate the LAI from the leaf biomass
+    IF(sla_dyn) THEN
+       biomass_to_lai_0d = log(1.+ ext_coeff_N(pft)* leaf_biomass * slainit(pft))/(ext_coeff_N(pft)) 
+    ELSE
+       biomass_to_lai_0d = leaf_biomass * sla(pft)
+    ENDIF
+     
+!!$    !+++++++++ TEMP ++++++++++
+!!$    ! This is a perfect place to hack the code to make it run with
+!!$    ! constant lai
+!!$    WRITE(numout,*) 'WARNING ERROR: Using fake lai values for testing!'
+!!$    biomass_to_lai=3.79052
+!!$    !+++++++++++++++++++++++++
+
+            !+++++++ TEMP ++++++++++
+            ! This code is only used for evaluation of the performance of the multi-layer energy budget. 
+            ! To reduce the complexity of the tests we want to impose the LAI and its vertical distribution. 
+            ! The solution is not very elegant but it works. 
+            !  IF (ld_fake_height) THEN
+            ! In order to imposed lai, we read the TOTAL_LAI from run.def
+            !  CALL getin_p('TOTAL_LAI', impose_lai)
+            ! This part of code reset the sla vale to match which alow modeled LAI equal to TOTAL LAI. 
+            ! Althought this is ugly way to match the modeled LAI and impose LAI. 
+            ! You probably need to go to your ORCHIDEE out put file to find out the suitable SLA value 
+            ! and reset it agin in the run.def.
+            ! So, we impose LAI & structure for a quick testing the performance of multilayer energy budget
+            ! without changing the leaf_biomass.
+            !     IF ( leaf_biomass .GT. 0.0) THEN
+            !        sla(pft)=impose_lai/leaf_biomass
+            !          WRITE(numout,'(A,F20.8)') 'USE A FAKE SLA BASED ON imposed LAI/LEAFMASS=', sla(pft)
+            !     ENDIF 
+            !        biomass_to_lai=leaf_biomass*sla(pft) 
+            !  ENDIF 
+            !++++++++++++++++++++++++
+
+  END FUNCTION biomass_to_lai_0d
+
+
+!! ================================================================================================================================
+!! FUNCTION     : biomass_to_lai_1d
+!!
+!>\BRIEF        Calculate the LAI based on the leaf biomass
+!!
+!! DESCRIPTION : Calculates the LAI of a PFT/grid square based on the leaf biomass
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : ::LAI [m**2 m**{-2}]
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION biomass_to_lai_1d(leaf_biomass, npts, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std)                                          :: npts
+    INTEGER(i_std)                                          :: pft               !! PFT number (-)
+    REAL(r_std), DIMENSION(npts)                            :: leaf_biomass      !! Biomass of the leaves
+                                                                                 !! @tex $(gC m^{-2})$ @endtex 
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(npts)                            :: biomass_to_lai_1d !! Leaf area index 
+                                                                                 !! @tex $(m^{2} m^{-2})$ @endtex 
+!_ ================================================================================================================================
+ 
+    !! 1. Calculate the LAI from the leaf biomass
+    IF(sla_dyn) THEN
+       biomass_to_lai_1d = log(1.+ ext_coeff_N(pft)* leaf_biomass * slainit(pft))/(ext_coeff_N(pft)) 
+    ELSE
+       biomass_to_lai_1d = leaf_biomass * sla(pft)
+    ENDIF
+
+  END FUNCTION biomass_to_lai_1d
+
+
+!! ================================================================================================================================
+!! FUNCTION     : lai_to_biomass_0d
+!!
+!>\BRIEF        Calculate leaf biomass from lai
+!!
+!! DESCRIPTION : Calculates leaf biomass (m2 m-2) from leaf biomass (gC m-2)
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : ::Leaf biomass [gC m^{-2}]
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION lai_to_biomass_0d(lai, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std)                                          :: pft               !! PFT number (-)
+    REAL(r_std)                                             :: lai               !! Leaf Area Index
+                                                                                 !! @tex $(m^{2} m^{-2})$ @endtex
+
+
+    !! 0.2 Output variables
+                
+    REAL(r_std)                                             :: lai_to_biomass_0d !! Leaf area index
+                                                                                 !! @tex $(gC m^{-2})$ @endtex  
+                                                                                  
+!_ ================================================================================================================================
+ 
+    !! 1. Calculate the LAI from the leaf biomass
+    IF(sla_dyn) THEN
+       lai_to_biomass_0d = ( exp(lai*ext_coeff_N(pft)) - 1.) / &
+               (ext_coeff_N(pft) * slainit(pft))       
+    ELSE
+       lai_to_biomass_0d = lai / sla(pft)
+    ENDIF
+
+END FUNCTION lai_to_biomass_0d
+
+
+
+!! ================================================================================================================================
+!! FUNCTION     : lai_to_biomass_1d
+!!
+!>\BRIEF        Calculate leaf biomass from lai
+!!
+!! DESCRIPTION : Calculates leaf biomass (m2 m-2) from leaf biomass (gC m-2)
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : ::Leaf biomass [gC m^{-2}]
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION lai_to_biomass_1d(lai, npts, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std)                                          :: npts
+    INTEGER(i_std)                                          :: pft               !! PFT number (-)
+    REAL(r_std), DIMENSION(npts)                            :: lai               !! Leaf Area Index
+                                                                                 !! @tex $(m^{2} m^{-2})$ @endtex
+
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(npts)                            :: lai_to_biomass_1d !! Leaf area index
+                                                                                 !! @tex $(gC m^{-2})$ @endtex  
+                                                                                 
+!_ ================================================================================================================================
+ 
+    !! 1. Calculate the LAI from the leaf biomass
+    IF(sla_dyn) THEN
+       lai_to_biomass_1d = ( exp(lai*ext_coeff_N(pft)) - 1.) / &
+               (ext_coeff_N(pft) * slainit(pft))       
+    ELSE
+       lai_to_biomass_1d = lai / sla(pft)
+    ENDIF
+
+  END FUNCTION lai_to_biomass_1d
+  
+  
+!! ================================================================================================================================
+!! FUNCTION     : calculate_c0_alloc
+!!
+!>\BRIEF        Calculate the baseline root vs sapwood allocation
+!!
+!! DESCRIPTION : Calculates the baseline root vs sapwood allocation based on the 
+!! parameters of the pipe model (hydraulic conductivities) and the
+!! turnover of the different components              
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : ::c0_alloc (m)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION calculate_c0_alloc(pts, pft, tau_eff_root, tau_eff_sap)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                             :: pts               !! Pixel number (-)
+    INTEGER(i_std)                             :: pft               !! PFT number (-)
+    REAL(r_std)                                :: tau_eff_root      !! Effective longivety for leaves (days)
+    REAL(r_std)                                :: tau_eff_sap       !! Effective longivety for leaves (days)
+    
+    !! 0.2 Output variables
+                
+    REAL(r_std)                                :: calculate_c0_alloc  !! quadratic mean height (m) 
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std)                                :: sapwood_density
+    REAL(r_std)                                :: qm_dia            !! quadratic mean diameter (m)
+
+!_ ================================================================================================================================
+ 
+    !! 1. Calculate c0_alloc
+    IF ( is_tree(pft) ) THEN
+
+       sapwood_density = deux * pipe_density(pft) / kilo_to_unit
+       calculate_c0_alloc = sqrt(k_root(pft)/k_sap(pft)*tau_eff_sap/tau_eff_root*sapwood_density)
+
+    ! Grasses and croplands   
+    ELSE
+
+       !+++CHECK+++
+       ! Simply copied the same formulation as for trees but note
+       ! that the sapwood in trees vs grasses and crops has a very
+       ! meaning. In grasses and crops is structural carbon to ensure
+       ! that the allocation works. In trees it really is the sapwood
+       sapwood_density = deux * pipe_density(pft) / kilo_to_unit
+       calculate_c0_alloc = sqrt(k_root(pft)/k_sap(pft)*tau_eff_sap/tau_eff_root*sapwood_density)
+       !+++++++++++
+
+    ENDIF ! is_tree(j)
+
+ END FUNCTION calculate_c0_alloc
+
+
+!! ================================================================================================================================
+!! FUNCTION     : wood_to_ba_eff
+!!
+!>\BRIEF        Calculate effective basal area from woody biomass making use of allometric relationships
+!!
+!! DESCRIPTION :  Calculate basal area of an individual tree from the woody biomass of that tree making 
+!! use of allometric relationships. Effective basal area accounts for both above and below ground carbon
+!! and is the basis for the application of the rule of Deleuze and Dhote.
+!! (i) woodmass = tree_ff * pipe_density*ba*height
+!! (ii) height = pipe_tune2 * sqrt(4/pi*ba) ** pipe_tune_3  
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : effective basal area (m2 ind-1)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+ 
+ FUNCTION wood_to_ba_eff(biomass_temp, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                                          :: pft                  !! PFT number (-)
+    REAL(r_std), DIMENSION(:,:)                             :: biomass_temp         !! Biomass of an individual tree within a circ 
+                                                                                    !! class @tex $(m^{2} ind^{-1})$ @endtex 
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(ncirc)                           :: wood_to_ba_eff       !! Effective basal area of an individual tree within a circ
+                                                                                    !! class @tex $(m^{2} ind^{-1})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                          :: l                    !! Index
+    REAL(r_std)                                             :: woodmass_ind         !! Woodmass of an individual tree
+                                                                                    !! @tex $(gC ind^{-1})$ @endtex
+
+!_ ================================================================================================================================
+ 
+ !! 1. Calculate basal area from woodmass
+
+    IF ( is_tree(pft) ) THEN
+       
+       DO l = 1,ncirc
+         
+          ! Woodmass of an individual tree
+          woodmass_ind = biomass_temp(l,isapabove) + biomass_temp(l,isapbelow) + &
+             biomass_temp(l,iheartabove) + biomass_temp(l,iheartbelow)
+
+          ! Basal area of that individual (m2 ind-1)  
+          wood_to_ba_eff(l) = (pi/4*(woodmass_ind/(tree_ff(pft)*pipe_density(pft)*pipe_tune2(pft))) &
+                  **(2./pipe_tune3(pft)))**(pipe_tune3(pft)/(pipe_tune3(pft)+2))
+                 
+       ENDDO
+
+    ELSE
+
+       WRITE(numout,*) 'pft ',pft
+       CALL ipslerr (3,'wood_to_ba_eff', &
+            'wood_to_ba_eff is not defined for this PFT.', &
+            'See the output file for more details.','')
+
+    ENDIF
+
+ END FUNCTION wood_to_ba_eff
+
+!! ================================================================================================================================
+!! FUNCTION     : wood_to_ba_old
+!!
+!>\BRIEF        Calculate basal area from woody biomass making use of allometric relationships
+!!
+!! DESCRIPTION : Calculate basal area of an individual tree from the woody biomass of that tree making 
+!! use of allometric relationships given below. Here basal area is defined in line with its classical 
+!! forestry meaning.
+!! (i) woodmass = tree_ff * pipe_density*ba*height
+!! (ii) height = pipe_tune2 * sqrt(4/pi*ba) ** pipe_tune_3  
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : basal area (m2 ind-1)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+ 
+ FUNCTION wood_to_ba_old(biomass_temp, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                                          :: pft               !! PFT number (-)
+    REAL(r_std), DIMENSION(:)                             :: biomass_temp        !! Biomass of an individual tree within a circ 
+                                                                                 !! class @tex $(m^{2} ind^{-1})$ @endtex 
+
+    !! 0.2 Output variables
+                
+    REAL(r_std)                                            :: wood_to_ba_old     !! Basal area of an individual tree within a circ
+                                                                                 !! class @tex $(m^{2} ind^{-1})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std)                                             :: woodmass_ind      !! Woodmass of an individual tree
+                                                                                 !! @tex $(gC ind^{-1})$ @endtex
+
+!_ ================================================================================================================================
+ 
+ !! 1. Calculate basal area from woodmass
+
+    IF ( is_tree(pft) ) THEN
+
+             
+          ! Woodmass of an individual tree
+          woodmass_ind = biomass_temp(iheartabove) + biomass_temp(isapabove)
+
+
+          ! Basal area of that individual (m2 ind-1)  
+          wood_to_ba_old = (pi/4*(woodmass_ind/(tree_ff(pft)*pipe_density(pft)*pipe_tune2(pft))) &
+                  **(2./pipe_tune3(pft)))**(pipe_tune3(pft)/(pipe_tune3(pft)+2))
+
+
+    ELSE
+
+       WRITE(numout,*) 'pft ',pft
+       CALL ipslerr (3,'wood_to_ba', &
+            'wood_to_ba is not defined for this PFT.', &
+            'See the output file for more details.','')
+
+    ENDIF
+
+ END FUNCTION wood_to_ba_old
+
+
+!! ================================================================================================================================
+!! FUNCTION     : ccbio_to_biomass
+!!
+!>\BRIEF        Calculate total biomass from circ_class_biomass
+!!
+!! DESCRIPTION : circ_class_biomass is expressed in gC tree-1 and thus needs to
+!!               be multiplied by the number of trees per circumference class
+!!               circ_class_n expressed in tree m-2 to calculate the total
+!!               biomass in gC m-2. 
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : total biomass (gC(N) m-2)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+ 
+ FUNCTION cc_to_biomass_2d(npts,ivm,ccbio,ccind)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                        :: npts              !! Domain size (unitless)
+    INTEGER(i_std), INTENT(in)                        :: ivm               !! number of the specific PFT (unitless)
+    REAL(r_std), DIMENSION(:,:,:)                     :: ccbio             !! circ_class_biomass. Biomass of an individual 
+                                                                           !! tree @tex $(gC(N) ind^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:)                         :: ccind             !! circ_class_n. Number of trees per circumference
+                                                                           !! class
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(nparts,nelements)          :: cc_to_biomass_2d  !! biomass @tex $(gC(N) m^{2})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                    :: iele,icir,ipar    !! Index
+
+!_ ================================================================================================================================
+    
+    cc_to_biomass_2d(:,:) = zero
+
+    DO iele = 1,nelements
+
+       ! Note that when used in 2d ivm is a single PFT
+       IF ( is_tree(ivm) ) THEN
+
+          DO ipar = 1,nparts
+
+             DO icir = 1,ncirc
+                
+                cc_to_biomass_2d(ipar,iele) = cc_to_biomass_2d(ipar,iele) + &
+                     ccbio(icir,ipar,iele) * ccind(icir)
+                                        
+             ENDDO
+      
+          ENDDO
+
+       ELSE
+
+          ! Grasses and cropland only have one circumference class
+          DO ipar = 1,nparts
+             
+             cc_to_biomass_2d(ipar,iele) = cc_to_biomass_2d(ipar,iele) + &
+                  ccbio(1,ipar,iele) * ccind(1)
+             
+          ENDDO
+
+       ENDIF
+
+    ENDDO
+
+ END FUNCTION cc_to_biomass_2d
+
+ 
+!! ================================================================================================================================
+
+ FUNCTION cc_to_biomass_4d(npts,nvm,ccbio,ccind)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                        :: npts               !! Domain size (unitless)
+    INTEGER(i_std), INTENT(in)                        :: nvm                !! Total number of PFTs (unitless)
+    REAL(r_std), DIMENSION(:,:,:,:,:)                 :: ccbio              !! circ_class_biomass. Biomass of an individual 
+                                                                            !! tree @tex $(gC(N) ind^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:)                     :: ccind              !! circ_class_n. Number of trees per circumference
+                                                                            !! class
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements) :: cc_to_biomass_4d   !! biomass @tex $(gC(N) m^{2})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                    :: iele,icir,ipar,ivm !! Index
+
+!_ ================================================================================================================================
+    
+    cc_to_biomass_4d(:,:,:,:) = zero
+
+    DO iele = 1,nelements
+
+       ! Note that when used in 4d, nvm rather than ivm
+       ! should be passed. Now the function will loop over all
+       ! PFTs instead of just 1 PFT for the 2d version of this
+       ! function.
+       DO ivm = 2,nvm
+
+          IF ( is_tree(ivm) ) THEN
+
+             DO ipar = 1,nparts
+
+                DO icir = 1,ncirc
+
+                   cc_to_biomass_4d(:,ivm,ipar,iele) = cc_to_biomass_4d(:,ivm,ipar,iele) + &
+                      ccbio(:,ivm,icir,ipar,iele) * ccind(:,ivm,icir)
+                                        
+                ENDDO
+      
+             ENDDO
+
+          ELSE
+
+            ! Grasses and cropland only have one circumference class
+            DO ipar = 1,nparts
+
+               cc_to_biomass_4d(:,ivm,ipar,iele) = cc_to_biomass_4d(:,ivm,ipar,iele) + &
+                   ccbio(:,ivm,1,ipar,iele) * ccind(:,ivm,1)
+
+            ENDDO
+
+          ENDIF
+
+       ENDDO
+
+    ENDDO
+
+ END FUNCTION cc_to_biomass_4d
+
+
+!! ================================================================================================================================
+!! FUNCTION     : biomass_to_cc
+!!
+!>\BRIEF        Calculate circ_class_biomass from biomass
+!!
+!! DESCRIPTION : The labile and carbres pools are often dealt with at the stand
+!!               level for simplicity but then need to be stored at the plant 
+!!               level. This is needed because labile and carbres C is lost when
+!!               plants are dying. Also, all plant C and N should be stored in a
+!!               single variable. 
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : total biomass (gC(N) m-2)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+ 
+ FUNCTION biomass_to_cc_1d(bio,ccbio,ccind)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    REAL(r_std)                                       :: bio               !! biomass. Biomass of a specific pool of 
+                                                                           !! a whole stand 
+                                                                           !! @tex $(gC(N) m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:)                         :: ccbio             !! circ_class_biomass. Biomass of a specif pool of 
+                                                                           !! the individual trees in each circumference class 
+                                                                           !! @tex $(gC(N) ind^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:)                         :: ccind             !! circ_class_n. Number of trees per circumference
+                                                                           !! class
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(ncirc)                     :: biomass_to_cc_1d  !! biomass @tex $(gC(N) m^{2})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                    :: icir              !! Index
+    REAL(r_std), DIMENSION(ncirc)                     :: share_ncirc       !! ratio of specific pool
+                                                                           !! across circumference classes
+
+!_ ================================================================================================================================
+    
+    biomass_to_cc_1d(:) = zero
+
+    ! Convert the pools
+    IF (SUM(ccbio(:)*ccind(:)) .GT. zero) THEN
+       
+       ! Proportional to the present pools
+       share_ncirc(:) = (ccbio(:)*ccind(:))/SUM(ccbio(:)*ccind(:))
+
+    ELSEIF (SUM(ccind(:)) .GT. zero) THEN
+
+       ! There are no pools at present. Make it proportional
+       ! to the number of trees
+       share_ncirc(:) = ccind(:)/SUM(ccind(:))
+
+    ELSE 
+
+       ! There is no biomass in circ_class_biomass or individuals
+       share_ncirc(:) = zero
+
+
+    ENDIF
+
+    share_ncirc(1) = zero
+    share_ncirc(1) = 1 - SUM(share_ncirc(:))
+
+    ! Distribute bio over the ncirc circumference classes of biomass_to_cc
+    ! biomass_to_cc will eventually be assigned to circ_class_biomass
+    DO icir = 1,ncirc
+
+       IF (ccind(icir) .GT. zero) THEN
+
+          biomass_to_cc_1d(icir) = bio / ccind(icir) * share_ncirc(icir)
+
+       ELSE
+
+          biomass_to_cc_1d(icir) = zero
+
+       ENDIF
+
+    ENDDO
+
+ END FUNCTION biomass_to_cc_1d
+
+!! ================================================================================================================================
+FUNCTION biomass_to_cc_3d(bio,ccbio,ccind,npts,nvm)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                        :: npts              !! Domain size (unitless)
+    INTEGER(i_std), INTENT(in)                        :: nvm               !! Total number of PFTs (unitless)
+    REAL(r_std),DIMENSION(:,:)                        :: bio               !! biomass. Biomass of a specific pool of 
+                                                                           !! a whole stand. dimensions are npts and nvm 
+                                                                           !! @tex $(gC(N) m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:)                     :: ccbio             !! circ_class_biomass. Biomass of a specif pool of 
+                                                                           !! the individual trees in each circumference class 
+                                                                           !! @tex $(gC(N) ind^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:)                     :: ccind             !! circ_class_n. Number of trees per circumference
+                                                                           !! class
+   
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)            :: biomass_to_cc_3d  !! biomass @tex $(gC(N) m^{2})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                    :: icir,ipts,ivm     !! Index
+    REAL(r_std), DIMENSION(ncirc)                     :: share_ncirc       !! ratio of specific pool
+                                                                           !! across circumference classes
+
+!_ ================================================================================================================================
+    
+    biomass_to_cc_3d(:,:,:) = zero
+
+    DO ipts = 1,npts
+
+       DO ivm = 1,nvm
+
+          ! Convert the pools
+          IF (is_tree(ivm)) THEN
+
+             ! Forests have ncirc circ classes
+             IF (SUM(ccbio(ipts,ivm,:)*ccind(ipts,ivm,:)) .GT. zero) THEN
+       
+                share_ncirc(:) = (ccbio(ipts,ivm,:)*ccind(ipts,ivm,:)) / &
+                     SUM(ccbio(ipts,ivm,:)*ccind(ipts,ivm,:))
+
+             ELSE
+
+                share_ncirc(:) = zero
+                
+             ENDIF
+
+          ELSE
+            
+             ! Grass and crops
+             share_ncirc(:) = zero
+
+          ENDIF
+
+          ! Make sure that the shares add up to one
+          ! and that grass and croplands are properly
+          ! dealt with
+          share_ncirc(1) = zero
+          share_ncirc(1) = 1 - SUM(share_ncirc(:))
+                   
+          DO icir = 1,ncirc
+
+             IF (ccind(ipts,ivm,icir) .GT. zero) THEN
+
+                biomass_to_cc_3d(ipts,ivm,icir) = bio(ipts,ivm) / &
+                     ccind(ipts,ivm,icir) * share_ncirc(icir)
+
+             ELSE
+
+                biomass_to_cc_3d(ipts,ivm,icir) = zero
+
+             ENDIF ! plants are present in this circ_class
+
+          ENDDO ! icir
+
+       ENDDO ! ivm
+       
+    ENDDO ! ipts
+
+ END FUNCTION biomass_to_cc_3d
+
+!! ================================================================================================================================
+
+
+
+
+
+
+
+!! ================================================================================================================================
+!! FUNCTION     : cc_to_lai_0d
+!!
+!>\BRIEF        Calculate the LAI based on the circ_class_biomass and circ_class_n
+!!
+!! DESCRIPTION : Calculates the LAI of a PFT/grid square based on the leaf biomass
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : ::LAI [m**2 m**{-2}]
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION cc_to_lai_0d(ccbio,ccind,pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                        :: pft                !! Number of the PFT under study (unitless)
+    REAL(r_std), DIMENSION(:)                         :: ccbio              !! circ_class_biomass. Biomass of an individual 
+                                                                            !! tree @tex $(gC(N) ind^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:)                         :: ccind              !! circ_class_n. Number of trees per circumference
+                                                                            !! class
+
+    !! 0.2 Output variables
+    REAL(r_std)                                       :: cc_to_lai_0d       !! leaf area index @tex $(m^{2} m^{-2})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                    :: icir               !! Index
+    REAL(r_std)                                       :: leaf_biomass       !! Leaf mass for carbon calculated from 
+                                                                            !! circ_class_biomass and circ_class_n.
+                                                                            !! @tex $(gC m^{-2})$ @endtex
+!_ ================================================================================================================================
+ 
+    !! 1. Calculate leaf biomass
+    cc_to_lai_0d = zero
+    leaf_biomass = zero
+
+    IF ( is_tree(pft) ) THEN
+
+       DO icir = 1,ncirc
+                
+          leaf_biomass = leaf_biomass + ccbio(icir) * ccind(icir)
+                                        
+       ENDDO
+
+    ELSE
+
+       ! Grasses and cropland only have one circumference class
+       leaf_biomass = ccbio(1) * ccind(1)
+        
+    ENDIF
+
+    !! 2. Calculate the LAI from the leaf biomass
+    IF(sla_dyn) THEN
+       
+       cc_to_lai_0d = log(1.+ ext_coeff_N(pft) * leaf_biomass * &
+            slainit(pft))/(ext_coeff_N(pft)) 
+        
+    ELSE
+
+       cc_to_lai_0d = leaf_biomass * sla(pft)
+
+    ENDIF
+
+ END FUNCTION cc_to_lai_0d
+
+
+!! ================================================================================================================================
+!! FUNCTION     : cc_to_lai_1d
+!!
+!>\BRIEF        Calculate the LAI based on the circ_class_biomass and circ_class_n
+!!
+!! DESCRIPTION : Calculates the LAI of a PFT/grid square based on the leaf biomass
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : ::LAI [m**2 m**{-2}]
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION cc_to_lai_1d(npts,ccbio,ccind,pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                        :: npts               !! Domain size (unitless)
+    INTEGER(i_std), INTENT(in)                        :: pft                !! number of PFT under study (unitless)
+    REAL(r_std), DIMENSION(:,:,:,:)                   :: ccbio              !! circ_class_biomass. Biomass of an individual 
+                                                                            !! tree @tex $(gC(N) ind^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:)                       :: ccind              !! circ_class_n. Number of trees per circumference
+                                                                            !! class
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(npts)                      :: cc_to_lai_1d       !! leaf area index @tex $(m^{2} m^{-2})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                    :: icir               !! Index
+    REAL(r_std), DIMENSION(npts)                      :: leaf_biomass       !! Leaf mass for carbon calculated from 
+                                                                            !! circ_class_biomass and circ_class_n.
+                                                                            !! @tex $(gC m^{-2})$ @endtex
+!_ ================================================================================================================================
+ 
+    !! 1. Calculate leaf biomass for a specific PFT
+    cc_to_lai_1d(:) = zero
+    leaf_biomass(:) = zero
+
+    ! Note that when used in 2d ivm is a single PFT
+    IF ( is_tree(pft) ) THEN
+
+       DO icir = 1,ncirc
+                
+          leaf_biomass(:) = leaf_biomass(:) + &
+               ccbio(:,icir,ileaf,icarbon) * ccind(:,icir)
+                                        
+       ENDDO
+
+    ELSE
+
+       ! Grasses and cropland only have one circumference class
+             
+        leaf_biomass(:) = ccbio(:,1,ileaf,icarbon) * ccind(:,1)
+
+     ENDIF
+
+     !! 2. Calculate the LAI from the leaf biomass
+     IF(sla_dyn) THEN
+
+       cc_to_lai_1d(:) = log(1.+ ext_coeff_N(pft)* leaf_biomass(:) * &
+            slainit(pft))/(ext_coeff_N(pft)) 
+
+    ELSE
+
+       cc_to_lai_1d(:) = leaf_biomass(:) * sla(pft)
+
+    ENDIF
+
+ END FUNCTION cc_to_lai_1d
+
+
+!! ================================================================================================================================
+!! FUNCTION     : wood_to_ba
+!!
+!>\BRIEF        Calculate basal area from woody biomass making use of allometric relationships
+!!
+!! DESCRIPTION : Calculate basal area of an individual tree from the woody biomass of that tree making 
+!! use of allometric relationships given below. Here basal area is defined in line with its classical 
+!! forestry meaning.
+!! (i) woodmass = tree_ff * pipe_density*ba*height
+!! (ii) height = pipe_tune2 * sqrt(4/pi*ba) ** pipe_tune_3  
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : basal area (m2 ind-1)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+ 
+ FUNCTION wood_to_ba(biomass_temp, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                                          :: pft               !! PFT number (-)
+    REAL(r_std), DIMENSION(:,:)                             :: biomass_temp      !! Biomass of an individual tree within a circ 
+                                                                                 !! class @tex $(m^{2} ind^{-1})$ @endtex 
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(ncirc)                           :: wood_to_ba        !! Basal area of an individual tree within a circ
+                                                                                 !! class @tex $(m^{2} ind^{-1})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                          :: l                 !! Index
+    REAL(r_std)                                             :: woodmass_ind      !! Woodmass of an individual tree
+                                                                                 !! @tex $(gC ind^{-1})$ @endtex
+
+!_ ================================================================================================================================
+ 
+ !! 1. Calculate basal area from woodmass
+
+    IF ( is_tree(pft) ) THEN
+
+       DO l = 1,ncirc
+             
+          ! Woodmass of an individual tree
+          woodmass_ind = biomass_temp(l,iheartabove) + biomass_temp(l,isapabove)
+
+
+          ! Basal area of that individual (m2 ind-1)  
+          wood_to_ba(l) = (pi/4*(woodmass_ind/(tree_ff(pft)*pipe_density(pft)*pipe_tune2(pft))) &
+                  **(2./pipe_tune3(pft)))**(pipe_tune3(pft)/(pipe_tune3(pft)+2))
+
+       ENDDO
+
+    ELSE
+
+       WRITE(numout,*) 'pft ',pft
+       CALL ipslerr (3,'wood_to_ba', &
+            'wood_to_ba is not defined for this PFT.', &
+            'See the output file for more details.','')
+
+    ENDIF
+
+ END FUNCTION wood_to_ba
+
+
+
+!! ================================================================================================================================
+!! FUNCTION     : wood_to_qmheight
+!!
+!>\BRIEF        Calculate the quadratic mean height from the biomass
+!!
+!! DESCRIPTION : Calculates the quadratic mean height from the biomass
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : ::qm_height (m)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION wood_to_qmheight(biomass_temp, ind, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                             :: pft               !! PFT number (-)
+    REAL(r_std), DIMENSION(ncirc,nparts)       :: biomass_temp      !! Biomass of the leaves @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)              :: ind               !! Number of individuals @tex $(m^{-2})$ @endtex
+
+
+    !! 0.2 Output variables
+                
+    REAL(r_std)                                :: wood_to_qmheight  !! quadratic mean height (m) 
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(ncirc)              :: circ_class_ba     !! basal area for each circ_class @tex $(m^{2})$ @endtex
+    REAL(r_std)                                :: qm_dia            !! quadratic mean diameter (m)
+
+!_ ================================================================================================================================
+ 
+    !! 1. Calculate qm_height from the biomass
+    IF ( is_tree(pft) ) THEN
+
+       ! Basal area at the tree level (m2 tree-1)
+       circ_class_ba(:) = wood_to_ba(biomass_temp(:,:),pft) 
+       
+       IF (SUM(ind(:)) .NE. zero) THEN
+
+          qm_dia = SQRT( 4/pi*SUM(circ_class_ba(:)*ind(:))/SUM(ind(:)) )
+          
+       ELSE
+          
+          qm_dia = zero
+
+       ENDIF
+       
+       wood_to_qmheight = pipe_tune2(pft)*(qm_dia**pipe_tune3(pft))
+             
+
+    ! Grasses and croplands   
+    ELSE
+
+       ! Calculate height as a function of the leaf and structural biomass. Use structural
+       ! biomass to make sure that the grasslands have a roughness length during the winter
+       ! If the biomass increases, vegetation height will increase as well. Divide by 
+       ! ind(ipts,j) to obtain the height of the individual. biomass(ileaf) is in gC m-2 
+       ! whereas qm is the height of the individual.
+       IF (SUM(ind(:)) .NE. zero) THEN
+
+          wood_to_qmheight = SUM(biomass_temp(:,ileaf) + biomass_temp(:,isapabove)) / &
+               SUM(ind(:)) * sla(pft) * lai_to_height(pft)
+
+       ELSE
+
+          wood_to_qmheight = zero
+
+       ENDIF
+
+    ENDIF ! is_tree(j)
+
+ END FUNCTION wood_to_qmheight
+
+
+!! ================================================================================================================================
+!! FUNCTION     : wood_to_qmdia
+!!
+!>\BRIEF        Calculate the quadratic mean diameter from the biomass
+!!
+!! DESCRIPTION : Calculates the quadratic mean diameter from the aboveground biomass
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : ::qm_dia (m)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION wood_to_qmdia(biomass_temp, ind, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                             :: pft               !! PFT number (-)
+    REAL(r_std), DIMENSION(ncirc,nparts)       :: biomass_temp      !! Biomass of the leaves @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(ncirc)              :: ind               !! Number of individuals @tex $(m^{-2})$ @endtex
+
+    !! 0.2 Output variables
+                
+    REAL(r_std)                                :: wood_to_qmdia     !! quadratic mean diameter (m) 
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(ncirc)              :: circ_class_ba     !! basal area for each circ_class @tex $(m^{2})$ @endtex
+
+!_ ================================================================================================================================
+ 
+    !! 1. Calculate qm_dia from the biomass
+    IF ( is_tree(pft) ) THEN
+
+       ! Basal area at the tree level (m2 tree-1)
+       circ_class_ba(:) = wood_to_ba(biomass_temp(:,:),pft) 
+       
+       IF (SUM(ind(:)) .NE. zero) THEN
+
+          wood_to_qmdia = SQRT( 4/pi*SUM(circ_class_ba(:)*ind(:))/SUM(ind(:)) )
+          
+       ELSE
+          
+          wood_to_qmdia = zero
+
+       ENDIF
+
+
+    ! Grasses and croplands   
+    ELSE
+
+       wood_to_qmdia = zero   
+       
+    ENDIF ! is_tree(pft)
+
+ END FUNCTION wood_to_qmdia
+
+
+!! ================================================================================================================================
+!! FUNCTION     : wood_to_volume
+!!
+!>\BRIEF        This allometric function computes volume as a function of 
+!! biomass at stand scale. Volume \f$(m^3 m^{-2}) = f(biomass (gC m^{-2}))\f$
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!! 
+!! RETURN VALUE : biomass_to_volume
+!!
+!! REFERENCE(S)	: See above, module description.
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION wood_to_volume(npts,ccbio,ccind,pft,branch_ratio,inc_branches)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                :: npts           !! Domain size (unitless)
+    REAL(r_std), INTENT(in), DIMENSION(:,:,:) :: ccbio          !! circ_class_biomass or biomass of an 
+                                                                !! individual tree in each circumference 
+                                                                !! class @tex $(gC tree^{-1})$ @endtex  
+    REAL(r_std), INTENT(in), DIMENSION(:)     :: ccind          !! Number of trees per circumference class
+    REAL(r_std), INTENT(in)                   :: branch_ratio   !! Branch ratio of sap and heartwood biomass
+                                                                !! unitless
+    INTEGER(i_std), INTENT(in)                :: pft            !! Plant functional type (unitless)
+    INTEGER(i_std), INTENT(in)                :: inc_branches   !! Include the branches in the volume calculation?
+                                                                !! 0: exclude the branches from the volume calculation 
+                                                                !! (thus correct the biomass for the branch ratio)
+                                                                !! 1: include the branches in the volume calculation  
+                                                                !! (thus use all aboveground biomass)
+                                    
+    
+
+    !! 0.2 Output variables
+
+    REAL(r_std)                               :: wood_to_volume !! The volume of wood per square meter 
+                                                                !!  @tex $(m^3 m^{-2})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(nparts,nelements)  :: biomass        !! Total biomass at the stand level
+                                                                !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std)                               :: woody_biomass  !! Woody biomass at the stand level 
+                                                                !! @tex $(gC m^{-2})$ @endtex
+
+!_ ================================================================================================================================
+
+ !! 1. Volume to biomass
+
+    ! Calculate stand biomass from circ_class_biomass. In cc_to_biomass_2d
+    ! which is used here, npts is not used but we need to pass it to have
+    ! a consistent call structure for cc_to_biomass_2d and cc_to_biomass_4d
+    biomass = cc_to_biomass(npts,pft,ccbio,ccind)
+
+    ! Woody biomass used in the calculation
+    IF (inc_branches .EQ. 0) THEN
+
+       woody_biomass = (biomass(isapabove,icarbon)+biomass(iheartabove,icarbon)) * &
+            (un - branch_ratio)
+
+    ELSEIF (inc_branches .EQ. 1) THEN
+
+       woody_biomass = (biomass(isapabove,icarbon)+biomass(iheartabove,icarbon))
+
+    ELSE
+
+       CALL ipslerr(3,'ERROR in wood_to_volume',&
+            'Specify how the branches should be accounted for','','')
+
+    ENDIF
+
+    ! Wood volume expressed in m**3 / m**2
+    wood_to_volume = woody_biomass/(pipe_density(pft))
+
+  END FUNCTION wood_to_volume
+
+
+!! ================================================================================================================================
+!! FUNCTION     : wood_to_height
+!!
+!>\BRIEF        Calculate tree height from woody biomass making use of allometric relationships
+!!
+!! DESCRIPTION : Calculate height of an individual tree from the woody biomass of that tree making 
+!! use of allometric relationships. This is the height used in forestry and for calculating the aerodynamic
+!! interactions 
+!! (i) height(:) = pipe_tune2(j)*(4/pi*ba(:))**(pipe_tune3(j)/2) and
+!! (ii) woodmass_ind = tree_ff*pipe_density*ba*height   
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : height (m)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION wood_to_height(biomass_temp, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                                          :: pft                !! PFT number (-)
+    REAL(r_std), DIMENSION(:,:)                             :: biomass_temp       !! Biomass of an individual tree within a circ 
+                                                                                  !! class @tex $(m^{2} ind^{-1})$ @endtex 
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(ncirc)                           :: wood_to_height     !! Height of an individual tree within a circ
+                                                                                  !! class (m)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                          :: l                  !! Index
+    REAL(r_std)                                             :: woodmass_ind       !! Woodmass of an individual tree
+                                                              !! @tex $(gC ind{-1})$ @endtex
+
+!_ ================================================================================================================================
+ 
+ !! 1. Calculate height from woodmass
+
+    IF ( is_tree(pft) ) THEN
+       
+       DO l = 1,ncirc
+         
+          ! Woodmass of an individual tree (only the aboveground component)
+          woodmass_ind = biomass_temp(l,isapabove) + biomass_temp(l,iheartabove)
+
+          ! Height of that individual
+          wood_to_height(l) = (((woodmass_ind/(tree_ff(pft)*&
+               pipe_density(pft))*4/pi)**(pipe_tune3(pft)/2))*&
+               pipe_tune2(pft))**(1/(pipe_tune3(pft)/2+1))
+            
+       ENDDO
+
+    ELSE
+
+       WRITE(numout,*) 'ERROR: wood_to_height, pft ',pft
+       CALL ipslerr (3,'wood_to_height', &
+            'wood_to_height is not defined for this PFT.', &
+            'See the output file for more details.','')
+
+    ENDIF
+
+ END FUNCTION wood_to_height
+
+
+!! ================================================================================================================================
+!! FUNCTION     : wood_to_height_eff
+!!
+!>\BRIEF        Calculate the effective tree height from woody biomass making use of allometric relationships
+!!
+!! DESCRIPTION : Calculate the effective height of an individual tree from the woody biomass of that tree making 
+!! use of allometric relationships. Effective height makes use of both above and belowground biomass and is
+!! used in the calculation of the allocation according to deleuze and dhote, hydraulic architecture because also
+!! the height of the belowground part should be included.
+!! (i) height(:) = pipe_tune2(j)*(4/pi*ba(:))**(pipe_tune3(j)/2) and
+!! (ii) woodmass_ind = tree_ff*pipe_density*ba*height   
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : height (m)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION wood_to_height_eff(biomass_temp, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                                          :: pft                !! PFT number (-)
+    REAL(r_std), DIMENSION(:,:)                             :: biomass_temp       !! Biomass of an individual tree within a circ 
+                                                                                  !! class @tex $(m^{2} ind^{-1})$ @endtex 
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(ncirc)                           :: wood_to_height_eff !! Effective height of an individual tree within a circ
+                                                                                  !! class (m)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                          :: l                  !! Index
+    REAL(r_std)                                             :: woodmass_ind       !! Woodmass of an individual tree
+                                                                                  !! @tex $(gC ind{-1})$ @endtex
+                                                                                  
+!_ ================================================================================================================================
+ 
+ !! 1. Calculate height from woodmass
+
+    IF ( is_tree(pft) ) THEN
+       
+       DO l = 1,ncirc
+         
+          ! Woodmass of an individual tree. Both above and belowground biomass are used
+          woodmass_ind = biomass_temp(l,isapabove) + biomass_temp(l,isapbelow) + &
+             biomass_temp(l,iheartabove) + biomass_temp(l,iheartbelow)
+
+          ! Height of that individual
+          wood_to_height_eff(l) = (((woodmass_ind/(tree_ff(pft)*pipe_density(pft))*4/pi)**(pipe_tune3(pft)/2))&
+               *pipe_tune2(pft))**(1/(pipe_tune3(pft)/2+1))
+          
+       ENDDO
+
+    ELSE
+
+       WRITE(numout,*) 'pft ',pft
+       CALL ipslerr (3,'wood_to_height_eff', &
+            'wood_to_height_eff is not defined for this PFT.', &
+            'See the output file for more details.','')
+
+    ENDIF
+
+ END FUNCTION wood_to_height_eff
+
+
+!! ================================================================================================================================
+!! FUNCTION     : wood_to_dia
+!!
+!>\BRIEF        Calculate diameter from woody biomass making use of allometric relationships
+!!
+!! DESCRIPTION : Calculate diameter of an individual tree from the woody biomass of that tree making 
+!! use of allometric relationships. Makes only use of the aboveground biomass and relates to the
+!! typical forestry diameter (but not normalized at 1.3 m)
+!! (i) woodmass_ind = tree_ff * pipe_density * height * pi/4*dia**2
+!! (ii) height = pipe_tune2 * dia * pipe_tune3 
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : diameter (m)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION wood_to_dia(biomass_temp, pft)
+
+
+ !! 0. Variable and parameter declaration
+
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                                          :: pft               !! PFT number (-)
+    REAL(r_std), DIMENSION(:,:)                             :: biomass_temp      !! Biomass of an individual tree within a circ 
+                                                                                 !! class @tex $(m^{2} ind^{-1})$ @endtex 
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(ncirc)                           :: wood_to_dia       !! Diameter of an individual tree within a circ
+                                                                                 !! class (m)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                          :: l                 !! Index
+    REAL(r_std)                                             :: woodmass_ind      !! Woodmass of an individual tree
+                                                                                 !! @tex $(gC ind^{-1})$ @endtex
+
+!_ ================================================================================================================================
+ 
+ !! 1. Calculate basal area from woodmass
+
+    IF ( is_tree(pft) ) THEN
+       
+       DO l = 1,ncirc
+         
+          ! Woodmass of an individual tree
+          woodmass_ind = biomass_temp(l,isapabove) + biomass_temp(l,iheartabove)
+
+          ! Basal area of that individual (m2 ind-1)  
+          wood_to_dia(l) = (4/pi*woodmass_ind/(tree_ff(pft)*pipe_density(pft)*pipe_tune2(pft))) ** &
+                  (1./(2+pipe_tune3(pft)))
+                 
+       ENDDO
+
+    ELSE
+
+       WRITE(numout,*) 'pft ',pft
+       CALL ipslerr (3,'wood_to_dia', &
+            'wood_to_dia is not defined for this PFT.', &
+            'See the output file for more details.','')
+
+    ENDIF
+
+ END FUNCTION wood_to_dia
+
+
+!! ================================================================================================================================
+!! FUNCTION     : wood_to_dia_eff
+!!
+!>\BRIEF        Calculate effective diameter from woody biomass making use of allometric relationships
+!!
+!! DESCRIPTION : Calculate the effective diameter of an individual tree from the woody biomass of that tree making 
+!! use of allometric relationships. Effective diameter accounts for both above and belowground biomass. 
+!! (i) woodmass_ind = tree_ff * pipe_density * height * pi/4*dia**2
+!! (ii) height = pipe_tune2 * dia * pipe_tune3 
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : diameter (m)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION wood_to_dia_eff(biomass_temp, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                                          :: pft               !! PFT number (-)
+    REAL(r_std), DIMENSION(:,:)                             :: biomass_temp      !! Biomass of an individual tree within a circ 
+                                                                                 !! class @tex $(m^{2} ind^{-1})$ @endtex 
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(ncirc)                           :: wood_to_dia_eff   !! Diameter of an individual tree within a circ
+                                                                                 !! class (m)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                          :: l                 !! Index
+    REAL(r_std)                                             :: woodmass_ind      !! Woodmass of an individual tree
+                                                                                 !! @tex $(gC ind^{-1})$ @endtex
+
+!_ ================================================================================================================================
+ 
+ !! 1. Calculate basal area from woodmass
+
+    IF ( is_tree(pft) ) THEN
+       
+       DO l = 1,ncirc
+         
+          ! Woodmass of an individual tree
+          woodmass_ind = biomass_temp(l,isapabove) + biomass_temp(l,isapbelow) + &
+             biomass_temp(l,iheartabove) + biomass_temp(l,iheartbelow)
+
+          ! Basal area of that individual (m2 ind-1)  
+          wood_to_dia_eff(l) = (4/pi*woodmass_ind / &
+               (tree_ff(pft)*pipe_density(pft)*pipe_tune2(pft))) ** &
+               (1./(2+pipe_tune3(pft)))
+                 
+       ENDDO
+
+    ELSE
+
+       WRITE(numout,*) 'pft ',pft
+       CALL ipslerr (3,'wood_to_dia_eff', &
+            'wood_to_dia_eff is not defined for this PFT.', &
+            'See the output file for more details.','')
+
+    ENDIF
+
+ END FUNCTION wood_to_dia_eff
+
+
+!! ================================================================================================================================
+!! FUNCTION     : wood_to_circ
+!!
+!>\BRIEF        Calculate circumference from woody biomass making use of allometric relationships
+!!
+!! DESCRIPTION : All this does it computer the diameter using a different routine, and then
+!!               convert that into a circumference.  
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : circumference (m)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION wood_to_circ(biomass_temp, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                                          :: pft               !! PFT number (-)
+    REAL(r_std), DIMENSION(:,:)                             :: biomass_temp      !! Biomass of an individual tree within a circ 
+                                                                                 !! class @tex $(m^{2} ind^{-1})$ @endtex 
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(ncirc)                           :: wood_to_circ      !! Circumference of an individual tree within a circ
+                                                                                 !! class (m)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+!_ ================================================================================================================================
+ 
+    !! 1. Calculate diameter from woodmass
+
+    wood_to_circ(:)=val_exp
+
+    wood_to_circ(:)=wood_to_dia(biomass_temp(:,:),pft)
+
+    ! convert to a circumference (m)
+    wood_to_circ(:) =  wood_to_circ(:)*pi
+
+ END FUNCTION wood_to_circ
+
+
+   !! ================================================================================================================================
+!! FUNCTION     : wood_to_cv_eff
+!!
+!>\BRIEF        Calculate crown volume from woody biomass making use of allometric relationships
+!!
+!! DESCRIPTION : Calculate basal areadiameter of an individual tree from the woody biomass of that tree making 
+!! use of allometric relationships:
+!! (i) Basal area is written as a function of wood_mass: woodmass_ind = tree_ff*pipe_density*ba*height
+!! (ii) height = pipe_tune2 * sqrt( 4/pi*ba ) ** pipe_tune3
+!! (iii) cn = pipe_tune1 * sqrt( 4/pi*ba ) ** pipe_tune_exp_coeff  
+!! (iv) cv = 4.0 / 3.0 * pi * ( SQRT( cn/pi ) ) ** 3
+!! 
+!! NOTE: the difference between this and wood_to_cv is that this include aboveground and belowground
+!!       biomass in the calculation
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : diameter (m3 ind-1)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION wood_to_cv_eff(biomass_temp, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                                          :: pft               !! PFT number (-)
+    REAL(r_std), DIMENSION(:,:)                             :: biomass_temp      !! Biomass of an individual tree within a circ 
+                                                                                 !! class @tex $(m^{2} ind^{-1})$ @endtex 
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(ncirc)                           :: wood_to_cv_eff    !! Crown volume of an individual tree 
+                                                                                 !! @tex $(m^{2} ind{-1})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                          :: l                 !! Index
+    REAL(r_std)                                             :: woodmass_ind      !! Woodmass of an individual tree
+                                                                                 !! @tex $(gC ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                           :: dia               !! Diameter of an individual tree (m)
+
+!_ ================================================================================================================================
+ 
+ !! 1. Calculate crown volume from woodmass
+
+    IF ( is_tree(pft) ) THEN
+
+       ! Crown diameter of the individual tree (m2 ind-1)  
+       dia(:) = (4./pi*wood_to_cn_eff(biomass_temp(:,:),pft))**(1./2.)
+       wood_to_cv_eff(:) = pi/6.*dia(:)**3.  
+       ! WRITE(numout,*) 'wood_to_cv_eff, ', wood_to_cv_eff(:)
+
+    ELSE
+
+       WRITE(numout,*) 'pft ',pft
+       CALL ipslerr (3,'wood_to_cv_eff', &
+            'wood_to_cv_eff is not defined for this PFT.', &
+            'See the output file for more details.','')
+
+    ENDIF
+
+  END FUNCTION wood_to_cv_eff
+
+!! ================================================================================================================================
+!! FUNCTION     : wood_to_cn
+!!
+!>\BRIEF        Calculate crown area from woody biomass making use of allometric relationships
+!!
+!! DESCRIPTION : Calculate crown area of an individual tree from the woody biomass of that tree 
+!! making use of allometric relationship that relates crown area (cn) to diameter (dia) as 
+!! pipe_tune1*dia**pipe_tune_exp_coeff where the pipe_tune parameters are pft-specific. 
+!! (i) Basal area is written as a function of wood_mass: woodmass_ind = tree_ff*pipe_density*ba*height
+!! (ii) height = pipe_tune2*sqrt(4/pi*ba)**pipe_tune3
+!! (iii) cn = pipe_tune1*sqrt(4/pi*ba)**pipe_tune_exp_coeff   
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : crown area (m2 ind-1)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION wood_to_cn(biomass_temp, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                                          :: pft               !! PFT number (-)
+    REAL(r_std), DIMENSION(:,:)                             :: biomass_temp      !! biomass of an individual tree within a circ 
+                                                                                 !! class @tex $(m^{2} ind^{-1})$ @endtex 
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(ncirc)                           :: wood_to_cn        !! Crown area of an individual tree within a circ
+                                                                                 !! class @tex $(m^{2} ind-1)$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                          :: l                 !! Index
+    REAL(r_std)                                             :: woodmass_ind      !! Woodmass of an individual tree
+                                                                                 !! @tex $(gC ind{-1})$ @endtex
+
+!_ ================================================================================================================================
+ 
+ !! 1. Calculate crown area from woodmass
+
+    IF ( is_tree(pft) ) THEN
+       
+       DO l = 1,ncirc
+         
+          ! Woodmass of an individual tree
+          woodmass_ind = biomass_temp(l,isapabove) + biomass_temp(l,iheartabove)
+ 
+          ! Crown area of that individual
+          ! cn = pipe_tune1*sqrt(4/pi*ba)**pipe_tune_exp_coeff 
+          wood_to_cn(l) = pipe_tune1(pft) * SQRT( 4/pi*(pi/4*(woodmass_ind/&
+               (tree_ff(pft)*pipe_density(pft)*pipe_tune2(pft)))**&
+               (2./pipe_tune3(pft)))**(pipe_tune3(pft)/&
+               (pipe_tune3(pft)+2)) ) ** pipe_tune_exp_coeff(pft)
+                
+       ENDDO
+
+    ELSE
+
+       WRITE(numout,*) 'ERROR: wood_to_cn, pft ',pft
+       CALL ipslerr (3,'ERROR: wood_to_cn', &
+            'wood_to_cn is not defined for this PFT.', &
+            'See the output file for more details.','')
+
+    ENDIF
+
+ END FUNCTION wood_to_cn
+
+!! ================================================================================================================================
+!! FUNCTION     : wood_to_cn_eff
+!!
+!>\BRIEF        Calculate crown area from woody biomass making use of allometric relationships
+!!
+!! DESCRIPTION : Calculate crown area of an individual tree from the woody biomass of that tree 
+!! making use of allometric relationship that relates crown area (cn) to diameter (dia) as 
+!! pipe_tune1*dia**pipe_tune_exp_coeff where the pipe_tune parameters are pft-specific. 
+!! (i) Basal area is written as a function of wood_mass: woodmass_ind = tree_ff*pipe_density*ba*height
+!! (ii) height = pipe_tune2*sqrt(4/pi*ba)**pipe_tune3
+!! (iii) cn = pipe_tune1*sqrt(4/pi*ba)**pipe_tune_exp_coeff   
+!!
+!! NOTE: This is different from wood_to_cn because this uses both the aboveground and
+!!       belowground wood mass.
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : crown area (m2 ind-1)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION wood_to_cn_eff(biomass_temp, pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std)                                          :: pft               !! PFT number (-)
+    REAL(r_std), DIMENSION(:,:)                             :: biomass_temp      !! biomass of an individual tree within a circ 
+                                                                                 !! class @tex $(m^{2} ind^{-1})$ @endtex 
+
+    !! 0.2 Output variables
+                
+    REAL(r_std), DIMENSION(ncirc)                           :: wood_to_cn_eff    !! Crown area of an individual tree within a circ
+                                                                                 !! class @tex $(m^{2} ind-1)$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                          :: l                 !! Index
+    REAL(r_std)                                             :: woodmass_ind      !! Woodmass of an individual tree
+                                                                                 !! @tex $(gC ind{-1})$ @endtex
+
+!_ ================================================================================================================================
+ 
+ !! 1. Calculate crown area from woodmass
+
+    IF ( is_tree(pft) ) THEN
+       
+       DO l = 1,ncirc
+         
+          ! Woodmass of an individual tree
+          woodmass_ind = biomass_temp(l,isapabove) + biomass_temp(l,iheartabove) + &
+               biomass_temp(l,isapbelow) + biomass_temp(l,iheartbelow)
+ 
+          ! Crown area of that individual
+          ! cn = pipe_tune1*sqrt(4/pi*ba)**pipe_tune_exp_coeff 
+          wood_to_cn_eff(l) = pipe_tune1(pft) * SQRT( 4/pi*(pi/4*(woodmass_ind/&
+               (tree_ff(pft)*pipe_density(pft)*pipe_tune2(pft)))**(2./pipe_tune3(pft)))**&
+               (pipe_tune3(pft)&
+               /(pipe_tune3(pft)+2)) ) ** pipe_tune_exp_coeff(pft)
+                
+       ENDDO
+
+    ELSE
+
+       WRITE(numout,*) 'pft ',pft
+       CALL ipslerr (3,'wood_to_cn_eff', &
+            'wood_to_cn_eff is not defined for this PFT.', &
+            'See the output file for more details.','')
+
+    ENDIF
+
+  END FUNCTION wood_to_cn_eff
+
+
+!! ================================================================================================================================
+!! FUNCTION     : Nmax
+!!
+!>\BRIEF        This function determines the maximum number of trees per hectare for 
+!! a given quadratic mean diameter (Dg). It applies the self-thinning principle 
+!! of Reineke (1933), with Dg instead of mean diameter (Dhote 1999).
+!! Parameterization: Dhote (1999) for broad-leaved and Vacchiano (2008)
+!! for needle-leaved.
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : Nmax
+!!
+!! REFERENCE(S)   : See above, module description.
+!!
+!! FLOWCHART   : None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION Nmax(Dg,no_pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    REAL(r_std)      :: Dg              !! Quadratic mean diameter (cm)
+    INTEGER(i_std)   :: no_pft          !! Plant functional type (unitless) 
+
+    !! 0.2 Output variables
+
+    REAL(r_std)      :: Nmax            !! Maximum number of trees according to the self-thinning model in (trees ha-1)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+!_ ================================================================================================================================
+ !! 1. maximum number of trees per hectare for a given quadratic mean diameter
+
+    IF (is_tree(no_pft)) THEN
+
+       ! thinning curve of the MTC
+       Nmax = (Dg/alpha_self_thinning(no_pft))**(un/beta_self_thinning(no_pft))
+
+       ! Truncate the range to avoid huge numbers due the exponental model used to describe self-thinning
+       ! Don't set to ntreesmax else stomate_mark_kill will assume we are at self-thinning and
+       ! won't apply background mortality. 
+       ! Nmax = MIN( Nmax, ntreesmax(no_pft))
+       Nmax = MAX( Nmax, dens_target(no_pft) )
+
+    ELSE
+
+       WRITE(numout,*) 'Self thinning is not defined for PFT, ', no_pft
+       CALL ipslerr (3,'nmax', &
+            'Self thinning is not defined for this PFT.', &
+            'See the output file for more details.','')
+
+    ENDIF
+
+  END FUNCTION Nmax
+
+
+!! ================================================================================================================================
+!! FUNCTION     : Nmaxyield
+!!
+!>\BRIEF        This function determines the maximum number of trees per hectare for 
+!! a given quadratic mean diameter (Dg). It applies the 75 percentile  of the European 
+!! yield tables
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : Nmaxyield
+!!
+!! REFERENCE(S)   : See above, module description.
+!!
+!! FLOWCHART   : None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION Nmaxyield(Dg,no_pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    REAL(r_std)      :: Dg              !! Quadratic mean diameter (cm)
+    INTEGER(i_std)   :: no_pft          !! Plant functional type (unitless) 
+
+    !! 0.2 Output variables
+
+    REAL(r_std)      :: Nmaxyield       !! Maximum number of trees according to the self-thinning model
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+!_ ================================================================================================================================
+ !! 1. maximum number of trees per hectare for a given quadratic mean diameter
+
+    IF (is_tree(no_pft)) THEN
+
+       ! thinning curve of the MTC
+       Nmaxyield = (Dg/alpha_rdi_upper(no_pft))**(un/beta_rdi_upper(no_pft))
+
+       ! Truncate the range to avoid huge numbers due the exponental 
+       ! model used to describe self-thinning
+       Nmaxyield = MIN( Nmaxyield, nmaxtrees(no_pft) )
+       Nmaxyield = MAX( Nmaxyield, dens_target(no_pft) )
+
+    ELSE
+
+       WRITE(numout,*) 'Self thinning is not defined for PFT, ', no_pft
+       CALL ipslerr (3,'ERROR: Nmaxyield', &
+            'Self thinning is not defined for this PFT.', &
+            'See the output file for more details.','')
+
+    ENDIF
+
+  END FUNCTION Nmaxyield
+
+
+!! ================================================================================================================================
+!! FUNCTION     : Nminyield
+!!
+!>\BRIEF        This function determines the minimum number of trees per hectare for 
+!! a given quadratic mean diameter (Dg). It applies the 25 percentile of the European 
+!! yield tables
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : Nminyield
+!!
+!! REFERENCE(S)   : See above, module description.
+!!
+!! FLOWCHART   : None
+!! \n
+!_ ================================================================================================================================
+   
+  FUNCTION Nminyield(Dg,no_pft)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    REAL(r_std)      :: Dg              !! Quadratic mean diameter (cm)
+    INTEGER(i_std)   :: no_pft          !! Plant functional type (unitless) 
+
+    !! 0.2 Output variables
+
+    REAL(r_std)      :: Nminyield       !! Minimum number of trees according to the self-thinning model
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+!_ ================================================================================================================================
+ !! 1. minimum number of trees per hectare for a given quadratic mean diameter
+
+    IF (is_tree(no_pft)) THEN
+
+       ! thinning curve of the MTC
+       Nminyield = (Dg/alpha_rdi_lower(no_pft))**(un/beta_rdi_lower(no_pft))
+
+       ! Truncate the range to avoid huge numbers due the exponental 
+       ! model used to describe self-thinning
+       Nminyield = MIN( Nminyield, nmaxtrees(no_pft) )
+       Nminyield = MAX( Nminyield, dens_target(no_pft) )
+
+    ELSE
+
+       WRITE(numout,*) 'Self thinning is not defined for PFT, ', no_pft
+       CALL ipslerr (3,'ERROR: Nminyield', &
+            'Self thinning is not defined for this PFT.', &
+            'See the output file for more details.','')
+
+
+    ENDIF
+
+  END FUNCTION Nminyield
+
+
+!! ================================================================================================================================
+!! FUNCTION     : calculate_rdi
+!!
+!>\BRIEF        Calculate the relative density index of a stand
+!!
+!! DESCRIPTION   : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : calculate_rdi
+!!
+!! REFERENCE(S)   : Bellassen, V., Le Maire, G., Dhote, J.F., Viovy, N., Ciais, P., 2010. 
+!! Modeling forest management within a global vegetation model â Part 1: 
+!! model structure and general behaviour. Ecological Modelling 221, 2458â2474.
+!!
+!! FLOWCHART   : None
+!! \n
+!_ ================================================================================================================================
+  
+  FUNCTION calculate_rdi(diameters_temp,circ_class_n_temp,ivm)
+
+ !! 0. Variable and parameter declaration
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    REAL(r_std),DIMENSION(ncirc),INTENT(in)            :: circ_class_n_temp   !! The distribution of individuals
+                                                                              !! for a given grid square and PFT  
+    REAL(r_std),DIMENSION(ncirc),INTENT(in)            :: diameters_temp      !! The diameters of the trunks
+                                                                              !! for each circ class (m)
+    INTEGER(i_std),INTENT(IN)                          :: ivm                 !! The number of the PFT
+                                                                              !! (unitless)
+
+    !! 0.2 Output variables
+    REAL(r_std)                                        :: calculate_rdi       !! The RDI of the stand 
+                                                                              !! (unitless, always positive)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std)                                        :: Dg                  !! The quadratic mean diameter
+    REAL(r_std)                                        :: ind_loc
+    INTEGER(i_std)                                     :: icir                !! Indices
+
+!_ ================================================================================================================================
+
+ !! 1. Calculate the relative density index for a stand, based on
+ !!    the number of trees in each circumference class and the
+ !!    the diameter of a model tree in each class. 
+    ind_loc=SUM(circ_class_n_temp(:))
+
+    Dg=zero
+
+    DO icir=1,ncirc
+       Dg=Dg+circ_class_n_temp(icir)*m2_to_ha*(diameters_temp(icir)*m_to_cm)**2
+    ENDDO
+    Dg=SQRT(Dg/(ind_loc*m2_to_ha))
+   
+    calculate_rdi=(ind_loc*m2_to_ha)/Nmax(Dg,ivm)
+
+  END FUNCTION calculate_rdi
+
+
+!! ================================================================================================================================
+!! SUBROUTINE  : check_biomass_sync
+!!
+!>\BRIEF       
+!!
+!! DESCRIPTION : 
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE check_biomass_sync ( check_point, npts, biomass, &
+       circ_class_biomass, circ_class_n , ind)
+
+ !! 0. Variable and parameter description
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                                 :: npts                 !! Domain size (unitless)
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)              :: circ_class_biomass   !! Biomass of the componets of the model  
+                                                                                       !! tree within a circumference
+                                                                                       !! class @tex $(gC ind^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)                  :: circ_class_n         !! Number of individuals in each circ class
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)                :: biomass              !! Stand level biomass 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    CHARACTER(*),INTENT(in)                                    :: check_point          !! A flag to indicate at which
+                                                                                       !! point in the code we're doing
+                                                                                       !! this check
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                    :: ind                  !! Density of individuals 
+                                                                                       !! @tex $(m^{-2})$ @endtex 
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER                                                    :: iele,ipts,ivm,ipar,icir
+    REAL(r_std)                                                :: total_circ_class_biomass
+    REAL(r_std),DIMENSION(ncirc)                               :: tree_size
+    LOGICAL                                                    :: lnegative
+    LOGICAL                                                    :: lsync
+    LOGICAL                                                    :: lindividuals
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                 :: bm_sync              !! The difference betweeen the
+                                                                                       !! biomass in the circ_classes and
+                                                                                       !! the total biomass 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+!_ ================================================================================================================================
+
+    lsync=.TRUE.
+    lnegative=.FALSE.
+    lindividuals=.TRUE.
+
+    bm_sync(:,:,:)=zero
+
+    !+++NOTE+++
+    ! 5-10% is gained in speed by skipping this routine
+    !++++++++++
+
+    ! Check to see if the biomass is not equal to the total biomass
+    ! in circ_class_biomass anywhere.
+    DO ipts=1,npts
+
+       DO ivm=1,nvm
+
+          ! Only woody PFTs have circumference classes therefore
+          ! only woody PFTs need to be syncronized
+          IF(.NOT.hack_circ_class)THEN
+             IF(is_tree(ivm)) THEN
+                tree_size(:)=zero
+                DO icir=1,ncirc
+                   tree_size(icir) = &
+                        SUM(circ_class_biomass(ipts,ivm,icir,:,icarbon))
+                ENDDO
+                DO icir=2,ncirc
+                   IF(tree_size(icir) .LT. tree_size(icir-1)-min_stomate)THEN
+                      WRITE(numout,*) 'ERROR: stopping in sync'
+                      WRITE(numout,*) check_point
+                      WRITE(numout,*) 'ipts,ivm: ',ipts,ivm,icir,icir-1
+                      WRITE(numout,*) 'tree_size(icir), tree_size(icir-1), ',&
+                           tree_size(icir), tree_size(icir-1), tree_size(icir) - &
+                           tree_size(icir-1)  
+                      WRITE(numout,*) 'icir, tree_size: ',icir, tree_size(:)
+                      CALL ipslerr (3,'check_biomass_sync', &
+                           'The size of the trees in the circ class are ',&
+                           'not monotonically increasing!',&
+                           'Look in the output file for more details.')   
+                   ENDIF
+                ENDDO
+             ENDIF
+          ENDIF
+          
+          DO iele=1,nelements
+                
+             DO ipar=1,nparts
+                
+                total_circ_class_biomass=zero
+           
+                DO icir=1,ncirc
+                   
+                   total_circ_class_biomass=total_circ_class_biomass + &
+                        circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                        circ_class_n(ipts,ivm,icir)
+
+                   ! Check as well to see if our biomass is ever negative.
+                   ! It really should not be.
+                   IF(circ_class_biomass(ipts,ivm,icir,ipar,iele) .LT. &
+                        -min_stomate)THEN
+
+                      lnegative=.TRUE.
+                      WRITE(numout,*) '!***********************************'
+                      WRITE(numout,*) 'Error: Negative biomass component!'
+                      WRITE(numout,*) 'Check point: ',TRIM(check_point)
+                      WRITE(numout,*) 'circ_class_biomass(ipts,ivm,icir,ipar,iele) ',&
+                           circ_class_biomass(ipts,ivm,icir,ipar,iele)
+                      WRITE(numout,'(A,5I5)') 'ipts,ivm,icir,ipar,iele', &
+                           ipts,ivm,icir,ipar,iele
+                      WRITE(numout,*) '!***********************************'
+
+                   ENDIF
+                ENDDO
+
+                IF(ABS(biomass(ipts,ivm,ipar,iele) -  &
+                     total_circ_class_biomass) .GT. sync_threshold)THEN
+
+                   WRITE(numout,*) '!***********************************'
+                   WRITE(numout,*) 'Biomass and circ_class_biomass are not equal!'
+                   WRITE(numout,*) 'Check point: ',TRIM(check_point)
+                   WRITE(numout,100) 'biomass(ipts,ivm,ipar,iele) ',&
+                        biomass(ipts,ivm,ipar,iele)
+                   WRITE(numout,100) 'total_circ_class_biomass ',&
+                        total_circ_class_biomass
+                   WRITE(numout,100) 'Difference: ',&
+                        ABS(biomass(ipts,ivm,ipar,iele) - total_circ_class_biomass)
+                   WRITE(numout,*) 'ipts,ivm,ipar,iele',ipts,ivm,ipar,iele
+                   WRITE(numout,*) '!***********************************'
+100                FORMAT(A,E20.10)
+                   lsync=.FALSE.
+
+                ENDIF
+
+             ENDDO
+
+             ! we are not going to save the biomass for every component 
+             ! right now, just the total
+             bm_sync(ipts,ivm,iele)=zero
+
+             DO ipar=1,nparts
+                   
+                DO icir=1,ncirc
+
+                   bm_sync(ipts,ivm,iele)=bm_sync(ipts,ivm,iele) + &
+                        circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                        circ_class_n(ipts,ivm,icir)
+
+                ENDDO ! ncirc
+
+             ENDDO ! nparts
+
+             bm_sync(ipts,ivm,iele)=ABS(bm_sync(ipts,ivm,iele)-&
+                  SUM(biomass(ipts,ivm,:,iele)))
+
+          ENDDO ! nelements
+
+          IF(ABS(ind(ipts,ivm) - SUM(circ_class_n(ipts,ivm,:))) &
+               .GT. min_stomate)THEN
+             
+             WRITE(numout,*) '!***********************************'
+             WRITE(numout,*) 'ind and circ_class_n are not equal!'
+             WRITE(numout,*) 'Check point: ',TRIM(check_point)
+             WRITE(numout,100) 'ind(ipts,ivm) ',&
+                  ind(ipts,ivm)
+             WRITE(numout,100) 'circ_class_n ',&
+                  SUM(circ_class_n(ipts,ivm,:))
+             WRITE(numout,100) 'Difference: ',&
+                  ABS(ind(ipts,ivm) - SUM(circ_class_n(ipts,ivm,:)))
+             WRITE(numout,*) 'ipts,ivm',ipts,ivm
+             WRITE(numout,*) '!***********************************'
+             lindividuals = .FALSE.
+
+          ENDIF
+
+       ENDDO ! loop over PFTs
+
+    ENDDO ! loop over points
+ 
+    IF(.NOT. lsync) THEN
+       WRITE(numout,*) 'ERROR: stopping in sync #2'
+       WRITE(numout,*) 'Stopping'
+       CALL ipslerr (3,'check_biomass_sync', &
+            'circ_class_biomass*circ_class_n is not equal to the total biomass',&
+            'Look in the output file for more details.',&
+            '')
+    ENDIF
+
+    If(lnegative) THEN
+       WRITE(numout,*) 'ERROR: negative biomass'
+       WRITE(numout,*) 'Stopping'
+       CALL ipslerr (3,'check_biomass_sync', &
+            'One of the biomass pools is negative!',&
+            'Look in the output file for more details.',&
+            '')
+    ENDIF
+
+    IF(.NOT. lindividuals) THEN
+       WRITE(numout,*) 'ERROR: number of individuals started to diverge'
+       WRITE(numout,*) 'Stopping'
+       CALL ipslerr (3,'check_biomass_sync', &
+            'ind and circ_class_n are not similar',&
+            'Look in the output file for more details.',&
+            '')
+    ENDIF
+    
+
+  END SUBROUTINE check_biomass_sync
+
+!! ================================================================================================================================
+!! SUBROUTINE  : check_surface_area
+!!
+!>\BRIEF       
+!!
+!! DESCRIPTION : 
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE check_surface_area(check_point, npts, veget_max_begin, &
+       veget_max, test_type)
+
+  !! 0. Variable and parameter description
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                        :: npts                 !! Domain size (unitless)
+    CHARACTER(*),INTENT(in)                           :: check_point          !! A flag to indicate at which
+                                                                              !! point in the code we're doing
+                                                                              !! this check
+    CHARACTER(*), INTENT(in)                          :: test_type            !! Which test do we want to run on veget_max
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: veget_max            !! "maximal" coverage fraction of a PFT 
+                                                                              !! (LAI -> infinity) on ground. May sum to
+                                                                              !! less than unity if the pixel has
+                                                                              !! nobio area. (unitless; 0-1)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: veget_max_begin     !! temporary storage of veget_max to check area conservation
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                    :: iele, ipts, ivm      !! Indices
+    INTEGER(i_std)                                    :: ipar, icir           !! Indices
+    INTEGER(i_std)                                    :: ivma,iagec,ipft     !! Counter
+    REAL(r_std)                                       :: temp_begin, temp_end !! temporary variables to accumulate veget_max of
+                                                                              !! different age classes of the same species  
+
+!_ ================================================================================================================================
+
+    SELECT CASE (test_type)
+       
+    CASE ('pft')
+       
+       ! In all subroutines where veget_max should be preserved at the
+       ! PFT level, the most strict test can be performed
+       DO ipts=1,npts
+
+          DO ivm = 1,nvm
+
+             IF (veget_max_begin(ipts,ivm) - veget_max(ipts,ivm) .GT. &
+                  min_stomate ) THEN
+                WRITE(numout,*) 'Surface area is not preserved in ', &
+                     TRIM(check_point)
+                WRITE(numout,*) 'Area has changed for PFT, ',ipts, ivm
+                WRITE(numout,*) 'Change from, ',veget_max_begin(ipts,ivm), &
+                     ' to ', veget_max(ipts,ivm)
+                IF(err_act.GT.1) CALL ipslerr (plev, TRIM(check_point), &
+                        'Surface area not preserved','','')
+             ENDIF
+             
+          ENDDO !nvm
+
+          ! One message per pixel
+!!$          IF (err_act.GT.1) WRITE(numout,*) 'Surface area preserved in ',  &
+!!$               TRIM(check_point), ipts
+             
+       ENDDO ! npts
+
+    CASE ('ageclass')
+
+       ! In subroutines where veget_max can move from one pft to 
+       ! another within the same species. This is the test to use
+       DO ipts=1,npts
+          
+          DO ivma=1,nvmap
+
+             ! get pft number
+             ivm=start_index(ivma)
+
+             ! If we only have a single age class for this
+             ! PFT, we can simplify the test
+             IF(nagec_pft(ivma) .EQ. 1) THEN
+
+                IF (veget_max_begin(ipts,ivm) - veget_max(ipts,ivm) .GT. &
+                     min_stomate ) THEN
+                   WRITE(numout,*) 'Surface area is not preserved in ', &
+                        TRIM(check_point)
+                   WRITE(numout,*) 'Area has changed for PFT, ',ipts, ivm
+                   WRITE(numout,*) 'Change from, ',veget_max_begin(ipts,ivm), &
+                        ' to ', veget_max(ipts,ivm)
+                   IF(err_act.GT.1) CALL ipslerr (plev, TRIM(check_point), &
+                        'Surface area not preserved','','')
+                ENDIF
+
+             ELSE ! more than 1 age class
+
+                temp_begin = 0
+                temp_end = 0
+                DO iagec = nagec_pft(ivma),1,-1
+                   
+                   ! Accumulate veget_max for all pfts/age classes
+                   ! that belong to the same species
+                   ipft = ivm+iagec-1
+                   temp_begin = temp_begin + veget_max_begin(ipts,ipft)
+                   temp_end = temp_end + veget_max(ipts,ipft)
+
+                ENDDO
+                
+                IF (temp_begin - temp_end .GT. min_stomate ) THEN
+                   WRITE(numout,*) 'Surface area is not preserved in ', &
+                        TRIM(check_point)
+                   WRITE(numout,*) 'Area has changed for PFT, ',ipts, ivm
+                   WRITE(numout,*) 'Change from, ',veget_max_begin(ipts,ivm), &
+                        ' to ', veget_max(ipts,ivm)
+                   IF(err_act.GT.1) CALL ipslerr (plev, TRIM(check_point), &
+                        'Surface area not preserved','','')
+                ENDIF
+
+             ENDIF ! number of age classes
+
+          ENDDO ! nvmap
+
+          ! One message per pixel
+          !IF (err_act.GT.1) WRITE(numout,*) 'Surface area preserved in ',  &
+          !     TRIM(check_point), ipts
+          
+       ENDDO ! ipts
+
+    CASE('pixel')
+
+       ! Use this test in subroutines where veget_max can be moved
+       ! between species. This is the least strict test and only 
+       ! test wheter the total veget_max was preserved.
+       DO ipts=1,npts
+             
+          IF (ABS(SUM(veget_max_begin(ipts,:)) - SUM(veget_max(ipts,:))) .GT. &
+               min_stomate ) THEN
+             WRITE(numout,*) 'Surface area is not preserved in ', &
+                  TRIM(check_point)
+             WRITE(numout,*) 'Area in pixel ', ipts,' has changed form, ', & 
+             SUM(veget_max_begin(ipts,:)), 'to,', SUM(veget_max(ipts,:))
+             IF(err_act.GT.1) CALL ipslerr (plev, TRIM(check_point), &
+                  'Surface area not preserved','','')
+          ENDIF
+          
+          ! One message per pixel
+          !IF (err_act.GT.1) WRITE(numout,*) 'Surface area preserved in ',  &
+          !     TRIM(check_point), ipts
+
+       ENDDO ! npts
+       
+    CASE DEFAULT
+
+        WRITE(numout,*) 'Error: an unknown type/resolution was requested'
+        WRITE(numout,*) ' for the surface area check. Check the cases'
+        WRITE(numout,*) ' defined in src_parameters/function_library or'
+        WRITE(numout,*) ' the spelling of the type in the CALL argument',&
+            test_type
+        CALL ipslerr (3,'surface_area_check in function_library',&
+             'unknown type', 'Check *_out_orchidee for more details','')        
+       
+    END SELECT
+
+  END SUBROUTINE check_surface_area
+
+!! ================================================================================================================================
+!! SUBROUTINE  : check_mass balance
+!!
+!>\BRIEF       
+!!
+!! DESCRIPTION : 
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE check_mass_balance(check_point, closure_intern, npts, pool_end, &
+            pool_start, veget_max, test_type)
+
+ !! 0. Variable and parameter description
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                        :: npts                 !! Domain size (unitless)
+    CHARACTER(*),INTENT(in)                           :: check_point          !! A flag to indicate at which
+                                                                              !! point in the code we're doing
+                                                                              !! this check
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)         :: closure_intern       !! Check closure of internal mass balance
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)         :: pool_start           !! Start and end pool of this routine 
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)         :: pool_end             !! Start and end pool of this routine 
+    CHARACTER(*), INTENT(in)                          :: test_type            !! Which test do we want to run on veget_max
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: veget_max            !! "maximal" coverage fraction of a PFT 
+                                                                              !! (LAI -> infinity) on ground. May sum to
+                                                                              !! less than unity if the pixel has
+                                                                              !! nobio area. (unitless; 0-1) 
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER                                           :: iele, ipts, ivm      !! Indices
+    INTEGER                                           :: ipar, icir, err      !! Indices
+    INTEGER(i_std)                                    :: ivma,iagec,ipft      !! Counter
+    REAL(r_std)                                       :: temp_begin, temp_end !! temporary variables to accumulate veget_max of
+
+    CHARACTER(LEN=10)                                 :: var_name             !! Name of element
+
+!_ ================================================================================================================================
+
+    SELECT CASE (test_type)
+       
+    CASE ('ipts')
+
+       ! Close the mass balance for one specific pixel and pft. 
+       ! This :test is used for subroutines that are called within 
+       ! a DO ipts = 1,npts and DO ivm = 1,nvm loop. The mass
+       ! balance is checked for a single pft at a single pixel. 
+
+       DO iele=1,nelements
+          
+          IF (iele.EQ.icarbon) var_name = 'carbon'
+          IF (iele.EQ.initrogen) var_name = 'nitrogen'
+          err = zero
+
+          ! Mass balance closure          
+          IF(ABS(closure_intern(1,1,iele)) .GT. min_stomate)THEN
+
+             ! Count the number of errors
+             err = err + 1
+
+             ! Give extra details of where the mass balance
+             ! problem occurs. Stop the model if the user
+             ! asked for it
+             IF(err_act.GT.1) THEN
+                WRITE(numout,*) 'Error: mass balance is not closed in ', &
+                     TRIM(check_point), ' for ', var_name
+                WRITE(numout,*) ' Difference is, ', &
+                     closure_intern(1,1,iele)
+                WRITE(numout,*) ' pool_end,pool_start: ', &
+                     pool_end(1,1,iele), &
+                     pool_start(1,1,iele)
+                CALL ipslerr (plev, TRIM(check_point), &
+                     'Mass balance error','','')
+             ENDIF
+
+          ENDIF
+
+          !+++CHECK+++
+          ! A lot of output - only write a message if their is a problem
+!!$          ! One message per pixel. The err condition is needed because under
+!!$          ! err_act = 2 the model will write an error to the out_orchidee file
+!!$          ! but will not be stopped. Therefore it should be checked whether we
+!!$          ! have an error or not
+!!$          IF (err_act.GT.1 .AND. err.EQ.0) THEN
+!!$             WRITE(numout,*) 'Mass balance closure in ', &
+!!$                  TRIM(check_point), ' for ',var_name
+!!$          ENDIF
+          !++++++++++
+
+       ENDDO ! nelements
+
+    CASE ('pft')
+    
+       ! Close mass balance at the pixel and pft level.
+       DO iele=1,nelements
+
+          IF (iele.EQ.icarbon) var_name = 'carbon'
+          IF (iele.EQ.initrogen) var_name = 'nitrogen'
+
+          DO ipts=1,npts
+
+             err = zero
+
+             DO ivm=1,nvm
+
+                !check for NaN
+                IF (isnan(pool_start(ipts,ivm,iele))) THEN
+                    WRITE(numout,*)'At the pixel',ipts,' for element',iele,&
+                        ' and for PFT',ivm,' pool_start is NaN'
+                    WRITE(numout,*) ' pool_start: ', pool_start(ipts,:,iele)
+                    CALL ipslerr(plev,TRIM(check_point),'NaN problem','','')
+                ENDIF
+                IF (isnan(pool_end(ipts,ivm,iele))) THEN
+                    WRITE(numout,*) 'At the pixel',ipts,' for element',iele,&
+                    ' and for PFT',ivm,' pool_end is NaN'
+                    WRITE(numout,*) ' pool_end: ', pool_end(ipts,:,iele)
+                    CALL ipslerr(plev,TRIM(check_point),'NaN problem','','')
+                ENDIF
+                IF (isnan(closure_intern(ipts,ivm,iele))) THEN
+                   WRITE(numout,*) 'At the pixel',ipts,' for element',iele,&
+                    ' and for PFT',ivm,' closure_intern is NaN'
+                   WRITE(numout,*) ' closure_intern: ', closure_intern(ipts,:,iele)
+                    CALL ipslerr(plev,TRIM(check_point), 'NaN problem','','')
+                ENDIF
+
+
+                ! Mass balance closure          
+                IF(ABS(closure_intern(ipts,ivm,iele)) .GT. min_stomate)THEN
+              
+                   err = err+1
+      
+                   ! If the model is under development or being tested we will
+                   ! output extra information to facilitate debugging.
+                   IF(err_act.GT.1)THEN
+                      WRITE(numout,*) 'Error: mass balance is not closed in ', &
+                           TRIM(check_point), ' for ', var_name
+                      WRITE(numout,*) ' ipts, ivm; ', ipts,ivm
+                      WRITE(numout,*) ' Difference is, ', &
+                           closure_intern(ipts,ivm,iele)
+                      WRITE(numout,*) ' pool_end,pool_start: ', &
+                           pool_end(ipts,ivm,iele), &
+                           pool_start(ipts,ivm,iele)
+                      IF (err_act.GT.1) CALL ipslerr (plev, TRIM(check_point), &
+                           'Mass balance error','','')
+                   ENDIF
+                ENDIF
+             ENDDO ! nvm
+
+             !+++CHECK+++
+             ! A lot of output - only write a message if their is a problem
+!!$             ! One message per pixel
+!!$             IF (err_act.GT.1 .AND. err.EQ.zero) THEN
+!!$                WRITE(numout,*) 'Mass balance closure in ', &
+!!$                     TRIM(check_point), ' for ',var_name
+!!$             ENDIF
+             !++++++++++
+
+          ENDDO ! npts
+
+
+       ENDDO ! nelements
+
+    CASE ('ageclass')
+       
+       ! This option is only used when err_act.GE.2
+
+       ! In the subroutine under test, biomass can move
+       ! from one age class to another age class in the
+       ! same species. Test across all age classes for
+       ! the same species.
+       DO iele=1,nelements
+
+          IF (iele.EQ.icarbon) var_name = 'carbon'
+          IF (iele.EQ.initrogen) var_name = 'nitrogen'
+        
+          DO ipts=1,npts
+
+             err = zero
+
+             DO ivma=1,nvmap
+
+                ! get pft number
+                ivm=start_index(ivma)
+
+                !check for NaN
+                IF (isnan(pool_start(ipts,ivm,iele))) THEN
+                    WRITE(numout,*)'At the pixel',ipts,' for element',iele,&
+                        ' and for PFT',ivm,' pool_start is NaN'
+                    WRITE(numout,*) ' pool_start: ', pool_start(ipts,:,iele)
+                    CALL ipslerr(plev,TRIM(check_point),'NaN problem','','')
+                ENDIF
+                IF (isnan(pool_end(ipts,ivm,iele))) THEN
+                    WRITE(numout,*) 'At the pixel',ipts,' for element',iele,&
+                    ' and for PFT',ivm,' pool_end is NaN'
+                    WRITE(numout,*) ' pool_end: ', pool_end(ipts,:,iele)
+                    CALL ipslerr(plev,TRIM(check_point),'NaN problem','','')
+                ENDIF
+                IF (isnan(closure_intern(ipts,ivm,iele))) THEN
+                   WRITE(numout,*) 'At the pixel',ipts,' for element',iele,&
+                    ' and for PFT',ivm,' closure_intern is NaN'
+                   WRITE(numout,*) ' closure_intern: ', closure_intern(ipts,:,iele)
+                    CALL ipslerr(plev,TRIM(check_point), 'NaN problem','','')
+                ENDIF
+
+                ! If we only have a single age class for this
+                ! PFT, we can simplify the test
+                IF(nagec_pft(ivma) .EQ. 1) THEN
+
+                   ! Mass balance closure          
+                   IF(ABS(closure_intern(ipts,ivm,iele)) .GT. min_stomate)THEN
+                      err=err+1
+                      WRITE(numout,*) 'Error: mass balance is not closed in ', &
+                           TRIM(check_point), ' for ', var_name
+                      WRITE(numout,*) ' ipts, ivm; ', ipts,ivm
+                      WRITE(numout,*) ' Difference is, ', &
+                           closure_intern(ipts,ivm,iele)
+                      WRITE(numout,*) ' pool_end,pool_start: ', &
+                           pool_end(ipts,ivm,iele), &
+                           pool_start(ipts,ivm,iele)
+                      IF (err_act.GT.1) CALL ipslerr (plev, TRIM(check_point), &
+                           'Mass balance error','','')
+
+                   ENDIF ! test for closure
+
+                ELSE ! more than 1 age class
+
+                   temp_begin = 0
+                   DO iagec = nagec_pft(ivma),1,-1
+                      
+                      ! Accumulate check_intern for all pfts/age classes
+                      ! that belong to the same species
+                      ipft = ivm+iagec-1
+                      temp_begin = temp_begin + closure_intern(ipts,ipft,iele)
+                      
+                   ENDDO ! nagec_pft
+                   
+                   IF (temp_begin .GT. min_stomate) THEN
+
+                      ! mass balance
+                      err=err+1
+                      WRITE(numout,*) 'Error: mass balance is not closed in ', &
+                           TRIM(check_point), ' for ', var_name
+                      WRITE(numout,*) ' ipts, ivma; ', ipts,ivma
+                      WRITE(numout,*) ' first and last pft, ', &
+                           start_index(ivma), ipft
+                      WRITE(numout,*) ' Difference is, ', &
+                           temp_begin
+                      IF (err_act.GT.1) CALL ipslerr (plev, TRIM(check_point), &
+                           'Mass balance error','','')
+
+                   ENDIF ! test for closure
+
+                ENDIF ! number of age classes
+
+             ENDDO ! ivmap
+
+             
+             !+++CHECK+++
+             ! A lot of output - only write a message if their is a problem
+!!$             ! One message per pixel
+!!$             IF (err_act.GT.1 .AND. err.EQ.zero) THEN
+!!$                WRITE(numout,*) 'Mass balance closure in ', &
+!!$                     TRIM(check_point), ' for ',var_name
+!!$             ENDIF
+             !++++++++++
+
+          ENDDO ! npts
+
+       ENDDO ! iele
+
+    CASE ('pixel')
+
+       ! For testing subroutines where biomass can also move
+       ! from one species to another.
+       DO iele = 1, nelements
+
+          IF (iele.EQ.icarbon) var_name = 'carbon'
+          IF (iele.EQ.initrogen) var_name = 'nitrogen'
+        
+          DO ipts=1,npts
+
+             err = zero
+         
+                !check for NaN
+                IF (isnan(SUM(pool_start(ipts,:,iele)))) THEN
+                    WRITE(numout,*)'At the pixel',ipts,' for element',iele,&
+                    ' pool_start is NaN'
+                    WRITE(numout,*) ' pool_start: ', pool_start(ipts,:,iele)
+                    CALL ipslerr(plev,TRIM(check_point),'NaN problem','','')
+                ENDIF
+                IF (isnan(SUM(pool_end(ipts,:,iele)))) THEN
+                    WRITE(numout,*) 'At the pixel',ipts,' for element',iele,&
+                    ' pool_end is NaN'
+                    WRITE(numout,*) ' pool_end: ', pool_end(ipts,:,iele)
+                    CALL ipslerr(plev,TRIM(check_point),'NaN problem','','')
+                ENDIF
+                IF (isnan(SUM(closure_intern(ipts,:,iele)))) THEN
+                   WRITE(numout,*) 'At the pixel',ipts,' for element',iele,&
+                   ' closure_intern is NaN'
+                   WRITE(numout,*) ' closure_intern: ', closure_intern(ipts,:,iele)
+                    CALL ipslerr(plev,TRIM(check_point), 'NaN problem','','')
+                ENDIF
+ 
+             ! Mass balance closure          
+             IF(ABS(SUM(closure_intern(ipts,:,iele))) .GT. min_stomate)THEN
+
+                err = err+1
+
+                IF(err_act.GT.1)THEN
+                   WRITE(numout,*) 'Error: mass balance is not closed in ', &
+                        TRIM(check_point), ' for ', var_name
+                   WRITE(numout,*) ' ipts, ', ipts
+                   WRITE(numout,*) ' Difference is, ', &
+                        SUM(closure_intern(ipts,:,iele))
+                   WRITE(numout,*) ' pool_end,pool_start: ', &
+                        SUM(pool_end(ipts,:,iele)), &
+                        SUM(pool_start(ipts,:,iele))
+                   IF (err_act.GT.1) CALL ipslerr (plev, TRIM(check_point), &
+                        'Mass balance error','','')
+                ENDIF
+                
+             ENDIF
+
+             !+++CHECK+++
+             ! A lot of output - only write a message if their is a problem
+!!$             ! One message per pixel
+!!$             IF (err_act.GT.1 .AND. err.EQ.zero) THEN
+!!$                WRITE(numout,*) 'Mass balance closure in ', &
+!!$                     TRIM(check_point), ' for ',var_name
+!!$             ENDIF
+             !++++++++++
+             
+          ENDDO ! npts
+          
+       ENDDO ! iele
+
+    CASE ('products')
+
+       ! This option is only used when err_act.GE.2
+      
+       ! testing mass balance for the product pool. Veget_max is not used
+       ! ivm is not defined for closure_intern 
+       DO iele=1,nelements
+
+          IF (iele.EQ.icarbon) var_name = 'carbon'
+          IF (iele.EQ.initrogen) var_name = 'nitrogen'
+          
+          DO ipts=1,npts
+
+             err = zero
+
+             IF(ABS(closure_intern(ipts,1,iele)) .GT. min_stomate)THEN
+
+                err = err+1 
+                WRITE(numout,*) 'Error: mass balance is not closed'//&
+                     'in basic_product_use', var_name
+                WRITE(numout,*) 'ipts,ivm,iele ', ipts
+                WRITE(numout,*) 'Difference is, ', &
+                     closure_intern(ipts,1,iele)
+                WRITE(numout,*) 'pool_end, pool_start: ', &
+                        pool_end(ipts,1,iele), pool_start(ipts,1,iele)
+                IF(err_act.GT.1) CALL ipslerr (plev,'basic_product_use', &
+                     'Mass balance error.','','')
+             ENDIF
+             
+             !+++CHECK+++
+             ! A lot of output - only write a message if their is a problem
+!!$             ! One message per pixel
+!!$             IF (err_act.GT.1 .AND. err.EQ.zero) THEN
+!!$                WRITE(numout,*) 'Mass balance closure in ', &
+!!$                     TRIM(check_point), ' for ',var_name
+!!$             ENDIF
+             !++++++++++  
+
+          ENDDO
+       ENDDO
+    
+    CASE DEFAULT
+
+        WRITE(numout,*) 'Error: an unknown type/resolution was requested'
+        WRITE(numout,*) ' for the mass balance check. Check the cases'
+        WRITE(numout,*) ' defined in src_parameters/function_library or'
+        WRITE(numout,*) ' the spelling of the type in the CALL argument',&
+            test_type
+        CALL ipslerr (3,'mass_balance_check in function_library',&
+        'unknown type', 'Check *_out_orchidee for more details','')        
+       
+    END SELECT
+
+ END SUBROUTINE check_mass_balance
+
+!! ================================================================================================================================
+!! FUNCTION     : sort_circ_class_biomass
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION : sort the diameters in circ_class_biomass from low to high and
+!!               change the order in circ_class_n accordingly
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : ::circ_class_biomass (gC tree-1),circ_class_n (tree m-2)
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+   
+  SUBROUTINE sort_circ_class_biomass(circ_class_biomass_new,circ_class_n_new)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(:), INTENT(inout)           :: circ_class_n_new
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: circ_class_biomass_new
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                     :: inc,icir,jcir        !! Indices
+    REAL(r_std), DIMENSION(nparts,nelements)           :: v1                   !! temporay variable for sorting circ_class_biomass
+    REAL(r_std)                                        :: v2                   !! temporay variables for sorting circ_class_n
+    REAL(r_std)                                        :: sort                 !! flag triggering sorting routine (0 or 1)
+    REAL(r_std), DIMENSION(ncirc)                      :: tree_size            !! temporay variables for checking the biomass
+                                                                               !! for each circ class @tex ($gC tree^{-1}$) @endtex
+    
+!_ ================================================================================================================================
+
+    ! Calculate the total biomass in each circumference class
+    tree_size(:)=zero
+    DO icir=1,ncirc
+
+       ! Only check the order of the carbon pools
+       tree_size(icir)=SUM(circ_class_biomass_new(icir,:,icarbon))
+
+    ENDDO
+
+    ! Check whether the order was preserved 
+    sort = zero
+    DO icir=2,ncirc
+
+       IF(tree_size(icir) .LT. tree_size(icir-1))THEN
+
+          ! The order is not preserved
+          sort = un
+          EXIT
+
+       ENDIF
+
+    ENDDO
+
+    ! Sort the biomasses. Note that at the same time we also 
+    ! have to sort circ_class_n. We made use of the Shell sort
+    ! method
+    IF (sort==1) THEN
+
+       ! Based on nummerical recipies in Fortran
+       inc = 1
+
+       DO
+          inc=3*inc+1
+          IF (inc .GT. ncirc) EXIT
+
+       ENDDO
+
+       DO
+          inc = inc/3
+
+          DO icir=inc+1,ncirc
+
+             v1(:,:) = circ_class_biomass_new(icir,:,:)
+             v2 = circ_class_n_new(icir)
+             jcir=icir
+
+             DO
+
+                ! Use the carbon pool to sort the circumference classes
+                ! but when moving circ classes around, also move the
+                ! other elements, i.e. nitrogen.
+                IF (SUM(circ_class_biomass_new(jcir-inc,:,icarbon)) .LE. &
+                     SUM(v1(:,icarbon))) EXIT
+                circ_class_biomass_new(jcir,:,:) = &
+                     circ_class_biomass_new(jcir-inc,:,:)
+                circ_class_n_new(jcir) = circ_class_n_new(jcir-inc) 
+                jcir = jcir-inc
+                IF (jcir .LE. inc) EXIT
+
+             ENDDO
+
+             circ_class_biomass_new(jcir,:,:)=v1(:,:)
+             circ_class_n_new(jcir)=v2
+
+          ENDDO
+
+          IF (inc .LE. 1) EXIT
+
+       ENDDO
+
+       ! Debug
+       WRITE(numout,*) 'sort end - carbon', &
+            SUM(circ_class_biomass_new(:,:,icarbon),2),&
+            circ_class_n_new(:)
+       WRITE(numout,*) 'sort end - nitrogen', &
+            SUM(circ_class_biomass_new(:,:,initrogen),2)
+       !-
+
+    ENDIF
+
+  END SUBROUTINE sort_circ_class_biomass
+
+END MODULE function_library
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/pft_parameters.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/pft_parameters.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/pft_parameters.f90	(revision 6412)
@@ -0,0 +1,6056 @@
+! =================================================================================================================================
+! MODULE       : pft_parameters
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module initializes all the pft parameters in function of the
+!!              number of vegetation types and of the values chosen by the user.
+!!
+!!\n DESCRIPTION:  This module allocates and initializes the pft parameters in function of the number of pfts
+!!                 and the values of the parameters. \n
+!!                 The number of PFTs is read in control.f90 (subroutine control_initialize). \n
+!!                 Then we can initialize the parameters. \n
+!!                 This module is the result of the merge of constantes_co2, constantes_veg, stomate_constants.\n
+!!
+!! RECENT CHANGE(S): Josefine Ghattas 2013 : The declaration part has been extracted and moved to module pft_parameters_var
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE pft_parameters
+
+  USE pft_parameters_var
+  USE vertical_soil_var
+  USE constantes_mtc
+  USE constantes
+  USE ioipsl
+  USE ioipsl_para 
+  USE defprec
+  
+  IMPLICIT NONE
+
+CONTAINS
+ !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pft_parameters_main
+!!
+!>\BRIEF          This subroutine initializes all the pft parameters in function of the
+!! number of vegetation types chosen by the user.
+!!
+!! DESCRIPTION  : This subroutine is called after the reading of the number of PFTS and the options 
+!!                activated by the user in the configuration files. \n
+!!                The allocation is done just before reading the correspondence table  between PFTs and MTCs
+!!                defined by the user in the configuration file.\n
+!!                With the correspondence table, the subroutine can initialize the pft parameters in function
+!!                of the flags activated (ok_sechiba, ok_stomate, routing, new_hydrol...) in order to
+!!                optimize the memory allocation. \n
+!!                If the number of PFTs and pft_to_mtc are not found, the standard configuration will be used
+!!                (13 PFTs, PFT = MTC). \n 
+!!                Some restrictions : the pft 1 can only be the bare soil and it is unique. \n
+!!                Algorithm : Build new PFT from 13 generic-PFT or meta-classes.
+!!                1. Read the number of PFTs in "run.def". If nothing is found, it is assumed that the user intend to use 
+!!                   the standard of PFTs (13).
+!!                2. Read the index vector in "run.def". The index vector associates one PFT to one meta-classe (or generic PFT).
+!!                   When the association is done, the PFT defined by the user inherited the default values from the meta classe.
+!!                   If nothing is found, it is assumed to use the standard index vector (PFT = MTC).
+!!                3. Check consistency
+!!                4. Memory allocation and initialization.
+!!                5. The parameters are read in the configuration file in config_initialize (control module).
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE pft_parameters_main()
+
+   IMPLICIT NONE
+
+   !! 0. Variables and parameters declaration
+
+   !! 0.4 Local variables  
+
+   INTEGER(i_std) :: j                             !! Index (unitless)
+
+!_ ================================================================================================================================ 
+   
+   !
+   ! PFT global
+   !
+
+   IF(l_first_pft_parameters) THEN
+
+      !! 1. First time step
+      IF(printlev>=3) THEN
+         WRITE(numout,*) 'l_first_pft_parameters :we read the parameters from the def files'
+      ENDIF
+
+      !! 2. Memory allocation for the pfts-parameters
+      CALL pft_parameters_alloc()
+
+      !! 3. Correspondance table 
+      
+      !! 3.1 Initialisation of the correspondance table
+      !! Initialisation of the correspondance table
+      IF (nvm == nvmc) THEN
+         pft_to_mtc = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 /)
+      ELSE
+         pft_to_mtc(:) = undef_int
+      ENDIF !(nvm  == nvmc)
+      
+      !! 3.2 Reading of the conrrespondance table in the .def file
+      !
+      !Config Key   = PFT_TO_MTC
+      !Config Desc  = correspondance array linking a PFT to MTC
+      !Config if    = OK_SECHIBA or OK_STOMATE
+      !Config Def   = 0, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('PFT_TO_MTC',pft_to_mtc)
+      
+      !! 3.3 If the user want to use the standard configuration, he needn't to fill the correspondance array
+      !!     If the configuration is wrong, send a error message to the user.
+      IF(nvm /= nvmc ) THEN
+         !
+         IF(pft_to_mtc(1) == undef_int) THEN
+            STOP ' The array PFT_TO_MTC is empty : we stop'
+         ENDIF !(pft_to_mtc(1) == undef_int)
+         !
+      ENDIF !(nvm /= nvmc )
+
+      !! 3.4 Some error messages
+
+      !! 3.4.1 What happened if pft_to_mtc(j) > nvmc or pft_to_mtc(j) <=0 (if the mtc doesn't exist)?
+       DO j = 1, nvm ! Loop over # PFTs  
+          !
+          IF( (pft_to_mtc(j) > nvmc) .OR. (pft_to_mtc(j) <= 0) ) THEN
+             WRITE(numout,*) 'the metaclass chosen does not exist'
+             STOP 'we stop reading pft_to_mtc'
+          ENDIF !( (pft_to_mtc(j) > nvmc) .OR. (pft_to_mtc(j) <= 0) )
+          !
+       ENDDO  ! Loop over # PFTs  
+
+
+       !! 3.4.2 Check if pft_to_mtc(1) = 1 
+       IF(pft_to_mtc(1) /= 1) THEN
+          !
+          WRITE(numout,*) 'the first pft has to be the bare soil'
+          STOP 'we stop reading next values of pft_to_mtc'
+          !
+       ELSE
+          !
+          DO j = 2,nvm ! Loop over # PFTs different from bare soil
+             !
+             IF(pft_to_mtc(j) == 1) THEN
+                WRITE(numout,*) 'only pft_to_mtc(1) has to be the bare soil'
+                STOP 'we stop reading pft_to_mtc'
+             ENDIF ! (pft_to_mtc(j) == 1)
+             !
+          ENDDO ! Loop over # PFTs different from bare soil
+          !
+       ENDIF !(pft_to_mtc(1) /= 1)
+      
+
+      !! 4.Initialisation of the pfts-parameters
+      CALL pft_parameters_init()
+
+      !! 5. Useful data
+
+      !! 5.1 Read the name of the PFTs given by the user
+      !
+      !Config Key   = PFT_NAME
+      !Config Desc  = Name of a PFT
+      !Config if    = OK_SECHIBA or OK_STOMATE
+      !Config Def   = bare ground, tropical broad-leaved evergreen, tropical broad-leaved raingreen, 
+      !Config         temperate needleleaf evergreen, temperate broad-leaved evergreen temperate broad-leaved summergreen,
+      !Config         boreal needleleaf evergreen, boreal broad-leaved summergreen, boreal needleleaf summergreen,
+      !Config         C3 grass, C4 grass, C3 agriculture, C4 agriculture    
+      !Config Help  = the user can name the new PFTs he/she introducing for new species
+      !Config Units = [-]
+      CALL getin_p('PFT_NAME',pft_name)
+
+      !! 5.2 A useful message to the user: correspondance between the number of the pft
+      !! and the name of the associated mtc 
+      DO j = 1,nvm ! Loop over # PFTs
+         !
+         WRITE(numout,*) 'the PFT',j, 'called  ', PFT_name(j),'corresponds to the MTC : ',MTC_name(pft_to_mtc(j))
+         !
+      ENDDO ! Loop over # PFTs
+
+
+      !! 6. End message
+      IF(printlev>=3) THEN
+         WRITE(numout,*) 'pft_parameters_done'
+      ENDIF
+
+      !! 8. Reset flag
+      l_first_pft_parameters = .FALSE.
+
+   ELSE 
+
+      RETURN
+
+   ENDIF !(l_first_pft_parameters)
+
+ END SUBROUTINE pft_parameters_main
+ !
+ !=
+ !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pft_parameters_init 
+!!
+!>\BRIEF          This subroutine initializes all the pft parameters by the default values
+!! of the corresponding metaclasse. 
+!!
+!! DESCRIPTION  : This subroutine is called after the reading of the number of PFTS and the correspondence
+!!                table defined by the user in the configuration files. \n
+!!                With the correspondence table, the subroutine can search the default values for the parameter
+!!                even if the PFTs are classified in a random order (except bare soil). \n
+!!                With the correspondence table, the subroutine can initialize the pft parameters in function
+!!                of the flags activated (ok_sechiba, ok_stomate, routing, new_hydrol...).\n
+!!
+!! RECENT CHANGE(S): Didier Solyga : Simplified PFT loops : use vector notation. 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE pft_parameters_init()
+  
+   IMPLICIT NONE
+   
+   !! 0. Variables and parameters declaration
+
+   !! 0.1 Input variables
+   
+   !! 0.4 Local variables
+
+   INTEGER(i_std)                :: jv            !! Index (unitless) 
+!_ ================================================================================================================================ 
+
+   !
+   ! 1. Correspondance between the PFTs values and thes MTCs values 
+   !
+ 
+
+   ! 1.1 For parameters used anytime
+   
+   PFT_name(:) = MTC_name(pft_to_mtc(:))
+   !
+   ! Vegetation structure 
+   !
+   veget_ori_fixed_test_1(:) = veget_ori_fixed_mtc(pft_to_mtc(:))
+   llaimax(:) = llaimax_mtc(pft_to_mtc(:))
+   llaimin(:) = llaimin_mtc(pft_to_mtc(:))
+   height_presc(:) = height_presc_mtc(pft_to_mtc(:))
+   z0_over_height(:) = z0_over_height_mtc(pft_to_mtc(:))
+   ratio_z0m_z0h(:) = ratio_z0m_z0h_mtc(pft_to_mtc(:))
+   type_of_lai(:) = type_of_lai_mtc(pft_to_mtc(:))
+   natural(:) = natural_mtc(pft_to_mtc(:))
+   !
+   ! Water - sechiba
+   !
+   IF (zmaxh == 2.0) THEN
+      WRITE(numout,*)'Initialize humcst using reference values for 2m soil depth'
+      humcste(:) = humcste_ref2m(pft_to_mtc(:))  ! values for 2m soil depth
+   ELSE IF (zmaxh == 4.0) THEN
+      WRITE(numout,*)'Initialize humcst using reference values for 4m soil depth'
+      humcste(:) = humcste_ref4m(pft_to_mtc(:))  ! values for 4m soil depth 
+   ELSE
+      WRITE(numout,*)'Note that humcste is initialized with values for 2m soil depth bur zmaxh=', zmaxh
+      humcste(:) = humcste_ref2m(pft_to_mtc(:))  ! values for 2m soil depth
+   END IF
+   !
+   ! Soil - vegetation
+   !
+   pref_soil_veg(:) = pref_soil_veg_mtc(pft_to_mtc(:))
+   !
+   ! Vegetation - age classes
+   !
+   agec_group(:) = agec_group_mtc(pft_to_mtc(:))
+   !
+   ! Photosynthesis
+   !
+   is_c4(:)      = is_c4_mtc(pft_to_mtc(:))
+   vcmax_fix(:)  = vcmax_fix_mtc(pft_to_mtc(:))
+   downregulation_co2_coeff(:) = downregulation_co2_coeff_mtc(pft_to_mtc(:))
+   E_KmC(:)      = E_KmC_mtc(pft_to_mtc(:))
+   E_KmO(:)      = E_KmO_mtc(pft_to_mtc(:))
+   E_Sco(:)      = E_Sco_mtc(pft_to_mtc(:))
+   E_gamma_star(:) = E_gamma_star_mtc(pft_to_mtc(:))
+   E_Vcmax(:)    = E_Vcmax_mtc(pft_to_mtc(:))
+   E_Jmax(:)     = E_Jmax_mtc(pft_to_mtc(:))
+   aSV(:)        = aSV_mtc(pft_to_mtc(:))
+   bSV(:)        = bSV_mtc(pft_to_mtc(:))
+   tphoto_min(:) = tphoto_min_mtc(pft_to_mtc(:))
+   tphoto_max(:) = tphoto_max_mtc(pft_to_mtc(:))
+   aSJ(:)        = aSJ_mtc(pft_to_mtc(:))
+   bSJ(:)        = bSJ_mtc(pft_to_mtc(:))
+   D_Vcmax(:)    = D_Vcmax_mtc(pft_to_mtc(:))
+   D_Jmax(:)     = D_Jmax_mtc(pft_to_mtc(:))
+   E_gm(:)       = E_gm_mtc(pft_to_mtc(:))  
+   S_gm(:)       = S_gm_mtc(pft_to_mtc(:))  
+   D_gm(:)       = D_gm_mtc(pft_to_mtc(:))
+   E_Rd(:)       = E_Rd_mtc(pft_to_mtc(:))
+   Vcmax25(:)    = Vcmax25_mtc(pft_to_mtc(:))
+   arJV(:)       = arJV_mtc(pft_to_mtc(:))
+   brJV(:)       = brJV_mtc(pft_to_mtc(:))
+   KmC25(:)      = KmC25_mtc(pft_to_mtc(:))
+   KmO25(:)      = KmO25_mtc(pft_to_mtc(:))
+   Sco25(:)      = Sco25_mtc(pft_to_mtc(:)) 
+   gm25(:)       = gm25_mtc(pft_to_mtc(:))
+   gamma_star25(:)  = gamma_star25_mtc(pft_to_mtc(:))
+   a1(:)         = a1_mtc(pft_to_mtc(:))
+   b1(:)         = b1_mtc(pft_to_mtc(:))
+   g0(:)         = g0_mtc(pft_to_mtc(:))
+   h_protons(:)  = h_protons_mtc(pft_to_mtc(:))
+   fpsir(:)      = fpsir_mtc(pft_to_mtc(:))
+   fQ(:)         = fQ_mtc(pft_to_mtc(:))     
+   fpseudo(:)    = fpseudo_mtc(pft_to_mtc(:))    
+   kp(:)         = kp_mtc(pft_to_mtc(:))
+   alpha(:)      = alpha_mtc(pft_to_mtc(:))
+   gbs(:)        = gbs_mtc(pft_to_mtc(:))
+   theta(:)      = theta_mtc(pft_to_mtc(:))        
+   alpha_LL(:)   = alpha_LL_mtc(pft_to_mtc(:))
+   stress_vcmax(:) = stress_vcmax_mtc(pft_to_mtc(:)) 
+   stress_gs(:)  = stress_gs_mtc(pft_to_mtc(:)) 
+   stress_gm(:)  = stress_gm_mtc(pft_to_mtc(:))
+   ext_coeff(:)  = ext_coeff_mtc(pft_to_mtc(:))
+   ext_coeff_vegetfrac(:) = ext_coeff_vegetfrac_mtc(pft_to_mtc(:))
+   
+   ! Some classic stomate parameters are now also used 
+   ! in sechiba to calculate the canopy structure.
+   ! Vegetation structure - stomate & sechiba
+   sla(:) = sla_mtc(pft_to_mtc(:))
+   slainit(:) = slainit_mtc(pft_to_mtc(:))
+   pipe_density(:) = pipe_density_mtc(pft_to_mtc(:))
+   tree_ff(:) = tree_ff_mtc(pft_to_mtc(:))
+   pipe_tune1(:) = pipe_tune1_mtc(pft_to_mtc(:)) 
+   pipe_tune2(:) = pipe_tune2_mtc(pft_to_mtc(:))  
+   pipe_tune3(:) = pipe_tune3_mtc(pft_to_mtc(:))
+   pipe_tune_exp_coeff(:) = pipe_tune_exp_coeff_mtc(pft_to_mtc(:))
+   lai_to_height(:) = lai_to_height_mtc(pft_to_mtc(:))
+
+   ! Hydraulic architecture - sechiba
+   k_root(:) = k_root_mtc(pft_to_mtc(:))
+   k_sap(:) = k_sap_mtc(pft_to_mtc(:))
+   k_leaf(:) = k_leaf_mtc(pft_to_mtc(:))
+   psi_leaf(:) = psi_leaf_mtc(pft_to_mtc(:))
+   psi_50(:) = psi_50_mtc(pft_to_mtc(:))
+   c_cavitation(:) = c_cavitation_mtc(pft_to_mtc(:))
+   psi_soil_tune(:) = psi_soil_tune_mtc(pft_to_mtc(:))
+   srl(:) = srl_mtc(pft_to_mtc(:))
+   r_froot(:) = r_froot_mtc(pft_to_mtc(:))
+   psi_root(:) = psi_root_mtc(pft_to_mtc(:))
+
+   ! Photosynthesis - stomate & sechiba
+   ext_coeff_N(:) = ext_coeff_N_mtc(pft_to_mtc(:))
+   nue_opt(:) = nue_opt_mtc(pft_to_mtc(:))
+
+   ! Define labels from physiologic characteristics 
+   leaf_tab(:) = leaf_tab_mtc(pft_to_mtc(:)) 
+   pheno_model(:) = pheno_model_mtc(pft_to_mtc(:))   
+   !
+   is_tree(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( leaf_tab(jv) <= 2 ) is_tree(jv) = .TRUE.
+   END DO
+   !
+   is_deciduous(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( is_tree(jv) .AND. (pheno_model(jv) /= "none") ) is_deciduous(jv) = .TRUE.
+   END DO
+   !
+   is_evergreen(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( is_tree(jv) .AND. (pheno_model(jv) == "none") ) is_evergreen(jv) = .TRUE.
+   END DO
+   !
+   is_needleleaf(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( leaf_tab(jv) == 2 ) is_needleleaf(jv) = .TRUE.
+   END DO
+   !
+   is_tropical(:) = is_tropical_mtc(pft_to_mtc(:))
+   is_temperate(:) = is_temperate_mtc(pft_to_mtc(:))
+   is_boreal(:) = is_boreal_mtc(pft_to_mtc(:))
+
+   ! 1.2 For sechiba parameters
+
+   IF (ok_sechiba) THEN
+      !
+      ! Vegetation structure - sechiba
+      !
+      rveg_pft(:) = rveg_mtc(pft_to_mtc(:))
+      !
+      ! Evapotranspiration -  sechiba
+      !
+      rstruct_const(:) = rstruct_const_mtc(pft_to_mtc(:))
+      kzero(:) = kzero_mtc(pft_to_mtc(:))
+      !
+      ! Water - sechiba
+      !
+      wmax_veg(:) = wmax_veg_mtc(pft_to_mtc(:))
+      IF ( OFF_LINE_MODE ) THEN
+         throughfall_by_pft(:) = 0.
+      ELSE
+         throughfall_by_pft(:) = throughfall_by_mtc(pft_to_mtc(:))
+      ENDIF
+      !
+      ! Albedo - sechiba
+      !
+      snowa_aged(:) = snowa_aged_mtc(pft_to_mtc(:))
+      snowa_dec(:) = snowa_dec_mtc(pft_to_mtc(:))
+
+      leaf_ssa(:,ivis) = leaf_ssa_vis_mtc(pft_to_mtc(:))
+      leaf_ssa(:,inir) = leaf_ssa_nir_mtc(pft_to_mtc(:))
+      leaf_psd(:,ivis) = leaf_psd_vis_mtc(pft_to_mtc(:))
+      leaf_psd(:,inir) = leaf_psd_nir_mtc(pft_to_mtc(:))
+      bgd_reflectance(:,ivis) = bgd_reflectance_vis_mtc(pft_to_mtc(:))
+      bgd_reflectance(:,inir) = bgd_reflectance_nir_mtc(pft_to_mtc(:))
+      leaf_to_shoot_clumping(:) = leaf_to_shoot_clumping_mtc(pft_to_mtc(:))
+      lai_correction_factor(:) = lai_correction_factor_mtc(pft_to_mtc(:))
+      min_level_sep(:) = min_level_sep_mtc(pft_to_mtc(:))
+      !
+      ! Diffuco and hydrol_arch
+      !
+      lai_top(:) = lai_top_mtc(pft_to_mtc(:))
+      !
+
+   ENDIF !(ok_sechiba)
+
+   ! 1.3 For BVOC parameters
+   
+   IF (ok_bvoc) THEN
+      !
+      ! Biogenic Volatile Organic Compounds
+      !
+      em_factor_isoprene(:) = em_factor_isoprene_mtc(pft_to_mtc(:))
+      em_factor_monoterpene(:) = em_factor_monoterpene_mtc(pft_to_mtc(:))
+      LDF_mono = LDF_mono_mtc 
+      LDF_sesq = LDF_sesq_mtc 
+      LDF_meth = LDF_meth_mtc 
+      LDF_acet = LDF_acet_mtc 
+
+      em_factor_apinene(:) = em_factor_apinene_mtc(pft_to_mtc(:))
+      em_factor_bpinene(:) = em_factor_bpinene_mtc(pft_to_mtc(:))
+      em_factor_limonene(:) = em_factor_limonene_mtc(pft_to_mtc(:))
+      em_factor_myrcene(:) = em_factor_myrcene_mtc(pft_to_mtc(:))
+      em_factor_sabinene(:) = em_factor_sabinene_mtc(pft_to_mtc(:))
+      em_factor_camphene(:) = em_factor_camphene_mtc(pft_to_mtc(:))
+      em_factor_3carene(:) = em_factor_3carene_mtc(pft_to_mtc(:))
+      em_factor_tbocimene(:) = em_factor_tbocimene_mtc(pft_to_mtc(:))
+      em_factor_othermonot(:) = em_factor_othermonot_mtc(pft_to_mtc(:))
+      em_factor_sesquiterp(:) = em_factor_sesquiterp_mtc(pft_to_mtc(:))
+
+      beta_mono = beta_mono_mtc
+      beta_sesq = beta_sesq_mtc
+      beta_meth = beta_meth_mtc
+      beta_acet = beta_acet_mtc
+      beta_oxyVOC = beta_oxyVOC_mtc
+      
+      em_factor_ORVOC(:) = em_factor_ORVOC_mtc(pft_to_mtc(:)) 
+      em_factor_OVOC(:) = em_factor_OVOC_mtc(pft_to_mtc(:))
+      em_factor_MBO(:) = em_factor_MBO_mtc(pft_to_mtc(:))
+      em_factor_methanol(:) = em_factor_methanol_mtc(pft_to_mtc(:))
+      em_factor_acetone(:) = em_factor_acetone_mtc(pft_to_mtc(:)) 
+      em_factor_acetal(:) = em_factor_acetal_mtc(pft_to_mtc(:))
+      em_factor_formal(:) = em_factor_formal_mtc(pft_to_mtc(:))
+      em_factor_acetic(:) = em_factor_acetic_mtc(pft_to_mtc(:))
+      em_factor_formic(:) = em_factor_formic_mtc(pft_to_mtc(:))
+      em_factor_no_wet(:) = em_factor_no_wet_mtc(pft_to_mtc(:))
+      em_factor_no_dry(:) = em_factor_no_dry_mtc(pft_to_mtc(:))
+      Larch(:) = Larch_mtc(pft_to_mtc(:)) 
+      !-
+   ENDIF !(ok_bvoc)
+
+   ! 1.4 For stomate parameters
+ 
+   IF (ok_stomate) THEN
+
+      !
+      ! Vegetation structure - stomate
+      !
+      availability_fact(:) = availability_fact_mtc(pft_to_mtc(:))
+      !
+      ! Respiration - stomate
+      !
+      frac_growthresp(:) = frac_growthresp_mtc(pft_to_mtc(:))
+      maint_resp_slope_c(:) = maint_resp_slope_c_mtc(pft_to_mtc(:))
+      maint_resp_slope_b(:) = maint_resp_slope_b_mtc(pft_to_mtc(:))
+      maint_resp_slope_a(:) = maint_resp_slope_a_mtc(pft_to_mtc(:))  
+      coeff_maint_init(:) = coeff_maint_init_mtc(pft_to_mtc(:))
+      tref_maint_resp(:) = tref_maint_resp_mtc(pft_to_mtc(:))
+      tmin_maint_resp(:) = tmin_maint_resp_mtc(pft_to_mtc(:))
+      e0_maint_resp(:) = e0_maint_resp_mtc(pft_to_mtc(:))
+      !
+      ! Fire - stomate
+      !
+      flam(:) = flam_mtc(pft_to_mtc(:))
+      resist(:) = resist_mtc(pft_to_mtc(:))
+      !
+      ! Flux - LUC
+      !
+      coeff_lcchange_1(:) = coeff_lcchange_1_mtc(pft_to_mtc(:))
+      coeff_lcchange_10(:) = coeff_lcchange_10_mtc(pft_to_mtc(:))
+      coeff_lcchange_100(:) = coeff_lcchange_100_mtc(pft_to_mtc(:))
+      !
+      ! Flux - LUC
+      !
+      coeff_lcchange_s(:) = coeff_lcchange_s_mtc(pft_to_mtc(:))
+      coeff_lcchange_m(:) = coeff_lcchange_m_mtc(pft_to_mtc(:))
+      coeff_lcchange_l(:) = coeff_lcchange_l_mtc(pft_to_mtc(:))
+      !
+      ! Phenology
+      !
+      !
+      ! 1. Stomate
+      !
+      lai_max_to_happy(:) = lai_max_to_happy_mtc(pft_to_mtc(:))  
+      lai_max(:) = lai_max_mtc(pft_to_mtc(:))
+      pheno_type(:) = pheno_type_mtc(pft_to_mtc(:))
+      !
+      ! 2. Leaf Onset
+      !
+      pheno_gdd_crit_c(:) = pheno_gdd_crit_c_mtc(pft_to_mtc(:))
+      pheno_gdd_crit_b(:) = pheno_gdd_crit_b_mtc(pft_to_mtc(:))         
+      pheno_gdd_crit_a(:) = pheno_gdd_crit_a_mtc(pft_to_mtc(:))
+      pheno_moigdd_t_crit(:) = pheno_moigdd_t_crit_mtc(pft_to_mtc(:))
+      ngd_crit(:) =  ngd_crit_mtc(pft_to_mtc(:))
+      ncdgdd_temp(:) = ncdgdd_temp_mtc(pft_to_mtc(:)) 
+      hum_frac(:) = hum_frac_mtc(pft_to_mtc(:))
+      hum_min_time(:) = hum_min_time_mtc(pft_to_mtc(:))
+      tau_sap(:) = tau_sap_mtc(pft_to_mtc(:))
+      tau_leaf(:) = tau_leaf_mtc(pft_to_mtc(:))
+      tau_leafinit(:) = tau_leafinit_mtc(pft_to_mtc(:))  
+      tau_fruit(:) = tau_fruit_mtc(pft_to_mtc(:))
+      tau_root(:) = tau_root_mtc(pft_to_mtc(:))
+      ecureuil(:) = ecureuil_mtc(pft_to_mtc(:))
+      alloc_min(:) = alloc_min_mtc(pft_to_mtc(:))
+      alloc_max(:) = alloc_max_mtc(pft_to_mtc(:))
+      demi_alloc(:) = demi_alloc_mtc(pft_to_mtc(:))
+      leaflife_tab(:) = leaflife_mtc(pft_to_mtc(:))
+      !
+      ! 3. Senescence
+      !
+      leaffall(:) = leaffall_mtc(pft_to_mtc(:))
+      leafagecrit(:) = leafagecrit_mtc(pft_to_mtc(:))
+      senescence_type(:) = senescence_type_mtc(pft_to_mtc(:)) 
+      senescence_hum(:) = senescence_hum_mtc(pft_to_mtc(:)) 
+      nosenescence_hum(:) = nosenescence_hum_mtc(pft_to_mtc(:)) 
+      max_turnover_time(:) = max_turnover_time_mtc(pft_to_mtc(:))
+      min_turnover_time(:) = min_turnover_time_mtc(pft_to_mtc(:))
+      recycle_leaf(:) = recycle_leaf_mtc(pft_to_mtc(:))
+      recycle_root(:) = recycle_root_mtc(pft_to_mtc(:))
+      min_leaf_age_for_senescence(:) = min_leaf_age_for_senescence_mtc(pft_to_mtc(:))
+      senescence_temp_c(:) = senescence_temp_c_mtc(pft_to_mtc(:))
+      senescence_temp_b(:) = senescence_temp_b_mtc(pft_to_mtc(:))
+      senescence_temp_a(:) = senescence_temp_a_mtc(pft_to_mtc(:))
+      gdd_senescence(:) = gdd_senescence_mtc(pft_to_mtc(:))
+
+      !-
+      ! 4. N cycle
+      !-
+      cn_leaf_min(:) = cn_leaf_min_mtc(pft_to_mtc(:))
+      cn_leaf_max(:) = cn_leaf_max_mtc(pft_to_mtc(:))
+      max_soil_n_bnf(:) = max_soil_n_bnf_mtc(pft_to_mtc(:))
+      manure_pftweight(:) =  manure_pftweight_mtc(pft_to_mtc(:))
+
+      !
+      ! DGVM
+      !
+      residence_time(:) = residence_time_mtc(pft_to_mtc(:))
+      tmin_crit(:) = tmin_crit_mtc(pft_to_mtc(:))
+      tcm_crit(:) = tcm_crit_mtc(pft_to_mtc(:))
+      mortality_min(:) = mortality_min_mtc(pft_to_mtc(:))
+      mortality_max(:) = mortality_max_mtc(pft_to_mtc(:))
+      ref_mortality(:) = ref_mortality_mtc(pft_to_mtc(:))
+   
+      !
+      ! Recruitment (stomate)  
+      !  
+      recruitment_pft(:) = recruitment_pft_mtc(pft_to_mtc(:))  
+      recruitment_height(:) = recruitment_height_mtc(pft_to_mtc(:))  
+      recruitment_alpha(:) = recruitment_alpha_mtc(pft_to_mtc(:))  
+      recruitment_beta(:) = recruitment_beta_mtc(pft_to_mtc(:))  
+
+      !
+      ! Mortality - stomate_kill
+      !
+      death_distribution_factor(:) = death_distribution_factor_mtc(pft_to_mtc(:))
+      npp_reset_value(:) = npp_reset_value_mtc(pft_to_mtc(:))
+
+      !
+      ! Windfall - stomate_windthrow
+      !
+      IF (ok_windthrow) THEN
+         streamlining_c_leaf(:) = streamlining_c_leaf_mtc(pft_to_mtc(:))
+         streamlining_c_leafless(:) = streamlining_c_leafless_mtc(pft_to_mtc(:))
+         streamlining_n_leaf(:) = streamlining_n_leaf_mtc(pft_to_mtc(:))
+         streamlining_n_leafless(:) = streamlining_n_leafless_mtc(pft_to_mtc(:))
+         !streamlining_rb_leaf(:) = streamlining_rb_leaf_mtc(pft_to_mtc(:))
+         !streamlining_rb_leafless(:) = streamlining_rb_leafless_mtc(pft_to_mtc(:))
+         !canopy_density_leaf(:) = canopy_density_leaf_mtc(pft_to_mtc(:))
+         !canopy_density_leafless(:) = canopy_density_leafless_mtc(pft_to_mtc(:))
+         !intercept_breadth(:) = intercept_breadth_mtc(pft_to_mtc(:))
+         !slope_breadth(:) = slope_breadth_mtc(pft_to_mtc(:))
+         !intercept_depth(:) = intercept_depth_mtc(pft_to_mtc(:))
+         !slope_depth(:) = slope_depth_mtc(pft_to_mtc(:))
+         modulus_rupture(:) = modulus_rupture_mtc(pft_to_mtc(:))
+         f_knot(:) = f_knot_mtc(pft_to_mtc(:))
+         overturning_free_draining_shallow(:) = overturning_free_draining_shallow_mtc(pft_to_mtc(:))
+         overturning_free_draining_shallow_leafless(:) = overturning_free_draining_shallow_leafless_mtc(pft_to_mtc(:))
+         overturning_free_draining_deep(:) = overturning_free_draining_deep_mtc(pft_to_mtc(:))
+         overturning_free_draining_deep_leafless(:) = overturning_free_draining_deep_leafless_mtc(pft_to_mtc(:))
+         overturning_free_draining_average(:) = overturning_free_draining_average_mtc(pft_to_mtc(:))
+         overturning_free_draining_average_leafless(:) = overturning_free_draining_average_leafless_mtc(pft_to_mtc(:))
+         overturning_gleyed_shallow(:) = overturning_gleyed_shallow_mtc(pft_to_mtc(:))
+         overturning_gleyed_shallow_leafless(:) = overturning_gleyed_shallow_leafless_mtc(pft_to_mtc(:))
+         overturning_gleyed_deep(:) = overturning_gleyed_deep_mtc(pft_to_mtc(:))
+         overturning_gleyed_deep_leafless(:) = overturning_gleyed_deep_leafless_mtc(pft_to_mtc(:))
+         overturning_gleyed_average(:) = overturning_gleyed_average_mtc(pft_to_mtc(:))
+         overturning_gleyed_average_leafless(:) = overturning_gleyed_average_leafless_mtc(pft_to_mtc(:))
+         overturning_peaty_shallow(:) = overturning_peaty_shallow_mtc(pft_to_mtc(:))
+         overturning_peaty_shallow_leafless(:) = overturning_peaty_shallow_leafless_mtc(pft_to_mtc(:))
+         overturning_peaty_deep(:) = overturning_peaty_deep_mtc(pft_to_mtc(:))
+         overturning_peaty_deep_leafless(:) = overturning_peaty_deep_leafless_mtc(pft_to_mtc(:))
+         overturning_peaty_average(:) = overturning_peaty_average_mtc(pft_to_mtc(:))
+         overturning_peaty_average_leafless(:) = overturning_peaty_average_leafless_mtc(pft_to_mtc(:))
+         overturning_peat_shallow(:) = overturning_peat_shallow_mtc(pft_to_mtc(:))
+         overturning_peat_shallow_leafless(:) = overturning_peat_shallow_leafless_mtc(pft_to_mtc(:))
+         overturning_peat_deep(:) = overturning_peat_deep_mtc(pft_to_mtc(:))
+         overturning_peat_deep_leafless(:) = overturning_peat_deep_leafless_mtc(pft_to_mtc(:))
+         overturning_peat_average(:) = overturning_peat_average_mtc(pft_to_mtc(:))
+         overturning_peat_average_leafless(:) = overturning_peat_average_leafless_mtc(pft_to_mtc(:))
+         max_damage_further(:) = max_damage_further_mtc(pft_to_mtc(:))
+         max_damage_closer(:) = max_damage_closer_mtc(pft_to_mtc(:))
+         sfactor_further(:) = sfactor_further_mtc(pft_to_mtc(:))
+         sfactor_closer(:) = sfactor_closer_mtc(pft_to_mtc(:))
+         green_density(:) = green_density_mtc(pft_to_mtc(:))
+      END IF
+
+
+      !
+      ! SOM decomposition (stomate)
+      !
+
+      LC_leaf(:)       = LC_leaf_mtc(pft_to_mtc(:))
+      LC_sapabove(:)   = LC_sapabove_mtc(pft_to_mtc(:))
+      LC_sapbelow(:)   = LC_sapbelow_mtc(pft_to_mtc(:))
+      LC_heartabove(:) = LC_heartabove_mtc(pft_to_mtc(:))
+      LC_heartbelow(:) = LC_heartbelow_mtc(pft_to_mtc(:))
+      LC_fruit(:)      = LC_fruit_mtc(pft_to_mtc(:))
+      LC_root(:)       = LC_root_mtc(pft_to_mtc(:))
+      LC_carbres(:)    = LC_carbres_mtc(pft_to_mtc(:))
+      LC_labile(:)     = LC_labile_mtc(pft_to_mtc(:))
+
+      decomp_factor(:) = decomp_factor_mtc(pft_to_mtc(:))
+
+      !
+      ! Allocation and stand structure
+      !
+      pipe_tune4(:) = pipe_tune4_mtc(pft_to_mtc(:))
+      pipe_k1(:) = pipe_k1_mtc(pft_to_mtc(:)) 
+      mass_ratio_heart_sap(:) = mass_ratio_heart_sap_mtc(pft_to_mtc(:))
+      canopy_cover = canopy_cover_mtc(pft_to_mtc(:))
+      nmaxtrees(:) = nmaxtrees_mtc(pft_to_mtc(:))
+      height_init_min(:) = height_init_min_mtc(pft_to_mtc(:))
+      height_init_max(:) = height_init_max_mtc(pft_to_mtc(:))
+      alpha_self_thinning(:) = alpha_self_thinning_mtc(pft_to_mtc(:))
+      beta_self_thinning(:) = beta_self_thinning_mtc(pft_to_mtc(:))
+      fuelwood_diameter(:) = fuelwood_diameter_mtc(pft_to_mtc(:))
+      coppice_kill_be_wood(:) = coppice_kill_be_wood_mtc(pft_to_mtc(:))
+      h_first(:) = h_first_mtc(pft_to_mtc(:))
+      largest_tree_dia(:) = largest_tree_dia_mtc(pft_to_mtc(:))
+      thinstrat(:) = thinstrat_mtc(pft_to_mtc(:))
+      taumin(:) = taumin_mtc(pft_to_mtc(:))
+      taumax(:) = taumax_mtc(pft_to_mtc(:))
+      alpha_rdi_upper(:) =  alpha_rdi_upper_mtc(pft_to_mtc(:))
+      beta_rdi_upper(:) =  beta_rdi_upper_mtc(pft_to_mtc(:))
+      alpha_rdi_lower(:) =  alpha_rdi_lower_mtc(pft_to_mtc(:))
+      beta_rdi_lower(:) =  beta_rdi_lower_mtc(pft_to_mtc(:))  
+      branch_ratio(:) = branch_ratio_mtc(pft_to_mtc(:))
+      branch_harvest(:) = branch_harvest_mtc(pft_to_mtc(:))
+      coppice_diameter(:) = coppice_diameter_mtc(pft_to_mtc(:))
+      shoots_per_stool(:) = shoots_per_stool_mtc(pft_to_mtc(:))
+      src_rot_length(:) = src_rot_length_mtc(pft_to_mtc(:))
+      src_nrots(:) = src_nrots_mtc(pft_to_mtc(:))
+      deleuze_a(:) = deleuze_a_mtc(pft_to_mtc(:))
+      deleuze_b(:) = deleuze_b_mtc(pft_to_mtc(:))
+      deleuze_p_all(:) = deleuze_p_all_mtc(pft_to_mtc(:))
+      deleuze_p_coppice(:) = deleuze_p_coppice_mtc(pft_to_mtc(:))
+      deleuze_power(:) = deleuze_power_mtc(pft_to_mtc(:))
+      dens_target(:) = dens_target_mtc(pft_to_mtc(:))
+
+      k_latosa_max(:) = k_latosa_max_mtc(pft_to_mtc(:))
+      k_latosa_min(:) = k_latosa_min_mtc(pft_to_mtc(:))
+
+      deleuze_a(:) = deleuze_a_mtc(pft_to_mtc(:))
+      deleuze_b(:) = deleuze_b_mtc(pft_to_mtc(:))
+      deleuze_p_all(:) = deleuze_p_all_mtc(pft_to_mtc(:))
+      deleuze_p_coppice(:) = deleuze_p_coppice_mtc(pft_to_mtc(:))
+      m_dv(:) = m_dv_mtc(pft_to_mtc(:))
+      fruit_alloc(:) = fruit_alloc_mtc(pft_to_mtc(:))
+
+      labile_reserve(:) = labile_reserve_mtc(pft_to_mtc(:))
+      evergreen_reserve(:) = evergreen_reserve_mtc(pft_to_mtc(:))
+      deciduous_reserve(:) = deciduous_reserve_mtc(pft_to_mtc(:))
+      senescense_reserve(:) = senescense_reserve_mtc(pft_to_mtc(:))
+
+      cn_leaf_prescribed(:) = cn_leaf_prescribed_mtc(pft_to_mtc(:))
+      fcn_wood(:) = fcn_wood_mtc(pft_to_mtc(:))
+      fcn_root(:) = fcn_root_mtc(pft_to_mtc(:))
+
+      cn_leaf_init(:) = cn_leaf_init_mtc(pft_to_mtc(:))
+
+      !
+      ! Cropland management
+      !
+      harvest_ratio(:) = harvest_ratio_mtc(pft_to_mtc(:))
+
+   ENDIF !(ok_stomate)
+
+ END SUBROUTINE pft_parameters_init
+ !
+ !=
+ !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pft_parameters_alloc
+!!
+!>\BRIEF         This subroutine allocates memory needed for the PFT parameters 
+!! in function  of the flags activated.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE pft_parameters_alloc()
+
+   IMPLICIT NONE
+
+   !! 0. Variables and parameters declaration
+
+   !! 0.1 Input variables 
+   
+   !! 0.4 Local variables
+   
+   LOGICAL :: l_error                             !! Diagnostic boolean for error allocation (true/false) 
+   INTEGER :: ier                                 !! Return value for memory allocation (0-N, unitless)
+
+!_ ================================================================================================================================
+
+
+   !
+   ! 1. Parameters used anytime
+   !
+
+   l_error = .FALSE.
+
+   ALLOCATE(pft_to_mtc(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for pft_to_mtc. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(PFT_name(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for PFT_name. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(height_presc(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for height_presc. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(z0_over_height(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for z0_over_height. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(ratio_z0m_z0h(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for ratio_z0m_z0h. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_tree(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_tree. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(natural(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for natural. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_c4(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_c4. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(humcste(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for humcste. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(downregulation_co2_coeff(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for downregulation_co2_coeff. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(E_KmC(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for E_KmC. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(E_KmO(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for E_KmO. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(E_Sco(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for E_Sco. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+   
+   ALLOCATE(E_gamma_star(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for E_gamma_star. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(E_vcmax(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for E_Vcmax. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(E_Jmax(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for E_Jmax. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(aSV(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for aSV. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(bSV(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for bSV. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(tphoto_min(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for tphoto_min. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(tphoto_max(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for tphoto_max. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(aSJ(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for aSJ. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(bSJ(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for bSJ. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(D_Vcmax(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for D_Vcmax. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(D_Jmax(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for D_Jmax. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(E_gm(nvm),stat=ier)  
+   l_error = l_error .OR. (ier /= 0)  
+   IF (l_error) THEN  
+      WRITE(numout,*) ' Memory allocation error for E_gm. We stop. We need nvm words = ',nvm  
+      STOP 'pft_parameters_alloc'  
+   END IF 
+        
+   ALLOCATE(S_gm(nvm),stat=ier)  
+   l_error = l_error .OR. (ier /= 0)  
+   IF (l_error) THEN  
+      WRITE(numout,*) ' Memory allocation error for S_gm. We stop. We need nvm words = ',nvm  
+      STOP 'pft_parameters_alloc'  
+   END IF 
+         
+   ALLOCATE(D_gm(nvm),stat=ier)  
+   l_error = l_error .OR. (ier /= 0)  
+   IF (l_error) THEN  
+      WRITE(numout,*) ' Memory allocation error for D_gm. We stop. We need nvm words = ',nvm  
+      STOP 'pft_parameters_alloc'  
+   END IF   
+
+   ALLOCATE(E_Rd(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for E_Rd. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(Vcmax25(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for Vcmax25. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(arJV(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for arJV. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(brJV(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for brJV. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(KmC25(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for KmC25. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(KmO25(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for KmO25. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(Sco25(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for Sco25. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+        
+   ALLOCATE(gm25(nvm),stat=ier) 
+   l_error = l_error .OR. (ier /= 0) 
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for gm25. We stop. We need nvm words = ',nvm 
+      STOP 'pft_parameters_alloc' 
+   END IF
+
+   ALLOCATE(gamma_star25(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for gamma_star25. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(a1(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for a1. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(b1(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for b1. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(g0(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for g0. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(h_protons(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for h_protons. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(fpsir(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for fpsir. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(fQ(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for fQ. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(fpseudo(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for fpseudo. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(kp(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for kp. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(alpha(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for alpha. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(gbs(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for gbs. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(theta(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for theta. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(alpha_LL(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for alpha_LL. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(stress_vcmax(nvm),stat=ier) 
+   l_error = l_error .OR. (ier /= 0) 
+   IF (l_error) THEN 
+      WRITE(numout,*) ' Memory allocation error for stress_vcmax. We stop. We need nvm words = ',nvm 
+      STOP 'pft_parameters_alloc' 
+   END IF 
+    
+   ALLOCATE(stress_gs(nvm),stat=ier) 
+   l_error = l_error .OR. (ier /= 0) 
+   IF (l_error) THEN 
+      WRITE(numout,*) ' Memory allocation error for stress_gs. We stop. We need nvm words = ',nvm 
+      STOP 'pft_parameters_alloc' 
+   END IF 
+     
+   ALLOCATE(stress_gm(nvm),stat=ier) 
+   l_error = l_error .OR. (ier /= 0) 
+   IF (l_error) THEN 
+      WRITE(numout,*) ' Memory allocation error for stress_gm. We stop. We need nvm words = ',nvm 
+      STOP 'pft_parameters_alloc' 
+   END IF 
+
+   ALLOCATE(ext_coeff(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for ext_coeff. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(ext_coeff_vegetfrac(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for ext_coeff_vegetfrac. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+    ALLOCATE(veget_ori_fixed_test_1(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for veget_ori_fixed_test_1. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(llaimax(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for llaimax. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(llaimin(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for llaimin. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(type_of_lai(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for type_of_lai. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(vcmax_fix(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for vcmax_fix. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(pref_soil_veg(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for pref_soil_veg. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(agec_group(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for agec_group. We stop. We need nvm words = ',nvm
+      CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+   END IF
+
+   ALLOCATE(start_index(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for start_index. We stop. We need nvm words = ',nvm
+      CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+   END IF
+
+   ALLOCATE(nagec_pft(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for nagec_pft. We stop. We need nvm words = ',nvm
+      CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+   END IF
+
+   ALLOCATE(leaf_tab(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for leaf_tab. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(pheno_model(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for pheno_model. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+      
+   ALLOCATE(is_deciduous(nvm),stat=ier) 
+   l_error = l_error .OR. (ier /= 0) 
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_deciduous. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_evergreen(nvm),stat=ier) 
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_evergreen. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_needleleaf(nvm),stat=ier)  
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_needleleaf. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_tropical(nvm),stat=ier)   
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_tropical. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_temperate(nvm),stat=ier)   
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_temperate. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+   
+   ALLOCATE(is_boreal(nvm),stat=ier)   
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_boreal. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   
+
+   !
+   ! 2. Parameters used if ok_sechiba only
+   !
+   IF ( ok_sechiba ) THEN
+
+      l_error = .FALSE.
+
+      ALLOCATE(rstruct_const(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for rstruct_const. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(kzero(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for kzero. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(rveg_pft(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for rveg_pft. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(wmax_veg(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for wmax_veg. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(throughfall_by_pft(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for throughfall_by_pft. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(snowa_aged(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for snowa_aged. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(snowa_dec(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for snowa_dec_vis. We stop.We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(leaf_ssa(nvm,n_spectralbands),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leaf_ssa. We stop. We need nvm*n_spectralbands words = ',&
+              nvm*n_spectralbands
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(leaf_psd(nvm,n_spectralbands),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leaf_psd. We stop. We need nvm*n_spectralbands words = ',&
+              nvm*n_spectralbands
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(bgd_reflectance(nvm,n_spectralbands),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for bgd_reflectance. We need nvm*n_spectralbands words = ',&
+              nvm*n_spectralbands
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(leaf_to_shoot_clumping(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leaf_to_shoot_clumping. We need nvm words = ',&
+              nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(lai_correction_factor(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for lai_correction_factor. We need nvm words = ',&
+              nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(min_level_sep(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for min_level_sep. We need nvm words = ',&
+              nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(lai_top(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for lai_top. We need nvm words = ',&
+              nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(sla(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for sla. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(slainit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for slainit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(ext_coeff_N(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for ext_coeff_N. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(nue_opt(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for nue_opt. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pipe_density(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pipe_density. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(tree_ff(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tree_ff. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(pipe_tune1(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pipe_tune1. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pipe_tune2(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pipe_tune2. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pipe_tune3(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pipe_tune3. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pipe_tune_exp_coeff(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pipe_tune_exp_coeff. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(lai_to_height(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for lai_to_height. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      !
+      ! Hydraulic architecture
+      !
+      ALLOCATE(k_root(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for k_root. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(k_sap(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for k_sap. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(k_leaf(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for k_leaf. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(psi_leaf(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for psi_leaf. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(psi_50(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for psi_50. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(c_cavitation(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for c_cavitation. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(psi_soil_tune(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for psi_soil_tune. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(srl(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for srl. We stop.We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(r_froot(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for r_froot. We stop.We need nvmwords = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      ALLOCATE(psi_root(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for psi_root. We stop.We need nvmwords = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      IF( ok_bvoc ) THEN
+         
+         l_error = .FALSE.
+         
+         ALLOCATE(em_factor_isoprene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_isoprene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_monoterpene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_monoterpene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_apinene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_apinene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_bpinene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_bpinene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_limonene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_limonene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_myrcene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_myrcene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_sabinene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_sabinene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_camphene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_camphene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_3carene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_3carene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_tbocimene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_tbocimene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_othermonot(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_othermonot. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_sesquiterp(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_sesquiterp. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_ORVOC(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_ORVOC. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_OVOC(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0)       
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_OVOC. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_MBO(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_MBO. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_methanol(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_methanol. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_acetone(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_acetone. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_acetal(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_acetal. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_formal(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_formal. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_acetic(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0)       
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_acetic. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_formic(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_formic. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_no_wet(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0)
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_no_wet. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_no_dry(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0)       
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_no_dry. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(Larch(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for Larch. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+      ENDIF ! (ok_bvoc) 
+
+   ENDIF !(ok_sechiba)
+
+   !
+   ! 3. Parameters used if ok_stomate only
+   !
+   IF ( ok_stomate ) THEN
+
+      l_error = .FALSE.
+
+      ALLOCATE(availability_fact(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for availability_fact. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(maint_resp_slope(nvm,3),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maint_resp_slope. We stop. We need nvm*3 words = ',nvm*3
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      maint_resp_slope(:,:) = zero
+
+      ALLOCATE(maint_resp_slope_c(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maint_resp_slope_c. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(maint_resp_slope_b(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maint_resp_slope_b. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(maint_resp_slope_a(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maint_resp_slope_a. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(pheno_gdd_crit_c(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit_c. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_gdd_crit_b(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit_b. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_gdd_crit_a(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit_a. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_gdd_crit(nvm,3),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit. We stop. We need nvm words = ',nvm*3
+         STOP 'pft_parameters_alloc'
+      END IF
+      pheno_gdd_crit(:,:) = zero
+
+      ALLOCATE(pheno_moigdd_t_crit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_moigdd_t_crit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(ngd_crit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for ngd_crit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(ncdgdd_temp(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for ncdgdd_temp. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(hum_frac(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for hum_frac. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(hum_min_time(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for hum_min_time. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tau_sap(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tau_sap. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tau_leaf(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tau_leaf. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(tau_leafinit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tau_leafinit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tau_fruit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tau_fruit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tau_root(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tau_root. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(ecureuil(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for ecureuil. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(alloc_min(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for alloc_min. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(alloc_max(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for alloc_max. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(demi_alloc(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(frac_growthresp(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for frac_growthresp. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_maint_init(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_maint_init. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tref_maint_resp(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tref_maint_resp. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tmin_maint_resp(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tmin_maint_resp. We stop. We need nvm  words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(e0_maint_resp(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for e0_maint_resp. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(flam(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(resist(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for resist. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_lcchange_1(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_lcchange_1. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_lcchange_10(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_lcchange_10. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_lcchange_100(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_lcchange_100. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_lcchange_s(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_lcchange_s. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_lcchange_m(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_lcchange_m. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_lcchange_l(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_lcchange_l. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(lai_max_to_happy(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for lai_max_to_happy. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(lai_max(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for lai_max. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_type(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_type. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(leaffall(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leaffall. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(leafagecrit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leafagecrit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_type(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_hum(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_hum. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(nosenescence_hum(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for nosenescence_hum. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(max_turnover_time(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for max_turnover_time. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(min_turnover_time(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for min_turnover_time. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(recycle_leaf(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for recycle_leaf. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(recycle_root(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for recycle_root. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(min_leaf_age_for_senescence(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for min_leaf_age_for_senescence. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_temp_c(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_temp_c. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_temp_b(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_temp_b. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_temp_a(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_temp_a. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_temp(nvm,3),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_temp. We stop. We need nvm*3 words = ',nvm*3
+         STOP 'pft_parameters_alloc'
+      END IF
+      senescence_temp(:,:) = zero
+
+      ALLOCATE(gdd_senescence(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for gdd_senescence. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cn_leaf_min(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cn_leaf_min. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cn_leaf_max(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cn_leaf_max. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(max_soil_n_bnf(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for max_soil_n_bnf. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(manure_pftweight(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for manure_pftweight. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(residence_time(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for residence_time. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tmin_crit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tmin_crit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tcm_crit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tcm_crit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+         ALLOCATE(mortality_min(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for mortality_min. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(mortality_max(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for mortality_max. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(ref_mortality(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for ref_mortality. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(lai_initmin(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(bm_sapl(nvm,nparts,nelements),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for bm_sapl. We stop. We need nvm*nparts*nelements words = ',& 
+              &  nvm*nparts*nelements
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(migrate(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for migrate. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(maxdia(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maxdia. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cn_sapl(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cn_sapl. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(leaf_timecst(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leaf_timecst. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(leaflife_tab(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leaflife_tab. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(k_latosa_max(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for k_latosa_max. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(k_latosa_min(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for k_latosa_min. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      !
+      ! SOM decomposition (stomate)
+      !
+      ALLOCATE(LC(nvm,nparts),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for LC. We stop. We need nvm*nparts words = ',nvm,nparts
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(LC_leaf(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for LC_leaf. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(LC_sapabove(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for LC_sapabove. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(LC_sapbelow(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for LC_sapbelow. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(LC_heartabove(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for LC_heartabove. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(LC_heartbelow(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for LC_heartbelow. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(LC_fruit(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for LC_fruit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(LC_root(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for LC_root. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(LC_carbres(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for LC_carbres. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(LC_labile(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for LC_labile. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(decomp_factor(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for decomp_factor. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pipe_tune4(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pipe_tune4. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pipe_k1(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pipe_k1. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(mass_ratio_heart_sap(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for mass_ratio_heart_sap. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(canopy_cover(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for canopy_cover. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(nmaxtrees(nvm),stat=ier)   
+         l_error = l_error .OR. (ier /= 0)
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for nmaxtrees. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(height_init_min(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for height_init_min. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(height_init_max(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for height_init_max. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(alpha_self_thinning(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for alpha_self_thinning. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(beta_self_thinning(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for beta_self_thinning. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+         
+      ALLOCATE(fuelwood_diameter(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for fuelwood_diameter. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+         
+      ALLOCATE(coppice_kill_be_wood(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coppice_kill_be_wood. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(deleuze_a(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for deleuze_a. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(deleuze_b(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for deleuze_b. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(deleuze_p_all(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for deleuze_p_all. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(deleuze_p_coppice(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for deleuze_p_coppice. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(deleuze_power(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for deleuze_power. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(m_dv(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for m_dv. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(dens_target(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for dens_target. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(h_first(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for h_first. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(thinstrat(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for thinstrat. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(taumin(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for taumin. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(taumax(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for taumax. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(alpha_rdi_upper(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for alpha_rdi_upper. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(beta_rdi_upper(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for beta_rdi_upper. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(alpha_rdi_lower(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for alpha_rdi_lower. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(beta_rdi_lower(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for beta_rdi_lower. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(largest_tree_dia(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for largest_tree_dia. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(branch_ratio(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for branch_ratio. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(branch_harvest(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for branch_harvest. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(coppice_diameter(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coppice_diameter. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(shoots_per_stool(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for shoots_per_stool. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(src_rot_length(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for src_rot_length. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(src_nrots(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for src_nrots. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(fruit_alloc(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for fruit_alloc. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(labile_reserve(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for labile_reserve. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(evergreen_reserve(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for evergreen_reserve. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+       ALLOCATE(deciduous_reserve(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for deciudous_reserve. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+       ALLOCATE(senescense_reserve(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescense_reserve. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      ALLOCATE(cn_leaf_prescribed(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cn_leaf_prescribed. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      ALLOCATE(fcn_wood(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for fcn_wood. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(fcn_root(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for fcn_root. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(cn_leaf_init(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cn_leaf_init. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      
+      !
+      ! RECRUITMENT 
+      ! 
+      ALLOCATE(recruitment_pft(nvm),stat=ier)     
+      l_error = l_error .OR. (ier /= 0)  
+      IF (l_error) THEN  
+         WRITE(numout,*) ' Memory allocation error for recruitment_pft. We stop. We need nvm words = ',nvm  
+         CALL ipslerr_p (3, 'pft_parameters','pft_parameters_alloc','','')  
+      END IF  
+
+      ALLOCATE(recruitment_height(nvm),stat=ier)     
+      l_error = l_error .OR. (ier /= 0)  
+      IF (l_error) THEN  
+         WRITE(numout,*) ' Memory allocation error for recruitment_height. We stop. We need nvm words = ',nvm  
+         CALL ipslerr_p (3, 'pft_parameters','pft_parameters_alloc','','')  
+      END IF  
+
+      ALLOCATE(recruitment_alpha(nvm),stat=ier)     
+      l_error = l_error .OR. (ier /= 0) 
+      IF (l_error) THEN  
+         WRITE(numout,*) ' Memory allocation error for recruitment_alpha. We stop. We need nvm words = ',nvm  
+         CALL ipslerr_p (3, 'pft_parameters','pft_parameters_alloc','','') 
+      END IF  
+
+      ALLOCATE(recruitment_beta(nvm),stat=ier)     
+      l_error = l_error .OR. (ier /= 0)  
+      IF (l_error) THEN  
+         WRITE(numout,*) ' Memory allocation error for recruitment_beta. We stop. We need nvm words = ',nvm  
+         CALL ipslerr_p (3, 'pft_parameters','pft_parameters_alloc','','')  
+      END IF  
+
+      !
+      ! MORTALITY
+      !
+      ALLOCATE(death_distribution_factor(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for death_distribution_factor. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(npp_reset_value(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for npp_reset_value. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      !
+      ! WINDTHROW
+      !
+
+      ALLOCATE(streamlining_c_leaf(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for streamlining_c_leaf. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(streamlining_c_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for streamlining_c_leafless. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(streamlining_n_leaf(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for streamlining_n_leaf. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+      
+      ALLOCATE(streamlining_n_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for streamlining_n_leafless. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(streamlining_rb_leaf(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for streamlining_rb_leaf. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+       
+      ALLOCATE(streamlining_rb_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for streamlining_rb_leafless . We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(canopy_density_leaf(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for canopy_density_leaf . We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+       
+      ALLOCATE(canopy_density_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for canopy_density_leafless. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE( intercept_breadth(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for intercept_breadth . We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+       
+      ALLOCATE(slope_breadth(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for slope_breadth. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+       
+      ALLOCATE(intercept_depth(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for intercept_depth . We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(slope_depth(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for slope_depth . We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(modulus_rupture(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for modulus_rupture. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(f_knot(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for f_knot. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_free_draining_shallow(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_free_draining_shallow. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_free_draining_shallow_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_free_draining_shallow_leafless.',&
+           ' We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_free_draining_deep(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_free_draining_deep. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+       
+      ALLOCATE(overturning_free_draining_deep_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_free_draining_deep_leafles. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_free_draining_average(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_free_draining_average. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_free_draining_average_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_free_draining_average_leafless. ', &
+            ' We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_gleyed_shallow(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_gleyed_shallow. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_gleyed_shallow_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_gleyed_shallow_leafless. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+       
+      ALLOCATE(overturning_gleyed_deep(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_gleyed_deep. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_gleyed_deep_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_gleyed_deep_leafless. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_gleyed_average(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_gleyed_average. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_gleyed_average_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_gleyed_average_leafless. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_peaty_shallow(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_peaty_shallow. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_peaty_shallow_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_peaty_shallow_leafless. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_peaty_deep(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_peaty_deep. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_peaty_deep_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_peaty_deep_leafless. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+         
+      ALLOCATE(overturning_peaty_average(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_peaty_average. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_peaty_average_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_peaty_average_leafless. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_peat_shallow(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_peat_shallow. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+       
+      ALLOCATE(overturning_peat_shallow_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_peat_shallow_leafless. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_peat_deep(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_peat_deep. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_peat_deep_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_peat_deep_leafless. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+       
+      ALLOCATE(overturning_peat_average(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_peat_average. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+        
+      ALLOCATE(overturning_peat_average_leafless(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for overturning_peat_average_leafles. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(max_damage_further(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for max_damage_further. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(max_damage_closer(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for max_damage_cloeer. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(sfactor_further(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for sfactor_further. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(sfactor_closer(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for sfactor_closer. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+      ALLOCATE(green_density(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for green_density. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+
+
+
+      !
+      ! CROPLAND MANAGEMENT
+      !
+      ALLOCATE(harvest_ratio(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for harvest_ratio. We stop. We need nvm words = ',nvm
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      END IF
+
+   ENDIF ! (ok_stomate)
+
+ END SUBROUTINE pft_parameters_alloc
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_pft_parameters 
+!!
+!>\BRIEF          This subroutine will read the imposed values for the global pft
+!! parameters (sechiba + stomate). It is not called if IMPOSE_PARAM is set to NO.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE config_pft_parameters
+   
+   IMPLICIT NONE
+
+   !! 0. Variables and parameters declaration
+  
+   INTEGER(i_std) :: jv, ivm              !! Index (untiless)
+
+!_ ================================================================================================================================ 
+
+   ! Vegetation structure
+   !
+
+   !Config Key   = LEAF_TAB
+   !Config Desc  = leaf type : 1=broad leaved tree, 2=needle leaved tree, 3=grass 4=bare ground
+   !Config if    = OK_STOMATE
+   !Config Def   = 4, 1, 1, 2, 1, 1, 2, 1, 2, 3, 3, 3, 3 
+   !Config Help  = 
+   !Config Units = [-] 
+   CALL getin_p('LEAF_TAB',leaf_tab)
+   
+   !Config Key   = PHENO_MODEL
+   !Config Desc  = which phenology model is used? (tabulated) 
+   !Config if    = OK_STOMATE
+   !Config Def   = none, none, moi, none, none, ncdgdd, none, ncdgdd, ngd, moigdd, moigdd, moigdd, moigdd
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('PHENO_MODEL',pheno_model)
+   
+   !! Redefine the values for is_tree, is_deciduous, is_needleleaf, is_evergreen if values have been modified
+   !! in run.def
+
+   is_tree(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( leaf_tab(jv) <= 2 ) is_tree(jv) = .TRUE.
+   END DO
+   !
+   is_deciduous(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( is_tree(jv) .AND. (pheno_model(jv) /= "none") ) is_deciduous(jv) = .TRUE.
+   END DO
+   !
+   is_evergreen(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( is_tree(jv) .AND. (pheno_model(jv) == "none") ) is_evergreen(jv) = .TRUE.
+   END DO
+   !
+   is_needleleaf(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( leaf_tab(jv) == 2 ) is_needleleaf(jv) = .TRUE.
+   END DO
+
+
+   !Config Key   = SECHIBA_LAI
+   !Config Desc  = laimax for maximum lai(see also type of lai interpolation)
+   !Config if    = OK_SECHIBA or IMPOSE_VEG
+   !Config Def   = 0., 8., 8., 4., 4.5, 4.5, 4., 4.5, 4., 2., 2., 2., 2.
+   !Config Help  = Maximum values of lai used for interpolation of the lai map
+   !Config Units = [m^2/m^2]
+   CALL getin_p('SECHIBA_LAI',llaimax)
+
+   !Config Key   = LLAIMIN
+   !Config Desc  = laimin for minimum lai(see also type of lai interpolation)
+   !Config if    = OK_SECHIBA or IMPOSE_VEG
+   !Config Def   = 0., 8., 0., 4., 4.5, 0., 4., 0., 0., 0., 0., 0., 0.
+   !Config Help  = Minimum values of lai used for interpolation of the lai map
+   !Config Units = [m^2/m^2]
+   CALL getin_p('LLAIMIN',llaimin)
+
+   !Config Key   = SLOWPROC_HEIGHT
+   !Config Desc  = prescribed height of vegetation 
+   !Config if    = OK_SECHIBA
+   !Config Def   = 0., 30., 30., 20., 20., 20., 15., 15., 15., .5, .6, 1., 1.
+   !Config Help  =
+   !Config Units = [m] 
+   CALL getin_p('SLOWPROC_HEIGHT',height_presc)
+
+   !Config Key   = Z0_OVER_HEIGHT
+   !Config Desc  = factor to calculate roughness height from height of canopy 
+   !Config if    = OK_SECHIBA
+   !Config Def   = 0., 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625, 0.0625
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('Z0_OVER_HEIGHT',z0_over_height)
+
+   !
+   !Config Key   = RATIO_Z0M_Z0H
+   !Config Desc  = Ratio between z0m and z0h
+   !Config Def   = 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0 
+   !Config if    = OK_SECHIBA
+   !Config Help  = 
+   !Config Units = [-]
+   CALL getin_p('RATIO_Z0M_Z0H',ratio_z0m_z0h)
+
+
+   !Config Key   = TYPE_OF_LAI
+   !Config Desc  = Type of behaviour of the LAI evolution algorithm 
+   !Config if    = OK_SECHIBA
+   !Config Def   = inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('TYPE_OF_LAI',type_of_lai)
+
+   !Config Key   = NATURAL
+   !Config Desc  = natural? 
+   !Config if    = OK_SECHIBA, OK_STOMATE
+   !Config Def   = y, y, y, y, y, y, y, y, y, y, y, n, n 
+   !Config Help  =
+   !Config Units = [BOOLEAN]
+   CALL getin_p('NATURAL',natural)
+
+   
+   !
+   ! Photosynthesis
+   !
+
+   !Config Key   = IS_C4
+   !Config Desc  = flag for C4 vegetation types
+   !Config if    = OK_SECHIBA or OK_STOMATE
+   !Config Def   = n, n, n, n, n, n, n, n, n, n, n, y, n, y
+   !Config Help  =
+   !Config Units = [BOOLEAN]
+   CALL getin_p('IS_C4',is_c4)
+
+   !Config Key   = VCMAX_FIX
+   !Config Desc  = values used for vcmax when STOMATE is not activated
+   !Config if    = OK_SECHIBA and NOT(OK_STOMATE)
+   !Config Def   = 0., 40., 50., 30., 35., 40.,30., 40., 35., 60., 60., 70., 70.
+   !Config Help  =
+   !Config Units = [micromol/m^2/s] 
+   CALL getin_p('VCMAX_FIX',vcmax_fix)
+
+   !Config Key   = DOWNREG_CO2
+   !Config Desc  = coefficient for CO2 downregulation (unitless)
+   !Config if    = 
+   !Config Def   = 0., 0.38, 0.38, 0.28, 0.28, 0.28, 0.22, 0.22, 0.22, 0.26, 0.26, 0.26, 0.26
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('DOWNREG_CO2',downregulation_co2_coeff)
+
+   !Config Key   = E_KmC
+   !Config Desc  = Energy of activation for KmC
+   !Config if    = 
+   !Config Def   = undef,  79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430.
+   !Config Help  = See Medlyn et al. (2002) 
+   !Config Units = [J mol-1]
+   CALL getin_p('E_KMC',E_KmC)
+
+   !Config Key   = E_KmO
+   !Config Desc  = Energy of activation for KmO
+   !Config if    = 
+   !Config Def   = undef, 36380.,  36380.,  36380.,  36380.,  36380., 36380., 36380., 36380., 36380., 36380., 36380., 36380.
+   !Config Help  = See Medlyn et al. (2002) 
+   !Config Units = [J mol-1]
+   CALL getin_p('E_KMO',E_KmO)
+   
+   !Config Key   = E_Sco 
+   !Config Desc  = Energy of activation for Sco 
+   !Config if    = 
+   !Config Def   = undef, -24460., -24460., -24460., -24460., -24460., -24460., -24460., -24460., -24460., -24460., -24460., -24460. 
+   !Config Help  = See Table 2 of Yin et al. (2009) - Value for C4 plants is not mentioned - We use C3 for all plants 
+   !Config Units = [J mol-1] 
+   CALL getin_p('E_SCO',E_Sco)
+
+   !Config Key   = E_gamma_star
+   !Config Desc  = Energy of activation for gamma_star
+   !Config if    = 
+   !Config Def   = undef, 37830.,  37830.,  37830.,  37830.,  37830., 37830., 37830., 37830., 37830., 37830., 37830., 37830.
+   !Config Help  = See Medlyn et al. (2002) from Bernacchi al. (2001) 
+   !Config Units = [J mol-1]
+   CALL getin_p('E_GAMMA_STAR',E_gamma_star)
+
+   !Config Key   = E_Vcmax
+   !Config Desc  = Energy of activation for Vcmax
+   !Config if    = 
+   !Config Def   = undef, 71513., 71513., 71513., 71513., 71513., 71513., 71513., 71513., 71513., 67300., 71513., 67300.
+   !Config Help  = See Table 2 of Yin et al. (2009) for C4 plants and Kattge & Knorr (2007) for C3 plants (table 3)
+   !Config Units = [J mol-1]
+   CALL getin_p('E_VCMAX',E_Vcmax)
+
+   !Config Key   = E_Jmax
+   !Config Desc  = Energy of activation for Jmax
+   !Config if    = 
+   !Config Def   = undef, 49884., 49884., 49884., 49884., 49884., 49884., 49884., 49884., 49884., 77900., 49884., 77900. 
+   !Config Help  = See Table 2 of Yin et al. (2009) for C4 plants and Kattge & Knorr (2007) for C3 plants (table 3)
+   !Config Units = [J mol-1]
+   CALL getin_p('E_JMAX',E_Jmax)
+
+   !Config Key   = aSV
+   !Config Desc  = a coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax
+   !Config if    = 
+   !Config Def   = undef, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 641.64, 668.39, 641.64 
+   !Config Help  = See Table 3 of Kattge & Knorr (2007) - For C4 plants, we assume that there is no acclimation and that at for a temperature of 25Â°C, aSV is the same for both C4 and C3 plants (no strong jusitification - need further parametrization)
+   !Config Units = [J K-1 mol-1]
+   CALL getin_p('ASV',aSV)
+
+   !Config Key   = bSV
+   !Config Desc  = b coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax
+   !Config if    = 
+   !Config Def   = undef, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, 0., -1.07, 0. 
+   !Config Help  = See Table 3 of Kattge & Knorr (2007) - For C4 plants, we assume that there is no acclimation
+   !Config Units = [J K-1 mol-1 Â°C-1]
+   CALL getin_p('BSV',bSV)
+
+   !Config Key   = TPHOTO_MIN
+   !Config Desc  = minimum photosynthesis temperature (deg C)
+   !Config if    = OK_STOMATE
+   !Config Def   = undef,  -4., -4., -4., -4.,-4.,-4., -4., -4., -4., -4., -4., -4.
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('TPHOTO_MIN',tphoto_min)
+
+   !Config Key   = TPHOTO_MAX
+   !Config Desc  = maximum photosynthesis temperature (deg C)
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 55., 55., 55., 55., 55., 55., 55., 55., 55., 55., 55., 55.
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('TPHOTO_MAX',tphoto_max)
+
+   !Config Key   = aSJ
+   !Config Desc  = a coefficient of the linear regression (a+bT) defining the Entropy term for Jmax
+   !Config if    = 
+   !Config Def   = undef, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 630., 659.70, 630. 
+   !Config Help  = See Table 3 of Kattge & Knorr (2007) - and Table 2 of Yin et al. (2009) for C4 plants
+   !Config Units = [J K-1 mol-1]
+   CALL getin_p('ASJ',aSJ)
+
+   !Config Key   = bSJ
+   !Config Desc  = b coefficient of the linear regression (a+bT) defining the Entropy term for Jmax
+   !Config if    = 
+   !Config Def   = undef, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, 0., -0.75, 0. 
+   !Config Help  = See Table 3 of Kattge & Knorr (2007) - For C4 plants, we assume that there is no acclimation
+   !Config Units = [J K-1 mol-1 Â°C-1]
+   CALL getin_p('BSJ',bSJ)
+
+   !Config Key   = D_Vcmax
+   !Config Desc  = Energy of deactivation for Vcmax
+   !Config if    = 
+   !Config Def   = undef, 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 192000., 200000., 192000.
+   !Config Help  = Medlyn et al. (2002) also uses 200000. for C3 plants (same value than D_Jmax). 'Consequently', we use the value of D_Jmax for C4 plants.
+   !Config Units = [J mol-1]
+   CALL getin_p('D_VCMAX',D_Vcmax)
+
+   !Config Key   = D_Jmax
+   !Config Desc  = Energy of deactivation for Jmax
+   !Config if    = 
+   !Config Def   = undef, 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 192000., 200000., 192000.
+   !Config Help  = See Table 2 of Yin et al. (2009)
+   !Config Units = [J mol-1]
+   CALL getin_p('D_JMAX',D_Jmax)
+
+   !Config Key   = E_gm  
+   !Config Desc  = Energy of activation for gm  
+   !Config if    =   
+   !Config Def   = undef, 49600., 49600., 49600., 49600., 49600., 49600., 49600., 49600., 49600., undef, 49600., undef  
+   !Config Help  = See Table 2 of Yin et al. (2009)  
+   !Config Units = [J mol-1]  
+   CALL getin_p('E_GM',E_gm)  
+    
+   !Config Key   = S_gm  
+   !Config Desc  = Entropy term for gm  
+   !Config if    =   
+   !Config Def   = undef, 1400., 1400., 1400., 1400., 1400., 1400., 1400., 1400., 1400., undef, 1400., undef  
+   !Config Help  = See Table 2 of Yin et al. (2009)  
+   !Config Units = [J K-1 mol-1]  
+   CALL getin_p('S_GM',S_gm)  
+    
+   !Config Key   = D_gm  
+   !Config Desc  = Energy of deactivation for gm  
+   !Config if    =   
+   !Config Def   = undef, 437400., 437400., 437400., 437400., 437400., 437400., 437400., 437400., 437400., undef, 437400., undef  
+   !Config Help  = See Table 2 of Yin et al. (2009)  
+   !Config Units = [J mol-1]  
+   CALL getin_p('D_GM',D_gm)   
+
+   !Config Key   = E_Rd
+   !Config Desc  = Energy of activation for Rd
+   !Config if    = 
+   !Config Def   = undef, 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390.
+   !Config Help  = See Table 2 of Yin et al. (2009)
+   !Config Units = [J mol-1]
+   CALL getin_p('E_RD',E_Rd)
+
+   !Config Key   = VCMAX25
+   !Config Desc  = Maximum rate of Rubisco activity-limited carboxylation at 25Â°C
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 65., 65., 35., 45., 55., 35., 45., 35., 70., 70., 70., 70.
+   !Config Help  =
+   !Config Units = [micromol/m^2/s]
+   CALL getin_p('VCMAX25',Vcmax25)
+
+   !Config Key   = ARJV
+   !Config Desc  = a coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio 
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 1.715, 2.59, 1.715
+   !Config Help  = See Table 3 of Kattge & Knorr (2007) - For C4 plants, we assume that there is no acclimation and that for a temperature of 25Â°C, aSV is the same for both C4 and C3 plants (no strong jusitification - need further parametrization)
+   !Config Units = [mu mol e- (mu mol CO2)-1]
+   CALL getin_p('ARJV',arJV)
+
+   !Config Key   = BRJV
+   !Config Desc  = b coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio 
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, 0., -0.035, 0.
+   !Config Help  = See Table 3 of Kattge & Knorr (2007) -  We assume No acclimation term for C4 plants
+   !Config Units = [(mu mol e- (mu mol CO2)-1) (Â°C)-1]
+   CALL getin_p('BRJV',brJV)
+
+   !Config Key   = KmC25
+   !Config Desc  = MichaelisâMenten constant of Rubisco for CO2 at 25Â°C
+   !Config if    = 
+   !Config Def   = undef, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 650., 404.9, 650.
+   !Config Help  = See Table 2 of Yin et al. (2009) for C4 plants and Medlyn et al. (2002) for C3 plants
+   !Config Units = [ubar]
+   CALL getin_p('KMC25',KmC25)
+
+   !Config Key   = KmO25
+   !Config Desc  = MichaelisâMenten constant of Rubisco for O2 at 25Â°C
+   !Config if    = 
+   !Config Def   = undef, 278400., 278400., 278400., 278400., 278400., 278400., 278400., 278400., 278400., 450000., 278400., 450000.
+   !Config Help  = See Table 2 of Yin et al. (2009) for C4 plants and Medlyn et al. (2002) for C3 plants
+   !Config Units = [ubar]
+   CALL getin_p('KMO25',KmO25)
+
+   !Config Key   = Sco25 
+   !Config Desc  = Relative CO2 /O2 specificity factor for Rubisco at 25Â°C 
+   !Config if    =  
+   !Config Def   = undef, 2800., 2800., 2800., 2800., 2800., 2800., 2800., 2800., 2800., 2590., 2800., 2590. 
+   !Config Help  = See Table 2 of Yin et al. (2009) 
+   !Config Units = [bar bar-1] 
+   CALL getin_p('SCO25',Sco25) 
+    
+   !Config Key   = gm25  
+   !Config Desc  = Mesophyll diffusion conductance at 25Â°C  
+   !Config if    =   
+   !Config Def   = undef, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, undef, 0.4, undef  
+   !Config Help  = See legend of Figure 6 of Yin et al. (2009) and review by Flexas et al. (2008) - gm is not used for C4 plants  
+   !Config Units = [mol m-2 s-1 bar-1]  
+   CALL getin_p('GM25',gm25)   
+
+   !Config Key   = gamma_star25
+   !Config Desc  = Ci-based CO2 compensation point in the absence of Rd at 25Â°C (ubar)
+   !Config if    = 
+   !Config Def   = undef, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75
+   !Config Help  = See Medlyn et al. (2002) for C3 plants - For C4 plants, we use the same value (probably uncorrect)
+   !Config Units = [ubar]
+   CALL getin_p('gamma_star25',gamma_star25)
+
+   !Config Key   = a1
+   !Config Desc  = Empirical factor involved in the calculation of fvpd
+   !Config if    = 
+   !Config Def   = undef, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.72, 0.85, 0.72
+   !Config Help  = See Table 2 of Yin et al. (2009)
+   !Config Units = [-]
+   CALL getin_p('A1',a1)
+
+   !Config Key   = b1
+   !Config Desc  = Empirical factor involved in the calculation of fvpd
+   !Config if    = 
+   !Config Def   = undef, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.20, 0.14, 0.20
+   !Config Help  = See Table 2 of Yin et al. (2009)
+   !Config Units = [-]
+   CALL getin_p('B1',b1)
+
+   !Config Key   = g0
+   !Config Desc  = Residual stomatal conductance when irradiance approaches zero 
+   !Config if    = 
+   !Config Def   = undef, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.01875, 0.00625, 0.01875 
+   !Config Help  = Value from ORCHIDEE - No other reference.
+   !Config Units = [mol mâ2 sâ1 barâ1]
+   CALL getin_p('G0',g0)
+
+   !Config Key   = h_protons
+   !Config Desc  = Number of protons required to produce one ATP
+   !Config if    = 
+   !Config Def   = undef, 4., 4., 4., 4., 4., 4., 4., 4., 4., 4., 4., 4. 
+   !Config Help  = See Table 2 of Yin et al. (2009) - h parameter
+   !Config Units = [mol mol-1]
+   CALL getin_p('H_PROTONS',h_protons)
+
+   !Config Key   = fpsir
+   !Config Desc  = Fraction of PSII eâ transport rate partitioned to the C4 cycle
+   !Config if    = 
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.4, undef, 0.4 
+   !Config Help  = See Table 2 of Yin et al. (2009)
+   !Config Units = [-]
+   CALL getin_p('FPSIR',fpsir)
+
+   !Config Key   = fQ
+   !Config Desc  = Fraction of electrons at reduced plastoquinone that follow the Q-cycle
+   !Config if    = 
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 1., undef, 1.
+   !Config Help  = See Table 2 of Yin et al. (2009) - Values for C3 plants are not used
+   !Config Units = [-]
+   CALL getin_p('FQ',fQ)
+
+   !Config Key   = fpseudo
+   !Config Desc  = Fraction of electrons at PSI that follow pseudocyclic transport 
+   !Config if    = 
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.1, undef, 0.1
+   !Config Help  = See Table 2 of Yin et al. (2009) - Values for C3 plants are not used
+   !Config Units = [-]
+   CALL getin_p('FPSEUDO',fpseudo)
+
+   !Config Key   = kp
+   !Config Desc  = Initial carboxylation efficiency of the PEP carboxylase
+   !Config if    = 
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.7, undef, 0.7
+   !Config Help  = See Table 2 of Yin et al. (2009) 
+   !Config Units = [mol mâ2 sâ1 barâ1]
+   CALL getin_p('KP',kp)
+
+   !Config Key   = alpha
+   !Config Desc  = Fraction of PSII activity in the bundle sheath
+   !Config if    = 
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.1, undef, 0.1
+   !Config Help  = See legend of Figure 6 of Yin et al. (2009)
+   !Config Units = [-]
+   CALL getin_p('ALPHA',alpha)
+
+   !Config Key   = gbs
+   !Config Desc  = Bundle-sheath conductance
+   !Config if    = 
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.003, undef, 0.003
+   !Config Help  = See legend of Figure 6 of Yin et al. (2009)
+   !Config Units = [mol mâ2 sâ1 barâ1]
+   CALL getin_p('GBS',gbs)
+
+   !Config Key   = theta
+   !Config Desc  = Convexity factor for response of J to irradiance
+   !Config if    = 
+   !Config Def   = undef, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7
+   !Config Help  = See Table 2 of Yin et al. (2009)   
+   !Config Units = [â]
+   CALL getin_p('THETA',theta)
+
+   !Config Key   = alpha_LL
+   !Config Desc  = Conversion efficiency of absorbed light into J at strictly limiting light
+   !Config if    = 
+   !Config Def   = undef, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372
+   !Config Help  = See comment from Yin et al. (2009) after eq. 4
+   !Config Units = [mol eâ (mol photon)â1]
+   CALL getin_p('ALPHA_LL',alpha_LL)
+
+   !Config Key   = STRESS_VCMAX 
+   !Config Desc  = Stress on vcmax 
+   !Config if    = OK_SECHIBA or OK_STOMATE 
+   !Config Def   = 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1. 
+   !Config Help  = 
+   !Config Units = [-] 
+   CALL getin_p('STRESS_VCMAX', stress_vcmax) 
+    
+   !Config Key   = STRESS_GS 
+   !Config Desc  = Stress on gs 
+   !Config if    = OK_SECHIBA or OK_STOMATE 
+   !Config Def   = 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. 
+   !Config Help  = 
+   !Config Units = [-] 
+   CALL getin_p('STRESS_GS', stress_gs) 
+    
+   !Config Key   = STRESS_GM 
+   !Config Desc  = Stress on gm 
+   !Config if    = OK_SECHIBA or OK_STOMATE 
+   !Config Def   = 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. 
+   !Config Help  = 
+   !Config Units = [-] 
+   CALL getin_p('STRESS_GM', stress_gm)   
+
+   !Config Key   = EXT_COEFF
+   !Config Desc  = extinction coefficient of the Monsi&Seaki relationship (1953)
+   !Config if    = OK_SECHIBA or OK_STOMATE
+   !Config Def   = .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('EXT_COEFF',ext_coeff)
+
+   !Config Key   = EXT_COEFF_VEGETFRAC
+   !Config Desc  = extinction coefficient used for the calculation of the bare soil fraction 
+   !Config if    = OK_SECHIBA or OK_STOMATE
+   !Config Def   = 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('EXT_COEFF_VEGETFRAC',ext_coeff_vegetfrac)
+  
+   !
+   ! Water-hydrology - sechiba
+   !
+
+   !Config Key   = HYDROL_HUMCSTE
+   !Config Desc  = Root profile
+   !Config Def   = humcste_ref2m or humcste_ref4m depending on zmaxh
+   !Config if    = OK_SECHIBA
+   !Config Help  = See module constantes_mtc for different default values
+   !Config Units = [m]
+   CALL getin_p('HYDROL_HUMCSTE',humcste)
+
+   !
+   ! Soil - vegetation
+   !
+
+   !Config Key   = PREF_SOIL_VEG
+   !Config Desc  = The soil tile number for each vegetation
+   !Config if    = OK_SECHIBA or OK_STOMATE
+   !Config Def   = 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3
+   !Config Help  = Gives the number of the soil tile on which we will
+   !Config         put each vegetation. This allows to divide the hydrological column
+   !Config Units = [-]        
+   CALL getin_p('PREF_SOIL_VEG',pref_soil_veg)
+
+   !
+   ! Vegetation - Age classes
+   !
+
+   !Config Key   = NVMAP
+   !Config Desc  = The number of PFTs if we ignore age classes.  If nagec = 1, this is just nvm.
+   !Config if    = OK_SECHIBA or OK_STOMATE
+   !Config Def   = nvm
+   !Config Help  = Gives the total number of PFTs ignoring age classes.
+   !Config Units = [-]  
+   nvmap=nvm
+   CALL getin_p('NVMAP',nvmap)
+   WRITE(numout,*)'the number of pfts for nvmap used by the model: ',nvmap
+   IF(nagec > 1 .AND. nvmap == nvm)THEN
+      WRITE(numout,*) 'WARNING: The number of age classes is greater than one, but'
+      WRITE(numout,*) '         the input file indicates that none of the PFTs have age classes.'
+      WRITE(numout,*) '         You should change either nagec or nvmap.'
+   ENDIF
+
+   !Config Key   = AGEC_GROUP
+   !Config Desc  = The group that each PFT belongs to.  
+   !Config if    = OK_SECHIBA or OK_STOMATE
+   !Config Def   = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13
+   !Config Help  = The group that each PFT belongs to.  If you are not using age classes, this
+   !Config         is just equal to the number of the PFT.
+   !Config Units = [-]   
+   DO ivm=1,nvm
+      agec_group(ivm)=ivm
+   ENDDO
+   CALL getin_p('AGEC_GROUP',agec_group)
+
+ END SUBROUTINE config_pft_parameters
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_sechiba_pft_parameters
+!!
+!>\BRIEF        This subroutine will read the imposed values for the sechiba pft
+!! parameters. It is not called if IMPOSE_PARAM is set to NO. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE config_sechiba_pft_parameters()
+
+   IMPLICIT NONE
+  
+   !! 0. Variables and parameters declaration
+
+!_ ================================================================================================================================ 
+
+   ! Evapotranspiration -  sechiba
+   !
+   
+   !Config Key   = RSTRUCT_CONST
+   !Config Desc  = Structural resistance 
+   !Config if    = OK_SECHIBA
+   !Config Def   = 0.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0,  2.5,  2.0,  2.0,  2.0
+   !Config Help  =
+   !Config Units = [s/m]
+   CALL getin_p('RSTRUCT_CONST',rstruct_const)
+   
+   !Config Key   = KZERO
+   !Config Desc  = A vegetation dependent constant used in the calculation of the surface resistance.
+   !Config if    = OK_SECHIBA
+   !Config Def   = 0.0, 12.E-5, 12.E-5, 12.e-5, 12.e-5, 25.e-5, 12.e-5,25.e-5, 25.e-5, 30.e-5, 30.e-5, 30.e-5, 30.e-5 
+   !Config Help  =
+   !Config Units = [kg/m^2/s]
+   CALL getin_p('KZERO',kzero)
+   
+   !Config Key   = RVEG_PFT
+   !Config Desc  = Artificial parameter to increase or decrease canopy resistance.
+   !Config if    = OK_SECHIBA
+   !Config Def   = 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.
+   !Config Help  = This parameter is set by PFT.
+   !Config Units = [-]
+   CALL getin_p('RVEG_PFT',rveg_pft)    
+   
+   !
+   ! Water-hydrology - sechiba
+   !
+
+   !Config Key   = WMAX_VEG
+   !Config Desc  = Maximum field capacity for each of the vegetations (Temporary): max quantity of water
+   !Config if    = OK_SECHIBA
+   !Config Def   = 150., 150., 150., 150., 150., 150., 150.,150., 150., 150., 150., 150., 150.
+   !Config Help  =
+   !Config Units = [kg/m^3]
+   CALL getin_p('WMAX_VEG',wmax_veg)
+
+   !Config Key   = PERCENT_THROUGHFALL_PFT
+   !Config Desc  = Percent by PFT of precip that is not intercepted by the canopy. Default value depend on run mode.
+   !Config if    = OK_SECHIBA
+   !Config Def   = Case offline [0. 0. 0....] else [30. 30. 30.....]
+   !Config Help  = During one rainfall event, PERCENT_THROUGHFALL_PFT% of the incident rainfall
+   !Config         will get directly to the ground without being intercepted, for each PFT.
+   !Config Units = [%]
+   CALL getin_p('PERCENT_THROUGHFALL_PFT',throughfall_by_pft)
+   throughfall_by_pft(:) = throughfall_by_pft(:) / 100. 
+   
+   
+   !
+   ! Albedo - sechiba
+   !
+   
+   !Config Key   = SNOWA_AGED
+   !Config Desc  = Minimum snow albedo value for each vegetation type after
+   !aging (dirty old snow)
+   !Config if    = OK_SECHIBA
+   !Config Def   = 0.35, 0., 0., 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.18,
+   !0.18, 0.18, 0.18
+   !Config Help  = Values are from the Thesis of S. Chalita (1992)
+   !Config Units = [-]
+   CALL getin_p('SNOWA_AGED',snowa_aged)
+
+   !Config Key   = SNOWA_DEC
+   !Config Desc  = Decay rate of snow albedo value for each vegetation type
+   !as it will be used in condveg_snow
+   !Config if    = OK_SECHIBA
+   !Config Def   = 0.45, 0.,  0., 0.06, 0.06, 0.11, 0.06, 0.11, 0.11,
+   !0.52,0.52, 0.52, 0.52
+   !Config Help  = Values are from the Thesis of S. Chalita (1992)
+   !Config Units = [-]
+   CALL getin_p('SNOWA_DEC',snowa_dec)
+
+   !
+   !Config Key  = LEAF_SSA_VIS
+   !Config Desc = Leaf_single_scattering_albedo_vis values
+   !Config If   = ALBEDO_TYPE == Pinty
+   !Config Def  = 0.17192, 0.12560, 0.16230, 0.13838, 0.13202, 0.14720,  
+   !              0.14680, 0.14415, 0.15485, 0.17544, 0.17384, 0.17302, 0.17116 
+   !Config Help  =
+   !Config Units = [-]
+   !
+   CALL getin_p('LEAF_SSA_VIS',leaf_ssa(:,ivis))
+!     WRITE(numout,*) 'Single scattering albedo values for the leaves in the VIS spectrum: ',leaf_ssa(:,ivis)
+   !
+   !Config Key  = LEAF_SSA_NIR
+   !Config Desc = Leaf_single_scattering_albedo_nir values
+   !Config If   = ALBEDO_TYPE == Pinty
+   !Config Def  = 0.70253, 0.68189, 0.69684, 0.68778, 0.68356, 0.69533, &
+   !              0.69520, 0.69195, 0.69180, 0.71236, 0.71904, 0.71220, 0.71190
+   !Config Help  =
+   !Config Units = [-]
+   !
+   CALL getin_p('LEAF_SSA_NIR',leaf_ssa(:,inir))
+!     WRITE(numout,*) 'Single scattering albedo values for the leaves in the NIR spectrum: ',leaf_ssa(:,inir)
+   !
+   !Config Key  = LEAF_PSD_VIS
+   !Config Desc = Preferred scattering direction values in the visibile spectra
+   !Config If   = ALBEDO_TYPE == Pinty
+   !Config Def  = 1.00170, 0.96776, 0.99250, 0.97170, 0.97119, 0.98077, &
+   !              0.97672, 0.97810, 0.98605, 1.00490, 1.00360, 1.00320, 1.00130
+   !Config Help  =
+   !Config Units = [-]
+   !
+   CALL getin_p('LEAF_PSD_VIS',leaf_psd(:,ivis))
+!     WRITE(numout,*) 'Preferred scattering direction values for the leaves in the VIS spectrum: ',leaf_psd(:,ivis)
+   !
+   !Config Key  = LEAF_PSD_NIR
+   !Config Desc =  Preferred scattering direction values in the near infrared spectra
+   !Config If   = ALBEDO_TYPE == Pinty
+   !Config Def  = 2.00520, 1.95120, 1.98990, 1.97020, 1.95900, 1.98190, &
+   !              1.98890, 1.97400, 1.97780, 2.02430, 2.03350, 2.02070, 2.02150
+   !Config Help  =
+   !Config Units = [-]
+   !
+   CALL getin_p('LEAF_PSD_NIR',leaf_psd(:,inir)) 
+!     WRITE(numout,*) 'Preferred scattering direction values for the leaves in the NIR spectrum: ',leaf_psd(:,inir)
+   !
+   !
+   !Config Key  = BGRD_REF_VIS
+   !Config Desc = Background reflectance values in the visibile spectra
+   !Config If   = ALBEDO_TYPE == Pinty
+   !Config Def   = 0.2300000,   0.0866667,   0.0800000,   0.0533333,   0.0700000,   0.0933333,   0.0533333,    
+   !               0.0833333,   0.0633333,   0.1033330,   0.1566670,   0.1166670,   0.1200000
+   !Config Help  =
+   !Config Units = [-]
+   !
+   CALL getin_p('BGRD_REF_VIS',bgd_reflectance(:,ivis)) 
+!     WRITE(numout,*) 'Background (soil) reflectance values in the VIS spectrum: ',bgd_reflectance(:,ivis)
+   !
+   !Config Key  = BGRD_REF_NIR
+   !Config Desc = Background reflectance values in the near infrared spectra
+   !Config If   = ALBEDO_TYPE == Pinty
+   !Config Def   = 0.4200000,   0.1500000,   0.1300000,   0.0916667,   0.1066670,   0.1650000,   0.0900000,    
+   !               0.1483330,   0.1066670,   0.1900000,   0.3183330,   0.2200000,   0.2183330
+   !Config Help  =
+   !Config Units = [-]
+   !
+   CALL getin_p('BGRD_REF_NIR',bgd_reflectance(:,inir)) 
+!     WRITE(numout,*) 'Background (soil) reflectance values in the NIR spectrum: ',bgd_reflectance(:,inir)
+   !Config Key  = LEAF_TO_SHOOT_CLUMPING
+   !Config Desc = The leaf-to-shoot clumping factor
+   !Config If   = ALBEDO_TYPE == Pinty
+   !Config Def   = un,   un,   un,   un,   un,   un,   un,   
+   !               un,   un,   un,   un,   un,   un
+   !Config Help  =
+   !Config Units = [-]
+   !
+   CALL getin_p('LEAF_TO_SHOOT_CLUMPING',leaf_to_shoot_clumping(:)) 
+   !
+   !Config Key  = LAI_CORRECTION_FACTOR
+   !Config Desc = The correction factor for the LAI for grasslands 
+   !              and crops (see note in pft_parameters)
+   !Config If   = ALBEDO_TYPE == Pinty
+   !Config Def   = un,   un,   un,   un,   un,   un,   un,   
+   !               un,   un,   un,   un,   un,   un
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('LAI_CORRECTION_FACTOR',lai_correction_factor(:)) 
+
+   !Config Key  = MIN_LEVEL_SEP
+   !Config Desc = The minimum level thickness we use for photosynthesis 
+   !Config If   = ALBEDO_TYPE == Pinty
+   !Config Def   = un,   0.1,   0.1,   0.1,   0.1,   0.1,   0.1,   
+   !               0.1,   0.1,   0.1,   0.1,   0.1,   0.1
+   !Config Help  =
+   !Config Units = [m]
+   CALL getin_p('MIN_LEVEL_SEP',min_level_sep(:)) 
+   
+
+   !Config Key  = LAI_TOP
+   !Config Desc = Definition, in terms of LAI of the top layer 
+   !              (used to calculate one of the resistences of 
+   !              vbeta3) to calculate transpiration 
+   !Config If   = 
+   !Config Def  = un,   0.1,   0.1,   0.1,   0.1,   0.1,   0.1,   
+   !              0.1,   0.1,   0.1,   0.1,   0.1,   0.1
+   !Config Help  =
+   !Config Units = [m2 m2]
+   !
+   CALL getin_p('LAI_TOP',lai_top(:)) 
+
+   !Config Key   = SLA
+   !Config Desc  = specif leaf area 
+   !Config if    = OK_STOMATE
+   !Config Def   = 1.5E-2, 1.53E-2, 2.6E-2, 9.26E-3, 2E-2, 2.6E-2, 9.26E-3, 2.6E-2, 1.9E-2, 2.6E-2, 2.6E-2, 2.6E-2, 2.6E-2
+   !Config Help  =
+   !Config Units = [m^2/gC]
+   CALL getin_p('SLA',sla)
+
+   !Config Key   = SLAINIT
+   !Config Desc  = specif leaf area 
+   !Config if    = OK_STOMATE
+   !Config Def   = 1.5E-2, 1.53E-2, 2.6E-2, 9.26E-3, 2E-2, 2.6E-2, 9.26E-3, 2.6E-2, 1.9E-2, 2.6E-2, 2.6E-2, 2.6E-2, 2.6E-2
+   !Config Help  =
+   !Config Units = [m^2/gC]
+   CALL getin_p('SLAINIT',slainit)
+
+   !Config Key   = EXT_COEFF_N
+   !Config Desc  = Extinction coefficient of the leaf N content profile within the canopy
+   !Config if    = OK_STOMATE
+   !Config Def   =  0.15, 0.15, 0.15,0.15,0.15, 0.15,0.15,0.15,0.15, 0.15, 0.15, 0.15, 0.15
+   !Config Help  =
+   !Config Units = [(m2[ground]) (m-2[leaf])]
+   CALL getin_p('EXT_COEFF_N',ext_coeff_N)
+
+   !Config Key   = NUE_OPT
+   !Config Desc  = Nitrogen use efficiency of Vcmax 
+   !Config if    = OK_STOMATE
+   !Config Def   = undef,  22.,  22., 20., 33.,  33., 20., 33., 22.,  45.,  45.,  60.,  60.  
+   !Config Help  =
+   !Config Units = [(mumol[CO2] s-1) (gN[leaf])-1]
+   CALL getin_p('NUE_OPT',nue_opt)
+
+   !Config Key   = PIPE_DENSITY 
+   !Config Desc  = 
+   !Config if    = 
+   !Config Def   = undef, 3.e5, 3.e5, 2.e5, 3.e5, 3.e5, 2.e5, 3.e5, 2.e5, 2.e5, 2.e5, 2.e5, 2.e5
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("PIPE_DENSITY",pipe_density)
+
+   !Config Key   = TREE_FF
+   !Config Desc  = Tree form factor reducing the volume of a cylinder
+   !               to the real volume of the tree shape (including the 
+   !               branches)
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 0.6, 0.6, 0.6, 0.6, 0.6, 0.8, 0.8, 0.8, 0., 0., 0., 0.
+   !Config Help  = 
+   !Config Units = [-]  
+   CALL getin_p('TREE_FF',tree_ff)
+   
+   !Config Key   = PIPE_TUNE1
+   !Config Desc  = crown area = pipe_tune1. stem diameter**pipe_tune_exp_coeff (Reinicke's theory)
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 100., 100., 100., 100., 100., 100., 100., 100., 0., 0., 0., 0. 
+   !Config Help  = 
+   !Config Units = [-]    
+   CALL getin_p('PIPE_TUNE1',pipe_tune1)
+
+   !Config Key   = PIPE_TUNE2 
+   !Config Desc  = height=pipe_tune2 * diameter**pipe_tune3
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 40., 40., 40., 40., 40., 40., 40., 40., 0., 0., 0., 0.  
+   !Config Help  = 
+   !Config Units = [-]      
+   CALL getin_p('PIPE_TUNE2',pipe_tune2) 
+   
+   !Config Key   = PIPE_TUNE3
+   !Config Desc  = height=pipe_tune2 * diameter**pipe_tune3
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0., 0., 0., 0.   
+   !Config Help  = 
+   !Config Units = [-]    
+   CALL getin_p('PIPE_TUNE3',pipe_tune3)
+
+   !Config Key   = PIPE_TUNE_EXP_COEFF 
+   !Config Desc  = pipe tune exponential coeff 
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 1.6, 1.6, 1.6, 1.6, 1.6, 1.6, 1.6, 1.6, 0., 0., 0., 0.  
+   !Config Help  = 
+   !Config Units = [-]   
+   CALL getin_p('PIPE_TUNE_EXP_COEFF',pipe_tune_exp_coeff)
+
+   !Config Key   = LAI_TO_HEIGHT
+   !Config Desc  = Convertion factor from lai to vegetation height for grasses and crops
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 
+   !Config Help  = undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.2, 0.5, 0.2, 0.5
+   !Config Units = [m m2 m-2] 
+   CALL getin_p('LAI_TO_HEIGHT',lai_to_height)
+
+   !
+   ! Hydraulic architecture
+   !
+   !Config Key   = K_ROOT
+   !Config Desc  = Fine root specific conductivity
+   !Config if    = OK_STOMATE
+   !Config Def   = (undef, 4., 4., 4., 4., 4., 4., 4., 4., 50., 50., 50., 50.)*1.e-7 
+   !Config Help  =
+   !Config Units = [m^{3} kg^{-1} s^{-1} MPa^{-1}] 
+   CALL getin_p('K_ROOT',k_root) 
+ 
+   !Config Key   = K_SAP
+   !Config Desc  = Sapwood specific conductivity
+   !Config if    = OK_STOMATE
+   !Config Def   = (undef, 50., 10., 8., 5., 30., 8., 20., 8., undef, undef, undef, undef)*1.e-4
+   !Config Help  =
+   !Config Units = [m^{2} s^{-1} MPa^{-1}] 
+   CALL getin_p('K_SAP',k_sap)
+
+   !Config Key   = K_LEAF
+   !Config Desc  = Leaf conductivity
+   !Config if    = OK_STOMATE
+   !Config Def   = (undef, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5)*1.e-7
+   !Config Help  =
+   !Config Units = [m s^{-1} MPa^{-1})] 
+   CALL getin_p('K_LEAF',k_leaf)
+
+   !Config Key   = PSI_LEAF
+   !Config Desc  = Minimal leaf potential
+   !Config if    = OK_STOMATE, 11-LAYERS, FUNCTIONAL ALLOCATION
+   !Config Def   = undef, -2.2, -2.2, -2.2, -3.5, -2.2, -2.2, -2.2, -2.2, -2.2, -2.2, -2.2, -2.2
+   !Config Help  =
+   !Config Units = [MPa] 
+   CALL getin_p('PSI_LEAF',psi_leaf)
+
+   !Config Key   = PSI_50
+   !Config Desc  = Sapwood leaf water potential that causes 50% loss of xylem conductivity through cavitation
+   !Config if    = OK_STOMATE, 11-LAYERS, FUNCTIONAL ALLOCATION
+   !Config Def   = undef, -0.3, -1.3, -2.0, -1.7, -1.0, -2.0, -1.0, -2.0, undef, undef, undef, undef
+   !Config Help  =
+   !Config Units = [m s^{-1} MPa^{-1})] 
+   CALL getin_p('PSI_50',psi_50)      
+   
+   !Config Key   = C_CAVITATION
+   !Config Desc  = Shape parameter for loss of conductance
+   !Config if    = OK_STOMATE, 11-LAYERS, FUNCTIONAL ALLOCATION
+   !Config Def   = undef, 5., 3., 3., 3., 3., 3., 3., 3., undef, undef, undef, undef  
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('C_CAVITATION',c_cavitation)
+
+   !Config Key   = PSI_SOIL_TUNE
+   !Config Desc  = Additive tuning parameter to account for soil-root interactions
+   !Config if    = OK_STOMATE, 11-LAYERS, FUNCTIONAL ALLOCATION, HYDRAOL_ARCHITECTURE
+   !Config Def   = undef, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. 
+   !Config Help  =
+   !Config Units = [MPa] 
+   CALL getin_p('PSI_SOIL_TUNE',psi_soil_tune)
+
+   !Config Key   = SRL
+   !Config Desc  = Specific root length to use in the calculations of soil to
+   !Config Desc    root resistance.
+   !Config if    = OK_STOMATE, 11-LAYERS, FUNCTIONAL ALLOCATION,
+   !Config if      HYDRAOL_ARCHITECTURE, OK_SOIL_ROOT
+   !Config Def   = undef, 10., 10., 9.2, 9.2, 14., 18.3, 18.3, 18.3, undef, undef, undef, undef 
+   !Config Help  =
+   !Config Units = [m g^(-1)] 
+   CALL getin_p('SRL',srl)
+
+   !Config Key   = R_FROOT
+   !Config Desc  = Fine root radius to use in the calculations of soil to root
+   !Config Desc    resistance
+   !Config if    = OK_STOMATE, 11-LAYERS, FUNCTIONAL ALLOCATION,
+   !Config if      HYDRAOL_ARCHITECTURE, OK_SOIL_ROOT
+   !Config Def   = undef,  0.29E-3, 0.29E-3,  0.29E-3,  0.29E-3, 0.29E-3,  0.24E-3, 
+   !Config DEF     0.21E-3,  0.21E-3, undef, undef,  undef,  undef /)
+   !Config Help  =
+   !Config Units = [m] 
+   CALL getin_p('R_FROOT',r_froot)
+
+   !Config Key   = PSI_ROOT
+   !Config Desc  = Minimum root water potential to use in the calculations of 
+   !Config Desc    soil to root resistance.
+   !Config if    = OK_STOMATE, 11-LAYERS, FUNCTIONAL ALLOCATION,
+   !Config if      HYDRAOL_ARCHITECTURE, OK_SOIL_ROOT
+   !Config Def   = undef, -4., -4., -4., -4., -4., -4., -4., -4., undef,
+   !undef, undef, undef 
+   !Config Help  =
+   !Config Units = [MPa] 
+   CALL getin_p('PSI_ROOT',psi_root)
+
+
+   IF ( ok_bvoc ) THEN
+      !
+      ! BVOC
+      !
+
+      !Config Key   = ISO_ACTIVITY
+      !Config Desc  = Biogenic activity for each age class : isoprene
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0.5, 1.5, 1.5, 0.5
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('ISO_ACTIVITY',iso_activity)
+
+      !Config Key   = METHANOL_ACTIVITY
+      !Config Desc  = Isoprene emission factor for each age class : methanol
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 1., 1., 0.5, 0.5
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('METHANOL_ACTIVITY',methanol_activity)
+
+      !Config Key   = EM_FACTOR_ISOPRENE
+      !Config Desc  = Isoprene emission factor
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 24., 24., 8., 16., 45., 8., 18., 0.5, 12., 18., 5., 5.
+      !Config Help  =
+      !Config Units = [ugC/g/h] 
+      CALL getin_p('EM_FACTOR_ISOPRENE',em_factor_isoprene)
+
+      !Config Key   = EM_FACTOR_MONOTERPENE
+      !Config Desc  = Monoterpene emission factor 
+      !Config if    = CHEMISTRY_BVOC 
+      !Config Def   = 0., 2.0, 2.0, 1.8, 1.4, 1.6, 1.8, 1.4, 1.8, 0.8, 0.8,  0.22, 0.22
+      !Config Help  =
+      !Config Units = [ugC/g/h] 
+      CALL getin_p('EM_FACTOR_MONOTERPENE',em_factor_monoterpene)
+
+      !Config Key   = C_LDF_MONO 
+      !Config Desc  = Monoterpenes fraction dependancy to light
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0.6
+      !Config Help  =
+      !Config Units = []
+      CALL getin_p('C_LDF_MONO',LDF_mono)
+
+      !Config Key   = C_LDF_SESQ 
+      !Config Desc  = Sesquiterpenes fraction dependancy to light
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0.5
+      !Config Help  =
+      !Config Units = []
+      CALL getin_p('C_LDF_SESQ',LDF_sesq)
+
+      !Config Key   = C_LDF_METH 
+      !Config Desc  = Methanol fraction dependancy to light
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0.8
+      !Config Help  =
+      !Config Units = []
+      CALL getin_p('C_LDF_METH',LDF_meth)
+
+      !Config Key   = C_LDF_ACET 
+      !Config Desc  = Acetone fraction dependancy to light
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0.2
+      !Config Help  =
+      !Config Units = []
+      CALL getin_p('C_LDF_ACET',LDF_acet)
+
+      !Config Key   = EM_FACTOR_APINENE 
+      !Config Desc  = Alfa pinene  emission factor 
+      !Config if    = CHEMISTRY_BVOC 
+      !Config Def   = 0., 1.35, 1.35, 0.85, 0.95, 0.75, 0.85, 0.60, 1.98, 0.30, 0.30, 0.09, 0.09
+      !Config Help  =
+      !Config Units = [ugC/g/h] 
+      CALL getin_p('EM_FACTOR_APINENE',em_factor_apinene)
+
+      !Config Key   = EM_FACTOR_BPINENE
+      !Config Desc  = Beta pinene  emission factor
+      !Config if    = CHEMISTRY_BVOC 
+      !Config Def   = 0., 0.30, 0.30, 0.35, 0.25, 0.20, 0.35, 0.12, 0.45, 0.16, 0.12, 0.05, 0.05
+      !Config Help  =
+      !Config Units = [ugC/g/h] 
+      CALL getin_p('EM_FACTOR_BPINENE',em_factor_bpinene)
+
+      !Config Key   = EM_FACTOR_LIMONENE
+      !Config Desc  = Limonene  emission factor
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 0.25, 0.25, 0.20, 0.25, 0.14, 0.20, 0.135, 0.11, 0.19, 0.42, 0.03, 0.03
+      !Config Help  =
+      !Config Units = [ugC/g/h] 
+      CALL getin_p('EM_FACTOR_LIMONENE',em_factor_limonene)
+
+      !Config Key   = EM_FACTOR_MYRCENE
+      !Config Desc  = Myrcene  emission factor
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 0.20, 0.20, 0.12, 0.11, 0.065, 0.12, 0.036, 0.075, 0.08,  0.085, 0.015, 0.015
+      !Config Help  =
+      !Config Units = [ugC/g/h] 
+      CALL getin_p('EM_FACTOR_MYRCENE',em_factor_myrcene)
+
+      !Config Key   = EM_FACTOR_SABINENE
+      !Config Desc  = Sabinene  emission factor
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 0.20, 0.20, 0.12, 0.17, 0.70, 0.12, 0.50, 0.09, 0.085, 0.075, 0.02, 0.02
+      !Config Help  =
+      !Config Units = [ugC/g/h] 
+      CALL getin_p('EM_FACTOR_SABINENE',em_factor_sabinene)
+
+      !Config Key   = EM_FACTOR_CAMPHENE 
+      !Config Desc  = Camphene  emission factor 
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 0.15, 0.15, 0.10, 0.10, 0.01, 0.10, 0.01, 0.07, 0.07, 0.08, 0.01, 0.01
+      !Config Help  =
+      !Config Units = [ugC/g/h] 
+      CALL getin_p('EM_FACTOR_CAMPHENE',em_factor_camphene)
+
+      !Config Key   = EM_FACTOR_3CARENE 
+      !Config Desc  = 3-Carene  emission factor
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 0.13, 0.13, 0.42, 0.02, 0.055, 0.42,0.025, 0.125, 0.085, 0.085, 0.065, 0.065
+      !Config Help  =
+      !Config Units = [ugC/g/h] 
+      CALL getin_p('EM_FACTOR_3CARENE',em_factor_3carene)
+
+      !Config Key   = EM_FACTOR_TBOCIMENE
+      !Config Desc  = T-beta-ocimene  emission factor
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 0.25, 0.25, 0.13, 0.09, 0.26, 0.13, 0.20, 0.085, 0.18, 0.18, 0.01, 0.01
+      !Config Help  =
+      !Config Units = [ugC/g/h] 
+      CALL getin_p('EM_FACTOR_TBOCIMENE', em_factor_tbocimene)
+
+      !Config Key   = EM_FACTOR_OTHERMONOT
+      !Config Desc  = Other monoterpenes  emission factor
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 0.17, 0.17, 0.11, 0.11, 0.125, 0.11, 0.274, 0.01, 0.15, 0.155, 0.035, 0.035
+      !Config Help  =
+      !Config Units = [ugC/g/h] 
+      CALL getin_p('EM_FACTOR_OTHERMONOT',em_factor_othermonot)
+
+      !Config Key   = EM_FACTOR_SESQUITERP 
+      !Config Desc  = Sesquiterpenes  emission factor 
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 0.45, 0.45, 0.13, 0.3, 0.36, 0.15, 0.3, 0.25, 0.6, 0.6, 0.08, 0.08
+      !Config Help  =
+      !Config Units = [ugC/g/h] 
+      CALL getin_p('EM_FACTOR_SESQUITERP',em_factor_sesquiterp)
+
+      !Config Key   = C_BETA_MONO 
+      !Config Desc  = Monoterpenes temperature dependency coefficient
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0.1
+      !Config Help  =
+      !Config Units = []
+      CALL getin_p('C_BETA_MONO',beta_mono)
+
+      !Config Key   = C_BETA_SESQ 
+      !Config Desc  = Sesquiterpenes temperature dependency coefficient
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0.17
+      !Config Help  =
+      !Config Units = []
+      CALL getin_p('C_BETA_SESQ',beta_sesq)
+
+      !Config Key   = C_BETA_METH 
+      !Config Desc  = Methanol temperature dependency coefficient
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0.08
+      !Config Help  =
+      !Config Units = []
+      CALL getin_p('C_BETA_METH',beta_meth)
+
+      !Config Key   = C_BETA_ACET 
+      !Config Desc  = Acetone temperature dependency coefficient
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0.1
+      !Config Help  =
+      !Config Units = []
+      CALL getin_p('C_BETA_ACET',beta_acet)
+
+      !Config Key   = C_BETA_OXYVOC 
+      !Config Desc  = Other oxygenated BVOC temperature dependency coefficient
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0.13
+      !Config Help  =
+      !Config Units = []
+      CALL getin_p('C_BETA_OXYVOC',beta_oxyVOC)
+
+      !Config Key   = EM_FACTOR_ORVOC
+      !Config Desc  = ORVOC emissions factor 
+      !Config if    = CHEMISTRY_BVOC 
+      !Config Def   = 0., 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5
+      !Config Help  =
+      !Config Units = [ugC/g/h]  
+      CALL getin_p('EM_FACTOR_ORVOC',em_factor_ORVOC)
+
+      !Config Key   = EM_FACTOR_OVOC
+      !Config Desc  = OVOC emissions factor
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5
+      !Config Help  =
+      !Config Units = [ugC/g/h]        
+      CALL getin_p('EM_FACTOR_OVOC',em_factor_OVOC)
+
+      !Config Key   = EM_FACTOR_MBO
+      !Config Desc  = MBO emissions factor 
+      !Config if    = CHEMISTRY_BVOC 
+      !Config Def   = 0., 2.e-5, 2.e-5, 1.4, 2.e-5, 2.e-5, 0.14, 2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5
+      !Config Help  =
+      !Config Units = [ugC/g/h]  
+      CALL getin_p('EM_FACTOR_MBO',em_factor_MBO)
+
+      !Config Key   = EM_FACTOR_METHANOL
+      !Config Desc  = Methanol emissions factor 
+      !Config if    = CHEMISTRY_BVOC 
+      !Config Def   = 0., 0.8, 0.8, 1.8, 0.9, 1.9, 1.8, 1.8, 1.8, 0.7, 0.9, 2., 2.
+      !Config Help  =
+      !Config Units = [ugC/g/h]  
+      CALL getin_p('EM_FACTOR_METHANOL',em_factor_methanol)
+
+      !Config Key   = EM_FACTOR_ACETONE
+      !Config Desc  = Acetone emissions factor
+      !Config if    = CHEMISTRY_BVOC 
+      !Config Def   = 0., 0.25, 0.25, 0.3, 0.2, 0.33, 0.3, 0.25, 0.25, 0.2, 0.2, 0.08, 0.08
+      !Config Help  =
+      !Config Units = [ugC/g/h]     
+      CALL getin_p('EM_FACTOR_ACETONE',em_factor_acetone)
+
+      !Config Key   = EM_FACTOR_ACETAL
+      !Config Desc  = Acetaldehyde emissions factor 
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 0.2, 0.2, 0.2, 0.2, 0.25, 0.25, 0.16, 0.16, 0.12, 0.12, 0.035, 0.02
+      !Config Help  =
+      !Config Units = [ugC/g/h]  
+      CALL getin_p('EM_FACTOR_ACETAL',em_factor_acetal)
+
+      !Config Key   = EM_FACTOR_FORMAL
+      !Config Desc  = Formaldehyde emissions factor
+      !Config if    = CHEMISTRY_BVOC 
+      !Config Def   = 0., 0.04, 0.04, 0.08, 0.04, 0.04, 0.04, 0.04, 0.04, 0.025, 0.025, 0.013, 0.013
+      !Config Help  = 
+      !Config Units = [ugC/g/h]  
+      CALL getin_p('EM_FACTOR_FORMAL',em_factor_formal)
+
+      !Config Key   = EM_FACTOR_ACETIC
+      !Config Desc  = Acetic Acid emissions factor
+      !Config if    = CHEMISTRY_BVOC 
+      !Config Def   = 0., 0.025, 0.025,0.025,0.022,0.08,0.025,0.022,0.013,0.012,0.012,0.008,0.008
+      !Config Help  =
+      !Config Units = [ugC/g/h]  
+      CALL getin_p('EM_FACTOR_ACETIC',em_factor_acetic)
+
+      !Config Key   = EM_FACTOR_FORMIC
+      !Config Desc  = Formic Acid emissions factor
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 0.015, 0.015, 0.02, 0.02, 0.025, 0.025, 0.015, 0.015,0.010,0.010,0.008,0.008
+      !Config Help  =
+      !Config Units = [ugC/g/h]  
+      CALL getin_p('EM_FACTOR_FORMIC',em_factor_formic)
+
+      !Config Key   = EM_FACTOR_NO_WET
+      !Config Desc  = NOx emissions factor wet soil emissions and exponential dependancy factor 
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 2.6, 0.06, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.36, 0.36, 0.36, 0.36
+      !Config Help  =
+      !Config Units = [ngN/m^2/s]
+      CALL getin_p('EM_FACTOR_NO_WET',em_factor_no_wet)
+
+      !Config Key   = EM_FACTOR_NO_DRY
+      !Config Desc  = NOx emissions factor dry soil emissions and exponential dependancy factor 
+      !Config if    = CHEMISTRY_BVOC
+      !Config Def   = 0., 8.60, 0.40, 0.22, 0.22, 0.22, 0.22, 0.22, 0.22, 2.65, 2.65, 2.65, 2.65
+      !Config Help  =
+      !Config Units = [ngN/m^2/s] 
+      CALL getin_p('EM_FACTOR_NO_DRY',em_factor_no_dry)
+
+      !Config Key   = LARCH
+      !Config Desc  = Larcher 1991 SAI/LAI ratio
+      !Config if    = CHEMISTRY_BVOC 
+      !Config Def   = 0., 0.015, 0.015, 0.003, 0.005, 0.005, 0.003, 0.005, 0.003, 0.005, 0.005, 0.008, 0.008
+      !Config Help  =
+      !Config Units = [-]  
+      CALL getin_p('LARCH',Larch)
+      
+   ENDIF ! (ok_bvoc)
+
+ END SUBROUTINE config_sechiba_pft_parameters
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_stomate_pft_parameters 
+!!
+!>\BRIEF         This subroutine will read the imposed values for the stomate pft
+!! parameters. It is not called if IMPOSE_PARAM is set to NO.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE config_stomate_pft_parameters
+
+   IMPLICIT NONE
+   
+   !! 0. Variables and parameters declaration
+
+   !! 0.4 Local variable
+   INTEGER(i_std)  ::  ivma, ivm             !! indices for number of pfts with and without age classes
+
+!_ ================================================================================================================================
+
+   ! Vegetation structure
+   !
+   !Config Key   = IS_TROPICAL
+   !Config Desc  = PFT IS TROPICAL 
+   !Config if    = OK_STOMATE
+   !Config Def   = FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('IS_TROPICAL',is_tropical)
+
+   !Config Key   = IS_TEMPERATE
+   !Config Desc  = PFT IS TEMPERATE 
+   !Config if    = OK_STOMATE
+   !Config Def   = FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE 
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('IS_TEMPERATE',is_temperate)
+
+   !Config Key   = IS_BOREAL
+   !Config Desc  = PFT IS BOREAL 
+   !Config if    = OK_STOMATE
+   !Config Def   = FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE 
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('IS_BOREAL',is_boreal)
+
+   !Config Key   = AVAILABILITY_FACT 
+   !Config Desc  = Calculate dynamic mortality in lpj_gap, pft dependent parameter
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 0.14, 0.14, 0.10, 0.10, 0.10, 0.05, 0.05, 0.05, undef, undef, undef, undef 
+   !Config Help  = 
+   !Config Units = [-]   
+   CALL getin_p('AVAILABILITY_FACT',availability_fact)
+
+   !
+   ! Respiration - stomate
+   !
+
+   !Config Key   = FRAC_GROWTHRESP
+   !Config Desc  = fraction of GPP which is lost as growth respiration
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, .28, .28, .28, .28, .28, .28, .28, .28, .28, .28, .28, .28 
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('FRAC_GROWTHRESP',frac_growthresp) 
+
+   !Config Key   = MAINT_RESP_SLOPE_C
+   !Config Desc  = slope of maintenance respiration coefficient (1/K), constant c of aT^2+bT+c , tabulated
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, .20, .20, .16, .16, .16, .16, .16, .16, .16, .12, .16, .12 
+   !Config Help  = Offset of the temperature quadratic function that determines the 
+   !Config         slope of the function between temperature and maintenance respiration.
+   !Config Units = [-]
+   CALL getin_p('MAINT_RESP_SLOPE_C',maint_resp_slope_c)
+
+   !Config Key   = MAINT_RESP_SLOPE_B
+   !Config Desc  = slope of maintenance respiration coefficient (1/K), constant b of aT^2+bT+c , tabulated
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, .0, .0, .0, .0, .0, .0, .0, .0, -.00133, .0, -.00133, .0 
+   !Config Help  = b coefficient of the temperature quadratic function that determines the 
+   !Config         slope of the function between temperature and maintenance respiration.
+   !Config Units = [-]
+   CALL getin_p('MAINT_RESP_SLOPE_B',maint_resp_slope_b)
+
+   !Config Key   = MAINT_RESP_SLOPE_A
+   !Config Desc  = slope of maintenance respiration coefficient (1/K), constant a of aT^2+bT+c , tabulated
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0    
+   !Config Help  = a coefficient of the temperature quadratic function that determines the 
+   !Config         slope of the function between temperature and maintenance respiration.
+   !Config Units = [-]
+   CALL getin_p('MAINT_RESP_SLOPE_A',maint_resp_slope_a)
+
+   !Config Key   = COEFF_MAINT_INIT
+   !Config Desc  = maintenance respiration coefficient at 10 deg C
+   !Config if    = OK_STOMATE
+   !Config Def   =   &  undef, 1.81E-2, 1.81E-2, 3.84E-2, 3.84E-2, 3.84E-2, 3.84E-2, 3.84E-2,   3.84E-2,   3.84E-2,   2.74E-2,   3.84E-2,   2.74E-2  /)            !Config Help  =
+   !Config Units = [gC/gN/day]
+   CALL getin_p('COEFF_MAINT_INIT',coeff_maint_init)
+
+   !Config Key   = TREF_MAINT_RESP
+   !Config Desc  = maintenance respiration Temperature coefficient
+   !Config if    = OK_STOMATE
+   !Config Def   =   &  undef, 56.02, 56.02, 56.02, 56.02, 56.02, 56.02, 56.02, 56.02, 56.02, 56.02, 56.02, 56.02  /)   
+   !Config Help  =
+   !Config Units = [degC]
+   CALL getin_p('TREF_MAINT_RESP',tref_maint_resp)
+
+   !Config Key   = TMIN_MAINT_RESP
+   !Config Desc  = maintenance respiration Temperature coefficient
+   !Config if    = OK_STOMATE
+   !Config Def   =   &  undef, 46.02, 46.02, 46.02, 46.02, 46.02, 46.02, 46.02, 46.02, 46.02, 46.02, 46.02, 46.02  /)   
+   !Config Help  =
+   !Config Units = [degC]
+   CALL getin_p('TMIN_MAINT_RESP',tmin_maint_resp)
+
+   !Config Key   = E0_MAINT_RESP
+   !Config Desc  = maintenance respiration Temperature coefficient
+   !Config if    = OK_STOMATE
+   !Config Def   =   &  undef, 308.56, 308.56, 308.56, 308.56, 308.56, 308.56, 308.56, 308.56, 308.56, 308.56, 308.56, 308.56  /)   
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('E0_MAINT_RESP',e0_maint_resp)
+
+   
+   !
+   ! Fire - stomate
+   !
+
+   !Config Key   = FLAM
+   !Config Desc  = flamability: critical fraction of water holding capacity
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, .15, .25, .25, .25, .25, .25, .25, .25, .25, .25, .35, .35
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('FLAM',flam)
+
+   !Config Key   = RESIST
+   !Config Desc  = fire resistance
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, .95, .90, .12, .50, .12, .12, .12, .12, .0, .0, .0, .0 
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('RESIST',resist)
+  
+   !
+   ! Flux - LUC
+   !
+   !Config Key   = COEFF_LCCHANGE_1
+   !Config Desc  = Coeff of biomass export for the year
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 0.897, 0.897, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597 
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('COEFF_LCCHANGE_1',coeff_lcchange_1)
+
+   !Config Key   = COEFF_LCCHANGE_10
+   !Config Desc  = Coeff of biomass export for the decade
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 0.103, 0.103, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.403, 0.299, 0.403
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('COEFF_LCCHANGE_10',coeff_lcchange_10)
+
+   !Config Key   = COEFF_LCCHANGE_100
+   !Config Desc  = Coeff of biomass export for the century
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 0., 0., 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0., 0.104, 0.
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('COEFF_LCCHANGE_100',coeff_lcchange_100)
+   
+         !
+   ! Flux - LUC
+   !
+   !Config Key   = COEFF_LCCHANGE_s
+   !Config Desc  = Coeff of biomass export for the year
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 0.897, 0.897, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597 
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('COEFF_LCCHANGE_s',coeff_lcchange_s)
+
+   !Config Key   = COEFF_LCCHANGE_m
+   !Config Desc  = Coeff of biomass export for the decade
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 0.103, 0.103, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.403, 0.299, 0.403
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('COEFF_LCCHANGE_m',coeff_lcchange_m)
+
+   !Config Key   = COEFF_LCCHANGE_l
+   !Config Desc  = Coeff of biomass export for the century
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 0., 0., 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0., 0.104, 0.
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('COEFF_LCCHANGE_l',coeff_lcchange_l)
+
+   !
+   ! Phenology
+   !
+
+   !Config Key   = LAI_MAX_TO_HAPPY
+   !Config Desc  = threshold of LAI below which plant uses carbohydrate reserves
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5 
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('LAI_MAX_TO_HAPPY',lai_max_to_happy) 
+
+   !Config Key   = LAI_MAX
+   !Config Desc  = maximum LAI, PFT-specific
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 7., 7., 5., 5., 5., 4.5, 4.5, 3.0, 2.5, 2.5, 5.,5. 
+   !Config Help  =
+   !Config Units = [m^2/m^2]
+   CALL getin_p('LAI_MAX',lai_max)
+
+   !Config Key   = PHENO_TYPE
+   !Config Desc  = type of phenology, 0=bare ground 1=evergreen,  2=summergreen,  3=raingreen,  4=perennial
+   !Config if    = OK_STOMATE
+   !Config Def   = 0, 1, 3, 1, 1, 2, 1, 2, 2, 4, 4, 2, 3
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('PHENO_TYPE',pheno_type)
+
+   !
+   ! Phenology : Leaf Onset
+   !
+
+   !Config Key   = PHENO_GDD_CRIT_C
+   !Config Desc  = critical gdd, tabulated (C), constant c of aT^2+bT+c
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, 270., 400., 125., 400.
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('PHENO_GDD_CRIT_C',pheno_gdd_crit_c)
+
+   !Config Key   = PHENO_GDD_CRIT_B
+   !Config Desc  = critical gdd, tabulated (C), constant b of aT^2+bT+c
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef,undef, undef, 6.25, 0., 0., 0.
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('PHENO_GDD_CRIT_B',pheno_gdd_crit_b)
+
+   !Config Key   = PHENO_GDD_CRIT_A
+   !Config Desc  = critical gdd, tabulated (C), constant a of aT^2+bT+c
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.03125,  0., 0., 0.
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('PHENO_GDD_CRIT_A',pheno_gdd_crit_a)
+
+   !Config Key   = PHENO_MOIGDD_T_CRIT
+   !Config Desc  = Average temperature threashold for C4 grass used in pheno_moigdd
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 22.0, undef, undef
+   !Config Help  =
+   !Config Units = [C]
+   CALL getin_p('PHENO_MOIGDD_T_CRIT',pheno_moigdd_t_crit)
+
+   !Config Key   = NGD_CRIT
+   !Config Desc  = critical ngd, tabulated. Threshold -5 degrees
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, 0., undef, undef, undef, undef, undef
+   !Config Help  = NGD : Number of Growing Days.
+   !Config Units = [days]
+   CALL getin_p('NGD_CRIT',ngd_crit)
+
+   !Config Key   = NCDGDD_TEMP
+   !Config Desc  = critical temperature for the ncd vs. gdd function in phenology
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, undef, undef, undef, 5., undef, 0., undef, undef, undef, undef, undef
+   !Config Help  =
+   !Config Units = [C] 
+   CALL getin_p('NCDGDD_TEMP',ncdgdd_temp)
+
+   !Config Key   = HUM_FRAC
+   !Config Desc  = critical humidity (relative to min/max) for phenology
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, .5, undef, undef, undef, undef, undef,  undef, .5, .5, .5,.5     
+   !Config Help  =
+   !Config Units = [%]
+   CALL getin_p('HUM_FRAC',hum_frac)
+
+   !Config Key   = HUM_MIN_TIME
+   !Config Desc  = minimum time elapsed since moisture minimum
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, 50., undef, undef, undef, undef, undef, undef, 35., 35., 75., 75.
+   !Config Help  =
+   !Config Units = [days]
+   CALL getin_p('HUM_MIN_TIME',hum_min_time)
+
+   !Config Key   = TAU_SAP
+   !Config Desc  = sapwood -> heartwood conversion time
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 730., 730., 730., 730., 730., 730., 730., 730., undef, undef, undef, undef
+   !Config Help  =
+   !Config Units = [days]
+   CALL getin_p('TAU_SAP',tau_sap)
+
+   !Config Key   = TAU_LEAF
+   !Config Desc  = leaf longivety
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 730., 180., 910., 730., 180., 910., 180., 180., 120., 120., 90., 90. 
+   !Config Help  =
+   !Config Units = [days]
+   CALL getin_p('TAU_LEAF',tau_leaf)
+
+   !Config Key   = TAU_LEAFINIT
+   !Config Desc  = time to attain the initial foliage using the carbohydrate reserve
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 10., 10., 10., 10., 10., 10., 10., 10., 10., 10., 10., 10.
+   !Config Help  =
+   !Config Units = [days]
+   CALL getin_p('TAU_LEAFINIT',tau_leafinit) 
+
+   !Config Key   = TAU_FRUIT
+   !Config Desc  = fruit lifetime
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 90., 90., 90., 90., 90., 90., 90., 90., undef, undef, undef, undef
+   !Config Help  =
+   !Config Units = [days]
+   CALL getin_p('TAU_FRUIT',tau_fruit)
+
+   !Config Key   = TAU_ROOT
+   !Config Desc  = root longivety
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 256., 256., 256., 256., 256., 256., 256., 256., 256., 256., 256., 256.
+   !Config Help  =
+   !Config Units = [days]
+   CALL getin_p('TAU_ROOT',tau_root)
+
+   !Config Key   = ECUREUIL
+   !Config Desc  = fraction of primary leaf and root allocation put into reserve
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, .0, 1., .0, .0, 1., .0, 1., 1., 1., 1., 1., 1.
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('ECUREUIL',ecureuil)
+
+   !Config Key   = ALLOC_MIN
+   !Config Desc  = minimum allocation above/below = f(age) - 30/01/04 NV/JO/PF
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, undef, undef, undef, undef 
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('ALLOC_MIN',alloc_min)
+
+   !Config Key   = ALLOC_MAX
+   !Config Desc  = maximum allocation above/below = f(age) - 30/01/04 NV/JO/PF
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, undef, undef, undef, undef
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('ALLOC_MAX',alloc_max)
+
+   !Config Key   = DEMI_ALLOC 
+   !Config Desc  = mean allocation above/below = f(age) - 30/01/04 NV/JO/PF
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 5., 5., 5., 5., 5., 5., 5., 5., undef, undef, undef, undef
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('DEMI_ALLOC',demi_alloc)
+
+   !Config Key   = LEAFLIFE_TAB
+   !Config Desc  = leaf longevity
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, .5, 2., .33, 1., 2., .33, 2., 2., 2., 2., 2., 2. 
+   !Config Help  =
+   !Config Units = [years]
+   CALL getin_p('LEAFLIFE_TAB',leaflife_tab)
+
+   !Config Key   = K_LATOSA_MAX
+   !Config Desc  = Maximum leaf-to-sapwood area ratio
+   !Config if    = OK_STOMATE
+   !Config Def   = (undef, 5., 5., 5., 3., 5., 5., 5., 5., undef, undef, undef, undef)*1.e3
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('K_LATOSA_MAX',k_latosa_max)
+   
+   !Config Key   = K_LATOSA_MIN
+   !Config Desc  = Minimum leaf-to-sapwood area ratio
+   !Config if    = OK_STOMATE
+   !Config Def   = (undef, 5., 5., 5., 3., 5., 5., 5., 5., undef, undef, undef, undef)*1.e3
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('K_LATOSA_MIN',k_latosa_min)
+
+
+   !
+   ! SOM decomposition (stomate)
+   !
+   !Config Key   = LC_leaf 
+   !Config Desc  = Lignine/C ratio of leaf pool
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 0.18, 0.18, 0.24, 0.18, 0.18, 0.24, 0.18, 0.24, 0.09, 0.09, 0.09, 0.09
+   !Config Help  = 
+   !Config Units = [-]   
+   CALL getin_p('LC_leaf',LC_leaf)
+
+   !Config Key   = LC_sapabove 
+   !Config Desc  = Lignine/C ratio of sapabove pool
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 0.23, 0.23, 0.29, 0.23, 0.23, 0.29, 0.23, 0.29, 0.09, 0.09, 0.09, 0.09
+   !Config Help  = 
+   !Config Units = [-]   
+   CALL getin_p('LC_sapabove',LC_sapabove)
+
+   !Config Key   = LC_sapbelow 
+   !Config Desc  = Lignine/C ratio of sapbelow pool
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 0.23, 0.23, 0.29, 0.23, 0.23, 0.29, 0.23, 0.29, 0.09, 0.09, 0.09, 0.09
+   !Config Help  = 
+   !Config Units = [-]   
+   CALL getin_p('LC_sapbelow',LC_sapbelow)
+
+   !Config Key   = LC_heartabove 
+   !Config Desc  = Lignine/C ratio of heartabove pool
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 0.23, 0.23, 0.29, 0.23, 0.23, 0.29, 0.23, 0.29, 0.09, 0.09, 0.09, 0.09
+   !Config Help  = 
+   !Config Units = [-]   
+   CALL getin_p('LC_heartabove',LC_heartabove)
+
+   !Config Key   = LC_heartbelow 
+   !Config Desc  = Lignine/C ratio of heartbelow pool
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 0.23, 0.23, 0.29, 0.23, 0.23, 0.29, 0.23, 0.29, 0.09, 0.09, 0.09, 0.09
+   !Config Help  = 
+   !Config Units = [-]   
+   CALL getin_p('LC_heartbelow',LC_heartbelow)
+
+   !Config Key   = LC_fruit
+   !Config Desc  = Lignine/C ratio of fruit pool
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 0.09, 0.09, 0.09, 0.09, 0.09, 0.09, 0.09, 0.09, 0.09, 0.09, 0.09, 0.09
+   !Config Help  = 
+   !Config Units = [-]   
+   CALL getin_p('LC_fruit',LC_fruit)
+
+   !Config Key   = LC_root
+   !Config Desc  = Lignine/C ratio of fruit pool
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 0.22, 0.22, 0.22, 0.22, 0.22, 0.22, 0.22, 0.22, 0.22, 0.22, 0.22, 0.22
+   !Config Help  = 
+   !Config Units = [-]   
+   CALL getin_p('LC_root',LC_root)
+
+   !Config Key   = LC_carbres
+   !Config Desc  = Lignine/C ratio of carbres pool
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.
+   !Config Help  = 
+   !Config Units = [-]   
+   CALL getin_p('LC_carbres',LC_carbres)
+
+   !Config Key   = LC_labile
+   !Config Desc  = Lignine/C ratio of labile pool
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.
+   !Config Help  = 
+   !Config Units = [-]   
+   CALL getin_p('LC_labile',LC_labile)
+
+   !Config Key   = DECOMP_FACTOR 
+   !Config Desc  = Multpliactive factor modifying the standard decomposition factor for each SOM pool 
+   !Config if    = 
+   !Config Def   = undef, 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.2, 1.4 
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("DECOMP_FACTOR",decomp_factor)
+
+   !
+   ! Stand structure - stomate
+   !
+   !Config Key   = PIPE_TUNE4
+   !Config Desc  = needed for stem diameter
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0., 0., 0., 0.
+   !Config Help  = 
+   !Config Units = [-]  
+   CALL getin_p('PIPE_TUNE4',pipe_tune4)
+   
+   !Config Key   = PIPE_K1 
+   !Config Desc  = 
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 8.e3, 8.e3, 8.e3, 8.e3, 8.e3, 8.e3, 8.e3, 8.e3, 0., 0., 0., 0. 
+   !Config Help  = 
+   !Config Units = [-]   
+   CALL getin_p('PIPE_K1',pipe_k1)
+
+   !Config Key   = MASS_RATIO_HEART_SAP 
+   !Config Desc  = mass ratio (heartwood+sapwood)/heartwood 
+   !Config If    = OK_STOMATE 
+   !Config Def   = undef, 3., 3., 3., 3., 3., 3., 3., 3., 0., 0., 0., 0.  
+   !Config Help  = 
+   !Config Units = [-]   
+   CALL getin_p('MASS_RATIO_HEART_SAP',mass_ratio_heart_sap)
+
+
+   !Config Key   = CANOPY_COVER
+   !Config Desc  = Test values for canopy cover
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 0.9, 0.9, 0.7, 0.7, 0.7, 0.6, 0.5, 0.5, 0.9, 0.9, 0.9, 0.9
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('CANOPY_COVER',canopy_cover)
+
+   !Config Key   = NMAXTREES
+   !Config Desc  = number of seedlings planted at the start of a rotation
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   = (undef, 10., 10., 10., 10., 10., 2., 2., 2., 10., 10., 10., 10.)*1.e3
+   !Config Help  = 
+   !Config Units = [trees ha-1]
+   CALL getin_p("NMAXTREES",nmaxtrees)
+
+   !Config Key   = HEIGHT_INIT_MIN
+   !Config Desc  = 
+   !Config if    = FUNCTIONAL ALLOCATION 
+   !Config Def   = undef, 2, 2, 2, 2, 2, 3, 3, 3, 3, 0.1, 0.1, 0.1, 0.1
+   !Config Help  = 
+   !Config Units = [m]
+   CALL getin_p("HEIGHT_INIT_MIN",height_init_min)
+
+   !Config Key   = HEIGHT_INIT_MAX
+   !Config Desc  = 
+   !Config if    = FUNCTIONAL ALLOCATION 
+   !Config Def   = undef, 3, 3, 3, 3, 3, 4, 4, 4, 4, 0.2, 0.2, 0.2, 0.2
+   !Config Help  = 
+   !Config Units = [m]
+   CALL getin_p("HEIGHT_INIT_MAX",height_init_max)
+
+   !Config Key   = ALPHA_SELF_THINNING
+   !Config Desc  = 
+   !Config if    = FUNCTION NMAX 
+   !Config Def   = undef, 3000, 3000, 1462, 2262, 1900, 960, 939, 1046, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = [-]
+   CALL getin_p("ALPHA_SELF_THINNING",alpha_self_thinning)
+
+   !Config Key   = BETA_SELF_THINNING
+   !Config Desc  = 
+   !Config if    = FUNCTION NMAX 
+   !Config Def   = undef, -0.57, -0.57, -0.55, -0.61, -0.58, -0.55, -0.56, -0.56, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = [-]
+   CALL getin_p("BETA_SELF_THINNING",beta_self_thinning)
+
+   !Config Key   = FUELWOOD_DIAMETER
+   !Config Desc  = Diameter below which harvest will be used as fuelwood
+   !Config if    = 
+   !Config Def   = undef, 0.3, 0.3, 0.2, 0.3, 0.3, 0.2, 0.2, 0.2, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = [m]
+   CALL getin_p("FUELWOOD_DIAMETER",fuelwood_diameter)
+   
+   !Config Key   = COPPICE_KILL_BE_WOOD
+   !Config Desc  = The fraction of belowground wood killed during coppicing
+   !Config if    = 
+   !Config Def   = undef, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = [m]
+   CALL getin_p("COPPICE_KBEW",coppice_kill_be_wood)
+
+   !Config Key   = DELEUZE_A
+   !Config Desc  = intercept of the intra-tree competition within a stand
+   !               based on the competion rule of Deleuze and Dhote 2004
+   !               Used when n_circ > 6
+   !Config if    = OK_STOMATE, functional allocation 
+   !Config Def   = undef, 0.23, 0.23, 0.23, 0.23, 0.23, 0.23, 0.23, 0.23, 0.23, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("DELEUZE_A",deleuze_a)
+   
+   !Config Key   = DELEUZE_B
+   !Config Desc  = slope of the intra-tree competition within a stand
+   !               based on the competion rule of Deleuze and Dhote 2004
+   !               Used when n_circ > 6
+   !Config if    = OK_STOMATE, functional allocation  
+   !Config Def   = undef, 0.58, 0.58, 0.58, 0.58, 0.58, 0.58, 0.58, 0.58, 0.58, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("DELEUZE_B",deleuze_b)
+   
+   !Config Key   = DELEUZE_P_ALL
+   !Config Desc  = Percentile of the circumferences that receives photosynthates
+   !               based on the competion rule of Deleuze and Dhote 2004
+   !               Used when n_circ < 6 for FM 1, FM2 and FM4
+   !Config if    = OK_STOMATE, functional allocation  
+   !Config Def   = undef, 0.5, 0.5, 0.99, 0.99, 0.99, 0.99, 0.99, 0.99, 0.99, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("DELEUZE_P_ALL",deleuze_p_all)
+   
+   !Config Key   = DELEUZE_P_COPPICE
+   !Config Desc  = Percentile of the circumferences that receives photosynthates
+   !               based on the competion rule of Deleuze and Dhote 2004
+   !               Used when n_circ < 6 for FM3
+   !Config if    = OK_STOMATE, functional allocation  
+   !Config Def   = undef, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("DELEUZE_P_COPPICE",deleuze_p_coppice)
+ 
+   !Config Key   = DELEUZE_POWER
+   !Config Desc  = Divisor of the power for the slope of the intra-tree competition within a stand
+   !               based on the competion rule of Deleuze and Dhote 2004 (1/deleuze_power)
+   !Config if    = OK_STOMATE, functional allocation  
+   !Config Def   = undef, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+   !undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("DELEUZE_POWER",deleuze_power)
+ 
+   !Config Key   = M_DV
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   = undef, 1.05, 1.05, 1.05, 1.05, 1.05, 1.05, 1.05, 1.05, 1.05, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("M_DV",m_dv)
+   
+   !Config Key   = DENS_TARGET
+   !Config Desc  = 
+   !Config if    = OK_STOMATE, functional allocation
+   !Config Def   = 0.0, 100.0, 100.0, 200.0, 100.0, 100.0, 200.0, 100.0, 200.0, 0.0, 0.0, 0.0, 0.0
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("DENS_TARGET",dens_target)
+
+   !Config Key   = H_FIRST
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT
+   !Config Def   = 0.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 0.0, 0.0, 0.0, 0.0   
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("H_FIRST",h_first)
+
+   !Config Key   = LARGEST_TREE_DIA
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   = 0.0, 2000.0, 2000.0, 2000.0, 2000.0, 2000.0, 2000.0, 2000.0, 2000.0, 0.0, 0.0, 0.0, 0.0
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("LARGEST_TREE_DIA",largest_tree_dia)
+
+   !Config Key   = TAUMIN
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   = 0.0, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.0, 0.0, 0.0, 0.0
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("TAUMIN",taumin)
+   
+   !Config Key   = TAUMAX
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   = 0.0, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.0, 0.0, 0.0, 0.0
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("TAUMAX",taumax)
+
+   !Config Key   = ALPHA_RDI_UPPER
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   = undef, 3000, 3000, 592, 862, 504, 1287, 984, 589, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("ALPHA_RDI_UPPER",alpha_rdi_upper)
+   
+   !Config Key   = BETA_RDI_UPPER
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   =  undef, -0.57, -0.57, -0.46, -0.51, -0.44, -0.59, -0.57, -0.48, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("BETA_RDI_UPPER",beta_rdi_upper)
+   
+   !Config Key   = ALPHA_RDI_LOWER
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   = undef, 2999, 2999, 433, 445, 369, 1022, 828, 385, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("ALPHA_RDI_LOWER",alpha_rdi_lower)
+   
+   !Config Key   = BETA_RDI_LOWER
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   =  undef, -0.57, -0.57, -0.46, -0.51, -0.44, -0.59, -0.57, -0.48, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("BETA_RDI_LOWER",beta_rdi_lower)
+
+   !Config Key   = BRANCH_RATIO
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   = 0.0, 0.38, 0.38, 0.25, 0.38, 0.38, 0.25, 0.38, 0.25, 0.0, 0.0, 0.0, 0.0  
+   !Config m_dvHelp  = 
+   !Config Units = 
+   CALL getin_p("BRANCH_RATIO",branch_ratio)
+
+   !Config Key   = BRANCH_HARVEST
+   !Config Desc  = The fraction of branches which are harvested during FM2 (the rest are left onsite)
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   = 0.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0  
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("BRANCH_HARVEST",branch_harvest)
+
+   !Config Key   = COPPICE_DIAMETER
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   = undef, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("COPPICE_DIAMETER",coppice_diameter)
+   
+   !Config Key   = SHOOTS_PER_STOOL
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   = undef, 6, 6, 6, 6, 6, 6, 6, 6, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("SHOOTS_PER_STOOL",shoots_per_stool)
+   
+   !Config Key   = SRC_ROT_LENGTH
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   = undef, 3, 3, 3, 3, 3, 3, 3, 3, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("SRC_ROT_LENGTH",src_rot_length)
+   
+   !Config Key   = SRC_NROTS
+   !Config Desc  = 
+   !Config if    = FOREST_MANAGEMENT 
+   !Config Def   = undef, 10, 10, 10, 10, 10, 10, 10, 10, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("SRC_NROTS",src_nrots)
+   
+   !Config Key   = FRUIT_ALLOC
+   !Config Desc  = Guestimates - should be confirmed
+   !Config if    = OK_STOMATE
+   !Config Def   = (undef, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0., 0., 0., 0.)
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('FRUIT_ALLOC',fruit_alloc)
+
+   !Config Key   = LABILE_RESERVE 
+   !Config Desc  = Depends on the allocation scheme
+   !Config if    = 
+   !Config Def   = undef, 30., 60., 60., 30., 60., 30., 30., 30., 30., 30., 30. 
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("LABILE_RESERVE",labile_reserve)
+
+   !Config Key   = EVERGREEN_RESERVE
+   !Config Desc  = Fraction of sapwood mass stored in the reserve pool of evergreen trees
+   !Config If    = OK_STOMATE, functional allocation 
+   !Config Def   = undef, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05 
+   !Config Help  = 
+   !Config Units = [-]  
+   CALL getin_p('EVERGREEN_RESERVE',evergreen_reserve)
+   
+   !Config Key   = DECIDUOUS_RESERVE
+   !Config Desc  = Fraction of sapwood mass stored in the reserve pool of 
+   !               deciduous trees during the growing season
+   !Config If    = OK_STOMATE, functional allocation 
+   !Config Def   = undef, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12
+   !Config Help  = 
+   !Config Units = [-]  
+   CALL getin_p('DECIDUOUS_RESERVE',deciduous_reserve)
+   
+   !Config Key   = SENESCENSE_RESERVE
+   !Config Desc  = Fraction of sapwood mass stored in the reserve pool of 
+   !               deciduous trees during the senescense
+   !Config If    = OK_STOMATE, functional allocation 
+   !Config Def   = undef, 0.15, 0.15, 0.15, 0.15, 0.15, 0.15, 0.15, 0.15, 0.15, 0.15, 0.15, 0.15 
+   !Config Help  = 
+   !Config Units = [-]  
+   CALL getin_p('SENESCENSE_RESERVE',senescense_reserve)
+
+   !Config Key   = CN_LEAF_PRESCRIBED
+   !Config Desc  = 
+   !Config if    = 
+   !Config Def   = undef, 29., 29., 29., 29., 29., 29., 29., 29., 29., 29., 29., 29.
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("CN_LEAF_PRESCRIBED",cn_leaf_prescribed)
+
+   !Config Key   = FCN_WOOD
+   !Config Desc  = CN of wood for allocation, relative to leaf CN according to stich et al 2003
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, .087, .087, .087, .087, .087, .087, .087, .087, 1., 1., 1.
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('FCN_WOOD',fcn_wood)  
+ 
+   !Config Key   = FCN_ROOT
+   !Config Desc  = CN roots for allocation, relative to leaf CN according to stich et al 2003
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('FCN_ROOT',fcn_root) 
+
+   !Config Key   = CN_LEAF_INIT
+   !Config Desc  = 
+   !Config if    = 
+   !Config Def   = undef, 29., 29., 29., 29., 29., 29., 29., 29., 29., 29., 29., 29.
+   !Config Help  = 
+   !Config Units = 
+   CALL getin_p("CN_LEAF_INIT",cn_leaf_init)
+
+   !
+   ! Recruitment - stomate_prescribe  
+   !     
+   !Config Key   = RECRUITMENT_PFT  
+   !Config Desc  = Logical recruitment flag for each pft. So PFTs with recruitment or not recruitment can coexist.  
+   !Config if    = OK_STOMATE  
+   !Config Def   = FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE  
+   !Config Help  =   
+   !Config Units = [-]  
+   CALL getin_p("RECRUITMENT_PFT",recruitment_pft)  
+
+   !Config Key   = RECRUITMENT_HEIGHT  
+   !Config Desc  = Prescribed height for tree recruits (m)   
+   !Config if    = OK_STOMATE  
+   !Config Def   = undef, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, undef, undef, undef  
+   !Config Help  =
+   !Config Units =   
+   CALL getin_p("RECRUITMENT_HEIGHT",recruitment_height)  
+
+   !Config Key   = RECRUITMENT_ALPHA  
+   !Config Desc  = Intercept of power model relating light and recruitment numbers  
+   !Config if    = OK_STOMATE  
+   !Config Def   = undef, -3.0, -3.0, -3.0, -3.0, -3.0, -3.0, -3.0, -3.0, undef, undef, undef, undef  
+   !Config Help  =   
+   !Config Units =   
+   CALL getin_p("RECRUITMENT_ALPHA",recruitment_alpha)  
+
+   !Config Key   = RECRUITMENT_BETA  
+   !Config Desc  = Slope of power model relating light and recruitment numbers  
+   !Config if    = OK_STOMATE  
+   !Config Def   = undef, 0.8, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, undef, undef, undef, undef  
+   !Config Help  =   
+   !Config Units =   
+   CALL getin_p("RECRUITMENT_BETA",recruitment_beta) 
+
+   !
+   ! Mortality
+   !
+   !Config Key   = DEATH_DISTRIBUTION_FACTOR
+   !Config Desc  = Shape parameter for tree mortality
+   !Config if    = OK_STOMATE, FUNCTIONAL ALLOCATION
+   !Config Def   = undef, 100., 100., 100., 100., 100., 100., 100., 100., undef, undef, undef, undef  
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('DEATH_DF',death_distribution_factor) 
+
+   !Config Key   = NPP_RESET_VALUE
+   !Config Desc  = The value longterm NPP is reset to after a non-tree stand dies. 
+   !Config if    = OK_STOMATE, FUNCTIONAL ALLOCATION
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, 500., 500., 500., 500.  
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('NPP_RESET_VALUE',npp_reset_value) 
+
+      !
+      ! Windthrow - stomate
+      !
+
+      ! NOTE: COMMENTS HAVE NOT BEEN FILLED YET.
+
+      !Config Key   = MOR
+      !Config Desc  = Modulus of Rupture
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = [Pa] 
+      CALL getin_p('STREAMLINING_C_LEAF',streamlining_c_leaf)
+
+      !Config Key   = MOR
+      !Config Desc  = Modulus of Rupture
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = [Pa]
+      CALL getin_p('STREAMLINING_C_LEAFLESS',streamlining_c_leafless)
+
+      !Config Key   = MOR
+      !Config Desc  = Modulus of Rupture
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = [Pa]
+      CALL getin_p('STREAMLINING_N_LEAF',streamlining_n_leaf)
+
+      !Config Key   = MOR
+      !Config Desc  = Modulus of Rupture
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = [Pa]
+      CALL getin_p('STREAMLINING_N_LEAFLESS',streamlining_n_leafless)
+
+      !Config Key   = MOR
+      !Config Desc  = Modulus of Rupture
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = [Pa]
+      !CALL getin_p('STREAMLINING_RB_LEAF',streamlining_rb_leaf)
+
+      !Config Key   = MOR
+      !Config Desc  = Modulus of Rupture
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = [Pa]
+      !CALL getin_p('STREAMLINING_RB_LEAFLESS',streamlining_rb_leafless)
+
+      !Config Key   = MOR
+      !Config Desc  = Modulus of Rupture
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = [Pa]
+      !CALL getin_p('CANOPY_DENSITY_LEAF',canopy_density_leaf)
+
+      !Config Key   = 
+      !Config Desc  = Canopy density
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = 
+      !CALL getin_p('CANOPY_DENSITY_LEAFLESS',canopy_density_leafless)
+
+      !Config Key   = 
+      !Config Desc  = Canopy density
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = 
+      !CALL getin_p('INTERCEPT_BREADTH',intercept_breadth)
+
+      !Config Key   = MOR
+      !Config Desc  = Modulus of Rupture
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = [Pa]
+      !CALL getin_p('SLOPE_BREADTH',slope_breadth)
+
+      !Config Key   = MOR
+      !Config Desc  = Modulus of Rupture
+      !Config if    = OK_:wSTOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = [Pa]
+      !CALL getin_p('INTERCEPT_DEPTH',intercept_depth)
+
+      !Config Key   = MOR
+      !Config Desc  = Modulus of Rupture
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = [Pa]
+      !CALL getin_p('SLOPE_DEPTH',slope_depth)
+
+      !Config Key   = MOR
+      !Config Desc  = Modulus of Rupture
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = [Pa]
+      CALL getin_p('MODULUS_RUPTURE',modulus_rupture)
+
+      !Config Key   = MOR
+      !Config Desc  = Modulus of Rupture
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7, 3.6E7  
+      !Config Help  =
+      !Config Units = [Pa]
+      CALL getin_p('F_KNOT',f_knot)
+
+      !Config Key   = GDN
+      !Config Desc  = Green density of the tree
+      !Config if    = OK_STOMATE
+      !Config Def   = undef,937.1, 1045.0, 925.0, 1045.0, 937.1, 936.7, 1045.0, 930.0, 850.0, 850.0, 850.0, 850.0
+      !Config Help  = 
+      !Config Units = [kg/m^3]
+      CALL getin_p('GREEN_DENSITY',green_density)
+ 
+ 
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in free draining and shallow soil type
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/kg]
+      CALL getin_p('OV_FD_SHALLOW',overturning_free_draining_shallow)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in free draining and shallow soil type leafless
+      !Config if    = OK_STOMATE
+      !Config Def   = 
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_FD_SHALLOW_LESS',overturning_free_draining_shallow_leafless)
+
+      !Config Key   =
+      !Config Desc  = Regression coefficient for overturning in free draining and deep soil type
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_FD_DEEP',overturning_free_draining_deep)
+
+      !Config Key   =
+      !Config Desc  = Regression coefficient for overturning in free draining and deep soil type leafless
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_FD_DEEP_LESS',overturning_free_draining_deep_leafless)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in free draining and medium soil type  
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_FD_AVERAGE',overturning_free_draining_average)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in free draining and medium soil type leafless 
+      !Config if    = OK_STOMATE
+      !Config Def   =  
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_FD_AVERAGE_LESS',overturning_free_draining_average_leafless)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in gleyed and shallow soil type
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_GLEYED_SHALLOW',overturning_gleyed_shallow)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in gleyed and shallow soil type leafless
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_GLEYED_SHALLOW_LESS',overturning_gleyed_shallow_leafless)
+
+      !Config Key   = Regression coefficient for overturning in gleyed and deep soil type
+      !Config Desc  = 
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg
+      CALL getin_p('OV_GLEYED_DEEP',overturning_gleyed_deep)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in gleyed and deep soil type leafless
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_GLEYED_DEEP_LESS',overturning_gleyed_deep_leafless)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in gleyed and
+      !medium soil type
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_GLEYED_AVERAGE',overturning_gleyed_average)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in gleyed and
+      !medium soil type leafless
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_GLEYED_AVERAGE_LESS',overturning_gleyed_average_leafless)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in peaty and
+      !shallow soil type
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_PEATY_SHALLOW',overturning_peaty_shallow)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in peaty and
+      !shallow soil type leafless
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_PEATY_SHALLOW_LESS',overturning_peaty_shallow_leafless)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in peaty and
+      !deep soil type
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_PEATY_DEEP',overturning_peaty_deep)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in peaty and
+      !deep soil type leafless  
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_PEATY_DEEP_LESS',overturning_peaty_deep_leafless)
+
+      !Config Key   =
+      !Config Desc  = Regression coefficient for overturning in peaty and
+      !medium soil type 
+      !Config if    = OK_STOMATE
+      !Config Def   =  
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_PEATY_AVERAGE',overturning_peaty_average)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in peaty and
+      !medium soil type leafless 
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_PEATY_AVERAGE_LESS',overturning_peaty_average_leafless)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in shallow peat soil
+      !type
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_PEAT_SHALLOW',overturning_peat_shallow)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in shallow peat
+      !soil leafless
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_PEAT_SHALLOW_LESS',overturning_peat_shallow_leafless)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in deep peat
+      !soil
+      !Config if    = OK_STOMATE
+      !Config Def   =  
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_PEAT_DEEP',overturning_peat_deep)
+
+      !Config Key   =
+      !Config Desc  = Regression coefficient for overturning in deep peat
+      !soil leafless
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_PEAT_DEEP_LESS',overturning_peat_deep_leafless)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in medium peat
+      !soil
+      !Config if    = OK_STOMATE
+      !Config Def   =   
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_PEAT_AVERAGE',overturning_peat_average)
+
+      !Config Key   = 
+      !Config Desc  = Regression coefficient for overturning in medium peat
+      !soil leafless
+      !Config if    = OK_STOMATE
+      !Config Def   =  
+      !Config Help  =
+      !Config Units = [Nm/Kg]
+      CALL getin_p('OV_PEAT_AVERAGE_LESS',overturning_peat_average_leafless)
+
+      !Config Key   = MDF
+      !Config Desc  = Maximum damage rate
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8 
+      !Config Help  =
+      !Config Units = [unitless]
+      CALL getin_p('MAX_DAMAGE_FURTHER',max_damage_further)
+
+      !Config Key   = MDC
+      !Config Desc  = Maximum damage rate
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8 
+      !Config Help  =
+      !Config Units = [unitless]
+      CALL getin_p('MAX_DAMAGE_CLOSER',max_damage_closer)
+
+      !Config Key   = SFF
+      !Config Desc  = Scaling factor for maximum damage rate 
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8 
+      !Config Help  =
+      !Config Units = [unitless]
+      CALL getin_p('SFACTOR_FURTHER',sfactor_further)
+
+      !Config Key   = SFC
+      !Config Desc  = Scaling factor for maximum damage rate
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8 
+      !Config Help  =
+      !Config Units = [unitless]
+      CALL getin_p('SFACTOR_CLOSER',sfactor_closer)
+
+
+
+
+   !
+   ! Phenology : Senescence
+   !
+   !
+   !Config Key   = LEAFFALL
+   !Config Desc  = length of death of leaves, tabulated 
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, 10., undef, undef, 10., undef, 10., 10., 10., 10., 10., 10. 
+   !Config Help  =
+   !Config Units = [days]
+   CALL getin_p('LEAFFALL',leaffall)
+
+   !Config Key   = LEAFAGECRIT
+   !Config Desc  = critical leaf age, tabulated
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 730., 180., 910., 730., 180., 910., 180., 180., 120., 120., 90., 90.  
+   !Config Help  =
+   !Config Units = [days]
+   CALL getin_p('LEAFAGECRIT',leafagecrit) 
+
+   !Config Key   = SENESCENCE_TYPE
+   !Config Desc  = type of senescence, tabulated
+   !Config if    = OK_STOMATE
+   !Config Def   = none, none, dry, none, none, cold, none, cold, cold, mixed, mixed, mixed, mixed 
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('SENESCENCE_TYPE',senescence_type) 
+
+   !Config Key   = SENESCENCE_HUM
+   !Config Desc  = critical relative moisture availability for senescence
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, .3, undef, undef, undef, undef, undef, undef, .2, .2, .3, .2 
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('SENESCENCE_HUM',senescence_hum)
+
+   !Config Key   = NOSENESCENCE_HUM
+   !Config Desc  = relative moisture availability above which there is no humidity-related senescence
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, .8, undef, undef, undef, undef, undef, undef, .3, .3, .3, .3 
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('NOSENESCENCE_HUM',nosenescence_hum) 
+
+   !Config Key   = MAX_TURNOVER_TIME
+   !Config Desc  = maximum turnover time for grasse
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef,  80.,  80., 80., 80. 
+   !Config Help  =
+   !Config Units = [days]
+   CALL getin_p('MAX_TURNOVER_TIME',max_turnover_time)
+
+   !Config Key   = MIN_TURNOVER_TIME
+   !Config Desc  = minimum turnover time for grasse 
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, 10., 10., 10., 10. 
+   !Config Help  =
+   !Config Units = [days]
+   CALL getin_p('MIN_TURNOVER_TIME',min_turnover_time)
+
+   !Config Key   = RECYCLE_LEAF
+   !Config Desc  = Fraction of N leaf that is recycled when leaves are senescent 
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5 
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('RECYCLE_LEAF',recycle_leaf)
+
+   !Config Key   = RECYCLE_ROOT
+   !Config Desc  = Fraction of N root that is recycled when roots are senescent 
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2 
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('RECYCLE_ROOT',recycle_root)
+
+   !Config Key   = MIN_LEAF_AGE_FOR_SENESCENCE
+   !Config Desc  = minimum leaf age to allow senescence g
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, 90., undef, undef, 90., undef, 60., 60., 30., 30., 30., 30.
+   !Config Help  =
+   !Config Units = [days] 
+   CALL getin_p('MIN_LEAF_AGE_FOR_SENESCENCE',min_leaf_age_for_senescence)
+
+   !Config Key   = SENESCENCE_TEMP_C
+   !Config Desc  = critical temperature for senescence (C), constant c of aT^2+bT+c, tabulated
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, undef, undef, undef, 12., undef, 7., 2., -1.375, 5., 5., 10.
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('SENESCENCE_TEMP_C',senescence_temp_c)
+
+   !Config Key   = SENESCENCE_TEMP_B
+   !Config Desc  = critical temperature for senescence (C), constant b of aT^2+bT+c ,tabulated
+   !Config if    = OK_STOMATE 
+   !Config Def   = undef, undef, undef, undef, undef, 0., undef, 0., 0., .1, 0., 0., 0.
+   !Config Help  =
+   !Config Units = [-]
+   CALL getin_p('SENESCENCE_TEMP_B',senescence_temp_b)
+
+   !Config Key   = SENESCENCE_TEMP_A
+   !Config Desc  = critical temperature for senescence (C), constant a of aT^2+bT+c , tabulated
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, undef, undef, undef, 0., undef, 0., 0.,.00375, 0., 0., 0. 
+   !Config Help  =
+   !Config Units = [-] 
+   CALL getin_p('SENESCENCE_TEMP_A',senescence_temp_a)
+
+   !Config Key   = GDD_SENESCENCE
+   !Config Desc  = minimum gdd to allow senescence of crops  
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 950., 4000.
+   !Config Help  =
+   !Config Units = [days] 
+   CALL getin_p("GDD_SENESCENCE", gdd_senescence)
+
+   !
+   ! N cycle
+   !
+   !Config Key   = CN_LEAF_MIN
+   !Config Desc  = minimum CN ratio of leaves  
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 16., 16., 28., 16., 16., 28., 16., 16., 16., 16., 16., 16. 
+   !Config Help  =
+   !Config Units = [gC/gN] 
+   CALL getin_p("CN_LEAF_MIN", cn_leaf_min)
+
+   !Config Key   = CN_LEAF_MAX
+   !Config Desc  = maximum CN ratio of leaves  
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, 45., 45., 75., 45., 45., 75., 45., 45., 45., 45., 45., 45. 
+   !Config Help  =
+   !Config Units = [gC/gN] 
+   CALL getin_p("CN_LEAF_MAX", cn_leaf_max)
+
+   !Config Key   = MAX_SOIL_N_BNF
+   !Config Desc  = Value of total N (NH4+NO3) above which we stop adding N via BNF (gN/m**2)  
+   !Config if    = OK_STOMATE
+   !Config Def   = 0.0, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 2., 2., 2., 2.
+   !Config Help  =
+   !Config Units = [gN/m**2] 
+   CALL getin_p("MAX_SOIL_N_BNF", max_soil_n_bnf)
+
+   !Config Key   = MANURE_PFTWEIGHT
+   !Config Desc  = Weight of the distribution of manure over the PFT surface
+   !Config if    = OK_STOMATE
+   !Config Def   = 0., 0., 0., 0., 0., 0., 0., 0., 0., 1., 1., 1., 1. 
+   !Config Help  =
+   !Config Units = [gC/gN] 
+   CALL getin_p("MANURE_PFTWEIGHT", manure_pftweight)
+
+   !
+   ! CROPLAND MANAGEMENT
+   !
+   !Config Key   = HARVEST_RATIO
+   !Config Desc  = Share of biomass that is harvested. This residual = 1 - harvest_ratio  
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.5, 0.5
+   !Config Help  =
+   !Config Units = [unitless] 
+   CALL getin_p("HARVEST_RATIO", harvest_ratio)
+
+   !
+   ! DGVM
+   !
+
+   !Config Key   = RESIDENCE_TIME
+   !Config Desc  = residence time of trees
+   !Config if    = OK_DGVM and NOT(LPJ_GAP_CONST_MORT)
+   !Config Def   = undef, 500.0, 500.0, 500.0, 500.0, 500.0, 500.0, 500.0, 500.0, 0.0, 0.0, 0.0, 0.0 
+   !Config Help  =
+   !Config Units = [years]
+   CALL getin_p('RESIDENCE_TIME',residence_time)
+
+   !Config Key   = TMIN_CRIT
+   !Config Desc  = critical tmin, tabulated
+   !Config if    = OK_STOMATE
+   !Config Def   = undef,  0.0, 0.0, -30.0, -14.0, -30.0, -45.0, -45.0, undef, undef, undef, undef, undef
+   !Config Help  = 
+   !Config Units = [C]
+   CALL getin_p('TMIN_CRIT',tmin_crit)
+
+   !Config Key   = TCM_CRIT
+   !Config Desc  = critical tcm, tabulated 
+   !Config if    = OK_STOMATE
+   !Config Def   = undef, undef, undef, 5.0, 15.5, 15.5, -8.0, -8.0, -8.0, undef, undef, undef, undef
+   !Config Help  =
+   !Config Units = [C]
+   CALL getin_p('TCM_CRIT',tcm_crit)
+   
+   !Config Key   = MORTALITY_MIN
+   !Config Desc  = Asymptotic mortality 
+   !Config if    = OK_STOMATE, functional allocation, lpj_const_mort
+   !Config Def   = undef, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01
+   !Config Help  =
+   !Config Units = [year-1]
+   CALL getin_p('MORTALITY_MIN',mortality_min)
+
+   !Config Key   = MORTALITY_MAX
+   !Config Desc  = Maximum mortality, tabulated 
+   !Config if    = OK_STOMATE, functional allocation + lpj_const_mort
+   !Config Def   = undef, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1
+   !Config Help  =
+   !Config Units = [year-1]
+   CALL getin_p('MORTALITY_MIN',mortality_min)
+
+   !Config Key   = REF_MORTALITY
+   !Config Desc  = Reference mortality, tabulated 
+   !Config if    = OK_STOMATE, functional allocation + lpj_const_mort
+   !Config Def   = undef, 0.035, 0.035, 0.035, 0.035, 0.035, 0.035, 0.035, 0.035, 0.035, 0.035, 0.035, 0.035
+   !Config Help  =
+   !Config Units = [year-1]
+   CALL getin_p('REF_MORTALITY',ref_mortality)
+   
+   ! Age classes
+   ! I want to create a temporary array that indicates which "real" PFT starts
+   ! on which index.  This could probably be put somewhere else, but this
+   ! routine is only called once a year and this loop is not expensive.
+   start_index(:)=-1
+   nagec_pft(:)=-1
+   DO ivma=1,nvmap
+      ! The start index is just the first place we find this real PFT.
+      DO ivm=1,nvm
+         IF(agec_group(ivm) .EQ. ivma)THEN
+            start_index(ivma)=ivm
+            ! It is possible that not all forests will have multiple age 
+            ! classes.  For example, the species might have age classes 
+            ! but metaclasses (running outside Europe) might not. Let's 
+            ! check to see how many age classes each PFT has. Right now, 
+            ! the only options are 1 or nagec, but this could be changed 
+            ! without too much difficulty.
+            IF((ivm+nagec-1) .LT. nvm)THEN
+               ! This first if loop prevents an out of bounds error
+               IF(agec_group(ivm+nagec-1) == ivma)THEN
+                  nagec_pft(ivma)=nagec
+               ELSE
+                  nagec_pft(ivma)=1
+               ENDIF
+            ELSE
+               nagec_pft(ivma)=1
+            ENDIF
+            EXIT
+         ENDIF
+      ENDDO
+   ENDDO
+   ! Check to see if the calculation worked and we found indices for all of them.
+   DO ivma=1,nvmap
+      IF(start_index(ivma) .LT. 0)THEN
+         WRITE(numout,*) 'Could not find a start index for one age class group!'
+         WRITE(numout,*) 'Check the input file and ',&
+              'make sure the following ivma appears in agec_group'
+         WRITE(numout,*) 'ivma,nvmap',ivma,nvmap
+         WRITE(numout,*) 'agec_group',agec_group(:)
+         CALL ipslerr_p (3,'pft_parameters','pft_parameters_alloc','','')
+      ENDIF
+   ENDDO
+
+ END SUBROUTINE config_stomate_pft_parameters
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pft_parameters_clear
+!!
+!>\BRIEF         This subroutine deallocates memory at the end of the simulation. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE pft_parameters_clear
+   
+   l_first_pft_parameters = .TRUE.
+   
+   IF (ALLOCATED(pft_to_mtc)) DEALLOCATE(pft_to_mtc)
+   IF (ALLOCATED(PFT_name)) DEALLOCATE(PFT_name)
+   IF (ALLOCATED(veget_ori_fixed_test_1)) DEALLOCATE(veget_ori_fixed_test_1)   
+   IF (ALLOCATED(llaimax)) DEALLOCATE(llaimax)
+   IF (ALLOCATED(llaimin)) DEALLOCATE(llaimin)
+   IF (ALLOCATED(height_presc)) DEALLOCATE(height_presc)   
+   IF (ALLOCATED(z0_over_height)) DEALLOCATE(z0_over_height)   
+   IF (ALLOCATED(ratio_z0m_z0h)) DEALLOCATE(ratio_z0m_z0h)   
+   IF (ALLOCATED(type_of_lai)) DEALLOCATE(type_of_lai)
+   IF (ALLOCATED(is_tree)) DEALLOCATE(is_tree)
+   IF (ALLOCATED(natural)) DEALLOCATE(natural)
+   IF (ALLOCATED(is_deciduous)) DEALLOCATE(is_deciduous)
+   IF (ALLOCATED(is_evergreen)) DEALLOCATE(is_evergreen)
+   IF (ALLOCATED(is_needleleaf)) DEALLOCATE(is_needleleaf)
+   IF (ALLOCATED(is_tropical)) DEALLOCATE(is_tropical)
+   IF (ALLOCATED(is_temperate)) DEALLOCATE(is_temperate)
+   IF (ALLOCATED(is_boreal)) DEALLOCATE(is_boreal)
+   IF (ALLOCATED(agec_group)) DEALLOCATE(agec_group)
+   IF (ALLOCATED(start_index)) DEALLOCATE(start_index)
+   IF (ALLOCATED(nagec_pft)) DEALLOCATE(nagec_pft)
+   IF (ALLOCATED(humcste)) DEALLOCATE(humcste)
+   IF (ALLOCATED(pref_soil_veg)) DEALLOCATE(pref_soil_veg)
+   IF (ALLOCATED(is_c4)) DEALLOCATE(is_c4)  
+   IF (ALLOCATED(vcmax_fix)) DEALLOCATE(vcmax_fix)
+   IF (ALLOCATED(downregulation_co2_coeff)) DEALLOCATE(downregulation_co2_coeff) 
+   IF (ALLOCATED(E_KmC)) DEALLOCATE(E_KmC)
+   IF (ALLOCATED(E_KmO)) DEALLOCATE(E_KmO)
+   IF (ALLOCATED(E_Sco)) DEALLOCATE(E_Sco)
+   IF (ALLOCATED(E_gamma_star)) DEALLOCATE(E_gamma_star)
+   IF (ALLOCATED(E_Vcmax)) DEALLOCATE(E_Vcmax)
+   IF (ALLOCATED(E_Jmax)) DEALLOCATE(E_Jmax)
+   IF (ALLOCATED(aSV)) DEALLOCATE(aSV)
+   IF (ALLOCATED(bSV)) DEALLOCATE(bSV)
+   IF (ALLOCATED(tphoto_min)) DEALLOCATE(tphoto_min)
+   IF (ALLOCATED(tphoto_max)) DEALLOCATE(tphoto_max)
+   IF (ALLOCATED(aSJ)) DEALLOCATE(aSJ)
+   IF (ALLOCATED(bSJ)) DEALLOCATE(bSJ)
+   IF (ALLOCATED(D_Vcmax)) DEALLOCATE(D_Vcmax)
+   IF (ALLOCATED(D_Jmax)) DEALLOCATE(D_Jmax)
+   IF (ALLOCATED(E_gm)) DEALLOCATE(E_gm)  
+   IF (ALLOCATED(S_gm)) DEALLOCATE(S_gm)  
+   IF (ALLOCATED(D_gm)) DEALLOCATE(D_gm)
+   IF (ALLOCATED(E_Rd)) DEALLOCATE(E_Rd)
+   IF (ALLOCATED(Vcmax25)) DEALLOCATE(Vcmax25)
+   IF (ALLOCATED(arJV)) DEALLOCATE(arJV)
+   IF (ALLOCATED(brJV)) DEALLOCATE(brJV)
+   IF (ALLOCATED(KmC25)) DEALLOCATE(KmC25)
+   IF (ALLOCATED(KmO25)) DEALLOCATE(KmO25)
+   IF (ALLOCATED(Sco25)) DEALLOCATE(Sco25) 
+   IF (ALLOCATED(gm25)) DEALLOCATE(gm25)
+   IF (ALLOCATED(gamma_star25)) DEALLOCATE(gamma_star25)
+   IF (ALLOCATED(a1)) DEALLOCATE(a1)
+   IF (ALLOCATED(b1)) DEALLOCATE(b1)
+   IF (ALLOCATED(g0)) DEALLOCATE(g0)
+   IF (ALLOCATED(h_protons)) DEALLOCATE(h_protons)
+   IF (ALLOCATED(fpsir)) DEALLOCATE(fpsir)
+   IF (ALLOCATED(fQ)) DEALLOCATE(fQ)
+   IF (ALLOCATED(fpseudo)) DEALLOCATE(fpseudo)
+   IF (ALLOCATED(kp)) DEALLOCATE(kp)
+   IF (ALLOCATED(alpha)) DEALLOCATE(alpha)
+   IF (ALLOCATED(gbs)) DEALLOCATE(gbs)
+   IF (ALLOCATED(theta)) DEALLOCATE(theta)
+   IF (ALLOCATED(alpha_LL)) DEALLOCATE(alpha_LL)
+   IF (ALLOCATED(stress_vcmax)) DEALLOCATE(stress_vcmax) 
+   IF (ALLOCATED(stress_gs)) DEALLOCATE(stress_gs) 
+   IF (ALLOCATED(stress_gm)) DEALLOCATE(stress_gm)
+   IF (ALLOCATED(ext_coeff)) DEALLOCATE(ext_coeff)
+   IF (ALLOCATED(ext_coeff_vegetfrac)) DEALLOCATE(ext_coeff_vegetfrac)
+   IF (ALLOCATED(rveg_pft)) DEALLOCATE(rveg_pft)
+   IF (ALLOCATED(rstruct_const)) DEALLOCATE(rstruct_const)
+   IF (ALLOCATED(kzero)) DEALLOCATE(kzero)
+   IF (ALLOCATED(wmax_veg)) DEALLOCATE(wmax_veg)
+   IF (ALLOCATED(throughfall_by_pft)) DEALLOCATE(throughfall_by_pft)
+   IF (ALLOCATED(snowa_aged)) DEALLOCATE(snowa_aged)
+   IF (ALLOCATED(snowa_dec)) DEALLOCATE(snowa_dec)
+   IF (ALLOCATED(leaf_ssa)) DEALLOCATE(leaf_ssa)   
+   IF (ALLOCATED(leaf_psd)) DEALLOCATE(leaf_psd)   
+   IF (ALLOCATED(bgd_reflectance)) DEALLOCATE(bgd_reflectance)
+   IF (ALLOCATED(leaf_to_shoot_clumping)) DEALLOCATE(leaf_to_shoot_clumping) 
+   IF (ALLOCATED(lai_correction_factor)) DEALLOCATE(lai_correction_factor) 
+   IF (ALLOCATED(min_level_sep)) DEALLOCATE(min_level_sep)
+   IF (ALLOCATED(lai_top)) DEALLOCATE(lai_top)   
+   IF (ALLOCATED(em_factor_isoprene)) DEALLOCATE(em_factor_isoprene)
+   IF (ALLOCATED(em_factor_monoterpene)) DEALLOCATE(em_factor_monoterpene)
+   IF (ALLOCATED(em_factor_apinene)) DEALLOCATE(em_factor_apinene)
+   IF (ALLOCATED(em_factor_bpinene)) DEALLOCATE(em_factor_bpinene)
+   IF (ALLOCATED(em_factor_limonene)) DEALLOCATE(em_factor_limonene)
+   IF (ALLOCATED(em_factor_myrcene)) DEALLOCATE(em_factor_myrcene)
+   IF (ALLOCATED(em_factor_sabinene)) DEALLOCATE(em_factor_sabinene)
+   IF (ALLOCATED(em_factor_camphene)) DEALLOCATE(em_factor_camphene)
+   IF (ALLOCATED(em_factor_3carene)) DEALLOCATE(em_factor_3carene)
+   IF (ALLOCATED(em_factor_tbocimene)) DEALLOCATE(em_factor_tbocimene)
+   IF (ALLOCATED(em_factor_othermonot)) DEALLOCATE(em_factor_othermonot)
+   IF (ALLOCATED(em_factor_sesquiterp)) DEALLOCATE(em_factor_sesquiterp)
+   IF (ALLOCATED(em_factor_ORVOC)) DEALLOCATE(em_factor_ORVOC)
+   IF (ALLOCATED(em_factor_OVOC)) DEALLOCATE(em_factor_OVOC)
+   IF (ALLOCATED(em_factor_MBO)) DEALLOCATE(em_factor_MBO)
+   IF (ALLOCATED(em_factor_methanol)) DEALLOCATE(em_factor_methanol)
+   IF (ALLOCATED(em_factor_acetone)) DEALLOCATE(em_factor_acetone)
+   IF (ALLOCATED(em_factor_acetal)) DEALLOCATE(em_factor_acetal)
+   IF (ALLOCATED(em_factor_formal)) DEALLOCATE(em_factor_formal)
+   IF (ALLOCATED(em_factor_acetic)) DEALLOCATE(em_factor_acetic)
+   IF (ALLOCATED(em_factor_formic)) DEALLOCATE(em_factor_formic)
+   IF (ALLOCATED(em_factor_no_wet)) DEALLOCATE(em_factor_no_wet)
+   IF (ALLOCATED(em_factor_no_dry)) DEALLOCATE(em_factor_no_dry)
+   IF (ALLOCATED(Larch)) DEALLOCATE(Larch)
+   IF (ALLOCATED(leaf_tab)) DEALLOCATE(leaf_tab)
+   IF (ALLOCATED(sla)) DEALLOCATE(sla)
+   IF (ALLOCATED(slainit)) DEALLOCATE(slainit)
+   IF (ALLOCATED(availability_fact)) DEALLOCATE(availability_fact)
+   IF (ALLOCATED(ext_coeff_N)) DEALLOCATE(ext_coeff_N)
+   IF (ALLOCATED(nue_opt)) DEALLOCATE(nue_opt)
+   IF (ALLOCATED(frac_growthresp)) DEALLOCATE(frac_growthresp)
+   IF (ALLOCATED(maint_resp_slope)) DEALLOCATE(maint_resp_slope)
+   IF (ALLOCATED(maint_resp_slope_c)) DEALLOCATE(maint_resp_slope_c)
+   IF (ALLOCATED(maint_resp_slope_b)) DEALLOCATE(maint_resp_slope_b)
+   IF (ALLOCATED(maint_resp_slope_a)) DEALLOCATE(maint_resp_slope_a)
+   IF (ALLOCATED(coeff_maint_init)) DEALLOCATE(coeff_maint_init)
+   IF (ALLOCATED(tref_maint_resp)) DEALLOCATE(tref_maint_resp)
+   IF (ALLOCATED(tmin_maint_resp)) DEALLOCATE(tmin_maint_resp)
+   IF (ALLOCATED(e0_maint_resp)) DEALLOCATE(e0_maint_resp)
+   IF (ALLOCATED(flam)) DEALLOCATE(flam)
+   IF (ALLOCATED(resist)) DEALLOCATE(resist)
+   IF (ALLOCATED(coeff_lcchange_1)) DEALLOCATE(coeff_lcchange_1)
+   IF (ALLOCATED(coeff_lcchange_10)) DEALLOCATE(coeff_lcchange_10)
+   IF (ALLOCATED(coeff_lcchange_100)) DEALLOCATE(coeff_lcchange_100)
+   IF (ALLOCATED(coeff_lcchange_s)) DEALLOCATE(coeff_lcchange_s)
+   IF (ALLOCATED(coeff_lcchange_m)) DEALLOCATE(coeff_lcchange_m)
+   IF (ALLOCATED(coeff_lcchange_l)) DEALLOCATE(coeff_lcchange_l)
+   IF (ALLOCATED(lai_max_to_happy)) DEALLOCATE(lai_max_to_happy)
+   IF (ALLOCATED(lai_max)) DEALLOCATE(lai_max)
+   IF (ALLOCATED(pheno_model)) DEALLOCATE(pheno_model)
+   IF (ALLOCATED(pheno_type)) DEALLOCATE(pheno_type)
+   IF (ALLOCATED(pheno_gdd_crit_c)) DEALLOCATE(pheno_gdd_crit_c)
+   IF (ALLOCATED(pheno_gdd_crit_b)) DEALLOCATE(pheno_gdd_crit_b)
+   IF (ALLOCATED(pheno_gdd_crit_a)) DEALLOCATE(pheno_gdd_crit_a)
+   IF (ALLOCATED(pheno_gdd_crit)) DEALLOCATE(pheno_gdd_crit)
+   IF (ALLOCATED(pheno_moigdd_t_crit)) DEALLOCATE(pheno_moigdd_t_crit)
+   IF (ALLOCATED(ngd_crit)) DEALLOCATE(ngd_crit)
+   IF (ALLOCATED(ncdgdd_temp)) DEALLOCATE(ncdgdd_temp)
+   IF (ALLOCATED(hum_frac)) DEALLOCATE(hum_frac)
+   IF (ALLOCATED(hum_min_time)) DEALLOCATE(hum_min_time)
+   IF (ALLOCATED(tau_sap)) DEALLOCATE(tau_sap)
+   IF (ALLOCATED(tau_leaf)) DEALLOCATE(tau_leaf)
+   IF (ALLOCATED(tau_leafinit)) DEALLOCATE(tau_leafinit)
+   IF (ALLOCATED(tau_fruit)) DEALLOCATE(tau_fruit)
+   IF (ALLOCATED(tau_root)) DEALLOCATE(tau_root)
+   IF (ALLOCATED(ecureuil)) DEALLOCATE(ecureuil)
+   IF (ALLOCATED(alloc_min)) DEALLOCATE(alloc_min)
+   IF (ALLOCATED(alloc_max)) DEALLOCATE(alloc_max)
+   IF (ALLOCATED(demi_alloc)) DEALLOCATE(demi_alloc)
+   IF (ALLOCATED(leaflife_tab)) DEALLOCATE(leaflife_tab)
+   IF (ALLOCATED(leaffall)) DEALLOCATE(leaffall)
+   IF (ALLOCATED(leafagecrit)) DEALLOCATE(leafagecrit)
+   IF (ALLOCATED(senescence_type)) DEALLOCATE(senescence_type)
+   IF (ALLOCATED(senescence_hum)) DEALLOCATE(senescence_hum)
+   IF (ALLOCATED(nosenescence_hum)) DEALLOCATE(nosenescence_hum)
+   IF (ALLOCATED(max_turnover_time)) DEALLOCATE(max_turnover_time)
+   IF (ALLOCATED(min_turnover_time)) DEALLOCATE(min_turnover_time)
+   IF (ALLOCATED(recycle_leaf)) DEALLOCATE(recycle_leaf)
+   IF (ALLOCATED(recycle_root)) DEALLOCATE(recycle_root)
+   IF (ALLOCATED(min_leaf_age_for_senescence)) DEALLOCATE(min_leaf_age_for_senescence)
+   IF (ALLOCATED(senescence_temp_c)) DEALLOCATE(senescence_temp_c)
+   IF (ALLOCATED(senescence_temp_b)) DEALLOCATE(senescence_temp_b)
+   IF (ALLOCATED(senescence_temp_a)) DEALLOCATE(senescence_temp_a)
+   IF (ALLOCATED(senescence_temp)) DEALLOCATE(senescence_temp)
+   IF (ALLOCATED(gdd_senescence)) DEALLOCATE(gdd_senescence)
+   IF (ALLOCATED(cn_leaf_min)) DEALLOCATE(cn_leaf_min)
+   IF (ALLOCATED(cn_leaf_max)) DEALLOCATE(cn_leaf_max)
+   IF (ALLOCATED(max_soil_n_bnf)) DEALLOCATE(max_soil_n_bnf)
+   IF (ALLOCATED(manure_pftweight)) DEALLOCATE(manure_pftweight)
+   IF (ALLOCATED(residence_time)) DEALLOCATE(residence_time)
+   IF (ALLOCATED(tmin_crit)) DEALLOCATE(tmin_crit)
+   IF (ALLOCATED(tcm_crit)) DEALLOCATE(tcm_crit)
+   IF (ALLOCATED(mortality_min)) DEALLOCATE(mortality_min)
+   IF (ALLOCATED(mortality_max)) DEALLOCATE(mortality_max)
+   IF (ALLOCATED(ref_mortality)) DEALLOCATE(ref_mortality)
+   IF (ALLOCATED(lai_initmin)) DEALLOCATE(lai_initmin)
+   IF (ALLOCATED(bm_sapl)) DEALLOCATE(bm_sapl)
+   IF (ALLOCATED(migrate)) DEALLOCATE(migrate)
+   IF (ALLOCATED(maxdia)) DEALLOCATE(maxdia)
+   IF (ALLOCATED(cn_sapl)) DEALLOCATE(cn_sapl)
+   IF (ALLOCATED(leaf_timecst)) DEALLOCATE(leaf_timecst)
+   IF (ALLOCATED(k_latosa_max)) DEALLOCATE(k_latosa_max)
+   IF (ALLOCATED(k_latosa_min)) DEALLOCATE(k_latosa_min)
+   IF (ALLOCATED(LC)) DEALLOCATE(LC)
+   IF (ALLOCATED(LC_leaf)) DEALLOCATE(LC_leaf)
+   IF (ALLOCATED(LC_sapabove)) DEALLOCATE(LC_sapabove)
+   IF (ALLOCATED(LC_sapbelow)) DEALLOCATE(LC_sapbelow)
+   IF (ALLOCATED(LC_heartabove)) DEALLOCATE(LC_heartabove)
+   IF (ALLOCATED(LC_heartbelow)) DEALLOCATE(LC_heartbelow)
+   IF (ALLOCATED(LC_fruit)) DEALLOCATE(LC_fruit)
+   IF (ALLOCATED(LC_root)) DEALLOCATE(LC_root)
+   IF (ALLOCATED(LC_carbres)) DEALLOCATE(LC_carbres)
+   IF (ALLOCATED(LC_labile)) DEALLOCATE(LC_labile)
+   IF (ALLOCATED(decomp_factor)) DEALLOCATE(decomp_factor)
+   IF (ALLOCATED(pipe_density)) DEALLOCATE(pipe_density)
+   IF (ALLOCATED(tree_ff)) DEALLOCATE(tree_ff)
+   IF (ALLOCATED(pipe_tune1)) DEALLOCATE(pipe_tune1)
+   IF (ALLOCATED(pipe_tune2)) DEALLOCATE(pipe_tune2)
+   IF (ALLOCATED(pipe_tune3)) DEALLOCATE(pipe_tune3)
+   IF (ALLOCATED(pipe_tune4)) DEALLOCATE(pipe_tune4)
+   IF (ALLOCATED(pipe_k1)) DEALLOCATE(pipe_k1)
+   IF (ALLOCATED(pipe_tune_exp_coeff)) DEALLOCATE(pipe_tune_exp_coeff)
+   IF (ALLOCATED(mass_ratio_heart_sap)) DEALLOCATE(mass_ratio_heart_sap)
+   IF (ALLOCATED(canopy_cover)) DEALLOCATE(canopy_cover)
+   IF (ALLOCATED(nmaxtrees)) DEALLOCATE(nmaxtrees)
+   IF (ALLOCATED(height_init_min)) DEALLOCATE(height_init_min)
+   IF (ALLOCATED(height_init_max)) DEALLOCATE(height_init_max)
+   IF (ALLOCATED(alpha_self_thinning)) DEALLOCATE(alpha_self_thinning)
+   IF (ALLOCATED(beta_self_thinning)) DEALLOCATE(beta_self_thinning)
+   IF (ALLOCATED(fuelwood_diameter)) DEALLOCATE(fuelwood_diameter)
+   IF (ALLOCATED(coppice_kill_be_wood)) DEALLOCATE(coppice_kill_be_wood)
+   IF (ALLOCATED(lai_to_height)) DEALLOCATE(lai_to_height)
+   IF (ALLOCATED(deleuze_a)) DEALLOCATE(deleuze_a)
+   IF (ALLOCATED(deleuze_b)) DEALLOCATE(deleuze_b)
+   IF (ALLOCATED(deleuze_p_all)) DEALLOCATE(deleuze_p_all)
+   IF (ALLOCATED(deleuze_power)) DEALLOCATE(deleuze_power)
+   IF (ALLOCATED(m_dv)) DEALLOCATE(m_dv)
+   IF (ALLOCATED(h_first)) DEALLOCATE(h_first)
+   IF (ALLOCATED(dens_target)) DEALLOCATE(dens_target)
+   IF (ALLOCATED(thinstrat)) DEALLOCATE(thinstrat)
+   IF (ALLOCATED(taumin)) DEALLOCATE(taumin)
+   IF (ALLOCATED(taumax)) DEALLOCATE(taumax)
+   IF (ALLOCATED(alpha_rdi_upper)) DEALLOCATE(alpha_rdi_upper)
+   IF (ALLOCATED(beta_rdi_upper)) DEALLOCATE(beta_rdi_upper)
+   IF (ALLOCATED(alpha_rdi_lower)) DEALLOCATE(alpha_rdi_lower)
+   IF (ALLOCATED(beta_rdi_lower)) DEALLOCATE(beta_rdi_lower)
+   IF (ALLOCATED(largest_tree_dia)) DEALLOCATE(largest_tree_dia)
+   IF (ALLOCATED(branch_ratio)) DEALLOCATE(branch_ratio)
+   IF (ALLOCATED(coppice_diameter)) DEALLOCATE(coppice_diameter)
+   IF (ALLOCATED(shoots_per_stool)) DEALLOCATE(shoots_per_stool)
+   IF (ALLOCATED(src_rot_length)) DEALLOCATE(src_rot_length)
+   IF (ALLOCATED(src_nrots)) DEALLOCATE(src_nrots)
+   IF (ALLOCATED(fruit_alloc)) DEALLOCATE(fruit_alloc)
+   IF (ALLOCATED(labile_reserve)) DEALLOCATE(labile_reserve)
+   IF (ALLOCATED(evergreen_reserve)) DEALLOCATE(evergreen_reserve)
+   IF (ALLOCATED(deciduous_reserve)) DEALLOCATE(deciduous_reserve)
+   IF (ALLOCATED(senescense_reserve)) DEALLOCATE(senescense_reserve) 
+   IF (ALLOCATED(cn_leaf_prescribed)) DEALLOCATE(cn_leaf_prescribed)
+   IF (ALLOCATED(fcn_wood)) DEALLOCATE(fcn_wood)
+   IF (ALLOCATED(fcn_root)) DEALLOCATE(fcn_root)
+   IF (ALLOCATED(cn_leaf_init)) DEALLOCATE(cn_leaf_init)
+   IF (ALLOCATED(k_root)) DEALLOCATE(k_root)
+   IF (ALLOCATED(k_sap)) DEALLOCATE(k_sap)
+   IF (ALLOCATED(k_leaf)) DEALLOCATE(k_leaf)
+   IF (ALLOCATED(psi_leaf)) DEALLOCATE(psi_leaf)
+   IF (ALLOCATED(psi_50)) DEALLOCATE(psi_50)
+   IF (ALLOCATED(c_cavitation)) DEALLOCATE(c_cavitation)
+   IF (ALLOCATED(psi_soil_tune)) DEALLOCATE(psi_soil_tune)
+   IF (ALLOCATED(srl)) DEALLOCATE(srl)
+   IF (ALLOCATED(r_froot)) DEALLOCATE(r_froot)
+   IF (ALLOCATED(psi_root)) DEALLOCATE(psi_root)
+   IF (ALLOCATED(recruitment_pft)) DEALLOCATE(recruitment_pft)  
+   IF (ALLOCATED(recruitment_height)) DEALLOCATE(recruitment_height)  
+   IF (ALLOCATED(recruitment_alpha)) DEALLOCATE(recruitment_alpha)  
+   IF (ALLOCATED(recruitment_beta)) DEALLOCATE(recruitment_beta) 
+   IF (ALLOCATED(harvest_ratio)) DEALLOCATE(harvest_ratio)
+   IF (ALLOCATED(death_distribution_factor)) DEALLOCATE(death_distribution_factor)
+   IF (ALLOCATED(npp_reset_value)) DEALLOCATE(npp_reset_value)
+   IF (ALLOCATED(streamlining_c_leaf)) DEALLOCATE(streamlining_c_leaf)
+   IF (ALLOCATED(streamlining_c_leafless)) DEALLOCATE(streamlining_c_leafless)
+   IF (ALLOCATED(streamlining_n_leaf)) DEALLOCATE(streamlining_n_leaf)
+   IF (ALLOCATED(streamlining_n_leafless)) DEALLOCATE(streamlining_n_leafless)
+   IF (ALLOCATED(streamlining_rb_leaf)) DEALLOCATE(streamlining_rb_leaf)
+   IF (ALLOCATED(streamlining_rb_leafless)) DEALLOCATE(streamlining_rb_leafless)
+   IF (ALLOCATED(canopy_density_leaf)) DEALLOCATE(canopy_density_leaf)
+   IF (ALLOCATED(canopy_density_leafless)) DEALLOCATE(canopy_density_leafless)
+   IF (ALLOCATED(intercept_breadth)) DEALLOCATE(intercept_breadth)
+   IF (ALLOCATED(slope_breadth)) DEALLOCATE(slope_breadth)
+   IF (ALLOCATED(intercept_depth)) DEALLOCATE(intercept_depth)
+   IF (ALLOCATED(slope_depth)) DEALLOCATE(slope_depth)
+   IF (ALLOCATED(modulus_rupture)) DEALLOCATE(modulus_rupture)
+   IF (ALLOCATED(f_knot)) DEALLOCATE(f_knot)
+   IF (ALLOCATED(overturning_free_draining_shallow)) DEALLOCATE(overturning_free_draining_shallow)
+   IF (ALLOCATED(overturning_free_draining_shallow_leafless)) DEALLOCATE(overturning_free_draining_shallow_leafless)
+   IF (ALLOCATED(overturning_free_draining_deep)) DEALLOCATE(overturning_free_draining_deep)
+   IF (ALLOCATED(overturning_free_draining_deep_leafless)) DEALLOCATE(overturning_free_draining_deep_leafless)
+   IF (ALLOCATED(overturning_free_draining_average)) DEALLOCATE(overturning_free_draining_average)
+   IF (ALLOCATED(overturning_free_draining_average_leafless)) DEALLOCATE(overturning_free_draining_average_leafless)
+   IF (ALLOCATED(overturning_gleyed_shallow)) DEALLOCATE(overturning_gleyed_shallow)
+   IF (ALLOCATED(overturning_gleyed_shallow_leafless)) DEALLOCATE(overturning_gleyed_shallow_leafless)
+   IF (ALLOCATED(overturning_gleyed_deep)) DEALLOCATE(overturning_gleyed_deep)
+   IF (ALLOCATED(overturning_gleyed_deep_leafless)) DEALLOCATE(overturning_gleyed_deep_leafless)
+   IF (ALLOCATED(overturning_gleyed_average)) DEALLOCATE(overturning_gleyed_average)
+   IF (ALLOCATED(overturning_gleyed_average_leafless)) DEALLOCATE(overturning_gleyed_average_leafless)
+   IF (ALLOCATED(overturning_peaty_shallow)) DEALLOCATE(overturning_peaty_shallow)
+   IF (ALLOCATED(overturning_peaty_shallow_leafless)) DEALLOCATE(overturning_peaty_shallow_leafless)
+   IF (ALLOCATED(overturning_peaty_deep)) DEALLOCATE(overturning_peaty_deep)
+   IF (ALLOCATED(overturning_peaty_deep_leafless)) DEALLOCATE(overturning_peaty_deep_leafless)
+   IF (ALLOCATED(overturning_peaty_average)) DEALLOCATE(overturning_peaty_average)
+   IF (ALLOCATED(overturning_peaty_average_leafless)) DEALLOCATE(overturning_peaty_average_leafless)
+   IF (ALLOCATED(overturning_peat_shallow)) DEALLOCATE(overturning_peat_shallow)
+   IF (ALLOCATED(overturning_peat_shallow_leafless)) DEALLOCATE(overturning_peat_shallow_leafless)
+   IF (ALLOCATED(overturning_peat_deep)) DEALLOCATE(overturning_peat_deep)
+   IF (ALLOCATED(overturning_peat_deep_leafless)) DEALLOCATE(overturning_peat_deep_leafless)
+   IF (ALLOCATED(overturning_peat_average)) DEALLOCATE(overturning_peat_average)
+   IF (ALLOCATED(overturning_peat_average_leafless)) DEALLOCATE(overturning_peat_average_leafless)
+   IF (ALLOCATED(max_damage_further)) DEALLOCATE(max_damage_further)
+   IF (ALLOCATED(max_damage_closer)) DEALLOCATE(max_damage_closer)
+   IF (ALLOCATED(sfactor_further)) DEALLOCATE(sfactor_further)
+   IF (ALLOCATED(sfactor_closer)) DEALLOCATE(sfactor_closer)
+   IF (ALLOCATED(green_density)) DEALLOCATE(green_density)
+ 
+
+ END SUBROUTINE pft_parameters_clear
+
+END MODULE pft_parameters
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/pft_parameters_var.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/pft_parameters_var.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/pft_parameters_var.f90	(revision 6412)
@@ -0,0 +1,1211 @@
+! =================================================================================================================================
+! MODULE       : pft_parameters_var
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module contains the variables in function of plant funtional type (pft).
+!!
+!!\n DESCRIPTION: This module contains the declarations for the externalized variables in function of the 
+!!                plant foncional type(pft). \n
+!!                The module is already USE in module pft_parameters. Therefor no need to USE it seperatly except
+!!                if the subroutines in module pft_parameters are not needed.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE pft_parameters_var
+
+  USE defprec
+  
+  IMPLICIT NONE
+
+
+  !
+  ! PFT GLOBAL
+  !
+  INTEGER(i_std), SAVE :: nvm = 13                               !! Number of vegetation types (2-N, unitless)
+!$OMP THREADPRIVATE(nvm)
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pft_to_mtc  !! Table of conversion : we associate one pft to one metaclass 
+                                                                 !! (1-13, unitless)
+!$OMP THREADPRIVATE(pft_to_mtc)
+
+  CHARACTER(LEN=34), ALLOCATABLE, SAVE, DIMENSION(:) :: PFT_name !! Description of the PFT (unitless)
+!$OMP THREADPRIVATE(PFT_name)
+
+  LOGICAL, SAVE   :: l_first_pft_parameters = .TRUE.             !! To keep first call trace of the module (true/false)
+!$OMP THREADPRIVATE(l_first_pft_parameters)
+
+  !
+  ! VEGETATION STRUCTURE
+  !
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaf_tab       !! leaf type (1-4, unitless)
+                                                                    !! 1=broad leaved tree, 2=needle leaved tree, 
+                                                                    !! 3=grass 4=bare ground 
+!$OMP THREADPRIVATE(leaf_tab)
+
+  CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_model  !! which phenology model is used? (tabulated) (unitless)
+!$OMP THREADPRIVATE(pheno_model)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_tree               !! Is the vegetation type a tree ? (true/false)
+!$OMP THREADPRIVATE(is_tree)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_deciduous          !! Is PFT deciduous ? (true/false)
+!$OMP THREADPRIVATE(is_deciduous)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_evergreen          !! Is PFT evegreen ? (true/false)
+!$OMP THREADPRIVATE(is_evergreen)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_needleleaf         !! Is PFT needleleaf ? (true/false)
+!$OMP THREADPRIVATE(is_needleleaf)
+ 
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_tropical           !! Is PFT tropical ? (true/false)
+!$OMP THREADPRIVATE(is_tropical)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_temperate          !! Is PFT temperate ? (true/false)
+!$OMP THREADPRIVATE(is_temperate)
+   
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_boreal             !! Is PFT boreal ? (true/false)
+!$OMP THREADPRIVATE(is_boreal)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: natural               !! natural? (true/false)
+!$OMP THREADPRIVATE(natural)
+
+  CHARACTER(len=5), ALLOCATABLE, SAVE, DIMENSION(:) :: type_of_lai  !! Type of behaviour of the LAI evolution algorithm 
+                                                                    !! for each vegetation type.
+                                                                    !! Value of type_of_lai, one for each vegetation type :
+                                                                    !! mean or interp
+!$OMP THREADPRIVATE(type_of_lai)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: veget_ori_fixed_test_1 !! Value for veget_ori for tests in 0-dim simulations 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(veget_ori_fixed_test_1)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: llaimax                !! laimax for maximum lai see also type of lai 
+                                                                         !! interpolation
+                                                                         !! @tex $(m^2.m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(llaimax)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: llaimin                !! laimin for minimum lai see also type of lai 
+                                                                         !! interpolation 
+                                                                         !! @tex $(m^2.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(llaimin)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: height_presc           !! prescribed height of vegetation.(m)
+                                                                         !! Value for height_presc : one for each vegetation type
+!$OMP THREADPRIVATE(height_presc)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: z0_over_height        !! Factor to calculate roughness height from 
+                                                                        !! vegetation height (unitless)   
+!$OMP THREADPRIVATE(z0_over_height)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ratio_z0m_z0h         !! Ratio between z0m and z0h
+!$OMP THREADPRIVATE(ratio_z0m_z0h)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) ::  rveg_pft              !! Potentiometer to set vegetation resistance (unitless)
+                                                                         !! Nathalie on March 28th, 2006 - from Fred Hourdin,
+!$OMP THREADPRIVATE(rveg_pft)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: sla                    !! specif leaf area @tex $(m^2.gC^{-1})$ @endtex 
+!$OMP THREADPRIVATE(sla)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: slainit                !! specif leaf area @tex $(m^2.gC^{-1})$ @endtex 
+!$OMP THREADPRIVATE(slainit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: availability_fact      !! calculate dynamic mortality in lpj_gap
+!$OMP THREADPRIVATE(availability_fact)
+
+  !
+  ! EVAPOTRANSPIRATION (sechiba)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: rstruct_const          !! Structural resistance. 
+                                                                         !! Value for rstruct_const : one for each vegetation type
+                                                                         !! @tex $(s.m^{-1})$ @endtex
+!$OMP THREADPRIVATE(rstruct_const)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: kzero                  !! A vegetation dependent constant used in the calculation
+                                                                         !! of the surface resistance. 
+                                                                         !! Value for kzero one for each vegetation type
+                                                                         !! @tex $(kg.m^2.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(kzero)
+
+  !
+  ! WATER (sechiba)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: wmax_veg  !! Volumetric available soil water capacity in each PFT
+                                                            !! @tex $(kg.m^{-3} of soil)$ @endtex
+!$OMP THREADPRIVATE(wmax_veg)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: humcste   !! Root profile description for the different vegetation types.
+                                                            !! These are the factor in the exponential which gets
+                                                            !! the root density as a function of depth 
+                                                            !! @tex $(m^{-1})$ @endtex
+!$OMP THREADPRIVATE(humcste)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: throughfall_by_pft !! Fraction of rain intercepted by the canopy (0-100, unitless)
+!$OMP THREADPRIVATE(throughfall_by_pft)
+
+  !
+  ! ALBEDO (sechiba)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_aged    !! Minimum snow albedo value for each vegetation type
+                                                                !! after aging (dirty old snow) (unitless)
+                                                                !! Source : Values are from the Thesis of S. Chalita (1992)
+!$OMP THREADPRIVATE(snowa_aged)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_dec     !! Decay rate ofsnow albedo value for each vegetation type
+                                                                !! as it will be used in condveg_snow (unitless)
+                                                                !! Source : Values are from the Thesis of S. Chalita (1992)
+!$OMP THREADPRIVATE(snowa_dec)
+
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: leaf_ssa       !! leaf single scattering albedo of all 
+!$OMP THREADPRIVATE(leaf_ssa)
+
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: leaf_psd       !! leaf prefered scattering direction of all 
+                                                                       !! vegetation types and spectra (unitless)
+!$OMP THREADPRIVATE(leaf_psd)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: bgd_reflectance  !! background reflectance of all vegetation types and spectra (unitless)
+!$OMP THREADPRIVATE(bgd_reflectance)
+
+
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaf_to_shoot_clumping       !! The clumping factor for leaves to shoots in the 
+                                                                               !! effective LAI calculation...notice this should be
+                                                                               !! equal to unity for grasslands/croplands
+!$OMP THREADPRIVATE(leaf_to_shoot_clumping)
+
+
+! NOTE: this next variable originally was a plant-to-stand clumping factor to be used
+! in describing how grasses and crops clump together at the plant level (but not trees, 
+! as their plant-to-stand clumping is calculated directly) to calculate abledo. However, we
+! get the effective spectral parameters for the albedo calculation from inverting satelite data,
+! which includes all clumping.  Therefore we do not wish to account for this effect twice.
+! What will be incorrect about our grassland and crop albedo is the lack of management options
+! for these PFTs in ORCHIDEE, which will lead to LAI values which are wrong.  Thus we 
+! will include an LAI correction factor in the calculation of the effective LAI which
+! allows us to compensate for this via tuning. 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_correction_factor  !! see note above
+!$OMP THREADPRIVATE(lai_correction_factor)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: min_level_sep          !! This is used in determining the levels
+                                                                         !! for photosynthesis.  This is the thinnest
+                                                                         !! that the levels are allowed to be, in 
+                                                                         !! vertical thickness.
+                                                                         !! @tex $(m)$ @endtex
+!$OMP THREADPRIVATE(min_level_sep)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_top                !!Diffuco.f90 calculates the stomatal conductance of the
+                                                                         !! top layer of the canopy. Because the top layer can contain
+                                                                         !! different amounts of LAI depending on the crown diameter
+                                                                         !! we had to define top layer in terms of the LAI it contains.
+                                                                         !! stomatal conductance in the top layer contributes to the
+                                                                         !! transpiration (m2 m-2). Arbitrary values.
+!$OMP THREADPRIVATE(lai_top) 
+
+  !
+  ! SOIL - VEGETATION
+  !
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pref_soil_veg      !! Table which contains the correlation between the soil
+                                                                        !! types and vegetation type. Two modes exist :
+                                                                        !! 1) pref_soil_veg = 0 then we have an equidistribution
+                                                                        !!    of vegetation on soil types
+                                                                        !! 2) Else for each pft the prefered soil type is given :
+                                                                        !!    1=sand, 2=loan, 3=clay
+                                                                        !! This variable is initialized in slowproc.(1-3, unitless)
+!$OMP THREADPRIVATE(pref_soil_veg)
+
+  !
+  ! PHOTOSYNTHESIS
+  !
+  !-
+  ! 1. CO2
+  !-
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_c4             !! flag for C4 vegetation types (true/false)
+!$OMP THREADPRIVATE(is_c4)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: vcmax_fix     !! values used for vcmax when STOMATE is not activated
+                                                                !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(vcmax_fix)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: downregulation_co2_coeff !! Coefficient for CO2 downregulation (unitless)
+!$OMP THREADPRIVATE(downregulation_co2_coeff)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_KmC         !! Energy of activation for KmC (J mol-1)
+!$OMP THREADPRIVATE(E_KmC)                                                               
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_KmO         !! Energy of activation for KmO (J mol-1)
+!$OMP THREADPRIVATE(E_KmO)         
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_Sco         !! Energy of activation for Sco (J mol-1) 
+!$OMP THREADPRIVATE(E_Sco) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_gamma_star  !! Energy of activation for gamma_star (J mol-1)
+!$OMP THREADPRIVATE(E_gamma_star)    
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_Vcmax       !! Energy of activation for Vcmax (J mol-1) 
+!$OMP THREADPRIVATE(E_Vcmax)                                                              
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_Jmax        !! Energy of activation for Jmax (J mol-1)
+!$OMP THREADPRIVATE(E_Jmax) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: aSV           !! a coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax (J K-1 mol-1)
+!$OMP THREADPRIVATE(aSV)    
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: bSV           !! b coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax (J K-1 mol-1 Â°C-1)
+!$OMP THREADPRIVATE(bSV)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_min   !! minimum photosynthesis temperature (deg C)
+!$OMP THREADPRIVATE(tphoto_min) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_max   !! maximum photosynthesis temperature (deg C)
+!$OMP THREADPRIVATE(tphoto_max) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: aSJ           !! a coefficient of the linear regression (a+bT) defining the Entropy term for Jmax (J K-1 mol-1)
+!$OMP THREADPRIVATE(aSJ)    
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: bSJ           !! b coefficient of the linear regression (a+bT) defining the Entropy term for Jmax (J K-1 mol-1 Â°C-1)
+!$OMP THREADPRIVATE(bSJ)    
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: D_Vcmax       !! Energy of deactivation for Vcmax (J mol-1)
+!$OMP THREADPRIVATE(D_Vcmax)                     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: D_Jmax        !! Energy of deactivation for Jmax (J mol-1)
+!$OMP THREADPRIVATE(D_Jmax)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_gm          !! Energy of activation for gm (J mol-1)  
+!$OMP THREADPRIVATE(E_gm)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: S_gm          !! Entropy term for gm (J K-1 mol-1)  
+!$OMP THREADPRIVATE(S_gm)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: D_gm          !! Energy of deactivation for gm (J mol-1)  
+!$OMP THREADPRIVATE(D_gm)                                    
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_Rd          !! Energy of activation for Rd (J mol-1)
+!$OMP THREADPRIVATE(E_Rd)                                      
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: Vcmax25       !! Maximum rate of Rubisco activity-limited carboxylation at 25Â°C
+                                                                !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(Vcmax25)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: arJV          !! a coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio (mu mol e- (mu mol CO2)-1)
+!$OMP THREADPRIVATE(arJV)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: brJV          !! b coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio (mu mol e- (mu mol CO2)-1)
+!$OMP THREADPRIVATE(brJV)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: KmC25         !! MichaelisâMenten constant of Rubisco for CO2 at 25Â°C (ubar)
+!$OMP THREADPRIVATE(KmC25)                                     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: KmO25         !! MichaelisâMenten constant of Rubisco for O2 at 25Â°C (ubar)
+!$OMP THREADPRIVATE(KmO25)     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: Sco25         !! Relative CO2 /O2 specificity factor for Rubisco at 25Â°C (bar bar-1) 
+!$OMP THREADPRIVATE(Sco25)           
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gamma_star25  !! Ci-based CO2 compensation point in the absence of Rd at 25Â°C (ubar)
+!$OMP THREADPRIVATE(gamma_star25)   
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gm25          !! Mesophyll diffusion conductance at 25Â°C (mol mÃ¢2 sÃ¢1 barÃ¢1) 
+!$OMP THREADPRIVATE(gm25)    
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: a1            !! Empirical factor involved in the calculation of fvpd (-)
+!$OMP THREADPRIVATE(a1)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: b1            !! Empirical factor involved in the calculation of fvpd (-)
+!$OMP THREADPRIVATE(b1)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: g0            !! Residual stomatal conductance when irradiance approaches zero (mol mâ2 sâ1 barâ1)
+!$OMP THREADPRIVATE(g0)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: h_protons     !! Number of protons required to produce one ATP (mol mol-1)
+!$OMP THREADPRIVATE(h_protons)                                 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: fpsir         !! Fraction of PSII eâ transport rate partitioned to the C4 cycle (-)
+!$OMP THREADPRIVATE(fpsir)                                         
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: fQ            !! Fraction of electrons at reduced plastoquinone that follow the Q-cycle (-) - Values for C3 platns are not used
+!$OMP THREADPRIVATE(fQ)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: fpseudo       !! Fraction of electrons at PSI that follow  pseudocyclic transport (-) - Values for C3 platns are not used
+!$OMP THREADPRIVATE(fpseudo)                                   
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: kp            !! Initial carboxylation efficiency of the PEP carboxylase (mol mâ2 sâ1 barâ1) 
+!$OMP THREADPRIVATE(kp)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alpha         !! Fraction of PSII activity in the bundle sheath (-)
+!$OMP THREADPRIVATE(alpha)                                     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gbs           !! Bundle-sheath conductance (mol mâ2 sâ1 barâ1)
+!$OMP THREADPRIVATE(gbs)                                       
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: theta         !! Convexity factor for response of J to irradiance (-)
+!$OMP THREADPRIVATE(theta)                                     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alpha_LL      !! Conversion efficiency of absorbed light into J at strictly limiting light (mol eâ (mol photon)â1)
+!$OMP THREADPRIVATE(alpha_LL)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: stress_vcmax  !! Stress on vcmax 
+!$OMP THREADPRIVATE(stress_vcmax) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: stress_gs     !! Stress on vcmax 
+!$OMP THREADPRIVATE(stress_gs) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: stress_gm     !! Stress on vcmax 
+!$OMP THREADPRIVATE(stress_gm)
+
+  !-
+  ! 2. Stomate
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ext_coeff     !! extinction coefficient of the Monsi&Saeki relationship (1953)
+                                                                !! (unitless)
+!$OMP THREADPRIVATE(ext_coeff)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ext_coeff_vegetfrac     !! extinction coefficient used for the calculation of the 
+                                                                !! bare soil fraction (unitless)
+!$OMP THREADPRIVATE(ext_coeff_vegetfrac)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ext_coeff_N   !! extinction coefficient of the leaf N content profile within the canopy
+                                                                !! ((m2[ground]) (m-2[leaf]))
+                                                                !! based on Dewar et al. (2012, value of 0.18), on Carswell et al. (2000, value of 0.11 used in OCN) 
+!$OMP THREADPRIVATE(ext_coeff_N)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: nue_opt       !! Nitrogen use efficiency of Vcmax 
+                                                                !! ((mumol[CO2] s-1) (gN[leaf])-1)
+                                                                !! based on the work of Kattge et al. (2009, GCB)
+!$OMP THREADPRIVATE(nue_opt)
+
+
+  !
+  ! RESPIRATION (stomate)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: frac_growthresp  !! fraction of GPP which is lost as growth respiration
+
+!$OMP THREADPRIVATE(frac_growthresp)
+
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: maint_resp_slope  !! slope of maintenance respiration coefficient 
+                                                                      !! (1/K, 1/K^2, 1/K^3), used in the code
+!$OMP THREADPRIVATE(maint_resp_slope)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_c  !! slope of maintenance respiration coefficient (1/K),
+                                                                      !! constant c of aT^2+bT+c , tabulated
+!$OMP THREADPRIVATE(maint_resp_slope_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_b  !! slope of maintenance respiration coefficient (1/K), 
+                                                                      !! constant b of aT^2+bT+c , tabulated
+!$OMP THREADPRIVATE(maint_resp_slope_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_a  !! slope of maintenance respiration coefficient (1/K), 
+                                                                      !! constant a of aT^2+bT+c , tabulated
+!$OMP THREADPRIVATE(maint_resp_slope_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_maint_init    !! maintenance respiration coefficient at 10 deg C,
+                                                                      !! @tex $(gC.gN^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(coeff_maint_init)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tref_maint_resp     !! maintenance respiration Temperature coefficient,
+                                                                      !! @tex $(degC)$ @endtex
+!$OMP THREADPRIVATE(tref_maint_resp)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmin_maint_resp     !! maintenance respiration Temperature coefficient,
+                                                                      !! @tex $(degC)$ @endtex
+!$OMP THREADPRIVATE(tmin_maint_resp)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: e0_maint_resp     !! maintenance respiration Temperature coefficient,
+                                                                      !! @tex $(unitless)$ @endtex
+!$OMP THREADPRIVATE(e0_maint_resp)
+
+ 
+  !
+  ! FIRE (stomate)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: flam              !! flamability : critical fraction of water holding 
+                                                                    !! capacity (0-1, unitless)
+!$OMP THREADPRIVATE(flam)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: resist            !! fire resistance (0-1, unitless)
+!$OMP THREADPRIVATE(resist)
+
+
+  !
+  ! FLUX - LUC (Land Use Change)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_1   !! Coeff of biomass export for the year (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_1)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_10  !! Coeff of biomass export for the decade (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_10)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_100 !! Coeff of biomass export for the century (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_100)
+ 
+  !
+  ! FLUX - LUC (Land Use Change)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_s   !! Coeff of biomass export for the year (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_s)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_m  !! Coeff of biomass export for the decade (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_m)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_l  !! Coeff of biomass export for the century (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_l)
+ 
+  !
+  ! PHENOLOGY
+  !
+  !-
+  ! 1. Stomate
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_max_to_happy  !! threshold of LAI below which plant uses carbohydrate reserves
+!$OMP THREADPRIVATE(lai_max_to_happy)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_max           !! maximum LAI, PFT-specific @tex $(m^2.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(lai_max)
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_type     !! type of phenology (0-4, unitless)
+                                                                    !! 0=bare ground 1=evergreen,  2=summergreen, 
+                                                                    !! 3=raingreen,  4=perennial
+                                                                    !! For the moment, the bare ground phenotype is not managed, 
+                                                                    !! so it is considered as "evergreen"
+!$OMP THREADPRIVATE(pheno_type)
+
+  !-
+  ! 2. Leaf Onset
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: pheno_gdd_crit   !! critical gdd,tabulated (C), used in the code
+!$OMP THREADPRIVATE(pheno_gdd_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_c   !! critical gdd,tabulated (C), 
+                                                                     !! constant c of aT^2+bT+c (unitless)
+!$OMP THREADPRIVATE(pheno_gdd_crit_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_b   !! critical gdd,tabulated (C), 
+                                                                     !! constant b of aT^2+bT+c (unitless)
+!$OMP THREADPRIVATE(pheno_gdd_crit_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_a   !! critical gdd,tabulated (C), 
+                                                                     !! constant a of aT^2+bT+c (unitless)
+!$OMP THREADPRIVATE(pheno_gdd_crit_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_moigdd_t_crit!! Monthly avearage temperature treashold used for C4 grass (C)
+!$OMP THREADPRIVATE(pheno_moigdd_t_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ngd_crit           !! critical ngd,tabulated. Threshold -5 degrees (days)
+!$OMP THREADPRIVATE(ngd_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ncdgdd_temp        !! critical temperature for the ncd vs. gdd function
+                                                                     !! in phenology (C)
+!$OMP THREADPRIVATE(ncdgdd_temp)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: hum_frac           !! critical humidity (relative to min/max) for phenology
+                                                                     !! (0-1, unitless)
+!$OMP THREADPRIVATE(hum_frac)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: hum_min_time       !! minimum time elapsed since moisture minimum (days)
+!$OMP THREADPRIVATE(hum_min_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_sap            !! sapwood -> heartwood conversion time (days)
+!$OMP THREADPRIVATE(tau_sap)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_leaf           !! leaf turnover (1/years)
+!$OMP THREADPRIVATE(tau_leaf)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_fruit          !! fruit lifetime (days)
+!$OMP THREADPRIVATE(tau_fruit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_root           !! root turnover (1/days)
+!$OMP THREADPRIVATE(tau_root)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_leafinit  !! time to attain the initial foliage using the carbohydrate reserve
+!$OMP THREADPRIVATE(tau_leafinit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ecureuil           !! fraction of primary leaf and root allocation put
+                                                                     !! into reserve (0-1, unitless)
+!$OMP THREADPRIVATE(ecureuil)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alloc_min          !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
+!$OMP THREADPRIVATE(alloc_min)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alloc_max          !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
+!$OMP THREADPRIVATE(alloc_max)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: demi_alloc         !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
+!$OMP THREADPRIVATE(demi_alloc)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaflife_tab       !! leaf longevity, tabulated (??units??)
+!$OMP THREADPRIVATE(leaflife_tab)
+
+  !-
+  ! 3. Senescence
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaffall              !! length of death of leaves,tabulated (days)
+!$OMP THREADPRIVATE(leaffall)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leafagecrit           !! critical leaf age,tabulated (days)
+!$OMP THREADPRIVATE(leafagecrit)
+
+  CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_type  !! type of senescence,tabulated (unitless)
+                                                                        !! List of avaible types of senescence :
+                                                                        !! 'cold  ', 'dry   ', 'mixed ', 'none  '
+!$OMP THREADPRIVATE(senescence_type)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_hum        !! critical relative moisture availability for senescence
+                                                                        !! (0-1, unitless)
+!$OMP THREADPRIVATE(senescence_hum)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: nosenescence_hum      !! relative moisture availability above which there is
+                                                                        !! no humidity-related senescence (0-1, unitless)
+!$OMP THREADPRIVATE(nosenescence_hum)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: max_turnover_time     !! maximum turnover time for grasses (days)
+!$OMP THREADPRIVATE(max_turnover_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: min_turnover_time     !! minimum turnover time for grasses (days)
+!$OMP THREADPRIVATE(min_turnover_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: recycle_leaf          !! Fraction of N leaf that is recycled when leaves are senescent
+!$OMP THREADPRIVATE(recycle_leaf)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: recycle_root          !! Fraction of N root that is recycled when leaves are senescent
+!$OMP THREADPRIVATE(recycle_root)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: min_leaf_age_for_senescence  !! minimum leaf age to allow senescence g (days)
+!$OMP THREADPRIVATE(min_leaf_age_for_senescence)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: senescence_temp     !! critical temperature for senescence (C),
+                                                                        !! used in the code
+!$OMP THREADPRIVATE(senescence_temp)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_c     !! critical temperature for senescence (C), 
+                                                                        !! constant c of aT^2+bT+c , tabulated (unitless)
+!$OMP THREADPRIVATE(senescence_temp_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_b     !! critical temperature for senescence (C), 
+                                                                        !! constant b of aT^2+bT+c , tabulated (unitless)
+!$OMP THREADPRIVATE(senescence_temp_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_a     !! critical temperature for senescence (C),
+                                                                        !! constant a of aT^2+bT+c , tabulated (unitless)
+!$OMP THREADPRIVATE(senescence_temp_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gdd_senescence        !! minimum gdd to allow senescence of crops (days)
+!$OMP THREADPRIVATE(gdd_senescence)
+
+  !-
+  ! 4. N cycle
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cn_leaf_min           !! minimum CN ratio of leaves (gC/gN)
+!$OMP THREADPRIVATE(cn_leaf_min)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cn_leaf_max           !! maximum CN ratio of leaves (gC/gN) 
+!$OMP THREADPRIVATE(cn_leaf_max)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: max_soil_n_bnf        !! Value of total N (NH4+NO3) 
+                                                                        !! above which we stop adding N via BNF
+                                                                        !! (gN/m**2)
+!$OMP THREADPRIVATE(max_soil_n_bnf)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: manure_pftweight      !! Weight of the distribution of manure over the PFT surface
+!$OMP THREADPRIVATE(manure_pftweight)
+
+!
+  ! Crop harvest
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: harvest_ratio  !! Share of biomass that is removed from the site during harvest
+                                                                    !! A high value indicates a high harvest efficiency and thus a 
+                                                                    !! input of residuals. (unitless, 0-1).
+
+!$OMP THREADPRIVATE(harvest_ratio)
+
+  !
+  ! STOMATE - Age classes
+  !
+
+  INTEGER(i_std), SAVE                            :: nvmap          !! The number of PFTs we have if we ignore age classes.
+                                                                    !! @tex $-$ @endtex
+!$OMP THREADPRIVATE(nvmap) 
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: agec_group     !! The age class group that this PFT belongs to.
+                                                                    !! If you're not using age classes, this will just be
+                                                                    !! set to the number of the PFT and should be ignored
+                                                                    !! in the code.
+                                                                    !! @tex $-$ @endtex
+!$OMP THREADPRIVATE(agec_group) 
+! I do not like the location of these next two variables.  They are computed
+! after agec_group is read in.  Ideally, they would be passed around
+! as arguments or in a structure, since they are not really
+! parameters read in from the input file.
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: start_index    !! Gives the index that this real PFT starts
+                                                                    !! on, ignoring age classes
+                                                                    !! @tex $-$ @endtex
+!$OMP THREADPRIVATE(start_index) 
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: nagec_pft      !! The number of age classes for each PFT.
+                                                                    !! Only 1 or nagec are supported right now.
+                                                                    !! @tex $-$ @endtex
+!$OMP THREADPRIVATE(nagec_pft) 
+
+  !
+  ! DGVM
+  !
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: residence_time        !! residence time of trees (y) 
+!$OMP THREADPRIVATE(residence_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmin_crit             !! critical tmin, tabulated (C)
+!$OMP THREADPRIVATE(tmin_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tcm_crit              !! critical tcm, tabulated (C)
+!$OMP THREADPRIVATE(tcm_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)   :: mortality_min     !! Asymptotic mortality if plant growth exceeds long term
+                                                                    !! NPP @tex $(year^{-1})$ @endtex
+!$OMP THREADPRIVATE(mortality_min) 
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)   :: mortality_max     !! Maximum mortality if plants hardly grows
+                                                                    !! @tex $(year^{-1})$ @endtex
+!$OMP THREADPRIVATE(mortality_max) 
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)   :: ref_mortality     !! Reference mortality rate used to calculate mortality
+                                                                    !! as a function of the plant vigor @tex $(year^{-1})$ @endtex
+!$OMP THREADPRIVATE(ref_mortality)
+
+  !
+  ! Biogenic Volatile Organic Compounds
+  !
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_isoprene       !! Isoprene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_isoprene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_monoterpene    !! Monoterpene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_monoterpene)
+
+  REAL(r_std), SAVE :: LDF_mono                                            !! monoterpenes fraction dependancy to light
+!$OMP THREADPRIVATE(LDF_mono) 
+  REAL(r_std), SAVE :: LDF_sesq                                            !! sesquiterpenes fraction dependancy to light
+!$OMP THREADPRIVATE(LDF_sesq)
+  REAL(r_std), SAVE :: LDF_meth                                            !! methanol fraction dependancy to light
+!$OMP THREADPRIVATE(LDF_meth)
+  REAL(r_std), SAVE :: LDF_acet                                            !! acetone fraction dependancy to light
+!$OMP THREADPRIVATE(LDF_acet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_apinene        !! Alfa pinene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_apinene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_bpinene        !! Beta pinene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_bpinene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_limonene       !! Limonene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_limonene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_myrcene        !! Myrcene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_myrcene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_sabinene       !! Sabinene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_sabinene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_camphene       !! Camphene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_camphene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_3carene        !! 3-carene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_3carene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_tbocimene      !! T-beta-ocimene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_tbocimene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_othermonot     !! Other monoterpenes emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_othermonot)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_sesquiterp     !! Sesquiterpene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_sesquiterp)
+
+  REAL(r_std), SAVE :: beta_mono                                           !! Monoterpenes temperature dependency coefficient 
+!$OMP THREADPRIVATE(beta_mono)
+  REAL(r_std), SAVE :: beta_sesq                                           !! Sesquiterpenes temperature dependency coefficient
+!$OMP THREADPRIVATE(beta_sesq)
+  REAL(r_std), SAVE :: beta_meth                                           !! Methanol temperature dependency coefficient 
+!$OMP THREADPRIVATE(beta_meth)
+  REAL(r_std), SAVE :: beta_acet                                           !! Acetone temperature dependency coefficient
+!$OMP THREADPRIVATE(beta_acet)
+  REAL(r_std), SAVE :: beta_oxyVOC                                         !! Other oxygenated BVOC temperature dependency coefficient
+!$OMP THREADPRIVATE(beta_oxyVOC)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_ORVOC          !! ORVOC emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_ORVOC)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_OVOC           !! OVOC emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_OVOC)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_MBO            !! MBO emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_MBO)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_methanol       !! Methanol emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_methanol)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetone        !! Acetone emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_acetone)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetal         !! Acetaldehyde emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_acetal)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_formal         !! Formaldehyde emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_formal)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetic         !! Acetic Acid emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_acetic)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_formic         !! Formic Acid emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_formic)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_no_wet         !! NOx emissions factor soil emissions and 
+                                                                           !! exponential dependancy factor for wet soils
+                                                                           !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_no_wet)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_no_dry         !! NOx emissions factor soil emissions and
+                                                                           !! exponential dependancy factor for dry soils
+                                                                           !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_no_dry)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: Larch                    !! Larcher 1991 SAI/LAI ratio (unitless)
+!$OMP THREADPRIVATE(Larch)
+
+  !
+  ! INTERNAL PARAMETERS USED IN STOMATE_DATA
+  !
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_initmin   !! Initial lai for trees/grass 
+                                                                !! @tex $(m^2.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(lai_initmin)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bm_sapl   !! sapling biomass @tex $(gC.ind^{-1})$ @endtex
+!$OMP THREADPRIVATE(bm_sapl)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: migrate       !! migration speed @tex $(m.year^{-1})$ @endtex
+!$OMP THREADPRIVATE(migrate)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maxdia        !! maximum stem diameter from which on crown area no longer 
+                                                                !! increases (m)
+!$OMP THREADPRIVATE(maxdia)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cn_sapl       !! crown of tree when sapling  @tex $(m^2$)$ @endtex
+!$OMP THREADPRIVATE(cn_sapl)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaf_timecst  !! time constant for leaf age discretisation (days)
+!$OMP THREADPRIVATE(leaf_timecst)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: k_latosa_max       !! Maximum leaf-to-sapwood area ratio (unitless)
+!$OMP THREADPRIVATE(k_latosa_max)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: k_latosa_min       !! Minimum leaf-to-sapwood area ratio (unitless)
+!$OMP THREADPRIVATE(k_latosa_min)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: LC                 !! Lignin/C ratio of the different biomass pools and PFTs (unitless)
+                                                                      !! based on CN from White et al. (2000) 
+!$OMP THREADPRIVATE(LC)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: LC_leaf              !! Lignin/C ratio of leaf pool (unitless)
+                                                                      !! based on CN from White et al. (2000) 
+!$OMP THREADPRIVATE(LC_leaf)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: LC_sapabove          !! Lignin/C ratio of sapabove pool (unitless)
+                                                                      !! based on CN from White et al. (2000) 
+!$OMP THREADPRIVATE(LC_sapabove)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: LC_sapbelow          !! Lignin/C ratio of sapbelow pool (unitless)
+                                                                      !! based on CN from White et al. (2000) 
+!$OMP THREADPRIVATE(LC_sapbelow)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: LC_heartabove        !! Lignin/C ratio of heartabove pool (unitless)
+                                                                      !! based on CN from White et al. (2000) 
+!$OMP THREADPRIVATE(LC_heartabove)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: LC_heartbelow        !! Lignin/C ratio of heartbelow pool (unitless)
+                                                                      !! based on CN from White et al. (2000) 
+!$OMP THREADPRIVATE(LC_heartbelow)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: LC_fruit             !! Lignin/C ratio of fruit pool (unitless)
+                                                                      !! based on CN from White et al. (2000) 
+!$OMP THREADPRIVATE(LC_fruit)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: LC_root              !! Lignin/C ratio of root pool (unitless)
+                                                                      !! based on CN from White et al. (2000) 
+!$OMP THREADPRIVATE(LC_root)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: LC_carbres           !! Lignin/C ratio of carbres pool (unitless)
+                                                                      !! based on CN from White et al. (2000) 
+!$OMP THREADPRIVATE(LC_carbres)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: LC_labile            !! Lignin/C ratio of labile pool (unitless)
+                                                                      !! based on CN from White et al. (2000) 
+!$OMP THREADPRIVATE(LC_labile)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: decomp_factor        !! Multpliactive factor modifying 
+                                                                      !! the standard decomposition factor for each SOM pool
+!$OMP THREADPRIVATE(decomp_factor)
+
+   !
+  ! STAND STRUCTURE (stomate) 
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pipe_density        !! Wood density in @tex $(gC.m^{-3})$ @endtex
+!$OMP THREADPRIVATE(pipe_density)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pipe_tune1          !! crown area = pipe_tune1*stem diameter**pipe_tune_exp_coeff
+!$OMP THREADPRIVATE(pipe_tune1)
+  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pipe_tune2          !! height=pipe_tune2 * diameter**pipe_tune3
+!$OMP THREADPRIVATE(pipe_tune2)      
+  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pipe_tune3          !! height=pipe_tune2 * diameter**pipe_tune3
+!$OMP THREADPRIVATE(pipe_tune3)      
+  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pipe_tune4          !! ???needed for stem diameter
+!$OMP THREADPRIVATE(pipe_tune4)      
+  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pipe_k1             !! ???
+!$OMP THREADPRIVATE(pipe_k1)       
+  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pipe_tune_exp_coeff !! crown area = pipe_tune1*stem diameter**pipe_tune_exp_coeff
+!$OMP THREADPRIVATE(pipe_tune_exp_coeff)      
+  
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tree_ff             !! Volume reduction factor from cylinder to real tree shape (inc.branches)
+!$OMP THREADPRIVATE(tree_ff)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: mass_ratio_heart_sap!! mass ratio (heartwood+sapwood)/heartwood 
+!$OMP THREADPRIVATE(mass_ratio_heart_sap)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: canopy_cover        !! Canopy cover - current values are guesses for testing
+                                                                      !! could tune this variable to match MODIS albedo
+!$OMP THREADPRIVATE(canopy_cover)
+   
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: nmaxtrees         !! Intial number of seedlings per hectare. Used 
+                                                                    !! in prescribe to initialize the model and after 
+                                                                    !! every clearcut
+!$OMP THREADPRIVATE(nmaxtrees)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: height_init_min   !! The minimum height of a tree sapling when a forest 
+                                                                    !! stand is established. Owing to the allometric 
+                                                                    !! relationship this setting determines all
+                                                                    !! biomass components of a newly establised stand
+                                                                    !! @tex $(m)$ @endtex
+!$OMP THREADPRIVATE(height_init_min)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: height_init_max   !! The maximum height of a tree sapling when a forest 
+                                                                    !! stand is established. 
+                                                                    !! @tex $(m)$ @endtex
+!$OMP THREADPRIVATE(height_init_max)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: k_root              !! Fine root specific conductivity 
+                                                                      !! @tex $(m^{3} kg^{-1} s^{-1} MPa^{-1})$ @endtex 
+!$OMP THREADPRIVATE(k_root)
+ 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: k_sap               !! Sapwood specific conductivity
+                                                                      !! @tex $(m^{3} kg^{-1} s^{-1} MPa^{-1})$ @endtex 
+!$OMP THREADPRIVATE(k_sap)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: k_leaf              !! Leaf conductivity @tex $(m s^{-1} MPa^{-1})$ @endtex
+!$OMP THREADPRIVATE(k_leaf)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: psi_leaf            !! Minimal leaf water potential @tex $(m s^{-1} MPa^{-1})$ @endtex
+!$OMP THREADPRIVATE(psi_leaf)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: psi_50              !! Sapwood leaf water potential that causes 50% loss of xylem
+                                                                      !! conductivity through cavitation @tex $(m s^{-1} MPa^{-1})$ @endtex
+!$OMP THREADPRIVATE(psi_50)
+   
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: c_cavitation        !!Shape parameter for loss of conductance Machado & Tyree, 1994 (unitless)         
+!$OMP THREADPRIVATE(c_cavitation)
+     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: psi_soil_tune       !!Additive tuning parameter to account for soil-root interaction
+                                                                      !!@tex $(MPa)$ @endtex       
+!$OMP THREADPRIVATE(psi_soil_tune)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: srl                  !! Specific root length  @tex $(m g^{-1})$ @endtex       
+!$OMP THREADPRIVATE(srl)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: r_froot              !! Specific root length  @tex $(m)$ @endtex       
+!$OMP THREADPRIVATE(r_froot)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: psi_root             !! Minimum root water potential  @tex $(MPa)$ @endtex       
+!$OMP THREADPRIVATE(psi_root)
+
+  !  
+  ! RECRUITMENT (stomate) 
+  !  
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: recruitment_pft                 !! Do recruitment? (true/false)  
+!$OMP THREADPRIVATE(recruitment_pft)   
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: recruitment_height          !! Height of recruits  
+!$OMP THREADPRIVATE(recruitment_height)  
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: recruitment_alpha           !! Alpha parameter for recruitment model  
+!$OMP THREADPRIVATE(recruitment_alpha)  
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: recruitment_beta            !! Beta parameter for recruitment model  
+!$OMP THREADPRIVATE(recruitment_beta) 
+
+  !
+  ! PRESCRIBE (stomate)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tune_reserves_in_sapling  !! A factor to scale the reserve pool of newly
+                                                                            !!planted saplings.  This is required by some deciduous
+                                                                            !! trees in order to survive the first year until budburst,
+                                                                            !!but it has no physical basis.
+                                                                            !!(unitless)
+    
+!$OMP THREADPRIVATE(tune_reserves_in_sapling)
+
+!
+  ! MORTALITY (stomate)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) &
+                          :: death_distribution_factor              !! The scale factor between the smallest and largest 
+                                                                    !! circ class for tree mortality in lpj_kill.
+                                                                    !! (unitless)
+!$OMP THREADPRIVATE(death_distribution_factor)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) &
+                          :: npp_reset_value                        !! The value of the NPP that the long-term value is
+                                                                    !! reset to after a PFT dies in stomate_kill.  This
+                                                                    !! only seems to be used for non-trees.
+                                                                    !! @tex $(gC m^{-2})$ @endtex
+!$OMP THREADPRIVATE(npp_reset_value)
+
+
+  !
+  ! WINDFALL (stomate_windthrow)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: streamlining_c_leaf                         !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(streamlining_c_leaf)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: streamlining_c_leafless                     !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(streamlining_c_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: streamlining_n_leaf                         !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(streamlining_n_leaf)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: streamlining_n_leafless                     !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(streamlining_n_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: streamlining_rb_leaf                        !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(streamlining_rb_leaf)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: streamlining_rb_leafless                    !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(streamlining_rb_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: canopy_density_leaf                         !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(canopy_density_leaf)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: canopy_density_leafless                     !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(canopy_density_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: intercept_breadth                           !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(intercept_breadth)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: slope_breadth                               !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(slope_breadth)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: intercept_depth                             !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(intercept_depth)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: slope_depth                                 !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(slope_depth)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: modulus_rupture                             !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(modulus_rupture)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: f_knot                                      !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(f_knot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_free_draining_shallow           !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_free_draining_shallow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_free_draining_shallow_leafless  !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_free_draining_shallow_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_free_draining_deep              !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_free_draining_deep)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_free_draining_deep_leafless     !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_free_draining_deep_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_free_draining_average           !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_free_draining_average)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_free_draining_average_leafless  !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_free_draining_average_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_gleyed_shallow                  !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_gleyed_shallow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_gleyed_shallow_leafless         !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_gleyed_shallow_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_gleyed_deep                     !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_gleyed_deep)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_gleyed_deep_leafless            !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_gleyed_deep_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_gleyed_average                  !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_gleyed_average)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_gleyed_average_leafless         !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_gleyed_average_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_peaty_shallow                   !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_peaty_shallow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_peaty_shallow_leafless          !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_peaty_shallow_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_peaty_deep                      !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_peaty_deep)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_peaty_deep_leafless             !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_peaty_deep_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_peaty_average                   !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_peaty_average)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_peaty_average_leafless          !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_peaty_average_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_peat_shallow                    !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_peat_shallow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_peat_shallow_leafless           !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_peat_shallow_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_peat_deep                       !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_peat_deep)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_peat_deep_leafless              !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_peat_deep_leafless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_peat_average                    !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_peat_average)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: overturning_peat_average_leafless           !! Modulus of Rupture (Pa)
+!$OMP THREADPRIVATE(overturning_peat_average_leafless)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: max_damage_further                          !! Maximum damage rate for inner area (unitless)  
+!$OMP THREADPRIVATE(max_damage_further)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: max_damage_closer                           !! Maximum damage rate for forest edge (unitless)
+!$OMP THREADPRIVATE(max_damage_closer)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: sfactor_further                             !! Scaling coefficient s for inner forest (unitless)
+!$OMP THREADPRIVATE(sfactor_further)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: sfactor_closer                              !! Scaling coefficient s for forest edge (unitless)
+!$OMP THREADPRIVATE(sfactor_closer)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: green_density                               !! (kg/m^3)
+!$OMP THREADPRIVATE(green_density)
+
+ 
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_to_height       !! Covert lai into vegetation height for grasses and crops
+!$OMP THREADPRIVATE(lai_to_height)    
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: deleuze_a      !! intercept of the intra-tree competition within a stand
+                                                                    !! based on the competion rule of Deleuze and Dhote 2004
+                                                                    !! Used when n_circ > 6
+!$OMP THREADPRIVATE(deleuze_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: deleuze_b      !! slope of the intra-tree competition within a stand
+                                                                    !! based on the competion rule of Deleuze and Dhote 2004
+                                                                    !! Used when n_circ > 6
+!$OMP THREADPRIVATE(deleuze_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: deleuze_p_all  !! Percentile of the circumferences that receives photosynthates
+                                                                    !! based on the competion rule of Deleuze and Dhote 2004
+                                                                    !! Used when n_circ > 6 for FM1, FM2 and FM4 
+!$OMP THREADPRIVATE(deleuze_p_all)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: deleuze_p_coppice  !! Percentile of the circumferences that receives photosynthates
+                                                                    !! based on the competion rule of Deleuze and Dhote 2004
+                                                                    !! Used when n_circ > 6 for FM3
+!$OMP THREADPRIVATE(deleuze_p_coppice)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: deleuze_power  !! Divisor of the power for the slope of intra-tree competition within a stand
+                                                                    !! based on the competition rule of Deleuze and Dhote 2004
+!$OMP THREADPRIVATE(deleuze_power)
+
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: m_dv                !! Parameter in the Deleuze & Dhote allocation rule that
+                                                                      !! relaxes the cut-off imposed by ::sigma. Owing to m_relax 
+                                                                      !! trees still grow a little when their ::circ is below 
+                                                                      !! ::sigma
+!$OMP THREADPRIVATE(m_dv) 
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: h_first           !! Height at which the first thinning occurs (m)
+!$OMP THREADPRIVATE(h_first)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alpha_self_thinning !! Coefficient of the self-thinning relationship D=alpha*N^beta 
+                                                                    !! estimated from German, French, Spanish and Swedish 
+                                                                    !! forest inventories
+!$OMP THREADPRIVATE(alpha_self_thinning)
+ 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: beta_self_thinning!! Exponent of the self-thinning relationship D=alpha*N^beta 
+                                                                    !! estimated from German, French, Spanish and swedish
+                                                                    !! forest inventories
+!$OMP THREADPRIVATE(beta_self_thinning)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: thinstrat         !! The thinning strategy used for forest management.
+                                                                    !! Comes from Eq. 12 of Bellassen et al (2010)
+                                                                    !! @tex $(unitless)$ @endtex
+!$OMP THREADPRIVATE(thinstrat) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: taumin            !! Minimum tree death probability. stomate_forest.f90
+                                                                    !! Comes from Eq. 12 of Bellassen et al (2010)
+                                                                    !! @tex $(unitless)$ @endtex
+!$OMP THREADPRIVATE(taumin) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: taumax            !! Maximum tree death probability. stomate_forest.f90
+                                                                    !! Comes from Eq. 12 of Bellassen et al (2010)
+                                                                    !! @tex $(unitless)$ @endtex
+!$OMP THREADPRIVATE(taumax) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alpha_rdi_upper   !! Coefficient of the yield-table derived thinning relationship
+                                                                    !! D=alpha*N^beta estimated from JRC yield table database
+!$OMP THREADPRIVATE(alpha_rdi_upper)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: beta_rdi_upper    !! Coefficient of the yield-table derived thinning relationship
+                                                                    !! D=alpha*N^beta estimated from JRC yield table database
+!$OMP THREADPRIVATE(beta_rdi_upper)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alpha_rdi_lower   !! Coefficient of the yield-table derived thinning relationship
+                                                                    !! D=alpha*N^beta estimated from JRC yield table database
+!$OMP THREADPRIVATE(alpha_rdi_lower) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: beta_rdi_lower    !! Coefficient of the yield-table derived thinning relationship
+                                                                    !! D=alpha*N^beta estimated from JRC yield table database
+!$OMP THREADPRIVATE(beta_rdi_lower)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: dens_target       !! The minimum density of trees in a stand before
+                                                                    !! they all die off and we replant.  This is to prevent
+                                                                    !! the stand from becoming just one large tree.
+                                                                    !! @tex $(trees ha{-1})$ @endtex
+!$OMP THREADPRIVATE(dens_target) 
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: largest_tree_dia !! The diameter at which we decide to clearcut
+                                                                    !! a stand because our equipment cannot handle
+                                                                    !! trees larger than this.
+                                                                    !! @tex $(cm)$ @endtex
+!$OMP THREADPRIVATE(largest_tree_dia)
+
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: fuelwood_diameter !! Diameter below which the wood harvest is used as fuelwood (m)
+                                                                    !! Affects the way the wood is used in the dim_product_use
+                                                                    !! subroutine         
+!$OMP THREADPRIVATE(fuelwood_diameter)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coppice_kill_be_wood !! Diameter below which the wood harvest is used as fuelwood (m)
+!$OMP THREADPRIVATE(coppice_kill_be_wood)
+                                 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: branch_ratio      !! branches/total aboveground biomass ratio
+                                                                    !! (cf carbofor for CITEPA inventory, these 
+                                                                    !! Guerric, Lim 2004, Peischl 2007, 
+                                                                    !! Schulp 2008: 15-30% slash after harvest,
+                                                                    !! Zaehle 2007: 30% slash after harvest)
+!$OMP THREADPRIVATE(branch_ratio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: branch_harvest    !! The fraction of branches which are harvested
+                                                                    !! during thinning and clearcut operations on 
+                                                                    !! forests.  1.0 means all branches are taken offsite,
+                                                                    !! 0.0 means all branches are left onsite and go
+                                                                    !! into the litter pool.  This number is not
+                                                                    !! based on any data.
+!$OMP THREADPRIVATE(branch_harvest)                   
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: coppice_diameter !! The trunk diameter at which a coppice will be cut.
+                                                                    !! @tex $(m)$ @endtex
+!$OMP THREADPRIVATE(coppice_diameter)  
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: shoots_per_stool !! The number of shoots that regrow per stool after
+                                                                    !! the first coppice cut
+                                                                    !! @tex $-$ @endtex
+!$OMP THREADPRIVATE(shoots_per_stool) 
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: src_rot_length !! The number of years between cuttings for short
+                                                                    !! rotation coppices.
+                                                                    !! @tex $-$ @endtex
+!$OMP THREADPRIVATE(src_rot_length) 
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: src_nrots      !! The number of rotations for short rotations coppices
+                                                                    !! before the roots are killed and replanted.
+                                                                    !! @tex $-$ @endtex
+!$OMP THREADPRIVATE(src_nrots) 
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: fruit_alloc         !! Fraction of biomass allocated to fruit production (0-1)
+
+!$OMP THREADPRIVATE(fruit_alloc) 
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: labile_reserve       !! The size of the labile pool as a fraction of the
+                                                                      !! weekly gpp (-). For example, 3 indicates that the 
+                                                                      !! is 3 times the weekly gpp. 
+!$OMP THREADPRIVATE(labile_reserve)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: deciduous_reserve    !! Fraction of sapwood mass stored in the reserve pool of deciduous 
+                                                                      !! trees during the growing season (unitless, 0-1) 
+
+!$OMP THREADPRIVATE(deciduous_reserve)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: evergreen_reserve    !! Fraction of sapwood mass stored in the reserve pool of evergreen 
+                                                                      !! trees (unitless, 0-1) 
+
+!$OMP THREADPRIVATE(evergreen_reserve)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescense_reserve   !! Fraction of sapwood mass stored in the reserve pool of deciduous 
+                                                                      !! trees during senescense(unitless, 0-1)
+
+!$OMP THREADPRIVATE(senescense_reserve)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cn_leaf_prescribed  !! CN of foliage for allocation, according to stich et al 2003
+!$OMP THREADPRIVATE(cn_leaf_prescribed)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: fcn_wood            !! CN of wood for allocation, relative to leaf CN according
+                                                                      !! to stich et al 2003
+!$OMP THREADPRIVATE(fcn_wood)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: fcn_root            !! CN of roots for allocation, relative to leaf CN according
+                                                                      !! to stich et al 2003
+!$OMP THREADPRIVATE(fcn_root)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cn_leaf_init      !! CN of foliage for allocation, according to stich et al 2003
+!$OMP THREADPRIVATE(cn_leaf_init)
+
+END MODULE pft_parameters_var
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/structures.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/structures.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/structures.f90	(revision 6412)
@@ -0,0 +1,105 @@
+! =================================================================================================================================
+! MODULE       : structures
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Contains structures and types used throughout the code
+!!
+!!\n DESCRIPTION: In this module, structural types should be declared.  There are
+!!                also routines for allocating and deallocating the memory in structures,
+!!                if necessary.
+!!
+!! RECENT CHANGE(S): 
+!!
+!! REFERENCE(S)	: 
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: 2013-09-25 17:38:26 +0200 (Wed, 25 Sep 2013) $
+!! $Revision: 1480 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE structures
+
+  USE defprec
+  USE constantes
+  USE pft_parameters
+!-
+  IMPLICIT NONE
+!-
+
+  ! The purpose of this structure is to contain all
+  ! the information needed to fit the effective LAI
+  ! as a function of the solar angle.  Doing this
+  ! as a structure means that we can change which
+  ! function we fit to more easily.  We will have
+  ! to allocate this for every grid cell, PFT, and
+  ! level.
+  INTEGER,PARAMETER :: nparams_laieff = 5 ! The number of parameters in the structure below
+  TYPE laieff_type
+     REAL(r_std) :: a,b,c,d,e          !! We do a polynomial fit, a+b*x+c*x**2+d*x**3+e*x**4
+  END type laieff_type
+
+
+ CONTAINS
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : laieff_type_init
+!!
+!>\BRIEF        Set the values for all the parameters of this type to zero.
+!!
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::laieff_type
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!!
+!!
+!!
+!_ ================================================================================================================================
+
+   SUBROUTINE laieff_type_init(npts, nlevels_loc, laieff_fit)
+
+     !! 0. Variable and parameter declaration
+
+     !! 0.1 Input variables
+     INTEGER(i_std), INTENT(in)                                :: npts        !! Domain size - Number of land pixels  (unitless)       
+     INTEGER(i_std), INTENT(in)                                :: nlevels_loc     !! The number of vertical levels in the canopy (unitless)    
+     !! 0.2 Output variables
+     
+     !! 0.3 Modified variables
+     TYPE(laieff_type),DIMENSION (:,:,:),INTENT(inout)    :: laieff_fit      !! Fitted parameters for the effective LAI
+   
+     !! 0.4 Local variables
+
+     INTEGER :: ipts,ivm,ilevel
+
+!_ ================================================================================================================================
+
+     DO ipts=1,npts
+        DO ivm=1,nvm
+           DO ilevel=1,nlevels_loc
+              laieff_fit(ipts,ivm,ilevel)%a=zero
+              laieff_fit(ipts,ivm,ilevel)%b=zero
+              laieff_fit(ipts,ivm,ilevel)%c=zero
+              laieff_fit(ipts,ivm,ilevel)%d=zero
+              laieff_fit(ipts,ivm,ilevel)%e=zero
+           ENDDO
+        ENDDO
+     ENDDO
+
+
+   END SUBROUTINE laieff_type_init
+
+
+
+ END MODULE structures
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/vertical_soil.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/vertical_soil.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/vertical_soil.f90	(revision 6412)
@@ -0,0 +1,490 @@
+! ================================================================================================================================
+!  MODULE       : vertical_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   Initialization of vertical discretization in the soil for hydrology and thermodynamics   
+!!
+!!\n DESCRIPTION: Initialization of vertical discretization in the soil for hydrology and thermodynamics   
+!!
+!! RECENT CHANGES: 
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-CN/src_parameters/vertical_soil.f90 $
+!! $Date: 2016-08-24 12:24:51 +0200 (Wed, 24 Aug 2016) $
+!! $Revision: 3714 $
+!! \n
+!_ ================================================================================================================================
+MODULE vertical_soil
+
+  USE defprec
+  USE ioipsl_para
+  USE vertical_soil_var
+  USE constantes_var
+
+  IMPLICIT NONE
+
+
+  PUBLIC :: vertical_soil_init
+
+CONTAINS
+!! ================================================================================================================================
+!! SUBROUTINE   : vertical_soil_init
+!!
+!>\BRIEF     Initialization of vertical discretization in the soil for hydrology and thermodynamics   
+!!
+!! DESCRIPTION  : To define the total number of layers 
+!!                for hydrology model (nslm),  
+!!                and for thermodynamics model ngrnd.
+!!
+!! We have 2 type of levels in the hydrology and the thermodynamics :
+!!  (1) the nodes where the scalar variables are computed.
+!!  (2) the intermediate levels: these are the bounds of the layers and thus the
+!!      contact point between layer i and i+1.
+!!
+!! Situation in hydrol.f90
+!!   The CWRR model only uses two variables to describe the vertical discretization :
+!!   (1) znh : the depth of the nodes where soil moisture is computed. The nodes are not
+!!     supposed to be in the middle of the layer. For the first and last layers the
+!!     nodes are put onto the intermediate level. At 0 for the first layer and
+!!     zmaxh for the last layer.
+!!   (2) dnh : the distance between two nodes
+!!
+!! Situation in thermosoil.f90 :
+!!   For the thermodynamics other variables are needed to describe the vertical structure :
+!!   (1) znt(znh) : the depth of the nodes are the same as in hydrol.f90 except for
+!!     the first and last levels. In older versions than revision XXXX of thermosoil it is 
+!!     computed with fz(i+1/2)
+!!   (2) zlt (Zint) (zz_coef in thermosoil) : is the depth of the intermediate levels. 
+!!     In revision before XXXX of thermosoil.f90 it's computed by fz(i). 
+!!     Since revision XXXX, in the new formulation (vertical.f90) it is computed as 
+!!     zint(i) = (znh(i)+znh(i+1))/2
+!!   (3) dlt(dz_tmp) (dz2 in thermosoil): This is the thickness of the layer, i.e the
+!!     distance between the top and bottom of the layer. Thus it is given by
+!!     zint(i+1)-zint(i). It should not be confused with dnh in hydrology which is the
+!!     distance between nodes.
+!!
+!! in standard hydrology model (de Rosnay Patricia, 2000; depth_topthickness = 9.77517107e-04, zmaxh=2.0, refinebottom = .FALSE.):
+!!
+!! Example for standard depth of the hydrology
+!! Number of layers in hydrol =  11
+!! znh = depth of nodes
+!! [  0.00000000e+00   1.95503421e-03   5.86510264e-03 1.36852395e-02
+!!    2.93255132e-02   6.06060606e-02   1.23167155e-01 2.48289345e-01
+!!    4.98533725e-01   9.99022483e-01   2.00000000e+00 ]
+!! dnh = internode distance
+!! [ 0.          0.00195503  0.00391007  0.00782014  0.01564027 0.03128055
+!!   0.06256109  0.12512219  0.25024438  0.50048876  1.00097752 ]
+!! dlh = soil layer thickness
+!! [ 0.00097752  0.00293255  0.0058651   0.01173021  0.02346041 0.04692082
+!!   0.09384164  0.18768328  0.37536657  0.75073314  0.50048876 ]
+!! hcum = depth of soil layer bottom
+!! [  9.77517107e-04   3.91006843e-03   9.77517107e-03 2.15053764e-02
+!!    4.49657869e-02   9.18866081e-02   1.85728250e-01 3.73411535e-01
+!!    7.48778104e-01   1.49951124e+00   2.00000000e+00 ]
+!!
+!!
+!! In thermal model (an example of: depth_topthickness = 9.77517107e-04, zmaxt=10, depth_geom=10, refinebottom = .FALSE.): 
+!! Number of layers in thermosoil =  19
+!! The approximate maximal depth for thermosoil =  10.0078201332
+!! The actual maximal depth for thermosoil =  10.0
+!! znt= 
+!! [ 4.88758554e-04   1.95503421e-03   5.86510264e-03 1.36852395e-02
+!!   2.93255132e-02   6.06060606e-02   1.23167155e-01 2.48289345e-01
+!!   4.98533725e-01   9.99022483e-01   1.74975562e+00 2.50048876e+00
+!!   3.50146627e+00   4.50244379e+00   5.50342131e+00 6.50439882e+00
+!!   7.50537634e+00   8.50635386e+00   9.50733137e+00 ]
+!! dlt= 
+!! [ 9.77517107e-04   2.93255132e-03   5.86510264e-03 1.17302053e-02
+!!   2.34604106e-02   4.69208211e-02   9.38416423e-02 1.87683285e-01
+!!   3.75366569e-01   7.50733138e-01   5.00488758e-01 1.00097752e+00
+!!   1.00097752e+00   1.00097752e+00   1.00097752e+00 1.00097752e+00
+!!   1.00097752e+00   1.00097752e+00   9.93157383e-01 ]
+!! zlt= 
+!! [ 9.77517107e-04   3.91006843e-03   9.77517107e-03 2.15053764e-02
+!!   4.49657869e-02   9.18866081e-02   1.85728250e-01 3.73411535e-01
+!!   7.48778104e-01   1.49951124e+00   2.00000000e+00 3.00097752e+00
+!!   4.00195503e+00   5.00293255e+00   6.00391007e+00 7.00488758e+00
+!!   8.00586510e+00   9.00684262e+00   1.00000000e+01 ]
+!!
+!!
+!! A simple figure below shows the discretization.                       ^
+!!   '------' means interface; 'X' means node; '...' means many layers;  | means distance. 
+!!                                                                       v
+!! Keep in mind that the nodes are not necessarly in the middle of the layers. 
+!! 
+!!           Hydrology                     Thermodynamics
+!!
+!!    --------X------- znh(1) ^           ------------------- 1st          ^
+!!                            |                                            |
+!!                            |                  X        znt(1)           | depth_topthickness, dlt(1)  
+!!                            |dnh(2)                                      |
+!!    -----------------       |           ------------------- 2nd   zlt(1) v        ^
+!!                            |                                                     |
+!!            X        znh(2) v  ^                X        znt(2)                   |dlt(2) 
+!!                               |                                                  |
+!!    -----------------          |dnh(3)  ------------------- 3rd   zlt(2)          v
+!!                               | 
+!!            X        znh(3)    v                X        znt(3)
+!!
+!!    ----------------- ...              ------------------- ...
+!!
+!!                      ...                      X           ...
+!!
+!!    --------X------- znh(nslm)        ------------------- nslm     zlt(nslm)
+!!
+!!                                               X        znt(nslm)
+!!
+!!                                       ------------------- nslm+1   zlt(nslm+1)
+!!
+!!                                               X        znt(nslm+1)
+!! 
+!!                                       ------------------- ...
+!! 
+!!                                               X        znt(ngrnd)
+!!
+!!                                       ------------------- ngrnd    zlt(ngrnd)
+!!
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE vertical_soil_init
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Local variables
+    INTEGER(i_std), PARAMETER            :: nblayermax=500    !! Preset 500 for max. number of soil layers.
+    INTEGER(i_std)                       :: i, irev, iref, ntmp, ier
+    REAL(r_std)                          :: zgeoend           !! The node position where the geometrical increases of nodes stopped. (m)
+    REAL(r_std)                          :: dgeoend           !! The distance of the node at zgeoend and the node above. (m)
+    REAL(r_std)                          :: dcst              !! Related to refine at bottom. Work in progress...
+    REAL(r_std)                          :: cstint            !! Related to refine at bottom. Work in progress...
+    REAL(r_std)                          :: hh                !! Temporay variable, to calculate the layer thickness for temperature at zmaxh. 
+    REAL(r_std)                          :: ratio             !! The ratio of geometric increas.
+    INTEGER(i_std)                       :: nbrefine          !! Related to refine at bottom. Work in progress...
+    INTEGER(i_std)                       :: nbcst             !! Related to refine at bottom. Work in progress...
+    INTEGER(i_std)                       :: igeo              !! Related to refine at bottom. Work in progress...
+    REAL(r_std), DIMENSION(nblayermax+1) :: ztmp              !! Depth at the node of each layer (m)
+    REAL(r_std), DIMENSION(nblayermax+1) :: zint              !! Depth at the interface of each layer (m)
+    REAL(r_std), DIMENSION(nblayermax+1) :: dtmp              !! Distance between the current node and the one above (m)
+    REAL(r_std), DIMENSION(nblayermax+1) :: drefine           !! Related to refine at bottom. Work in progress...
+    INTEGER(i_std), DIMENSION(1)         :: imin              !! Related to refine at bottom. Work in progress...
+    
+
+    !! Variables controling the vertical discretiztaion
+    REAL(r_std)                          :: depth_topthickness   !! Thickness of the top Layer (m)
+    REAL(r_std)                          :: depth_cstthickness   !! Depth at which constant layer thickness start (m)
+    REAL(r_std)                          :: depth_geom           !! Depth at which we resume geometrical increases for temperature (m)
+    REAL(r_std)                          :: ratio_geom_below     !! Ratio of the geometrical series defining the thickness below DEPTH_GEOM.
+    LOGICAL                              :: refinebottom         !! Whether or not the hydrology layers will be refined towards the bottom.
+    REAL(r_std)                          :: dis_80               !! distance to 80cm below ground
+    REAL(r_std)                          :: dis_tmp              !! Temporary variable
+!_ ================================================================================================================================
+  
+    !Config Key   = DEPTH_MAX_T
+    !Config Desc  = Maximum depth of the soil thermodynamics
+    !Config If    = 
+    !Config Def   = 10.0
+    !Config Help  = Maximum depth of soil for temperature.
+    !Config Units = m
+    zmaxt = 10.0
+    CALL getin_p("DEPTH_MAX_T",zmaxt)
+    
+    !Config Key   = DEPTH_MAX_H
+    !Config Desc  = Maximum depth of soil moisture
+    !Config If    = 
+    !Config Def   = 2.0
+    !Config Help  = Maximum depth of soil for soil moisture (CWRR).
+    !Config Units = m
+    zmaxh=2.0
+    CALL getin_p("DEPTH_MAX_H",zmaxh)
+    
+    ! Verification
+    IF ( zmaxh > zmaxt) THEN
+       CALL ipslerr_p(3,'vertical_soil_init',"ERROR : zmaxh needs to be smaller than zmaxt.", &
+            "Correction : zmaxh set to zmaxt", " ")
+    ENDIF
+    
+    !Config Key   = DEPTH_TOPTHICK
+    !Config Desc  = Thickness of upper most Layer 
+    !Config If    = 
+    !Config Def   = 9.77517107e-04
+    !Config Help  = Thickness of top hydrology layer for soil moisture (CWRR).
+    !Config Units = m
+    depth_topthickness = 9.77517107e-04
+    CALL getin_p("DEPTH_TOPTHICK",depth_topthickness)
+    
+    !Config Key   = DEPTH_CSTTHICK
+    !Config Desc  = Depth at which constant layer thickness start
+    !Config If    = 
+    !Config Def   = DEPTH_MAX_H 
+    !Config Help  = Depth at which constant layer thickness start (smaller than zmaxh/2)
+    !Config Units = m
+    depth_cstthickness=zmaxh
+    CALL getin_p("DEPTH_CSTTHICK",depth_cstthickness)
+    
+    IF ( (depth_cstthickness /= zmaxh) .AND. (depth_cstthickness > zmaxh/2.0) ) THEN
+       CALL ipslerr_p(2,'vertical_soil_init',"ERROR : depth_cstthickness needs to be smaller than zmaxh/2.0", &
+            "Correction : Constant thickness disabled", " ")
+       depth_cstthickness = zmaxh
+    ENDIF
+    
+    ! REFINEBOTTOM option is under work... This option can not be set from the parameter file for the moment. 
+    ! All the related code for refinebottom except this getin are found in this module but needs to be tested.
+!!$  !Config Key   = REFINEBOTTOM
+!!$  !Config Desc  = Depth at which the hydrology layers will be refined towards the bottom.
+!!$  !Config If    = 
+!!$  !Config Def   = .FALSE.
+!!$  !Config Help  = Depth at which the hydrology layers will be refined towards the bottom.
+!!$  !               This is important when lower boundary conditions is different from a free drainag%e.
+!!$  !Config Units = -
+!!$  ! 
+    refinebottom = .FALSE.
+!!$  CALL getin_p("REFINEBOTTOM",refinebottom)
+    
+    !Config Key   = DEPTH_GEOM
+    !Config Desc  = Depth at which we resume geometrical increases for temperature
+    !Config If    = 
+    !Config Def   = DEPTH_MAX_H 
+    !Config Help  = Depth at which the thickness increases again for temperature.
+    !               This depth has to be deeper than the bottom of the hydrology.
+    !Config Units = m
+    depth_geom=zmaxh
+    CALL getin_p("DEPTH_GEOM",depth_geom)
+    
+    IF ( depth_geom < zmaxh ) THEN
+       CALL ipslerr_p(3,'vertical_soil_init',"ERROR : depth_geom needs to be larger than zmaxh", &
+            "Correction : setting depth_geom to zmaxh", " ")
+    ENDIF
+    
+    !Config Key   = RATIO_GEOM_BELOW
+    !Config Desc  = Ratio of the geometrical series defining the thickness below DEPTH_GEOM
+    !Config If    = 
+    !Config Def   = 2
+    !Config Help  = Ratio of the geometrical series defining the thickness below DEPTH_GEOM.
+    !               This parameter allows to cover the depth needed for temperature with fewer layers.
+    !Config Units = -
+    ratio_geom_below=2
+    CALL getin_p("RATIO_GEOM_BELOW",ratio_geom_below)
+    
+    !
+    ! Computing the layer depth for soil moisture. This defines the number of layers needed.
+    !
+    ztmp(:) = 0.0
+    dtmp(:) = 0.0
+    DO i=1,nblayermax
+       IF ( ztmp(i) < depth_cstthickness ) THEN
+          ztmp(i+1) = depth_topthickness*2.0*((2**i)-1)
+          dtmp(i+1) = ztmp(i+1)-ztmp(i)
+          igeo=i+1
+          zgeoend=ztmp(i+1)
+          dgeoend=dtmp(i+1)
+       ELSE
+          ztmp(i+1) = ztmp(i)+dtmp(i)
+          dtmp(i+1) = dtmp(i)
+       ENDIF
+    ENDDO
+    !
+    ! refine at bottom. Work in progress...
+    !
+    nbrefine = 1
+    drefine(:) = 0.0
+    IF (refinebottom) THEN
+       !
+       ! Compute parameters for the constant increment interval before refining,
+       ! If needed !
+       cstint=zmaxh-(2.0*zgeoend)
+       nbcst=MAX(INT(cstint/dgeoend), 0)
+       IF ( nbcst > 0 ) THEN
+          dcst=cstint/nbcst
+       ELSE
+          dcst=dgeoend
+       ENDIF
+       !
+       ! If we have to add constant increments
+       !
+       IF ( nbcst > 0 ) THEN
+          ! Add linear levels
+          DO i=igeo,igeo+nbcst-1
+             ztmp(i+1) = ztmp(i)+dcst
+             dtmp(i+1) = dcst
+          ENDDO
+          ! Refine the levels toward the bottom
+          DO i=igeo+nbcst,2*igeo+nbcst-2
+             irev=(2*igeo+nbcst-1)-i
+             ztmp(i+1) = ztmp(i)+dtmp(irev+1)
+             dtmp(i+1) = ztmp(i+1)-ztmp(i)
+             drefine(nbrefine)=dtmp(i+1)
+             nbrefine=nbrefine+1
+          ENDDO
+          ! Without constant increments
+       ELSE
+          imin=MINLOC(ABS(ztmp(:)-(zmaxh/2.0)))
+          igeo=imin(1)
+          ztmp(igeo)=zmaxh/2.0
+          dtmp(igeo) = ztmp(igeo)-ztmp(igeo-1)
+          DO i=igeo,2*igeo
+             irev=(2*igeo)-i
+             ztmp(i+1) = ztmp(i)+dtmp(irev)
+             dtmp(i+1) = ztmp(i-1)-ztmp(i)
+             drefine(nbrefine)=dtmp(i+1)
+             nbrefine=nbrefine+1
+          ENDDO
+       ENDIF
+    ENDIF
+   
+    ! Find the index (nslm) of the node closest to the zmaxh
+    imin=MINLOC(ABS(ztmp(:)-zmaxh))
+    nslm=imin(1)
+    !
+    ! ALLOCATE the arrays we need to keep
+    !
+    ALLOCATE(znh(nslm), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable znh','','')
+    ALLOCATE(dnh(nslm), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable dnh','','')
+    ALLOCATE(dlh(nslm), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable dlh','','')
+    ALLOCATE(zlh(nslm), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable zlh','','')
+    !
+    ! Extract now the values we need to reach zmaxh
+    !
+    znh(:)=ztmp(1:nslm)
+    
+    ! Force the last hydrological layer and node to be zmaxh
+    znh(nslm)=zmaxh
+    dnh(:)=dtmp(1:nslm)
+    ! Recalculate the distance between the last 2 nodes
+    dnh(nslm) = ztmp(nslm)-ztmp(nslm-1)
+    
+    ! Calculate the thickness of the layers
+    DO i = 1, nslm-1
+       dlh(i) = (dnh(i) + dnh(i+1)) / 2.0
+    ENDDO
+    dlh(nslm) = dnh(nslm)/2
+        
+    !
+    ! Extension for the thermodynamics below zmaxh
+    !
+    ntmp = nslm
+    ztmp(:)=0.0
+    ! Exception for the first layer. It is at the top in the hydrology and in
+    ! the middle for temperature.
+    ztmp(1)=depth_topthickness/2
+    DO i=2,ntmp
+       ztmp(i)=znh(i)
+    ENDDO
+    
+    ! Exception for the last layer where again temperature needs to be in
+    ! the middle of the layer. Also add a layer with the same thickness
+    hh=dnh(ntmp)/2.0
+    ztmp(ntmp)=ztmp(ntmp)-hh/2.0
+    ztmp(ntmp+1)=ztmp(ntmp)+hh*1.5
+    ztmp(ntmp+2)=ztmp(ntmp+1)+hh*2.0
+    ntmp=ntmp+2
+    
+    ! If we have created a refined region at the bottom of the soil moisture. We need to
+    ! unwinde it for temperature below zmaxh
+    IF ( nbrefine > 1 ) THEN
+       DO i=ntmp,ntmp+nbrefine
+          iref=(nbrefine+1)-(i-ntmp)
+          ztmp(i+1)=ztmp(i)+drefine(iref)
+       ENDDO
+       ntmp=ntmp+nbrefine
+    ENDIF
+    !
+    ! Resume the geometric increas of thickness
+    DO i=ntmp,nblayermax
+       IF ( ztmp(i) < depth_geom ) THEN
+          ratio = 1.0
+       ELSE
+          ratio = ratio_geom_below
+       ENDIF
+       ztmp(i+1)=ztmp(i)+ratio*(ztmp(i)-ztmp(i-1))
+    ENDDO
+    
+    ! Compute the depth of the lower interface of each layer.
+    !
+    zint(1) = depth_topthickness
+    DO i=2,nblayermax
+       zint(i) = (ztmp(i)+ztmp(i+1))/2.0
+    ENDDO
+    zint(nslm-1) = (znh(nslm-1) + znh(nslm))/2.0
+    zint(nslm) = (znh(nslm))
+    zint(nblayermax+1) = ztmp(nblayermax+1)+(ztmp(nblayermax+1)-ztmp(nblayermax))/2.0
+    
+    ! Determine the total number of layers for thermal (ngrnd).
+    !
+    imin=MINLOC(ABS(zint-zmaxt))
+    ngrnd= imin(1)
+    !ngrnd=imin(1)
+    ALLOCATE(znt(ngrnd), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable znt','','')
+    ALLOCATE(dlt(ngrnd), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable dlt','','')
+    ALLOCATE(zlt(ngrnd), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable zlt','','')
+    
+    ! Assign values for znt, zlt, dlt
+    !
+    znt(:)=ztmp(1:ngrnd)
+    zlt(:) = zint(1:ngrnd)
+    dlt(1) = zint(1)
+    DO i=2,ngrnd
+       dlt(i) = zint(i)-zint(i-1)
+    ENDDO
+    ! Depth of layers for the hydrology are the same as for thermosoil but only the upper nslm layers are used
+    zlh(:) = zlt(1:nslm)
+    
+    ! Force the last thermal layer and node to be zmaxt
+    zlt(ngrnd) = zmaxt
+    dlt(ngrnd) = zmaxt-zint(ngrnd-1)
+
+    ! Find the layer index closest to 80 cm below ground
+    ! This layer is used to calculate whether the soil is frozen
+    ! at 80 cm depth which affects the storm damage 
+    dis_80 = large_value
+    dis_tmp= large_value
+    DO i=1,ngrnd
+       dis_80 = ABS( 0.8 - zlt(i))
+       IF ( dis_80 .LT. dis_tmp) THEN
+          dis_tmp = dis_80
+          grnd_80 = i
+       ENDIF
+    ENDDO
+
+    IF (printlev >=2) THEN 
+       WRITE(numout,*) "=== Vertical discretization for hydrology ====================================================" 
+       WRITE(numout,*) "Number of layers in hydrology: nslm=", nslm 
+       WRITE(numout,*) "Total depth in hydrology (DEPTH_MAX_H) (m): znh(nslm)=", znh(nslm) 
+       WRITE(numout,*) "Depth of nodes in hydrology (m): znh=", znh 
+       WRITE(numout,*) "Depth of lower layer-interface for hydrology (m): zlh=", zlh 
+       WRITE(numout,*) "Layer thickness for hydrology (m): dlh=",dlh 
+       WRITE(numout,*) "Internode distance for hydrology (m): dnh=",dnh 
+       WRITE(numout,*) "=== Vertical discretization for thermosoil ===================================================" 
+       WRITE(numout,*) "Number of layers in thermosoil: ngrnd=", ngrnd 
+       WRITE(numout,*) "Total depth for thermosoil (DEPTH_MAX_T) (m): zlt=", zlt(ngrnd) 
+       WRITE(numout,*) "to be compared with calculated total depth for thermosoil (not used) zint=", zint(ngrnd) 
+       WRITE(numout,*) "Depth of the nodes in thermosoil (m): znt=",znt 
+       WRITE(numout,*) "Depth of lower layer-interface for thermosoil (m): zlt=", zlt(1:ngrnd) 
+       WRITE(numout,*) "Layer thickness for thermosoil (m): dlt=", dlt
+       WRITE(numout,*) "Layer closest to 80 cm depth:",grnd_80, "depth(grnd_80):",zlt(grnd_80)
+       WRITE(numout,*) "==============================================================================================" 
+    END IF    
+
+  END SUBROUTINE vertical_soil_init
+  
+END MODULE vertical_soil
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/vertical_soil_var.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/vertical_soil_var.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_parameters/vertical_soil_var.f90	(revision 6412)
@@ -0,0 +1,67 @@
+! =================================================================================================================================
+! MODULE       : vertical_soil_var
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        
+!!
+!!\n DESCRIPTION: 
+!!                
+!! RECENT CHANGE(S):
+!!
+!! REFERENCE(S)	: 
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-CN/src_parameters/vertical_soil_var.f90 $
+!! $Date: 2016-08-24 12:24:51 +0200 (Wed, 24 Aug 2016) $
+!! $Revision: 3714 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE vertical_soil_var
+
+  USE defprec
+
+  IMPLICIT NONE
+  PUBLIC
+
+  !! Dimensioning parameters
+  INTEGER(i_std), SAVE      :: ngrnd     !! Number of soil layer for thermo (unitless)
+!$OMP THREADPRIVATE(ngrnd)
+  INTEGER(i_std), SAVE      :: nbdl      !! Number of diagnostic layers in the soil, not needed in CWRR (unitless)
+!$OMP THREADPRIVATE(nbdl)
+  INTEGER(i_std), SAVE      :: nslm      !! Number of levels in CWRR (unitless)
+!$OMP THREADPRIVATE(nslm)
+  REAL(r_std), SAVE         :: zmaxh     !! Maximum depth of soil reservoir in hydrol (m). Old name dpu_max or depth_Wmax
+!$OMP THREADPRIVATE(zmaxh)
+  REAL(r_std), SAVE         :: zmaxt     !! Maximum depth of the soil thermodynamics (m)
+!$OMP THREADPRIVATE(zmaxt)
+  INTEGER(i_std), SAVE      :: grnd_80   !! Index of soil depthcloset to 80 cm below ground
+!$OMP THREADPRIVATE(grnd_80)
+
+  !! Variables defining the vertical layering in soil moisture and temperature
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: znt          !! Depth of nodes for thermal (m) 
+!$OMP THREADPRIVATE(znt)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: znh          !! Depth of nodes for hydrology (m)
+!$OMP THREADPRIVATE(znh)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: dnh          !! Distance between the current node and the one above for hydrology (m)
+!$OMP THREADPRIVATE(dnh)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: dlh          !! Soil layer thickness for hydrology (m) 
+!$OMP THREADPRIVATE(dlh)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: dlt          !! Soil layer thickness for thermal (m)
+!$OMP THREADPRIVATE(dlt)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: zlh          !! Depth of lower layer-interface for hydrology (m)
+!$OMP THREADPRIVATE(zlh)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: zlt          !! Depth of lower layer-interface for thermal (m)
+!$OMP THREADPRIVATE(zlt)
+
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: diaglev      !! The lower limit of the layer on which soil moisture
+                                                               !! (relative) and temperature are going to be diagnosed.
+                                                               !! These variables are made for transfering the information
+                                                               !! to the biogeophyical processes modelled in STOMATE. 
+!$OMP THREADPRIVATE(diaglev)
+
+END MODULE vertical_soil_var
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/AA_make
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/AA_make	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/AA_make	(revision 6412)
@@ -0,0 +1,188 @@
+#-
+#- $Id$
+#-
+PARALLEL_LIB = $(LIBDIR)/libparallel.a
+SXPARALLEL_LIB = $(PARALLEL_LIB)
+#-Q- sxnec  SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- eshpux SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-
+PARAM_LIB = $(LIBDIR)/libparameters.a
+SXPARAM_LIB = $(PARAM_LIB)
+#-Q- sxnec  SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- eshpux SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-
+ORGLOB_LIB = $(LIBDIR)/liborglob.a
+SXORGLOB_LIB = $(ORGLOB_LIB)
+#-Q- sxnec  SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx6nec SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- eshpux SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx8brodie SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-
+STOMATE_LIB = $(LIBDIR)/libstomate.a
+SXSTOMATE_LIB = $(STOMATE_LIB)
+#-Q- sxnec  SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx6nec SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- eshpux SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx8brodie SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-
+MODS1 =              \
+  qsat_moisture.f90 \
+  sechiba_io_p.f90   \
+  sechiba_io.f90     \
+  slowproc.f90       \
+  diffuco.f90        \
+  condveg.f90        \
+  enerbil.f90        \
+  explicitsnow.f90       \
+  hydrol.f90         \
+  thermosoil.f90     \
+  routing.f90        \
+  sechiba.f90        \
+  ioipslctrl.f90     \
+  intersurf.f90 
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libparallel
+	$(M_K) libparameters
+	$(M_K) liborglob
+	$(M_K) libstomate
+	$(M_K) m_all
+	@echo sechiba is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+#-Q- intel m_all: WORK_MOD $(MODEL_LIB)($(OBJSMODS1))
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+libparameters:
+	(cd ../src_parameters; $(M_K) -f Makefile)
+
+liborglob:
+	(cd ../src_global; $(M_K) -f Makefile)
+
+libstomate:
+	(cd ../src_stomate; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o) : %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+#-Q- intel
+#-Q- intel WORK_MOD :
+#-Q- intel 	$(RM) work.pcl
+#-Q- intel 	@echo "work.pc" > work.pcl
+#-Q- intel 	@echo "../src_parameters/work.pc" >> work.pcl
+#-Q- intel 	@echo "../src_stomate/work.pc" >> work.pcl
+#-Q- intel 	@echo "../../IOIPSL/src/work.pc" >> work.pcl
+
+config : 
+	$(BINDIR)/Fparser -name SECHIBA $(MODS1)
+	echo 'Configuration of SECHIBA done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(sechiba.o):          \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(sechiba_io_p.o)    \
+  $(MODEL_LIB)(sechiba_io.o)      \
+  $(MODEL_LIB)(diffuco.o)         \
+  $(MODEL_LIB)(condveg.o)         \
+  $(MODEL_LIB)(enerbil.o)         \
+  $(MODEL_LIB)(hydrol.o)          \
+  $(MODEL_LIB)(thermosoil.o)      \
+  $(MODEL_LIB)(slowproc.o)        \
+  $(MODEL_LIB)(routing.o)
+ 
+$(MODEL_LIB)(sechiba_io_p.o): \
+  $(PARAM_LIB)(constantes.o)  \
+  $(PARALLEL_LIB)(mod_orchidee_para.o)
+
+$(MODEL_LIB)(sechiba_io.o): \
+  $(MODEL_LIB)(sechiba_io_p.o) \
+  $(PARAM_LIB)(constantes.o)
+
+$(MODEL_LIB)(hydrol.o):           \
+  $(PARAM_LIB)(constantes.o)  \
+  $(MODEL_LIB)(explicitsnow.o)  \
+  $(MODEL_LIB)(sechiba_io.o)      \
+  $(ORGLOB_LIB)(grid.o)
+
+$(MODEL_LIB)(explicitsnow.o):         \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(PARAM_LIB)(constantes.o)      \
+  $(PARAM_LIB)(constantes_soil.o) \
+  $(MODEL_LIB)(qsat_moisture.o)   \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(slowproc.o):         \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(STOMATE_LIB)(stomate.o)       \
+  $(MODEL_LIB)(sechiba_io.o)      \
+  $(ORGLOB_LIB)(interpol_help.o)
+
+$(MODEL_LIB)(diffuco.o):          \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(qsat_moisture.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(enerbil.o):          \
+  $(PARAM_LIB)(constantes.o)      \
+  $(MODEL_LIB)(qsat_moisture.o)   \
+  $(MODEL_LIB)(explicitsnow.o)        \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(condveg.o):          \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(PARAM_LIB)(constantes.o)  \
+  $(PARAM_LIB)(constantes_soil.o)  \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(sechiba_io.o) \
+  $(ORGLOB_LIB)(interpol_help.o)
+
+$(MODEL_LIB)(thermosoil.o): \
+  $(PARAM_LIB)(constantes.o)  \
+  $(PARAM_LIB)(constantes_soil.o)  \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(routing.o):          \
+  $(PARAM_LIB)(constantes.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(intersurf.o):   \
+  $(PARAM_LIB)(constantes.o)  \
+  $(PARAM_LIB)(control.o)    \
+  $(ORGLOB_LIB)(grid.o)      \
+  $(MODEL_LIB)(thermosoil.o) \
+  $(MODEL_LIB)(sechiba.o)
+
+$(MODEL_LIB)(ioipslctrl.o):   \
+  $(PARAM_LIB)(constantes.o)  \
+  $(PARAM_LIB)(constantes_soil.o)  \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(thermosoil.o) 
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/AA_make.ldef
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/AA_make.ldef	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/AA_make.ldef	(revision 6412)
@@ -0,0 +1,19 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a SECHIBA
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/libsechiba.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxsechiba.a
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/albedo.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/albedo.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/albedo.f90	(revision 6412)
@@ -0,0 +1,1891 @@
+! ===============================================================================================================================
+! MODULE       : albedo
+!
+! 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 surface albedo using a variety of different schemes
+!!
+!! \n DESCRIPTION : This module includes the mechanisms for
+!! 1. :: albedo_two_stream computes the two_stream approach of Pinty et al 2006.
+!!           Requires an effective leaf area index and depends on the solar angle.
+!!           Separates light into NIR and VIS, and diffuse and direct illumination
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCES(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.
+!!
+!!                    B. Pinty, T. Lavergne, R.E. Dickinson, J-L. Widlowski, 
+!!                    N. Gobron and M. M. Verstraete (2006). Simplifying the 
+!!                    Interaction of Land Surfaces with Radiation for Relating 
+!!                    Remote Sensing Products to Climate Models. Journal of 
+!!                    Geophysical Research. Vol 111, D02116.
+!!
+!! SVN              :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/perso/matthew.mcgrath/TRUNK/ORCHIDEE/src_sechiba/albedo.f90 $
+!! $Date: 2012-07-19 15:12:52 +0200 (Thu, 1 Nov 2012) $
+!! $Revision: 947 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE albedo
+  !
+  USE ioipsl
+  !
+  ! modules used :
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE structures
+  USE interpol_help
+  USE ioipsl_para, ONLY : ipslerr_p
+  USE stomate_laieff
+
+  IMPLICIT NONE
+
+  PRIVATE :: print_debugging_albedo_info,calculate_snow_albedo,&
+       twostream_solver,gammas
+  PUBLIC :: albedo_two_stream
+                                                                        
+CONTAINS
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : albedo_two_stream
+!!
+!>\BRIEF        This subroutine calculates the albedo for two stream radiation transfer model.  This routine includes
+!!              the effect of snow on the background albedo, through one of two methods.
+!!
+!! DESCRIPTION  : The albedo for two stream radiation transfer model  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.
+!!
+!!    NOTE: the main output variable, albedo, is an unweighted average of the direct and diffuse albedos
+!!          for each grid point...this is done in this way right now to be consistent with the new scheme,
+!!          but it doesn't have to be combined like that once we have an energy budget which can
+!!          use both types of light directly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::albedo
+!!
+!! REFERENCE(S) : B. Pinty, T. Lavergne, R.E. Dickinson, J-L. Widlowski, N. Gobron and M. M. Verstraete (2006).
+!! Simplifying the Interaction of Land Surfaces with Radiation for Relating Remote Sensing Products to Climate Models.
+!! Journal of Geophysical Research. Vol 111, D02116.
+!!
+!! FLOWCHART    : None
+!! \n
+!!
+!!
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE albedo_two_stream(npts, &
+       drysoil_frac, veget_max, coszang, soilalb_dry, &
+       soilalb_wet, frac_nobio, soilalb_moy, bckgrnd_alb, & 
+       alb_bare, albedo, snow, snow_age, snow_nobio, &
+       snow_nobio_age, albedo_snow, albedo_glob, &
+       circ_class_biomass, circ_class_n, z0m, &
+       Isotrop_Abs_Tot_p, Isotrop_Tran_Tot_p, laieff_fit, &
+       albedo_pft, frac_snow_veg, frac_snow_nobio,&
+       Collim_Abs_Tot_mean, Collim_Alb_Tot_mean, &
+       laieff_collim, laieff_isotrop)
+
+ !! 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(:), INTENT(in)                     :: drysoil_frac           !! Fraction of  dry soil (unitless)
+   REAL(r_std), DIMENSION(:), INTENT(in)                     :: coszang                !! The cosine of the solar zenith angle (unitless)
+   REAL(r_std), DIMENSION(:,:), INTENT(in)                   :: veget_max              !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                                       !! (m^2 m^{-2})
+   REAL(r_std), DIMENSION(:,:), INTENT(in)                   :: soilalb_dry            !! Albedo values for the dry bare soil (unitless)
+   REAL(r_std), DIMENSION(:,:), INTENT(in)                   :: soilalb_wet            !! Albedo values for the wet bare soil (unitless)
+   REAL(r_std), DIMENSION(:,:), INTENT(in)                   :: soilalb_moy            !! Albedo values for the mean bare soil (unitless)
+   REAL(r_std), DIMENSION(:,:), INTENT(in)                   :: bckgrnd_alb             !! Background albedo values if read in from map 
+                                                                                       !! (see condveg_background_soilalb)
+   REAL(r_std),DIMENSION (:), INTENT(in)                     :: snow                   !! Snow mass in vegetation (kg m^{-2})           
+   REAL(r_std),DIMENSION (:,:), INTENT(in)                   :: snow_nobio             !! Snow mass on continental ice, lakes, etc. (kg m^{-2})      
+   REAL(r_std),DIMENSION (:), INTENT(in)                     :: snow_age               !! Snow age (days)        
+   REAL(r_std),DIMENSION (:,:), INTENT(in)                   :: snow_nobio_age         !! Snow age on continental ice, lakes, etc. (days)    
+   REAL(r_std),DIMENSION (:,:), INTENT(in)                   :: frac_nobio             !! Fraction of non-vegetative surfaces, i.e. 
+                                                                                       !! continental ice, lakes, etc. (unitless)     
+   REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(IN)             :: circ_class_biomass     !! Stem diameter 
+                                                                                       !! @tex $(m)$ @endtex
+   REAL(r_std), DIMENSION(:,:,:), INTENT(IN)                 :: circ_class_n           !! Number of trees within each circumference
+   REAL(r_std), DIMENSION(:), INTENT(in)                     :: z0m                    !! Roughness height for momentum of vegetated part (m)
+   TYPE(laieff_type),DIMENSION (:,:,:),INTENT(in)            :: laieff_fit             !! Fitted parameters for the effective LAI
+   
+   !! 0.2 Output variables
+   
+   REAL(r_std), DIMENSION(:,:), INTENT(out)                  :: alb_bare               !! Mean bare soil albedo for visible and near-infrared
+   REAL(r_std), DIMENSION (:,:), INTENT (out)                :: albedo                 !! Albedo (two stream radiation transfer model)
+                                                                                       !! for visible and near-infrared range 
+                                                                                       !! (unitless)
+   REAL(r_std),DIMENSION (:), INTENT (out)                   :: albedo_snow            !! Snow albedo (unitless ratio)     
+   REAL(r_std),DIMENSION (:), INTENT (out)                   :: albedo_glob            !! Mean albedo (unitless ratio)
+   REAL(r_std),DIMENSION (:,:,:), INTENT (out)               :: Isotrop_Abs_Tot_p      !! Absorbed radiation per layer for photosynthesis
+   REAL(r_std),DIMENSION (:,:,:), INTENT (out)               :: Isotrop_Tran_Tot_p     !! Transmitted radiation per layer for photosynthesis
+   REAL(r_std), DIMENSION (:,:,:), INTENT (out)              :: albedo_pft             !! Albedo (two stream radiation transfer model)
+                                                                                       !! for visible and near-infrared range 
+                                                                                       !! for each PFT (unitless)
+   REAL(r_std), DIMENSION(:,:), INTENT(in)                   :: frac_snow_nobio        !! Fraction of snow on continental ice, lakes, etc. 
+                                                                                       !! (unitless ratio)
+   REAL(r_std),DIMENSION(:), INTENT(in)                      :: frac_snow_veg          !! The fraction of ground covered with snow, between 0 and 1
+   REAL(r_std),DIMENSION(nlevels_tot), INTENT (out)          :: Collim_Abs_Tot_mean    !! collimated total absorption for a given level        * changed for enerbil integration
+   REAL(r_std),DIMENSION(nlevels_tot), INTENT (out)          :: Collim_Alb_Tot_mean    !! Collimated (direct) total albedo for a given level   * changed for enerbil integration
+   REAL(r_std), DIMENSION(nlevels_tot,npts,nvm), INTENT(out) :: laieff_collim          !! Leaf Area Index Effective for direct light
+   REAL(r_std), DIMENSION(nlevels_tot,npts,nvm), INTENT(out) :: laieff_isotrop         !! Leaf Area Index Effective converts
+                                                                                       !! 3D lai into 1D lai for two stream
+                                                                                       !! radiation transfer model...this is for 
+                                                                                       !! isotropic light and only calculated once per day
+                                                                                       !! @tex $(m^{2} m^{-2})$ @endtex      
+
+
+
+   !! 0.3 Modified variables
+ 
+ 
+   !! 0.4 Local variables
+
+   REAL(r_std),DIMENSION (nlevels_tot)   :: laieff_isotrop_pft, laieff_collim_pft   !! 
+   REAL(r_std)                           :: cosine_sun_angle    !! the cosine of the solar zenith angle
+   INTEGER(i_std)                        :: ks                  !! Index for visible and near-infraread range
+   INTEGER(i_std)                        :: ivm                 !! Index for vegetative PFTs
+   INTEGER(i_std)                        :: ipts                !! Index for spatial domain
+   INTEGER(i_std)                        :: ilevel              !! Index for canopy levels
+   REAL(r_std)                           :: leaf_reflectance
+   REAL(r_std)                           :: leaf_transmittance
+   REAL(r_std)                           :: br_base_temp,br_base_temp_collim,br_base_temp_isotrop
+   REAL(r_std)                           :: leaf_psd_temp
+   REAL(r_std)                           :: leaf_single_scattering_albedo
+
+   REAL(r_std),DIMENSION(nlevels_tot)    :: Collim_Tran_Uncoll  !! collimated total transmission of uncollided light for a given level 
+   REAL(r_std),DIMENSION(nlevels_tot)    :: Collim_Tran_Coll    !! collimated total transmission for a given level
+   REAL(r_std),DIMENSION(nlevels_tot)    :: Collim_Abs_Tot      !! collimated total absorption for a given level        * changed for enerbil integration
+   REAL(r_std),DIMENSION(nlevels_tot)    :: Collim_Alb_Tot      !! Collimated (direct) total albedo for a given level   * changed for enerbil integration
+
+   REAL(r_std),DIMENSION(nlevels_tot)    :: Isotrop_Alb_Tot     !! isotropic (diffuse) total albedo for a given level
+   REAL(r_std),DIMENSION(nlevels_tot)    :: Isotrop_Tran_Uncoll !! isotropic total transmission of uncollided light for a given level
+   REAL(r_std),DIMENSION(nlevels_tot)    :: Isotrop_Tran_Coll   !! isotropic total transmission for a given level
+   REAL(r_std),DIMENSION(nlevels_tot)    :: Isotrop_Abs_Tot     !! isotropic total absporbtion for a given level
+   INTEGER :: jv, inno
+   REAL(r_std) :: alb_nobio
+
+   REAL(r_std), DIMENSION(npts,nvm)      :: frac_snow_veg_loc   !! the fraction of ground covered with snow, between 0 and 1
+
+
+
+   REAL(r_std):: laieff_collim_1, laieff_isotrop_1, Collim_Alb_Tot_1,Collim_Tran_Tot_1,Collim_Abs_Tot_1,&
+                 Isotrop_Alb_Tot_1,Isotrop_Tran_Tot_1,Isotrop_Abs_Tot_1,&
+                 Collim_Tran_Uncollided_1, Isotrop_Tran_Uncollided_1  !! Values for the one level solution
+
+   REAL(r_std):: converged_albedo
+   REAL(r_std):: isotrop_angle
+   LOGICAL :: lconverged
+   LOGICAL :: lprint                                                  !! a flag for printing some debug statements
+   REAL(r_std), DIMENSION(npts,nvm,n_spectralbands) :: snowa_veg      !! snow albedo due to vegetated surfaces, between 0 and 1
+   REAL(r_std), DIMENSION(npts,nnobio,n_spectralbands) :: snowa_nobio !! Albedo of snow covered area on continental ice, 
+                                                                      !! lakes, etc. (unitless ratio)  
+
+!_ ================================================================================================================================
+
+   IF (printlev>=2) WRITE(numout,*) 'Entering albedo_two_stream'
+
+   !! Initialize local printlev
+    !printlev_loc=get_printlev('albedo') 
+
+   IF (printlev_loc>=3) WRITE(numout,*) 'nlevels_tot',nlevels_tot
+   IF (printlev_loc>=4) THEN
+      DO ivm = 1,nvm
+         WRITE(numout,*) 'laieff_isotrop start albedo for ivm', &
+              ivm,'is', laieff_isotrop(:,:,ivm)
+      ENDDO
+      WRITE(numout,*)'albedo.f90, coszang',coszang(:)
+   ENDIF
+
+   !! 1. We will now calculate the background reflectance to be used in the model.
+   !  The parameters read in from the input file do not include the effect 
+   !  of snow, so we need to figure out the snow's contribution for each 
+   !  grid space
+   !  Initialize some output variables
+   DO ipts = 1, npts
+      albedo_snow(ipts) = zero
+   ENDDO
+
+   Isotrop_Abs_Tot_p(:,:,:)=zero
+   Isotrop_Tran_Tot_p(:,:,:)=un
+   albedo_pft(:,:,:)=zero
+
+   Collim_Abs_Tot_mean(:) = zero
+   Collim_Alb_Tot_mean(:) = zero
+
+   ! We need to calculate the LAI effective for this solar angle. The other LAI
+   ! effective that we calculated was computed at an angle of 60.0 degrees for
+   ! the isotropic contribution. Notice that, in many situations, the results 
+   ! will be exactly the same.  One can show that Pgap is proportional to 
+   ! 1/cos(theta) if the level bottom is below all canopy elements, which
+   ! means that the cos(theta) in the calculation of the LAIeff will be
+   ! cancelled out
+   isotrop_angle=COS(60.0/180.0*pi)
+   DO ipts=1,npts
+      DO ivm=1,nvm
+         DO ilevel=1,nlevels_tot
+            laieff_isotrop(ilevel,ipts,ivm) = &
+                 calculate_laieff_fit(isotrop_angle,laieff_fit(ipts,ivm,ilevel))
+            laieff_collim(ilevel,ipts,ivm) = &
+                 calculate_laieff_fit(coszang(ipts),laieff_fit(ipts,ivm,ilevel))
+            ! Because we are fitting these values, it's possible that some 
+            ! will drop below zero.  This causes a serious problem here,
+            ! so let's make sure this doesn't happen.  Unfortunately, by
+            ! doing this, we lose a test of things going wrong (an unfitted
+            ! negative LAIeff can be the sign of another problem), but we
+            ! don't really have a choice.
+            IF(laieff_isotrop(ilevel,ipts,ivm) .LT. min_stomate) &
+                 laieff_isotrop(ilevel,ipts,ivm)=zero
+            IF(laieff_collim(ilevel,ipts,ivm) .LT. min_stomate) &
+                 laieff_collim(ilevel,ipts,ivm)=zero
+         ENDDO
+      ENDDO
+   ENDDO
+
+   ! Debug
+   IF(printlev_loc>=4)THEN
+      DO ivm=1,nvm
+         IF(ivm == test_pft)THEN
+            DO ipts = 1, npts
+               IF(ipts == test_grid)THEN
+                  WRITE(numout,*) 'Laieff_collim and laieff_isotrop in albedo'
+                  WRITE(numout,*) 'ACOS(coszang(ipts))/pi*180: ',&
+                       ACOS(coszang(ipts))/pi*180.0_r_std
+                  WRITE(numout,*) 'coszang(ipst)', coszang
+                  DO ilevel=nlevels_tot,1,-1
+                     WRITE(numout,*) ilevel,laieff_collim(ilevel,ipts,ivm),&
+                          laieff_isotrop(ilevel,ipts,ivm)
+                  END DO
+                  DO ilevel=nlevels_tot,1,-1
+                     WRITE(numout,*) 'Fitting parameters: ',&
+                          laieff_fit(ipts,ivm,ilevel)%a,&
+                          laieff_fit(ipts,ivm,ilevel)%b,&
+                          laieff_fit(ipts,ivm,ilevel)%c,&
+                          laieff_fit(ipts,ivm,ilevel)%d,&
+                          laieff_fit(ipts,ivm,ilevel)%e
+                  ENDDO
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDDO
+   ENDIF
+   !-
+
+   ! Calculate the snow albedo
+   CALL calculate_snow_albedo(npts,  coszang,  snow,  snow_nobio, &
+        snow_age, snow_nobio_age,  frac_nobio,  albedo_snow, &
+        snowa_veg,  frac_snow_veg,  snowa_nobio,  frac_snow_nobio, &
+        veget_max, z0m)
+
+   ! Check for possible problems in the calcualtion of the fraction
+   ! of the grid cell covered by snow. Fractions should be positive
+   ! numbers
+   DO ipts=1,npts
+      IF(frac_snow_veg(ipts) .LT. 0.0)THEN
+         WRITE(numout,*) 'SNOWFRAC ipts ',ipts,frac_snow_veg(ipts)
+         CALL ipslerr_p (3,'albedo', 'snow frac error','','')
+      END IF
+     
+      DO inno=1,nnobio
+         IF(frac_snow_nobio(ipts,inno) .LT. 0.0)THEN
+            WRITE(numout,*) 'SNOWFRAC ipts inno',ipts,inno,frac_snow_nobio(ipts,inno)
+            CALL ipslerr_p (3,'albedo', 'nobio snow frac error','','')
+         ENDIF
+      ENDDO
+   ENDDO
+
+   ! Initialize the albedo in every square for both spectra by calculating the 
+   ! bare soil albedo
+   DO ipts = 1, npts
+      DO ks = 1, n_spectralbands
+
+         ! 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(ipts,ks) = soilalb_wet(ipts,ks) + drysoil_frac(ipts) * &
+                 (soilalb_dry(ipts,ks) -  soilalb_wet(ipts,ks))
+         ELSE
+            alb_bare(ipts,ks) = soilalb_moy(ipts,ks)
+         ENDIF
+
+         ! we need to take into account any snow that has fallen on the bare 
+         ! soil since there may be some bare soil, initialize the albedo with 
+         ! this fraction
+         albedo(ipts,ks) = veget_max(ipts,1) * (alb_bare(ipts,ks)*&
+              (un-frac_snow_veg(ipts)) + &
+              frac_snow_veg(ipts)*snowa_veg(ipts,1,ks))
+      
+      ENDDO ! ks = 1, n_spectralbands
+   ENDDO ! ipts = 1, npts
+ 
+   !! 2. Calculation of albedo of the whole grid cell, taking into account all 
+   !!    PFTs (except bare soil) and spectral bands
+   DO ipts = 1, npts ! loop over the grid squares
+
+      !+++CHECK+++
+      ! observations from the MERGE, sinang is calculated as cos of the zenith
+      ! angle in solar.f90 (i.e. it is the cosine of the zenith angle). 
+      ! Then maybe also the cosine_sun_angle is a redundant variable.
+      cosine_sun_angle = coszang(ipts)
+      !+++++++++++
+
+      ! Debug
+      IF(printlev_loc >= 4) THEN
+         WRITE(numout,*)'cosine_sun_angle',cosine_sun_angle
+      ENDIF
+
+      ! For the coupled model, the angles can be negative.
+      ! Offline, they are always between zero and 90 degrees.
+      IF(cosine_sun_angle .LE. min_sechiba)THEN
+
+         ! It's night, so no sunlight...don't need to calculate albedo.  
+         ! Set it equal to zero, because the snow albedo has already been 
+         ! calculated and it looks funny on the coupled run maps otherwise.
+         albedo(ipts,:)=zero
+         CYCLE
+
+      ENDIF
+
+      ! Are there any non-bio PFTs here that we need to take into account?
+      DO ks = 1, n_spectralbands ! Loop over # of spectra
+         DO jv = 1, nnobio 
+            ! now update the albedo
+            IF ( jv .EQ. iice ) THEN
+               alb_nobio = alb_ice(ks)
+            ELSE
+               WRITE(numout,*) 'jv=',jv
+               CALL ipslerr_p (3,'Albedo.f90', &
+                    'DO NOT KNOW ALBEDO OF THIS SURFACE TYPE','','')
+            ENDIF
+
+            ! this takes into account both snow covered and non-snow 
+            ! covered non-bio regios in all grid squares
+            albedo(ipts,ks) = albedo(ipts,ks) + &
+                 ( frac_nobio(ipts,jv) ) * &
+                 ( (un-frac_snow_nobio(ipts,jv)) * alb_nobio + &
+                 ( frac_snow_nobio(ipts,jv)  ) * snowa_nobio(ipts,jv,ks)   )
+
+            albedo_snow(ipts) = albedo_snow(ipts) + &
+                 ( frac_nobio(ipts,jv) ) * ( frac_snow_nobio(ipts,jv) ) * &
+                 snowa_nobio(ipts,jv,ks)/REAL(n_spectralbands,r_std) 
+
+         ENDDO ! jv = 1, nnobio 
+      ENDDO ! ks = 1, n_spectralbands 
+      
+
+      DO ivm = 2, nvm  ! Loop over # of PFTs 
+
+         ! Use local variable. Note that the dimension are changed
+         ! a PFT-specific frac_snow_veg is now used. In the future
+         ! frac_snow_veg could be made PFT dependent. 
+         frac_snow_veg_loc(ipts,ivm) = frac_snow_veg(ipts)
+
+         ! for this grid square and this vegetation type, we have a set LAI 
+         ! effective
+         laieff_collim_pft(1:nlevels_tot) = &
+              laieff_collim(1:nlevels_tot,ipts,ivm)
+         laieff_isotrop_pft(1:nlevels_tot) = &
+              laieff_isotrop(1:nlevels_tot,ipts,ivm)
+
+         IF(veget_max(ipts,ivm) == zero)THEN
+            ! this vegetation type is not present, so no reason to do the 
+            ! calculation
+            CYCLE
+         ENDIF
+
+         DO ks = 1, n_spectralbands ! Loop over # of spectra
+
+            ! set single scattering albedo and preferred scattering direction
+            leaf_single_scattering_albedo = leaf_ssa(ivm,ks)
+            leaf_psd_temp = leaf_psd(ivm,ks)                 
+
+            ! calculate the rleaf and tleaf from wl=rl+tl and dl=rl/tl
+            leaf_transmittance = leaf_single_scattering_albedo/ & 
+                 (leaf_psd_temp+1)
+            leaf_reflectance = leaf_psd_temp * &
+                 leaf_transmittance
+
+            ! We need to take into account the effect of snow on the 
+            ! background reflectance here. From the snow above I can 
+            ! calculate the true background reflectance for this PFT.
+            ! The flag alb_bg_modis is a bit confusing because in 
+            ! both cases the data source is the MODIS albedo product
+            IF (alb_bg_modis) THEN
+
+               ! If the flag is set to TRUE the model will read a 
+               ! spatially explicit map of the background albedo for
+               ! each PIXEL. The background albedo of the pixel is 
+               ! then used to calculate the background albedo of the
+               ! PFT accounting for snow fraction and snow albedo. Note
+               ! that both snow fraction and snow albedo vary over time.
+               br_base_temp = (un-frac_snow_veg_loc(ipts,ivm)) * & 
+                 bckgrnd_alb(ipts,ks) + &
+                 ( frac_snow_veg_loc(ipts,ivm)  ) * snowa_veg(ipts,ivm,ks)
+
+            ELSE
+               
+               ! If the flag is set to FALSE the model uses the original
+               ! parameterization at the PFT level. Each PFT has a fixed
+               ! background albedo. The background albedo is recalculated
+               ! taking into account the snowfraction and the snow albedo.
+               ! Note that snow fraction and snoe albedo both vary over
+               ! time.
+               br_base_temp= (un-frac_snow_veg_loc(ipts,ivm)) * & 
+                 bgd_reflectance(ivm,ks) + &
+                 ( frac_snow_veg_loc(ipts,ivm)  ) * snowa_veg(ipts,ivm,ks)
+
+            ENDIF
+
+            ! At this step, we assume that there is no difference between the 
+            ! direct and the diffuse background reflectance, which is true for 
+            ! the background but not the canopy albedo
+            br_base_temp_collim=br_base_temp
+            br_base_temp_isotrop=br_base_temp
+
+            ! Debug - Set flag for extra output
+            IF(printlev_loc>=4 .AND. test_pft == ivm .AND. &
+                 test_grid == ipts)THEN
+               lprint=.TRUE.
+            ELSE
+               lprint=.FALSE.
+            ENDIF
+            !-
+    
+            ! Now solve the multilevel scheme 
+            CALL multilevel_albedo(cosine_sun_angle, &
+                 leaf_single_scattering_albedo, &
+                 leaf_psd_temp, br_base_temp_collim, br_base_temp_isotrop, &
+                 laieff_collim_pft, laieff_isotrop_pft, lconverged, &
+                 Collim_Alb_Tot, Collim_Tran_Coll, Collim_Abs_Tot, &
+                 Isotrop_Alb_Tot, &
+                 Isotrop_Tran_Coll, Isotrop_Abs_Tot, Collim_Tran_Uncoll, &
+                 Isotrop_Tran_Uncoll, lprint)
+
+            Collim_Abs_Tot_mean(:) = Collim_Abs_Tot_mean(:) + Collim_Abs_Tot(:)
+            Collim_Alb_Tot_mean(:) = Collim_Alb_Tot_mean(:) + Collim_Alb_Tot(:)
+
+            ! This is a lot of information printed out for the paper
+            ! on the multilevel albedo scheme (McGrath et al 2016, GMDD).  
+            ! Probably not useful for anyone else, but I'm keeping it in 
+            ! until the paper is published. This is why I'm protecting it 
+            ! with an IF statement.  I do not use printlev_loc>=4 since it 
+            ! really is too much information for normal usage.
+            IF(.FALSE.)THEN
+
+               WRITE(6,'(A,2F14.10)') 'Background reflectance ',&
+                    br_base_temp_collim,br_base_temp_isotrop
+               WRITE(6,'(A,F14.10)') 'Single scattering albedo (wl): ',&
+                    leaf_single_scattering_albedo
+               WRITE(6,'(A,F14.10)') 'Preferred scattering direction (dl): ',&
+                    leaf_psd_temp
+
+               WRITE(6,*) 'Collimated light ',ACOS(cosine_sun_angle)/pi*180.0
+               WRITE(6,'(A,F4.1,A,4(F10.6,A))') '        1  &  ',laieff_collim_1,&
+                    ' & ',Collim_Alb_Tot_1,' & ',&
+                    Collim_Tran_Tot_1-Collim_Tran_Uncollided_1,' & ',&
+                    Collim_Tran_Uncollided_1,' & ',&
+                    Collim_Alb_Tot_1+Collim_Tran_Tot_1,' \\ '
+               WRITE(6,'(A,F4.1,A,4(F10.6,A))') '        2  &  ',laieff_collim_1,&
+                    ' & ',Collim_Alb_Tot(nlevels_tot),' & ',&
+                    Collim_Tran_Coll(1),' & ',Collim_Tran_Uncoll(1),' & ',&
+                    Collim_Alb_Tot(nlevels_tot)+Collim_Tran_Coll(1)+&
+                    Collim_Tran_Uncoll(1),' \\ '
+               WRITE(6,'(A,F4.1,A,4(F10.6,A))') '     Diff  &  ',laieff_collim_1,&
+                    ' & ',ABS(Collim_Alb_Tot_1-Collim_Alb_Tot(nlevels_tot)),' & ',&
+                    ABS((Collim_Tran_Tot_1-Collim_Tran_Uncollided_1)-&
+                    Collim_Tran_Coll(1)),' & ',&
+                    ABS(Collim_Tran_Uncollided_1-Collim_Tran_UnColl(1)),' & ',&
+                    ABS((Collim_Alb_Tot_1+Collim_Tran_Tot_1)-&
+                    (Collim_Alb_Tot(nlevels_tot)+Collim_Tran_Coll(1)+&
+                    Collim_Tran_Uncoll(1))),' \\ '
+
+               WRITE(6,*) 'Isotropic light '
+               WRITE(6,'(A,F4.1,A,4(F10.6,A))') '        1  &  ',&
+                    laieff_isotrop_1,' & ',Isotrop_Alb_Tot_1,' & ',&
+                    Isotrop_Tran_Tot_1-Isotrop_Tran_Uncollided_1,' & ',&
+                    Isotrop_Tran_Uncollided_1,' & ',&
+                    Isotrop_Alb_Tot_1+Isotrop_Tran_Tot_1,' \\ '
+               WRITE(6,'(A,F4.1,A,4(F10.6,A))') '        2  &  ',&
+                    laieff_isotrop_1,' & ',Isotrop_Alb_Tot(nlevels_tot),' & ',&
+                    Isotrop_Tran_Coll(1),' & ',Isotrop_Tran_Uncoll(1),' & ',&
+                    Isotrop_Alb_Tot(nlevels_tot)+Isotrop_Tran_Coll(1)+&
+                    Isotrop_Tran_Uncoll(1),' \\ '
+               WRITE(6,'(A,F4.1,A,4(F10.6,A))') '     Diff  &  ',&
+                    laieff_isotrop_1,&
+                    ' & ',ABS(Isotrop_Alb_Tot_1-Isotrop_Alb_Tot(nlevels_tot)),' & ',&
+                    ABS((Isotrop_Tran_Tot_1-Isotrop_Tran_Uncollided_1)-&
+                    Isotrop_Tran_Coll(1)),' & ',&
+                    ABS(Isotrop_Tran_Uncollided_1-Isotrop_Tran_UnColl(1)),' & ',&
+                    ABS((Isotrop_Alb_Tot_1+Isotrop_Tran_Tot_1)-&
+                    (Isotrop_Alb_Tot(nlevels_tot)+Isotrop_Tran_Coll(1)+&
+                    Isotrop_Tran_Uncoll(1))),' \\ '
+
+               WRITE(6,1010) 'COLLIMTRAN ',laieff_collim_1, &
+                    laieff_collim_pft(nlevels_tot),1,&
+                    leaf_single_scattering_albedo,br_base_temp_collim,&
+                    leaf_psd_temp,ACOS(cosine_sun_angle)/pi*180.0,&
+                    Collim_Tran_Tot_1,(Collim_Tran_Coll(1)+Collim_Tran_Uncoll(1))
+               WRITE(6,1010) 'COLLIMALB ',laieff_collim_1, &
+                    laieff_collim_pft(nlevels_tot),2,&
+                    leaf_single_scattering_albedo,br_base_temp_collim,&
+                    leaf_psd_temp,ACOS(cosine_sun_angle)/pi*180.0,&
+                    Collim_Alb_Tot_1,Collim_Alb_Tot(nlevels_tot)
+               WRITE(6,1010) 'COLLIMABSCAN ',laieff_collim_1, &
+                    laieff_collim_pft(nlevels_tot),3,&
+                    leaf_single_scattering_albedo,br_base_temp_collim,&
+                    leaf_psd_temp,ACOS(cosine_sun_angle)/pi*180.0,&
+                    Collim_Abs_Tot_1,SUM(Collim_Abs_Tot(:))
+               WRITE(6,1010) 'COLLIMABSSOIL ',laieff_collim_1, &
+                    laieff_collim_pft(nlevels_tot),4,&
+                    leaf_single_scattering_albedo,br_base_temp_collim,&
+                    leaf_psd_temp,ACOS(cosine_sun_angle)/pi*180.0,&
+                    un-Collim_Alb_Tot_1-Collim_Abs_Tot_1,un-&
+                    Collim_Alb_Tot(nlevels_tot)-SUM(Collim_Abs_Tot(:))
+
+               WRITE(6,1010) 'ISOTROPTRAN ',laieff_isotrop_1, &
+                    laieff_isotrop_pft(nlevels_tot),1,&
+                    leaf_single_scattering_albedo,br_base_temp_isotrop,&
+                    leaf_psd_temp,ACOS(cosine_sun_angle)/pi*180.0,&
+                    Isotrop_Tran_Tot_1,(Isotrop_Tran_Coll(1)+Isotrop_Tran_Uncoll(1))
+               WRITE(6,1010) 'ISOTROPALB ',laieff_isotrop_1, &
+                    laieff_isotrop_pft(nlevels_tot),2,&
+                    leaf_single_scattering_albedo,br_base_temp_isotrop,&
+                    leaf_psd_temp,ACOS(cosine_sun_angle)/pi*180.0,&
+                    Isotrop_Alb_Tot_1,Isotrop_Alb_Tot(nlevels_tot)
+               WRITE(6,1010) 'ISOTROPABSCAN ',laieff_isotrop_1, &
+                    laieff_isotrop_pft(nlevels_tot),3,&
+                    leaf_single_scattering_albedo,br_base_temp_isotrop,&
+                    leaf_psd_temp,ACOS(cosine_sun_angle)/pi*180.0,&
+                    Isotrop_Abs_Tot_1,SUM(Isotrop_Abs_Tot(:))
+               WRITE(6,1010) 'ISOTROPABSSOIL ',laieff_isotrop_1, &
+                    laieff_isotrop_pft(nlevels_tot),4,&
+                    leaf_single_scattering_albedo,br_base_temp_isotrop,&
+                    leaf_psd_temp,ACOS(cosine_sun_angle)/pi*180.0,&
+                    un-Isotrop_Alb_Tot_1-Isotrop_Abs_Tot_1,un-&
+                    Isotrop_Alb_Tot(nlevels_tot)-SUM(Isotrop_Abs_Tot(:))
+
+1010           FORMAT(A,2(F12.6,2X),I4,2X,6(F14.8,2X))
+
+            ENDIF ! debugging
+
+            ! For our total albedo, we are just taking a simple mean of the 
+            ! diffuse and the direct light, which means we lose some 
+            ! information. This might be changed in the future. We also need 
+            ! to weight this by the percentage of nonbio land, but this 
+            ! appears to be included in veget_max
+            converged_albedo = (Collim_Alb_Tot(nlevels_tot) + &
+                 Isotrop_Alb_Tot(nlevels_tot))/2.0_r_std
+            albedo(ipts,ks) = albedo(ipts,ks) + &
+                 veget_max(ipts,ivm)*converged_albedo
+            albedo_pft(ipts,ivm,ks)=veget_max(ipts,ivm)*converged_albedo
+
+            ! Save the absorbed radiation for photosynthesis, we need only the
+            ! visible range and use the isotropic part, this can be change 
+            ! later to distinguish between sunlit and shaded leaves.
+            ! Be careful here
+            IF (ks == 1) THEN
+               ! Test if Collim_Abs_Tot has negative values
+               ! If so, set it to min_sechiba  
+               DO  ilevel=1,nlevels_tot
+                  IF (Isotrop_Abs_Tot(ilevel) .LT. zero) THEN
+                     Isotrop_Abs_Tot(ilevel) =  min_sechiba
+                  ENDIF
+               ENDDO
+               !
+               Isotrop_Abs_Tot_p(ipts,ivm,:) = Isotrop_Abs_Tot(:)
+               Isotrop_Tran_Tot_p(ipts,ivm,:) = Isotrop_Tran_Coll(:) + &
+                    Isotrop_Tran_Uncoll(:)
+
+               ! Notice that this light is actually cumulative, not per
+               ! level!  This was needed for debugging purposes and running
+               ! tests.  However, the photosynthesis routines need the light
+               ! transmitted per level, i.e. if there is zero LAI
+               ! in a level, the transmitted light will be one.
+               DO ilevel=1,nlevels_tot-1
+                  IF(Isotrop_Tran_Tot_p(ipts,ivm,ilevel+1) .GT. alb_threshold)THEN
+                     Isotrop_Tran_Tot_p(ipts,ivm,ilevel)=&
+                          Isotrop_Tran_Tot_p(ipts,ivm,ilevel) / &
+                          Isotrop_Tran_Tot_p(ipts,ivm,ilevel+1)
+                  ELSE
+
+                     ! Here, we really don't know anything about how much 
+                     ! light is transmitted in this layer, but there is no 
+                     ! light reaching it from above so we can safely assume 
+                     ! no photosynthesis takes place.  This is equivalent
+                     ! to assuming it has no LAI, which means the 
+                     ! transmission will be unity.
+                     Isotrop_Tran_Tot_p(ipts,ivm,ilevel)=un
+
+                  ENDIF
+               ENDDO
+
+               ! Debug
+               IF (printlev_loc>=4 .AND. ivm == test_pft .AND. &
+                    ipts == test_grid) THEN
+                  WRITE(numout,*) 'Absorbed light in albedo.f90: ', ipts, ivm
+                  DO ilevel=nlevels_tot,1,-1
+                     WRITE(numout,'(I5,10F20.10)') ilevel, &
+                          Isotrop_Abs_Tot_p(ipts,ivm,ilevel),&
+                          Isotrop_Tran_Tot_p(ipts,ivm,ilevel),&
+                          laieff_isotrop(ilevel,ipts,ivm),&
+                          laieff_collim(ilevel,ipts,ivm)
+                  ENDDO
+               ENDIF
+               !-
+
+            ENDIF ! IF ks==1
+
+         ENDDO ! ks = 1, n_spectralbands 
+
+      ENDDO ! ivm = 2, nvm  
+
+   ENDDO ! ipts = 1, npts 
+
+   ! now we need to average the albedo over all our spectra, so we can 
+   ! pass it to modules which do not distinguish between different 
+   ! spectral bands
+   albedo_glob(:) = zero
+   DO ks = 1, n_spectralbands ! Loop over # of spectra
+      albedo_glob(:) = albedo_glob(:) + albedo(:,ks)
+   ENDDO
+   albedo_glob(:)=albedo_glob(:)/REAL(n_spectralbands,r_std)
+
+   Collim_Abs_Tot_mean(:) = Collim_Abs_Tot_mean(:) / n_spectralbands
+   Collim_Alb_Tot_mean(:) = Collim_Abs_Tot_mean(:) / n_spectralbands
+
+   ! Error checking
+   IF (abs(albedo(1,1)) .gt. 1.0d0) THEN
+
+       CALL print_debugging_albedo_info(1, cosine_sun_angle, &
+             leaf_reflectance, leaf_transmittance, laieff_collim_1, &
+             laieff_isotrop_1, br_base_temp_collim, br_base_temp_isotrop, &
+             Collim_Alb_Tot_1, Collim_Tran_Tot_1, Collim_Abs_Tot_1, &
+             Isotrop_Alb_Tot_1, Isotrop_Tran_Tot_1, Isotrop_Abs_Tot_1)
+       STOP
+
+   END IF
+   !-
+
+   ! Debug
+   IF (printlev_loc>=4) THEN
+      DO ivm = 1,nvm
+         WRITE(numout,*) 'laieff_isotrop end albedo for ivm',ivm,'is', &
+              laieff_isotrop(:,:,ivm)
+      ENDDO
+   ENDIF
+   !-
+
+   IF (printlev>=3) WRITE(numout,*) 'Leaving albedo_two_stream'
+
+ END SUBROUTINE albedo_two_stream
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : twostream_solver
+!!
+!>\BRIEF        : Computes the two-stream albedo solution for a level with given single scatterer properties
+!!                and a defined background albedo
+!!
+!! DESCRIPTION  : This solution is the two-stream solution of Pinty et al (2006) for a vegetation level above
+!!                an isotropically reflecting background.  It breaks down the problem into three parts, solving
+!!                each part for the case of diffuse (isotropic) and direct (collimated) light.  The three parts are,
+!!                1) The term due to light that does not interact at all with the canopy (Black Canopy)
+!!                2) Light that does not interact at all with the background (Black Background)
+!!                3) Light that bounces between the background and the canopy
+!!                This routine (and the routines it uses) were received directly from Bernard Pinty, and only some
+!!                minor modifcations were made, in addition to more documentation
+!! 
+!!                NOTE: the single layer solution is no longer used. The code is kept here in case it is decided that
+!!                      the multi layer solution is two expensive if only a single layer is used for the energy budget.
+!!                      In that case a solution needs to be implemeted to calculate the light distribution within
+!!                      the canopy. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): Collim_Alb_Tot,Collim_Tran_Tot,
+!!      Collim_Abs_Tot,Isotrop_Alb_Tot,Isotrop_Tran_Tot,Isotrop_Abs_To
+!!
+!! REFERENCE(S) :  B. Pinty, T. Lavergne, R.E. Dickinson, J-L. Widlowski, N. Gobron and M. M. Verstraete (2006).
+!! Simplifying the Interaction of Land Surfaces with Radiation for Relating Remote Sensing Products to Climate Models.
+!! Journal of Geophysical Research. Vol 111, D02116.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE twostream_solver(leaf_reflectance, leaf_transmittance, background_reflectance_collim, background_reflectance_isotrop, &
+          cosine_sun_angle, Collim_Alb_Tot, Collim_Tran_Tot, Collim_Abs_Tot, &
+          Isotrop_Alb_Tot, Isotrop_Tran_Tot, Isotrop_Abs_Tot, laieff_collim, &
+           laieff_isotrop,  Collim_Tran_Uncollided,  Isotrop_Tran_Uncollided)
+
+
+   !! 0. Variables and parameter declaration
+   !! 0.1 Input variables
+   REAL(r_std), INTENT(IN)    :: leaf_reflectance            !! effective leaf reflectance, between 0 and 1
+                                                             !! @tex $()$ @endtex 
+   REAL(r_std), INTENT(IN)    :: leaf_transmittance          !! effective leaf transmittance, between 0 and 1
+                                                             !! @tex $()$ @endtex 
+   REAL(r_std), INTENT(IN)    :: background_reflectance_collim      !! background reflectance for direct radiation,
+                                                             !! between 0 and 1
+   REAL(r_std), INTENT(IN)    :: background_reflectance_isotrop      !! background reflectance for diffuse radiation,
+                                                             !! between 0 and 1
+   REAL(r_std), INTENT(IN)    :: cosine_sun_angle            !! cosine of the solar zenith angle, between 0 and 1
+                                                             !! @tex $()$ @endtex 
+   REAL(r_std), INTENT(IN)    :: laieff_collim               !! Effective Leaf Area Index, computed at current sun angle
+   REAL(r_std), INTENT(IN)    :: laieff_isotrop              !! Effective Leaf Area Index, computed at 60 degrees
+                                                             !! @tex $(m^{2} m^{-2})$ @endtex 
+
+   !! 0.2 Output variables
+   !! notice that these variables (absorption + transmission + reflection) do not necessarily add up to 1 due to multiple scattering
+   REAL(r_std), INTENT(OUT)   :: Collim_Alb_Tot              !! collimated total albedo from this level, between 0 and 1
+                                                             !! @tex $()$ @endtex 
+   REAL(r_std), INTENT(OUT)   :: Collim_Tran_Tot             !! collimated total transmission through this level, between 0 and 1
+                                                             !! @tex $()$ @endtex 
+   REAL(r_std), INTENT(OUT)   :: Collim_Abs_Tot              !! collimated total absorption by this level, between 0 and 1
+                                                             !! @tex $()$ @endtex 
+   REAL(r_std), INTENT(OUT)   :: Isotrop_Alb_Tot             !! isotropic total albedo from this level, between 0 and 1
+                                                             !! @tex $()$ @endtex 
+   REAL(r_std), INTENT(OUT)   :: Isotrop_Tran_Tot            !! isotropic total transmission through this level, between 0 and 1
+                                                             !! @tex $()$ @endtex 
+   REAL(r_std), INTENT(OUT)   :: Isotrop_Abs_Tot             !! isotropic total absorption by this level, between 0 and 1
+                                                             !! @tex $()$ @endtex 
+   REAL(r_std), INTENT(OUT)   :: Collim_Tran_Uncollided      !! collimated uncollied transmission through this level, between 0 and 1
+                                                             !! @tex $()$ @endtex 
+   REAL(r_std), INTENT(OUT)   :: Isotrop_Tran_Uncollided     !! isotropic uncollied transmission through this level, between 0 and 1
+                                                             !! @tex $()$ @endtex 
+
+   !! 0.3 Modified variables
+
+   !! 0.4 Local variables
+   LOGICAL :: ok
+   REAL(r_std), DIMENSION(4)                           :: gammaCoeffs
+   REAL(r_std), DIMENSION(4)                           :: gammaCoeffs_star
+   REAL(r_std)                                         :: tauprimetilde
+   REAL(r_std)                                         :: tauprimestar
+   REAL(r_std)                                         :: sun_zenith_angle_radians
+   REAL(r_std), PARAMETER                              :: isotropic_cosine_constant=0.5/0.705
+
+   !calculated fluxes
+
+   REAL(r_std)                :: Collim_Alb_BB 
+   REAL(r_std)                :: Collim_Tran_BB
+   REAL(r_std)                :: Collim_Abs_BB
+   REAL(r_std)                :: Isotrop_Alb_BB
+   REAL(r_std)                :: Isotrop_Tran_BB
+   REAL(r_std)                :: Isotrop_Abs_BB
+   REAL(r_std)                :: Collim_Tran_BC
+   REAL(r_std)                :: Isotrop_Tran_BC
+   REAL(r_std)                :: Collim_Tran_TotalOneWay
+   REAL(r_std)                :: Isotrop_Tran_TotalOneWay
+   REAL(r_std)                :: Below_reinject_rad_collim,Below_reinject_rad_isotrop
+
+!_ ================================================================================================================================
+
+   IF (printlev>=2) WRITE(numout,*) 'Entering twostream_solver'
+
+   ! convert angular values
+   
+   sun_zenith_angle_radians = acos(cosine_sun_angle)
+
+   ! calculate the 4 gamma coefficients both in isotropic and collimated illumination 
+
+   call gammas(leaf_reflectance, leaf_transmittance, cosine_sun_angle, gammaCoeffs)
+   call gammas(leaf_reflectance,leaf_transmittance,isotropic_cosine_constant,&
+        gammaCoeffs_star)
+
+   ! estimate the effective value of the optical thickness 
+
+   tauprimetilde = 0.5_r_std * laieff_collim
+   !tauprimetilde = 1.
+
+   ! Should become zenit angle dependent (=60Â°) calculated by the Monte Carlo 
+   ! photon shooting routine
+
+   tauprimestar  = 0.5_r_std * laieff_isotrop
+   !tauprimestar  = 1.
+
+   ! +++++++++++++ BLACK BACKGROUND ++++++++++++++++++++++ 
+   ! * Apply the black-background 2stream solution 
+   ! * These equations are written for the part of the incoming radiation 
+   ! * that never hits the background but does interact with the vegetation 
+   ! * canopy.
+   ! * 
+   ! * Note : the same routine dhrT1() is used for both the isotropic and
+   ! * collimated illumination conditions but the calling arguments differ.
+   ! * (especially the solar angle used).
+   ! */
+
+   !	/* 1) collimated source */
+   ok=dhrT1(leaf_reflectance,leaf_transmittance,&
+        gammaCoeffs(1),gammaCoeffs(2),gammaCoeffs(3),gammaCoeffs(4),&
+        sun_zenith_angle_radians, tauprimetilde,&
+        Collim_Alb_BB,Collim_Tran_BB,Collim_Abs_BB)                      
+   ! 	/* 2) isotropic source */
+   ok=dhrT1(leaf_reflectance,leaf_transmittance,&
+        gammaCoeffs_star(1),gammaCoeffs_star(2),gammaCoeffs_star(3),&
+        gammaCoeffs_star(4),&
+        acos(isotropic_cosine_constant),tauprimestar,&
+        Isotrop_Alb_BB,Isotrop_Tran_BB,Isotrop_Abs_BB)
+
+
+   ! +++++++++++++ BLACK CANOPY ++++++++++++++++++++++ 
+   ! * Apply the black canopy solution.
+   ! * These equations hold for the part of the incoming radiation 
+   ! * that do not interact with the vegetation, travelling through 
+   ! * its gaps.
+   ! */
+
+   ! 	/* 1) collimated source */
+   IF (cosine_sun_angle .NE. 0) THEN
+      Collim_Tran_BC  = exp( - tauprimetilde/cosine_sun_angle)
+      Collim_Tran_Uncollided = Collim_Tran_BC
+   ENDIF
+
+
+   ! 	/* 2) isotropic source */
+   Isotrop_Tran_BC = TBarreUncoll_exact(tauprimestar)
+   Isotrop_Tran_Uncollided = Isotrop_Tran_BC
+
+
+   ! /* Total one-way transmissions:
+   ! * The vegetation canopy is crossed (one way) by the uncollided radiation
+   ! * (black canopy) and the collided one (black background). */
+
+   !	/* 1) collimated source */
+   Collim_Tran_TotalOneWay  = Collim_Tran_BC  + Collim_Tran_BB 
+
+   !	/* 2) isotropic source */
+   Isotrop_Tran_TotalOneWay = Isotrop_Tran_BC + Isotrop_Tran_BB 
+
+   ! * The Below_reinject_rad describes the process of reflecting toward the 
+   ! * background the upward travelling radiation (re-emitted from below the 
+   ! * canopy). It appears in the coupling equations as the limit of the series: 
+   ! *    1 + rg*rbv + (rg*rbv)^2 + (rg*rbv)^3 + ...
+   ! *      where rg is the background_reflectance and rbv is Isotrop_Alb_BB
+   ! *      (with Isotrop describing the Lambertian reflectance of the background).
+   ! */
+   ! this might be involved in Eq. 27, 
+   Below_reinject_rad_collim = un / (un - background_reflectance_collim*Isotrop_Alb_BB)
+   Below_reinject_rad_isotrop = un / (un - background_reflectance_isotrop*Isotrop_Alb_BB)
+
+   !/* TOTAL ALBEDO */
+   ! 	/* 1) collimated source */
+   Collim_Alb_Tot = Collim_Alb_BB + &
+        background_reflectance_collim * Collim_Tran_TotalOneWay * &
+        Isotrop_Tran_TotalOneWay * Below_reinject_rad_collim
+   !	/* 2) isotropic source */
+   Isotrop_Alb_Tot = Isotrop_Alb_BB + & 
+        background_reflectance_isotrop * Isotrop_Tran_TotalOneWay * &
+        Isotrop_Tran_TotalOneWay * Below_reinject_rad_isotrop ! this seems to be
+   ! exactly Eq. 33
+
+
+   !/* TOTAL TRANSMITION TO THE BACKGROUND LEVEL */
+   !	/* 1) collimated source */
+   Collim_Tran_Tot = Collim_Tran_TotalOneWay * Below_reinject_rad_collim ;
+
+   !	/* 2) isotropic source */
+   Isotrop_Tran_Tot = Isotrop_Tran_TotalOneWay * Below_reinject_rad_isotrop ;
+
+   !/* TOTAL ABSORPTION BY THE VEGETATION LEVEL */
+   !	/* 1) collimated source */
+   Collim_Abs_Tot = un - (Collim_Tran_Tot + Collim_Alb_Tot) + &
+        background_reflectance_collim * Collim_Tran_Tot;
+   !	/* 2) isotropic source */
+   Isotrop_Abs_Tot = un - (Isotrop_Tran_Tot + Isotrop_Alb_Tot) + &
+        background_reflectance_isotrop * Isotrop_Tran_Tot;
+
+!+++ TEMP +++ 
+! Combine the collimated & isotrop together as Collimate for energybudget 
+   Collim_Alb_Tot = Collim_Alb_Tot + Isotrop_Alb_Tot
+   Collim_Abs_Tot = Collim_Abs_Tot + Isotrop_Abs_Tot   
+!+++ TEMP +++       
+        
+
+    IF (printlev>=3) WRITE(numout,*) 'Exiting twostream_solver'
+
+ END SUBROUTINE twostream_solver
+
+
+!! ============================================================================\n
+!! FUNCTION     : dhrT1
+!!
+!>\BREF         
+!!
+!! DESCRIPTION : Taken directly from the Fortan code provided by Pinty et al for their \n
+!!               two-stream model.  The only changes are the REAL types.  This is used
+!!               to compute the black background absorption, transmission, and reflectance
+!!               in Pintys scheme and it's based on the older model of Meador and Weaver...
+!!               Pinty 2006 also includes a short discussion of it in Appendix A 
+!!
+!! RECENT CHANGE(S): None\n
+!!
+!! RETURN VALUE : dhrT1
+!!
+!! REFERENCE(S) : Meador and Weaver, 'Two-stream approximations to radiative transfer in
+!!    planetary atmosphere: a unified description of existing methods and a new improvement'
+!!    J. Atmospheric Sciences, VOL 37, p. 630--643, 1980.
+!!
+!! FLOWCHART    : None
+!_ =============================================================================
+
+FUNCTION dhrT1(rl,tl,gamma1,gamma2,gamma3,gamma4,tta,tau,AlbBS,Tdif,AbsVgt)
+
+
+  !! 0. Variables and parameter declaration
+  !! 0.1 Input variables
+  REAL(r_std), INTENT(IN) :: rl  ! the effective reflectance of a single scatterer, between 0 and 1
+                                 !! @tex $()$ @endtex      
+  REAL(r_std), INTENT(IN) :: tl  ! the effective transmittance of a single scatterer, between 0 and 1
+                                 !! @tex $()$ @endtex      
+  REAL(r_std), INTENT(IN) :: gamma1 ! the gamma coefficients from Meador and Weaver
+  REAL(r_std), INTENT(IN) :: gamma2
+  REAL(r_std), INTENT(IN) :: gamma3
+  REAL(r_std), INTENT(IN) :: gamma4
+  REAL(r_std), INTENT(IN) :: tta ! the solar zenith angle, between 0 and pi/2
+                                 !! @tex $(radians)$ @endtex      
+
+  REAL(r_std), INTENT(IN) :: tau ! Effective LAI * G(theta)
+                                 !! @tex $()$ @endtex      
+
+  !! 0.2 Output variables
+  REAL(r_std), INTENT(OUT) :: AlbBS ! the albedo of level, between 0 and 1
+                                 !! @tex $()$ @endtex      
+  REAL(r_std), INTENT(OUT) :: Tdif ! the transmitted light (all diffuse) from this light source, between 0 and 1
+                                 !! @tex $()$ @endtex      
+  REAL(r_std), INTENT(OUT) :: AbsVgt ! the light absorbed by the level, between 0 and 1
+                                 !! @tex $()$ @endtex      
+  LOGICAL :: dhrT1 ! the output flag, which always appears to be true
+
+  !! 0.3 Modified variables
+  !! 0.4 Local variables
+
+  REAL(r_std) :: alpha1,alpha2,ksquare,k
+  REAL(r_std) :: first_term,secnd_term1,secnd_term2,secnd_term3
+  REAL(r_std) :: expktau,Tdir
+  REAL(r_std) :: mu0,w0 
+
+  !_ ================================================================================================================================
+
+  mu0=cos(tta)
+  w0=rl+tl
+
+
+  Tdir = exp(-tau/mu0) ! direct transmission
+
+  ! There is a difference between conservative and non-conservative scattering 
+  ! conditions */
+  IF (w0 .ne. 1.0 .AND. w0 .ne. 0.0) THEN
+     !NON_CONSERVATIVE SCATTERING
+
+     ! some additional parameters, taken from Eq. 16--18 of Meador and Weaver, J. Atmospheric Sciences,
+     ! Vol 37, p. 630--643 (1980)
+
+     alpha1  = gamma1*gamma4 + gamma2*gamma3
+     alpha2  = gamma1*gamma3 + gamma2*gamma4
+     ksquare = gamma1*gamma1 - gamma2*gamma2
+     k       = sqrt(ksquare)
+
+     expktau = exp(k*tau)
+
+     !Black Soil Albedo...Eq. 14 in Meador and Weaver
+     first_term  = ((un-ksquare*mu0*mu0)*((k+gamma1)*expktau + (k-gamma1)/expktau))
+     IF (first_term .eq. 0.0) THEN
+        !we will be dividing by zero : cannot continue.
+        dhrT1 = .false.
+     ELSE 
+        first_term = un/first_term
+        secnd_term1 = (un - k*mu0)*(alpha2 + k*gamma3)*expktau
+        secnd_term2 = (un + k*mu0)*(alpha2 - k*gamma3)/expktau
+        secnd_term3 = 2.0_r_std * k * (gamma3 - alpha2*mu0)*Tdir
+
+        AlbBS = (w0 * first_term * (secnd_term1 - secnd_term2 - secnd_term3))
+
+        !Transmission...Eq. 15 in Meador and Weaver, for diffuse light?
+        IF (ksquare .eq. 0.0) THEN 
+           first_term = un
+        ENDIF
+        secnd_term1 = (un+k*mu0)*(alpha1+k*gamma4)*expktau
+        secnd_term2 = (un-k*mu0)*(alpha1-k*gamma4)/expktau
+        secnd_term3 = 2.0_r_std * k * (gamma4 + alpha1*mu0)
+        Tdif = - w0*first_term*(Tdir*(secnd_term1 - secnd_term2) - secnd_term3)
+
+        ! Absorption by vegetation...whatever is not transmitted or reflected 
+        ! must be absorbed
+        AbsVgt = (un- (Tdif+Tdir) - AlbBS)
+     ENDIF ! first_term .eq. 0.0
+  ELSE IF (w0 .eq. 0.) THEN
+     !BLACK CANOPY
+     AlbBS = zero
+     Tdif  = zero
+     AbsVgt = un - Tdir
+  ELSE
+     !CONSERATIVE SCATTERING...Eq. 24 in Meador and Weaver
+     AlbBS =  (un/(un + gamma1*tau))*(gamma1*tau + (gamma3-gamma1*mu0)*&
+          (un-exp(-tau/mu0)));
+     Tdif   = un - AlbBS - Tdir;
+     AbsVgt = zero;
+  ENDIF ! w0 .ne. 1.0 .AND. w0 .ne. 0.0
+
+! not sure what the purpose of this flag is, as it will always be set to true here
+  dhrT1 = .true.
+
+END FUNCTION dhrT1
+
+!! ============================================================================\n
+!! FUNCTION     : TBarreUncoll_exact
+!!
+!>\BRIEF          Computes the transmission of the diffuse black canopy light
+!!
+!! DESCRIPTION : Taken directly from the Fortan code provided by Pinty et al for their \n
+!!               two-stream model.  The only changes are the REAL types.  This appears
+!!               to be solving Eq. 16 in Pinty 2006, which is the transmission which
+!!               does not collide with the canopy
+!!
+!! RECENT CHANGE(S): None\n
+!!
+!! RETURN VALUE : TBarreUncoll_exact
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!_ =============================================================================
+
+FUNCTION TBarreUncoll_exact(tau)
+
+
+  !! 0. Variables and parameter declaration
+
+  !! 0.1 Input variables
+  REAL(r_std), INTENT(IN) :: tau ! Effective LAI * G(theta)
+  !! @tex $()$ @endtex      
+
+  !! 0.2 Output variables
+  REAL(r_std) :: TBarreUncoll_exact ! the isotropic light transmission uncollided
+                                    ! with the canopy, between 0 and 1
+  !! @tex $()$ @endtex      
+
+
+  !! 0.3 Modified variables
+
+  !! 0.4 Local variables
+!  INTEGER :: j,ind
+!  REAL(r_std) :: iGammaloc
+!  INTEGER :: order
+
+!_ ================================================================================================================================
+
+  !+++++ CHECK +++++
+
+!!$  iGammaloc = zero
+!!$  order=20
+!!$
+!!$  ! in the case where tau is equal to zero, this crashes in the first loop where
+!!$  ! iGammaloc is also zero...quick fix, and might even be accurate
+!!$
+!!$  IF(tau .GT. 1e-10_r_std)THEN
+!!$
+!!$     DO j=0,order-1
+!!$        ind = order - j
+!!$        iGammaloc = ind / (un + ind/(tau+iGammaloc))
+!!$     END DO
+!!$     iGammaloc=un/(tau + iGammaloc)
+!!$  ENDIF
+!!$
+!!$  TBarreUncoll_exact = exp(-tau)*(un - tau + tau*tau*iGammaloc)
+
+  ! this is a change suggested by Bernard to improve the matching between the one
+  ! level and multilevel case
+
+  TBarreUncoll_exact = exp(-tau*2.0_r_std*0.705_r_std)
+  !++++++++++
+
+END FUNCTION TBarreUncoll_exact
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : gammas
+!!
+!>\BRIEF         Computes a set of gamma coefficients for use in the black background equations
+!!
+!! DESCRIPTION : Taken directly from the Fortan code provided by Pinty et al for their \n
+!!               two-stream model.  The only changes are the REAL types.  This calculates
+!!               the gamma coefficients based on Appendix A in the paper.  This seems to
+!!               make the assumption of the Ross's G function and a spherical leaf
+!!               angle distribution.
+!!
+!! RECENT CHANGE(S): None\n
+!!
+!! MAIN OUTPUT VARIABLE(S): gammaCoeff
+!!
+!! REFERENCE(S) :  B. Pinty, T. Lavergne, R.E. Dickinson, J-L. Widlowski, N. Gobron and M. M. Verstraete (2006).
+!! Simplifying the Interaction of Land Surfaces with Radiation for Relating Remote Sensing Products to Climate Models.
+!! Journal of Geophysical Research. Vol 111, D02116.
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+
+SUBROUTINE gammas(rl, tl, mu0, gammaCoeff)
+
+
+  !! 0. Variables and parameter declaration
+  !! 0.1 Input variables
+  REAL(r_std), INTENT(IN) :: rl  ! the effective reflectance of a single scatterer, between 0 and 1
+  !! @tex $()$ @endtex      
+  REAL(r_std), INTENT(IN) :: tl  ! the effective transmittance of a single scatterer, between 0 and 1
+  !! @tex $()$ @endtex      
+  REAL(r_std), INTENT(IN) :: mu0 ! the cosine of the solar zenith angle, between 0 and 1
+  !! @tex $()$ @endtex      
+
+  !! 0.2 Output variables
+  REAL(r_std), DIMENSION(1:4), INTENT(OUT) :: gammaCoeff ! the set of gamma coefficients in the above reference
+  !! @tex $()$ @endtex      
+
+  !! 0.3 Modified variables
+
+  !! 0.4 Local variables
+  REAL(r_std) :: wd,w0,w0half,wdsixth
+
+!_ ================================================================================================================================
+
+
+  w0      = rl+tl
+  wd      = rl-tl
+  w0half  = w0*0.5_r_std
+  wdsixth = wd/6.0_r_std
+
+  gammaCoeff(1)=2._r_std*(un - w0half + wdsixth)
+  gammaCoeff(2)=2._r_std*(w0half + wdsixth)
+  gammaCoeff(3)=2._r_std*(w0half*0.5_r_std + mu0*wdsixth)/w0
+  gammaCoeff(4)=un-gammaCoeff(3)
+
+END SUBROUTINE gammas
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : calculate_snow_albedo
+!!
+!>\BRIEF         Computes some of the information needed to calculate the effect of the snow albedo
+!!               on the background reflectance in the two stream model.  Right now, this can be done
+!!               with the old snow albedo scheme from Krinner et al 2005 as well as the snow albedo
+!!               scheme from Community Land Model 3 (CLM3). The calculation of
+!!               snow cover fraction is taken from Yang et al. 1997
+!!
+!! DESCRIPTION : In order to compute the background albedo in Pinty's two stream model, we have to take
+!!               into account any snow that has fallen through the canopy and landed on the ground.  In particular,
+!!               we need the amount of ground covered by the snow and the albedo of this snow.  Both of these
+!!               quantities are calculated here, using a function that changes the albedo of the snow based on
+!!               its age.  This is done in two ways, but the model of CLM3 is better suited to be used with Pinty's
+!!               albedo scheme, as it divides the radiation into VIS and NIR light. The calculation of snow cover 
+!!               fraction depends on roughness lenght.
+!!
+!! RECENT CHANGE(S): None\n
+!!
+!! MAIN OUTPUT VARIABLE(S): ::snowa_veg, ::frac_snow_veg, ::albedo_snow
+!!
+!! REFERENCE(S) :  "Technical description of the community land model CLM)", K. W. Oleson, Y. Dai, G. Bonan, M. Bosilovich, et al.,
+!!                 NCAR Technical Note, May 2004.
+!!
+!!                 Yang Z, Dickinson R, Robock A, Vinnikov K (1997) Validation of the snow submodel of the 
+!!                 biosphere-atmosphere transfer scheme with Russian 
+!!                 snow cover and meteorological observational data. Journal of Climate, 10, 353â373.
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+
+SUBROUTINE calculate_snow_albedo(npts,  coszang,  snow,  snow_nobio, &
+           snow_age,  snow_nobio_age,  frac_nobio,  albedo_snow, &
+           snowa_veg,  frac_snow_veg,  snowa_nobio,  frac_snow_nobio, &
+           veget_max, z0m)
+
+  !! 0. Variables and parameter declaration
+  !! 0.1 Input variables
+   INTEGER,INTENT(IN)                              :: npts            !! Domain size - Number of land pixels  (unitless) 
+   REAL(r_std), DIMENSION(npts), INTENT(in)        :: coszang          !!  cosine of the solar zenith angle, between 0 and 1
+                                                                      !! @tex $()$ @endtex 
+   REAL(r_std),DIMENSION (npts), INTENT(in)        :: snow            !! Snow mass in vegetation (kg m^{-2})           
+   REAL(r_std),DIMENSION (npts,nnobio), INTENT(in) :: snow_nobio      !! Snow mass on continental ice, lakes, etc. (kg m^{-2})      
+   REAL(r_std),DIMENSION (npts), INTENT(in)        :: snow_age        !! Snow age (days)        
+   REAL(r_std),DIMENSION (npts,nnobio), INTENT(in) :: snow_nobio_age  !! Snow age on continental ice, lakes, etc. (days)    
+   REAL(r_std),DIMENSION (npts,nnobio), INTENT(in) :: frac_nobio      !! Fraction of non-vegetative surfaces, i.e. 
+                                                                      !!    continental ice, lakes, etc. (unitless)     
+   REAL(r_std), DIMENSION(npts,nvm), INTENT(in)    :: veget_max       !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                      !!    (m^2 m^{-2})
+   REAL(r_std), DIMENSION(npts), INTENT(in)        :: z0m             !! Roughness height for momentum of vegetated part (m)
+   REAL(r_std), DIMENSION(:),INTENT(in)            :: frac_snow_veg   !! The fraction of the surface for each PFT covered by snow
+   REAL(r_std), DIMENSION(:,:),INTENT(in)          :: frac_snow_nobio !! The fraction of nonbiological land types covered by snow
+
+  !! 0.2 Output variables
+
+   REAL(r_std), DIMENSION(npts),INTENT(OUT)        :: albedo_snow     !! the averaged snow albedo for a given grid cell
+   REAL(r_std), DIMENSION(npts,nvm,n_spectralbands),&
+                                INTENT(OUT)        :: snowa_veg       !! the albedo of snow...this is seperated into
+                                                                       !! PFT types, even though the calculation is identical
+                                                                       !! for all PFTs right now
+   REAL(r_std), DIMENSION(npts,nnobio,n_spectralbands),&
+                                INTENT(OUT)        :: snowa_nobio     !! the albedo of snow on nonbiological land types
+
+
+  !! 0.3 Modified variables
+
+  !! 0.4 Local variables
+   REAL(r_std) :: agefunc,agefunc_nobio,snow_alb_direct, snow_alb_diffuse,f_mu
+   REAL(r_std),DIMENSION(n_spectralbands)            :: c_albedo,alb_snow_0 ! parameter values, taken directly from CLM3
+
+   INTEGER :: ipts,ks,ivm,jv ! indices
+
+   LOGICAL                                           :: do_new_snow_albedo = .TRUE.
+
+  
+  !_ ================================================================================================================================
+
+  
+  ! initialize the output
+  albedo_snow=val_exp
+  snowa_veg=val_exp
+  snowa_nobio=val_exp
+
+
+  ! set some values for the new snow albedo
+  alb_snow_0(ivis)=0.95_r_std
+  alb_snow_0(inir)=0.65_r_std
+  c_albedo(ivis)=0.2_r_std
+  c_albedo(inir)=0.5_r_std
+
+
+  DO ipts = 1, npts ! loop over all the grid squares
+
+     DO ivm=1,nvm ! loop over all the PFTs
+
+        IF(veget_max(ipts,ivm) == zero)THEN
+             ! this vegetation type is not present, so no reason to do the 
+             ! calculation
+             CYCLE
+        ENDIF
+
+        DO ks=1,n_spectralbands ! loop over spectra
+
+            IF (ABS(fixed_snow_albedo - undef_sechiba) .GT. EPSILON(undef_sechiba)) THEN
+
+               snowa_veg(ipts,ivm,ks) = fixed_snow_albedo
+
+            ELSE
+
+               IF(do_new_snow_albedo)THEN
+                   ! first we calculate diffuse albedo
+                   ! NOTE: The difference between these two methods has not been 
+                   ! tested.  The only constraint is that it must be dimensionless
+                   agefunc = un - EXP(-snow_age(ipts)/tcst_snowa) ! already in ORCHIDEE
+                   !agefunc = zero
+  
+
+                   ! using the constant from CLM3 conveted into days**-1
+                   !agefunc=un-un/(un+snow_age(ipts)*0.864_r_std)
+                   !agefunc=un/(un+snow_age(ipts)*0.864_r_std)     
+                   snow_alb_diffuse=(un-c_albedo(ks)*agefunc)*alb_snow_0(ks)
+
+                   ! now the direct albedo
+                   IF(coszang(ipts) .GT. 0.5_r_std)THEN
+                       f_mu=zero
+                   ELSE
+                       ! substituting b=2.0 into the equation...recommended by CLM3
+                       f_mu=(3.0_r_std)/(un+coszang(ipts))-2.0_r_std 
+                   ENDIF
+
+                   snow_alb_direct=snow_alb_diffuse+0.4_r_std*f_mu*&
+                       (un-snow_alb_diffuse)
+
+                   ! assume that the total snow albedo is a mix of 
+                   ! 50% direct and 50% diffuse
+                   snowa_veg(ipts,ivm,ks)=(snow_alb_direct+snow_alb_diffuse)/2.0_r_std
+
+              ELSE
+                   ! calculate the age of the snow for this grid square
+                   agefunc = EXP(-snow_age(ipts)/tcst_snowa)
+   
+                   ! now the albedo...use only the bare soil snow decay parameters, 
+                   ! since the true albedo is calculated
+                   ! by the PFT-dependent two-stream solver
+                   snowa_veg(ipts,ivm,ks) = snowa_aged(1)+snowa_dec(1)*agefunc 
+     
+              ENDIF ! control%do_new_snow_albedo
+
+           ENDIF ! prescribe or calculate albedo
+
+           ! Notice that the fraction of nobio land is included in veget_max.
+           ! We have to average by the number of spectras, too, for this array, 
+           ! because it doesn't distinguish between PFTs or spectra
+           albedo_snow(ipts) = albedo_snow(ipts) + &
+                frac_snow_veg(ipts) * veget_max(ipts,ivm) * &
+                snowa_veg(ipts,ivm,ks)/REAL(n_spectralbands,r_std)
+
+        ENDDO ! ks=1,n_spectralbands 
+
+     ENDDO ! ivm=1,nvm 
+
+     ! there is no distinction between NIR and VIS for non bio surfaces
+     IF (ABS(fixed_snow_albedo - undef_sechiba) .GT. EPSILON(undef_sechiba)) THEN
+        snowa_nobio(:,:,:) = fixed_snow_albedo
+     ELSE
+
+        DO jv = 1, nnobio 
+           ! calculate the snow age
+           agefunc_nobio = EXP(-snow_nobio_age(ipts,jv)/tcst_snowa)
+
+           ! and the albedo due to snow of this age on this nonbio surface
+           snowa_nobio(ipts,jv,:) = ( snowa_aged(1) + snowa_dec(1) * agefunc_nobio ) 
+        ENDDO
+     ENDIF ! prescribe or calculate
+
+     DO jv = 1, nnobio 
+
+        ! not sensitive to the spectral band.
+        ! Don't need to average here since we are outside the loop over the
+        ! bands
+        albedo_snow(ipts) = albedo_snow(ipts) + &
+             ( frac_nobio(ipts,jv) ) * ( frac_snow_nobio(ipts,jv) ) * &
+             snowa_nobio(ipts,jv,1) 
+
+     ENDDO ! jv = 1, nnobio 
+     
+  ENDDO ! ipts = 1, npts 
+
+
+END SUBROUTINE CALCULATE_SNOW_ALBEDO
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : optimize_albedo_values
+!!
+!>\BRIEF         Follow the radiation scattered through the canopy in the 
+!!               case of multiple levels.
+!!
+!! DESCRIPTION : Right now, we know that using Pintys method in the case of a 
+!!               single canopy level will result in different top of the canopy
+!!               albedos than iwhat is found if we use multiple canopy levels.
+!!               We trust that the single level case gives the 'true' values.
+!!
+!!               This algorithm follows light as it scatters through multiple
+!!               levels in the canopy.  At each level, the scattering 
+!!               solution is found by solving Pinty's two stream model.  This
+!!               means that light which enters a level can either be transmitted
+!!               without colliding with the vegetation, transmitted after
+!!               collision with the vegetation, reflecting off the vegetation,
+!!               or being absorbed.  We follow the fluxes until they get
+!!               really small.
+!!
+!! RECENT CHANGE(S): None\n
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lconverged, ::Collim_Alb_Tot, ::Collim_Tran_Tot, 
+!!          ::Collim_Abs_Tot, ::Isotrop_Alb_Tot, ::Isotrop_Tran_Tot, ::Isotrop_Abs_Tot
+!!
+!! REFERENCE(S) :  B. Pinty, T. Lavergne, R.E. Dickinson, J-L. Widlowski, N. Gobron
+!!          and M. M. Verstraete (2006). Simplifying the Interaction of Land 
+!!          Surfaces with Radiation for Relating Remote Sensing Products to 
+!!          Climate Models. Journal of Geophysical Research. Vol 111, D02116.
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+SUBROUTINE multilevel_albedo(cosine_sun_angle, leaf_single_scattering_albedo_start,&
+     leaf_psd_start, br_base_temp_collim,  br_base_temp_isotrop, &
+     laieff_collim_pft, laieff_isotrop_pft, lconverged, &
+     Collim_Alb_Coll, Collim_Tran_Coll, Collim_Abs_Tot, Isotrop_Alb_Coll, &
+     Isotrop_Tran_Coll, Isotrop_Abs_Tot, Collim_Tran_Uncoll, Isotrop_Tran_Uncoll, lprint)
+
+  !! 0. Variables and parameter declaration
+  !! 0.1 Input variables
+  REAL(r_std), INTENT(IN)    :: cosine_sun_angle                          !! cosine of the solar zenith angle, between 0 and 1
+  !! @tex $()$ @endtex 
+  REAL(r_std), INTENT(IN)    :: leaf_single_scattering_albedo_start       !! cosine of the solar zenith angle, between 0 and 1
+  REAL(r_std), INTENT(IN)    :: leaf_psd_start                            !! cosine of the solar zenith angle, between 0 and 1
+  REAL(r_std), INTENT(IN)    :: br_base_temp_collim                       !! cosine of the solar zenith angle, between 0 and 1
+  REAL(r_std), INTENT(IN)    :: br_base_temp_isotrop                      !! cosine of the solar zenith angle, between 0 and 1
+  REAL(r_std),DIMENSION(:),INTENT(IN)        :: laieff_collim_pft         !! Effective lai for a single pixel and pft to be 
+  REAL(r_std),DIMENSION(:),INTENT(IN)        :: laieff_isotrop_pft        !! Effective lai for a single pixel and pft to be 
+  LOGICAL,INTENT(IN)        :: lprint                                     !! A flag to print some debug statements
+  !!  used in the two stream approach...every level
+
+  !! 0.2 Output variables
+  LOGICAL,INTENT(OUT) :: lconverged                                       !! did the optimization converge?
+  REAL(r_std),DIMENSION(:),INTENT(OUT)          :: Collim_Alb_Coll        !! collimated total albedo for the converged case
+  !! unitless, between 0 and 1
+  REAL(r_std),DIMENSION(:),INTENT(OUT)          :: Collim_Tran_Coll       !! collimated total transmission
+  !! unitless, between 0 and 1
+  REAL(r_std),DIMENSION(:),INTENT(OUT)          :: Collim_Abs_Tot         !! collimated total absorption
+  !! unitless, between 0 and 1
+  REAL(r_std),DIMENSION(:),INTENT(OUT)          :: Isotrop_Alb_Coll       !! isotropic total albedo
+  !! unitless, between 0 and 1
+  REAL(r_std),DIMENSION(:),INTENT(OUT)          :: Isotrop_Tran_Coll      !! isotropic total transmission
+  !! unitless, between 0 and 1
+  REAL(r_std),DIMENSION(:),INTENT(OUT)          :: Isotrop_Abs_Tot        !! isotropic total absorption
+  !! unitless, between 0 and 1
+  REAL(r_std),DIMENSION(:),INTENT(OUT)          :: Collim_Tran_Uncoll     !! collimated uncollided transmission
+  !! unitless, between 0 and 1
+  REAL(r_std),DIMENSION(:),INTENT(OUT)          :: Isotrop_Tran_Uncoll    !! isotropic uncollided transmission
+  !! unitless, between 0 and 1
+
+  !! 0.3 Modified variables
+
+  !! 0.4 Local variables
+  ! use an extra level here...this is basically to store the transmission from the sun, which is normalized to 1.0
+  REAL(r_std),DIMENSION(nlevels_tot)            :: Collim_Abs_Coll_Unscaled
+  REAL(r_std),DIMENSION(nlevels_tot)            :: Collim_Alb_Coll_Unscaled
+  REAL(r_std),DIMENSION(nlevels_tot)            :: Collim_Tran_Coll_Unscaled
+  REAL(r_std),DIMENSION(nlevels_tot)            :: Collim_Tran_UnColl_Unscaled
+  REAL(r_std),DIMENSION(nlevels_tot)            :: Isotrop_Abs_Coll_Unscaled
+  REAL(r_std),DIMENSION(nlevels_tot)            :: Isotrop_Alb_Coll_Unscaled
+  REAL(r_std),DIMENSION(nlevels_tot)            :: Isotrop_Tran_Coll_Unscaled
+  REAL(r_std),DIMENSION(nlevels_tot)            :: Isotrop_Tran_UnColl_Unscaled
+  REAL(r_std),DIMENSION(nlevels_tot)            :: Collim_Tran_Tot
+  REAL(r_std),DIMENSION(nlevels_tot)            :: Isotrop_Tran_Tot
+
+  REAL(r_std),DIMENSION(0:nlevels_tot+1)            :: &
+       collim_down_cs,isotrop_down_cs,isotrop_up_cs
+
+  INTEGER                                       :: istep,ilevel
+
+  REAL(r_std)                                   :: leaf_reflectance
+  REAL(r_std)                                   :: leaf_transmittance
+
+  LOGICAL :: lexit
+  LOGICAL :: ok
+  REAL(r_std), DIMENSION(4)                     :: gammaCoeffs
+  REAL(r_std), DIMENSION(4)                     :: gammaCoeffs_star
+  REAL(r_std)                                   :: sun_zenith_angle_radians
+  REAL(r_std), PARAMETER                        :: isotropic_cosine_constant=0.5/0.705
+
+  INTEGER,SAVE :: icalls=0
+  !_ ================================================================================================================================
+
+
+  icalls=icalls+1
+
+  ! convet the sun angle
+  sun_zenith_angle_radians = acos(cosine_sun_angle)
+
+
+
+  ! initialize some values that are used in the optimization loop
+  istep=0
+  lexit=.FALSE.
+  lconverged=.FALSE.
+
+  ! calculate the albedo at our starting point
+
+  leaf_transmittance = leaf_single_scattering_albedo_start/ & 
+       ( leaf_psd_start+un)
+  leaf_reflectance =  leaf_psd_start * &
+       leaf_transmittance
+
+  ! some debugging stuff
+  !  DO ilevel=1,nlevels_tot
+  !
+  !     CALL print_debugging_albedo_info(ilevel,cosine_sun_angle,leaf_reflectance,&
+  !          leaf_transmittance,&
+  !          laieff_collim_pft(ilevel),laieff_isotrop_pft(ilevel), &
+  !          reflectance_collim(ilevel-1),reflectance_isotrop(ilevel-1),&
+  !          Collim_Alb_Tot_temp(ilevel),Collim_Tran_Tot_temp(ilevel),&
+  !          Collim_Abs_Tot_temp(ilevel),&
+  !          Isotrop_Alb_Tot_temp(ilevel),Isotrop_Tran_Tot_temp(ilevel),&
+  !          Isotrop_Abs_Tot_temp(ilevel))
+  !  ENDDO
+
+  ! calculate the gamma coefficients used in the case of the black background 
+  call gammas(leaf_reflectance, leaf_transmittance, cosine_sun_angle, gammaCoeffs)
+  call gammas(leaf_reflectance,leaf_transmittance,isotropic_cosine_constant,&
+       gammaCoeffs_star)
+
+
+
+  !************************** step one ****** !
+  ! compute all the unscaled quantities
+  DO ilevel=nlevels_tot,1,-1
+
+     Collim_Tran_UnColl_Unscaled(ilevel)=exp( - 0.5_r_std*&
+          laieff_collim_pft(ilevel)/cosine_sun_angle)
+
+     Isotrop_Tran_UnColl_Unscaled(ilevel)= &
+          TBarreUncoll_exact(0.5_r_std*laieff_isotrop_pft(ilevel))
+
+
+     !	/* 1) collimated source */
+     ok=dhrT1(leaf_reflectance,leaf_transmittance,&
+          gammaCoeffs(1),gammaCoeffs(2),gammaCoeffs(3),gammaCoeffs(4),&
+          sun_zenith_angle_radians, 0.5_r_std*laieff_collim_pft(ilevel),&
+          Collim_Alb_Coll_Unscaled(ilevel),Collim_Tran_Coll_Unscaled(ilevel),&
+          Collim_Abs_Coll_Unscaled(ilevel))
+
+     ! 	/* 2) isotropic source */
+     ok=dhrT1(leaf_reflectance,leaf_transmittance,&
+          gammaCoeffs_star(1),gammaCoeffs_star(2),gammaCoeffs_star(3),gammaCoeffs_star(4),&
+          acos(isotropic_cosine_constant),0.5_r_std*laieff_isotrop_pft(ilevel),&
+          Isotrop_Alb_Coll_Unscaled(ilevel),Isotrop_Tran_Coll_Unscaled(ilevel),&
+          Isotrop_Abs_Coll_Unscaled(ilevel))
+  ENDDO ! ilevel=nlevels_tot,1,-1
+
+
+  ! Following the fate of the light at every step
+
+  ! The downwelling array indicates the quantity of light flowing into this level
+  ! from above therefore, to start our system for collimated light, we give a 
+  ! unit of light coming into the top level from a collimated source.
+  ! The upwelling array is light entering this level from below.
+  ! cs is the current step, while ns is the next step for the iteration.
+  ! Level 0 is the background. Light can enter this level from above but not below
+  ! Level nlevels_tot+1 is the atomosphere. Light can enter this level from below 
+  ! but not above.
+  collim_down_cs(:)=zero
+  collim_down_cs(nlevels_tot)=un
+  isotrop_down_cs(:)=zero
+  isotrop_up_cs(:)=zero
+
+  CALL propagate_fluxes(collim_down_cs, isotrop_down_cs, isotrop_up_cs, &
+       Collim_Tran_UnColl_Unscaled, Collim_Tran_Coll_Unscaled, &
+       Collim_Alb_Coll_Unscaled, Isotrop_Tran_UnColl_Unscaled, &
+       Isotrop_Tran_Coll_Unscaled, Isotrop_Alb_Coll_Unscaled, &
+       br_base_temp_collim, br_base_temp_isotrop, .FALSE., &
+       Collim_Tran_Uncoll, Collim_Tran_Coll, Collim_Alb_Coll, lconverged, lprint)
+
+  ! Now for the isotropic light
+  collim_down_cs(:)=zero
+  isotrop_down_cs(:)=zero
+  isotrop_down_cs(nlevels_tot)=un
+  isotrop_up_cs(:)=zero
+
+  ! The colliminated light is never used here, but it's passed to keep things 
+  ! clean between the two cases. Might have to redo this if we are having 
+  ! peformance issues.
+  CALL propagate_fluxes(collim_down_cs, isotrop_down_cs, isotrop_up_cs, &
+       Collim_Tran_UnColl_Unscaled, Collim_Tran_Coll_Unscaled, &
+       Collim_Alb_Coll_Unscaled, Isotrop_Tran_UnColl_Unscaled, &
+       Isotrop_Tran_Coll_Unscaled, Isotrop_Alb_Coll_Unscaled, &
+       br_base_temp_collim, br_base_temp_isotrop, .TRUE., &
+       Isotrop_Tran_Uncoll, Isotrop_Tran_Coll, Isotrop_Alb_Coll, lconverged, lprint)
+
+  ! Calculate the absorption profile
+  Collim_Tran_Tot(:)=Collim_Tran_Coll(:)+Collim_Tran_Uncoll(:)
+  Isotrop_Tran_Tot(:)=Isotrop_Tran_Coll(:)+Isotrop_Tran_Uncoll(:)
+
+  ! bottom level
+  Collim_Abs_Tot(1)=Collim_Tran_Tot(1+1)+Collim_Tran_Tot(1)*br_base_temp_collim&
+       -Collim_Tran_Tot(1)-Collim_Alb_Coll(1)
+  Isotrop_Abs_Tot(1)=Isotrop_Tran_Tot(1+1)+Isotrop_Tran_Tot(1)*br_base_temp_isotrop&
+       -Isotrop_Tran_Tot(1)-Isotrop_Alb_Coll(1)
+
+  ! all middle levels
+  DO ilevel=2,nlevels_tot-1
+     Collim_Abs_Tot(ilevel)=Collim_Tran_Tot(ilevel+1)+Collim_Alb_Coll(ilevel-1)&
+          -Collim_Tran_Tot(ilevel)-Collim_Alb_Coll(ilevel)
+     Isotrop_Abs_Tot(ilevel)=Isotrop_Tran_Tot(ilevel+1)+Isotrop_Alb_Coll(ilevel-1)&
+          -Isotrop_Tran_Tot(ilevel)-Isotrop_Alb_Coll(ilevel)
+  ENDDO
+
+  ! top level
+  Collim_Abs_Tot(nlevels_tot)=un+Collim_Alb_Coll(nlevels_tot-1)&
+       -Collim_Tran_Tot(nlevels_tot)-Collim_Alb_Coll(nlevels_tot)
+  Isotrop_Abs_Tot(nlevels_tot)=un+Isotrop_Alb_Coll(nlevels_tot-1)&
+       -Isotrop_Tran_Tot(nlevels_tot)-Isotrop_Alb_Coll(nlevels_tot)
+
+END SUBROUTINE multilevel_albedo
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : print_debugging_albedo_info
+!!
+!>\BRIEF         Prints out some albedo information in a nice format.  
+!!               Should only be used for debugging, never for production runs.
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None\n
+!!
+!! MAIN OUTPUT VARIABLE(S): None.
+!!
+!! REFERENCE(S) :  
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+SUBROUTINE print_debugging_albedo_info(ilevel, cosine_sun_angle, &
+     leaf_reflectance, leaf_transmittance, laieff_collim_temp, laieff_isotrop_temp, &
+     br_base_temp_collim, br_base_temp_isotrop, Collim_Alb_Tot, &
+     Collim_Tran_Tot, Collim_Abs_Tot, Isotrop_Alb_Tot, Isotrop_Tran_Tot, Isotrop_Abs_Tot)
+
+  !! 0. Variables and parameter declaration
+  !! 0.1 Input variables
+  INTEGER,INTENT(IN)          :: ilevel
+  REAL(r_std), INTENT(IN)     :: cosine_sun_angle            !! cosine of the solar zenith angle, between 0 and 1
+                                                             !! @tex $()$ @endtex 
+   REAL(r_std), INTENT(IN)    :: laieff_collim_temp           !! cosine of the solar zenith angle, between 0 and 1
+   REAL(r_std), INTENT(IN)    :: laieff_isotrop_temp           !! cosine of the solar zenith angle, between 0 and 1
+   REAL(r_std), INTENT(IN)    :: leaf_reflectance           !! cosine of the solar zenith angle, between 0 and 1
+   REAL(r_std), INTENT(IN)    :: leaf_transmittance            !! cosine of the solar zenith angle, between 0 and 1
+   REAL(r_std), INTENT(IN)    :: br_base_temp_collim           !! cosine of the solar zenith angle, between 0 and 1
+   REAL(r_std), INTENT(IN)    :: br_base_temp_isotrop            !! cosine of the solar zenith angle, between 0 and 1
+   REAL(r_std),INTENT(IN)     :: Collim_Alb_Tot
+   REAL(r_std),INTENT(IN)     :: Collim_Tran_Tot
+   REAL(r_std),INTENT(IN)     :: Collim_Abs_Tot
+   REAL(r_std),INTENT(IN)     :: Isotrop_Alb_Tot
+   REAL(r_std),INTENT(IN)     :: Isotrop_Tran_Tot
+   REAL(r_std),INTENT(IN)     :: Isotrop_Abs_Tot
+
+  !! 0.2 Output variables
+
+  !! 0.3 Modified variables
+
+  !! 0.4 Local variables
+
+  !_ ================================================================================================================================
+   
+1223 FORMAT(I5,I3,7(F14.7))
+
+     WRITE (numout,'(8(11A))') '   Level   ','   Angle   ','  laieff_c  ','  laieff_i  ',&
+          '   rleaf   ','   tleaf   ','   rbgd_c   ','   rbgd_i   '
+
+     WRITE(numout,FMT='(I6,5X,7(F11.6))') &
+          ilevel,180/pi*ACOS(cosine_sun_angle),&
+          laieff_collim_temp,laieff_isotrop_temp,&
+          leaf_reflectance,leaf_transmittance,br_base_temp_collim,&
+          br_base_temp_isotrop
+
+
+     WRITE (numout,'(10X,6(11A))') ' Rtot(sun) ',' Ttot(sun) ',&
+          ' Atot(sun) ',' Rtot(iso) ',' Ttot(iso) ',' Atot(iso) '
+     WRITE(numout,FMT='(10X,6(F11.6))') &
+          Collim_Alb_Tot,Collim_Tran_Tot,Collim_Abs_Tot,&
+          Isotrop_Alb_Tot,Isotrop_Tran_Tot,Isotrop_Abs_Tot
+
+
+END SUBROUTINE print_debugging_albedo_info
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : propagate_fluxes
+!!
+!>\BRIEF         Propogates the radiation fluxes through each level of the
+!!               canopy.
+!!
+!! DESCRIPTION : This is an algorithm to follow radition fluxes through the
+!!     canopy.  At each level, the path probabilities are determined by the
+!!     raditional transfer scheme of Pinty et al (2006).  Notice that
+!!     the fluxes given by this routine are all cumulative fluxes, not per
+!!     level.
+!!
+!! RECENT CHANGE(S): None\n
+!!
+!! MAIN OUTPUT VARIABLE(S): ::Tran_Uncoll_Tot, ::Tran_Coll_Tot, ::Alb_Coll_Tot
+!!
+!! REFERENCE(S) :  
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+SUBROUTINE propagate_fluxes(collim_down_cs, isotrop_down_cs, isotrop_up_cs, &
+     Collim_Tran_UnColl_Unscaled, Collim_Tran_Coll_Unscaled, &
+     Collim_Alb_Coll_Unscaled, Isotrop_Tran_UnColl_Unscaled, &
+     Isotrop_Tran_Coll_Unscaled, Isotrop_Alb_Coll_Unscaled, br_base_temp_collim, &
+     br_base_temp_isotrop, lisotrop, Tran_Uncoll_Tot, Tran_Coll_Tot, &
+     Alb_Coll_Tot, lconverged, lprint)
+
+  !! 0. Variables and parameter declaration
+  !! 0.1 Input variables
+  REAL(r_std), DIMENSION(nlevels_tot),INTENT(IN)           :: Collim_Tran_UnColl_Unscaled
+  REAL(r_std), DIMENSION(nlevels_tot),INTENT(IN)           :: Collim_Tran_Coll_Unscaled
+  REAL(r_std), DIMENSION(nlevels_tot),INTENT(IN)           :: Collim_Alb_Coll_Unscaled
+  REAL(r_std), DIMENSION(nlevels_tot),INTENT(IN)           :: Isotrop_Tran_UnColl_Unscaled
+  REAL(r_std), DIMENSION(nlevels_tot),INTENT(IN)           :: Isotrop_Tran_Coll_Unscaled
+  REAL(r_std), DIMENSION(nlevels_tot),INTENT(IN)           :: Isotrop_Alb_Coll_Unscaled
+  REAL(r_std), INTENT(IN)                                  :: br_base_temp_collim             !! cosine of the solar zenith angle, between 0 and 1
+  REAL(r_std), INTENT(IN)                                  :: br_base_temp_isotrop            !! cosine of the solar zenith angle, between 0 and 1
+  LOGICAL, INTENT(IN)                                      :: lisotrop                        !! are we dealing with an isotropic source?  only needed for correct partitioning
+                                                                                              !! of the collided and uncollided transmitted light...the total is not affected
+  LOGICAL, INTENT(IN)                                      :: lprint                          !! a flag to print
+
+  !! 0.2 Output variables
+  REAL(r_std), DIMENSION(nlevels_tot),INTENT(OUT)          :: Tran_Uncoll_Tot
+  REAL(r_std), DIMENSION(nlevels_tot),INTENT(OUT)          :: Tran_Coll_Tot
+  REAL(r_std), DIMENSION(nlevels_tot),INTENT(OUT)          :: Alb_Coll_Tot
+  LOGICAL,INTENT(OUT)                                      :: lconverged
+
+  !! 0.3 Modified variables
+  REAL(r_std), DIMENSION(0:nlevels_tot+1),INTENT(INOUT)    :: collim_down_cs
+  REAL(r_std), DIMENSION(0:nlevels_tot+1),INTENT(INOUT)    :: isotrop_down_cs
+  REAL(r_std), DIMENSION(0:nlevels_tot+1),INTENT(INOUT)    :: isotrop_up_cs
+
+  !! 0.4 Local variables
+  INTEGER :: istep,ilevel
+  REAL(r_std),DIMENSION(0:nlevels_tot+1)            :: collim_down_ns,isotrop_down_ns,&
+       isotrop_up_ns,Tran_Uncoll_Tot_temp
+  
+  !_ ================================================================================================================================
+
+  Tran_Uncoll_Tot(:)=zero
+  Tran_Coll_Tot(:)=zero
+  Alb_Coll_Tot(:)=zero
+
+  Tran_Uncoll_Tot_temp(:)=un
+
+  istep=0
+
+  DO
+
+     istep=istep+1
+
+     lconverged=.TRUE.
+
+     ! Zero out the counters for the next step
+     collim_down_ns(:)=zero
+     isotrop_down_ns(:)=zero
+     isotrop_up_ns(:)=zero
+
+
+     ! Now we need to loop over all levels and see what light is entering the 
+     ! level, and how it will propagate in the next step
+     DO ilevel=1,nlevels_tot
+
+        ! For collimated downwelling light into the level, it can be scattered 
+        ! up, down, or pass through uncollided
+        IF(collim_down_cs(ilevel) .GT. zero)THEN
+           collim_down_ns(ilevel-1)=collim_down_ns(ilevel-1)+&
+                collim_down_cs(ilevel)*Collim_Tran_UnColl_Unscaled(ilevel)
+
+
+           ! This statement checks to see if this light has been previously
+           ! scattered or not.  This term is only present in level nlevels_tot
+           ! for the first step, level nlevels_tot-1 for the second step, 
+           ! level nlevels_tot-2 for the third step, etc., and it only happens
+           ! in the case of a collimated light source.
+           IF(ilevel == nlevels_tot-istep+1 .AND. .NOT. lisotrop) THEN
+              Tran_Uncoll_Tot_temp(ilevel)=Tran_Uncoll_Tot_temp(ilevel+1)*&
+                   Collim_Tran_UnColl_Unscaled(ilevel)
+           ENDIF
+
+           isotrop_down_ns(ilevel-1)=isotrop_down_ns(ilevel-1)+&
+                collim_down_cs(ilevel)*Collim_Tran_Coll_Unscaled(ilevel)
+           isotrop_up_ns(ilevel+1)=isotrop_up_ns(ilevel+1)+&
+                collim_down_cs(ilevel)*Collim_Alb_Coll_Unscaled(ilevel)
+
+        ENDIF ! collim_down_cs(ilevel) .GT. zero
+
+        ! For isotropic downwelling light, it can also be scattered up, down,
+        ! or pass through uncollided
+        IF(isotrop_down_cs(ilevel) .GT. zero)THEN
+           isotrop_down_ns(ilevel-1)=isotrop_down_ns(ilevel-1)+&
+                isotrop_down_cs(ilevel)*Isotrop_Tran_UnColl_Unscaled(ilevel)
+
+           ! This is the same check as above, but this time the light has
+           ! an isotropic source and not a collimated source
+           IF(ilevel == nlevels_tot-istep+1 .AND. lisotrop) THEN
+              Tran_Uncoll_Tot_temp(ilevel)=Tran_Uncoll_Tot_temp(ilevel+1)&
+                   *Isotrop_Tran_UnColl_Unscaled(ilevel)
+           ENDIF
+
+           isotrop_down_ns(ilevel-1)=isotrop_down_ns(ilevel-1)+&
+                isotrop_down_cs(ilevel)*Isotrop_Tran_Coll_Unscaled(ilevel)
+           isotrop_up_ns(ilevel+1)=isotrop_up_ns(ilevel+1)+&
+                isotrop_down_cs(ilevel)*Isotrop_Alb_Coll_Unscaled(ilevel)
+        ENDIF ! isotrop_down_cs(ilevel) .GT. zero
+
+        ! Isotropic upwelling light can pass through upwards collided or 
+        ! uncollided with vegetation in this level, or it can be reflected downwards
+        IF(isotrop_up_cs(ilevel) .GT. zero)THEN
+
+           isotrop_up_ns(ilevel+1)=isotrop_up_ns(ilevel+1)+isotrop_up_cs(ilevel)&
+                *Isotrop_Tran_UnColl_Unscaled(ilevel)
+           isotrop_up_ns(ilevel+1)=isotrop_up_ns(ilevel+1)+isotrop_up_cs(ilevel)&
+                *Isotrop_Tran_Coll_Unscaled(ilevel)
+           isotrop_down_ns(ilevel-1)=isotrop_down_ns(ilevel-1)+&
+                isotrop_up_cs(ilevel)*Isotrop_Alb_Coll_Unscaled(ilevel)
+        ENDIF
+
+        ! there can be no collimated upwards light, since upwards light must 
+        ! always have reflected off something
+
+
+     ENDDO ! ilevel=1,nlevels_tot
+
+     ! The background is a bit special. there is no transmission, but there is 
+     ! reflection, which leads to a source term to the bottom level from below.
+     isotrop_up_ns(1)=isotrop_up_ns(1)+collim_down_cs(0)*br_base_temp_collim
+     isotrop_up_ns(1)=isotrop_up_ns(1)+isotrop_down_cs(0)*br_base_temp_isotrop
+
+
+     ! Now we add the light generated here to our cumulative counters to track
+     ! the total amount that leaves the canopy, either through being absorbed
+     ! by the background or being reflected back into the atmosphere.
+     ! We keep track of the uncoll above, so here we track the total light that
+     ! is transmitted to the soil, and then at the end we taken the difference 
+     ! to get the collided radation.
+     Tran_Coll_Tot(1:nlevels_tot)=Tran_Coll_Tot(1:nlevels_tot)+&
+          isotrop_down_ns(0:nlevels_tot-1)+collim_down_ns(0:nlevels_tot-1)
+     Alb_Coll_Tot(1:nlevels_tot)=Alb_Coll_Tot(1:nlevels_tot)+isotrop_up_ns(2:nlevels_tot+1)
+
+     ! now we update the light we are currently tracking
+     collim_down_cs(:)=collim_down_ns(:)
+     isotrop_down_cs(:)=isotrop_down_ns(:)
+     isotrop_up_cs(:)=isotrop_up_ns(:)
+
+
+     ! check for convegence...if all the values of light are currently below a 
+     ! threshold, we're probably good assuming the threshold is low enough.
+     IF(MAXVAL(collim_down_cs,1) .GT. alb_threshold) lconverged=.FALSE.
+     IF(MAXVAL(isotrop_down_cs,1) .GT. alb_threshold) lconverged=.FALSE.
+     IF(MAXVAL(isotrop_up_cs,1) .GT. alb_threshold) lconverged=.FALSE.
+
+     IF(lconverged)THEN
+        IF(lprint) WRITE(numout,*) 'Converged after this many steps: ',istep
+        EXIT
+     ENDIF
+
+     ! This number here could also be externalized.
+     IF(istep .GE. 1000)THEN
+        WRITE(numout,*) '*********************************************************'
+        WRITE(numout,'(A,I6,F14.10)') 'Albedo not converging!',istep,alb_threshold
+        WRITE(numout,'(A)') '                  collim_down_cs ' // &
+             'isotrop_down_cs  isotrop_up_cs'
+        DO ilevel=0,nlevels_tot+1
+           WRITE(numout,'(I4,3F14.10)') ilevel, &
+                collim_down_cs(ilevel),isotrop_down_cs(ilevel),isotrop_up_cs(ilevel)
+
+        ENDDO
+        WRITE(numout,*) 'You should increase either the number' // &
+             'of steps or the alb_threshold.'
+        WRITE(numout,*) '*********************************************************'
+        EXIT
+     ENDIF ! istep .GE. 1000
+  ENDDO ! convergence loop
+
+
+  ! now separate the collided from the uncollided light.  Notice that
+  ! this is not really needed for any purposes other than debugging, as the
+  ! important quantity is the total amount of light striking the ground.
+  Tran_UnColl_Tot(1:nlevels_tot)=Tran_UnColl_Tot_temp(1:nlevels_tot)
+  Tran_Coll_Tot(1:nlevels_tot)=Tran_Coll_Tot(1:nlevels_tot)-Tran_UnColl_Tot(1:nlevels_tot)
+
+  ! Some debugging information
+  IF(lprint)THEN
+     WRITE(numout,'(A)') '      Tran_Uncoll_Tot   Tran_Coll_Tot  Alb_Coll_Tot'
+     DO ilevel=nlevels_tot,1,-1
+        WRITE(numout,'(I4,3F10.6)') ilevel, &
+             Tran_Uncoll_Tot(ilevel),Tran_Coll_Tot(ilevel),Alb_Coll_Tot(ilevel)
+     ENDDO
+  ENDIF
+
+END SUBROUTINE propagate_fluxes
+
+
+! ----------------------------------------------------------------------------------------
+
+
+END MODULE albedo
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/chemistry.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/chemistry.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/chemistry.f90	(revision 6412)
@@ -0,0 +1,1837 @@
+! ================================================================================================================================
+!  MODULE       : chemistry
+!
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF   
+!!
+!!\n DESCRIPTION: 
+!!
+!! RECENT CHANGE(S): The content of this module were previously part of the diffuco module.
+!!                   ok_inca changed name into ok_bvoc and DIFFUCO_OK_INCA changed into CHEMISTRY_BVOC
+!!                   LEAFAGE_OK_INCA changed name into CHEMISTRY_LEAFAGE
+!!
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-CN/src_sechiba/chemistry.f90 $
+!! $Date: 2016-08-24 12:24:51 +0200 (Wed, 24 Aug 2016) $
+!! $Revision: 3714 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE chemistry
+
+  USE ioipsl
+  USE xios_orchidee
+  USE constantes
+  USE qsat_moisture
+  USE sechiba_io_p
+  USE ioipsl
+  USE pft_parameters
+  USE grid
+  USE ioipsl_para 
+  USE xios_orchidee
+  USE function_library, ONLY: cc_to_lai
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: chemistry_initialize, chemistry_bvoc, chemistry_flux_interface, chemistry_clear
+
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_iso            !! Isoprene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_iso)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_mono           !! Monoterpene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_mono)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_ORVOC          !! Other Volatile Organic Compound emissions from vegetation (kgC.m^{-2}.s^{-1}) 
+!$OMP THREADPRIVATE(flx_ORVOC)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_MBO            !! 2-methyl-3-buten-2-ol emissions from vegetation (mainly pines in America) (kgC.m^{-2}.s^{-1}) 
+!$OMP THREADPRIVATE(flx_MBO)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_methanol       !! Methanol emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_methanol)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_acetone        !! Acetone emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_acetone)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_acetal         !! Acetaldehyde emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_acetal)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_formal         !! Formaldehyde emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_formal)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_acetic         !! Acetic acid emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_acetic)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_formic         !! Formic acid emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_formic)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_apinen         !! Alpha pinene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_apinen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_bpinen         !! Beta pinene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_bpinen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_limonen        !! Limonene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_limonen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_myrcen         !! Myrcene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_myrcen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_sabinen        !! Sabinene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_sabinen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_camphen        !! Camphene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_camphen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_3caren         !! 3-Carene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_3caren)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_tbocimen       !! T-beta Ocimene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_tbocimen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_othermono      !! Emissions of other monoterpenes from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_othermono)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_sesquiter      !! Sesquiterpene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_sesquiter)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_fertil_no      !! Biogenic nitrogen oxide soil emission due to N-fertilisation (ngN.m^{-2}.s^{-1}) 
+!$OMP THREADPRIVATE(flx_fertil_no)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_no_soil        !! Nitrogen Oxide emissions from soil, before deposition on canopy 
+                                                                       !! (ngN.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_no_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_no             !! Net nitrogen Oxide emissions from soil, after deposition on canopy
+!$OMP THREADPRIVATE(flx_no)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: CRF                !! Canopy reduction factor for net NO flux calculation (kjpindex,nvm)    
+!$OMP THREADPRIVATE(CRF)
+
+  ! variables used inside diffuco_inca module 
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)     :: ok_siesta        !! Flag for controlling post-pulse period (true/false)
+!$OMP THREADPRIVATE(ok_siesta)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)     :: allow_pulse      !! Flag for controlling pulse period (true/false)
+!$OMP THREADPRIVATE(allow_pulse)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pulse            !! Pulse fonction 
+!$OMP THREADPRIVATE(pulse)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pulseday         !! Counter for pulse period
+!$OMP THREADPRIVATE(pulseday)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: siestaday        !! Counter for post-pulse period
+!$OMP THREADPRIVATE(siestaday)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pulselim         !! Pulse period length
+!$OMP THREADPRIVATE(pulselim)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: siestalim        !! Post-pulse period length
+!$OMP THREADPRIVATE(siestalim)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: area2            !! Grid cell area (m^2)
+!$OMP THREADPRIVATE(area2)
+  REAL(r_std), SAVE                            :: nbre_precip 
+!$OMP THREADPRIVATE(nbre_precip)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: flx_co2_bbg_year !! CO2 emissions from biomass burning 
+                                                                   !! Read in an input file (kgC.m^{-2}.year^{-1})
+!$OMP THREADPRIVATE(flx_co2_bbg_year)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: N_qt_WRICE_year  !! N fertilizers applied on wetland rice
+                                                                   !! Read in an input file (kgN.yr^{-1})
+!$OMP THREADPRIVATE(N_qt_WRICE_year)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: N_qt_OTHER_year  !! N fertilizers applied on other crops and grasses
+                                                                   !! Read in an input file (kgN.yr^{-1}) 
+!$OMP THREADPRIVATE(N_qt_OTHER_year)
+  LOGICAL, SAVE   :: l_first_chemistry_inca=.TRUE.                 !! Initialisation for chemistry_flux_interface
+!$OMP THREADPRIVATE(l_first_chemistry_inca)
+     
+
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE      : chemistry_initialize
+!!
+!>\BRIEF             This subroutine initializes the chemistry module
+!!
+!! DESCRIPTION     : Some of the variables and flags used chemistry_bvoc are allocated and initialised here.
+!!
+!! RECENT CHANGE(S): Changed name from diffuco_inca_init to chemistry_initialize
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S)    : None
+!!
+!! FLOWCHART       : None
+!_ ================================================================================================================================
+
+  SUBROUTINE chemistry_initialize(kjpindex, lalo, neighbours, resolution)
+
+    USE interpweight
+
+    IMPLICIT NONE
+    
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (unitless) 
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT (in)    :: lalo             !! Geographical coordinates
+    INTEGER(i_std), DIMENSION(kjpindex,8), INTENT (in) :: neighbours       !! Vector of neighbours for each 
+                                                                           !! grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)     :: resolution       !! The size in km of each grid-box in X and Y
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(kjpindex)                   :: achem_wrice      !! Availability of data for the interpolation
+    REAL(r_std), DIMENSION(kjpindex)                   :: achem_other      !! Availability of data for the interpolation
+    REAL(r_std), DIMENSION(kjpindex)                   :: achem_co2        !! Availability of data for the interpolation
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    LOGICAL                                            :: allow_weathergen
+    CHARACTER(LEN=80)                                  :: filename, fieldname
+    INTEGER(i_std)                                     :: iml, jml, lml, tml, force_id
+    INTEGER(i_std)                                     :: ier
+    REAL(r_std)                                        :: vmin, vmax       !! min/max values to use for the
+                                                                           !!   renormalization
+    CHARACTER(LEN=250)                                 :: maskvname        !! Variable to read the mask from
+                                                                           !! the file
+    CHARACTER(LEN=80)                                  :: lonname, latname !! lon, lat names in input file
+    REAL(r_std), DIMENSION(:), ALLOCATABLE             :: variabletypevals !! Values for all the types of the variable
+                                                                           !!   (variabletypevals(1) = -un, not used)
+    CHARACTER(LEN=50)                                  :: fractype         !! method of calculation of fraction
+                                                                           !!   'XYKindTime': Input values are kinds 
+                                                                           !!     of something with a temporal 
+                                                                           !!     evolution on the dx*dy matrix'
+    LOGICAL                                            :: nonegative       !! whether negative values should be removed
+    CHARACTER(LEN=50)                                  :: maskingtype      !! Type of masking
+                                                                           !!   'nomask': no-mask is applied
+                                                                           !!   'mbelow': take values below maskvals(1)
+                                                                           !!   'mabove': take values above maskvals(1)
+                                                                           !!   'msumrange': take values within 2 ranges;
+                                                                           !!      maskvals(2) <= SUM(vals(k)) <= maskvals(1)
+                                                                           !!      maskvals(1) < SUM(vals(k)) <= maskvals(3)
+                                                                           !!        (normalized by maskvals(3))
+                                                                           !!   'var': mask values are taken from a 
+                                                                           !!     variable inside the file (>0)
+    REAL(r_std), DIMENSION(3)                          :: maskvals         !! values to use to mask (according to 
+                                                                           !!   `maskingtype') 
+    CHARACTER(LEN=250)                                 :: namemaskvar      !! name of the variable to use to mask 
+    REAL(r_std)                                        :: chem_norefinf    !! No value
+    REAL(r_std)                                        :: chem_default     !! Default value
+
+!_ ================================================================================================================================
+
+    ALLOCATE (pulse(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable pulse','','')
+    pulse(:) = un
+
+    ! If we acount for NOx pulse emissions
+    IF (ok_pulse_NOx) THEN
+
+       ALLOCATE (ok_siesta(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable ok_siesta','','')
+       ok_siesta(:) = .FALSE.
+
+       ALLOCATE (allow_pulse(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable allow_pulse','','')
+       allow_pulse(:) = .FALSE.
+
+       ALLOCATE (pulseday(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable pulseday','','')
+       pulseday(:) = zero
+
+       ALLOCATE (siestaday(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable siestaday','','')
+       siestaday(:) = zero
+
+       ALLOCATE (pulselim(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable pulselim','','')
+       pulselim(:) = zero
+
+       ALLOCATE (siestalim(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable siestalim','','')
+       siestalim(:) = zero
+
+    END IF ! (ok_pulse_NOx) 
+
+    ! If we acount for NOx emissions by N-fertilizers
+    IF (ok_cropsfertil_NOx) THEN
+
+       ALLOCATE (area2(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable area2','','')
+       area2(:) = resolution(:,1)*resolution(:,2) 
+
+       ALLOCATE (N_qt_WRICE_year(kjpindex),stat=ier)  !! N fertilizers on wetland rice, read in file 
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable N_qt_WRICE_year','','')
+       N_qt_WRICE_year(:) = zero
+    
+       ALLOCATE (N_qt_OTHER_year(kjpindex),stat=ier)  !! N fertilizers on other crops and grasses, read in file 
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable N_qt_OTHER_year','','')
+       N_qt_OTHER_year(:) = zero
+
+       WRITE (numout,*) ' *********************** Interpolating N fertilizers files for NOx emissions... '
+
+       !Config Key   = N_FERTIL_FILE
+       !Config Desc  = File name
+       !Config If    = CHEMISTRY_BVOC and NOx_FERTILIZERS_USE
+       !Config Def   = orchidee_fertilizer_1995.nc
+       !Config Help  = 
+       !Config Units = - 
+       filename = 'orchidee_fertilizer_1995.nc'
+       CALL getin_p('N_FERTIL_FILE',filename) 
+       
+       !! Variables for interpweight
+       vmin = 0.
+       vmax = 0.
+       ! Type of calculation of cell fractions
+       fractype = 'default'
+       ! Name of the longitude and latitude in the input file
+       lonname = 'lon'
+       latname = 'lat'
+       ! Default value when no value is get from input file
+       chem_default = 0.
+       ! Reference value when no value is get from input file
+       chem_norefinf = 0.
+       ! Should negative values be set to zero from input file?
+       nonegative = .TRUE.
+       ! Type of mask to apply to the input data (see header for more details)
+       maskingtype = 'nomask'
+       ! Values to use for the masking
+       maskvals = (/ min_sechiba, undef_sechiba, undef_sechiba /)
+       ! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
+       namemaskvar = ''
+
+       fieldname= 'N_qt_WRICE_year'
+       CALL interpweight_2Dcont(kjpindex, 0, 0, lalo, resolution, neighbours,                        &
+            contfrac, filename, fieldname, lonname, latname, vmin, vmax, nonegative, maskingtype,       &
+            maskvals, namemaskvar, -1, fractype, chem_default, chem_norefinf,                           &
+            N_qt_WRICE_year, achem_wrice)
+       
+       fieldname= 'N_qt_OTHER_year'
+       CALL interpweight_2Dcont(kjpindex, 0, 0, lalo, resolution, neighbours,                        &
+            contfrac, filename, fieldname, lonname, latname, vmin, vmax, nonegative, maskingtype,       &
+            maskvals, namemaskvar, -1, fractype, chem_default, chem_norefinf,                           &
+            N_qt_OTHER_year, achem_other)
+       
+    END IF
+
+    ALLOCATE (flx_iso(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_iso','','')
+    flx_iso(:,:) = 0. 
+
+    ALLOCATE (flx_mono(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_mono','','')
+    flx_mono(:,:) = 0. 
+
+    ALLOCATE (flx_ORVOC(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_ORVOC ','','')
+    flx_ORVOC(:,:) = 0. 
+
+    ALLOCATE (flx_MBO(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_MBO','','')
+    flx_MBO(:,:) = 0. 
+
+    ALLOCATE (flx_methanol(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_methanol','','')
+    flx_methanol(:,:) = 0. 
+
+    ALLOCATE (flx_acetone(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_acetone','','')
+    flx_acetone(:,:) = 0. 
+
+    ALLOCATE (flx_acetal(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_acetal','','')
+    flx_acetal(:,:) = 0. 
+
+    ALLOCATE (flx_formal(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_formal','','')
+    flx_formal(:,:) = 0. 
+
+    ALLOCATE (flx_acetic(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_acetic','','')
+    flx_acetic(:,:) = 0. 
+
+    ALLOCATE (flx_formic(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_formic','','')
+    flx_formic(:,:) = 0. 
+
+    ALLOCATE (flx_no_soil(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_no_soil','','')
+    flx_no_soil(:,:) = 0. 
+
+    ALLOCATE (flx_no(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_no','','')
+    flx_no(:,:) = 0. 
+       
+    ALLOCATE (flx_fertil_no(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_fertil_no','','')
+    flx_fertil_no(:,:) = 0. 
+
+    ALLOCATE (flx_apinen(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_apinen','','')
+    flx_apinen(:,:) = 0.       
+
+    ALLOCATE (flx_bpinen (kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_bpinen','','')
+    flx_bpinen(:,:) = 0.      
+
+    ALLOCATE (flx_limonen  (kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_limonen','','')
+    flx_limonen(:,:) = 0.    
+
+    ALLOCATE (flx_myrcen(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_myrcen','','')
+    flx_myrcen(:,:) = 0.       
+
+    ALLOCATE (flx_sabinen(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_sabinen','','')
+    flx_sabinen(:,:) = 0.      
+
+    ALLOCATE (flx_camphen(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_camphen','','')
+    flx_camphen(:,:) = 0.      
+
+    ALLOCATE (flx_3caren(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_3caren','','')
+    flx_3caren(:,:) = 0.       
+
+    ALLOCATE (flx_tbocimen(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_tbocimen','','')
+    flx_tbocimen(:,:) = 0.     
+
+    ALLOCATE (flx_othermono(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_othermono','','')
+    flx_othermono(:,:) = 0.    
+
+    ALLOCATE (flx_sesquiter(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_sesquiter','','')
+    flx_sesquiter(:,:) = 0.    
+
+    ALLOCATE(CRF(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable CRF ','','')
+    CRF(:,:) = 0. 
+
+
+    ! If we acount for NOx emissions due to Biomass Burning
+    IF (ok_bbgfertil_NOx) THEN
+
+       ALLOCATE (flx_co2_bbg_year(kjpindex),stat=ier) !! CO2 emissions from bbg, read in file 
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable flx_co2_bbg_year','','')
+       flx_co2_bbg_year(:) = zero    
+
+       WRITE (numout,*) ' *********************** Interpolating CO2 bbg files for NOx emissions... '
+       !Config Key   = N_FERTIL_FILE
+       !Config Desc  = File name
+       !Config If    = CHEMISTRY_BVOC and NOx_FERTILIZERS_USE
+       !Config Def   = orchidee_fertilizer_1995.nc
+       !Config Help  = ...
+       !Config Units = -
+       filename = 'orchidee_bbg_clim.nc'
+       CALL getin_p('CO2_BBG_FILE',filename)
+
+       !! Variables for interpweight
+       vmin = 0.
+       vmax = 0.
+       ! Type of calculation of cell fractions
+       fractype = 'default'
+       ! Name of the longitude and latitude in the input file
+       lonname = 'lon'
+       latname = 'lat'
+       ! Default value when no value is get from input file
+       chem_default = 0.
+       ! Reference value when no value is get from input file
+       chem_norefinf = 0.
+       ! Should negative values be set to zero from input file?
+       nonegative = .TRUE.
+       ! Type of mask to apply to the input data (see header for more details)
+       maskingtype = 'nomask'
+       ! Values to use for the masking
+       maskvals = (/ min_sechiba, undef_sechiba, undef_sechiba /)
+       ! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
+       namemaskvar = ''
+
+       fieldname = 'flx_co2_bbg_year'
+       CALL interpweight_2Dcont(kjpindex, 0, 0, lalo, resolution, neighbours,                         &
+            contfrac, filename, fieldname, lonname, latname, vmin, vmax, nonegative, maskingtype,     &
+            maskvals, namemaskvar, -1, fractype, chem_default, chem_norefinf,                         &
+            flx_co2_bbg_year, achem_co2)
+    END IF
+
+    IF ( OFF_LINE_MODE ) THEN
+
+       !-
+       !- What are the alowed options for the temporal interpolation
+       !-
+       ! ALLOW_WEATHERGEN : Allow weather generator to create data
+       ! This parameter is already read in the driver
+       allow_weathergen = .FALSE.
+       CALL getin_p('ALLOW_WEATHERGEN',allow_weathergen)
+       
+       ! FORCING_FILE : Name of file containing the forcing data
+       ! This parameter is already read in the driver
+       filename='forcing_file.nc'
+       CALL getin_p('FORCING_FILE',filename)
+       CALL flininfo(filename,iml, jml, lml, tml, force_id)   
+       WRITE(numout,*) 'Number of data per year in forcing file :', tml 
+       CALL flinclo(force_id)
+       WRITE(numout,*) 'Forcing file closed in chemistry_initialize'
+       
+       
+       IF ( allow_weathergen ) THEN
+          WRITE(numout,*) '**chemistry_initialize: Using weather generator, careful to precip division for NOx '
+          nbre_precip = un
+          WRITE(numout,*) 'Division pour les precip, NOx:', nbre_precip
+       ELSE
+          WRITE(numout,*) 'DT_SECHIBA :', dt_sechiba
+          nbre_precip = (one_day/dt_sechiba)/(tml/one_year)
+          WRITE(numout,*) 'Division pour les precip, NOx:', nbre_precip
+       END IF
+
+    ELSE ! (in coupled mode)
+
+       nbre_precip = un
+       
+    END IF  ! (OFF_LINE_MODE)
+
+    ! Write diagnostics
+    IF (ok_cropsfertil_NOx) THEN
+      CALL xios_orchidee_send_field("achem_wrice",achem_wrice)
+      CALL xios_orchidee_send_field("achem_other",achem_other)
+    END IF
+    IF (ok_bbgfertil_NOx) THEN
+      CALL xios_orchidee_send_field("achem_co2",achem_co2)
+    END IF
+
+       
+  END SUBROUTINE chemistry_initialize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : chemistry_bvoc
+!!
+!>\BRIEF          This subroutine computes biogenic emissions of reactive compounds, that is of
+!!                VOCs (volatile organic compounds) from vegetation and NOx (nitrogen oxides) from soils.
+!!                Calculation are mostly based on the works by Guenther et al. (1995) and Yienger and Levy (1995).\n 
+!!
+!! DESCRIPTION  : Biogenic VOC emissions from vegetation are based on the parameterisations developped by
+!!                Guenther et al. (1995). Biogenic VOCs considered here are: isoprene, monoterpenes, OVOC and ORVOC 
+!!                as bulked emissions, methanol, acetone, acetaldehyde, formaldehyde, acetic acid, formic acid
+!!                as single emissions.\n
+!!                For every biogenic VOCs an emission factor (EF), depending on the PFT considered, is used.\n
+!!                Isoprene emissions depend on temperature and radiation. A partition between sunlit and shaded
+!!                leaves is taken into account and either one (if ok_multilayer = FALSE) or several layers
+!!                (if ok_multilayer = TRUE) in the canopy can be used.\n
+!!                When radiation extinction is considered, the canopy radiative transfer model takes into 
+!!                account light extinction through canopy, calculating first need diffuse and direct radiation
+!!                based on Andrew Friend 2001 radiative model and Spitters et al. 1986. The calculation of lai, 
+!!                parscat, parsh and parsun, laisun and laishabsed based on Guenther et al.(JGR, 1995) and Norman (1982).\n
+!!                Emissions for other BVOCs (monoterpenes, OVOC, ORVOC and other single compounds such as
+!!                methanol, acetone...) depend only on temperature.\n   
+!!                The impact of leaf age, using an emission activity prescribed for each of the 4 leaf age
+!!                classes can also be considered for isoprene and methanol emissions when ok_leafage = TRUE.\n
+!!                NOx emissions from soils are based on Yienger and Levy (1995) and depend on soil moisture
+!!                and temperature and PFT. The pulse effect, related to significant rain occuring after severe
+!!                drought can also be considered (ok_pulse_NOx = TRUE), as well as the increase in emissions related to
+!!                biomass buring (ok_bbgfertil_NOx = TRUE) or use of fertilizers (ok_cropsfertil_NOx = TRUE). 
+!!                A net NO flux is eventually calculated taking into account loss by deposition on the surface, using
+!!                a Canopy Reduction Factor (CRF) based on stomatal and leaf area.\n 
+!!                This subroutine is called by diffuco_main only if biogenic emissions are activated
+!!                for sechiba (flag CHEMISTRY_BVOC=TRUE).\n
+!!
+!! RECENT CHANGE(S): Changed name from diffuco_inca to chemistry_bvoc
+!!
+!! MAIN OUTPUT VARIABLE(S): :: PAR, :: PARsun, :: PARsh, :: laisun, :: laish,
+!!                          :: flx_iso, :: flx_mono, :: flx_ORVOC, :: flx_MBO,
+!!                          :: flx_methanol, :: flx_acetone, :: flx_acetal, :: flx_formal,
+!!                          :: flx_acetic, :: flx_formic, :: flx_no_soil, :: flx_no,
+!!                          :: CRF, :: flx_fertil_no, :: Trans, :: Fdf,
+!!                          :: PARdf, :: PARdr, :: PARsuntab, :: PARshtab
+!!
+!! REFERENCE(S) :
+!! - Andrew Friend (2001), Modelling canopy CO2 fluxes: are 'big-leaf' simplifications justified? 
+!! Global Ecology and Biogeography, 10, 6, 603-619, doi: 10.1046/j.1466-822x.2001.00268.x 
+!! - Spitters, C.J.T, Toussaint, H.A.J.M, Groudriaan, J. (1986), Separating the diffuse and direct
+!! component of global radiation and its implications for modeling canopy photosynthesis, Agricultural
+!! and Forest Meteorology, 38, 1-3, 217-229, doi:10.1016/0168-1923(86)90060-2
+!! - Norman JM (1982) Simulation of microclimates. In: Hatfield JL, Thomason IJ (eds)
+!!  Biometeorology in integrated pest management. Academic, New York, pp 65â99
+!! - Guenther, A., Hewitt, C. N., Erickson, D., Fall, R., Geron, C., Graedel, T., Harley, P.,
+!! Klinger, L., Lerdau, M., McKay, W. A., Pierce, T., Scholes, B., Steinbrecher, R., Tallamraju,
+!! R., Taylor, J. et Zimmerman, P. (1995), A global model of natural volatile organic compound
+!! emissions, J. Geophys. Res., 100, 8873-8892.
+!! - MacDonald, R. et Fall, R. (1993), Detection of substantial emissions of methanol from
+!! plants to the atmosphere, Atmos. Environ., 27A, 1709-1713.
+!! - Guenther, A., Geron, C., Pierce, T., Lamb, B., Harley, P. et Fall, R. (2000), Natural emissions
+!! of non-methane volatile organic compounds, carbon monoxide, and oxides of nitrogen from
+!! North America, Atmos. Environ., 34, 2205-2230.
+!! - Yienger, J. J. et Levy II, H. (1995), Empirical model of global soil-biogenic NOx emissions,
+!! J. Geophys. Res., 100, 11,447-11,464.
+!! - Lathiere, J., D.A. Hauglustaine, A. Friend, N. De Noblet-Ducoudre, N. Viovy, and
+!!  G. Folberth (2006), Impact of climate variability and land use changes on global biogenic volatile 
+!! organic compound emissions, Atmospheric Chemistry and Physics, 6, 2129-2146. 
+!! - Lathiere, J., D.A. Hauglustaine, N. De Noblet-Ducoudre, G. Krinner et G.A. Folberth (2005),
+!! Past and future changes in biogenic volatile organic compound emissions simulated with a global
+!! dynamic vegetation model, Geophysical Research Letters, 32, doi: 10.1029/2005GL024164.
+!! - Lathiere, J. (2005), Evolution des emissions de composes organiques et azotes par la biosphere
+!!  continentale dans le modele LMDz-INCA-ORCHIDEE, These de doctorat, Universite Paris VI.
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+
+  SUBROUTINE chemistry_bvoc (kjpindex, swdown, coszang, temp_air, &
+       temp_sol, ptnlev1, precip_rain, humrel, veget_max, &
+       circ_class_biomass, circ_class_n, frac_age, lalo, ccanopy, &
+       cim,  wind, snow, &
+       veget, hist_id, hist2_id,kjit, index, &
+       indexlai, indexveg)
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                 :: kjpindex         !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std), INTENT(in)                                 :: kjit             !! Time step number (-) 
+    INTEGER(i_std),INTENT (in)                                 :: hist_id          !! History file identifier (-)
+    INTEGER(i_std),INTENT (in)                                 :: hist2_id         !! History file 2 identifier (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)           :: index            !! Indeces of the points on the map (-)
+    INTEGER(i_std),DIMENSION (kjpindex*(nlai+1)), INTENT (in)  :: indexlai         !! Indeces of the points on the 3D map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in)       :: indexveg         !! Indeces of the points on the 3D map (-)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: swdown           !! Down-welling surface short-wave flux 
+                                                                                   !! (W.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: coszang          !! Cosine of the solar zenith angle (unitless) 
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: temp_air         !! Air temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: temp_sol         !! Skin temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: ptnlev1          !! 1st level of soil temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: precip_rain      !! Rain precipitation !!?? init
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)           :: humrel           !! Soil moisture stress (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)           :: veget_max        !! Max. vegetation fraction (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)              :: snow             !! Snow mass (kg)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)          :: veget            !! Fraction of vegetation type (-)
+    REAL(r_std), DIMENSION(kjpindex,nvm,nleafages), INTENT(in) :: frac_age         !! Age efficacity from STOMATE for iso 
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT(in)             :: lalo             !! Geographical coordinates for pixels (degrees)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)              :: ccanopy          !! CO2 concentration inside the canopy
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)          :: cim              !! Intercellular CO2 over nlai 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)              :: wind             !! Wind module (m s^{-1})
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)              :: circ_class_biomass !!  Biomass components of the model tree  
+                                                                                   !! within a circumference class
+                                                                                   !! class @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)                  :: circ_class_n     !! Number of trees within each circumference
+                                                                                   !! class @tex $(m^{-2})$ @endtex
+    
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables 
+
+    INTEGER(i_std)                             :: ji, jv, jf, jl    !! Indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: fol_dens          !! foliar density (gDM.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex)           :: tleaf             !! Foliar temperature (K)
+    REAL(r_std), DIMENSION(kjpindex)           :: t_no              !! Temperature used for soil NO emissions (C)
+    REAL(r_std), DIMENSION(kjpindex)           :: exp_1             !! First exponential used in the calculation of 
+                                                                    !! isoprene dependancy to Temperature 
+    REAL(r_std), DIMENSION(kjpindex)           :: exp_2             !! Second exponential used in the calculation of 
+                                                                    !! Isoprene dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_iso            !! Isoprene dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Cl_iso            !! Isoprene dependancy to Light 
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_mono           !! Monoterpene dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_sesq           !! Sesquiterpenes dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_meth           !! Methanol dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_acet           !! Acetone dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_oxyVOC         !! Other oxygenated BVOC dependancy to Temperature
+    REAL(r_std)                                :: GAMMA_iso         !! Temperature and light dependancy for isoprene and fo each PFT
+    REAL(r_std)                                :: GAMMA_iso_m       !! Temperature and light dependancy for isoprene and fo each PFT for multilayer
+    REAL(r_std), DIMENSION(kjpindex)           :: Ylt_mono          !! Total Temperature and light dependancy for monoterpenes
+    REAL(r_std), DIMENSION(kjpindex)           :: Ylt_sesq          !! Total Temperature and light dependancy for sesquiterpens
+    REAL(r_std), DIMENSION(kjpindex)           :: Ylt_meth          !! Total Temperature and light dependancy for methanol
+    REAL(r_std), DIMENSION(kjpindex)           :: Ylt_acet          !! Total Temperature and light dependancy for acetone
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_MBO            !! MBO dependance to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Cl_MBO            !! MBO dependance to Light
+    REAL(r_std), DIMENSION(kjpindex)           :: Xvar              !! Parameter used in the calculation 
+                                                                    !! of MBO dependance to Temperature
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: flx_OVOC          !! Biogenic OVOC emission - 
+                                                                    !! Other Volatil Organic Components (kgC.m^{-2}.s^{-1})
+    !!Canopy radiative transfer model
+    REAL(r_std), DIMENSION(kjpindex)           :: So                !! Maximum radiation at the Earth surface (W.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex)           :: Rfrac             !! Parameter in the regression of diffuse 
+                                                                    !! share on transmission
+    REAL(r_std), DIMENSION(kjpindex)           :: Kfrac             !! Parameter in the regression of diffuse 
+                                                                    !! share on transmission
+    REAL(r_std), DIMENSION(kjpindex)           :: swdf              !! Sw diffuse radiation (W.m^{-2}) 
+    REAL(r_std), DIMENSION(kjpindex)           :: swdr              !! Sw direct radiation (W.m^{-2}) 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: PARscat           !! Scatter PAR @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Clsun_iso         !! Isoprene dependance to light for sun leaves 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Clsh_iso          !! Isoprene dependance to light for shaded leaves
+    !! for multilayer canopy model for iso flux
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: PARscattab        !! Scatter PAR @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nlai+1)             :: laitab            !! LAI per layer (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nlai)      :: laisuntabdep      !! LAI of sun leaves in each layer (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nlai)      :: laishtabdep       !! LAI of shaded leaves in each layer 
+                                                                    !! (m^2.m^{-2})
+    REAL(r_std)                                :: Clsun_iso_tab     !! Isoprene dependance to light 
+                                                                    !! for sun leaves and per layer 
+    REAL(r_std)                                :: Clsh_iso_tab      !! Isoprene dependance to light 
+                                                                    !! for shaded leaves and per layer
+    !for multilayer canopy model Spitter et al. 1986
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: PARnotscat        !! Not-Scattered PAR 
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: PARabsdir         !! Absorbed light of the PAR direct flux  
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: PARabsdiff        !! Absorbed light of the PAR diffuse flux  
+    REAL(r_std), PARAMETER                     :: sigma = 0.20      !! scattering coefficient of single leaves and for visible radiation
+    REAL(r_std), PARAMETER                     :: cluster = 0.85    !! clustering coefficient for leaves, the same that is setting for default in MEGAN V2.10
+    REAL(r_std)                                :: rho               !! reflection index of a green, closed vegetation
+    REAL(r_std)                                :: kbl               !! extinction coefficient of black leaves
+    REAL(r_std)                                :: kdf               !! extinction coefficient of diffuse flux
+    !!Leaf age
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Eff_age_iso       !! Isoprene emission dependance to Leaf Age 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Eff_age_meth      !! Methanol emission dependance to Leaf Age 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Eff_age_VOC       !! Other VOC emission dependance to Leaf Age 
+    !!BBG and Fertilizers for NOx soil emission
+    REAL(r_std), DIMENSION(kjpindex)           :: veget_max_nowoody !! sum of veget_max for non-woody PFT
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: N_qt_WRICE_pft    !! N fertiliser on RICE 
+                                                                    !! (kgN per year per grid cell)
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: N_qt_OTHER_pft    !! N fertiliser on other veg 
+                                                                    !! (kgN per year per grid cell)
+    !! CO2 inhibition effect on isoprene
+    REAL(r_std),DIMENSION (kjpindex,nvm)       :: fco2_wshort       !! Wilkinson short term function for CO2 impact on BVOC (isoprene) 
+    REAL(r_std),DIMENSION (kjpindex)           :: fco2_wlong        !! Wilkinson long term function for CO2 impact on BVOC (isoprene) 
+    REAL(r_std)                                :: fco2_ctrl
+    REAL(r_std),DIMENSION (kjpindex,nvm)       :: fco2              !! Function for CO2 impact on BVOC (isoprene)
+    REAL(r_std), DIMENSION(kjpindex)           :: Ismax_short
+    REAL(r_std), DIMENSION(kjpindex)           :: h_short
+    REAL(r_std), DIMENSION(kjpindex)           :: Cstar_short
+    REAL(r_std)                                :: Ismax_long
+    REAL(r_std)                                :: h_long
+    REAL(r_std)                                :: Cstar_long
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: lai               !! Leaf area index (m^2.m^{-2})
+
+    !! 0.5 Parameters values
+
+    REAL(r_std), PARAMETER :: CT1 = 95000.0       !! Empirical coeffcient (see Guenther .et. al, 1995, eq(10)) (J.mol^{-1})
+    REAL(r_std), PARAMETER :: CT2 = 230000.0      !! Empirical coefficient (see Guenther .et. al, 1995, eq(10)) (J.mol^{-1})
+    REAL(r_std), PARAMETER :: TS = 303.0          !! Leaf temperature at standard condition
+                                                  !! (see Guenther .et. al, 1995, eq(10)) (K)
+    REAL(r_std), PARAMETER :: TM = 314.0          !! Leaf temperature (see Guenther .et. al, 1995, eq(10)) (K)
+
+    REAL(r_std), PARAMETER :: alpha_ = 0.0027     !! Empirical coeffcient (see Guenther .et. al, 1995, eq(9)) (unitless)
+    REAL(r_std), PARAMETER :: CL1 = 1.066         !! Empirical coeffcient (see Guenther .et. al, 1995, eq(9)) (unitless)
+    REAL(r_std), PARAMETER :: beta = 0.09         !! Empirical coeffcient (see Guenther .et. al, 1995, eq(11)) (K^{-1})
+    REAL(r_std), PARAMETER :: lai_threshold = 11. !! Lai threshold for the calculation of scattered radiation
+                                                  !! based on Guenther .et. al (1995) (m^2.m^{-2})
+
+                                              
+    ! Biogenic emissions
+    REAL(r_std),DIMENSION(kjpindex)            :: PAR               !! Photosynthetic active radiation, half of swdown
+                                                                    !! @tex ($\mu mol photons. m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)        :: PARsun            !! PAR received by sun leaves
+                                                                    !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)        :: PARsh             !! PAR received by shaded leaves 
+                                                                    !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)        :: laisun            !! Leaf area index of Sun leaves (m^2.m^{-2})
+    REAL(r_std),DIMENSION(kjpindex,nvm)        :: laish             !! Leaf area index of Shaded leaves (m^2.m^{-2}) 
+
+    CHARACTER(LEN=14)                          :: tleafsun_name     !! To store variables names for I/O
+    CHARACTER(LEN=13)                          :: tleafsh_name      !! To store variables names for I/O
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: Tleafsun_temp     !! temporary sunlit leaf temperature matrix for writing
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: Tleafsh_temp      !! temporary shade leaf temperature matrix for writing
+    REAL(r_std),DIMENSION(kjpindex)            :: Fdf               !! Fraction of the radiation which is diffused (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex,nlai+1)     :: PARsuntab         !! PAR received by sun leaves over LAI layers
+                                                                    !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nlai+1)     :: PARshtab          !! PAR received by shaded leaves over LAI layers
+                                                                    !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex)            :: PARdf             !! Diffuse photosynthetic active radiation
+                                                                    !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex)            :: PARdr             !! Direct photosynthetic active radiation
+                                                                    !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex)            :: Trans             !! Atmospheric Transmissivity (unitless)
+
+!_ ================================================================================================================================
+    fco2 = 0.
+    fco2_wshort = 0.
+    fco2_wlong = 0.
+    Fdf(:) = 0.
+    PAR(:) = 0. 
+    PARsun(:,:) = 0. 
+    PARsh(:,:) = 0. 
+    laisun(:,:) = 0. 
+    laish(:,:) = 0. 
+    CRF(:,:) = 0.               
+    Trans(:) = 0.            
+    PARdf(:) = 0.           
+    PARdr(:) = 0.            
+    PARsuntab(:,:) = 0.        
+    PARshtab(:,:) = 0.        
+   
+    !+++CHECK+++
+    ! This routine calculates radiative transfer through the canopy
+    ! but it is already calculated in the albedo routine. The routine
+    ! makes use of the trunk-based 1D lai whereas a 3D canopy structure
+    ! could now be used. circ_class_biomass and circ_class_n can be used
+    ! to calculate the canopy structure. As a place holder they are used 
+    ! to calculate the 1D lai. 
+    ! Calculate the LAI from the biomass. 
+    lai(:,:) = zero
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          lai(ji,jv) = cc_to_lai(circ_class_biomass(ji,jv,:,ileaf,icarbon), &
+               circ_class_n(ji,jv,:),jv)
+       ENDDO
+    ENDDO
+    !++++++++
+
+    !! 1. Canopy radiative transfer model
+
+    !! Canopy radiative transfer model: takes into account light extinction through canopy
+    !! First need to calculate diffuse and direct radiation
+    !! Based on Andrew Friend radiative model (Global Ecology & Biogeography, 2001)
+    !! And Spitters et al. (Agricultural and Forest Meteorology, 1986)
+       
+    IF ( ok_radcanopy ) THEN
+
+       DO ji = 1, kjpindex
+          IF (coszang(ji) .GT. zero) THEN
+             !! 1.1 Extra-terrestrial solar irradiance at a plan parallel to Earh's surface
+             So(ji) = Sct*( un + 0.033*COS(360.*pi/180.*julian_diff/365.))*coszang(ji)
+             !! 1.2 Atmospheric transmissivity
+             Trans(ji) = swdown(ji)/So(ji)
+             !! 1.3 Empirical calculation of fraction diffuse from transmission based on Spitters et al. (1986)
+             Rfrac(ji) = 0.847 - 1.61*coszang(ji) + 1.04*(coszang(ji)**2.)
+             Kfrac(ji) = (1.47 - Rfrac(ji))/1.66      
+             IF (Trans(ji) .LE. 0.22) THEN
+                Fdf(ji) = un
+             ELSE IF (Trans(ji) .LE. 0.35) THEN
+                Fdf(ji) = un - 6.4*((Trans(ji) - 0.22)**2.) 
+             ELSE IF (Trans(ji) .LE. Kfrac(ji)) THEN
+                Fdf(ji) = 1.47 - 1.66*Trans(ji)
+             ELSE
+                Fdf(ji) = Rfrac(ji)
+             END IF
+             !! 1.4 Direct and diffuse sw radiation in W.m^{-2}
+             swdf(ji) = swdown(ji)*Fdf(ji)
+             swdr(ji) = swdown(ji)*(un-Fdf(ji))
+          ELSE
+             swdf(ji) = zero
+             swdr(ji) = zero
+          END IF
+
+          !! 1.5 PAR diffuse and direct in umol/m^2/s
+          PARdf(ji) = swdf(ji) * W_to_mol * RG_to_PAR
+          PARdr(ji) = swdr(ji) * W_to_mol * RG_to_PAR 
+       END DO
+
+       !! 1.6 Calculation of lai, parscat, parsh and parsun, laisun and laish !!?? define the terms
+       !! Based on Guenther et al. (JGR, 1995) and Norman (1982)
+       ! One-layer canopy model or multi-layer canopy model
+       IF (ok_multilayer) THEN 
+
+
+          ! Calculation PER LAYER
+          DO jl = nlai+1, 1, -1
+            laitab(jl) = laimax*(EXP(lai_level_depth*(jl-1) - un)/(EXP(lai_level_depth*nlai) - un))
+
+         !introduction of the Spitter way to calculate radiation over the levels !!!!!!!
+             DO ji = 1, kjpindex
+                kdf = cluster*0.8*SQRT((1 - sigma))
+                IF (ABS(ACOS(coszang(ji))) .LT. pi/2. .AND. coszang(ji) .NE. zero) THEN
+                   ! Coefficients calculation:
+                   kbl = cluster*0.5/ABS(coszang(ji))
+                   rho = ((1-SQRT((1 - sigma)))/(1+SQRT((1 - sigma))))*(2/(1+1.6*ABS(coszang(ji))))
+
+                   PARnotscat(ji,jl) = (1 - sigma)*PARdr(ji)*kbl*EXP(-SQRT((1 - sigma))*kbl*laitab(jl))
+                   PARabsdir(ji,jl) = (1 - rho)*SQRT((1 - sigma))*PARdr(ji)*kbl*EXP(-SQRT((1 - sigma))*kbl*laitab(jl))
+                   PARabsdiff(ji,jl) = (1 - rho)*PARdf(ji)*kdf*EXP(-kdf*laitab(jl))
+                   PARshtab(ji,jl) = (PARabsdiff(ji,jl) + (PARabsdir(ji,jl) - PARnotscat(ji,jl)))/(1 - sigma)
+                   PARsuntab(ji,jl) = PARshtab(ji,jl) + (1-sigma)*kbl*PARdr(ji)/(1 - sigma) 
+
+                   !correction using the equation (4) in Bodin et al 2012 and (7) or (8) in Spitter et al 1986 
+                   !using the extinction coefficient kbl = 0.5/coszang and not only 0.5
+                   IF (jl .NE. nlai+1) THEN
+                      laisuntabdep(ji,jl) =(laitab(jl+1)-laitab(jl))*EXP(-kbl*laitab(jl))
+                      laishtabdep(ji,jl) =(laitab(jl+1)-laitab(jl))*(1.-EXP(-kbl*laitab(jl)))
+                   ENDIF
+
+                ELSE
+
+                   PARshtab(ji,jl) = PARdf(ji)*kdf*EXP(-kdf*laitab(jl))
+                   PARsuntab(ji,jl) = 0.
+
+                   IF (jl .NE. nlai+1) THEN
+                      laisuntabdep(ji,jl) = 0.
+                      laishtabdep(ji,jl) = laitab(jl+1)-laitab(jl)
+
+                   ENDIF  
+                END IF
+             END DO
+          END DO
+
+
+
+       ! introduction of the Spitter way to calculate radiation over the levels !!!!!!!
+       ELSE
+          ! Calculation FOR one layer
+          DO jv = 1, nvm
+             DO ji = 1, kjpindex
+                IF (lai(ji,jv) .LE. lai_threshold) THEN
+                   PARscat(ji,jv) = 0.07*PARdr(ji)*(1.1 - 0.1*lai(ji,jv))*exp(-coszang(ji))
+                ELSE
+                   PARscat(ji,jv) = zero
+                END IF
+
+                IF (coszang(ji) .NE. zero ) THEN
+                   PARsh(ji,jv) = PARdf(ji)*exp(-0.5*((lai(ji,jv))**0.7)) + PARscat(ji,jv)
+                   PARsun(ji,jv) = PARdr(ji)*COS(60.*pi/180.)/coszang(ji) + PARsh(ji,jv)
+                ELSE
+                   PARsh(ji,jv) = PARdf(ji)*exp(-0.5*(lai(ji,jv)**0.7)) + PARscat(ji,jv)
+                   PARsun(ji,jv) = zero 
+                END IF
+                IF (ABS(ACOS(coszang(ji))) .LT. pi/2. .AND. coszang(ji) .NE. zero) THEN 
+                   ! calculation as in Lathiere (2005) = with correction removing lai in Guenther (1995)
+                   laisun(ji,jv) = (un - exp(-0.5*lai(ji,jv)/(coszang(ji))))*coszang(ji)/COS(60.*pi/180.)
+                   laish(ji,jv) = lai(ji,jv) - laisun(ji,jv)
+                ELSE
+                   laisun(ji,jv) = zero
+                   laish(ji,jv) = lai(ji,jv)
+                END IF
+             END DO
+          END DO
+       ENDIF
+    END IF
+
+
+    !! 2. Calculation of non-PFT dependant parameters used for VOC emissions
+    DO ji = 1, kjpindex ! (loop over # pixels)
+       !! 2.1 Calculation of Tleaf (based on Lathiere, 2005)
+
+
+       tleaf(ji) = temp_air(ji)
+
+       !! 2.2 Isoprene emission dependency - with no PARsun/PARshaded partitioning - Guenther et al. (1995) and Lathiere (2005)
+       !> @codeinc $$?? ecrire les equation en latex ? 
+       exp_1(ji) = exp( (CT1 * ( tleaf(ji) - TS )) / (RR*TS*tleaf(ji)) )
+       exp_2(ji) = exp( (CT2 *( tleaf(ji) - TM )) / (RR*TS*tleaf(ji)) )
+       PAR(ji)   = swdown(ji) * W_to_mol * RG_to_PAR         ! from W/m^2 to umol photons/m^2/s and half of sw for PAR
+       Ct_iso(ji)    = exp_1(ji)/(un + exp_2(ji))            ! temperature dependance  
+       Cl_iso(ji)    = alpha_*CL1*PAR(ji)/sqrt(un + (alpha_**2) * (PAR(ji)**2) ) ! light dependance
+       !> @endcodeinc
+  
+       !! 2.3 Monoterpene and oxy VOB emission dependency to Temperature 
+       !!     light independant fraction
+       !> @codeinc
+       !Ct_mono(ji) = exp(beta*(tleaf(ji) - TS))  ! Old method
+       Ct_mono(ji) = exp(beta_mono*(tleaf(ji) - TS))
+       Ct_sesq(ji) = exp(beta_sesq*(tleaf(ji) - TS))
+       Ct_meth(ji) = exp(beta_meth*(tleaf(ji) - TS))
+       Ct_acet(ji) = exp(beta_acet*(tleaf(ji) - TS))
+       Ct_oxyVOC(ji) = exp(beta_oxyVOC*(tleaf(ji) - TS))     
+       !> @endcodeinc
+       !! 2.4 MBO biogenic emissions dependency, only from PFT7 and PFT4 for location of vegetation emitter
+       ! but in fact MBO fluxes only in America (ponderosa and lodgepole pines only found in these areas)
+       !> @codeinc
+       Xvar(ji) = ((un/312.3) - (un/tleaf(ji)))/RR
+       !> @endcodeinc
+       !! 2.4.1 temperature dependency
+       !> @codeinc
+       Ct_MBO(ji)    = (1.52*209000.0*exp(67000.0*Xvar(ji)))/(209000.0 - 67000.0*(un - exp(209000.0*Xvar(ji))))
+       !> @endcodeinc
+       !! 2.4.2 light dependency
+       Cl_MBO(ji)    = (0.0011*1.44*PAR(ji))/(sqrt(un + (0.0011**2)*(PAR(ji)**2)))
+       !! 2.5 NO biogenic emissions given in ngN/m^2/s, emission factor in ngN/m^2/s too
+       !! calculation of temperature used for NO soil emissions
+       t_no(ji) = ptnlev1(ji) - ZeroCelsius  !!temp must be in celsius to calculate no emissions
+       !! 2.6 calculation of non-woody veget_max fraction
+       IF (ok_cropsfertil_NOx) THEN
+          veget_max_nowoody(ji) = zero
+          DO jv = 1,nvm
+             IF ( (jv /= ibare_sechiba) .AND. .NOT.(is_tree(jv)) ) THEN
+                veget_max_nowoody(ji) = veget_max_nowoody(ji) + veget_max(ji,jv)
+             ENDIF
+          ENDDO
+       END IF
+    END DO ! (loop over # pixels)
+
+    !! 2bis. Calculation of CO2 function for inhibition effect on isoprene 
+    ! 2 approaches can be used: either Possell et al. (2005) or Wilkinson et al. (2006) 
+
+!! 19/04/2010 and then implemented in version revised by Nicolas Vuichard, 08042014
+!! Impact of atmospheric CO2 on isoprene emissions
+!! Can be activated or not
+!! If considered, can use either Possell 2005 or Wilkinson 2009 parameterisation 
+!! This is used to rescale the emission factor, considered to be measured at 350 ppm of CO2
+!! to the CO2 conditions of the run
+
+IF ( ok_co2bvoc_poss ) THEN
+   WRITE(numout,*) 'CO2 impact on isoprene: Possell calculation'
+
+   !! Possell function needs to be normalized (experiments at 400 ppm and EF before 1995)
+   !! Normalized at 350 ppm
+   fco2_ctrl = (-0.0123+(441.4795/350.)+(-1282.65/(350.**2)))
+
+   !! 2 tests: using the canopy (atmospheric) CO2 'ccanopy'
+   !! or the intercellular CO2 over nlai 'cim' 
+   !! with cim = ccanopy*0.667 
+   !! in the end I go for ccanopy for the Possell function since too much differences
+   !! when using cim and also the function has been derived based on atmospheric CO2
+   DO ji = 1, kjpindex
+
+      fco2(ji,:) = (-0.0123+(441.4795/ccanopy(ji))+(-1282.65/(ccanopy(ji)*ccanopy(ji))))/fco2_ctrl
+
+   END DO
+ELSE IF ( ok_co2bvoc_wilk ) THEN
+   WRITE(numout,*) 'CO2 impact on isoprene: Wilkinson calculation'
+
+   !! In the Wilkinson function, 2 impacts are considered:
+   !! -short-term impact for CO2 variation during a single day (seconds/minutes)
+   !! -long-term impact for CO2 variation during leaf-growth (weeks/month)
+
+
+   !! Long-term parameters
+   !! Constant
+   Ismax_long = 1.344
+   h_long = 1.4614
+   Cstar_long = 585.
+   !! Short-term parameters 
+   !! They have to be calculated based on atmospheric CO2
+   !! 10/05/2010
+   !! For atmospheric CO2 lower than 400 ppm or higher than 1200 ppm
+   !! (min and max CO2 level tested for short-term effect in Wilkinson et al. 2009)
+   !! we use the parameters calculated at 400/1200 ppm. For intermediate CO2 concentration,
+   !! parameters are calculated. 
+   !! Linear interpolation
+
+   DO ji = 1, kjpindex
+
+      IF (ccanopy(ji) .LE. 400.) THEN
+
+         Ismax_short(ji) = 1.072
+         h_short(ji) = 1.7
+         Cstar_short(ji) = 1218.
+
+      ELSE IF (ccanopy(ji) .EQ. 600.) THEN
+
+         Ismax_short(ji) = 1.036
+         h_short(ji) = 2.0125
+         Cstar_short(ji) = 1150.
+
+      ELSE IF (ccanopy(ji) .EQ. 800.) THEN
+
+         Ismax_short(ji) = 1.046
+         h_short(ji) = 1.5380
+         Cstar_short(ji) = 2025.
+
+      ELSE IF (ccanopy(ji) .GE. 1200.) THEN
+
+         Ismax_short(ji) = 1.014
+         h_short(ji) = 2.8610
+         Cstar_short(ji) = 1525.
+
+
+      ELSE IF ((ccanopy(ji) .GT. 400.) .AND. (ccanopy(ji) .LT. 600.)) THEN
+
+         Ismax_short(ji) = 1.036 + (ccanopy(ji)-600.)*(1.036-1.072)/(600.-400.)
+         h_short(ji) = 2.0125 + (ccanopy(ji)-600.)*(2.0125-1.7)/(600.-400.)
+         Cstar_short(ji) =  1150. + (ccanopy(ji)-600.)*(1150.-1218.)/(600.-400.)
+
+      ELSE IF ((ccanopy(ji) .GT. 600.) .AND. (ccanopy(ji) .LT. 800.)) THEN
+
+         Ismax_short(ji) = 1.046 + (ccanopy(ji)-800.)*(1.046-1.036)/(800.-600.)
+         h_short(ji) = 1.5380 + (ccanopy(ji)-800.)*(1.5380-2.0125)/(800.-600.)
+         Cstar_short(ji) = 2025. + (ccanopy(ji)-800.)*(2025.-1150.)/(800.-600.)
+
+      ELSE IF ((ccanopy(ji) .GT. 800.) .AND. (ccanopy(ji) .LT. 1200.)) THEN
+
+        Ismax_short(ji) = 1.014 + (ccanopy(ji)-1200.)*(1.014-1.046)/(1200.-800.)
+        h_short(ji) = 2.8610 + (ccanopy(ji)-1200.)*(2.8610-1.5380)/(1200.-800.)
+        Cstar_short(ji) = 1525. + (ccanopy(ji)-1200.)*(1525.-2025.)/(1200.-800.)
+
+
+      END IF
+
+   END DO
+
+   WRITE(numout,*) '***Wilkinson BVOC-CO2 function: parameters***'
+   WRITE(numout,*) 'Ismax_long: ', Ismax_long
+   WRITE(numout,*) 'h_long: ', h_long
+   WRITE(numout,*) 'Cstar_long: ', Cstar_long
+   WRITE(numout,*) 'Ismax_short: ', MAXVAL(Ismax_short(:)) , MINVAL(Ismax_short(:))
+   WRITE(numout,*) 'h_short: ', MAXVAL(h_short(:)) , MINVAL(h_short(:))
+   WRITE(numout,*) 'Cstar_short: ', MAXVAL(Cstar_short(:)) , MINVAL(Cstar_short(:))
+   WRITE(numout,*) '******'
+
+   DO ji = 1, kjpindex
+      fco2_wlong(ji) = (Ismax_long-((Ismax_long*((0.667*ccanopy(ji))**h_long))/&
+                     & ((Cstar_long**h_long)+(0.667*ccanopy(ji))**h_long)))/1.06566
+      DO jv = 1, nvm
+         fco2_wshort(ji,jv) = (Ismax_short(ji)-((Ismax_short(ji)*((cim(ji,jv))**h_short(ji)))/&
+                            & ((Cstar_short(ji)**h_short(ji))+(cim(ji,jv))**h_short(ji))))/1.010803
+      END DO
+   END DO
+
+   DO ji = 1, kjpindex
+      DO jv = 1, nvm
+         fco2(ji,jv) = fco2_wshort(ji,jv)*fco2_wlong(ji)
+      END DO
+   END DO
+
+ELSE
+      WRITE(numout,*) 'CO2 impact on isoprene not considered'
+      fco2(:,:) = 1.
+END IF
+
+
+    !! 3. Calculation of PFT dependant parameters and
+    ! Calculation of VOC emissions flux
+
+    Eff_age_iso(:,:) = zero
+    Eff_age_meth(:,:) = zero
+
+
+    DO jv = 1, nvm ! loop over the PDFs
+       DO ji = 1, kjpindex ! loop over the grid cell
+          ! 6-Calculation of Leaf Age Function (Lathiere 2005)
+          IF ( ok_leafage ) THEN
+             DO jf = 1, nleafages
+                !> @codeinc
+                Eff_age_iso(ji,jv) = Eff_age_iso(ji,jv) + frac_age(ji,jv,jf)*iso_activity(jf)
+                Eff_age_meth(ji,jv) = Eff_age_meth(ji,jv) + frac_age(ji,jv,jf)*methanol_activity(jf)
+                !> @endcodeinc 
+             END DO
+             !> @codeinc
+             Eff_age_VOC(ji,jv) = un
+             !> @endcodeinc
+          ELSE
+             Eff_age_iso(ji,jv) = un
+             Eff_age_meth(ji,jv) = un
+             Eff_age_VOC(ji,jv) = un
+          END IF
+          !! 5. Calculation of foliar density
+          IF ( sla(jv) .eq. zero ) THEN
+             fol_dens(ji,jv) = zero
+          ELSE
+             ! 2 factor for conversion from gC to gDM
+             fol_dens(ji,jv) = 2 * lai(ji,jv)/sla(jv)
+          ENDIF
+          !! 6. Calculation of VOC emissions from vegetation
+          IF ( ok_radcanopy ) THEN
+             ! if multi-layer canopy model
+             IF (ok_multilayer) THEN 
+
+                laisun(ji,jv) = zero
+                laish(ji,jv) = zero
+                GAMMA_iso_m  = zero
+                flx_iso(ji,jv) = zero
+                flx_mono(ji,jv) = zero
+                flx_apinen(ji,jv) = zero
+                flx_bpinen(ji,jv) = zero
+                flx_limonen(ji,jv) = zero
+                flx_myrcen(ji,jv) =  zero
+                flx_sabinen(ji,jv) =  zero
+                flx_camphen(ji,jv) = zero
+                flx_3caren(ji,jv) = zero
+                flx_tbocimen(ji,jv) = zero
+                flx_othermono(ji,jv) = zero
+                flx_sesquiter(ji,jv) =  zero
+                flx_methanol(ji,jv) = zero
+                flx_acetone(ji,jv) =  zero
+                flx_acetal(ji,jv) = zero
+                flx_formal(ji,jv) = zero
+                flx_acetic(ji,jv) = zero
+                flx_formic(ji,jv) = zero
+                ! loop over the NLAI canopy layers
+                DO jl = 1, nlai
+                   IF ((laitab(jl) .LE. lai(ji,jv)).AND.(lai(ji,jv).NE.zero)) THEN
+                      !sunlit vegetation 
+                      Clsun_iso_tab   = alpha_*CL1*PARsuntab(ji,jl)/sqrt(un + (alpha_**2) * (PARsuntab(ji,jl)**2) )
+                      ! shaded vegetation
+                      Clsh_iso_tab    = alpha_*CL1*PARshtab(ji,jl)/sqrt(un + (alpha_**2) * (PARshtab(ji,jl)**2) ) 
+                      flx_iso(ji,jv) = flx_iso(ji,jv) + (laisuntabdep(ji,jl)*Clsun_iso_tab+ &
+                           & laishtabdep(ji,jl)*Clsh_iso_tab)* &
+                           & fol_dens(ji,jv)/lai(ji,jv)*Ct_iso(ji)*em_factor_isoprene(jv)* &
+                           & Eff_age_iso(ji,jv)*fco2(ji,jv)*1e-9/one_hour
+
+                      GAMMA_iso_m = GAMMA_iso_m + (laisuntabdep(ji,jl)*Clsun_iso_tab+ &
+                           & laishtabdep(ji,jl)*Clsh_iso_tab)* &
+                           & fol_dens(ji,jv)/lai(ji,jv)*Ct_iso(ji)*1e-9/one_hour
+
+                      laisun(ji,jv) = laisun(ji,jv) + laisuntabdep(ji,jl)
+                      laish(ji,jv)  = laish(ji,jv) + laishtabdep(ji,jl)
+                   END IF
+                END DO
+
+                !! 6.1 Calculation of monoterpene biogenic emissions
+                flx_mono(ji,jv) = ((1-LDF_mono)*Ct_mono(ji)*1e-9/one_hour*fol_dens(ji,jv) + LDF_mono*GAMMA_iso_m)* &
+                     & em_factor_monoterpene(jv)*Eff_age_VOC(ji,jv) 
+                !! 6.12 Calculation of sesquiterpenes biogenic emission 
+                flx_sesquiter(ji,jv) = ((1-LDF_sesq)*Ct_sesq(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_sesq*GAMMA_iso_m)* &
+                     & em_factor_sesquiterp(jv)*Eff_age_VOC(ji,jv)
+                !! 6.13 Calculation of methanol biogenic emissions
+                flx_methanol(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_meth*GAMMA_iso_m)* &
+                     & em_factor_methanol(jv)*Eff_age_meth(ji,jv)
+                !! 6.14 Calculation of acetone biogenic emissions
+                flx_acetone(ji,jv) = ((1-LDF_acet)*Ct_acet(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_acet*GAMMA_iso_m)* &
+                     & em_factor_acetone(jv)*Eff_age_VOC(ji,jv)
+                !! 6.14 Calculation of acetaldehyde biogenic emissions
+                flx_acetal(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_meth*GAMMA_iso_m)* &
+                     & em_factor_acetal(jv)*Eff_age_VOC(ji,jv)
+                !! 6.16 Calculation of formaldehyde biogenic emissions
+                flx_formal(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_meth*GAMMA_iso_m)* &
+                     & em_factor_formal(jv)*Eff_age_VOC(ji,jv)
+                !! 6.17 Calculation of acetic acid biogenic emissions
+                flx_acetic(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_meth*GAMMA_iso_m)* &
+                     & em_factor_acetic(jv)*Eff_age_VOC(ji,jv)
+                !! 6.18 Calculation of formic acid biogenic emissions
+                flx_formic(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_meth*GAMMA_iso_m)* &
+                     & em_factor_formic(jv)*Eff_age_VOC(ji,jv)
+
+
+                !! 6.3 Calculation of alfa pinene biogenic emission 
+                flx_apinen(ji,jv) = em_factor_apinene(jv)*flx_mono(ji,jv) 
+                !! 6.4 Calculation of beta pinene biogenic emission 
+                flx_bpinen(ji,jv) = em_factor_bpinene(jv)*flx_mono(ji,jv) 
+                !! 6.5 Calculation of limonene biogenic emission 
+                flx_limonen(ji,jv) = em_factor_limonene(jv)*flx_mono(ji,jv) 
+                !! 6.6 Calculation of myrcene biogenic emission !! 
+                flx_myrcen(ji,jv) = em_factor_myrcene(jv)*flx_mono(ji,jv) 
+                !! 6.7 Calculation of sabinene biogenic emission
+                flx_sabinen(ji,jv) = em_factor_sabinene(jv)*flx_mono(ji,jv) 
+                !! 6.8 Calculation of camphene biogenic emission 
+                flx_camphen(ji,jv) = em_factor_camphene(jv)*flx_mono(ji,jv) 
+                !! 6.9 Calculation of 3-carene biogenic emission 
+                flx_3caren(ji,jv) = em_factor_3carene(jv)*flx_mono(ji,jv) 
+                !! 6.10 Calculation of t-beta-ocimene biogenic emission
+                flx_tbocimen(ji,jv) = em_factor_tbocimene(jv)*flx_mono(ji,jv) 
+                !! 6.11 Calculation of other monoterpenes biogenic emission
+                flx_othermono(ji,jv) = em_factor_othermonot(jv)*flx_mono(ji,jv) 
+
+                ! if mono-layer canopy model
+             ELSE
+                !sunlit vegetation 
+                Clsun_iso(ji,jv)   = alpha_*CL1*PARsun(ji,jv)/sqrt(un + (alpha_**2) * (PARsun(ji,jv)**2) )
+                ! shaded vegetation      
+                Clsh_iso(ji,jv)    = alpha_*CL1*PARsh(ji,jv)/sqrt(un + (alpha_**2) * (PARsh(ji,jv)**2) )       
+                IF (lai(ji,jv) .NE. zero) THEN
+                   !! 6.1 Calculation of isoprene biogenic emissions
+                   GAMMA_iso = (laisun(ji,jv)*Clsun_iso(ji,jv) + laish(ji,jv)*Clsh_iso(ji,jv))/lai(ji,jv)*Ct_iso(ji)
+                   flx_iso(ji,jv) = GAMMA_iso*fol_dens(ji,jv)*em_factor_isoprene(jv)*Eff_age_iso(ji,jv)*fco2(ji,jv)*1e-9/one_hour
+                   !! 6.2 Calculation of monoterpene biogenic emissions
+                   flx_mono(ji,jv) = ((1-LDF_mono)*Ct_mono(ji)+LDF_mono*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_monoterpene(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+                   !! 6.3 Calculation of alfa pinene biogenic emission 
+                   flx_apinen(ji,jv) = em_factor_apinene(jv)*flx_mono(ji,jv)
+                   !! 6.4 Calculation of beta pinene biogenic emission 
+                   flx_bpinen(ji,jv) = em_factor_bpinene(jv)*flx_mono(ji,jv)
+                   !! 6.5 Calculation of limonene biogenic emission 
+                   flx_limonen(ji,jv) = em_factor_limonene(jv)*flx_mono(ji,jv)
+                   !! 6.6 Calculation of myrcene biogenic emission 
+                   flx_myrcen(ji,jv) = em_factor_myrcene(jv)*flx_mono(ji,jv)
+                   !! 6.7 Calculation of sabinene biogenic emission 
+                   flx_sabinen(ji,jv) = em_factor_sabinene(jv)*flx_mono(ji,jv)
+                   !! 6.8 Calculation of camphene biogenic emission 
+                   flx_camphen(ji,jv) = em_factor_camphene(jv)*flx_mono(ji,jv)
+                   !! 6.9 Calculation of 3-carene biogenic emission 
+                   flx_3caren(ji,jv) = em_factor_3carene(jv)*flx_mono(ji,jv)
+                   !! 6.10 Calculation of t-beta-ocimene biogenic emission 
+                   flx_tbocimen(ji,jv) = em_factor_tbocimene(jv)*flx_mono(ji,jv)
+                   !! 6.11 Calculation of other monoterpenes biogenic emission 
+                   flx_othermono(ji,jv) = em_factor_othermonot(jv)*flx_mono(ji,jv)
+                   !! 6.12 Calculation of sesquiterpenes biogenic emission 
+                   flx_sesquiter(ji,jv) = ((1-LDF_sesq)*Ct_sesq(ji)+LDF_sesq*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_sesquiterp(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+                   !! 6.13 Calculation of methanol biogenic emissions
+                   flx_methanol(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)+LDF_meth*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_methanol(jv)*Eff_age_meth(ji,jv)*1e-9/one_hour
+                   !! 6.14 Calculation of acetone biogenic emissions
+                   flx_acetone(ji,jv) = ((1-LDF_acet)*Ct_acet(ji)+LDF_acet*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_acetone(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+                   !! 6.15 Calculation of acetaldehyde biogenic emissions
+                   flx_acetal(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)+LDF_meth*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_acetal(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+                   !! 6.16 Calculation of formaldehyde biogenic emissions
+                   flx_formal(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)+LDF_meth*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_formal(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+                   !! 6.17 Calculation of acetic acid biogenic emissions
+                   flx_acetic(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)+LDF_meth*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_acetic(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+                   !! 6.18 Calculation of formic acid biogenic emissions
+                   flx_formic(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)+LDF_meth*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_formic(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+ 
+                ELSE
+                   ! 
+                   flx_iso(ji,jv) = zero
+                   flx_mono(ji,jv) = zero
+                   flx_apinen(ji,jv) = zero 
+                   flx_bpinen(ji,jv) = zero 
+                   flx_limonen(ji,jv) = zero 
+                   flx_myrcen(ji,jv) =  zero
+                   flx_sabinen(ji,jv) =  zero 
+                   flx_camphen(ji,jv) = zero 
+                   flx_3caren(ji,jv) = zero 
+                   flx_tbocimen(ji,jv) = zero
+                   flx_othermono(ji,jv) = zero 
+                   flx_sesquiter(ji,jv) =  zero 
+                   flx_methanol(ji,jv) = zero
+                   flx_acetone(ji,jv) =  zero 
+                   flx_acetal(ji,jv) = zero
+                   flx_formal(ji,jv) = zero 
+                   flx_acetic(ji,jv) = zero 
+                   flx_formic(ji,jv) = zero 
+                END IF
+             END IF
+             ! if no light extinction due to vegetation  
+          ELSE
+             !! Isoprene emissions - general equation
+             flx_iso(ji,jv) = fol_dens(ji,jv)*Ct_iso(ji)*Cl_iso(ji)*Eff_age_iso(ji,jv)*fco2(ji,jv)* &
+                  em_factor_isoprene(jv)*1e-9/one_hour
+             !! 6.2 Calculation of monoterpene biogenic emissions
+             Ylt_mono(ji) = ((1-LDF_mono)*Ct_mono(ji)+LDF_mono*Ct_iso(ji)*Cl_iso(ji)) 
+             flx_mono(ji,jv) = fol_dens(ji,jv)*em_factor_monoterpene(jv)*Ylt_mono(ji)*Eff_age_VOC(ji,jv)*&
+                  1e-9/one_hour
+             !! 6.3 Calculation of alfa pinene biogenic emission 
+             flx_apinen(ji,jv) = em_factor_apinene(jv)*flx_mono(ji,jv)  
+             !! 6.4 Calculation of beta pinene biogenic emission 
+             flx_bpinen(ji,jv) = em_factor_bpinene(jv)*flx_mono(ji,jv)                       
+             !! 6.5 Calculation of limonene biogenic emission 
+             flx_limonen(ji,jv) = em_factor_limonene(jv)*flx_mono(ji,jv)                      
+             !! 6.6 Calculation of myrcene biogenic emission 
+             flx_myrcen(ji,jv) = em_factor_myrcene(jv)*flx_mono(ji,jv)                       
+             !! 6.7 Calculation of sabinene biogenic emission 
+             flx_sabinen(ji,jv) = em_factor_sabinene(jv)*flx_mono(ji,jv)           
+             !! 6.8 Calculation of camphene biogenic emission 
+             flx_camphen(ji,jv) = em_factor_camphene(jv)*flx_mono(ji,jv)
+             !! 6.9 Calculation of 3-carene biogenic emission 
+             flx_3caren(ji,jv) = em_factor_3carene(jv)*flx_mono(ji,jv)                       
+             !! 6.10 Calculation of t-beta-ocimene biogenic emission 
+             flx_tbocimen(ji,jv) = em_factor_tbocimene(jv)*flx_mono(ji,jv)                     
+             !! 6.11 Calculation of other monoterpenes biogenic emission 
+             flx_othermono(ji,jv) = em_factor_othermonot(jv)*flx_mono(ji,jv)                    
+             !! 6.12 Calculation of sesquiterpenes biogenic emission 
+             Ylt_sesq(ji) = ((1-LDF_sesq)*Ct_sesq(ji)+LDF_sesq*Ct_iso(ji)*Cl_iso(ji))
+             flx_sesquiter(ji,jv) = fol_dens(ji,jv)*em_factor_sesquiterp(jv)*Ylt_sesq(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour    
+             !! 6.16 Calculation of methanol biogenic emissions
+             Ylt_meth(ji) = ((1-LDF_meth)*Ct_meth(ji)+LDF_meth*Ct_iso(ji)*Cl_iso(ji))
+             flx_methanol(ji,jv) = fol_dens(ji,jv)*em_factor_methanol(jv)*Ylt_meth(ji)*Eff_age_meth(ji,jv)*1e-9/one_hour
+             !! 6.17 Calculation of acetone biogenic emissions
+             Ylt_acet(ji) = ((1-LDF_acet)*Ct_acet(ji)+LDF_acet*Ct_iso(ji)*Cl_iso(ji))
+             flx_acetone(ji,jv) = fol_dens(ji,jv)*em_factor_acetone(jv)*Ylt_acet(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+             !! 6.18 Calculation of acetaldehyde biogenic emissions
+             flx_acetal(ji,jv) = fol_dens(ji,jv)*em_factor_acetal(jv)*Ylt_meth(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+             !! 6.19 Calculation of formaldehyde biogenic emissions
+             flx_formal(ji,jv) = fol_dens(ji,jv)*em_factor_formal(jv)*Ylt_meth(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+             !! 6.20 Calculation of acetic acid biogenic emissions
+             flx_acetic(ji,jv) = fol_dens(ji,jv)*em_factor_acetic(jv)*Ylt_meth(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+             !! 6.21 Calculation of formic acid biogenic emissions
+             flx_formic(ji,jv) = fol_dens(ji,jv)*em_factor_formic(jv)*Ylt_meth(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+
+          END IF
+
+          !! 6.22 Calculation of ORVOC biogenic emissions
+          !! Other Reactive Volatile Organic Compounds
+          !> @codeinc
+          flx_ORVOC(ji,jv) = fol_dens(ji,jv)*em_factor_ORVOC(jv)*Ct_mono(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          !> @endcodeinc
+          !! 6.4 Calculation of OVOC biogenic emissions
+          !! Other Volatile Organic Compounds
+          flx_OVOC(ji,jv) = fol_dens(ji,jv)*em_factor_OVOC(jv)*Ct_mono(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          !! 6.5 Calculation of MBO biogenic emissions
+          !! 2-Methyl-3-Buten-2-ol 
+          IF(lalo(ji,1) .GE. 20. .AND. lalo(ji,2) .LE. -100) THEN
+             flx_MBO(ji,jv) = fol_dens(ji,jv)*em_factor_MBO(jv)*Ct_MBO(ji)*Cl_MBO(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          ELSE
+             flx_MBO(ji,jv) = zero
+          END IF
+       END DO
+
+    END DO
+
+
+    !! 7. Calculation of NOx emissions from soils
+    ! Based on Yienger & Levy (1995) and Lathiere (2005, chapter 3)
+    DO ji = 1, kjpindex
+       !! 7.1 Precipitation-related pulse function
+       IF (ok_pulse_NOx) THEN
+          ! if we are during a period where pulses are not allowed
+          IF (ok_siesta(ji)) THEN
+             ! if this period is not over 
+             IF (FLOOR(siestaday(ji)) .LE. siestalim(ji)) THEN
+                siestaday(ji) = siestaday(ji) + (dt_sechiba/one_day)
+                ! if this period is over
+             ELSE
+                ok_siesta(ji) = .FALSE.
+                siestaday(ji) = zero
+             END IF
+          END IF
+          ! if we are during a period where pulses are allowed
+          IF ((.NOT. ok_siesta(ji)) .AND. (.NOT. allow_pulse(ji))) THEN
+             IF (humrel(ji,1) .LT. 0.15) THEN
+                ! if precip exceeds 1 mm/day over one time step => a pulse occurs
+                IF(precip_rain(ji)/nbre_precip .GE. un/(one_day/dt_sechiba)) THEN
+                   ! if precip is up to 5 mm/day => pulse length is 3 days
+                   IF (precip_rain(ji)/nbre_precip .LT. 5./(one_day/dt_sechiba)) THEN
+                      pulselim(ji) = 3.
+                      ! if precip is up to 15 mm/day => pulse length is 7 days
+                   ELSE IF (precip_rain(ji)/nbre_precip .LT. 15./(one_day/dt_sechiba)) THEN
+                      pulselim(ji) = 7.
+                      ! if precip is upper than 15 mm/day => pulse length is 14 days
+                   ELSE IF (precip_rain(ji)/nbre_precip .GE. 15./(one_day/dt_sechiba)) THEN
+                      pulselim(ji) = 14.
+                   END IF
+                   allow_pulse(ji)=.TRUE.
+                   pulseday(ji) = un
+                END IF
+             END IF
+          END IF
+          ! if we were during a pulse period
+          IF (allow_pulse(ji)) THEN
+             ! if we are still during the pulse period
+             ! 16/06/2010 We assume a (pulselim-1) days for the pulse length (NVui+Jlath)
+             IF(FLOOR(pulseday(ji)) .LT. pulselim(ji)) THEN
+                ! calculation of the pulse function
+                IF (pulselim(ji).EQ.3) THEN
+                   pulse(ji) = 11.19*exp(-0.805*pulseday(ji))
+                ELSE IF (pulselim(ji).EQ.7) THEN
+                   pulse(ji) = 14.68*exp(-0.384*pulseday(ji))
+                ELSE IF (pulselim(ji).EQ.14) THEN 
+                   pulse(ji) = 18.46*exp(-0.208*pulseday(ji))
+                END IF
+                pulseday(ji) = pulseday(ji) + (dt_sechiba/one_day)
+                ! if the pulse period is over
+             ELSE
+                ! pulse function is set to 1 
+                pulse(ji) = un
+                allow_pulse(ji) = .FALSE.
+                siestaday(ji) = un
+                siestalim(ji) = pulselim(ji)
+                ok_siesta(ji) = .TRUE. 
+             END IF
+          END IF
+          ! no precipitation-related pulse function
+       ELSE
+          pulse(ji) = un
+       END IF
+    END DO
+
+    !! 7.2 Calculation of NO basal emissions including pulse effect
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          !Tropical forests
+          IF ( is_tropical(jv) .AND. is_evergreen(jv) ) THEN
+             ! Wet soils
+             IF (humrel(ji,1) .GT. 0.3) THEN
+                flx_no_soil(ji,jv) = 2.6*pulse(ji)
+                ! Dry soils
+             ELSE
+                flx_no_soil(ji,jv) = 8.6*pulse(ji)
+             END IF
+             !Else If agricultural lands OR Wet soils
+          ELSE IF ( ( .NOT.(natural(jv)) ) .OR. ( humrel(ji,1) .GT. 0.3 ) ) THEN
+             ! Calculation of NO emissions depending of Temperature
+             IF (t_no(ji) .LT. zero) THEN
+                flx_no_soil(ji,jv) = zero
+             ELSE IF (t_no(ji) .LE. 10.) THEN
+                flx_no_soil(ji,jv) = 0.28*em_factor_no_wet(jv)*t_no(ji)*pulse(ji)
+             ELSE IF (t_no(ji) .LE. 30.) THEN
+                flx_no_soil(ji,jv) = em_factor_no_wet(jv)*exp(0.103*t_no(ji))*pulse(ji)
+             ELSE
+                flx_no_soil(ji,jv) = 21.97*em_factor_no_wet(jv)*pulse(ji)
+             END IF
+             !Else if Temp negative
+          ELSE IF (t_no(ji) .LT. zero) THEN
+             flx_no_soil(ji,jv) = zero
+             !Else if Temp <= 30
+          ELSE IF (t_no(ji) .LE. 30.) THEN
+             flx_no_soil(ji,jv) = (em_factor_no_dry(jv)*t_no(ji))/30.*pulse(ji)
+          ELSE
+             flx_no_soil(ji,jv) = em_factor_no_dry(jv)*pulse(ji)
+          END IF
+
+          !! 7.3 IF ACTIVATED (ok_bbgfertil_NOx = TRUE) calculation of NOx soil emission increase due to biomass burning
+          ! Calculation of Biomass-Burning-induced NOx emissions (Lathiere, 2005)
+          ! => NOx emissions 3-fold increase
+          IF (ok_bbgfertil_NOx) THEN
+             IF ( natural(jv) ) THEN
+                ! North Tropical zone from May to June
+                IF ((lalo(ji,1) .LE. 30. .AND. lalo(ji,1) .GE. zero).AND. &
+                     (julian_diff .GE. 121. .AND. julian_diff .LE. 181).AND.(flx_co2_bbg_year(ji) .GT. 0.1)) THEN
+                   flx_no_soil(ji,jv) = flx_no_soil(ji,jv)*3.
+                   ! South Tropical zone from November to December
+                ELSE IF ((lalo(ji,1) .GE. -30. .AND. lalo(ji,1) .LT. zero).AND.(julian_diff .GE. 305.).AND. & 
+                        (flx_co2_bbg_year(ji) .GT. 0.1)) THEN
+                   flx_no_soil(ji,jv) = flx_no_soil(ji,jv)*3.
+                END IF
+             END IF
+          END IF
+
+          !! 7.4 IF ACTIVATED (ok_cropsfertil_NOx = TRUE) calculation of NOx soil emission increase due to fertilizer use 
+          ! Calculation of N-fertiliser-induced NOx emissions
+          flx_fertil_no(ji,jv) = zero
+          IF (ok_cropsfertil_NOx) THEN
+             IF (veget_max_nowoody(ji) .NE. zero) THEN
+                ! Non-agricultural lands
+                IF ( (jv == ibare_sechiba) .OR. is_tree(jv) ) THEN
+                   N_qt_WRICE_pft(ji,jv) = zero
+                   N_qt_OTHER_pft(ji,jv) = zero
+                ! Grasslands or Croplands
+                ELSE
+                   N_qt_WRICE_pft(ji,jv) = N_qt_WRICE_year(ji)*veget_max(ji,jv)/veget_max_nowoody(ji)
+                   N_qt_OTHER_pft(ji,jv) = N_qt_OTHER_year(ji)*veget_max(ji,jv)/veget_max_nowoody(ji)
+                END IF
+             ELSE
+                N_qt_WRICE_pft(ji,jv) = zero
+                N_qt_OTHER_pft(ji,jv) = zero
+             END IF
+
+             ! North temperate regions from May to August
+             ! OR South Temperate regions from November to February
+             IF (((lalo(ji,1) .GT. 30.) .AND. (julian_diff .GE. 121. .AND. julian_diff .LE. 243.).AND. &
+                  (veget_max(ji,jv) .NE. zero)) .OR. &
+                  ((lalo(ji,1) .LT. -30.) .AND. (julian_diff .GE. 305. .OR. julian_diff .LE. 59.) .AND.&
+                  (veget_max(ji,jv) .NE. zero))) THEN
+                ! 1e12 for conversion from kg to Ng
+                ! 1/(365/12*24*60*60*4) for conversion from year to seconds corrected for 4 months of emissions
+                flx_fertil_no(ji,jv) = (N_qt_WRICE_pft(ji,jv)*(1/30.)+N_qt_OTHER_pft(ji,jv))*(2.5/100.) &
+                     & *1e12/(365*24*60*60*4/12)/(area2(ji)*veget_max(ji,jv))
+                ! OR Tropical regions all the year
+             ELSE IF ((lalo(ji,1) .GE. -30.).AND.(lalo(ji,1) .LE. 30.).AND.(veget_max(ji,jv) .NE. zero)) THEN
+                flx_fertil_no(ji,jv) = (N_qt_WRICE_pft(ji,jv)*(1/30.)+N_qt_OTHER_pft(ji,jv))*(2.5/100.) &
+                     & *1e12/(365*24*60*60)/(area2(ji)*veget_max(ji,jv))
+             END IF
+             flx_no_soil(ji,jv) = flx_no_soil(ji,jv) + flx_fertil_no(ji,jv)
+          END IF
+
+          !! 7.5 Calculation of net NO flux above soil accounting for surface deposition, 
+          !! based on the Canopy Reduction Factor (CRF), calculated using Leaf Area and Stomatal Area
+          !kc=cuticle absorptivity = 0.24m^2/m^2
+          !ks=stomatal absorptivity = 8.75m^2/m^2
+          !Larch=Larcher SAI/LAI ratio given in Larcher 1991
+          !> @codeinc
+          CRF(ji,jv) = (exp(-8.75*Larch(jv)*lai(ji,jv)) + exp(-0.24*lai(ji,jv)))/2.
+          flx_no(ji,jv) = flx_no_soil(ji,jv)*CRF(ji,jv)
+          !> @endcodeinc
+       END DO
+    END DO
+
+
+    ! Write output with XIOS
+    CALL xios_orchidee_send_field("PAR",PAR)
+    CALL xios_orchidee_send_field("flx_fertil_no",flx_fertil_no)
+    CALL xios_orchidee_send_field("flx_iso",flx_iso)
+    CALL xios_orchidee_send_field("flx_mono",flx_mono)
+    CALL xios_orchidee_send_field("flx_ORVOC",flx_ORVOC)
+    CALL xios_orchidee_send_field("flx_MBO",flx_MBO)
+    CALL xios_orchidee_send_field("flx_methanol",flx_methanol)
+    CALL xios_orchidee_send_field("flx_acetone",flx_acetone)
+    CALL xios_orchidee_send_field("flx_acetal",flx_acetal)
+    CALL xios_orchidee_send_field("flx_formal",flx_formal)
+    CALL xios_orchidee_send_field("flx_acetic",flx_acetic)
+    CALL xios_orchidee_send_field("flx_formic",flx_formic)
+    CALL xios_orchidee_send_field("flx_no_soil",flx_no_soil)
+    CALL xios_orchidee_send_field("flx_no",flx_no)
+    CALL xios_orchidee_send_field('flx_apinen'   , flx_apinen)
+    CALL xios_orchidee_send_field('flx_bpinen'   , flx_bpinen)
+    CALL xios_orchidee_send_field('flx_limonen'  ,flx_limonen)
+    CALL xios_orchidee_send_field('flx_myrcen'   , flx_myrcen)
+    CALL xios_orchidee_send_field('flx_sabinen'  ,flx_sabinen)
+    CALL xios_orchidee_send_field('flx_camphen'  ,flx_camphen)
+    CALL xios_orchidee_send_field('flx_3caren'   , flx_3caren)
+    CALL xios_orchidee_send_field('flx_tbocimen' ,flx_tbocimen)
+    CALL xios_orchidee_send_field('flx_othermono',flx_othermono)
+    CALL xios_orchidee_send_field('flx_sesquiter',flx_sesquiter)
+    CALL xios_orchidee_send_field("CRF",CRF)
+    CALL xios_orchidee_send_field('fco2', fco2)
+
+    IF ( ok_radcanopy ) THEN
+       CALL xios_orchidee_send_field("PARdf",PARdf)
+       CALL xios_orchidee_send_field("PARdr",PARdr)
+       
+       IF (ok_multilayer) THEN
+          CALL xios_orchidee_send_field("PARsuntab",PARsuntab)
+          CALL xios_orchidee_send_field("PARshtab",PARshtab)
+       ELSE
+          CALL xios_orchidee_send_field("PARsun",PARsun)
+          CALL xios_orchidee_send_field("PARsh",PARsh)
+          CALL xios_orchidee_send_field("laisun",laisun)
+          CALL xios_orchidee_send_field("laish",laish)
+       ENDIF
+    ENDIF
+
+    IF ( ok_bbgfertil_Nox ) THEN
+       CALL xios_orchidee_send_field("flx_co2_bbg_year",flx_co2_bbg_year)
+    END IF
+
+    IF ( ok_cropsfertil_Nox ) THEN
+       CALL xios_orchidee_send_field("N_qt_WRICE_year",N_qt_WRICE_year)
+       CALL xios_orchidee_send_field("N_qt_OTHER_year",N_qt_OTHER_year)
+    END IF
+    
+
+    ! Write output with IOIPSL
+    IF ( .NOT. almaoutput ) THEN
+
+       CALL histwrite_p(hist_id, 'PAR', kjit, PAR, kjpindex, index)
+       IF ( ok_radcanopy ) THEN
+          CALL histwrite_p(hist_id, 'laisun', kjit, laisun, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'laish', kjit, laish, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'Fdf', kjit, Fdf, kjpindex, index)
+          IF (ok_multilayer) THEN 
+             CALL histwrite_p(hist_id, 'PARsuntab', kjit, PARsuntab, kjpindex*(nlai+1), indexlai)
+             CALL histwrite_p(hist_id, 'PARshtab', kjit, PARshtab, kjpindex*(nlai+1), indexlai)
+          ELSE
+             CALL histwrite_p(hist_id, 'PARsun', kjit, PARsun, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist_id, 'PARsh', kjit, PARsh, kjpindex*nvm, indexveg)
+          END IF
+          CALL histwrite_p(hist_id, 'coszang', kjit, coszang, kjpindex, index)
+          CALL histwrite_p(hist_id, 'PARdf', kjit, PARdf, kjpindex, index)
+          CALL histwrite_p(hist_id, 'PARdr', kjit, PARdr, kjpindex, index)
+          CALL histwrite_p(hist_id, 'Trans', kjit, Trans, kjpindex, index)
+       END IF
+       CALL histwrite_p(hist_id, 'flx_fertil_no', kjit, flx_fertil_no, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'CRF', kjit, CRF, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'fco2', kjit, fco2, kjpindex*nvm, indexveg)
+
+       IF ( ok_bbgfertil_Nox ) THEN
+          CALL histwrite_p(hist_id, 'flx_co2_bbg_year', 1, flx_co2_bbg_year, kjpindex, index)
+       ENDIF
+       IF ( ok_cropsfertil_Nox ) THEN
+          CALL histwrite_p(hist_id, 'N_qt_WRICE_year', 1, N_qt_WRICE_year, kjpindex, index)
+          CALL histwrite_p(hist_id, 'N_qt_OTHER_year', 1, N_qt_OTHER_year, kjpindex, index)
+       ENDIF
+       CALL histwrite_p(hist_id, 'flx_iso', kjit, flx_iso, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_mono', kjit, flx_mono, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_apinen', kjit, flx_apinen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_bpinen', kjit, flx_bpinen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_limonen', kjit, flx_limonen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_myrcen', kjit, flx_myrcen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_sabinen', kjit, flx_sabinen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_camphen', kjit, flx_camphen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_3caren', kjit, flx_3caren, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_tbocimen', kjit, flx_tbocimen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_othermono', kjit, flx_othermono, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_sesquiter', kjit, flx_sesquiter, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_ORVOC', kjit, flx_ORVOC, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_MBO', kjit, flx_MBO, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_methanol', kjit, flx_methanol, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_acetone', kjit, flx_acetone, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_acetal', kjit, flx_acetal, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_formal', kjit, flx_formal, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_acetic', kjit, flx_acetic, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_formic', kjit, flx_formic, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_no_soil', kjit, flx_no_soil, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_no', kjit, flx_no, kjpindex*nvm, indexveg)
+       
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'PAR', kjit, PAR, kjpindex, index)
+          IF ( ok_radcanopy ) THEN
+             CALL histwrite_p(hist2_id, 'PARsun', kjit, PARsun, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'PARsh', kjit, PARsh, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'laisun', kjit, laisun, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'laish', kjit, laish, kjpindex*nvm, indexveg)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'flx_fertil_no', kjit, flx_fertil_no, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'CRF', kjit, CRF, kjpindex*nvm, indexveg)
+          IF ( ok_bbgfertil_Nox ) THEN
+             CALL histwrite_p(hist2_id, 'flx_co2_bbg_year', 1, flx_co2_bbg_year, kjpindex, index)
+          ENDIF
+          IF ( ok_cropsfertil_Nox ) THEN
+             CALL histwrite_p(hist2_id, 'N_qt_WRICE_year', 1, N_qt_WRICE_year, kjpindex, index)
+             CALL histwrite_p(hist2_id, 'N_qt_OTHER_year', 1, N_qt_OTHER_year, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'flx_iso', kjit, flx_iso, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_mono', kjit, flx_mono, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_apinen', kjit, flx_apinen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_bpinen', kjit, flx_bpinen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_limonen', kjit, flx_limonen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_myrcen', kjit, flx_myrcen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_sabinen', kjit, flx_sabinen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_camphen', kjit, flx_camphen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_3caren', kjit, flx_3caren, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_tbocimen', kjit, flx_tbocimen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_othermono', kjit, flx_othermono, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_sesquiter', kjit, flx_sesquiter, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_ORVOC', kjit, flx_ORVOC, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_MBO', kjit, flx_MBO, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_methanol', kjit, flx_methanol, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_acetone', kjit, flx_acetone, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_acetal', kjit, flx_acetal, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_formal', kjit, flx_formal, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_acetic', kjit, flx_acetic, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_formic', kjit, flx_formic, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_no_soil', kjit, flx_no_soil, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_no', kjit, flx_no, kjpindex*nvm, indexveg)
+       ENDIF
+    ENDIF
+
+    IF (printlev>=3) WRITE(numout,*) 'OK chemistry_bvoc'
+
+  END SUBROUTINE chemistry_bvoc
+
+!! ================================================================================================================================
+!! SUBROUTINE   : chemistry_flux_interface
+!!
+!>\BRIEF          This subroutine will give to the interface between inca model and orchidee model in sechiba all the flux ask by inca
+!!
+!! DESCRIPTION  : This subroutine allows the transfer of fluxes between surface and atmospheric chemistry. It is called from sechiba
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+
+ SUBROUTINE chemistry_flux_interface( field_out_names, fields_out, field_in_names, fields_in)
+
+     !
+     ! Optional arguments
+     !
+     ! Names and fields for emission variables : to be transport by Orchidee to Inca
+     CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_out_names
+     REAL(r_std),DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: fields_out
+     !
+     ! Names and fields for deposit variables : to be transport from chemistry model by INCA to ORCHIDEE.
+     CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_in_names
+     REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN)    :: fields_in
+     !
+     ! Number of fields to give (nb_fields_out) or get from (nb_fields_in) INCA :
+     INTEGER(i_std), SAVE   :: nb_fields_out, nb_fields_in
+!$OMP THREADPRIVATE(nb_fields_out, nb_fields_in)
+
+     ! Id of fields to give (nb_fields_out) or get from (nb_fields_in) INCA :
+     INTEGER(i_std)  :: i_fields_out, i_fields_in
+
+     IF (l_first_chemistry_inca) THEN
+
+        ! il faut verifier que ok_bvoc (chemistry_ok_bvoc) est bien active sinon on arrete tout
+        if (.not.ok_bvoc) then 
+          CALL ipslerr_p (3,'chemistry_inca', &
+            &          'you need to activate chemistry_ok_bvoc in orchidee.def',&
+            &          'This model won''t be able to continue.', &
+            &          '')
+        endif
+
+        ! Prepare fieds out/in for interface with INCA.
+        IF (PRESENT(field_out_names)) THEN
+           nb_fields_out=SIZE(field_out_names)
+        ELSE
+           nb_fields_out=0
+        ENDIF
+
+        IF (PRESENT(field_in_names)) THEN
+           nb_fields_in=SIZE(field_in_names)
+        ELSE
+           nb_fields_in=0
+        ENDIF
+        l_first_chemistry_inca = .FALSE.
+
+     ENDIF
+
+ 
+     IF (ok_bvoc) THEN 
+        ! Fields for deposit variables : to be transport from chemistry model by INCA to ORCHIDEE.
+        DO i_fields_in=1,nb_fields_in
+           SELECT CASE(TRIM(field_in_names(i_fields_in)))
+           CASE DEFAULT 
+              CALL ipslerr_p (3,'chemistry_inca', &
+                   &          'You ask in INCA an unknown field '//TRIM(field_in_names(i_fields_in))//&
+                   &          ' to give to ORCHIDEE for this specific version.',&
+                   &          'This model won''t be able to continue.', &
+                   &          '(check your tracer parameters in INCA)')
+           END SELECT
+        ENDDO
+        
+        ! Fields for Biogenic emissions : to be transport by Orchidee to Inca
+        DO i_fields_out=1,nb_fields_out
+           SELECT CASE(TRIM(field_out_names(i_fields_out)))
+           CASE("flx_iso") 
+              fields_out(:,:,i_fields_out)=flx_iso(:,:)
+           CASE("flx_mono") 
+              fields_out(:,:,i_fields_out)=flx_mono(:,:)
+           CASE("flx_ORVOC") 
+              fields_out(:,:,i_fields_out)=flx_ORVOC(:,:)
+           CASE("flx_MBO") 
+              fields_out(:,:,i_fields_out)=flx_MBO(:,:)
+           CASE("flx_methanol") 
+              fields_out(:,:,i_fields_out)=flx_methanol(:,:)
+           CASE("flx_acetone") 
+              fields_out(:,:,i_fields_out)=flx_acetone(:,:)
+           CASE("flx_acetal") 
+              fields_out(:,:,i_fields_out)=flx_acetal(:,:)
+           CASE("flx_formal") 
+              fields_out(:,:,i_fields_out)=flx_formal(:,:)
+           CASE("flx_acetic") 
+              fields_out(:,:,i_fields_out)=flx_acetic(:,:)
+           CASE("flx_formic") 
+              fields_out(:,:,i_fields_out)=flx_formic(:,:)
+           CASE("flx_no_soil") 
+              fields_out(:,:,i_fields_out)=flx_no_soil(:,:)
+           CASE("flx_nox") 
+              fields_out(:,:,i_fields_out)=flx_no(:,:)
+           CASE("flx_fertil_no") 
+              fields_out(:,:,i_fields_out)=flx_fertil_no(:,:)
+           CASE("flx_apinen")
+              fields_out(:,:,i_fields_out)=flx_apinen(:,:)
+           CASE("flx_bpinen")
+              fields_out(:,:,i_fields_out)=flx_bpinen(:,:)
+           CASE("flx_limonen")
+              fields_out(:,:,i_fields_out)=flx_limonen(:,:)
+           CASE("flx_myrcen")
+              fields_out(:,:,i_fields_out)=flx_myrcen(:,:)
+           CASE("flx_sabinen")
+              fields_out(:,:,i_fields_out)=flx_sabinen(:,:)
+           CASE("flx_camphen")
+              fields_out(:,:,i_fields_out)=flx_camphen(:,:)
+           CASE("flx_3caren")
+              fields_out(:,:,i_fields_out)=flx_3caren(:,:)
+           CASE("flx_tbocimen")
+              fields_out(:,:,i_fields_out)=flx_tbocimen(:,:)
+           CASE("flx_othermono")
+              fields_out(:,:,i_fields_out)=flx_othermono(:,:)
+           CASE("flx_sesquiter")
+              fields_out(:,:,i_fields_out)=flx_sesquiter(:,:)
+              
+           CASE DEFAULT 
+              CALL ipslerr_p (3,'chemistry_inca', &
+                   &          'You ask from INCA an unknown field '//TRIM(field_out_names(i_fields_out))//&
+                   &          ' to ORCHIDEE for this specific version.',&
+                   &          'This model won''t be able to continue.', &
+                   &          '(check your tracer parameters in INCA)')
+           END SELECT
+        ENDDO
+        
+     ENDIF
+   END SUBROUTINE chemistry_flux_interface
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : chemistry_clear
+!!
+!>\BRIEF          Clear chemistry module
+!!
+!! DESCRIPTION  : Deallocate memory and reset initialization variables to there original values
+!!
+!_ ================================================================================================================================
+
+   SUBROUTINE chemistry_clear
+
+     !! 1. Initialize as for first run
+     l_first_chemistry_inca = .TRUE.
+     
+     !! 2. Deallocate dynamic variables
+     IF (ALLOCATED(pulse)) DEALLOCATE (pulse)
+     IF (ALLOCATED (ok_siesta)) DEALLOCATE (ok_siesta) 
+     IF (ALLOCATED (allow_pulse)) DEALLOCATE (allow_pulse)
+     IF (ALLOCATED (pulseday)) DEALLOCATE (pulseday)
+     IF (ALLOCATED (siestaday)) DEALLOCATE (siestaday)
+     IF (ALLOCATED (pulselim)) DEALLOCATE (pulselim)
+     IF (ALLOCATED (siestalim)) DEALLOCATE (siestalim)
+     IF (ALLOCATED (area2)) DEALLOCATE (area2)
+     IF (ALLOCATED (N_qt_WRICE_year)) DEALLOCATE (N_qt_WRICE_year)
+     IF (ALLOCATED (N_qt_OTHER_year)) DEALLOCATE (N_qt_OTHER_year)
+     IF (ALLOCATED (flx_iso)) DEALLOCATE (flx_iso)
+     IF (ALLOCATED (flx_mono)) DEALLOCATE (flx_mono)
+     IF (ALLOCATED (flx_ORVOC)) DEALLOCATE (flx_ORVOC)
+     IF (ALLOCATED (flx_MBO)) DEALLOCATE (flx_MBO)
+     IF (ALLOCATED (flx_methanol)) DEALLOCATE (flx_methanol)
+     IF (ALLOCATED (flx_acetone)) DEALLOCATE (flx_acetone)
+     IF (ALLOCATED (flx_acetal)) DEALLOCATE (flx_acetal)
+     IF (ALLOCATED (flx_formal)) DEALLOCATE (flx_formal)
+     IF (ALLOCATED (flx_acetic)) DEALLOCATE (flx_acetic)
+     IF (ALLOCATED (flx_formic)) DEALLOCATE (flx_formic)
+     IF (ALLOCATED (flx_no_soil)) DEALLOCATE (flx_no_soil)
+     IF (ALLOCATED (flx_no)) DEALLOCATE (flx_no)
+     IF (ALLOCATED (flx_fertil_no)) DEALLOCATE (flx_fertil_no)
+     IF (ALLOCATED (flx_apinen)) DEALLOCATE (flx_apinen)
+     IF (ALLOCATED (flx_bpinen)) DEALLOCATE (flx_bpinen)
+     IF (ALLOCATED (flx_limonen)) DEALLOCATE (flx_limonen)
+     IF (ALLOCATED (flx_myrcen)) DEALLOCATE (flx_myrcen)
+     IF (ALLOCATED (flx_sabinen)) DEALLOCATE (flx_sabinen)
+     IF (ALLOCATED (flx_camphen)) DEALLOCATE (flx_camphen)
+     IF (ALLOCATED (flx_3caren)) DEALLOCATE (flx_3caren)
+     IF (ALLOCATED (flx_tbocimen)) DEALLOCATE (flx_tbocimen)
+     IF (ALLOCATED (flx_othermono)) DEALLOCATE (flx_othermono)
+     IF (ALLOCATED (flx_sesquiter)) DEALLOCATE (flx_sesquiter)
+     IF (ALLOCATED (CRF)) DEALLOCATE (CRF)
+     IF (ALLOCATED (flx_co2_bbg_year)) DEALLOCATE (flx_co2_bbg_year)
+
+   END SUBROUTINE chemistry_clear
+   
+END MODULE chemistry
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/condveg.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/condveg.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/condveg.f90	(revision 6412)
@@ -0,0 +1,1552 @@
+! ===============================================================================================================================
+! 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. :: rough_dyn to choose between two methods to calculate 
+!!    the roughness height. If set to false: the roughness height is 
+!!    calculated by the old formulation which does not distinguish between 
+!!    z0m and z0h and which does not vary with LAI. If set to true: the 
+!!    grid average is calculated by the formulation proposed by Su et al. (2001)
+!! 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): Added option rough_dyn and subroutine condveg_z0cdrag_dyn. Removed 
+!!                   subroutine condveg_z0logz. June 2016.
+!!                   The condveg_albedo scheme has been replaced by albedo_two_stream, 
+!!                   developed for the DOFOCO branch. The albedo_two_steam is contained
+!!                   in albedo.f90 module.
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE condveg
+
+  USE ioipsl
+  USE xios_orchidee
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE qsat_moisture
+  USE interpol_help
+  USE mod_orchidee_para
+  USE ioipsl_para 
+  USE sechiba_io_p
+  USE albedo
+  USE slowproc
+  USE grid
+  USE function_library, ONLY: cc_to_lai, biomass_to_lai, wood_to_qmheight
+
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: condveg_main, condveg_initialize, condveg_finalize, condveg_clear 
+
+  !
+  ! Variables used inside condveg module
+  !
+  LOGICAL, SAVE                :: l_first_condveg=.TRUE.              !! To keep first call's trace
+!$OMP THREADPRIVATE(l_first_condveg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: soilalb_dry    !! Albedo values for the dry bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_dry)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: soilalb_wet    !! Albedo values for the wet bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_wet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: soilalb_moy    !! Albedo values for the mean bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_moy)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: bckgrnd_alb     !! Albedo values for the background bare soil (unitless)
+!$OMP THREADPRIVATE(bckgrnd_alb)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)      :: albedo_snow    !! Mean snow albedo over visible and near-infrared 
+                                                                      !! range !(unitless) 
+!$OMP THREADPRIVATE(albedo_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)      :: albedo_glob    !! Mean surface albedo over visible and 
+                                                                      !!near-infrared range (unitless)
+  
+CONTAINS
+
+!!  =============================================================================================================================
+!! SUBROUTINE		 		    : condveg_initialize
+!!
+!>\BRIEF			            Allocate module variables, read from restart file or initialize with default values
+!!
+!! DESCRIPTION			    : Allocate module variables, read from restart file or initialize with default values.
+!!                                          condveg_snow is called to initialize corresponding variables.
+!!
+!! RECENT CHANGE(S)			    : None
+!!
+!! MAIN OUTPUT VARIABLE(S)
+!!
+!! REFERENCE(S)			            : None
+!! 
+!! FLOWCHART                                : None
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE condveg_initialize (kjit, kjpindex, index, rest_id, &
+       lalo, neighbours, resolution, contfrac, veget, veget_max, frac_nobio, totfrac_nobio, &
+       zlev, snow, snow_age, snow_nobio, snow_nobio_age, &
+       drysoil_frac, height, snowdz, snowrho, tot_bare_soil, &
+       temp_air, pb, u, v, &
+       circ_class_biomass, circ_class_n, & 
+       emis, albedo, z0m, z0h, roughheight, &
+       frac_snow_veg,frac_snow_nobio, &
+       coszang, &
+       Isotrop_Abs_Tot_p, Isotrop_Tran_Tot_p, laieff_fit, albedo_pft, &
+       Collim_Abs_Tot, Collim_Alb_Tot, laieff_collim, laieff_isotrop)
+    
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables  
+    INTEGER(i_std), INTENT(in)                       :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                       :: kjpindex         !! Domain size
+    INTEGER(i_std),INTENT (in)                       :: rest_id          !! _Restart_ file identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index            !! Indeces of the points on the map
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)  :: lalo             !! Geographical coordinates
+    INTEGER(i_std),DIMENSION (kjpindex,NbNeighb), INTENT(in):: neighbours!! neighoring grid points if land
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)  :: resolution       !! size in x an y of the grid (m)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)    :: contfrac         ! Fraction of land in each grid box.
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: veget            !! Fraction of vegetation types
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: veget_max        !! Fraction of vegetation type
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: frac_nobio    !! Fraction of continental ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: totfrac_nobio    !! total fraction of continental ice+lakes+...
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)    :: zlev             !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: snow             !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: snow_age         !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio    !! Snow mass [Kg/m^2] on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio_age   !! Snow age on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: drysoil_frac     !! Fraction of visibly Dry soil(between 0 and 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: height           !! Vegetation Height (m)
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in):: snowdz           !! Snow depth at each snow layer
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in):: snowrho          !! Snow density at each snow layer
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)    :: tot_bare_soil    !! Total evaporating bare soil fraction 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)       :: temp_air         !! Air temperature
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)     :: pb               !! Surface pressure (hPa)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)       :: u                !! Horizontal wind speed, u direction 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)       :: v                !! Horizontal wind speed, v direction
+                                                                         !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)    :: circ_class_biomass !! Biomass per circumference class
+                                                                           !!@tex $(gC tree^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)        :: circ_class_n     !! Number of trees within each circumference
+                                                                         !! class (@tex $(trees.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)     :: coszang          !! the cosine of the solar zenith angle (unitless)
+    TYPE(laieff_type),DIMENSION (:,:,:),INTENT(in)   :: laieff_fit       !! Fitted parameters for the effective LAI
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: emis             !! Emissivity
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out) :: albedo           !! Albedo, vis(1) and nir(2)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: z0m              !! Roughness for momentum (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: z0h              !! Roughness for heat (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: roughheight      !! Effective height for roughness
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)    :: frac_snow_veg    !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(out):: frac_snow_nobio  !! Snow cover fraction on non-vegeted area
+    REAL(r_std),DIMENSION (:,:,:), INTENT (out)      :: Isotrop_Abs_Tot_p!! Absorbed radiation per level for photosynthesis
+    REAL(r_std),DIMENSION (:,:,:), INTENT (out)      :: Isotrop_Tran_Tot_p !! Transmitted radiation per level for photosynthesis
+    REAL(r_std), DIMENSION(kjpindex,nvm,n_spectralbands), &
+                                    INTENT (out)     :: albedo_pft       !! Albedo (two stream radiation transfer model)
+                                                                         !! for visible and near-infrared range
+                                                                         !! for each PFTi (unitless)
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION(:), INTENT(inout)          :: Collim_Abs_Tot !! collimated total absorption for a given level
+    REAL(r_std),DIMENSION(:), INTENT(inout)          :: Collim_Alb_Tot !! Collimated (direct) total albedo for a given level
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: laieff_collim  !! Leaf Area Index Effective for direct light
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: laieff_isotrop !! Leaf Area Index Effective converts
+                                                                       !! 3D lai inot 1D lai for two steam
+                                                                       !! radiation transfer model...this is for 
+                                                                       !! isotropic light and only calculated once per day
+                                                                       !! @tex $(m^{2} m^{-2})$ @endtex
+
+    !! 0.4 Local variables   
+    INTEGER                                          :: ier
+    INTEGER                                          :: ji,jv
+    REAL(r_std), DIMENSION(kjpindex,2)               :: alb_bare         !! Mean bare soil albedo for visible and near-infrared 
+                                                                         !! range (unitless) 
+    REAL(r_std), DIMENSION(kjpindex,nvm)             :: lai              !! Leaf area index (m2[leaf]/m2[ground])
+!_ ================================================================================================================================
+  
+    IF (.NOT. l_first_condveg) CALL ipslerr_p(3,'condveg_initialize','Error: initialization already done','','')
+    l_first_condveg=.FALSE.
+
+    !! Initialize local printlev
+    !printlev_loc=get_printlev('condveg')    
+
+    IF (printlev>=3) WRITE (numout,*) 'Start condveg_initialize'
+    
+    !! 0. Calculate LAI from biomass. 
+    ! This is done to prevent passing an incorrect
+    ! LAI around, since LAI is diagnostic.
+    ! We can't do this if we use an LAI map! So this breaks DO_STOMATE=N
+    lai(:,ibare_sechiba) = zero
+    DO ji = 1, kjpindex 
+       DO jv = 1, nvm
+          lai(ji,jv) = cc_to_lai(circ_class_biomass(ji,jv,:,ileaf,icarbon),circ_class_n(ji,jv,:),jv)
+       ENDDO
+    ENDDO
+
+    !! 1. Allocate module variables and read from restart or initialize
+
+    IF (alb_bg_modis) THEN
+       ! Allocate background soil albedo
+       ALLOCATE (bckgrnd_alb(kjpindex,2),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for bckgrnd_alb','','')
+       bckgrnd_alb(:,:) = val_exp
+ 
+       ! Read background albedo from restart file
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Background soil albedo for visible and near-infrared range')
+       CALL restget_p (rest_id, 'soilalbedo_bg', nbp_glo, 2, 1, kjit, .TRUE., bckgrnd_alb, "gather", nbp_glo, index_g)
+       
+       ! Initialize by interpolating from file if the variable was not in restart file
+
+       IF ( ALL(bckgrnd_alb(:,:) == val_exp) ) THEN
+          CALL read_background_albedo(kjpindex, lalo, neighbours, resolution, contfrac)
+       END IF
+       CALL xios_orchidee_send_field("bckgrnd_alb",bckgrnd_alb)
+
+    ENDIF   
+
+    ! Dry soil albedo
+    ALLOCATE (soilalb_dry(kjpindex,2),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for soilalb_dry','','')
+    soilalb_dry(:,:) = val_exp
+
+    ! Wet soil albedo
+    ALLOCATE (soilalb_wet(kjpindex,2),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for soilalb_wet','','')
+    soilalb_wet(:,:) = val_exp
+
+    ! Mean soil albedo
+    ALLOCATE (soilalb_moy(kjpindex,2),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for soilalb_moy','','')
+    soilalb_moy(:,:) = val_exp
+
+    ! Snow albedo of vegetative PFTs
+    ALLOCATE (albedo_snow(kjpindex),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'condveg_initialize','Pb in allocation for albedo_snow','','')
+    albedo_snow(:) = val_exp
+
+    ! Mean vegetation albedo over visible and near-infrared range 
+    ALLOCATE (albedo_glob(kjpindex),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'condveg_initialize','Pb in allocation for albedo_glob','','')
+    albedo_glob(:) = val_exp
+
+    !! Read variables from restart file or initialize them
+    ! dry soil albedo
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Dry bare soil albedo')
+    CALL restget_p (rest_id,'soilalbedo_dry' , nbp_glo, 2, 1, kjit, .TRUE., soilalb_dry, "gather", nbp_glo, index_g)
+
+    ! wet soil albedo
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Wet bare soil albedo')
+    CALL restget_p (rest_id, 'soilalbedo_wet', nbp_glo, 2, 1, kjit, .TRUE., soilalb_wet, "gather", nbp_glo, index_g)
+
+    ! mean soil aledo
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Mean bare soil albedo')
+    CALL restget_p (rest_id, 'soilalbedo_moy', nbp_glo, 2, 1, kjit, .TRUE., soilalb_moy, "gather", nbp_glo, index_g)
+
+    ! Initialize the variables if not found in restart file
+    IF ( ALL(soilalb_wet(:,:) == val_exp) .OR. &
+         ALL(soilalb_dry(:,:) == val_exp) .OR. &
+         ALL(soilalb_moy(:,:) == val_exp)) THEN
+       ! One or more of the variables were not in the restart file. 
+       ! Call routine condveg_soilalb to calculate them.
+       CALL condveg_soilalb(kjpindex, lalo, neighbours, resolution, contfrac)
+       WRITE(numout,*) '---> val_exp ', val_exp
+       WRITE(numout,*) '---> ALBEDO_wet VIS:', MINVAL(soilalb_wet(:,ivis)), MAXVAL(soilalb_wet(:,ivis))
+       WRITE(numout,*) '---> ALBEDO_wet NIR:', MINVAL(soilalb_wet(:,inir)), MAXVAL(soilalb_wet(:,inir))
+       WRITE(numout,*) '---> ALBEDO_dry VIS:', MINVAL(soilalb_dry(:,ivis)), MAXVAL(soilalb_dry(:,ivis))
+       WRITE(numout,*) '---> ALBEDO_dry NIR:', MINVAL(soilalb_dry(:,inir)), MAXVAL(soilalb_dry(:,inir))
+       WRITE(numout,*) '---> ALBEDO_moy VIS:', MINVAL(soilalb_moy(:,ivis)), MAXVAL(soilalb_moy(:,ivis))
+       WRITE(numout,*) '---> ALBEDO_moy NIR:', MINVAL(soilalb_moy(:,inir)), MAXVAL(soilalb_moy(:,inir))
+    ENDIF
+
+    ! z0m
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Roughness for momentum')
+    CALL restget_p (rest_id, 'z0m', nbp_glo, 1, 1, kjit, .TRUE., z0m, "gather", nbp_glo, index_g)
+
+    ! z0h
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Roughness for heat')
+    CALL restget_p (rest_id, 'z0h', nbp_glo, 1, 1, kjit, .TRUE., z0h, "gather", nbp_glo, index_g)
+
+    ! roughness height
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Roughness height')
+    CALL restget_p (rest_id, 'roughheight', nbp_glo, 1, 1, kjit, .TRUE., roughheight, "gather", nbp_glo, index_g)
+
+    !! Initialize emissivity
+    IF ( impaze ) THEN
+       ! Use parameter CONDVEG_EMIS from run.def
+       emis(:) = emis_scal
+    ELSE
+       ! Set emissivity to 1.
+       emis_scal = un
+       emis(:) = emis_scal
+    ENDIF
+
+
+    !! 3. Calculate the fraction of snow on vegetation and nobio
+    CALL condveg_frac_snow(kjpindex, snow, snow_nobio, snowrho, snowdz, &
+       frac_snow_veg, frac_snow_nobio, z0m)
+
+    !! 4. Calculate roughness height if it was not found in the restart file
+    IF ( ALL(z0m(:) == val_exp) .OR. ALL(z0h(:) == val_exp) .OR. ALL(roughheight(:) == val_exp)) THEN
+       !! Calculate roughness height
+       ! Chooses between two methods to calculate the grid average of the 
+       ! roughness. If impaze set to true:  The grid average is calculated by 
+       ! averaging the drag coefficients over PFT. If impaze set to false: 
+       ! The grid average is calculated by averaging the logarithm of the 
+       ! roughness length per PFT.
+       IF ( impaze ) THEN
+          ! Use parameter CONDVEG_Z0 and ROUGHHEIGHT from run.def
+          z0m(:) = z0_scal
+          z0h(:) = z0_scal
+          roughheight(:) = roughheight_scal
+       ELSE
+          ! Caluculate roughness height
+          IF( rough_dyn ) THEN
+             CALL condveg_z0cdrag_dyn(kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, zlev, &
+                  &               height, temp_air, pb, u, v, lai, frac_snow_veg, z0m, z0h, roughheight)
+          ELSE
+             CALL condveg_z0cdrag(kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, zlev, &
+                  height, tot_bare_soil, z0m, z0h, roughheight)
+          ENDIF
+       END IF
+    END IF
+
+    !! 5. Calculate albedo
+         
+    ! We need to initialize albedo here to give a realistic guess to 
+    ! the coupled model.
+    CALL albedo_two_stream(kjpindex, drysoil_frac, veget_max, &
+                 coszang, soilalb_dry, soilalb_wet, frac_nobio, soilalb_moy, &
+                 bckgrnd_alb, alb_bare, albedo, snow, snow_age, snow_nobio, &
+                 snow_nobio_age, albedo_snow, albedo_glob, &
+                 circ_class_biomass, circ_class_n, &
+                 z0m, Isotrop_Abs_Tot_p, Isotrop_Tran_Tot_p, &
+                 laieff_fit, albedo_pft, frac_snow_veg, frac_snow_nobio, &
+                 Collim_Abs_Tot, Collim_Alb_Tot, laieff_collim, laieff_isotrop)
+
+    IF (printlev>=3) WRITE (numout,*) 'condveg_initialize done '
+    
+  END SUBROUTINE condveg_initialize
+
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_main
+!!
+!>\BRIEF        Calls the subroutines update the variables for current time step
+!!
+!!
+!! MAIN OUTPUT VARIABLE(S):  emis (emissivity), albedo (albedo of 
+!! vegetative PFTs in visible and near-infrared range), z0 (surface roughness height),
+!! roughheight (grid effective roughness height), soil type (fraction of soil types) 
+!! 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!!
+!! REVISION(S)  : None
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_main (kjit, kjpindex, index, rest_id, hist_id, hist2_id, &
+       lalo, neighbours, resolution, contfrac, veget, veget_max, frac_nobio, totfrac_nobio, &
+       zlev, snow, snow_age, snow_nobio, snow_nobio_age, &
+       drysoil_frac, height, snowdz, snowrho, tot_bare_soil, &
+       Temp_air, pb, u, v, circ_class_biomass, circ_class_n,& 
+       emis, albedo, z0m, z0h, roughheight, &
+       frac_snow_veg, frac_snow_nobio, coszang, &
+       Isotrop_Abs_Tot_p, Isotrop_Tran_Tot_p, laieff_fit, albedo_pft, &
+       Collim_Abs_Tot, Collim_Alb_Tot, laieff_collim, laieff_isotrop )
+
+     !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables  
+
+    INTEGER(i_std), INTENT(in)                       :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                       :: kjpindex         !! Domain size
+    INTEGER(i_std),INTENT (in)                       :: rest_id          !! _Restart_ file identifier
+    INTEGER(i_std),INTENT (in)                       :: hist_id          !! _History_ file identifier
+    INTEGER(i_std), OPTIONAL, INTENT (in)            :: hist2_id          !! _History_ file 2 identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index            !! Indeces of the points on the map
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)  :: lalo             !! Geographical coordinates
+    INTEGER(i_std),DIMENSION (kjpindex,NbNeighb), INTENT(in):: neighbours!! neighoring grid points if land
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)  :: resolution       !! size in x an y of the grid (m)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)    :: contfrac         ! Fraction of land in each grid box.
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: veget            !! Fraction of vegetation types
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: veget_max        !! Fraction of vegetation type
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: frac_nobio    !! Fraction of continental ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: totfrac_nobio    !! total fraction of continental ice+lakes+...
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)    :: zlev             !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: snow             !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: snow_age         !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio    !! Snow mass [Kg/m^2] on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio_age   !! Snow age on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: drysoil_frac     !! Fraction of visibly Dry soil(between 0 and 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: height           !! Vegetation Height (m)
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in):: snowdz           !! Snow depth at each snow layer
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in):: snowrho          !! Snow density at each snow layer
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)    :: tot_bare_soil    !! Total evaporating bare soil fraction 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)       :: temp_air         !! Air temperature
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)     :: pb               !! Surface pressure (hPa)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)       :: u                !! Horizontal wind speed, u direction 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)       :: v                !! Horizontal wind speed, v direction
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: coszang          !! the cosine of the solar enith angle (unitless)
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)    :: circ_class_biomass !! Biomass per circumference class
+                                                                           !! @tex $(gC tree^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)        :: circ_class_n     !! Number of trees within each circumference
+                                                                         !! class @tex $(trees.m^{-2})$ @endtex
+    TYPE(laieff_type),DIMENSION (:,:,:),INTENT(in)   :: laieff_fit       !!Fitted parameters for the effective LAI
+
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: emis             !! Emissivity
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out) :: albedo           !! Albedo, vis(1) and nir(2)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: z0m              !! Roughness for momentum (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: z0h              !! Roughness for heat (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: roughheight      !! Effective height for roughness
+    REAL(r_std),DIMENSION (:,:,:), &
+                                      INTENT (out)   :: Isotrop_Abs_Tot_p !!Absorbed radiation per level for photosynthesis
+    REAL(r_std),DIMENSION (:,:,:), &
+                                      INTENT (out)   :: Isotrop_Tran_Tot_p !!Transmitted radiation per level for photosynthesis
+    REAL(r_std), DIMENSION(kjpindex,nvm,n_spectralbands), &
+                                      INTENT (out)   :: albedo_pft       !! Albedo (two stream radiation transfer model)
+                                                                         !! for visible and near-infrared range 
+                                                                         !! for each PFT (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)    :: frac_snow_veg    !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(out):: frac_snow_nobio  !! Snow cover fraction on non-vegeted area
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION(:), INTENT(inout)          :: Collim_Abs_Tot   !! Collimated total absorption for a given level
+    REAL(r_std),DIMENSION(:), INTENT(inout)          :: Collim_Alb_Tot   !! Collimated (direct) total albedo for a given level
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: laieff_collim    !! Leaf Area Index Effective for direct light
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: laieff_isotrop   !! Leaf Area Index Effective converts
+                                                                         !! 3D lai into 1D lai for two stream
+                                                                         !! radiation transfer model...this is for
+                                                                         !! isotropic light and only calculated once per day
+                                                                         !! @tex $(m^{2} m^{-2})$ @endtex
+
+    !! 0.4 Local variables 
+    CHARACTER(LEN=80)                                :: var_name         !! To store variables names for I/O  
+    REAL(r_std), DIMENSION(kjpindex,2)               :: alb_bare         !! Mean bare soil albedo for visible and near-infrared 
+                                                                         !! range (unitless) 
+    REAL(r_std), DIMENSION(kjpindex,nvm)             :: lai              !! Leaf area index (m2[leaf]/m2[ground])
+    INTEGER(i_std)                                   :: ji,ilevel,ivm
+!_ ================================================================================================================================
+  
+    !! Initialize local printlev
+    !printlev_loc=get_printlev('condveg')
+
+    !! 0. Calculate LAI from biomass. 
+    ! This is done to prevent passing an incorrect
+    ! LAI around, since LAI is diagnostic.
+    ! We can't do this if we use an LAI map! So this breaks DO_STOMATE=N
+    lai(:,ibare_sechiba) = zero
+    DO ji = 1, kjpindex
+       DO ivm = 1, nvm
+          lai(ji,ivm) = cc_to_lai(circ_class_biomass(ji,ivm,:,ileaf,icarbon),circ_class_n(ji,ivm,:),ivm)
+       ENDDO
+    ENDDO
+
+    !! 1. Calculate the fraction of snow on vegetation and nobio
+    CALL condveg_frac_snow(kjpindex, snow, snow_nobio, snowrho, snowdz, &
+            frac_snow_veg, frac_snow_nobio, z0m)
+
+    !! 2. Calculate emissivity
+    emis(:) = emis_scal
+    
+    !! 3. Calculate roughness height
+    ! If TRUE read in prescribed values for roughness height
+    IF ( impaze ) THEN
+
+       DO ji = 1, kjpindex
+         z0m(ji) = z0_scal
+         z0h(ji) = z0_scal
+         roughheight(ji) = roughheight_scal
+      ENDDO
+
+    ELSE
+
+       ! Calculate roughness height
+       IF ( rough_dyn ) THEN
+          CALL condveg_z0cdrag_dyn (kjpindex, veget, veget_max, &
+               frac_nobio, totfrac_nobio, zlev, height, &
+               temp_air, pb, u, v, lai, frac_snow_veg, &
+               z0m, z0h, roughheight)
+       ELSE
+          CALL condveg_z0cdrag (kjpindex, veget, veget_max, &
+               frac_nobio, totfrac_nobio, zlev, &
+               height, tot_bare_soil, z0m, z0h, roughheight)
+       ENDIF
+     
+    ENDIF ! impaze
+
+
+    !! 4. Calculate albedo    
+    CALL albedo_two_stream(kjpindex, drysoil_frac, veget_max, &
+         coszang, soilalb_dry, soilalb_wet, frac_nobio, soilalb_moy, &
+         bckgrnd_alb, alb_bare, albedo, snow, snow_age, snow_nobio, &
+         snow_nobio_age, albedo_snow, albedo_glob, &
+         circ_class_biomass, circ_class_n,&
+         z0m, Isotrop_Abs_Tot_p, Isotrop_Tran_Tot_p, &
+         laieff_fit, albedo_pft, frac_snow_veg, frac_snow_nobio, &
+         Collim_Abs_Tot, Collim_Alb_Tot, laieff_collim, laieff_isotrop)
+
+    ! Debug
+    IF(printlev >= 4)THEN
+       DO ivm = 1,nvm
+          WRITE(numout,*) 'laieff_isotrop condveg_main for ivm', &
+              ivm,'is', laieff_isotrop(:,:,ivm)
+       ENDDO
+    ENDIF
+    !-
+
+    !! 5. Output diagnostics
+    IF (.NOT. impaze) THEN
+       CALL xios_orchidee_send_field("soilalb_vis",alb_bare(:,1))
+       CALL xios_orchidee_send_field("soilalb_nir",alb_bare(:,2))
+    END IF
+    CALL xios_orchidee_send_field("albedo_vis",albedo(:,1))
+    CALL xios_orchidee_send_field("albedo_nir",albedo(:,2))
+    CALL xios_orchidee_send_field("albedo_snow",(albedo_snow(:)))
+    
+    IF ( almaoutput ) THEN
+       CALL histwrite_p(hist_id, 'Albedo', kjit, (albedo(:,1) + albedo(:,2))/2, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SAlbedo', kjit, albedo_snow(:), kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'Albedo', kjit, (albedo(:,1) + albedo(:,2))/2, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SAlbedo', kjit, albedo_snow(:), kjpindex, index)
+
+       ENDIF
+    ELSE
+       IF (.NOT. impaze) THEN
+          CALL histwrite_p(hist_id, 'soilalb_vis', kjit, alb_bare(:,1), kjpindex, index)
+          CALL histwrite_p(hist_id, 'soilalb_nir', kjit, alb_bare(:,2), kjpindex, index)
+          IF ( hist2_id > 0 ) THEN
+             CALL histwrite_p(hist2_id, 'soilalb_vis', kjit, alb_bare(:,1), kjpindex, index)
+             CALL histwrite_p(hist2_id, 'soilalb_nir', kjit, alb_bare(:,2), kjpindex, index)
+          ENDIF
+       END IF
+    ENDIF
+
+    IF (printlev>=3) WRITE (numout,*)' condveg_main done '
+
+  END SUBROUTINE condveg_main
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : condveg_finalize
+  !!
+  !>\BRIEF                                    Write to restart file
+  !!
+  !! DESCRIPTION			    : This subroutine writes the module variables and variables calculated in condveg
+  !!                                          to restart file
+  !!
+  !! RECENT CHANGE(S)			    : None
+  !!
+  !! REFERENCE(S)			    : None
+  !! 
+  !! FLOWCHART                              : None
+  !! \n
+  !_ ==============================================================================================================================
+  SUBROUTINE condveg_finalize (kjit, kjpindex, rest_id, z0m, z0h, roughheight)
+    
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables  
+    INTEGER(i_std), INTENT(in)                  :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                  :: kjpindex         !! Domain size
+    INTEGER(i_std),INTENT (in)                  :: rest_id          !! Restart file identifier
+    REAL(r_std),DIMENSION(kjpindex), INTENT(in) :: z0m              !! Roughness for momentum
+    REAL(r_std),DIMENSION(kjpindex), INTENT(in) :: z0h              !! Roughness for heat
+    REAL(r_std),DIMENSION(kjpindex), INTENT(in) :: roughheight      !! Grid effective roughness height (m)     
+    
+    !_ ================================================================================================================================
+    
+    IF ( alb_bg_modis ) THEN
+       CALL restput_p (rest_id, 'soilalbedo_bg', nbp_glo, 2, 1, kjit, bckgrnd_alb, 'scatter',  nbp_glo, index_g)
+    ENDIF
+    
+    CALL restput_p (rest_id, 'soilalbedo_dry', nbp_glo, 2, 1, kjit, soilalb_dry, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'soilalbedo_wet', nbp_glo, 2, 1, kjit, soilalb_wet, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'soilalbedo_moy', nbp_glo, 2, 1, kjit, soilalb_moy, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'z0m', nbp_glo, 1, 1, kjit, z0m, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'z0h', nbp_glo, 1, 1, kjit, z0h, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'roughheight', nbp_glo, 1, 1, kjit, roughheight, 'scatter',  nbp_glo, index_g)
+    
+  END SUBROUTINE condveg_finalize
+
+!! ==============================================================================================================================
+!! SUBROUTINE 	: condveg_clear
+!!
+!>\BRIEF        Deallocate albedo variables
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_clear  ()
+
+      l_first_condveg=.TRUE.
+       
+      ! Dry soil albedo
+       IF (ALLOCATED (soilalb_dry)) DEALLOCATE (soilalb_dry)
+       ! Wet soil albedo
+       IF (ALLOCATED(soilalb_wet))  DEALLOCATE (soilalb_wet)
+       ! Mean soil albedo
+       IF (ALLOCATED(soilalb_moy))  DEALLOCATE (soilalb_moy)
+       ! BG soil albedo
+       IF (ALLOCATED(bckgrnd_alb))   DEALLOCATE (bckgrnd_alb)
+       ! Mean snow albedo
+       IF (ALLOCATED(albedo_snow))  DEALLOCATE (albedo_snow)
+       ! Mean albedo
+       IF (ALLOCATED(albedo_glob))  DEALLOCATE (albedo_glob)
+
+  END SUBROUTINE condveg_clear
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_frac_snow
+!!
+!>\BRIEF        This subroutine calculates the fraction of snow on vegetation and nobio
+!!
+!! DESCRIPTION  
+!!
+!! RECENT CHANGE(S): These calculations were previously done in condveg_snow.
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE condveg_frac_snow(kjpindex, snow, snow_nobio, snowrho, snowdz, &
+                 frac_snow_veg, frac_snow_nobio, z0m)
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                          :: kjpindex        !! Domain size
+    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,nsnow),INTENT(in)   :: snowrho         !! Snow density at each snow layer
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in)   :: snowdz          !! Snow depth at each snow layer
+    REAL(r_std), DIMENSION(:), INTENT(in)               :: z0m             !! Roughness height of vegetated part (m)    
+
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: frac_snow_veg   !! Fraction of snow on vegetation (unitless ratio)
+    REAL(r_std), DIMENSION(kjpindex,nnobio), INTENT(out):: frac_snow_nobio !! Fraction of snow on continental ice, lakes, etc. 
+
+    !! 0.3 Local variables
+    REAL(r_std), DIMENSION(kjpindex)                    :: snowrho_ave     !! Average snow density
+    REAL(r_std), DIMENSION(kjpindex)                    :: snowdepth       !! Snow depth
+    REAL(r_std), DIMENSION(kjpindex)                    :: snowrho_snowdz       !! Snow rho time snowdz
+    INTEGER(i_std)                                      :: jv
+   
+!_ ================================================================================================================================
+
+    snowdepth=sum(snowdz,2)
+    snowrho_snowdz=sum(snowrho*snowdz,2)
+    WHERE(snowdepth(:) .LT. min_sechiba)
+       frac_snow_veg(:) = 0.
+    ELSEWHERE
+       
+       !+++CHECK+++
+       ! Trunk-formulation. This equation does not differentiate
+       ! between tall and short vegetation. Only the amount of 
+       ! snow is taken into account
+!!$          snowrho_ave(:)=snowrho_snowdz(:)/snowdepth(:)
+!!$          frac_snow_veg(:) = tanh(snowdepth(:)/(0.025*(snowrho_ave(:)/50.)))
+       
+       ! Calculate the snow cover fraction...right now this doesn't
+       ! depend on the PFT. It is calculated following
+       ! Yang et al 1997, eq. 32. Note when z0m of the specific PFT
+       ! would be used, the frac_snow_veg could be calculated at the
+       ! PFT level. By using z0m frac_snow now depends on the type
+       ! of vegetation.
+       snowrho_ave(:)=snowrho_snowdz(:)/snowdepth(:)
+       frac_snow_veg(:) = TANH((snow(:)/snowrho_ave(:))/ &
+            MAX((2.5_r_std*z0m(:)), min_sechiba))
+       !+++++++++++
+       
+    END WHERE
+
+    DO jv = 1, nnobio
+
+       !+++CHECK+++
+       ! Trunk-formulation. This equation does not differentiate
+       ! between tall and short vegetation. Only the amount of
+       ! snow is taken into account
+!!$       frac_snow_nobio(:,jv) = MIN(MAX(snow_nobio(:,jv),zero)/&
+!!$           (MAX(snow_nobio(:,jv),zero)+snowcri_alb*sn_dens/100.0),un)
+       ! calculate the fraction of the surface covered by snow
+       ! snow fraction calculated following Yang et al 1997, eq. 32
+       frac_snow_nobio(:,jv) = TANH((MAX(snow_nobio(:,jv),zero)/sn_dens)/ &
+           MAX((2.5_r_std*z0_ice), min_sechiba))
+       !+++++++++++
+
+    ENDDO
+
+    IF (printlev>=3) WRITE (numout,*) ' condveg_frac_snow done '
+    
+  END SUBROUTINE condveg_frac_snow
+
+  
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_soilalb
+!!
+!>\BRIEF        This subroutine calculates the albedo of soil (without snow).
+!!
+!! DESCRIPTION  This subroutine reads the soil colour maps in 1 x 1 deg resolution 
+!! from the Henderson-Sellers & Wilson database. These values are interpolated to 
+!! the model's resolution and transformed into 
+!! dry and wet albedos.\n
+!!
+!! If the soil albedo is calculated without the dependence of soil moisture, the
+!! soil colour values are transformed into mean soil albedo values.\n 
+!!
+!! The calculations follow the assumption that the grid of the data is regular and 
+!! it covers the globe. The calculation for the model grid are based on the borders 
+!! of the grid of the resolution.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! CALCULATED MODULE VARIABLE(S): soilalb_dry for visible and near-infrared range,
+!!                                soilalb_wet for visible and near-infrared range, 
+!!                                soilalb_moy for visible and near-infrared range 
+!!
+!! REFERENCE(S) : 
+!! -Wilson, M.F., and A. Henderson-Sellers, 1985: A global archive of land cover and
+!!  soils data for use in general circulation climate models. J. Clim., 5, 119-143.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE condveg_soilalb(nbpt, lalo, neighbours, resolution, contfrac)
+ 
+    USE interpweight
+
+    IMPLICIT NONE
+
+ 
+    !! 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,NbNeighb)!! Vector of neighbours for each grid point 
+                                                                           !! (1=N, 2=E, 3=S, 4=W)  
+    REAL(r_std), INTENT(in)                       :: resolution(nbpt,2)    !! The size of each grid cell in X and Y (km)
+    REAL(r_std), INTENT(in)                       :: contfrac(nbpt)        !! Fraction of land in each grid cell (unitless)   
+
+    !! 0.4 Local variables
+
+    CHARACTER(LEN=80)                             :: filename              !! Filename of soil colour map
+    INTEGER(i_std)                                :: i, ib, ip, nbexp      !! Indices
+    INTEGER                                       :: ALLOC_ERR             !! Help varialbe to count allocation error
+    REAL(r_std), DIMENSION(nbpt)                  :: asoilcol              !! Availability of the soilcol interpolation
+    REAL(r_std), DIMENSION(:), ALLOCATABLE        :: variabletypevals      !! Values for all the types of the variable
+                                                                           !!   (variabletypevals(1) = -un, not used)
+    REAL(r_std), DIMENSION(:,:), ALLOCATABLE      :: soilcolrefrac         !! soilcol fractions re-dimensioned
+    REAL(r_std)                                   :: vmin, vmax            !! min/max values to use for the 
+                                                                           !!   renormalization
+    CHARACTER(LEN=80)                             :: variablename          !! Variable to interpolate
+    CHARACTER(LEN=80)                             :: lonname, latname      !! lon, lat names in input file
+    CHARACTER(LEN=50)                             :: fractype              !! method of calculation of fraction
+                                                                           !!   'XYKindTime': Input values are kinds 
+                                                                           !!     of something with a temporal 
+                                                                           !!     evolution on the dx*dy matrix'
+    LOGICAL                                       :: nonegative            !! whether negative values should be removed
+    CHARACTER(LEN=50)                             :: maskingtype           !! Type of masking
+                                                                           !!   'nomask': no-mask is applied
+                                                                           !!   'mbelow': take values below maskvals(1)
+                                                                           !!   'mabove': take values above maskvals(1)
+                                                                           !!   'msumrange': take values within 2 ranges;
+                                                                           !!      maskvals(2) <= SUM(vals(k)) <= maskvals(1)
+                                                                           !!      maskvals(1) < SUM(vals(k)) <= maskvals(3)
+                                                                           !!        (normalized by maskvals(3))
+                                                                           !!   'var': mask values are taken from a 
+                                                                           !!     variable inside the file (>0)
+    REAL(r_std), DIMENSION(3)                     :: maskvals              !! values to use to mask (according to 
+                                                                           !!   `maskingtype') 
+    CHARACTER(LEN=250)                            :: namemaskvar           !! name of the variable to use to mask 
+    CHARACTER(LEN=250)                            :: msg
+    INTEGER                                       :: fopt
+    INTEGER(i_std), DIMENSION(:), ALLOCATABLE     :: vecpos
+    INTEGER(i_std), DIMENSION(:), ALLOCATABLE     :: solt
+
+!_ ================================================================================================================================
+  !! 1. Open file and allocate memory
+
+  ! Open file with soil colours 
+
+  !Config Key   = SOILALB_FILE
+  !Config Desc  = Name of file from which the bare soil albedo
+  !Config Def   = soils_param.nc
+  !Config If    = NOT(IMPOSE_AZE)
+  !Config Help  = The name of the file to be opened to read the soil types from 
+  !Config         which we derive then the bare soil albedos. This file is 1x1 
+  !Config         deg and based on the soil colors defined by Wilson and Henderson-Seller.
+  !Config Units = [FILE]
+  !
+  filename = 'soils_param.nc'
+  CALL getin_p('SOILALB_FILE',filename)
+
+
+  ALLOCATE(soilcolrefrac(nbpt, classnb), STAT=ALLOC_ERR) 
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable soilcolrefrac','','')
+  ALLOCATE(vecpos(classnb), STAT=ALLOC_ERR) 
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable vecpos','','')
+  ALLOCATE(solt(classnb), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable solt','','')
+
+  ! Assigning values to vmin, vmax
+  vmin = 1.0
+  vmax = classnb
+
+  ALLOCATE(variabletypevals(classnb),STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variabletypevals','','')
+  variabletypevals = -un
+
+  !! Variables for interpweight
+  ! Type of calculation of cell fractions
+  fractype = 'default'
+  ! Name of the longitude and latitude in the input file
+  lonname = 'nav_lon'
+  latname = 'nav_lat'
+  ! Should negative values be set to zero from input file?
+  nonegative = .FALSE.
+  ! Type of mask to apply to the input data (see header for more details)
+  maskingtype = 'mabove'
+  ! Values to use for the masking
+  maskvals = (/ min_sechiba, undef_sechiba, undef_sechiba /)
+  ! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
+  namemaskvar = ''
+
+  ! Interpolate variable soilcolor
+  variablename = 'soilcolor'
+  IF (printlev_loc >= 2) WRITE(numout,*) "condveg_soilalb: Start interpolate " &
+       // TRIM(filename) // " for variable " // TRIM(variablename)
+  CALL interpweight_2D(nbpt, classnb, variabletypevals, lalo, resolution, neighbours,          &
+    contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype,          &
+    maskvals, namemaskvar, 0, 0, -1, fractype,                                                        &
+    -1., -1., soilcolrefrac, asoilcol)
+  IF (printlev_loc >= 5) WRITE(numout,*)'  condveg_soilalb after interpweight_2D'
+      
+  ! Check how many points with soil information are found
+  nbexp = 0
+
+  soilalb_dry(:,:) = zero
+  soilalb_wet(:,:) = zero
+  soilalb_moy(:,:) = zero
+  IF (printlev_loc >= 5) THEN
+    WRITE(numout,*)'  condveg_soilalb before starting loop nbpt:', nbpt
+    WRITE(numout,*)'  condveg_soilalb initial values classnb: ',classnb
+    WRITE(numout,*)'  condveg_soilalb vis_dry. SUM:',SUM(vis_dry),' vis_dry= ',vis_dry
+    WRITE(numout,*)'  condveg_soilalb nir_dry. SUM:',SUM(nir_dry),' nir_dry= ',nir_dry
+    WRITE(numout,*)'  condveg_soilalb vis_wet. SUM:',SUM(vis_wet),' vis_wet= ',vis_wet
+    WRITE(numout,*)'  condveg_soilalb nir_wet. SUM:',SUM(nir_wet),' nir_wet= ',nir_wet
+  END IF
+
+  DO ib=1,nbpt ! Loop over domain size
+
+     ! vecpos: List of positions where textures were not zero
+     !   vecpos(1): number of not null textures found
+     vecpos = interpweight_ValVecR(soilcolrefrac(ib,:),classnb,zero,'neq')
+     fopt = vecpos(1)
+     IF (fopt == classnb) THEN
+        ! All textures are not zero
+        solt(:) = (/(i,i=1,classnb)/)
+     ELSE IF (fopt == 0) THEN
+        WRITE(numout,*)'  condveg_soilalb: for point=', ib, ' no soil class!'
+     ELSE
+        DO ip = 1,fopt
+           solt(ip) = vecpos(ip+1)
+        END DO
+     END IF
+        
+     !! 3. Compute the average bare soil albedo parameters
+     
+     IF ( (fopt .EQ. 0) .OR. (asoilcol(ib) .LT. min_sechiba)) THEN
+        ! Initialize with mean value if no points were interpolated or if no data was found
+        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          
+        ! If points were interpolated
+        DO ip=1, fopt
+           IF ( solt(ip) .LE. classnb) THEN
+              ! Set to zero if the value is below min_sechiba
+              IF (soilcolrefrac(ib,solt(ip)) < min_sechiba) soilcolrefrac(ib,solt(ip)) = zero
+
+              soilalb_dry(ib,ivis) = soilalb_dry(ib,ivis) + vis_dry(solt(ip))*soilcolrefrac(ib,solt(ip))
+              soilalb_dry(ib,inir) = soilalb_dry(ib,inir) + nir_dry(solt(ip))*soilcolrefrac(ib,solt(ip))
+              soilalb_wet(ib,ivis) = soilalb_wet(ib,ivis) + vis_wet(solt(ip))*soilcolrefrac(ib,solt(ip))
+              soilalb_wet(ib,inir) = soilalb_wet(ib,inir) + nir_wet(solt(ip))*soilcolrefrac(ib,solt(ip))
+              soilalb_moy(ib,ivis) = soilalb_moy(ib,ivis) + albsoil_vis(solt(ip))*                    &
+                soilcolrefrac(ib,solt(ip))
+              soilalb_moy(ib,inir) = soilalb_moy(ib,inir) + albsoil_nir(solt(ip))*                    &
+                soilcolrefrac(ib,solt(ip))
+           ELSE
+              msg = 'The file contains a soil color class which is incompatible with this program'
+              CALL ipslerr_p(3,'condveg_soilalb',TRIM(msg),'','')
+           ENDIF
+        ENDDO
+     ENDIF
+
+  ENDDO
+
+  IF ( nbexp .GT. 0 ) THEN
+     WRITE(numout,*) 'condveg_soilalb _______'
+     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'
+     WRITE(numout,*) 'condveg_soilalb: Use the diagnostic output field asoilcol to see location of these points'
+  ENDIF
+
+  DEALLOCATE (soilcolrefrac)
+  DEALLOCATE (variabletypevals)
+
+  ! Write diagnostics
+  CALL xios_orchidee_send_field("asoilcol",asoilcol)
+
+
+  IF (printlev_loc >= 3) WRITE(numout,*)'  condveg_soilalb ended'
+
+  END SUBROUTINE condveg_soilalb
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : read_background_albedo
+!!
+!>\BRIEF        This subroutine reads the background albedo
+!!
+!! DESCRIPTION  This subroutine reads the background albedo map in 0.5 x 0.5 deg resolution 
+!! derived from JRCTIP product. These values are then interpolated to the resolution of the
+!! simulation. For deserts and fallow croplands, the background albedo will
+!! be similar to the bare soil albedo. For all other vegetated PFTs, the background albedo 
+!! will be determined by the understory and/or the litter layer.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): bckgrnd_alb for visible and near-infrared range 
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE read_background_albedo(nbpt, lalo, neighbours, resolution, contfrac)
+
+    USE interpweight
+
+    IMPLICIT NONE
+
+    !! 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,NbNeighb)!! Vector of neighbours for each grid point 
+                                                                           !! (1=N, 2=E, 3=S, 4=W)  
+    REAL(r_std), INTENT(in)                       :: resolution(nbpt,2)    !! The size of each grid cell in X and Y (km)
+    REAL(r_std), INTENT(in)                       :: contfrac(nbpt)        !! Fraction of land in each grid cell (unitless)   
+
+    !! 0.4 Local variables
+
+    CHARACTER(LEN=80)                             :: filename              !! Filename of background albedo
+    REAL(r_std), DIMENSION(nbpt)                  :: aalb_bg               !! Availability of the interpolation
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)        :: lat_lu, lon_lu        !! Latitudes and longitudes read from input file
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lat_rel, lon_rel      !! Help variable to read file data and allocate memory
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: mask_lu               !! Help variable to read file data and allocate memory
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: soilalbedo_bg         !! Help variable to read file data and allocate memory
+    INTEGER                                       :: ALLOC_ERR             !! Help varialbe to count allocation error
+    REAL(r_std)                                   :: vmin, vmax            !! min/max values to use for the 
+                                                                           !!   renormalization
+    CHARACTER(LEN=80)                             :: variablename          !! Variable to interpolate
+    CHARACTER(LEN=250)                            :: maskvname             !! Variable to read the mask from 
+                                                                           !! the file
+    CHARACTER(LEN=80)                             :: lonname, latname      !! lon, lat names in input file
+    CHARACTER(LEN=50)                             :: fractype              !! method of calculation of fraction
+                                                                           !!   'XYKindTime': Input values are kinds 
+                                                                           !!     of something with a temporal 
+                                                                           !!     evolution on the dx*dy matrix'
+    LOGICAL                                       :: nonegative            !! whether negative values should be removed
+    CHARACTER(LEN=50)                             :: maskingtype           !! Type of masking
+                                                                           !!   'nomask': no-mask is applied
+                                                                           !!   'mbelow': take values below maskvals(1)
+                                                                           !!   'mabove': take values above maskvals(1)
+                                                                           !!   'msumrange': take values within 2 ranges;
+                                                                           !!      maskvals(2) <= SUM(vals(k)) <= maskvals(1)
+                                                                           !!      maskvals(1) < SUM(vals(k)) <= maskvals(3)
+                                                                           !!        (normalized by maskedvals(3))
+                                                                           !!   'var': mask values are taken from a 
+                                                                           !!     variable inside the file (>0)
+    REAL(r_std), DIMENSION(3)                     :: maskvals              !! values to use to mask (according to 
+                                                                           !!   `maskingtype') 
+    CHARACTER(LEN=250)                            :: namemaskvar           !! name of the variable to use to mask 
+    REAL(r_std)                                   :: albbg_norefinf        !! No value
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)        :: albbg_default         !! Default value
+
+!_ ================================================================================================================================
+
+  !! 1. Open file and allocate memory
+
+  ! Open file with background albedo
+
+  !Config Key   = ALB_BG_FILE
+  !Config Desc  = Name of file from which the background albedo is read 
+  !Config Def   = alb_bg.nc
+  !Config If    = 
+  !Config Help  = The name of the file to be opened to read background albedo 
+  !Config Units = [FILE]
+  !
+  filename = 'alb_bg.nc'
+  CALL getin_p('ALB_BG_FILE',filename)
+
+ 
+  ALLOCATE(albbg_default(2), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'read_background_albedo','Pb in allocation for albbg_default','','')
+
+  ! For this case there are not types/categories. We have 'only' a continuous field
+  ! Assigning values to vmin, vmax
+
+  vmin = 0.
+  vmax = 9999.
+  
+  !! Variables for interpweight
+  ! Type of calculation of cell fractions (not used here)
+  fractype = 'default'
+  ! Name of the longitude and latitude in the input file
+  lonname = 'longitude'
+  latname = 'latitude'
+  ! Default value when no value is get from input file
+  albbg_default(ivis) = 0.129
+  albbg_default(inir) = 0.247
+  ! Reference value when no value is get from input file (not used here)
+  albbg_norefinf = undef_sechiba
+  ! Should negative values be set to zero from input file?
+  nonegative = .FALSE.
+  ! Type of mask to apply to the input data (see header for more details)
+  maskingtype = 'var'
+  ! Values to use for the masking (here not used)
+  maskvals = (/ undef_sechiba, undef_sechiba, undef_sechiba /)
+  ! Name of the variable with the values for the mask in the input file (only if maskkingtype='var')
+  namemaskvar = 'mask'
+
+  ! There is a variable for each chanel 'infrared' and 'visible'
+  ! Interpolate variable bg_alb_vis
+  variablename = 'bg_alb_vis'
+  IF (printlev_loc >= 2) WRITE(numout,*) "read_background_albedo: Start interpolate " &
+       // TRIM(filename) // " for variable " // TRIM(variablename)
+  CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours,                                  &
+    contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype,          &
+    maskvals, namemaskvar, -1, fractype, albbg_default(inir), albbg_norefinf,                         &
+    bckgrnd_alb(:,ivis), aalb_bg)
+  IF (printlev_loc >= 5) WRITE(numout,*)"  read_background_albedo after InterpWeight2Dcont for '" //   &
+    TRIM(variablename) // "'"
+
+  ! Interpolate variable bg_alb_nir in the same file
+  variablename = 'bg_alb_nir'
+  IF (printlev_loc >= 2) WRITE(numout,*) "read_background_albedo: Start interpolate " &
+       // TRIM(filename) // " for variable " // TRIM(variablename)
+  CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours,                                  &
+    contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype,          &
+    maskvals, namemaskvar, -1, fractype, albbg_default(inir), albbg_norefinf,                         &
+    bckgrnd_alb(:,inir), aalb_bg)
+  IF (printlev_loc >= 5) WRITE(numout,*)"  read_background_albedo after InterpWeight2Dcont for '" //   &
+    TRIM(variablename) // "'"
+
+  IF (ALLOCATED(albbg_default)) DEALLOCATE(albbg_default)
+
+  IF (printlev_loc >= 3) WRITE(numout,*)'  read_background_albedo ended'
+
+  ! Write diagnostics
+  CALL xios_orchidee_send_field("aalb_bg",aalb_bg)
+
+  END SUBROUTINE read_background_albedo
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_z0cdrag
+!!
+!>\BRIEF        Computation of grid average of roughness length by calculating 
+!! the drag coefficient.
+!!
+!! DESCRIPTION  : This routine calculates the mean roughness height and mean 
+!! effective roughness height over the grid cell. The mean roughness height (z0) 
+!! is computed by averaging the drag coefficients  \n
+!!
+!! \latexonly 
+!! \input{z0cdrag1.tex}
+!! \endlatexonly
+!! \n 
+!!
+!! where C is the drag coefficient at the height of the vegetation, kappa is the 
+!! von Karman constant, z (Ztmp) is the height at which the fluxes are estimated and z0 the roughness height. 
+!! The reference level for z needs to be high enough above the canopy to avoid 
+!! singularities of the LOG. This height is set to  minimum 10m above ground. 
+!! The drag coefficient increases with roughness height to represent the greater 
+!! turbulence generated by rougher surfaces. 
+!! The roughenss height is obtained by the inversion of the drag coefficient equation.\n
+!!
+!! The roughness height for the non-vegetative surfaces is calculated in a second step. 
+!! In order to calculate the transfer coefficients the 
+!! effective roughness height is calculated. This effective value is the difference
+!! between the height of the vegetation and the zero plane displacement height.\nn
+!!
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUT VARIABLE(S):  :: roughness height(z0) and grid effective roughness height(roughheight)
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_z0cdrag (kjpindex, veget, veget_max, frac_nobio,&
+    totfrac_nobio, zlev, height, tot_bare_soil, &
+    z0m, z0h, roughheight)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+   
+    INTEGER(i_std), INTENT(in)                          :: kjpindex      !! Domain size - Number of land pixels  (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: veget         !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                         !! (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: veget_max     !! PFT "Maximal" coverage fraction of a PFT 
+                                                                         !! (= ind*cn_ind) (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nnobio), INTENT(in) :: frac_nobio    !! Fraction of non-vegetative surfaces, 
+                                                                         !! i.e. continental ice, lakes, etc. (unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: totfrac_nobio !! Total fraction of non-vegetative surfaces, 
+                                                                         !! i.e. continental ice, lakes, etc. (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: zlev          !! Height of first layer (m)           
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: height        !! Vegetation height (m)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: tot_bare_soil !! Total evaporating bare soil fraction 
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: z0m           !! Roughness height for momentum (m)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: z0h           !! Roughness height for heat (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. 
+    REAL(r_std), DIMENSION(kjpindex)                    :: dragm         !! Dragcoefficient for momentum
+    REAL(r_std), DIMENSION(kjpindex)                    :: dragh         !! Dragcoefficient for heat
+
+
+!_ ================================================================================================================================
+    
+    !! 1. Preliminary calculation
+
+    ! Set maximal height of first layer
+    ztmp(:) = MAX(10., zlev(:))
+
+    ! Calculate roughness for non-vegetative surfaces
+    ! with the von Karman constant 
+    dragm(:) = tot_bare_soil(:) * (ct_karman/LOG(ztmp(:)/z0_bare))**2
+    dragh(:) = tot_bare_soil(:) *(ct_karman/LOG(ztmp(:)/(z0_bare/ratio_z0m_z0h(1))))*(ct_karman/LOG(ztmp(:)/z0_bare))
+
+    ! Fraction of bare soil
+    sumveg(:) = tot_bare_soil(:)
+
+    ! Set average vegetation height to zero
+    ave_height(:) = zero
+    
+    !! 2. Calculate the mean roughness height 
+    
+    ! Calculate the mean roughness height of
+    ! vegetative PFTs over the grid cell
+    DO jv = 2, nvm
+
+       ! In the case of forest, use parameter veget_max because 
+       ! tree trunks influence the roughness even when there are no leaves
+       IF ( is_tree(jv) ) THEN
+          ! In the case of grass, use parameter veget because grasses 
+          ! only influence the roughness during the growing season
+          d_veg(:) = veget_max(:,jv)
+       ELSE
+          ! grasses only have an influence if they are really there!
+          d_veg(:) = veget(:,jv)
+       ENDIF
+       
+       ! Calculate the average roughness over the grid cell:
+       ! The unitless drag coefficient is per vegetative PFT
+       ! calculated by use of the von Karman constant, the height 
+       ! of the first layer and the roughness. The roughness
+       ! is calculated as the vegetation height  per PFT 
+       ! multiplied by the roughness  parameter 'z0_over_height= 1/16'. 
+       ! If this scaled value is lower than 0.01 then the value for 
+       ! the roughness of bare soil (0.01) is used. 
+       ! The sum over all PFTs gives the average roughness 
+       ! per grid cell for the vegetative PFTs.
+       dragm(:) = dragm(:) + d_veg(:) *(ct_karman/LOG(ztmp(:)/MAX(height(:,jv)*z0_over_height(jv),z0_bare)))**2
+       dragh(:) = dragh(:) + d_veg(:) *(ct_karman/LOG(ztmp(:)/(MAX(height(:,jv)*z0_over_height(jv),z0_bare) / &
+            ratio_z0m_z0h(jv)))) *(ct_karman/LOG(ztmp(:)/MAX(height(:,jv)*z0_over_height(jv),z0_bare)))
+
+
+       ! 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 ) 
+       dragm(:) = dragm(:) / sumveg(:)
+       dragh(:) = dragh(:) / sumveg(:)
+    ENDWHERE
+    ! Calculate fraction of roughness for vegetated part 
+    dragm(:) = (un - totfrac_nobio(:)) * dragm(:)
+    dragh(:) = (un - totfrac_nobio(:)) * dragh(:)
+
+    DO jv = 1, nnobio ! Loop over # of non-vegative surfaces
+
+       ! Set rougness for ice
+       IF ( jv .EQ. iice ) THEN
+          z0_nobio = z0_ice
+       ELSE
+          WRITE(numout,*) 'jv=',jv
+          WRITE(numout,*) 'DO NOT KNOW ROUGHNESS OF THIS SURFACE TYPE'
+          CALL ipslerr_p(3,'condveg_z0cdrag','DO NOT KNOW ROUGHNESS OF THIS SURFACE TYPE','','')
+       ENDIF
+       
+       ! Sum of vegetative roughness length and non-vegetative
+       ! roughness length
+       ! Note that z0m could be made dependent of frac_snow_nobio
+       dragm(:) = dragm(:) + frac_nobio(:,jv) *(ct_karman/LOG(ztmp(:)/z0_nobio))**2
+       dragh(:) = dragh(:) + frac_nobio(:,jv) *(ct_karman/LOG(ztmp(:)/z0_nobio/ratio_z0m_z0h(1)))*(ct_karman/LOG(ztmp(:)/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 
+    z0m(:) = ztmp(:) / EXP(ct_karman/SQRT(dragm(:)))
+    z0h(:) = ztmp(:) / EXP((ct_karman**2.)/(dragh(:)*LOG(ztmp(:)/z0m(:))))
+
+    ! 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_z0cdrag_dyn
+!!
+!>\BRIEF        Computation of grid average of roughness length by calculating 
+!! the drag coefficient based on formulation proposed by Su et al. (2001). 
+!!
+!! 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
+!! In the formulation of Su et al. (2001), one distinguishes the roughness height for
+!! momentum (z0m) and the one for heat (z0h). 
+!! z0m is computed as a function of LAI (z0m increases with LAI) and z0h is computed  
+!! with a so-called kB-1 term (z0m/z0h=exp(kB-1))
+!!
+!! RECENT CHANGE(S): Written by N. Vuichard (2016)
+!! 
+!! MAIN OUTPUT VARIABLE(S):  :: roughness height(z0) and grid effective roughness height(roughheight)
+!!
+!! REFERENCE(S) : 
+!! - Su, Z., Schmugge, T., Kustas, W.P., Massman, W.J., 2001. An Evaluation of Two Models for 
+!! Estimation of the Roughness Height for Heat Transfer between the Land Surface and the Atmosphere. J. Appl. 
+!! Meteorol. 40, 1933â1951. doi:10.1175/1520-0450(2001)
+!! - Ershadi, A., McCabe, M.F., Evans, J.P., Wood, E.F., 2015. Impact of model structure and parameterization 
+!! on Penman-Monteith type evaporation models. J. Hydrol. 525, 521â535. doi:10.1016/j.jhydrol.2015.04.008
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_z0cdrag_dyn (kjpindex,veget,veget_max,frac_nobio,totfrac_nobio,zlev, height, &
+       &                      temp_air, pb, u, v, lai, frac_snow_veg, z0m, z0h, roughheight)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+   
+    INTEGER(i_std), INTENT(in)                          :: kjpindex      !! Domain size - Number of land pixels  (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: veget         !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                         !! (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: veget_max     !! PFT "Maximal" coverage fraction of a PFT 
+                                                                         !! (= ind*cn_ind) (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nnobio), INTENT(in) :: frac_nobio    !! Fraction of non-vegetative surfaces, 
+                                                                         !! i.e. continental ice, lakes, etc. (unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: totfrac_nobio !! Total fraction of non-vegetative surfaces, 
+                                                                         !! i.e. continental ice, lakes, etc. (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: zlev          !! Height of first layer (m)           
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: height        !! Vegetation height (m)    
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: temp_air      !! 2m air temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: pb            !! Surface pressure (hPa)
+    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 
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: lai           !! Leaf area index (m2[leaf]/m2[ground])
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: frac_snow_veg    !! Snow cover fraction on vegeted area
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: z0m           !! Roughness height for momentum (m)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: z0h           !! Roughness height for heat (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)                    :: zhdispl       !! Zero plane displacement height (m)
+    REAL(r_std)                                         :: z0_nobio      !! Roughness height of non-vegetative fraction (m),  
+                                                                         !! i.e. continental ice, lakes, etc. 
+    REAL(r_std), DIMENSION(kjpindex)                    :: z0m_pft       !! Roughness height for momentum for a specific PFT
+    REAL(r_std), DIMENSION(kjpindex)                    :: z0h_pft       !! Roughness height for heat for a specific PFT
+    REAL(r_std), DIMENSION(kjpindex)                    :: dragm         !! Dragcoefficient for momentum
+    REAL(r_std), DIMENSION(kjpindex)                    :: dragh         !! Dragcoefficient for heat
+    REAL(r_std), DIMENSION(kjpindex)                    :: eta           !! Ratio of friction velocity to the wind speed at the canopy top - See Ershadi et al. (2015)
+    REAL(r_std), DIMENSION(kjpindex)                    :: eta_ec        !! Within-canopy wind speed profile estimation coefficient - See Ershadi et al. (2015)
+    REAL(r_std), DIMENSION(kjpindex)                    :: Ct_star       !! Heat transfer coefficient of the soil - see Su et al. (2001)
+    REAL(r_std), DIMENSION(kjpindex)                    :: kBs_m1        !! Canopy model of Brutsaert (1982) for a bare soil surface - used in the calculation of kB_m1 (see Ershadi et al. (2015))
+    REAL(r_std), DIMENSION(kjpindex)                    :: kB_m1         !! kB**-1: Term used in the calculation of z0h where B-1 is the inverse Stanton number (see Ershadi et al. (2015))
+    REAL(r_std), DIMENSION(kjpindex)                    :: fc            !! fractional canopy coverage
+    REAL(r_std), DIMENSION(kjpindex)                    :: fs            !! fractional soil coverage
+    REAL(r_std), DIMENSION(kjpindex)                    :: Reynolds      !! Reynolds number
+    REAL(r_std), DIMENSION(kjpindex)                    :: wind          !! wind Speed (m)
+    REAL(r_std), DIMENSION(kjpindex)                    :: u_star        !! friction velocity
+    REAL(r_std), DIMENSION(kjpindex)                    :: z0_ground     !! z0m value used for ground surface
+!_ ================================================================================================================================
+    
+    !! 1. Preliminary calculation
+
+    ! Set maximal height of first layer
+    ztmp(:) = MAX(10., zlev(:))
+    
+    z0_ground(:) = (1.-frac_snow_veg(:))*z0_bare + frac_snow_veg(:)*z0_bare/10.
+
+    ! Calculate roughness for non-vegetative surfaces
+    ! with the von Karman constant 
+    dragm(:) = veget_max(:,1) * (ct_karman/LOG(ztmp(:)/z0_ground(:)))**2
+
+    wind(:) = SQRT(u(:)*u(:)+v(:)*v(:))
+    u_star(:)= ct_karman * MAX(min_wind,wind(:)) / LOG(zlev(:)/z0_ground(:))
+    Reynolds(:) = z0_ground(:) * u_star(:) &
+         / (1.327*1e-5 * (pb_std/pb(:)) * (temp_air(:)/ZeroCelsius)**(1.81))
+    
+    kBs_m1(:) = 2.46 * reynolds**(1./4.) - LOG(7.4)
+
+    dragh(:) = veget_max(:,1) * (ct_karman/LOG(ztmp(:)/z0_ground(:)))*(ct_karman/LOG(ztmp(:)/(z0_ground(:)/exp(kBs_m1(:))) ))
+
+    ! Fraction of bare soil
+    sumveg(:) = veget_max(:,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
+       
+       WHERE(veget_max(:,jv) .GT. zero)       
+          ! 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.
+          eta(:) = c1 - c2 * exp(-c3 * Cdrag_foliage * lai(:,jv))
+          
+          z0m_pft(:) = (height(:,jv)*(1-height_displacement)*(exp(-ct_karman/eta(:))-exp(-ct_karman/(c1-c2)))) &
+               + z0_ground(:)
+
+          dragm(:) = dragm(:) + veget_max(:,jv) *(ct_karman/LOG(ztmp(:)/z0m_pft(:)))**2
+   
+          fc(:) = veget(:,jv)/veget_max(:,jv)
+          fs(:) = 1. - fc(:)
+
+          eta_ec(:) = ( Cdrag_foliage * lai(:,jv)) / (2 * eta(:)*eta(:))
+          wind(:) = SQRT(u(:)*u(:)+v(:)*v(:))
+          u_star(:)= ct_karman * MAX(min_wind,wind(:)) / LOG((zlev(:)+(height(:,jv)*(1-height_displacement)))/z0m_pft(:))
+          Reynolds(:) = z0_ground(:) * u_star(:) &
+               / (1.327*1e-5 * (pb_std/pb(:)) * (temp_air(:)/ZeroCelsius)**(1.81))
+                 
+          kBs_m1(:) = 2.46 * reynolds**(1./4.) - LOG(7.4)
+          Ct_star(:) = Prandtl**(-2./3.) * SQRT(1./Reynolds(:))
+   
+          WHERE(lai(:,jv) .GT. min_sechiba)
+             kB_m1(:) = (ct_karman * Cdrag_foliage) / (4 * Ct * eta(:) * (1 - exp(-eta_ec(:)/2.))) * fc(:)**2. &
+                  + 2*fc(:)*fs(:) * (ct_karman * eta(:) * z0m_pft(:) / height(:,jv)) / Ct_star(:) &
+                  + kBs_m1(:) * fs(:)**2. 
+          ELSEWHERE
+             kB_m1(:) = kBs_m1(:) * fs(:)**2. 
+          ENDWHERE
+   
+          z0h_pft(:) = z0m_pft(:) / exp(kB_m1(:))
+   
+          dragh(:) = dragh(:) + veget_max(:,jv) * (ct_karman/LOG(ztmp(:)/z0m_pft(:)))*(ct_karman/LOG(ztmp(:)/z0h_pft(:)))
+   
+          ! Sum of bare soil and fraction vegetated fraction
+          sumveg(:) = sumveg(:) + veget_max(:,jv)
+
+          ! Weigh height of vegetation with maximal cover fraction
+          ave_height(:) = ave_height(:) + veget_max(:,jv)*height(:,jv)
+
+       ENDWHERE
+    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 ) 
+       dragh(:) = dragh(:) / sumveg(:)
+       dragm(:) = dragm(:) / sumveg(:)
+    ENDWHERE
+
+    ! Calculate fraction of roughness for vegetated part 
+    dragh(:) = (un - totfrac_nobio(:)) * dragh(:)
+    dragm(:) = (un - totfrac_nobio(:)) * dragm(:)
+
+    DO jv = 1, nnobio ! Loop over # of non-vegative surfaces
+
+       ! Set rougness for ice
+       IF ( jv .EQ. iice ) THEN
+          z0_nobio = z0_ice
+       ELSE
+          WRITE(numout,*) 'jv=',jv
+          WRITE(numout,*) 'DO NOT KNOW ROUGHNESS OF THIS SURFACE TYPE'
+          CALL ipslerr_p(3,'condveg_z0cdrag_dyn','DO NOT KNOW ROUGHNESS OF THIS SURFACE TYPE','','')
+       ENDIF
+       
+       ! Sum of vegetative roughness length and non-vegetative
+       ! roughness length
+       dragm(:) = dragm(:) + frac_nobio(:,jv) * (ct_karman/LOG(ztmp(:)/z0_nobio))**2
+       
+       u_star(:)= ct_karman * MAX(min_wind,wind(:)) / LOG(zlev(:)/z0_nobio)
+       Reynolds(:) = z0_nobio * u_star(:) &
+            / (1.327*1e-5 * (pb_std/pb(:)) * (temp_air(:)/ZeroCelsius)**(1.81))
+       
+       kBs_m1(:) = 2.46 * reynolds**(1./4.) - LOG(7.4)
+   
+       dragh(:) = dragh(:) + frac_nobio(:,jv) * (ct_karman/LOG(ztmp(:)/z0_nobio)) * &
+            (ct_karman/LOG(ztmp(:)/(z0_nobio/ exp(kBs_m1(:))) ))
+
+    ENDDO ! Loop over # of non-vegative surfaces
+    
+    !! 4. Calculate the zero plane displacement height and effective roughness length
+    !  Take the exponential of the roughness 
+    z0m(:) = ztmp(:) / EXP(ct_karman/SQRT(dragm(:)))
+    z0h(:) = ztmp(:) / EXP((ct_karman**2.)/(dragh(:)*LOG(ztmp(:)/z0m(:))))
+
+    ! 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_dyn
+
+
+END MODULE condveg
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/diffuco.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/diffuco.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/diffuco.f90	(revision 6412)
@@ -0,0 +1,3699 @@
+! ================================================================================================================================
+!  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_co2 calculates the beta coefficient for transpiration for each type of vegetation, using Farqhar's formula 
+!! - chemistry_bvoc calculates the beta coefficient for emissions of biogenic compounds \n
+!!
+!! Finally, the module diffuco_comb computes the combined $\alpha$ and $\beta$ coefficients for use 
+!! elsewhere in the module. \n
+
+!! RECENT CHANGE(S): Nathalie le 28 mars 2006 - sur proposition de Fred Hourdin, ajout
+!! d'un potentiometre pour regler la resistance de la vegetation (rveg is now in pft_parameters)
+!! October 2018: Removed diffuco_trans using Jarvis formula for calculation of beta coefficient 
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE diffuco
+
+  ! modules used :
+  USE function_library,  ONLY : cc_to_lai, biomass_to_lai, biomass_to_coupled_lai
+  USE constantes
+  USE constantes_soil
+  USE qsat_moisture
+  USE sechiba_io_p
+  USE ioipsl
+  USE pft_parameters
+  USE grid
+  USE ioipsl_para 
+  USE xios_orchidee
+  USE chemistry, ONLY : chemistry_initialize, chemistry_bvoc, chemistry_clear
+  IMPLICIT NONE
+
+  ! public routines :
+  PRIVATE
+  PUBLIC :: diffuco_main, diffuco_initialize, diffuco_finalize, diffuco_clear
+
+  INTERFACE Arrhenius_modified
+     MODULE PROCEDURE Arrhenius_modified_0d, Arrhenius_modified_1d
+  END INTERFACE
+
+  !
+  ! variables used inside diffuco module : declaration and initialisation
+  !
+  !INTEGER(i_std), SAVE                              :: printlev_loc   !! local printlev for this module
+!!$OMP THREADPRIVATE(printlev_loc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: leaf_ci                   !! intercellular CO2 concentration (ppm)
+!$OMP THREADPRIVATE(leaf_ci)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: wind                      !! Wind module (m s^{-1})
+!$OMP THREADPRIVATE(wind)
+
+CONTAINS
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    diffuco_initialize
+!!
+!>\BRIEF	  Allocate module variables, read from restart file or initialize with default values
+!!
+!! DESCRIPTION:	  Allocate module variables, read from restart file or initialize with default values.
+!!                Call chemistry_initialize for initialization of variables needed for the calculations of BVOCs.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S): None
+!! 
+!! FLOWCHART: None
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE diffuco_initialize (kjit,    kjpindex, index,                  &
+                                 rest_id, lalo,     neighbours, resolution, &
+                                 rstruct, q_cdrag)
+    
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number (-) 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index            !! Indeces of the points on the map (-)
+    INTEGER(i_std),INTENT (in)                         :: rest_id          !! _Restart_ file identifier (-)
+    REAL(r_std),DIMENSION (kjpindex,2),   INTENT (in)  :: lalo             !! Geographical coordinates
+    INTEGER(i_std),DIMENSION (kjpindex,NbNeighb),INTENT (in):: neighbours  !! Vector of neighbours for each 
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)     :: resolution       !! The size in km of each grid-box in X and Y
+    
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: rstruct          !! Structural resistance for the vegetation
+    
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: q_cdrag          !! Surface drag coefficient (-)
+    
+    !! 0.4 Local variables
+    INTEGER                                            :: ilai
+    INTEGER                                            :: jv
+    INTEGER                                            :: ier
+    CHARACTER(LEN=4)                                   :: laistring
+    CHARACTER(LEN=80)                                  :: var_name        
+    !_ ================================================================================================================================
+    
+    !! Initialize local printlev
+    !printlev_loc=get_printlev('diffuco')
+    
+    !! 1. Define flag ldq_cdrag_from_gcm. This flag determines if the cdrag should be taken from the GCM or be calculated. 
+    !!    The default value is true if the q_cdrag variables was already initialized. This is the case when coupled to the LMDZ.
+
+    !Config Key   = CDRAG_FROM_GCM
+    !Config Desc  = Keep cdrag coefficient from gcm.
+    !Config If    = OK_SECHIBA
+    !Config Def   = y
+    !Config Help  = Set to .TRUE. if you want q_cdrag coming from GCM (if q_cdrag on initialization is non zero).
+    !Config         Keep cdrag coefficient from gcm for latent and sensible heat fluxes.
+    !Config Units = [FLAG]
+    IF ( ABS(MAXVAL(q_cdrag)) .LE. EPSILON(q_cdrag)) THEN
+       ldq_cdrag_from_gcm = .FALSE.
+    ELSE
+       ldq_cdrag_from_gcm = .TRUE.
+    ENDIF
+    CALL getin_p('CDRAG_from_GCM', ldq_cdrag_from_gcm)
+    IF (printlev_loc>=2) WRITE(numout,*) "ldq_cdrag_from_gcm = ",ldq_cdrag_from_gcm
+
+    !! 2. Allocate module variables
+    ALLOCATE (leaf_ci(kjpindex,nvm,nlai),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'diffuco_initialize','Problem in allocate of variable leaf_ci','','')
+    
+    ALLOCATE (wind(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'diffuco_initialize','Problem in allocate of variable wind','','')
+
+    !! 3. Read variables from restart file
+    IF (printlev>=3) WRITE (numout,*) 'Read DIFFUCO variables from restart file'
+
+    CALL ioconf_setatt_p('UNITS', 's/m')
+    CALL ioconf_setatt_p('LONG_NAME','Structural resistance')
+    CALL restget_p (rest_id, 'rstruct', nbp_glo, nvm, 1, kjit, .TRUE., rstruct, "gather", nbp_glo, index_g)
+    IF ( ALL(rstruct(:,:) == val_exp) ) THEN
+       DO jv = 1, nvm
+          rstruct(:,jv) = rstruct_const(jv)
+       ENDDO
+    ENDIF
+    
+    CALL ioconf_setatt_p('UNITS', 'ppm')
+    CALL ioconf_setatt_p('LONG_NAME','Leaf CO2')
+    CALL restget_p (rest_id, 'leaf_ci', nbp_glo, nvm, nlai, kjit, .TRUE.,leaf_ci, "gather", nbp_glo, index_g)
+    
+    !Config Key   = DIFFUCO_LEAFCI
+    !Config Desc  = Initial leaf CO2 level if not found in restart
+    !Config If    = OK_SECHIBA
+    !Config Def   = 233.
+    !Config Help  = The initial value of leaf_ci if its value is not found
+    !Config         in the restart file. This should only be used if the model is
+    !Config         started without a restart file.
+    !Config Units = [ppm]
+    CALL setvar_p (leaf_ci, val_exp,'DIFFUCO_LEAFCI', 233._r_std)
+    
+            
+    !! 4. Initialize chemistry module
+    IF (printlev>=3) WRITE(numout,*) "ok_bvoc:",ok_bvoc
+    IF ( ok_bvoc ) CALL chemistry_initialize(kjpindex, lalo, neighbours, resolution)
+    
+  END SUBROUTINE diffuco_initialize
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : diffuco_main
+!!
+!>\BRIEF	 The root subroutine for the module, which calls all other required
+!! subroutines.
+!! 
+!! DESCRIPTION   : 
+
+!! This is the main subroutine for the module. 
+!! First it calculates the surface drag coefficient (via a call to diffuco_aero), using available parameters to determine
+!! the stability of air in the surface layer by calculating the Richardson Nubmber. If a value for the 
+!! surface drag coefficient is passed down from the atmospheric model and and if the flag 'ldq_cdrag_from_gcm' 
+!! is set to TRUE, then the subroutine diffuco_aerod is called instead. This calculates the aerodynamic coefficient. \n
+!!
+!! Following this, an estimation of the saturated humidity at the surface is made (via a call
+!! to qsatcalc in the module qsat_moisture). Following this the beta coefficients for sublimation (via 
+!! diffuco_snow), interception (diffuco_inter), bare soil (diffuco_bare), and transpiration (via 
+!! diffuco_trans_co2) are calculated in sequence. Finally 
+!! the alpha and beta coefficients are combined (diffuco_comb). \n
+!!
+!! The surface drag coefficient is calculated for use within the module enerbil. It is required to to
+!! calculate the aerodynamic coefficient for every flux. \n
+!!
+!! The various beta coefficients are used within the module enerbil for modifying the rate of evaporation, 
+!! as appropriate for the surface. As explained in Chapter 2 of Guimberteau (2010), that module (enerbil) 
+!! calculates the rate of evaporation essentially according to the expression $E = /beta E_{pot}$, where
+!! E is the total evaporation and $E_{pot}$ the evaporation potential. If $\beta = 1$, there would be
+!! essentially no resistance to evaporation, whereas should $\beta = 0$, there would be no evaporation and
+!! the surface layer would be subject to some very stong hydrological stress. \n
+!!
+!! The following processes are calculated:
+!! - call diffuco_aero for aerodynamic transfer coeficient
+!! - call diffuco_snow for partial beta coefficient: sublimation
+!! - call diffuco_inter for partial beta coefficient: interception for each type of vegetation
+!! - call diffuco_bare for partial beta coefficient: bare soil
+!! - call diffuco_trans_co2 for partial beta coefficient: transpiration for each type of vegetation, using Farqhar's formula
+!! - call diffuco_comb for alpha and beta coefficient
+!! - call chemistry_bvoc for alpha and beta coefficients for biogenic emissions
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): humrel, q_cdrag, vbeta, vbeta1, vbeta4,
+!! vbeta2, vbeta3, rveget, cimean   
+!!
+!! REFERENCE(S) :				        
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273.
+!! - de Rosnay, P, 1999. ReprÃ©sentation des interactions sol-plante-atmosphÃšre dans le modÃšle de circulation gÃ©nÃ©rale
+!! du LMD, 1999. PhD Thesis, UniversitÃ© Paris 6, available (25/01/12): 
+!! http://www.ecmwf.int/staff/patricia_de_rosnay/publications.html#8
+!! - Ducharne, A, 1997. Le cycle de l'eau: modÃ©lisation de l'hydrologie continentale, Ã©tude de ses interactions avec 
+!! le climat, PhD Thesis, UniversitÃ© Paris 6
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available (25/01/12):
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!! - LathiÃšre, J, 2005. Evolution des Ã©missions de composÃ©s organiques et azotÃ©s par la biosphÃšre continentale dans le 
+!! modÃšle LMDz-INCA-ORCHIDEE, UniversitÃ© Paris 6
+!!
+!! FLOWCHART	:
+!! \latexonly 
+!!     \includegraphics[scale=0.5]{diffuco_main_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_main (kjit, kjpindex, &
+     & index, indexveg, indexlai, u, v, &
+     & zlev, z0m, z0h, roughheight, temp_sol, temp_air, &
+     & temp_growth, rau, q_cdrag, qsurf, qair, &
+     & q2m, t2m, pb, evap_bare_lim, &
+     & evapot, evapot_corr, snow, flood_frac, flood_res, &
+     & frac_nobio, snow_nobio, totfrac_nobio, swnet, swdown, &
+     & coszang, ccanopy, humrel, vegstress, veget, &
+     & veget_max, circ_class_biomass,circ_class_n, qsintveg, qsintmax, assim_param, &
+     & vbeta, vbeta1, vbeta2, vbeta3, &
+     & vbeta3pot, vbeta4, vbeta5, gsmean, rveget, &
+     & rstruct, cimean, gpp, lalo, neighbours, &
+     & resolution, ptnlev1, precip_rain, frac_age, tot_bare_soil, &
+     & frac_snow_veg, frac_snow_nobio, &
+     & hist_id, hist2_id, vbeta2sum, vbeta3sum, Isotrop_Abs_Tot_p, &
+!!$     & Isotrop_Tran_Tot_p, lai_per_level, lai, vbeta23, leaf_ci, &
+     & Isotrop_Tran_Tot_p, lai_per_level, vbeta23, leaf_ci, &
+     & gs_distribution, gs_diffuco_output, gstot_component, gstot_frac,&
+     & warnings, u_speed, profile_vbeta3, profile_rveget, &
+     & delta_c13_assim, leaf_ci_out)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number (-) 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),INTENT (in)                         :: hist_id          !! _History_ file identifier (-)
+    INTEGER(i_std),INTENT (in)                         :: hist2_id         !! _History_ file 2 identifier (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: index          !! Indeces of the points on the map (-)
+    INTEGER(i_std),DIMENSION (kjpindex*(nlai+1)), INTENT (in) :: indexlai  !! Indeces of the points on the 3D map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in) :: indexveg       !! Indeces of the points on the 3D map (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: u                !! Eastward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: v                !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: zlev             !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: z0m              !! Surface roughness Length for momentum (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: z0h              !! Surface roughness Length for heat (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: roughheight      !! Effective height for roughness (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_sol         !! Skin temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_air         !! Lowest level temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_growth      !! Growth temperature (Â°C) - Is equal to t2m_month
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: rau              !! Air Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: qsurf            !! Near surface air specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: qair             !! Lowest level air specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: q2m              !! 2m air specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: t2m              !! 2m air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: snow             !! Snow mass (kg)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: flood_frac       !! Fraction of floodplains
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: flood_res        !! Reservoir in floodplains (estimation to avoid over-evaporation)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: pb               !! Surface level pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evap_bare_lim    !! Limit to the bare soil evaporation when the 
+                                                                           !! 11-layer hydrology is used (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot           !! Soil Potential Evaporation (mm day^{-1}) 
+                                                                           !! NdN This variable does not seem to be used at 
+                                                                           !! all in diffuco
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot_corr      !! Soil Potential Evaporation
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: frac_nobio     !! Fraction of ice,lakes,cities,... (-)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio     !! Snow on ice,lakes,cities,... (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: totfrac_nobio    !! Total fraction of ice+lakes+cities+... (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: swnet            !! Net surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: swdown           !! Down-welling surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: coszang          !! Cosine of the solar zenith angle (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: ccanopy          !! CO2 concentration inside the canopy (ppm)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget            !! Fraction of vegetation type (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max        !! Max. fraction of vegetation type (LAI->infty)
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)      :: circ_class_biomass          !! Stand level biomass @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)          :: circ_class_n      !! Stand level biomass @tex $(gC m^{-2})$ @endtex
+
+    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 !! referenced vcmax, nue, leaf N 
+                                                                           !! for photosynthesis
+    REAL(r_std),DIMENSION (kjpindex,2),   INTENT (in)  :: lalo               !! Geographical coordinates
+    INTEGER(i_std),DIMENSION (kjpindex,NbNeighb),INTENT (in):: neighbours    !! Vector of neighbours for each 
+                                                                             !! grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)     :: resolution         !! The size in m of each grid-box in X and Y
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: ptnlev1            !! 1st level of soil temperature (Kelvin)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_rain        !! Rain precipitation expressed in mm/tstep
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT (in)  :: frac_age !! Age efficiency for isoprene emissions (from STOMATE)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: tot_bare_soil      !! Total evaporating bare soil fraction 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: frac_snow_veg      !! Snow cover fraction on vegetated area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in):: frac_snow_nobio    !! Snow cover fraction on none vegetated area
+    REAL(r_std),DIMENSION (kjpindex, nvm), INTENT (in) :: vegstress          !! Relative Soil water content accounting for root profile (m3 m-3)
+    REAL(r_std),DIMENSION (:,:,:), INTENT (in)         :: Isotrop_Abs_Tot_p  !! Absorbed radiation per level for photosynthesis
+    REAL(r_std),DIMENSION (:,:,:), INTENT (in)         :: Isotrop_Tran_Tot_p !! Absorbed radiation per level for photosynthesis
+    REAL(r_std), DIMENSION(:,:,:), INTENT(IN)          :: lai_per_level      !! This is the LAI per vertical level
+                                                                             !! @tex $(m^{2} m^{-2})$
+    REAL(r_std), DIMENSION (:), INTENT (in)            :: u_speed            !! wind speed at specified canopy level (m/s)
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta            !! Total beta coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta1           !! Beta for sublimation (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta4           !! Beta for bare soil evaporation (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta5           !! Beta for floodplains
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: gsmean           !! Mean stomatal conductance to CO2 (mol m-2 s-1) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta2           !! Beta for interception loss (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta3           !! Beta for transpiration (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta3pot        !! Beta for potential transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: rveget           !! Stomatal resistance for the whole canopy (s m^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: rstruct        !! Structural resistance for the vegetation
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: cimean           !! Mean leaf Ci (ppm)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: gpp              !! Assimilation ((gC m^{-2} s^{-1}), total area)        
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta23          !! Beta for fraction of wetted foliage that will
+                                                                           !! transpire once intercepted water has evaporated (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlai), INTENT (out)  :: leaf_ci    !! intercellular CO2 concentration (ppm)
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (out)       :: gs_distribution
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (out)       :: gs_diffuco_output
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (out)       :: gstot_component
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (out)       :: gstot_frac
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (out)       :: profile_vbeta3
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (out)       :: profile_rveget
+
+    REAL(r_std),DIMENSION (kjpindex,nvm)                    :: delta_c13_assim  !! C13 concentration in delta notation
+                                                                                !! @tex $ permille $ @endtex (per thousand)   
+    REAL(r_std),DIMENSION (kjpindex,nvm)                    :: leaf_ci_out      !! Ci    
+
+    !! 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       !! Surface drag coefficient (-)
+    REAL(r_std),DIMENSION(kjpindex,nvm,nwarns), INTENT(inout) &
+                                                           :: warnings     !! A warning counter
+
+    !! 0.4 Local variables
+    REAL(r_std),DIMENSION(kjpindex)          :: vbeta2sum, vbeta3sum
+    REAL(r_std),DIMENSION(kjpindex)          :: raero              !! Aerodynamic resistance (s m^{-1})
+    INTEGER(i_std)                           :: ilai
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: lai                !! PFT leaf area index (m^{2} m^{-2})
+    CHARACTER(LEN=4)                         :: laistring
+    CHARACTER(LEN=80)                        :: var_name           !! To store variables names for I/O
+    REAL(r_std),DIMENSION(kjpindex)          :: qsatt              !! Surface saturated humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: cim                !! Intercellular CO2 over nlai 
+    ! Isotope_c13
+    INTEGER(i_std), DIMENSION(kjpindex)                     :: index_assi        !! indices (unitless)
+    INTEGER(i_std)                                          :: nia,inia,nina,iainia   !! counter/indices (unitless)
+    INTEGER(i_std)                                          :: ji,jl,jv          !! Indices (-)    
+    REAL(r_std), DIMENSION(nlai+1)                          :: laitab            !! LAI per layer (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm)                    :: assimi            !! assimilation (at a specific LAI level)
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm)                    :: assimtot          !! total assimilation 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nlevels_tot)        :: assimi_lev        !! assimilation (at all LAI levels)
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+
+!_ ================================================================================================================================
+    
+
+    gs_distribution = 0.0d0
+    wind(:) = SQRT (u(:)*u(:) + v(:)*v(:))
+  
+  !! 1. Calculate the different coefficients
+
+    IF (.NOT.ldq_cdrag_from_gcm) THEN
+        ! Case 1a)
+       CALL diffuco_aero (kjpindex, kjit, u, v, zlev, z0h, z0m, roughheight, temp_sol, temp_air, &
+                          qsurf, qair, snow, q_cdrag)
+    ENDIF
+
+    ! Case 1b)
+    CALL diffuco_raerod (kjpindex, u, v, q_cdrag, raero)
+
+  !! 2. Make an estimation of the saturated humidity at the surface
+
+    CALL qsatcalc (kjpindex, temp_sol, pb, qsatt)
+
+  !! 3. Calculate the beta coefficient for sublimation
+  
+    CALL diffuco_snow (kjpindex, qair, qsatt, rau, u, v, q_cdrag, &
+         & snow, frac_nobio, totfrac_nobio, snow_nobio, &
+         & frac_snow_veg, frac_snow_nobio, vbeta1)
+
+
+    CALL diffuco_flood (kjpindex, qair, qsatt, rau, u, v, q_cdrag, evapot, evapot_corr, &
+         & flood_frac, flood_res, vbeta5)
+
+  !! 4. Calculate the beta coefficient for interception
+
+    CALL diffuco_inter (kjpindex, qair, qsatt, rau, u, v, q_cdrag, humrel, veget, &
+       & qsintveg, qsintmax, rstruct, vbeta2, vbeta23) 
+
+
+  !! 5. Calculate the beta coefficient for transpiration
+    ! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul Rveget
+    ! case 8a)
+    CALL diffuco_trans_co2 (kjpindex, dt_sechiba, swdown, temp_sol, pb, qsurf, q2m, t2m, &
+         temp_growth, rau, u, v, q_cdrag, humrel, vegstress, &
+         assim_param, ccanopy, circ_class_biomass, circ_class_n,&
+         veget_max, qsintveg, qsintmax, vbeta3, vbeta3pot, &
+         rveget, rstruct, cimean, gsmean, gpp, vbeta23, Isotrop_Abs_Tot_p,&
+         Isotrop_Tran_Tot_p, lai_per_level, gs_distribution, gs_diffuco_output, &
+         gstot_component, gstot_frac, veget, warnings, u_speed, profile_vbeta3, &
+         profile_rveget, index_assi, leaf_ci, assimtot, assimi_lev, hist_id, &
+         indexveg, indexlai, index, kjit, cim)
+    
+    ! calculate C13 isotopic signature
+    IF (ok_c13) THEN
+       
+       CALL isotope_c13(kjpindex, index_assi, leaf_ci, ccanopy, lai_per_level, &
+            assimtot, delta_c13_assim, leaf_ci_out, nvm, &
+            nlevels_tot, assimi_lev)
+       
+    ENDIF
+       
+    !
+    !biogenic emissions
+    !
+    IF ( ok_bvoc ) THEN
+
+       ! Calculate BVOC emissions
+       CALL chemistry_bvoc (kjpindex, swdown, coszang, temp_air, &
+            temp_sol, ptnlev1, precip_rain, humrel, veget_max, &
+            circ_class_biomass, circ_class_n, frac_age, lalo, ccanopy, &
+            cim, wind, snow, &
+            veget, hist_id, hist2_id, kjit, index, &
+            indexlai, indexveg)
+
+    ENDIF
+    !
+    ! combination of coefficient : alpha and beta coefficient
+    ! beta coefficient for bare soil
+    !
+
+    CALL diffuco_bare (kjpindex, evap_bare_lim, vbeta2, vbeta3, vbeta4)
+
+  !! 6. Combine the alpha and beta coefficients
+
+    ! Ajout qsintmax dans les arguments de la routine.... Nathalie / le 13-03-2006
+    CALL diffuco_comb (kjpindex, humrel, rau, u, v, q_cdrag, pb, qair, temp_sol, temp_air, snow, &
+        veget, circ_class_biomass,circ_class_n, &
+        tot_bare_soil, vbeta1, vbeta2, vbeta3, vbeta4, vbeta, qsintmax, vbeta2sum, vbeta3sum)
+
+    CALL xios_orchidee_send_field("q_cdrag",q_cdrag)
+    CALL xios_orchidee_send_field("raero",raero)
+    CALL xios_orchidee_send_field("wind",wind)
+    CALL xios_orchidee_send_field("qsatt",qsatt)
+    CALL xios_orchidee_send_field("coszang",coszang)
+    CALL xios_orchidee_send_field('cim', cim)
+
+    IF ( .NOT. almaoutput ) THEN
+       CALL histwrite_p(hist_id, 'raero', kjit, raero, kjpindex, index)
+       CALL histwrite_p(hist_id, 'cdrag', kjit, q_cdrag, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Wind', kjit, wind, kjpindex, index)
+       CALL histwrite_p(hist_id, 'qsatt', kjit, qsatt, kjpindex, index)
+
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'raero', kjit, raero, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'cdrag', kjit, q_cdrag, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Wind', kjit, wind, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'qsatt', kjit, qsatt, kjpindex, index)
+       ENDIF
+    ELSE
+       CALL histwrite_p(hist_id, 'cim', kjit, cim, kjpindex*nvm, indexveg)
+    ENDIF
+
+    IF (printlev>=3) WRITE (numout,*) ' diffuco_main done '
+
+  END SUBROUTINE diffuco_main
+
+!!  =============================================================================================================================
+!! SUBROUTINE: diffuco_finalize
+!!
+!>\BRIEF          Write to restart file
+!!
+!! DESCRIPTION:   This subroutine writes the module variables and variables calculated in diffuco
+!!                to restart file
+!!
+!! RECENT CHANGE(S): None
+!! REFERENCE(S): None
+!! FLOWCHART: None
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE diffuco_finalize (kjit, kjpindex, rest_id, rstruct )
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number (-) 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),INTENT (in)                         :: rest_id          !! _Restart_ file identifier (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: rstruct          !! Structural resistance for the vegetation
+
+    !! 0.4 Local variables
+    INTEGER                                            :: ilai
+    CHARACTER(LEN=4)                                   :: laistring
+    CHARACTER(LEN=80)                                  :: var_name        
+
+!_ ================================================================================================================================
+    
+  !! 1. Prepare the restart file for the next simulation
+    IF (printlev>=3) WRITE (numout,*) 'Complete restart file with DIFFUCO variables '
+
+    CALL restput_p (rest_id, 'rstruct', nbp_glo, nvm, 1, kjit, rstruct, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'leaf_ci', nbp_glo, nvm, nlai, kjit, leaf_ci, 'scatter',  nbp_glo, index_g)
+    
+  END SUBROUTINE diffuco_finalize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE		 			: diffuco_clear
+!!
+!>\BRIEF					Housekeeping module to deallocate the variables
+!! leaf_ci, rstruct and raero
+!!
+!! DESCRIPTION				        : Housekeeping module to deallocate the variables
+!! leaf_ci, rstruct and raero
+!!
+!! RECENT CHANGE(S)                             : None
+!!
+!! MAIN OUTPUT VARIABLE(S)	                : None
+!!
+!! REFERENCE(S)				        : None
+!!
+!! FLOWCHART                                    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_clear()
+
+    IF (ALLOCATED (leaf_ci)) DEALLOCATE (leaf_ci)
+
+    ! Deallocate and reset variables in chemistry module
+    CALL chemistry_clear
+
+  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, z0h, z0m, roughheight, temp_sol, temp_air, &
+                           qsurf, qair, snow, q_cdrag)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjpindex, kjit   !! Domain size
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: u                !! Eastward Lowest level wind speed (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: v                !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: zlev             !! Height of first atmospheric layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: z0h               !! Surface roughness Length for heat (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: z0m               !! Surface roughness Length for momentum (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: roughheight      !! Effective roughness height (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: temp_sol         !! Ground temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: temp_air         !! Lowest level temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: qsurf            !! near surface specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: qair             !! Lowest level specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: snow             !! Snow mass (kg)
+
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: q_cdrag          !! Surface drag coefficient (-) 
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jv
+    REAL(r_std)                                         :: speed, zg, zdphi, ztvd, ztvs, zdu2
+    REAL(r_std)                                         :: zri, cd_neut, zscf, cd_tmp
+    REAL(r_std)                                         :: snowfact
+!_ ================================================================================================================================
+
+  !! 1. Initialisation
+
+    ! test if we have to work with q_cdrag or to calcul it
+    DO ji=1,kjpindex
+       
+       !! 1a).1 Designation of wind speed
+       !! \latexonly 
+       !!     \input{diffucoaero1.tex}
+       !! \endlatexonly
+       speed = wind(ji)
+    
+       !! 1a).2 Calculation of geopotentiel
+       !! This is the definition of Geopotential height (e.g. Jacobson eqn.4.47, 2005). (required
+       !! for calculation of the Richardson Number)
+       !! \latexonly 
+       !!     \input{diffucoaero2.tex}
+       !! \endlatexonly
+       zg = zlev(ji) * cte_grav
+      
+       !! \latexonly 
+       !!     \input{diffucoaero3.tex}
+       !! \endlatexonly
+       zdphi = zg/cp_air
+       
+       !! 1a).3 Calculation of the virtual air temperature at the surface 
+       !! required for calculation of the Richardson Number
+       !! \latexonly 
+       !!     \input{diffucoaero4.tex}
+       !! \endlatexonly
+       ztvd = (temp_air(ji) + zdphi / (un + rvtmp2 * qair(ji))) * (un + retv * qair(ji)) 
+       
+       !! 1a).4 Calculation of the virtual surface temperature 
+       !! required for calculation of the Richardson Number
+       !! \latexonly 
+       !!     \input{diffucoaero5.tex}
+       !! \endlatexonly
+       ztvs = temp_sol(ji) * (un + retv * qsurf(ji))
+     
+       !! 1a).5 Calculation of the squared wind shear 
+       !! required for calculation of the Richardson Number
+       !! \latexonly 
+       !!     \input{diffucoaero6.tex}
+       !! \endlatexonly
+       zdu2 = MAX(cepdu2,speed**2)
+       
+       !! 1a).6 Calculation of the Richardson Number
+       !!  The Richardson Number is defined as the ratio of potential to kinetic energy, or, in the 
+       !!  context of atmospheric science, of the generation of energy by wind shear against consumption
+       !!  by static stability and is an indicator of flow stability (i.e. for when laminar flow 
+       !!  becomes turbulent and vise versa).\n
+       !!  It is approximated using the expression below:
+       !!  \latexonly 
+       !!     \input{diffucoaero7.tex}
+       !! \endlatexonly
+       zri = zg * (ztvd - ztvs) / (zdu2 * ztvd)
+      
+       !! The Richardson Number hence calculated is subject to a minimum value:
+       !! \latexonly 
+       !!     \input{diffucoaero8.tex}
+       !! \endlatexonly       
+       zri = MAX(MIN(zri,5.),-5.)
+       
+       !! 1a).7 Computing the drag coefficient
+       !!  We add the add the height of the vegetation to the level height to take into account
+       !!  that the level 'seen' by the vegetation is actually the top of the vegetation. Then we 
+       !!  we can subtract the displacement height.
+       !! \latexonly 
+       !!     \input{diffucoaero9.tex}
+       !! \endlatexonly
+
+       !! 7.0 Snow smoothering
+       !! Snow induces low levels of turbulence.
+       !! Sensible heat fluxes can therefore be reduced of ~1/3. Pomeroy et al., 1998
+       snowfact=1.
+       IF (snow(ji).GT.snowcri .AND. ok_snowfact .AND. (.NOT. rough_dyn))  snowfact=10.
+
+       cd_neut = ct_karman ** 2. / ( LOG( (zlev(ji) + roughheight(ji)) / z0m(ji) ) * LOG( (zlev(ji) + roughheight(ji)) / z0h(ji) ) )
+       
+       !! 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)) / z0m(ji)/snowfact)))
+
+          !! \latexonly 
+          !!     \input{diffucoaero13.tex}
+          !! \endlatexonly               
+          cd_tmp=cd_neut * (un - trois * cb * zri * zscf)
+       ENDIF
+       
+       !! If the Drag Coefficient becomes too small than the surface may uncouple from the atmosphere.
+       !! To prevent this, a minimum limit to the drag coefficient is defined as:
+       
+       !! \latexonly 
+       !!     \input{diffucoaero14.tex}
+       !! \endlatexonly
+       !!
+       q_cdrag(ji) = MAX(cd_tmp, 1.e-4/MAX(speed,min_wind))
+
+       ! In some situations it might be useful to give an upper limit on the cdrag as well. 
+       ! The line here should then be uncommented.
+      !q_cdrag(ji) = MIN(q_cdrag(ji), 0.5/MAX(speed,min_wind))
+
+    END DO
+
+    IF (printlev_loc>=3) WRITE (numout,*) ' not ldqcdrag_from_gcm : diffuco_aero done '
+
+  END SUBROUTINE diffuco_aero
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : diffuco_snow
+!!
+!>\BRIEF         This subroutine computes the beta coefficient for snow sublimation.
+!!
+!! DESCRIPTION   : This routine computes beta coefficient for snow sublimation, which
+!! integrates the snow on both vegetation and other surface types (e.g. ice, lakes,
+!! cities etc.) \n
+!!
+!! A critical depth of snow (snowcri) is defined to calculate the fraction of each grid-cell
+!! that is covered with snow (snow/snowcri) while the remaining part is snow-free.
+!! We also carry out a first calculation of sublimation (subtest) to lower down the beta
+!! coefficient if necessary (if subtest > snow). This is a predictor-corrector test. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::vbeta1 
+!!
+!! REFERENCE(S) :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp. 248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+SUBROUTINE diffuco_snow (kjpindex, qair, qsatt, rau, u, v,q_cdrag, &
+       & snow, frac_nobio, totfrac_nobio, snow_nobio, &
+       & frac_snow_veg, frac_snow_nobio, vbeta1)
+
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT(in)                           :: kjpindex       !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qair           !! Lowest level specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qsatt          !! Surface saturated humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: rau            !! Air density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: u              !! Eastward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: v              !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: q_cdrag        !! Surface drag coefficient (-)
+    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. (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)         :: frac_snow_veg  !! Snow cover fraction on vegeted area  
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in)  :: frac_snow_nobio!! Snow cover fraction on non-vegeted area  
+
+
+    !! 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)) * frac_snow_veg(ji)
+
+       ! Limitation of sublimation in case of snow amounts smaller 
+       ! than the atmospheric demand. 
+       speed = MAX(min_wind, wind(ji))
+
+       subtest = dt_sechiba * vbeta1(ji) * speed * q_cdrag(ji) * rau(ji) * &
+               & ( qsatt(ji) - qair(ji) )
+
+       IF ( subtest .GT. zero ) THEN
+          zrapp = snow(ji) / subtest
+          IF ( zrapp .LT. un ) THEN
+             vbeta1(ji) = vbeta1(ji) * zrapp
+          ENDIF
+       ENDIF
+
+    END DO ! Loop over # pixels - domain size
+
+  !! 2. Add the beta coefficients calculated from other surfaces types (snow on ice,lakes, cities...)
+
+    DO jv = 1, nnobio ! Loop over # other surface types
+!!$      !
+!!$      IF ( jv .EQ. iice ) THEN
+!!$        !
+!!$        !  Land ice is of course a particular case
+!!$        !
+!!$        DO ji=1,kjpindex
+!!$          vbeta1(ji) = vbeta1(ji) + frac_nobio(ji,jv)
+!!$        ENDDO
+!!$        !
+!!$      ELSE
+        !
+        DO ji=1,kjpindex ! Loop over # pixels - domain size
+
+           vbeta1_add = frac_nobio(ji,jv) * MAX(MIN(snow_nobio(ji,jv)/snowcri,un), zero)
+
+           ! Limitation of sublimation in case of snow amounts smaller than
+           ! the atmospheric demand. 
+           speed = MAX(min_wind, wind(ji))
+            
+            !!     Limitation of sublimation by the snow accumulated on the ground 
+            !!     A first approximation is obtained with the old values of
+            !!     qair and qsol_sat: function of temp-sol and pb. (see call of qsatcalc)
+           subtest = dt_sechiba * vbeta1_add * speed * q_cdrag(ji) * rau(ji) * &
+                & ( qsatt(ji) - qair(ji) )
+
+           IF ( subtest .GT. zero ) THEN
+              zrapp = snow_nobio(ji,jv) / subtest
+              IF ( zrapp .LT. un ) THEN
+                 vbeta1_add = vbeta1_add * zrapp
+              ENDIF
+           ENDIF
+
+           vbeta1(ji) = vbeta1(ji) + vbeta1_add
+
+        ENDDO ! Loop over # pixels - domain size
+
+!!$      ENDIF
+      
+    ENDDO ! Loop over # other surface types
+
+    IF (printlev>=3) WRITE (numout,*) ' diffuco_snow done '
+
+  END SUBROUTINE diffuco_snow
+
+
+!! ================================================================================================================================
+!! SUBROUTINE		 			: diffuco_flood 
+!!
+!>\BRIEF				       	This routine computes partial beta coefficient : floodplains
+!!
+!! DESCRIPTION				        : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S)	                : vbeta5
+!!
+!! REFERENCE(S)				        : None
+!!
+!! FLOWCHART                                    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_flood (kjpindex, qair, qsatt, rau, u, v, q_cdrag, evapot, evapot_corr, &
+       & flood_frac, flood_res, vbeta5)
+
+    ! interface description
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex   !! Domain size
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair       !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qsatt      !! Surface saturated humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau        !! Density
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u          !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: v          !! Lowest level wind speed
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag    !! Surface drag coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: flood_res  !! water mass in flood reservoir
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: flood_frac !! fraction of floodplains
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: evapot     !! Potential evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: evapot_corr!! Potential evaporation2
+    ! output fields
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: vbeta5     !! Beta for floodplains
+
+    ! local declaration
+    REAL(r_std)                                              :: subtest, zrapp, speed
+    INTEGER(i_std)                                           :: ji, jv
+
+!_ ================================================================================================================================
+    !
+    ! beta coefficient for sublimation for floodplains
+    !
+    DO ji=1,kjpindex
+       !
+       IF (evapot(ji) .GT. min_sechiba) THEN
+          vbeta5(ji) = flood_frac(ji) *evapot_corr(ji)/evapot(ji)
+       ELSE
+          vbeta5(ji) = flood_frac(ji)
+       ENDIF
+       !
+       ! -- Limitation of evaporation in case of water amounts smaller than
+       !    the atmospheric demand. 
+       
+       !
+       speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+       !
+       subtest = dt_sechiba * vbeta5(ji) * speed * q_cdrag(ji) * rau(ji) * &
+               & ( qsatt(ji) - qair(ji) )
+       !  
+       IF ( subtest .GT. zero ) THEN
+          zrapp = flood_res(ji) / subtest
+          IF ( zrapp .LT. un ) THEN
+             vbeta5(ji) = vbeta5(ji) * zrapp
+          ENDIF
+       ENDIF
+       !
+    END DO
+
+    IF (printlev>=3) WRITE (numout,*) ' diffuco_flood done '
+
+  END SUBROUTINE diffuco_flood
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : diffuco_inter
+!!
+!>\BRIEF	 This routine computes the partial beta coefficient
+!! for the interception for each type of vegetation
+!!
+!! DESCRIPTION   : We first calculate the dry and wet parts of each PFT (wet part = qsintveg/qsintmax).
+!! The former is submitted to transpiration only (vbeta3 coefficient, calculated in 
+!! diffuco_trans_co2), while the latter is first submitted to interception loss 
+!! (vbeta2 coefficient) and then to transpiration once all the intercepted water has been evaporated 
+!! (vbeta23 coefficient). Interception loss is also submitted to a predictor-corrector test, 
+!! as for snow sublimation. \n
+!!
+!! \latexonly 
+!!     \input{diffucointer1.tex}
+!! \endlatexonly
+!! Calculate the wet fraction of vegetation as  the ration between the intercepted water and the maximum water 
+!! on the vegetation. This ratio defines the wet portion of vegetation that will be submitted to interception loss.
+!!
+!! \latexonly 
+!!     \input{diffucointer2.tex}
+!! \endlatexonly
+!!
+!! Calculation of $\beta_3$, the canopy transpiration resistance
+!! \latexonly 
+!!     \input{diffucointer3.tex}
+!! \endlatexonly            
+!! 
+!! We here determine the limitation of interception loss by the water stored on the leaf. 
+!! A first approximation of interception loss is obtained using the old values of
+!! qair and qsol_sat, which are functions of temp-sol and pb. (see call of 'qsatcalc')
+!! \latexonly 
+!!     \input{diffucointer4.tex}
+!! \endlatexonly
+!!
+!! \latexonly
+!!     \input{diffucointer5.tex}
+!! \endlatexonly
+!!
+!! \latexonly 
+!!     \input{diffucointer6.tex}
+!! \endlatexonly
+!!
+!! Once the whole water stored on foliage has evaporated, transpiration can take place on the fraction
+!! 'zqsvegrap'.
+!! \latexonly 
+!!     \input{diffucointer7.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::vbeta2, ::vbeta23
+!!
+!! REFERENCE(S) :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp. 248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!! - Perrier, A, 1975. Etude physique de l'Ã©vaporation dans les conditions naturelles. Annales 
+!! Agronomiques, 26(1-18): pp. 105-123, pp. 229-243
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_inter (kjpindex, qair, qsatt, rau, u, v, q_cdrag, humrel, veget, &
+     & qsintveg, qsintmax, rstruct, vbeta2, vbeta23)
+   
+  !! 0 Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                           :: kjpindex   !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qair       !! Lowest level specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qsatt      !! Surface saturated humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: rau        !! Air Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: u          !! Eastward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: v          !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: q_cdrag    !! Surface drag coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: humrel     !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget      !! vegetation fraction for each type (fraction)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintveg   !! Water on vegetation due to interception (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintmax   !! Maximum water on vegetation (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: rstruct    !! architectural resistance (s m^{-1})
+    
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: vbeta2     !! Beta for interception loss (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: vbeta23    !! Beta for fraction of wetted foliage that will 
+                                                                       !! transpire (-)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                       :: ji, jv                               !! (-), (-)
+    REAL(r_std)                                          :: zqsvegrap, ziltest, zrapp, speed     !!
+!_ ================================================================================================================================
+
+  !! 1. Initialize
+
+    vbeta2(:,:) = zero
+    vbeta23(:,:) = zero
+   
+  !! 2. The beta coefficient for interception by vegetation. 
+    
+    DO jv = 2,nvm
+
+      DO ji=1,kjpindex
+
+         IF (veget(ji,jv) .GT. min_sechiba .AND. qsintveg(ji,jv) .GT. zero ) THEN
+
+            zqsvegrap = zero
+            IF (qsintmax(ji,jv) .GT. min_sechiba ) THEN
+
+            !! \latexonly 
+            !!     \input{diffucointer1.tex}
+            !! \endlatexonly
+            !!
+            !! We calculate the wet fraction of vegetation as  the ration between the intercepted water and the maximum water 
+            !! on the vegetation. This ratio defines the wet portion of vegetation that will be submitted to interception loss.
+            !!
+                zqsvegrap = MAX(zero, qsintveg(ji,jv) / qsintmax(ji,jv))
+            END IF
+
+            !! \latexonly 
+            !!     \input{diffucointer2.tex}
+            !! \endlatexonly
+            speed = MAX(min_wind, wind(ji))
+
+            !! Calculation of $\beta_3$, the canopy transpiration resistance
+            !! \latexonly 
+            !!     \input{diffucointer3.tex}
+            !! \endlatexonly
+            vbeta2(ji,jv) = veget(ji,jv) * zqsvegrap * (un / (un + speed * q_cdrag(ji) * rstruct(ji,jv)))
+            
+            !! We here determine the limitation of interception loss by the water stored on the leaf. 
+            !! A first approximation of interception loss is obtained using the old values of
+            !! qair and qsol_sat, which are functions of temp-sol and pb. (see call of 'qsatcalc')
+            !! \latexonly 
+            !!     \input{diffucointer4.tex}
+            !! \endlatexonly
+            ziltest = dt_sechiba * vbeta2(ji,jv) * speed * q_cdrag(ji) * rau(ji) * &
+               & ( qsatt(ji) - qair(ji) )
+
+            IF ( ziltest .GT. zero ) THEN
+
+                !! \latexonly 
+                !!     \input{diffucointer5.tex}
+                !! \endlatexonly
+                zrapp = qsintveg(ji,jv) / ziltest
+                IF ( zrapp .LT. un ) THEN
+                   
+                    !! \latexonly 
+                    !!     \input{diffucointer6.tex}
+                    !! \endlatexonly
+                    !!
+		    !! Once the whole water stored on foliage has evaporated, transpiration can take place on the fraction
+                    !! 'zqsvegrap'.
+                   IF ( humrel(ji,jv) >= min_sechiba ) THEN
+                      vbeta23(ji,jv) = MAX(vbeta2(ji,jv) - vbeta2(ji,jv) * zrapp, zero)
+                   ELSE
+                      ! We don't want transpiration when the soil cannot deliver it
+                      vbeta23(ji,jv) = zero
+                   ENDIF
+                    
+                    !! \latexonly 
+                    !!     \input{diffucointer7.tex}
+                    !! \endlatexonly
+                    vbeta2(ji,jv) = vbeta2(ji,jv) * zrapp
+                ENDIF
+            ENDIF
+        END IF
+!        ! Autre formulation possible pour l'evaporation permettant une transpiration sur tout le feuillage
+!        !commenter si formulation Nathalie sinon Tristan
+!        speed = MAX(min_wind, wind(ji))
+!        
+!        vbeta23(ji,jv) = MAX(zero, veget(ji,jv) * (un / (un + speed * q_cdrag(ji) * rstruct(ji,jv))) - vbeta2(ji,jv))
+
+      END DO
+
+    END DO
+
+    IF (printlev>=3) WRITE (numout,*) ' diffuco_inter done '
+
+  END SUBROUTINE diffuco_inter
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE      : diffuco_bare
+!!
+!>\BRIEF	   This routine computes the partial beta coefficient corresponding to
+!! bare soil
+!!
+!! DESCRIPTION	   : Bare soil evaporation is 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, evap_bare_lim, vbeta2, vbeta3, vbeta4)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjpindex       !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evap_bare_lim  !! limiting factor for bare soil evaporation when the 
+                                                                         !! 11-layer hydrology is used (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vbeta2         !! Beta for Interception 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vbeta3         !! Beta for Transpiration 
+
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta4         !! Beta for bare soil evaporation (-)
+    
+    !! 0.3 Modified variables
+        
+    !! 0.4 Local variables
+    INTEGER(i_std)                                     :: ji
+!_ ================================================================================================================================
+
+    IF (printlev>=2) WRITE (numout,*) 'Entering diffuco_bare'
+
+    !! 1. Calculation of the soil resistance and the beta (beta_4) for bare soil
+    DO ji = 1, kjpindex
+       
+       ! The limitation by 1-beta2-beta3 is due to the fact that evaporation under vegetation is possible
+       !! \latexonly 
+       !!     \input{diffucobare3.tex}
+       !! \endlatexonly
+       vbeta4(ji) = MIN(evap_bare_lim(ji), un - SUM(vbeta2(ji,:)+vbeta3(ji,:)))
+    END DO
+        
+    IF (printlev>=3) WRITE (numout,*) ' diffuco_bare done '
+    
+  END SUBROUTINE diffuco_bare
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : diffuco_trans_co2
+!!
+!>\BRIEF        This subroutine computes carbon assimilation and stomatal 
+!! conductance, following respectively Farqhuar et al. (1980) and Ball et al. (1987) 
+!! and Yin X and Struik PC. 2009.
+!!
+!! DESCRIPTION  :\n
+!! *** General:\n 
+!! The equations are different depending on the photosynthesis mode (C3 versus C4).
+!! Based on the work of Farquhar, von Caemmerer and Berry who published in 1980 a
+!! biochemical model for C3 photosynthetic rates (the FvCB model), Yin and
+!! Struik 2009 propose an analytical algorithm that incorporates a gs model and uses gm as a
+!! temperature-dependent parameter for calculating assimilation based on the FvCB
+!! model for various environmental scenarios. Yin and Struik 2009 also propose a
+!! C4-equivalent version of the FvCB model and an associated analytical algorithm
+!! for this model. They believe that applying FvCB-type models to both C3 and C4
+!! crops is recommended to accurately predict the response of crop photosynthesis
+!! to multiple, interactive environmental variables.  \n
+!!
+!!  Besides an analytical solution for photosynthesis the scheme includes a
+!! modified Arrhenius function for the temperature dependence that accounts for a
+!! decrease of Vcmax and Jmax at high temperatures and a temperature dependent
+!! J max/Vcmax ratio (Kattge & Knorr 2007). The temperature response of Vcmax and
+!! J max was parametrized with values from reanalysed data in literature (Kattge &
+!! Knorr 2007), whereas Vcmax and Jmax at a reference temperature of 25Â° C were
+!! derived from observed species-specific values in the TRY database (Kattge et
+!! al. 2011).
+!!   
+!! In this version here we replace the old trunk assimilation and conductance 
+!! which were computed over 20 levels of LAI and then integrated at the canopy level. 
+!! These artificial LAI levels  were introduced in order to allow for a saturation of
+!! photosynthesis with LAI, but they have no physical meaning. The approach of
+!  the two stream radiation transfer model was extended for a multi-layer canopy.
+!! The user can choose the numbers of layers in the run.def and the available light at
+!! each layers decides about the numbers of layers used for the photosynthesis
+!! calculation.
+!!
+!! NOTE: The variable Isotrop_Abs_Tot_p is the amount of light abosrbed by the canopy,
+!!       according to the two stream albedo routine.  Notice that this is the absorption
+!!       profile for light coming from an isotropic source (e.g. clouds, and what little
+!!       light is scattered by the atmosphere on a sunny day).  The real absorbed light
+!!       should have both the incoming radiation from clouds and the incoming radiation
+!!       from the sun, not just a single number like we have now.  If that information
+!!       ever becomes available, Collim_Abs_Tot should be passed from the albedo routines
+!!       and used here as well.
+!!
+!! RECENT CHANGE(S): 
+!!
+!! MAIN OUTPUT VARIABLE(S): beta coefficients, resistances, CO2 intercellular 
+!! concentration
+!!
+!! REFERENCE(S) :
+!!
+!!     Yin X, Struik PC. C3 and C4 photosynthesis models: an overview from the
+!! perspective of crop modelling. NJAS-Wageningen Journal of Life Sciences 2009.
+!!     C.J. Bernacchi, A.R. Portis, H. Nakano, S. von Caemmerer, S.P. Long,
+!! Temperature response of mesophyll conductance. Implication for the determination
+!! of Rubisco enzyme kinetics and for limitations to photosynthesis in vivo, Plant
+!! Physiology 130 (2002) 1992â1998.
+!!     C.J. Bernacchi, E.L. Singsaas, C. Pimentel, A.R. Portis Jr., S.P. Long,
+!! Improved temperature response functions for models of Rubisco-limited
+!! photosynthesis, Plant, Cell and Environment 24 (2001) 253â259.
+!!     B.E. Medlyn, E. Dreyer, D. Ellsworth, M. Forstreuter, P.C. Harley, M.U.F.
+!! Kirschbaum, X. Le Roux, P. Montpied, J. Strassemeyer, A. Walcroft, K. Wang, D.
+!! Loustau, Temperature response of parameters of a biochemically based model of
+!! photosynthesis. II. A review of experimental data, Plant, Cell and Environ- ment
+!! 25 (2002) 1167â1179.
+!!     Kattge, J. and Knorr, W.: Temperature acclimation in a biochemical model of
+!! photosynthesis: a reanalysis of data from 36 species, Plant Cell Environ., 30
+!! (2007) 1176â1190.
+!!     Keenan, T., et al., Soil water stress and coupled photosynthesisâconductance
+!! models: Bridging the gap between conflicting reports on the relative roles of
+!! stomatal, mesophyll conductance and biochemical limitations to photosynthesis.
+!! Agric. Forest Meteorol. (2010) 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE diffuco_trans_co2 (kjpindex, dt_sechiba, swdown, temp_sol, pb, qsurf, q2m, t2m, &
+                                temp_growth, rau, u, v, q_cdrag, humrel, vegstress, &
+                                assim_param, Ca, circ_class_biomass,circ_class_n,&
+                                veget_max, qsintveg, qsintmax, vbeta3, vbeta3pot, rveget, rstruct, &
+                                cimean, gsmean, gpp, vbeta23, Isotrop_Abs_Tot_p,&
+                                Isotrop_Tran_Tot_p, lai_per_level, gs_distribution, gs_diffuco_output, &
+                                gstot_component, gstot_frac, veget, warnings, u_speed, profile_vbeta3, &
+                                profile_rveget, index_assi, leaf_ci, assimtot, assimi_lev, &
+                                hist_id, indexveg, indexlai, index, kjit, cim)
+
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: kjpindex         !! Domain size (unitless)
+    REAL(r_std), INTENT (in)                                 :: dt_sechiba          !! Time step (s)
+    REAL(r_std),DIMENSION (:), INTENT (in)                   :: swdown           !! Downwelling short wave flux 
+                                                                                 !! @tex ($W m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (:), INTENT (in)                   :: temp_sol         !! Skin temperature (K)
+    REAL(r_std),DIMENSION (:), INTENT (in)                   :: pb               !! Lowest level pressure (hPa)
+    REAL(r_std),DIMENSION (:), INTENT (in)                   :: qsurf            !! Near surface specific humidity 
+                                                                                 !! @tex ($kg kg^{-1}$) @endtex
+    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)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_growth      !! Growth temperature (Â°C) - Is equal to t2m_month
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau              !! air density @tex ($kg m^{-3}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u                !! Lowest level wind speed 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: v                !! Lowest level wind speed 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag          !! Surface drag coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: humrel           !! Soil moisture stress (0-1,unitless)
+    REAL(r_std),DIMENSION (:,:,:), INTENT (in)               :: assim_param      !! min+max+opt temps (K), vcmax, vjmax for 
+                                                                                 !! photosynthesis 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: Ca               !! CO2 concentration inside the canopy
+
+    REAL(r_std),DIMENSION (:,:,:,:,:), INTENT (in)           :: circ_class_biomass
+    REAL(r_std),DIMENSION (:,:,:), INTENT (in)               :: circ_class_n
+
+                                                                                 !! @tex ($\mu mol mol^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: vegstress        !! Soil moisture stress (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)        :: qsintveg         !! Water on vegetation due to interception 
+                                                                                 !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: qsintmax         !! Maximum water on vegetation
+                                                                                 !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: vbeta23          !! Beta for fraction of wetted foliage that will 
+                                                                                 !! transpire (unitless)
+    REAL(r_std),DIMENSION (:,:,:),INTENT (in)                :: Isotrop_Abs_Tot_p !! Absorbed radiation per level for photosynthesis
+    REAL(r_std),DIMENSION (:,:,:),INTENT (in)                :: Isotrop_Tran_Tot_p !! Transmitted radiation per level for photosynthesis
+    REAL(r_std),DIMENSION(:,:,:),INTENT (in)                 :: lai_per_level    !! This is the LAI per vertical level
+                                                                                 !! @tex $(m^{2} m^{-2})$
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT (in)        :: veget
+    REAL(r_std), DIMENSION(:), INTENT (in)                   :: u_speed          !! wind speed at specified canopy level (m/s)   
+    
+    INTEGER(i_std),INTENT(in)                                :: hist_id          !! History_ file identifier (-)
+    INTEGER(i_std),DIMENSION (kjpindex*nvm),INTENT(in)       :: indexveg         !! Indices of the points on the 3D map (-)    
+    INTEGER(i_std),DIMENSION (kjpindex*(nlevels_tot+1)),INTENT(in)  :: indexlai  !! Indices of the points on the 3D map 
+    INTEGER(i_std),DIMENSION (kjpindex),INTENT(in)           :: index            !! Indices of the points on the map (-) 
+    INTEGER(i_std),INTENT(in)                                :: kjit             !! Time step number (-) 
+
+    !
+    !! 0.2 Output variables
+    !
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: vbeta3           !! Beta for Transpiration (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: vbeta3pot        !! Beta for Potential Transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: rveget           !! stomatal resistance of vegetation 
+                                                                                 !! @tex ($s m^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: rstruct          !! structural resistance @tex ($s m^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: cimean           !! mean intercellular CO2 concentration 
+                                                                                 !! @tex ($\mu mol mol^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: gsmean           !! mean stomatal conductance to CO2 (umol m-2 s-1)
+    REAL(r_Std),DIMENSION (kjpindex,nvm), INTENT (out)       :: gpp              !! Assimilation ((gC m^{-2} s^{-1}), total area)
+
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (out) &
+                                                             :: gs_distribution    
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (out) &
+                                                             :: gs_diffuco_output
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (out) &       
+                                                             :: gstot_component
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (out) &       
+                                                             :: gstot_frac
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (out) &       
+                                                             :: profile_vbeta3
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (out) &
+                                                             :: profile_rveget
+    INTEGER(i_Std),DIMENSION (kjpindex), INTENT (out)        :: index_assi       !! pixels for a given PFT where photosynthesis takes place
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlai), INTENT (out)  :: leaf_ci          !! intercellular CO2 concentration (ppm)
+    REAL(r_std),DIMENSION(kjpindex,nvm), INTENT (out)        :: assimtot         !! total assimilation 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nlevels_tot), INTENT (out) &
+                                                             :: assimi_lev       !! assimilation (at all LAI levels)
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+
+    !+++CHECK+++
+    ! INTENT was changed to inout because it is not yet calculated
+    ! should be set back to out once it is calculated (see ORCHIDEE-CN).
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)       :: cim              !! Intercellular CO2 over nlai 
+    !+++++++++++
+
+    !
+
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION(kjpindex,nvm,nwarns), INTENT(inout) &
+                                                             :: warnings         !! A warning counter
+ 
+    !
+    !! 0.4 Local variables
+    !
+    
+    REAL(r_std), DIMENSION(kjpindex,nvm,nlevels_tot+1)       :: assimi           !! assimilation (at a specific LAI level)
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm)                     :: coupled_lai
+    REAL(r_std), DIMENSION(kjpindex,nvm)                     :: total_lai 
+    !
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot)         :: gs_store
+    REAL(r_Std),DIMENSION (kjpindex,nvm)                     :: gs_column_total
+    REAL(r_Std),DIMENSION (kjpindex,nvm)                     :: gstot_store
+
+
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)         :: profile_gs_store
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)         :: profile_cimean
+    REAL(r_std),DIMENSION (kjpindex,nlevels_tot)             :: profile_assimtot
+
+    REAL(r_std),DIMENSION (kjpindex,nlevels_tot)             :: profile_Rdtot
+    REAL(r_std),DIMENSION (kjpindex,nlevels_tot)             :: profile_gstot
+    REAL(r_std),DIMENSION (kjpindex,nlevels_tot)             :: profile_gstop
+
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)         :: profile_gsmean
+
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)         :: profile_gpp
+
+    
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)         :: profile_rstruct
+    REAL(r_std),DIMENSION (nlevels_tot)                      :: profile_speed
+    REAL(r_std),DIMENSION (nlevels_tot)                      :: profile_cresist
+    
+    !
+    !
+    REAL(r_std),DIMENSION(kjpindex,nvm,nlevels_tot)          :: Abs_light        !! fraction of absorbed light within each layer (just to check)
+    REAL(r_std),DIMENSION(kjpindex,nvm)                      :: Abs_light_can    !! fraction of absorbed light within the canopy (just to check)  
+    REAL(r_std),DIMENSION (kjpindex,nvm)                     :: vcmax            !! maximum rate of carboxylation
+                                                                                 !! @tex ($\mu mol CO2 m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm)    :: nue                               !! Nitrogen use Efficiency with impact of leaf age (umol CO2 (gN)-1 s-1) 
+    REAL(r_std),DIMENSION (kjpindex,nvm)    :: ntot                              !! Total canopy (eg leaf) N (gN m-2[ground])  
+    REAL(r_std)                             :: N_profile                         !! N-content reduction factor for a specific canopy depth (unitless) 
+    REAL(r_std),DIMENSION (kjpindex)        :: leafN_top                         !! Leaf N content - top of canopy (gN m-2[leaf]) 
+    INTEGER(i_std)                          :: ji, jv, ilev, limit_photo         !! Indices (unitless)
+    REAL(r_std),DIMENSION(kjpindex,nlevels_tot+1)            :: info_limitphoto
+    REAL(r_std),DIMENSION(kjpindex)         :: leaf_ci_lowest                    !! intercellular CO2 concentration at the lowest 
+                                                                                 !! LAI level
+                                                                                 !! @tex ($\mu mol mol^{-1}$) @endtex
+    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) 
+    INTEGER(i_std)                                           :: nia,inia,nina    !! counter/indices (unitless)
+    INTEGER(i_std)                                           :: inina,iainia     !! counter/indices (unitless)
+    INTEGER(i_std), DIMENSION(kjpindex)                      :: index_non_assi   !! indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nlevels_tot+1)           :: vc2              !! rate of carboxylation (at a specific LAI level) 
+                                                                                 !! @tex ($\mu mol CO2 m^{-2} s^{-1}$) @endtex 
+
+    REAL(r_std), DIMENSION(kjpindex,nlevels_tot+1)           :: vj2              !! rate of Rubisco regeneration (at a specific LAI 
+                                                                                 !! level) @tex ($\mu mol e- m^{-2} s^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(kjpindex)                         :: gstop            !! stomatal conductance to H2O at topmost level 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nlevels_tot+1)           :: gs               !! stomatal conductance to CO2 
+                                                                                 !! @tex ($\mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nlevels_tot)             :: templeafci
+
+
+    REAL(r_std), DIMENSION(kjpindex)                         :: gamma_star       !! CO2 compensation point (ppm)
+                                                                                 !! @tex ($\mu mol mol^{-1}$) @endtex
+
+    REAL(r_std), DIMENSION(kjpindex)                         :: air_relhum       !! air relative humidity at 2m 
+                                                                                 !! @tex ($kg kg^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)                         :: VPD              !! Vapor Pressure Deficit (kPa)
+    REAL(r_std), DIMENSION(kjpindex)                         :: water_lim        !! water limitation factor (0-1,unitless)
+
+    REAL(r_std), DIMENSION(kjpindex)                         :: gstot            !! total stomatal conductance to H2O
+                                                                                 !! Final unit is
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)                         :: Rdtot            !! Total Day respiration (respiratory CO2 release other than by photorespiration) (mumol CO2 mâ2 sâ1) 
+    REAL(r_std), DIMENSION(kjpindex)                         :: gs_top           !! leaf stomatal conductance to H2O across all top levels
+                                                                                 !! @tex ($\mol H2O m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)                         :: qsatt                               !! surface saturated humidity at 2m (??) 
+                                                                                 !! @tex ($g g^{-1}$) @endtex
+                                                                                 !! levels (0-1,unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: T_Vcmax          !! Temperature dependance of Vcmax (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: S_Vcmax_acclim_temp                 !! Entropy term for Vcmax 
+                                                                                 !! accounting for acclimation to temperature (J K-1 mol-1)
+    REAL(r_std), DIMENSION(kjpindex)                         :: T_Jmax           !! Temperature dependance of Jmax
+    REAL(r_std), DIMENSION(kjpindex)                         :: S_Jmax_acclim_temp                  !! Entropy term for Jmax 
+                                                                                 !! accounting for acclimation to temperature (J K-1 mol-1)
+    REAL(r_std), DIMENSION(kjpindex)                         :: T_gm             !! Temperature dependance of gmw
+    REAL(r_std), DIMENSION(kjpindex)                         :: T_Rd             !! Temperature dependance of Rd (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: T_Kmc            !! Temperature dependance of KmC (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: T_KmO            !! Temperature dependance of KmO (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: T_Sco            !! Temperature dependance of Sco
+    REAL(r_std), DIMENSION(kjpindex)                         :: T_gamma_star     !! Temperature dependance of gamma_star (unitless)    
+    REAL(r_std), DIMENSION(kjpindex)                         :: vc               !! Maximum rate of Rubisco activity-limited carboxylation (mumol CO2 mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex)                         :: vj               !! Maximum rate of e- transport under saturated light (mumol CO2 mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex)                         :: gm               !! Mesophyll diffusion conductance (molCO2 mÃ¢2 sÃ¢1 barÃ¢1) 
+    REAL(r_std), DIMENSION(kjpindex)                         :: g0var 
+    REAL(r_std), DIMENSION(kjpindex,nlevels_tot+1)           :: Rd               !! Day respiration (respiratory CO2 release other than by photorespiration)(mumol CO2 mÃ¢2 sÃ¢1)
+    REAL(r_std), DIMENSION(kjpindex)                         :: Kmc              !! MichaelisâMenten constant of Rubisco for CO2 (mubar)
+    REAL(r_std), DIMENSION(kjpindex)                         :: KmO              !! MichaelisâMenten constant of Rubisco for O2 (mubar)
+    REAL(r_std), DIMENSION(kjpindex)                         :: Sco              !! Relative CO2 /O2 specificity factor for Rubisco (bar bar-1) 
+    REAL(r_std), DIMENSION(kjpindex)                         :: gb_co2           !! Boundary-layer conductance (molCO2 mÃ¢2 sÃ¢1 barÃ¢1) 
+    REAL(r_std), DIMENSION(kjpindex)                         :: gb_h2o           !! Boundary-layer conductance (molH2O mÃ¢2 sÃ¢1 barÃ¢1)
+    REAL(r_std), DIMENSION(kjpindex)                         :: fvpd             !! Factor for describing the effect of leaf-to-air vapour difference on gs (-)
+    REAL(r_std), DIMENSION(kjpindex)                         :: low_gamma_star   !! Half of the reciprocal of Sc/o (bar bar-1)
+    REAL(r_std)                                              :: fcyc             !! Fraction of electrons at PSI that follow cyclic transport around PSI (-)
+    REAL(r_std)                                              :: z                !! A lumped parameter (see Yin et al. 2009) ( mol mol-1)                          
+    REAL(r_std)                                              :: Rm               !! Day respiration in the mesophyll (umol CO2 mâ2 sâ1)
+    REAL(r_std)                                              :: Cs_star          !! Cs -based CO2 compensation point in the absence of Rd (ubar)
+    REAL(r_std), DIMENSION(kjpindex)                         :: Iabs             !! Photon flux density absorbed by leaf photosynthetic pigments (umol photon mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex)                         :: Jmax             !! Maximum value of J under saturated light (umol eâ mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex,nlevels_tot+1)           :: JJ               !! Rate of eâ transport (umol eâ mâ2 sâ1)
+    REAL(r_std)                                              :: J2               !! Rate of all eâ transport through PSII (umol eâ mâ2 sâ1)
+    REAL(r_std)                                              :: VpJ2             !! eâ transport-limited PEP carboxylation rate (umol CO2 mâ2 sâ1)
+    REAL(r_std)                                              :: A_1, A_3         !! Lowest First and third roots of the analytical solution for a general 
+                                                                                 !! cubic equation (see Appendix A of Yin et al. 2009) (umol CO2 mâ2 sâ1)
+    REAL(r_std)                                              :: A_1_tmp, A_3_tmp            !! Temporary First and third roots of the analytical solution 
+                                                                                            !! for a general cubic equation (see Appendix A of Yin et al. 2009) (umol CO2 mâ2 sâ1)
+    REAL(r_std)                                              :: Obs                         !! Bundle-sheath oxygen partial pressure (ubar)
+    REAL(r_std), DIMENSION(kjpindex,nlevels_tot+1)           :: Cc                          !! Chloroplast CO2 partial pressure (ubar)
+    REAL(r_std)                                              :: ci_star                     !! Ci -based CO2 compensation point in the absence of Rd (ubar)        
+    REAL(r_std)                                              :: a,b,c,d,m,f,j,g,h,i,l,p,q,r !! Variables used for solving the cubic equation (see Yin et al. (2009))
+    REAL(r_std)                                              :: QQ,UU,PSI,x1,x2,x3          !! Variables used for solving the cubic equation (see Yin et al. (2009))
+    REAL(r_std)                                              :: cresist                     !! coefficient for resistances (??)
+    rEAL(r_std)                                              :: lai_min                     !! mininum lai to calculate photosynthesis       
+
+    LOGICAL,DIMENSION(kjpindex,nlevels_tot)                  :: top_level                   !! A flag to see if a given level is considered
+                                                                                            !! a "top" level or not.  Must be done this way
+                                                                                            !! because there could be several "top" levels.
+    REAL(r_std)                                              :: totlai_top                  !! The sum of the LAI in all the levels that we
+                                                                                            !! declare as the "top".
+    INTEGER(i_std)                                           :: lev_count                   !! How many levels we have already taken for
+                                                                                            !! the "top"
+
+! @defgroup Photosynthesis Photosynthesis
+! @{   
+    ! 1. Preliminary calculations\n
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)         :: light_tran_to_level         !! Cumulative amount of light transmitted to a given level
+    LOGICAL,DIMENSION (kjpindex)                             :: lskip                       !! A flag to indicate we've hit an unusual
+                                                                                            !! case were we may have numerical instability.
+
+    INTEGER                                                  :: ic, jc, kc
+
+    INTEGER                                                  :: ipts
+    LOGICAL                                                  :: llight
+    LOGICAL                                                  :: llai
+    INTEGER,SAVE                                             :: istep=0, counter=0
+
+!_ ================================================================================================================================
+
+   IF (printlev>=4) WRITE (numout,*) ' diffuco_trans_co2'
+   IF (printlev_loc>=5) WRITE(numout,*) 'diffuco_trans_co2: nlai,lai_per_level',nlai,lai_per_level(:,:,:)
+
+    gs_store = 0.0d0
+    gs_column_total = 0.0d0
+    gs_distribution = 0.0d0
+    gs_diffuco_output = 0.0d0
+ 
+    gstot_frac = 0.0d0
+    gstot_component = 0.d0
+    gstot_store = 0.0d0
+
+    profile_gs_store = 0.0d0
+    profile_cimean = 0.0d0
+    profile_assimtot = 0.0d0
+
+    profile_Rdtot = 0.0d0
+    profile_gstot = 0.0d0
+    profile_gstop = 0.0d0
+
+    profile_gsmean = 0.0d0
+    profile_gpp = 0.0d0
+    profile_rveget = 2.5d20
+    profile_rstruct = 0.0d0
+    profile_speed = 0.0d0
+    profile_cresist = 0.0d0
+    profile_vbeta3 = 0.0d0
+
+    ! Debug 
+    IF(printlev_loc>=4)THEN 
+       WRITE(numout,*) 'Absorbed light in diffuco. ',test_grid,test_pft 
+       DO ilev=nlevels_tot,1,-1 
+          WRITE(numout,'(I5,10F20.10)') & 
+               ilev, Isotrop_Abs_Tot_p(test_grid,test_pft,ilev),& 
+               Isotrop_Tran_Tot_p(test_grid,test_pft,ilev),& 
+               lai_per_level(test_grid,test_pft,ilev) 
+       ENDDO
+    ENDIF
+    !-
+
+    gs_column_total = 0.0d0
+    gs_distribution = 0.0d0
+    gs_diffuco_output = 0.0d0
+    gstot_frac = 0.0d0
+    gstot_component = 0.d0
+    gstot_store = 0.0d0
+    gs_store(:,:,:)=zero
+    !
+    !
+    ! Photosynthesis parameters
+    !
+     nue(:,:) = assim_param(:,:,inue) 
+     ntot(:,:) = assim_param(:,:,ileafn)
+    !vcmax(:,:) = assim_param(:,:,ivcmax) ! from before nitrogen is included
+    !WRITE(numout,*) '210515 vcmax:', vcmax(:,:)
+    !
+    ! @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
+    ! @}
+    !
+    CALL qsatcalc (kjpindex, temp_sol, pb, qsatt)
+    air_relhum(:) = &
+      ( qsurf(:) * pb(:) / (Tetens_1+qsurf(:)* Tetens_2) ) / &
+      ( qsatt(:)*pb(:) / (Tetens_1+qsatt(:)*Tetens_2 ) )
+
+    ! WRITE(numout, *) '050315 air_relhum is: ', air_relhum
+
+    VPD(:) = ( qsatt(:)*pb(:) / (Tetens_1+qsatt(:)*Tetens_2 ) ) &
+         - ( qsurf(:) * pb(:) / (Tetens_1+qsurf(:)* Tetens_2) )
+    ! VPD is needed in kPa
+    ! We limit the impact of VPD in the range of [0:6] kPa
+    ! This seems to be the typical range of values
+    ! that the vapor pressure difference can take, although
+    ! there is a paper by Mott and Parkhurst, Plant, Cell & Environment,
+    ! Vol. 14, pp. 509--519 (1991) which gives a value of 15 kPa.
+    !!$ VPD(:) = MAX(zero,MIN(VPD(:)/10.,6.))
+    VPD(:) = VPD(:)/10.
+
+    !
+    ! 2. beta coefficient for vegetation transpiration
+    !
+    rstruct(:,1) = rstruct_const(1)
+    rveget(:,:) = undef_sechiba
+    vbeta3(:,:) = zero
+    vbeta3pot(:,:) = zero
+    gsmean(:,:) = zero
+    gpp(:,:) = zero
+    light_tran_to_level(:,:,:)=un
+    assimi_lev(:,:,:) = zero
+    cim(:,:) = zero
+    cimean(:,1) = Ca(:)
+    
+    !
+    ! 2.1 Initializations
+    ! Loop over vegetation types
+    ! 
+
+    DO jv = 2,nvm
+       gamma_star(:) = zero 
+       Kmo(:) = zero 
+       Kmc(:) = zero 
+       gm(:) = zero 
+       g0var(:) = zero 
+       
+       Cc(:,:) = zero 
+       vc2(:,:) = zero
+       vj2(:,:) = zero 
+       JJ(:,:) = zero 
+       info_limitphoto(:,:) = zero 
+       gs(:,:) = zero 
+       templeafci(:,:) = zero 
+       assimi(:,:,:) = zero 
+       Rd(:,:) = zero
+         
+      !
+      ! beta coefficient for vegetation transpiration
+      !
+      rstruct(:,jv) = rstruct_const(jv)
+      cimean(:,jv) = Ca(:)
+
+      DO ipts = 1, kjpindex 
+
+         total_lai(ipts, jv) = cc_to_lai( circ_class_biomass(ipts, jv,:, ileaf,&
+                 icarbon),circ_class_n(ipts, jv,:), jv ) 
+
+      IF( jv .eq. test_pft .and. printlev_loc >= 4 ) &
+           WRITE(numout,*) '101116 total_lai',total_lai(ipts,jv)
+
+      ENDDO 
+
+    ! ---TEMP---
+    ! calculation of vcmax before N is included  
+    !  IF (downregulation_co2) THEN
+    !     vcmax(:,jv) = assim_param(:,jv,ivcmax)*&
+    !          (un-downregulation_co2_coeff(jv)*&
+    !          log(Ca(:)/downregulation_co2_baselevel))
+    !  ELSE
+    !     vcmax(:,jv) = assim_param(:,jv,ivcmax)
+    !  ENDIF
+    !-----------
+
+      WHERE (total_lai(:,jv) .GT. min_sechiba)
+
+         leafN_top(:) = ntot(:,jv) * ext_coeff_N(jv) / &
+              ( 1. -exp(-ext_coeff_N(jv) * total_lai(:,jv)) ) 
+
+      ELSEWHERE
+
+         leafN_top(:) = zero
+
+      ENDWHERE
+
+      vcmax(:,jv) = nue(:,jv)*leafN_top(:)
+
+      !WRITE(numout,*) '210515 assim_param(grid,pft,npco2)','grid:'grid,'pft:',pft,'npco2:',npco2
+      !WRITE(numout,*)  assim_param(:,:,:)      
+      !! 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.
+      !          
+      ! set minimum lai value to test if photosynthesis should be calculated
+      ! 0.0001 is abitrary
+      ! could be externalised 
+      lai_min = 0.0001
+      !
+      nia=0
+      nina=0
+      index_assi=0
+      index_non_assi=0
+      llai=.FALSE.
+      !
+      DO ji=1,kjpindex     
+
+         IF(veget_max(ji,jv) == zero)THEN
+            ! this vegetation type is not present, so no reason to do the 
+            ! calculation
+            CYCLE
+         ENDIF
+
+         !
+         ! This is tricky.  We need a certain amount of LAI to have photosynthesis.
+         ! However, we divide our canopy up into certain levels, so even if we
+         ! have a total amount that is sufficient, there might not be enough
+         ! in any particular layer.  So we check each layer to see if there
+         ! is one that has enough to give a non-zero photosynthesis.  In
+         ! the worst-case scenario (small LAI in every other level), this becomes 
+         ! our top level for the gs calculation.  If gs_top_level is zero below,
+         ! we have a divide by zero issue.
+         llai=.FALSE.
+         DO ilev=1,nlevels_tot
+            IF(lai_per_level(ji,jv,ilev) .GT. lai_min) THEN 
+             llai=.TRUE.
+             ELSE
+             ENDIF
+         ENDDO
+
+
+         IF ( llai .AND. &
+              ( veget_max(ji,jv) .GT. min_sechiba ) ) THEN
+            
+            ! Here we need to do something different than in the previous model.
+            ! We explicitly need to check for absorbed light.  This occurs
+            ! because our albedo in the two stream model is a function
+            ! of the solar angle.  If the sun has set, we have no
+            ! light, and therefore we cannot have photosynthesis.
+            llight=.FALSE.
+            DO ilev=1,nlevels_tot
+               IF(Isotrop_Abs_Tot_p(ji,jv,ilev) .GT. min_sechiba) llight=.TRUE.
+            ENDDO
+            IF ( ( swdown(ji) .GT. min_sechiba )   .AND. &
+                 ( humrel(ji,jv) .GT. min_sechiba) .AND. &
+                 ( temp_growth(ji) .GT. tphoto_min(jv) ) .AND. &
+                 llight .AND. &
+                 ( temp_growth(ji) .LT. tphoto_max(jv) )) THEN
+               !
+               assimilate(ji) = .TRUE.
+               nia=nia+1
+               index_assi(nia)=ji
+               !
+            ELSE
+               !
+               assimilate(ji) = .FALSE.
+               nina=nina+1
+               index_non_assi(nina)=ji
+               !
+            ENDIF
+         ELSE
+            !
+            assimilate(ji) = .FALSE.
+            nina=nina+1
+            index_non_assi(nina)=ji
+            !
+         ENDIF
+        ! 
+      ENDDO 
+      !
+
+      IF(printlev_loc>=4 .AND. jv == test_pft)THEN
+         WRITE(numout,*) 'jv: ',jv
+         WRITE(numout,*) 'test_grid: ',test_grid
+         WRITE(numout,*) 'llai, veget_max: ',llai,veget_max(:,jv)
+         WRITE(numout,*) 'temp_growth: ',temp_growth(test_grid)
+         WRITE(numout,*) 'tphoto_min: ',tphoto_min(jv)
+         WRITE(numout,*) 'tphoto_max: ',tphoto_max(jv)
+         WRITE(numout,*) 'swdown: ',swdown(test_grid)
+         WRITE(numout,*) 'index_non_assi(:): ',index_non_assi(test_grid)
+         WRITE(numout,*) 'index_assi(:): ',index_assi(test_grid)
+         WRITE(numout,*) 'nia: ',nia
+         WRITE(numout,*) 'nina',nina
+      ENDIF
+
+      top_level(:,:)=.FALSE.
+      gstot(:) = zero
+      gstop(:) = zero
+      assimtot(:,jv) = zero
+      Rdtot(:)=zero
+      gs_top(:) = zero
+      lskip(:)=.FALSE.
+      !
+      zqsvegrap(:) = zero
+      WHERE (qsintmax(:,jv) .GT. min_sechiba)
+         !! relative water quantity in the water interception reservoir
+         zqsvegrap(:) = MAX(zero, qsintveg(:,jv) / qsintmax(:,jv))
+      ENDWHERE
+
+      !! Calculate the water limitation factor that restricts Vcmax when hydrol_arch is turned off.
+      !  If hydrol_architecture is used, VCmax is not controled but instead there is a control on
+      !  stomatal conductance
+      IF(ok_hydrol_arch) THEN
+         WHERE ( assimilate(:) )
+            water_lim(:) = un
+         ELSEWHERE
+            water_lim(:) = zero
+         ENDWHERE
+      ELSE
+         WHERE ( assimilate(:) )
+            water_lim(:) = MAX( min_sechiba, MIN( vegstress(:,jv)/0.5, un ))
+         ELSEWHERE
+            water_lim(:) = zero
+         ENDWHERE
+      ENDIF ! (ok_hydrol_arch)
+
+      ! give a default value of ci for all pixel that do not assimilate
+      DO ilev=1,nlevels_tot
+         DO inina=1,nina
+            leaf_ci(index_non_assi(inina),jv,ilev) = Ca(index_non_assi(inina)) 
+         ENDDO
+      ENDDO 
+
+      !
+      !
+      ! Here is the calculation of assimilation and stomatal conductance
+      ! based on the work of Farquahr, von Caemmerer and Berry (FvCB model) 
+      ! as described in Yin et al. 2009
+      ! Yin et al. developed a extended version of the FvCB model for C4 plants
+      ! and proposed an analytical solution for both photosynthesis pathways (C3 and C4)
+      ! Photosynthetic parameters used are those reported in Yin et al. 
+      ! Except For Vcmax25, relationships between Vcmax25 and Jmax25 for which we use 
+      ! Medlyn et al. (2002) and Kattge & Knorr (2007)
+      ! Because these 2 references do not consider mesophyll conductance, we neglect this term
+      ! in the formulations developed by Yin et al. 
+      ! Consequently, gm (the mesophyll conductance) tends to the infinite
+      ! This is of importance because as stated by Kattge & Knorr and Medlyn et al.,
+      ! values of Vcmax and Jmax derived with different model parametrizations are not 
+      ! directly comparable and the published values of Vcmax and Jmax had to be standardized
+      ! to one consistent formulation and parametrization
+
+      ! See eq. 6 of Yin et al. (2009)
+      ! Parametrization of Medlyn et al. (2002) - from Bernacchi et al. (2001)
+      T_KmC(:)        = Arrhenius(kjpindex,temp_sol,298.,E_KmC(jv))
+      T_KmO(:)        = Arrhenius(kjpindex,temp_sol,298.,E_KmO(jv))
+      T_Sco(:)        = Arrhenius(kjpindex,t2m,298.,E_Sco(jv))
+      T_gamma_star(:) = Arrhenius(kjpindex,temp_sol,298.,E_gamma_star(jv))
+
+
+      ! Parametrization of Yin et al. (2009) - from Bernacchi et al. (2001)
+      T_Rd(:)         = Arrhenius(kjpindex,temp_sol,298.,E_Rd(jv))
+
+
+      ! For C3 plants, we assume that the Entropy term for Vcmax and Jmax 
+      ! acclimates to temperature as shown by Kattge & Knorr (2007) - Eq. 9 and 10
+      ! and that Jmax and Vcmax respond to temperature following a modified Arrhenius function
+      ! (with a decrease of these parameters for high temperature) as in Medlyn et al. (2002) 
+      ! and Kattge & Knorr (2007).
+      ! In Yin et al. (2009), temperature dependance to Vcmax is based only on a Arrhenius function
+      ! Concerning this apparent unconsistency, have a look to the section 'Limitation of 
+      ! Photosynthesis by gm' of Bernacchi (2002) that may provide an explanation
+      
+      ! Growth temperature tested by Kattge & Knorr range from 11 to 35Â°C
+      ! So, we limit the relationship between these lower and upper limits
+      S_Jmax_acclim_temp(:) = aSJ(jv) + bSJ(jv) * MAX(11., MIN(temp_growth(:),35.))      
+      T_Jmax(:)  = Arrhenius_modified(kjpindex,temp_sol,298.,E_Jmax(jv),D_Jmax(jv),S_Jmax_acclim_temp)
+
+      S_Vcmax_acclim_temp(:) = aSV(jv) + bSV(jv) * MAX(11., MIN(temp_growth(:),35.))   
+      T_Vcmax(:) = Arrhenius_modified(kjpindex,temp_sol,298.,E_Vcmax(jv),D_Vcmax(jv),S_Vcmax_acclim_temp)
+
+      vc(:) = vcmax(:,jv) * T_Vcmax(:)
+  
+
+      ! As shown by Kattge & Knorr (2007), we make use
+      ! of Jmax25/Vcmax25 ratio (rJV) that acclimates to temperature for C3 plants
+      ! rJV is written as a function of the growth temperature
+      ! rJV = arJV + brJV * T_month 
+      ! See eq. 10 of Kattge & Knorr (2007)
+      ! and Table 3 for Values of arJV anf brJV 
+      ! Growth temperature is monthly temperature (expressed in Â°C) - See first paragraph of
+      ! section Methods/Data of Kattge & Knorr
+      vj(:) = ( arJV(jv) + brJV(jv) *  MAX(11., MIN(temp_growth(:),35.)) ) * vcmax(:,jv) * T_Jmax(:)
+
+      T_gm(:)  = Arrhenius_modified(kjpindex,t2m,298.,E_gm(jv),D_gm(jv),S_gm(jv))
+      gm(:)    = gm25(jv) * T_gm(:) * MAX(1-stress_gm(jv), water_lim(:))
+
+      g0var(:) = g0(jv)* MAX(1-stress_gs(jv), water_lim(:))
+      ! @endcodeinc
+      !
+      KmC(:)=KmC25(jv)*T_KmC(:)
+      KmO(:)=KmO25(jv)*T_KmO(:)
+      Sco(:)=Sco25(jv)*T_sco(:)
+      gamma_star(:) = gamma_star25(jv)*T_gamma_star(:)
+      ! low_gamma_star is defined by Yin et al. (2009)
+      ! as the half of the reciprocal of Sco - See Table 2
+      !!$ We derive its value from Equation 7 of Yin et al. (2009)
+      !!$ assuming a constant O2 concentration (Oi)
+      !!$ low_gamma_star(:) = gamma_star(:)/Oi
+      low_gamma_star(:) = 0.5 / Sco(:)
+
+      ! VPD expressed in kPa
+      ! Note : MIN(1.-min_sechiba,MAX(min_sechiba,(a1(jv) - b1(jv) * VPD(:))))
+      ! is always between 0-1 not including 0 and 1
+      fvpd(:) = 1. / ( 1. / MIN(1.-min_sechiba,MAX(min_sechiba,(a1(jv) - b1(jv) * VPD(:)))) - 1. ) &
+                * MAX(1-stress_gs(jv), water_lim(:)) 
+    
+      ! leaf boundary layer conductance  
+      ! conversion from a conductance in (m s-1) to (mol H2O m-2 s-1) 
+      ! from Pearcy et al. (1991, see below) 
+      gb_h2o(:) = gb_ref * 44.6 * (tp_00/t2m(:)) * (pb(:)/pb_std)  
+      
+      ! conversion from (mol H2O m-2 s-1) to (mol CO2 m-2 s-1) 
+      gb_co2(:) = gb_h2o(:) / ratio_H2O_to_CO2 
+
+      !
+      ! 2.4 Loop over LAI levels to estimate assimilation and conductance        
+      !
+      IF (nia .GT. 0) THEN
+
+         assim_loop:DO inia=1,nia
+
+            !
+            iainia=index_assi(inia)
+
+            !
+            ! Find the top layer that still contains lai.  We have also
+            ! added a check in here to make sure this layer has absorbed
+            ! light.  If there is no absorbed light, we will not calculate
+            ! stomatal conductance for the top level, which means gstop
+            ! will be zero later and we'll crash when we divide by it.
+            ! Include a warning so we know how often this happens.
+            ! The old system of chosing just one top level caused some bad results
+            ! in the transpir, evidently due to the calculation of vbeta3 being
+            ! too low due to too low of LAI in the top level.  Therefore, we are
+            ! now going to take several top levels in an effort to make sure
+            ! we have enough LAI.  We aim for an arbitrary amount of 0.1 or
+            ! the top three levels.  This has not been rigoursly tested, but it
+            ! is theoretically justified by the fact that if the LAI of the top
+            ! level is very low, other leaves will be getting a lot of sun and
+            ! well-exposed to the atmosphere, and therefore contribute equal
+            ! to the resistence of the vegetation.
+            totlai_top=zero
+            lev_count=0
+            !   
+            DO ilev=nlevels_tot, 1, -1
+               IF(lai_per_level(iainia,jv,ilev) .GT. lai_min)THEN
+                  IF(Isotrop_Abs_Tot_p(iainia,jv,ilev) .GT. min_sechiba)THEN
+                     IF(totlai_top .LT. lai_top(jv) .AND. lev_count .LT. nlev_top)THEN
+                        lev_count=lev_count+1
+                        top_level(iainia,ilev)=.TRUE.
+                        totlai_top=totlai_top+lai_per_level(iainia,jv,ilev)
+                     ELSE
+                        ! We have enough levels now.
+                        !WRITE(numout,*) 'Top levels ',totlai_top,lev_count
+                        EXIT
+                     ENDIF
+                  ELSE
+                     IF(err_act.GT.1)THEN
+                        WRITE(numout,*) 'WARNING: Found a level with LAI, ' // &
+                             'but no absorbed light.'
+                        WRITE(numout,*) 'WARNING: iainia,jv,ilev, ',iainia,jv,ilev
+                        WRITE(numout,*) 'WARNING: Isotrop_Abs_Tot_p(iainia,jv,ilev),' //&
+                             'lai_per_level(iainia,jv,ilev), ',iainia,jv,ilev
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDDO
+            IF(totlai_top .LT. min_sechiba)THEN
+               ! There seem to be some fringe cases where this happens, usually
+               ! at sunrise or sunset with low LAI levels.  Instead of stopping
+               ! here, I'm going to issue a warning.  If this case happens,
+               ! we produce no GPP, but we're not going to crash.  We need to
+               ! be careful in one of the loops below, since a stomatal 
+               ! conductance of zero will cause a crash.
+                IF(err_act.GT.1)THEN
+                   WRITE(numout,*) 'WARNING: Did not find a level with LAI in diffuco!'
+                   WRITE(numout,*) 'WARNING: iainia,ivm: ',iainia,jv
+                ENDIF
+               assimtot(iainia,jv) = zero
+               Rdtot(iainia) = zero
+               gstot(iainia) = zero
+               assimi_lev = zero
+               lskip(iainia)=.TRUE.
+               CYCLE assim_loop
+            ENDIF
+
+            ! We need to know how much is transmitted to this level
+            ! from the top of the canopy, since this aboslute number
+            ! is what is actually used in the photosyntheis.  Right now
+            ! Isotrop_Tran_Tot_p and Isotropic_Abs_Tot_p are the 
+            ! relative quantities transmitted through and absorbed
+            ! by the layer.
+            DO ilev = nlevels_tot-1,1,-1
+
+               light_tran_to_level(iainia,jv,ilev) = &
+                    light_tran_to_level(iainia,jv,ilev+1) * &
+                    Isotrop_Tran_Tot_p(iainia,jv,ilev+1)
+
+            ENDDO
+
+            ! Debug
+            IF(printlev_loc>=4 .AND. jv == test_pft .AND. iainia == test_grid)THEN
+               WRITE(numout,*) 'Absolute transmitted light to each level',&
+                    jv,iainia
+               DO ilev = nlevels_tot,1,-1
+                  WRITE(numout,*) ilev,light_tran_to_level(iainia,jv,ilev)
+               ENDDO
+            ENDIF
+            !-
+
+            DO ilev = 1, nlevels_tot
+ 
+               IF (Isotrop_Abs_Tot_p(iainia,jv,ilev) .GT. min_sechiba) THEN
+
+                  IF(lai_per_level(iainia,jv,ilev) .LE. min_sechiba)THEN
+
+                     ! This is not necessarily a problem.  LAI is updated in 
+                     ! slowproc, while absorbed light is updated in condveg, 
+                     ! which is called after diffuco. So we might be one 
+                     ! timestep off.  It generally should be at night,
+                     ! though, so there is no absorbed light. If this 
+                     ! persists, that is a real problem.
+                     IF(err_act.GT.1)THEN
+                        WRITE(numout,*) 'WARNING: We have absorbed light but no LAI ' // &
+                             'in this level. Skipping.'
+                        WRITE(numout,'(A,3I8)') 'WARNING: iainia,jv,ilev: ',iainia,jv,ilev
+                        WRITE(numout,'(A,2F20.10)') 'WARNING: Isotrop_Abs_Tot_p(iainia,jv,ilev), ' // &
+                             'lai_per_level(iainia,jv,ilev): ',&
+                             Isotrop_Abs_Tot_p(iainia,jv,ilev), &
+                             lai_per_level(iainia,jv,ilev)
+                     ENDIF
+                     CYCLE
+                  ENDIF
+                  
+                  ! nitrogen is scaled according to the transmitted light
+                  ! before the caclulation was: N_profile = 
+                  ! exp( -ext_coeff_N(jv)*laitab(jl) ). Where laitab is the 
+                  ! lai contained in a fixed lai layer. ext_coeff_N is 
+                  ! prescribed so this was a prescribed profile. We replaced
+                  ! it by the transmitted light calculated by the 2stream
+                  ! model, maybe ( un - Isotrop_Tran_Tot_p(iainia,jv,ilev) )
+                  ! could be replaced by the directly calculated absorbed
+                  ! light Isotrop_Abs_Tot_p(iainia,jv,ilev).
+                  ! Notice that light in the old code was the cumulative 
+                  ! light transmitted to the layer, while Isotrop_Tran_Tot_p 
+                  ! is the relative light transmitted through the layer.
+                  !+++TEMP+++
+                  ! test for multilayer run 
+!                 N_profile = ( un - .7_r_std * &
+!                          ( un - Isotrop_Tran_Tot_p(iainia,jv,ilev) ) )
+                  !++++++++++++++
+                  N_profile = ( un - .7_r_std * &
+                       ( un - light_tran_to_level(iainia,jv,ilev) ) )
+                  
+                  ! When hydrol_arch is turned on there is no water stress on 
+                  ! the vcmax and photosynthesis is only restricted by 
+                  ! stomatal closure when transpiration is higher than the 
+                  ! water supply to the leaves as calculated in hydrol_arch. 
+                  ! This more consistent with the substantial consensus in 
+                  ! plant physiology that the main restriction of 
+                  ! photosynthesis during drought occurs through diffusion 
+                  ! limitation rather than photochemical or biochemical failure
+                  ! (Flexas et al. 2006). Effects of drought stress on 
+                  ! respiration are less well known: increases, decreases and 
+                  ! no change have been found. For now there is no effect of 
+                  ! drought stress on dark respiration when hydrol_arch is 
+                  ! used.
+                  vc2(iainia,ilev) = vc(iainia) * N_profile * MAX(1-stress_vcmax(jv), water_lim(iainia))
+                  vj2(iainia,ilev) = vj(iainia) * N_profile * MAX(1-stress_vcmax(jv), water_lim(iainia))
+                     
+                  ! see Comment in legend of Fig. 6 of Yin et al. (2009)
+                  ! Rd25 is assumed to equal 0.01 Vcmax25 
+                  Rd(iainia,ilev) = vcmax(iainia,jv) * N_profile * 0.01 * &
+                       T_Rd(iainia) * MAX(1-stress_vcmax(jv), water_lim(iainia))
+                  Iabs(iainia) =swdown(iainia) * W_to_mol * RG_to_PAR *&
+                       Isotrop_Abs_Tot_p(iainia,jv,ilev) * &
+                       light_tran_to_level(iainia,jv,ilev) / &
+                       lai_per_level(iainia,jv,ilev)
+
+                  ! If we have a very dense canopy, the lower levels might
+                  ! get almost no light.  If the light is close to zero, it
+                  ! causes a numerical problem below, as x1 will be zero. Of
+                  ! course, if the absorbed light is really small 
+                  ! photosynthesis will not happen, so we can just skip this 
+                  ! level. This number is fairly arbitrary, but it should be 
+                  ! as small as possible.
+                  IF(Iabs(iainia) .LT. 1e-12)CYCLE
+
+                  ! eq. 4 of Yin et al (2009)
+                  ! Note that Iabs is very sensitive to the number of layers 
+                  ! use in the photosynthesis module and to the canopy 
+                  ! structure. The first sensitivity is related to 
+                  ! none-linearities to the light conditions and is an 
+                  ! numerical issue. The sensitivity to the canopy structure
+                  ! is a wanted behavior (that's why canopy structure was 
+                  ! implemented) but makes a substantial difference for the 
+                  ! total GPP in tropical compared to temperate forests. An 
+                  ! easy way to prescribe a different canopy structure is by 
+                  ! changing the range of the prescribed height. The parameter
+                  ! ::alpha_LL describes the relationship between Jmax and
+                  ! light saturation. It is thought to depend on the amount of 
+                  ! chlorophyl in the leaves which in turn depends on the 
+                  ! N-content. For the moment we use a prescribed value. After 
+                  ! the introduction of the structured canopy we noticed an 
+                  ! important sensitivity of GPP to this parameter which may 
+                  ! indicate that a substantial part of our canopy is under
+                  ! light saturation. 
+                  Jmax(iainia)     = vj2(iainia,ilev)
+                  JJ(iainia,ilev)  = ( alpha_LL(jv) * Iabs(iainia) + Jmax(iainia) - &
+                       sqrt((alpha_LL(jv) * Iabs(iainia) + Jmax(iainia) )**2. &
+                       - 4 * theta(jv) * Jmax(iainia) * alpha_LL(jv) * &
+                       Iabs(iainia)) ) &
+                       / ( 2 * theta(jv))
+
+                  
+                 IF (printlev_loc>=4 .AND. test_pft == jv) THEN
+                     WRITE(numout,*) '*************************'
+                     WRITE(numout,*) 'jv,ilev: ',jv,ilev
+                     WRITE(numout,*) 'JJ(iainia,ilev),Jmax(iainia),Iabs(iainia),Rd(iainia,ilev): ',&
+                          JJ(iainia,ilev),Jmax(iainia),Iabs(iainia),Rd(iainia,ilev)
+                     WRITE(numout,*) 'vj2(iainia,ilev),vc2(iainia,ilev), N_profile:',&
+                          vj2(iainia,ilev),vc2(iainia,ilev),N_profile
+                     WRITE(numout,*) 'Isotrop_Abs_Tot_p(iainia,jv,ilev),Isotrop_Tran_Tot_p(iainia,jv,ilev):',&
+                          Isotrop_Abs_Tot_p(iainia,jv,ilev), &
+                          Isotrop_Tran_Tot_p(iainia,jv,ilev)
+                     
+                     WRITE(numout,*) 'water_lim(iainia),T_Rd(iainia):',&
+                          water_lim(iainia),T_Rd(iainia)
+                     WRITE(numout,*) 'vc(iainia),vj(iainia), vcmax(iainia,jv):',&
+                          vc(iainia),vj(iainia),vcmax(iainia,jv)
+                     WRITE(numout,*) '*************************'
+                 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
+                    ! @}           
+                    !
+                    ! Analytical resolution of the Assimilation based 
+                    ! Yin et al. (2009)
+                    ! Eq. 28 of Yin et al. (2009)
+                    fcyc= 1. - ( 4.*(1.-fpsir(jv))*(1.+fQ(jv)) + &
+                         3.*h_protons(jv)*fpseudo(jv) ) / &
+                         ( 3.*h_protons(jv) - 4.*(1.-fpsir(jv)))
+
+                    ! See paragraph after eq. (20b) of Yin et al.
+                    Rm=Rd(iainia,ilev)/2.
+
+                    ! We assume that cs_star equals ci_star 
+                    ! (see Comment in legend of Fig. 6 of Yin et al. (2009)
+                    ! Equation 26 of Yin et al. (2009)
+                    Cs_star = (gbs(jv) * low_gamma_star(iainia) * &
+                         Oi - ( 1. + low_gamma_star(iainia) * alpha(jv) / &
+                         0.047) * Rd(iainia,ilev) + Rm ) / ( gbs(jv) + kp(jv) ) 
+
+                    ! eq. 11 of Yin et al (2009)
+                    J2 = JJ(iainia,ilev) / ( 1. - fpseudo(jv) / ( 1. - fcyc ) )
+                    
+                    ! Equation right after eq. (20d) of Yin et al. (2009)
+                    z = ( 2. + fQ(jv) - fcyc ) / ( h_protons(jv) * (1. - fcyc ))
+                    
+                    VpJ2 = fpsir(jv) * J2 * z / 2.
+                    
+                    A_3=9999.
+
+                    ! See eq. right after eq. 18 of Yin et al. (2009)
+                    ! The loop over limit_photo calculates the assimultion
+                    ! rate of the Rubisco-limited CO2 assimilation (Ac) and
+                    ! the rate of electron transport-limited CO2 assimultion
+                    ! (Aj).  The overall assimilation will be the slower
+                    ! of these two processes.
+                    DO limit_photo=1,2
+                       ! Is Vc limiting the Assimilation
+                       IF ( limit_photo .EQ. 1 ) THEN
+                          a = 1. + kp(jv) / gbs(jv)
+                          b = 0.
+                          x1 = vc2(iainia,ilev)
+                          x2 = KmC(iainia)/KmO(iainia)
+                          x3 = KmC(iainia)
+                          ! Is J limiting the Assimilation
+                       ELSE
+                          a = 1.
+                          b = VpJ2
+                          x1 = (1.- fpsir(jv)) * J2 * z / 3.
+                          x2 = 7. * low_gamma_star(iainia) / 3.
+                          x3 = 0.
+                       ENDIF
+
+                       m=fvpd(iainia)-g0var(iainia)/gb_co2(iainia)
+                       d=g0var(iainia)*(Ca(iainia)-Cs_star) + fvpd(iainia)*Rd(iainia,ilev)
+                       f=(b-Rm-low_gamma_star(iainia)*Oi*gbs(jv))*x1*d + a*gbs(jv)*x1*Ca(iainia)*d
+                       j=(b-Rm+gbs(jv)*x3 + x2*gbs(jv)*Oi)*m + (alpha(jv)*x2/0.047-1.)*d &
+                            + a*gbs(jv)*(Ca(iainia)*m - d/gb_co2(iainia) - (Ca(iainia) - Cs_star ))
+
+                       g=(b-Rm-low_gamma_star(iainia)*Oi*gbs(jv))*x1*m - (alpha(jv)*low_gamma_star(iainia)/0.047+1.)*x1*d &
+                            + a*gbs(jv)*x1*(Ca(iainia)*m - d/gb_co2(iainia) - (Ca(iainia)-Cs_star ))
+
+                       h=-((alpha(jv)*low_gamma_star(iainia)/0.047+1.)*x1*m + (a*gbs(jv)*x1*(m-1.))/gb_co2(iainia) )
+                       i= ( b-Rm + gbs(jv)*x3 + x2*gbs(jv)*Oi )*d + a*gbs(jv)*Ca(iainia)*d
+                       l= ( alpha(jv)*x2/0.047 - 1.)*m - (a*gbs(jv)*(m-1.))/gb_co2(iainia)
+                       
+                       p = (j-(h-l*Rd(iainia,ilev))) / l
+                       q = (i+j*Rd(iainia,ilev)-g) / l
+                       r = -(f-i*Rd(iainia,ilev)) / l 
+                       
+                       ! See Yin et al. (2009) and  Baldocchi (1994)
+                       QQ = ( (p**2._r_std) - 3._r_std * q) / 9._r_std
+                       UU = ( 2._r_std* (p**3._r_std) - 9._r_std *p*q + 27._r_std *r) /54._r_std
+
+                       
+                       IF  (QQ .GE. 0._r_std) THEN 
+                          IF (ABS(UU/(QQ**1.5_r_std) ) .LE. 1._r_std)  THEN
+                             PSI = ACOS(UU/(QQ**1.5_r_std))
+                             A_3_tmp = -2._r_std * SQRT(QQ) * COS(( PSI + 4._r_std * PI)/3._r_std ) - p / 3._r_std
+                             IF (( A_3_tmp .LT. A_3 )) THEN
+                                A_3 = A_3_tmp
+                                info_limitphoto(iainia,ilev)=2.
+                             ELSE
+                                ! In case, J is not limiting the assimilation
+                                ! we have to re-initialise a, b, x1, x2 and x3 values
+                                ! in agreement with a Vc-limited assimilation 
+                                a = 1. + kp(jv) / gbs(jv)
+                                b = 0.
+                                x1 = vc2(iainia,ilev)
+                                x2 = KmC(iainia)/KmO(iainia)
+                                x3 = KmC(iainia)
+                                info_limitphoto(iainia,ilev)=1.
+                             ENDIF
+                          ENDIF
+                       ELSE
+                          WRITE(numout,*) 'WARNING: unexpected value for QQ (diffuco.f90)'
+                       ENDIF
+
+                       IF ( ( A_3 .EQ. 9999. ) .OR. ( A_3 .LT. (-Rd(iainia,ilev)) ) ) THEN
+                          WRITE(numout,*) 'We have a problem in diffuco_trans_co2'
+                          WRITE(numout,*) 'no real positive solution found for pft:',jv
+                          WRITE(numout,*) 'temp_sol:',temp_sol(iainia)
+                          WRITE(numout,*) 'vpd:',vpd(iainia)
+                          WRITE(numout,*) 'Rd:',Rd(iainia,ilev)
+                          A_3 = -Rd(iainia,ilev)
+                       ENDIF
+                 
+                       assimi(iainia,jv,ilev) = A_3
+
+                       IF(printlev_loc>=4 .AND. jv == test_pft .AND. iainia == test_pft)THEN
+                          WRITE(numout,*) '( x1 - ( assimi(iainia,jv,ilev) + Rd(iainia,ilev) ) ', &
+                               ( x1 - (assimi(iainia,jv,ilev) + Rd(iainia,ilev) ))
+                          WRITE(numout,*) 'x1,assimi(iainia,jv,ilev),Rd(iainia,ilev): ', &
+                               x1,assimi(iainia,jv,ilev),Rd(iainia,ilev)
+                          WRITE(numout,*) 'jv,ilev,iainia: ', jv,ilev,iainia
+                       ENDIF
+
+                       !++++ TEMP +++++
+                       IF(( x1 - (assimi(iainia,jv,ilev) + Rd(iainia,ilev) )) == zero)THEN
+                          ! This causes a problem, since we really should not
+                          ! be dividing by zero.  However, it seems to happen
+                          ! fairly rarely, so all we'll do is cycle to the
+                          ! next loop and keep track of this warning so we
+                          ! can look at it afterwards.
+                          warnings(iainia,jv,iwphoto)=warnings(iainia,jv,iwphoto)+un
+
+                          IF(err_act.GT.1)THEN
+                             WRITE(numout,*) 'Diffuco, Getting ready to divide by zero! C4'
+                             WRITE(numout,*) '( x1 - ( assimi(iainia,jv,ilev) + Rd(iainia,ilev) ) ', &
+                                  ( x1 - (assimi(iainia,jv,ilev) + Rd(iainia,ilev) ))
+                             WRITE(numout,*) 'x1,assimi(iainia,jv,ilev),Rd(iainia,ilev): ', &
+                                  x1,assimi(iainia,jv,ilev),Rd(iainia,ilev)
+                             WRITE(numout,*) 'jv,ilev,iainia: ', jv,ilev,iainia
+                          ENDIF
+
+                          CYCLE
+
+                       ENDIF
+
+                       ! Eq. 24 of Yin et al. (2009) 
+                       Obs = ( alpha(jv) * assimi(iainia,jv,ilev) ) / ( 0.047 * gbs(jv) ) + Oi
+                       ! Eq. 23 of Yin et al. (2009)
+                       Cc(iainia,ilev) = ( ( assimi(iainia,jv,ilev) + Rd(iainia,ilev) ) * &
+                            ( x2 * Obs + x3 ) + low_gamma_star(iainia) * Obs * x1 ) &
+                            / MAX(min_sechiba, x1 - ( assimi(iainia,jv,ilev) + Rd(iainia,ilev) ))
+                       ! Eq. 22 of Yin et al. (2009)
+                       leaf_ci(iainia,jv,ilev) = ( Cc(iainia,ilev) - ( b - assimi(iainia,jv,ilev) - Rm ) / gbs(jv) ) / a
+
+                       ! Eq. 25 of Yin et al. (2009)
+                       ! It should be Cs instead of Ca but it seems that 
+                       ! other equations in Appendix C make use of Ca
+                       IF ( ABS( assimi(iainia,jv,ilev) + Rd(iainia,ilev) ) .LT. min_sechiba ) THEN
+                          gs(iainia,ilev) = g0var(iainia)
+                       ELSE
+                          gs(iainia,ilev) = g0var(iainia) + ( assimi(iainia,jv,ilev) + Rd(iainia,ilev) ) / &
+                              ( Ca(iainia) - Cs_star ) * fvpd(iainia)
+                       ENDIF
+                       !                       
+                    ENDDO !! ENDDO about limit photo
+                    !
+                 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
+                    ! @}           
+                    !
+                    !
+                    !
+                    A_1=9999.
+
+                    ! See eq. right after eq. 18 of Yin et al. (2009)
+                    DO limit_photo=1,2
+                       ! Is Vc limiting the Assimilation
+                       IF ( limit_photo .EQ. 1 ) THEN
+
+		        IF (printlev_loc>=4) THEN
+	                    WRITE(numout,*) 'IF - A_1, Do in limit_photo limit_photo .EG. 1 '
+		        ENDIF
+                          x1 = vc2(iainia,ilev)
+                          ! It should be O not Oi (comment from Vuichard)
+                          x2 = KmC(iainia) * ( 1. + 2*gamma_star(iainia)*Sco(iainia) / KmO(iainia) )
+                          ! Is J limiting the Assimilation
+                       ELSE
+                          x1 = JJ(iainia,ilev)/4.
+                          x2 = 2. * gamma_star(iainia)
+                       ENDIF
+
+
+                       ! See Appendix B of Yin et al. (2009)
+                       a = g0var(iainia) * ( x2 + gamma_star(iainia) ) + &
+                            ( g0var(iainia) / gm(iainia) + fvpd(iainia) ) * ( x1 - Rd(iainia,ilev) )
+                       b = Ca(iainia) * ( x1 - Rd(iainia,ilev) ) - gamma_star(iainia) * x1 - Rd(iainia,ilev) * x2
+                       c = Ca(iainia) + x2 + ( 1./gm(iainia) + 1./gb_co2(iainia) ) * ( x1 - Rd(iainia,ilev) ) 
+                       d = x2 + gamma_star(iainia) + ( x1 - Rd(iainia,ilev) ) / gm(iainia)
+                       m = 1./gm(iainia) + ( g0var(iainia)/gm(iainia) + fvpd(iainia) ) * ( 1./gm(iainia) + 1./gb_co2(iainia) )
+
+                       p = - ( d + (x1 - Rd(iainia,ilev) ) / gm(iainia) + a * (1./gm(iainia) + 1./gb_co2(iainia) ) + &
+                            ( g0var(iainia)/gm(iainia) + fvpd(iainia)) * c) / m
+
+                       q = ( d * ( x1 - Rd(iainia,ilev) ) + a*c + ( g0var(iainia)/gm(iainia) + fvpd(iainia) ) * b ) / m
+                       r = - a * b / m
+
+                       ! See Yin et al. (2009) 
+                       QQ = ( (p**2._r_std) - 3._r_std * q) / 9._r_std
+                       UU = ( 2._r_std* (p**3._r_std) - 9._r_std *p*q + 27._r_std *r) /54._r_std
+
+                       IF  (QQ .GE. 0._r_std) THEN
+
+                          IF (ABS(UU/(QQ**1.5_r_std) ) .LE. 1._r_std)  THEN
+                          PSI = ACOS(UU/(QQ**1.5_r_std))
+                          A_1_tmp = -2._r_std * SQRT(QQ) * COS( PSI / 3._r_std ) - p / 3._r_std
+
+                          IF (( A_1_tmp .LT. A_1 )) THEN
+                             A_1 = A_1_tmp
+                             info_limitphoto(iainia,ilev)=2.
+                          ELSE
+                             ! In case, J is not limiting the assimilation
+                             ! we have to re-initialise x1 and x2 values
+                             ! in agreement with a Vc-limited assimilation 
+                             x1 = vc2(iainia,ilev)
+                             ! It should be O not Oi (comment from Vuichard)
+                             x2 = KmC(iainia) * ( 1. + 2*gamma_star(iainia)*Sco(iainia) / KmO(iainia) )                         
+
+                          ENDIF 
+                          ENDIF 
+                       ENDIF 
+                    ENDDO
+
+                    IF ( (A_1 .EQ. 9999.) .OR. ( A_1 .LT. (-Rd(iainia,ilev)) ) ) THEN
+                       WRITE(numout,*) 'We have a problem in diffuco_trans_co2'
+                       WRITE(numout,*) 'no real positive solution found for pft:',jv
+                       WRITE(numout,*) 'temp_sol:',temp_sol(iainia)
+                       WRITE(numout,*) 'vpd:',vpd(iainia)
+                       WRITE(numout,*) 'Setting the solution to -Rd(iainia,ilev):',-Rd(iainia,ilev)
+                       A_1 = -Rd(iainia,ilev)
+                    ENDIF
+                    assimi(iainia,jv,ilev) = A_1
+
+
+                    ! Eq. 18 of Yin et al. (2009)
+
+                    IF(printlev_loc>=4 .AND. jv == test_pft .AND. iainia == test_pft)THEN
+                       WRITE(numout,*) '( x1 - ( assimi(iainia,jv,ilev) + Rd(iainia,ilev) ) ', &
+                            ( x1 - (assimi(iainia,jv,ilev) + Rd(iainia,ilev) ))
+                       WRITE(numout,*) 'x1,assimi(iainia,jv,ilev),Rd(iainia,ilev): ', &
+                            x1,assimi(iainia,jv,ilev),Rd(iainia,ilev)
+                       WRITE(numout,*) 'jv,ilev,iainia: ', jv,ilev,iainia
+                    ENDIF
+                    
+                    !++++ TEMP +++++
+                    IF(( x1 - (assimi(iainia,jv,ilev) + Rd(iainia,ilev) )) == zero)THEN
+
+                       ! This causes a problem, since we really should not
+                       ! be dividing by zero.  However, it seems to happen
+                       ! fairly rarely, so all we'll do is cycle to the
+                       ! next loop and keep track of this warning so we
+                       ! can look at it afterwards.
+                       warnings(iainia,jv,iwphoto)=warnings(iainia,jv,iwphoto)+un
+
+                       IF(err_act.GT.1)THEN
+                          WRITE(numout,*) 'Diffuco, Getting ready to divide by zero! C3'
+                          WRITE(numout,*) '( x1 - ( assimi(iainia,jv,ilev) + Rd(iainia,ilev) ) ', &
+                               ( x1 - (assimi(iainia,jv,ilev) + Rd(iainia,ilev) ))
+                          WRITE(numout,*) 'x1,assimi(iainia,jv,ilev),Rd(iainia,ilev): ', &
+                               x1,assimi(iainia,jv,ilev),Rd(iainia,ilev)
+                          WRITE(numout,*) 'jv,ilev,iainia: ', jv,ilev,iainia
+                       ENDIF
+
+                       CYCLE
+
+                    ENDIF
+                    !++++++++++++++++++++++++++++++
+
+                    Cc(iainia,ilev) = ( gamma_star(iainia) * x1 + ( assimi(iainia,jv,ilev) + Rd(iainia,ilev) ) * x2 )  &
+                         / MAX( min_sechiba, x1 - ( assimi(iainia,jv,ilev) + Rd(iainia,ilev) ) )
+                    ! Eq. 17 of Yin et al. (2009)
+                    leaf_ci(iainia,jv,ilev) = Cc(iainia,ilev) + assimi(iainia,jv,ilev) / gm(iainia) 
+                    ! See eq. right after eq. 15 of Yin et al. (2009)
+                    ci_star = gamma_star(iainia) - Rd(iainia,ilev) / gm(iainia)
+                    ! 
+                    ! Eq. 15 of Yin et al. (2009)
+                    IF ( ABS( assimi(iainia,jv,ilev) + Rd(iainia,ilev) ) .LT. min_sechiba ) THEN
+                       gs(iainia,ilev) = g0var(iainia)
+                    ELSE
+                       gs(iainia,ilev) = g0var(iainia) + ( assimi(iainia,jv,ilev) + Rd(iainia,ilev) ) / ( leaf_ci(iainia,jv,ilev) &
+                            - ci_star ) * fvpd(iainia)
+                    ENDIF
+
+                 ENDIF !C3 vs C4
+                 !
+                 !
+                 ! this is only for output to netcdf
+                 gs_diffuco_output(iainia,jv,ilev) = gs(iainia,ilev)
+                 !
+                 !
+                 ! @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
+                 ! @}           
+                 !
+                 !
+                 ! keep stomatal conductance of the levels which we decide
+                 ! are the top levels.  Notice that we multiply by the LAI
+                 ! in the level here, so this is no longer a per leaf quantity,
+                 ! but the whole quantity.
+                 IF ( top_level(iainia,ilev) ) THEN
+                    gs_top(iainia) = gs_top(iainia)+gs(iainia,ilev)*lai_per_level(iainia,jv,ilev)
+                    !
+                 ENDIF
+                 !
+                 ! @addtogroup Photosynthesis
+                 ! @{   
+                 !
+                 !! 2.4.5 Integration at the canopy level\n
+                 !! \latexonly
+                 !! \input{diffuco_trans_co2_2.4.5.tex}
+                 !! \endlatexonly
+                 ! @}           
+                 ! total assimilation and conductance
+                 ! 
+                 !++++++++++++++++++++
+                 ! The equations give the amount of carbon produced per m**2 if
+                 ! leaf surface.  Therefore, since we want GPP in units of m**2 of land surface,
+                 ! we have to multiply by the LAI.
+
+                 assimtot(iainia,jv) = assimtot(iainia,jv) + &
+                      assimi(iainia,jv,ilev) * lai_per_level(iainia,jv,ilev)
+
+                 IF (.NOT. ok_impose_can_structure ) THEN 
+                     profile_assimtot(iainia,ilev) = profile_assimtot(iainia,ilev) + &
+                                                   & assimi(iainia,jv,ilev) * lai_per_level(iainia,jv,ilev)
+                     profile_Rdtot(iainia,ilev) = profile_Rdtot(iainia,ilev) + &
+                                                   & Rd(iainia,ilev) * lai_per_level(iainia,jv,ilev)
+                     profile_gstot(iainia,ilev) = profile_gstot(iainia,ilev) + &
+                                                   & gs(iainia,ilev) * lai_per_level(iainia,jv,ilev)
+                 END IF ! (ok_impose_can_structure ) THEN 
+
+!                      assimi(iainia) 
+
+                 Rdtot(iainia) = Rdtot(iainia) + &
+                      Rd(iainia,ilev) * lai_per_level(iainia,jv,ilev)
+                 gstot(iainia) = gstot(iainia) + &
+                      gs(iainia,ilev) * lai_per_level(iainia,jv,ilev)
+                 assimi_lev(iainia,jv,ilev) = assimi(iainia,jv,ilev)
+
+                 IF(test_pft == jv .AND. printlev_loc>=4)THEN
+                    WRITE(numout,'(A,2I5,10ES20.8)') 'assimi middle',ilev,&
+                         iainia,assimi(iainia,jv,ilev),assimtot(iainia,jv),gs(iainia,ilev),&
+                         gstot(iainia),lai_per_level(iainia,jv,ilev)
+                 ENDIF
+
+                 !! (JR 100714) we need to retain the gs (stomatal conductance) per level and per PFT for use
+                 !! outside of this routine, in the case that the supply term constraint is applied and the 
+                 !! stomatal conductance profile needs to be re-calculated.
+                 gs_store(iainia, jv, ilev) = gs(iainia,ilev)
+                 !
+
+                 IF (.NOT. ok_impose_can_structure ) THEN 
+                     profile_gstot(iainia, ilev) = profile_gstot(iainia, ilev) + &
+                                                      & gs(iainia,ilev) * lai_per_level(iainia,jv,ilev)
+                 END IF ! (ok_impose_can_structure ) THEN 
+
+                 !! (JR 100714) we also retain the gstot (stomatal conductance over all canopy levels, constrained
+                 !! by LAI, again for the recalculation of the stomatal conductance profile.
+                 gstot_store(iainia, jv) = gstot_store(iainia, jv) + (gs(iainia,ilev) * lai_per_level(iainia,jv,ilev))
+
+                 !
+              ENDIF ! if there is absorbed light
+ 
+           ENDDO  ! loop over levels
+
+        ENDDO assim_loop  ! loop over assimulation points    
+        
+        IF(jv==testpft) THEN 
+           templeafci(:,:)=leaf_ci(:,testpft,:) 
+           CALL histwrite_p(hist_id, 'Cc', kjit, Cc, kjpindex*(nlevels_tot+1), indexlai) 
+           CALL histwrite_p(hist_id, 'Vc', kjit, Vc2, kjpindex*(nlevels_tot+1), indexlai) 
+           CALL histwrite_p(hist_id, 'Vj', kjit, JJ, kjpindex*(nlevels_tot+1), indexlai) 
+           CALL histwrite_p(hist_id, 'limitphoto', kjit, info_limitphoto, kjpindex*(nlevels_tot+1), indexlai) 
+           CALL histwrite_p(hist_id, 'gammastar', kjit, gamma_star, kjpindex, index) 
+           CALL histwrite_p(hist_id, 'Kmo', kjit, Kmo, kjpindex, index) 
+           CALL histwrite_p(hist_id, 'Kmc', kjit, Kmc, kjpindex, index) 
+           CALL histwrite_p(hist_id, 'gm', kjit, gm, kjpindex, index) 
+           CALL histwrite_p(hist_id, 'gs', kjit, gs, kjpindex*(nlevels_tot+1), indexlai) 
+!          CALL histwrite_p(hist_id, 'leafci', kjit, templeafci, kjpindex*(nlevels_tot), indexlai) 
+!          CALL histwrite_p(hist_id, 'assimi', kjit, assimi, kjpindex*nvm*(nlevels_tot+1), indexlai) 
+           CALL histwrite_p(hist_id, 'Rd', kjit, Rd, kjpindex*(nlevels_tot+1), indexlai) 
+        ENDIF 
+
+      !
+      !! 2.5 Calculate resistances
+
+        DO inia=1,nia
+
+           !
+           iainia=index_assi(inia)
+           !
+
+           ! We hit a fringe case above where we could not
+           ! calculate the GPP.  Skip this loop so we don't
+           ! divide by zero.
+           IF(lskip(iainia)) CYCLE
+
+
+           !! Mean stomatal conductance for CO2 (mol m-2 s-1)
+           gsmean(iainia,jv) = gstot(iainia)
+           !
+           ! cimean is the "mean ci" calculated in such a way that assimilation 
+           ! calculated in enerbil is equivalent to assimtot
+           !
+
+           IF (.NOT. ok_impose_can_structure ) THEN 
+               DO ilev = 1, nlevels_tot
+                   profile_gsmean(iainia, jv, ilev) = profile_gstot(iainia, ilev)
+                    IF(printlev_loc >= 4) WRITE(numout,*) '110215 profile_gsmean by level: ', &
+                         ilev, ' is: ', profile_gsmean(iainia, jv, ilev)
+               ENDDO ! ilev = 1, nlevels_tot
+           END IF ! (ok_impose_can_structure ) THEN 
+
+           IF((assimtot(iainia,jv)+Rdtot(iainia)) .GT. min_sechiba)THEN
+              cimean(iainia,jv) = (gsmean(iainia,jv)-g0var(iainia)) &
+                   / (fvpd(iainia)*(assimtot(iainia,jv)+Rdtot(iainia))) & 
+                   + gamma_star(iainia)
+           ELSE
+              ! According to Nicolas, this variable is completely diagnostic and not
+              ! used for anything.  If the analytical photosynthesis is unable to find
+              ! a solution for the A_1 coefficients in any of the levels, assimtot will
+              ! be equal to -Rd, which means we will be dividing by zero.  This loop
+              ! is to prevent that, and since cimean is diagnostic is doesn't matter
+              ! what the value is.
+              cimean(iainia,jv) = val_exp
+           ENDIF
+                
+
+
+           IF (.NOT. ok_impose_can_structure ) THEN 
+              DO ilev = 1, nlevels_tot
+                 IF((profile_assimtot(iainia,ilev)+profile_Rdtot(iainia,ilev)) .GT. min_sechiba)THEN
+                    profile_cimean(iainia,jv,ilev) = (profile_gs_store(iainia,jv,ilev)-g0(jv)) &
+                         / (fvpd(iainia)*(profile_assimtot(iainia,ilev)+profile_Rdtot(iainia,ilev))) &
+                         + gamma_star(iainia)
+                    IF(printlev_loc >= 4) THEN
+                         WRITE(numout,*) '210515 fvpd:', fvpd(iainia)
+                         WRITE(numout,*) 'profile_assimtot:', profile_assimtot(iainia,ilev)
+                         WRITE(numout,*) 'profile Rdtot:', profile_Rdtot(iainia,ilev)  
+                    ENDIF ! IF(printlev >= 4)
+                 ELSE
+                    ! According to Nicolas, this variable is completely diagnostic and not
+                    ! used for anything.  If the analytical photosynthesis is unable to find
+                    ! a solution for the A_1 coefficients in any of the levels, assimtot will
+                    ! be equal to -Rd, which means we will be dividing by zero.  This loop
+                    ! is to prevent that, and since cimean is diagnostic is doesn't matter
+                    ! what the value is.
+                    profile_cimean(iainia,jv,ilev) = val_exp
+                 ENDIF
+                 ! WRITE(numout, *) '100215b profile_cimean by level: ', ilev, ' is: ', profile_cimean(iainia, jv, ilev)
+              ENDDO ! ilev = 1, nlevels_tot
+           END IF ! (ok_impose_can_structure ) THEN 
+
+
+           ! conversion from umol m-2 (PFT) s-1 to gC m-2 (mesh area) tstep-1
+           gpp(iainia,jv) = assimtot(iainia,jv)*12e-6*veget_max(iainia,jv)*dt_sechiba
+           istep=istep+1
+           
+           IF (printlev_loc>=4) THEN
+              WRITE(numout,*) 'GPP DIFFUCO: ',istep,gpp(iainia,jv),iainia,jv,assimtot(iainia,jv),veget_max(iainia,jv),dt_sechiba
+           ENDIF
+
+           IF (.NOT. ok_impose_can_structure ) THEN 
+              DO ilev = 1, nlevels_tot
+                 profile_gpp(iainia,jv,ilev) = profile_assimtot(iainia, ilev)*12e-6*veget_max(iainia,jv)*dt_sechiba
+                 IF(printlev_loc >= 4)  WRITE(numout, *) '100215b profile_gpp by level: ', &
+                      ilev, ' is: ', profile_gpp(iainia, jv, ilev)
+              END DO ! ilev = 1, nlevels_tot
+           END IF ! (ok_impose_can_structure ) THEN 
+
+           ! As in Pearcy, Schulze and Zimmermann
+           ! Measurement of transpiration and leaf conductance
+           ! Chapter 8 of Plant Physiological Ecology
+           ! Field methods and instrumentation, 1991
+           ! Editors:
+           !
+           !    Robert W. Pearcy,
+           !    James R. Ehleringer,
+           !    Harold A. Mooney,
+           !    Philip W. Rundel
+           !
+           ! ISBN: 978-0-412-40730-7 (Print) 978-94-010-9013-1 (Online)
+           !
+           !
+           !
+           !++++++++ CHECK +++++++++
+           ! Do we need to normalise gs_top here by the LAI in the level?
+           ! In the trunk, it seems like they use an LAI of 0.1, so renormalise
+           ! to that.  The default value of lai_top is 0.1.
+           !
+           !! (JR 100714)
+           !! gs_top is normalised in the trunk over the entire canopy LAI, as it
+           !! meant to provide backwards compatability with the 'old' method for calculating
+           !! the stomatal conductance (in diffuco_trans) that calculates gs according to 
+           !! incident SW radiation (rather than CO2 concentration, as here in diffuco_trans_co2)
+           !!
+           !! rstruct in diffuco_trans is an extra resistance term added to reflect the fact
+           !! that less light reaches the lower canopy, and the total resistance used to calculate
+           !! vbeta3, and hence the transpiration, is (rstruct + rveget)
+           !!
+           !! The rstruct term makes the code more difficult to follow, and is no longer has
+           !! a physical requirement. We are getting small values of gstop as calculated below,
+           !! which was resulting in big resistances when rstruct = min_sechiba and 
+           !! rveget = un/gstop and total resistance = (rstruct + rveget) - see commented out
+           !! code below.
+           !!
+           !! The most transparent structure is to set total resistance = rveget = (1 / gstot)
+           !! This is analogous to the way in which assimtot, and hence canopy GPP, is calculated
+           !! above
+
+           gs_top(iainia)=gs_top(iainia)/totlai_top*lai_top(jv)
+           !+++++++++++++++++++++++++
+
+           gstot(iainia) =  mol_to_m_1 *(temp_sol(iainia)/tp_00)*&
+                (pb_std/pb(iainia))*gstot(iainia)*ratio_H2O_to_CO2
+           gstop(iainia) =  mol_to_m_1 * (temp_sol(iainia)/tp_00)*&
+                (pb_std/pb(iainia))*gs_top(iainia)*ratio_H2O_to_CO2
+
+
+           IF (.NOT. ok_impose_can_structure ) THEN 
+              DO ilev = 1, nlevels_tot
+
+                  profile_gsmean(iainia,jv,ilev) = profile_gsmean(iainia,jv,ilev) * 1e-6
+
+                  profile_gstot(iainia,ilev) =  mol_to_m_1 *(temp_sol(iainia)/tp_00)*&
+                    (pb_std/pb(iainia))*profile_gstot(iainia,ilev)*ratio_H2O_to_CO2
+
+                  profile_gstop(iainia,ilev) =  mol_to_m_1 * (temp_sol(iainia)/tp_00)*&
+                    (pb_std/pb(iainia))*gs_top(iainia)*ratio_H2O_to_CO2*&
+                    lai_per_level(iainia,jv,ilev)
+
+              END DO ! ilev = 1, nlevels_tot
+           END IF ! (ok_impose_can_structure ) THEN                  
+
+   
+           !IF (jv == test_pft .AND. test_grid == 1) THEN 
+           !         WRITE(numout, '(A20)'        ) 'Without water stress:'
+           !         WRITE(numout, '(A20, I5)'    ) 'pft type is:    ', jc
+           !        WRITE(numout, '(A20, ES15.5)') 'Old_Gs_total:', gstot(iainia)            
+           !ENDIF   
+            
+           ! THIS PART OF CORRECTION OF ::gstot SHOULD BE CONSISTENCY WITH 
+           ! "SECHIBA_HYDROL_ARCH" where the ::gstot is recalculated, again. 
+             
+           !++++++ CHECK ++++++
+           ! We introduce ::coupled_lai to calculate the :: vbeta3 
+           ! In an closed canopy not all the leaves fully interact with the
+           ! atmosphere because leaves can shelter each other. In a more open
+           ! canopy most leaves can interact with the atmosphere. We use the
+           ! ratio of lai over ::Pgap as a proxy for the amount of canopy that
+           ! can interact with the atmosphere. Clearly that amount of lai that
+           ! interacts should never exceed the:: total_lai.
+           coupled_lai(iainia, jv) = biomass_to_coupled_lai( SUM(circ_class_biomass(iainia, &
+                jv,:, ileaf, icarbon)*circ_class_n(iainia,jv,:)), veget(iainia,jv), jv)
+           
+           total_lai(iainia, jv) = cc_to_lai( circ_class_biomass(iainia, jv,:, ileaf,&
+                icarbon),circ_class_n(iainia, jv,:), jv )
+
+           !---TEMP---
+!!$           IF (printlev_loc>=4) THEN
+!!$              WRITE(numout,*) 'coupled LAI, ',  jv, coupled_lai(iainia, jv)
+!!$              WRITE(numout,*) 'total LAI, ',  jv, total_lai(iainia, jv)
+!!$              WRITE(numout,*) 'veget, ', jv, veget(iainia, jv)
+!!$              WRITE(numout,*) 'biomass(ileaf), ',biomass(iainia, jv, ileaf, icarbon) 
+!!$           ENDIF
+           !----------
+      
+           !+++++CHECK++++
+           !Here, we try to use coupled_lai to reset/refine the total stomata conductance 
+           !which interacted with the atmosphere for the transpiration for each pft.
+           gstot(iainia) = gstot(iainia)* (coupled_lai(iainia,jv)/total_lai(iainia,jv))
+           !++++++++++++++
+    
+           !+++++++++CHECK++++++++
+           !To get the resonable transpiration we had to set :: lai_top to
+           !::lai
+           !so we were using the entire canopy. Therefore we no longer use
+           !::lai_top and simply make use of the entire canopy to calculate the
+           !vegetation resistance from inverse of ::gstot so, we calculate the
+           !:: rveget using :: 1/gstot
+           rveget(iainia, jv) = un / gstot(iainia) 
+           !+++++++++++++++++++++++++++++++++++++++           
+
+           !rveget(iainia,jv) = un/gstop(iainia)
+!!$           rveget_min(iainia,jv) = (defc_plus / kzero(jv)) * &
+!!$                (un / SUM(lai_per_level(iainia,jv,:)))
+           !
+           ! rstruct is the difference between rtot (=1./gstot) and rveget
+           !
+           ! Correction Nathalie - le 27 Mars 2006 - Interdire a rstruct d'etre negatif
+           !rstruct(iainia,jv) = un/gstot(iainia) - &
+           !     rveget(iainia,jv)
+           
+           !++++++++ CHECK +++++++
+           !It seems that the calcualtion of rstruct is duplicated with the calculation of rvegt
+           !So, we set the ::rstruct as zero 
+           !rstruct(iainia,jv) = MAX( un/gstot(iainia) - &
+           !     rveget(iainia,jv), min_sechiba)
+           !
+           !
+           !! wind is a global variable of the diffuco module.
+           speed = MAX(min_wind, wind(iainia))
+           !
+           ! beta for transpiration
+           !
+           ! Corrections Nathalie - 28 March 2006 - on advices of Fred Hourdin
+           !! Introduction of a potentiometer rveg_pft to settle the rveg+rstruct sum problem in the coupled mode.
+           !! rveg_pft=1 in the offline mode. rveg_pft is a global variable declared in the diffuco module.
+           !vbeta3(iainia,jv) = veget_max(iainia,jv) * &
+           !  (un - zqsvegrap(iainia)) * &
+           !  (un / (un + speed * q_cdrag(iainia) * (rveget(iainia,jv) + &
+           !   rstruct(iainia,jv))))
+           !! Global resistance of the canopy to evaporation
+           !cresist=(un / (un + speed * q_cdrag(iainia) * &
+           !     veget(iainia,jv)/veget_max(iainia,jv) * &
+           !     (rveg_pft(jv)*(rveget(iainia,jv) + rstruct(iainia,jv)))))
+
+           ! (JR 100714)
+           ! previously the resistance term in this expression was (rveget + rstruct), but we now
+           ! use rveget alone  
+
+           cresist=(un / (un + speed * q_cdrag(iainia) * &
+                (rveg_pft(jv)*(rveget(iainia,jv)))))
+
+           !+++CHECK+++
+           !For the interception we assume -as earlier- that the surface area
+           !that intercepts is well estimated by ::veget. This is wrong because
+           !every leav can contribute to the interception. Depending on weather
+           !the parameters for interception are bulk values or single leave. Our
+           !approach is correct or needd to be improved.  
+           !
+           vbeta3(iainia,jv) = veget_max(iainia,jv) * &
+                (un - zqsvegrap(iainia)) * cresist + &
+                MIN( vbeta23(iainia,jv), veget(iainia,jv) * &
+                zqsvegrap(iainia) * cresist )
+           !+++++++++++++++++++++++++
+           
+           !vbeta3(iainia,jv) = veget_max(iainia,jv) * &
+           !     (un - zqsvegrap(iainia)) * cresist + &
+           !     MIN( vbeta23(iainia,jv), veget_max(iainia,jv) * &
+           !     zqsvegrap(iainia) * cresist )
+
+
+
+           IF (.NOT. ok_impose_can_structure ) THEN 
+               DO ilev = 1, nlevels_tot
+                   
+                   ! Fix the gstot equal zero condition to aviod the issue of divided by zero
+                   IF ( profile_gstot(iainia,ilev) .LE. min_sechiba ) THEN
+                       profile_gstot(iainia,ilev) = 1.0d-6 
+                   ENDIF
+
+                   profile_rveget(iainia,jv,ilev) = un/profile_gstot(iainia,ilev)
+
+                   ! need to resolve the rstruct issue
+                   profile_rstruct(iainia,jv,ilev) = MAX (un/profile_gstot(iainia,ilev) - &
+                                                  & profile_rveget(iainia,jv,ilev), min_sechiba)
+
+                   profile_speed(ilev) = MAX(min_wind, u_speed(ilev))  ! n.b. need to replace this with another wind profile parameterisation
+
+                   profile_cresist(ilev) = (un / (un + u_speed(ilev) * q_cdrag(iainia) * & 
+                                        & (rveg_pft(jv) * (profile_rveget(iainia,jv,ilev) + profile_rstruct(iainia,jv,ilev)) ) ) )
+
+                   profile_vbeta3(iainia,jv,ilev) = veget_max(iainia,jv) * (un - zqsvegrap(iainia)) * profile_cresist(ilev) + & 
+                                        & MIN( vbeta23(iainia,jv), &
+                                        veget_max(iainia,jv) * zqsvegrap(iainia) * profile_cresist(ilev) )
+
+               END DO ! ilev = 1, nlevels_tot
+           END IF ! (ok_impose_can_structure ) THEN 
+
+             
+           IF (printlev_loc>=4) THEN
+               DO ilev = 1, nlevels_tot
+                   WRITE(numout, *) 'profile_rveget(iainia, jv, ilev) is: ', profile_rveget(iainia, jv, ilev)
+               END DO
+
+               DO ilev = 1, nlevels_tot
+                   WRITE(numout, *) 'profile_vbeta3(iainia, jv, ilev) is: ', profile_vbeta3(iainia, jv, ilev)
+               END DO
+
+               DO ilev = 1, nlevels_tot            
+                   WRITE(numout, *) 'profile_cresist(ilev) is: ', (profile_cresist(ilev))
+               END DO
+           END IF !(printlev_loc) 
+
+           ! vbeta3pot for computation of potential transpiration (needed for irrigation)
+           vbeta3pot(iainia,jv) = MAX(zero, veget_max(iainia,jv) * cresist)
+           !
+           !
+            
+        ENDDO !loop over grid points
+
+        !
+     ENDIF ! if nia LT zero
+       
+  ENDDO  ! loop over vegetation types
+
+
+  DO ic = 1, kjpindex
+     DO jc = 1, nvm 
+     !++++++TEMP++++++++++++++++++++++++++++++++++++
+     !  IF (printlev_loc>=4 .AND. jc == test_pft) THEN
+     !     WRITE(714,   '(A20, ES20.4)') 'Rcanopy,', (un / (un + speed *q_cdrag(ic) * &
+     !                        (rveg_pft(jc)*(rveget(ic,jc) + rstruct(ic,jc))))) 
+                                                   
+     !     WRITE(numout,'(A20, ES20.4)') 'Rcanopy',(un / (un + speed *q_cdrag(ic) * &
+     !                        (rveg_pft(jc)*(rveget(ic,jc) + rstruct(ic,jc))))) 
+     !  ENDIF
+     !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+     
+
+     
+        IF(veget_max(ic,jc) == zero)THEN
+            ! this vegetation type is not present, so no reason to do the 
+            ! calculation
+            CYCLE
+        ENDIF
+
+        DO kc = 1, nlevels_tot
+            gs_column_total(ic,jc) = gs_column_total(ic,jc) + gs_store(ic,jc,kc) * lai_per_level(ic,jc,kc) 
+
+            gstot_component(ic,jc,kc) = gs_store(ic,jc,kc) * lai_per_level(ic,jc,kc) 
+
+            IF (gstot_store(ic,jc) .eq. 0.0d0) THEN
+                gstot_frac(ic,jc,kc) = 0.0d0
+            ELSE
+                gstot_frac(ic,jc,kc) = gstot_component(ic,jc,kc) / gstot_store(ic,jc)
+            END IF
+        END DO ! kc = 1, nlevels_tot 
+     END DO ! jc = 1, nvm
+  END DO ! ic = 1, kjpindex
+
+
+   Abs_light(:,:,:) = zero
+   Abs_light_can(:,:) = zero
+   
+  DO ic = 1, kjpindex
+     DO jc = 1, nvm 
+        IF(veget_max(ic,jc) == zero)THEN
+            ! this vegetation type is not present, so no reason to do the 
+            ! calculation
+            CYCLE
+        ENDIF
+
+        DO kc = 1, nlevels_tot
+           IF (gs_column_total(ic,jc) .ne. zero) THEN
+              gs_distribution(ic,jc,kc) = gs_store(ic,jc,kc)* lai_per_level(ic,jc,kc) / gs_column_total(ic,jc)
+           ELSE
+              gs_distribution(ic,jc,kc) = zero
+           END IF
+              Abs_light(ic,jc,kc)=Isotrop_Abs_Tot_p(ic,jc,kc)*light_tran_to_level(ic,jc,kc)
+           END DO ! kc = 1, nlevels_tot 
+           IF (jv==test_pft .AND. printlev_loc>=4) THEN  
+              Abs_light_can(:,:)=SUM(Abs_light(:,:,:),3)
+              WRITE(numout,*) 'Absorbed light in the canopy', Abs_light_can(:,jc)
+           ENDIF
+     END DO ! jc = 1, nvm
+  END DO ! ic = 1, kjpindex   
+
+!!$   !++++++ WRITING OUT SOME STUFF
+!!$   counter=counter+1
+!!$   WRITE(123,'(I8,20F20.10)') counter,gs_distribution(test_grid,test_pft,:)
+!!$   WRITE(124,'(I8,20F20.10)') counter,gstot_frac(test_grid,test_pft,:)
+!!$   WRITE(125,'(I8,20F20.10)') counter,gstot_store(test_grid,test_pft)
+!!$   WRITE(126,'(I8,20F20.10)') counter,gs_store(test_grid,test_pft,:)
+!!$   WRITE(127,'(I8,20F20.10)') counter,lai_per_level(test_grid,test_pft,:)
+!!$   WRITE(128,'(I8,20F20.10)') counter,gstot_component(test_grid,test_pft,:)
+!!$   WRITE(129,'(I8,20F20.10)') counter,gs_column_total(test_grid,test_pft)
+!!$   WRITE(130,'(I8,20F20.10)') counter,SUM(lai_per_level(test_grid,test_pft,:))
+!!$   IF(rveget(test_grid,test_pft) .LT. 1e19) &
+!!$        WRITE(131,'(I8,20ES20.10)') counter,rveget(test_grid,test_pft)
+!!$   IF(rveget_min(test_grid,test_pft) .LT. 1e19) &
+!!$        WRITE(132,'(I8,20ES20.10)') counter,rveget_min(test_grid,test_pft)
+!!$   WRITE(133,'(I8,20ES20.10)') counter,vbeta3(test_grid,test_pft)
+!!$   WRITE(134,'(I8,20ES20.10)') counter,vbeta3pot(test_grid,test_pft)
+   
+  IF (printlev_loc>=3) WRITE (numout,*) ' diffuco_trans_co2 done ' 
+
+END SUBROUTINE diffuco_trans_co2
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	   : diffuco_comb
+!!
+!>\BRIEF           This routine combines the previous partial beta 
+!! coefficients and calculates the total alpha and complete beta coefficients.
+!!
+!! DESCRIPTION	   : Those integrated coefficients are used to calculate (in enerbil.f90) the total evapotranspiration 
+!! from the grid-cell. \n
+!!
+!! In the case that air is more humid than surface, dew deposition can occur (negative latent heat flux). 
+!! In this instance, for temperature above zero, all of the beta coefficients are set to 0, except for 
+!! interception (vbeta2) and bare soil (vbeta4 with zero soil resistance). The amount of water that is 
+!! intercepted by leaves is calculated based on the value of LAI of the surface. In the case of freezing 
+!! temperatures, water is added to the snow reservoir, and so vbeta4 and vbeta2 are set to 0, and the 
+!! total vbeta 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 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, vbeta
+!!
+!! REFERENCE(S) :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!!
+!! FLOWCHART    :
+!! \latexonly 
+!!     \includegraphics[scale=0.25]{diffuco_comb_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_comb (kjpindex, humrel, rau, u, v, q_cdrag, pb, qair, temp_sol, temp_air, &
+        snow, veget, circ_class_biomass, circ_class_n,&
+        tot_bare_soil, vbeta1, vbeta2, vbeta3 , vbeta4, vbeta, qsintmax, vbeta2sum, vbeta3sum)    
+    
+    ! Ajout qsintmax dans les arguments de la routine Nathalie / le 13-03-2006
+
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT (in)                          :: kjpindex   !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: rau        !! Air Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: u          !! Eastward Lowest level wind speed (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: v          !! Nortward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: q_cdrag    !! Surface drag coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: pb         !! Lowest level pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qair       !! Lowest level specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: temp_sol   !! Skin temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: temp_air   !! Lower air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: snow       !! Snow mass (kg)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget      !! Fraction of vegetation type (fraction)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintmax   !! Maximum water on vegetation (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: tot_bare_soil!! Total evaporating bare soil fraction 
+    REAL(r_std),DIMENSION (kjpindex,nvm,ncirc,nparts,nelements), INTENT (in)    :: circ_class_biomass   !!
+    REAL(r_std),DIMENSION (kjpindex,nvm,ncirc), INTENT (in)    :: circ_class_n   !!
+    !! 0.2 Output variables
+    
+    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 (-)
+    REAL(r_std), DIMENSION(kjpindex), INTENT (inout)     :: vbeta2sum, vbeta3sum
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                       :: ji, jv
+    REAL(r_std)                                          :: zevtest, zsoil_moist, zrapp
+    REAL(r_std), DIMENSION(kjpindex)                     :: qsatt
+    LOGICAL, DIMENSION(kjpindex)                         :: toveg, tosnow
+    REAL(r_std)                                          :: coeff_dew_veg
+    REAL(r_std), DIMENSION(kjpindex)                     :: vbeta2sum_temp,vbeta3sum_temp
+    REAL(r_std),DIMENSION (kjpindex,nvm)                 :: lai        !! Leaf area index (m^2 m^{-2})
+!_ ================================================================================================================================
+    
+    !! \latexonly 
+    !!     \input{diffucocomb1.tex}
+    !! \endlatexonly
+
+    !! 0. Initialisation of vbeta2sum and vbeta3sum. They  are needed in the 
+    !! calculations for the multi-layer  energy budget.
+    vbeta2sum(:) = zero
+    vbeta3sum(:) = zero
+
+    !! 0.1 Calculate the LAI from the biomass. 
+    ! This is done to prevent passing an incorrect
+    ! LAI around, since LAI is diagnostic.
+    ! We can't do this if we use an LAI map! So this breaks DO_STOMATE=N
+    lai(:,ibare_sechiba) = zero
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          lai(ji,jv) = cc_to_lai(circ_class_biomass(ji,jv,:,ileaf,icarbon),circ_class_n(ji,jv,:),jv)
+       ENDDO
+    ENDDO
+    
+    !! 1. If dew is present:
+     
+    CALL qsatcalc (kjpindex, temp_sol, pb, qsatt)
+
+    
+    !! 1.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
+
+              !! If it is not freezing dew is put into the 
+              !! interception reservoir and onto the bare soil.
+              toveg(ji) = .TRUE.
+          ELSE
+
+              !! If it is freezing water is put into the 
+              !! snow reservoir.
+              tosnow(ji) = .TRUE.
+          ENDIF
+      ENDIF
+    END DO
+
+
+    !! 1.2 Now modify vbetas where necessary.
+    
+    !! 1.2.1 Soil and snow 
+    !! \latexonly 
+    !!     \input{diffucocomb6.tex}
+    !! \endlatexonly
+    DO ji = 1, kjpindex
+      IF ( toveg(ji) ) THEN
+        vbeta1(ji) = zero
+        vbeta4(ji) = tot_bare_soil(ji)
+!!        vbeta(ji) = vbeta4(ji)
+!!        vbeta2sum(ji) = 0.0d0
+!!        vbeta3sum(ji) = 0.0d0
+      ENDIF
+      IF ( tosnow(ji) ) THEN
+        vbeta1(ji) = un
+        vbeta4(ji) = zero
+!!        vbeta(ji) = un
+!!        vbeta2sum(ji) = 1.0d0
+!!        vbeta3sum(ji) = 0.0d0
+      ENDIF
+    ENDDO
+
+    !! 1.2.2 Vegetation 
+    !! \latexonly 
+    !!     \input{diffucocomb7.tex}
+    !! \endlatexonly
+    DO jv = 1, nvm
+      
+      DO ji = 1, kjpindex
+        
+        IF ( toveg(ji) ) THEN
+           IF (qsintmax(ji,jv) .GT. min_sechiba) THEN
+              
+              ! Compute part of dew that can be intercepted by leafs.
+              IF ( lai(ji,jv) .GT. min_sechiba) THEN
+                IF (lai(ji,jv) .GT. 1.5) THEN
+                   coeff_dew_veg= &
+                         &   dew_veg_poly_coeff(6)*lai(ji,jv)**5 &
+                         & - dew_veg_poly_coeff(5)*lai(ji,jv)**4 &
+                         & + dew_veg_poly_coeff(4)*lai(ji,jv)**3 &
+                         & - dew_veg_poly_coeff(3)*lai(ji,jv)**2 &
+                         & + dew_veg_poly_coeff(2)*lai(ji,jv) &
+                         & + dew_veg_poly_coeff(1)
+                 ELSE
+                    coeff_dew_veg=un
+                 ENDIF
+              ELSE
+                 coeff_dew_veg=zero
+              ENDIF
+              IF (jv .EQ. 1) THEN
+                ! This line may not work with CWRR when frac_bare is distributed
+                ! among three soiltiles. Fortunately, qsintmax(ji,1)=0 (LAI=0 in
+                ! PFT1) so we never pass here
+                 vbeta2(ji,jv) = coeff_dew_veg*tot_bare_soil(ji)
+              ELSE
+                 vbeta2(ji,jv) = coeff_dew_veg*veget(ji,jv)
+              ENDIF
+           ELSE
+              vbeta2(ji,jv) = zero ! if qsintmax=0, vbeta2=0
+           ENDIF
+!!           vbeta(ji) = vbeta(ji) + vbeta2(ji,jv)
+!!           vbeta4(ji) = 0.0d0
+!!           vbeta2sum(ji) = vbeta(ji)
+!!           vbeta3sum(ji) = 0.0d0
+        ENDIF
+        IF ( tosnow(ji) ) vbeta2(ji,jv) = zero
+        
+      ENDDO
+      
+    ENDDO
+
+    !! 1.2.3 Vegetation and transpiration  
+    !! 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
+
+    
+    !!  1.2.4 Overrules 1.2.2 
+    !! 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
+
+    !! 2. Now calculate vbeta in all cases (the equality needs to hold for enerbil to be consistent)
+    DO ji = 1, kjpindex
+          vbeta(ji) = vbeta4(ji) + SUM(vbeta2(ji,:)) + SUM(vbeta3(ji,:))
+
+          vbeta2sum(ji) = SUM(vbeta2(ji,:))
+          vbeta3sum(ji) = SUM(vbeta3(ji,:))
+
+
+          IF (vbeta(ji) .LT. min_sechiba) THEN
+             vbeta(ji) = zero
+             vbeta4(ji) = zero
+             vbeta2(ji,:)= zero
+             vbeta3(ji,:)= zero
+          END IF
+    ENDDO
+
+    IF (printlev>=3) WRITE (numout,*) ' diffuco_comb done '
+
+  END SUBROUTINE diffuco_comb
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	: diffuco_raerod
+!!
+!>\BRIEF	Computes the aerodynamic resistance, for cases in which the
+!! surface drag coefficient is provided by the coupled atmospheric model LMDZ and  when the flag
+!! 'ldq_cdrag_from_gcm' is set to TRUE
+!!
+!! DESCRIPTION	: Simply computes the aerodynamic resistance, for cases in which the
+!! surface drag coefficient is provided by the coupled atmospheric model LMDZ. If the surface drag coefficient
+!! is not provided by the LMDZ or signalled by the flag 'ldq_cdrag_from_gcm' set to FALSE, then the subroutine
+!! diffuco_aero is called instead of this one.
+!!
+!! Calculation of the aerodynamic resistance, for diganostic purposes. First calculate wind speed:
+!! \latexonly 
+!!     \input{diffucoaerod1.tex}
+!! \endlatexonly       
+!!
+!! next calculate ::raero
+!! \latexonly 
+!!     \input{diffucoaerod2.tex}
+!! \endlatexonly
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::raero
+!!
+!! REFERENCE(S)	:
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influence de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!!
+!! FLOWCHART    :  None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_raerod (kjpindex, u, v, q_cdrag, raero)
+    
+    IMPLICIT NONE
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                     :: kjpindex     !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: u            !! Eastward Lowest level wind velocity (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: v            !! Northward Lowest level wind velocity (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: q_cdrag      !! Surface drag coefficient (-)
+    
+    !! 0.2 Output variables 
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: raero        !! Aerodynamic resistance (s m^{-1})
+     
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                 :: ji           !! (-)
+    REAL(r_std)                                    :: speed        !! (m s^{-1})
+!_ ================================================================================================================================
+   
+  !! 1. Simple calculation of the aerodynamic resistance, for diganostic purposes.
+
+    DO ji=1,kjpindex
+
+       !! \latexonly 
+       !!     \input{diffucoaerod1.tex}
+       !! \endlatexonly       
+       speed = MAX(min_wind, wind(ji))
+
+       !! \latexonly 
+       !!     \input{diffucoaerod2.tex}
+       !! \endlatexonly
+       raero(ji) = un / (q_cdrag(ji)*speed)
+       
+    ENDDO
+  
+  END SUBROUTINE diffuco_raerod
+
+
+  FUNCTION Arrhenius (kjpindex,temp,ref_temp,energy_act) RESULT ( val_arrhenius )
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                     :: kjpindex          !! Domain size (-)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)    :: temp              !! Temperature (K)
+    REAL(r_std), INTENT(in)                       :: ref_temp          !! Temperature of reference (K)
+    REAL(r_std),INTENT(in)                        :: energy_act        !! Activation Energy (J mol-1)
+    
+    !! 0.2 Result
+
+    REAL(r_std), DIMENSION(kjpindex)              :: val_arrhenius     !! Temperature dependance based on
+                                                                       !! a Arrhenius function (-)
+    
+    val_arrhenius(:)=EXP(((temp(:)-ref_temp)*energy_act)/(ref_temp*RR*(temp(:))))
+  END FUNCTION Arrhenius
+
+  FUNCTION Arrhenius_modified_1d (kjpindex,temp,ref_temp,energy_act,energy_deact,entropy) RESULT ( val_arrhenius )
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                     :: kjpindex          !! Domain size (-)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)    :: temp              !! Temperature (K)
+    REAL(r_std), INTENT(in)                       :: ref_temp          !! Temperature of reference (K)
+    REAL(r_std),INTENT(in)                        :: energy_act        !! Activation Energy (J mol-1)
+    REAL(r_std),INTENT(in)                        :: energy_deact      !! Deactivation Energy (J mol-1)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)    :: entropy           !! Entropy term (J K-1 mol-1)
+        
+    !! 0.2 Result
+
+    REAL(r_std), DIMENSION(kjpindex)              :: val_arrhenius     !! Temperature dependance based on
+                                                                       !! a Arrhenius function (-)
+    
+    val_arrhenius(:)=EXP(((temp(:)-ref_temp)*energy_act)/(ref_temp*RR*(temp(:))))  &
+         * (1. + EXP( (ref_temp * entropy(:) - energy_deact) / (ref_temp * RR ))) &
+         / (1. + EXP( (temp(:) * entropy(:) - energy_deact) / ( RR*temp(:))))
+         
+  END FUNCTION Arrhenius_modified_1d
+
+  FUNCTION Arrhenius_modified_0d (kjpindex,temp,ref_temp,energy_act,energy_deact,entropy) RESULT ( val_arrhenius ) 
+    !! 0.1 Input variables 
+    
+    INTEGER(i_std),INTENT(in)                     :: kjpindex          !! Domain size (-) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)    :: temp              !! Temperature (K) 
+    REAL(r_std), INTENT(in)                       :: ref_temp          !! Temperature of reference (K) 
+    REAL(r_std),INTENT(in)                        :: energy_act        !! Activation Energy (J mol-1) 
+    REAL(r_std),INTENT(in)                        :: energy_deact      !! Deactivation Energy (J mol-1) 
+    REAL(r_std),INTENT(in)                        :: entropy           !! Entropy term (J K-1 mol-1) 
+         
+    !! 0.2 Result 
+    
+    REAL(r_std), DIMENSION(kjpindex)              :: val_arrhenius     !! Temperature dependance based on 
+                                                                       !! a Arrhenius function (-) 
+            
+    val_arrhenius(:)=EXP(((temp(:)-ref_temp)*energy_act)/(ref_temp*RR*(temp(:))))  & 
+         * (1. + EXP( (ref_temp * entropy - energy_deact) / (ref_temp * RR ))) & 
+         / (1. + EXP( (temp(:) * entropy - energy_deact) / ( RR*temp(:)))) 
+                 
+  END FUNCTION Arrhenius_modified_0d
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : isotope_c13
+!!
+!>\BRIEF         Calculate the fractionation of C13 during photosynthesis\n
+!!
+!! DESCRIPTION  :   
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: delta_c13_assim
+!!
+!! REFERENCE(S) : 
+!!	- Farquhar, G. D., Ehleringer, J. R., & Hubick, K. T. (1989). CARBON ISOTOPE DISCRIMINATION AND PHOTOSYNTHESIS. 
+!!	  Annual Review of Plant Physiology and Plant Molecular Biology, 40, 503-537. doi: 10.1146/annurev.arplant.40.1.50
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+
+  SUBROUTINE isotope_c13(kjpindex, index_assi, leaf_ci, ccanopy, lai_per_level, &
+       assimtot, delta_c13_assim, leaf_ci_out, nvm, &
+       nlevels_tot, assimi_lev)
+    
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT (in)                            :: kjpindex          !! number of land pixels
+    INTEGER(i_std), INTENT (in)                            :: nvm               !! number of pfts
+    INTEGER(i_std), INTENT (in)                            :: nlevels_tot       !! number of lai layers in canopy
+    INTEGER(i_std), DIMENSION(:), INTENT (in)              :: index_assi        !! indices (unitless)   
+    REAL(r_std), DIMENSION (:,:,:), INTENT (in)            :: leaf_ci           !! intercellular CO2 concentration (ppm)
+    REAL(r_std),DIMENSION (:), INTENT (in)                 :: ccanopy           !! CO2 concentration inside the canopy (ppm)   
+    REAL(r_std), DIMENSION(:,:,:), INTENT (in)             :: lai_per_level     !! This is the LAI per vertical level
+                                                                                !! @tex $(m^{2} m^{-2})$ @endtex 
+    !+++CHECK+++
+    ! Looks like assimi is a local variable in trans_co2 and that
+    ! its values are overwritten for every new layer. If this is 
+    ! indeed the case, it should not be used outside trans_co2    
+!    REAL(r_std), DIMENSION(:,:), INTENT (in)               :: assimi            !! assimilation (at a specific LAI level)
+!                                                                                !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    !+++++++++++    
+    REAL(r_std), DIMENSION(:,:), INTENT (in)               :: assimtot          !! total assimilation
+                                                                                !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT (in)             :: assimi_lev        !! assimilation (at all LAI levels)
+                                                                                !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (:,:), INTENT (out)              :: delta_c13_assim   !! C13 concentration in delta notation 
+                                                                                !! @tex $ permille $ @endtex (per thousand)   
+    REAL(r_std),DIMENSION (:,:), INTENT (out)              :: leaf_ci_out       !! Ci @tex $ ??unit?? $ @endtex      
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables 
+    INTEGER(i_std)                                          :: inia,iainia      !! counter/indices (unitless)
+    INTEGER(i_std)                                          :: ji,jv,jl         !! Indices (-)    
+    
+
+!_ ================================================================================================================================    
+    
+    !! Initialize
+    delta_c13_assim(:,:) = zero
+    leaf_ci_out(:,:) = zero
+    !printlev_loc = get_printlev('c13')
+
+    !! Calculate delta_C13
+    DO ji=1,kjpindex
+
+       ! Skip the whole pixel of none of the PFTs did photosynthesis
+       IF (SUM(SUM(assimi_lev(ji,:,:),2),1) .LE. zero) THEN
+            ! There was no photsynthesis at this pixel, no reason to do the 
+            ! calculation
+          CYCLE
+       ENDIF
+
+       DO jv = 1,nvm
+
+          ! Skip the PFT is it didn't do photosynthesis
+          IF (SUM(assimi_lev(ji,jv,:)) .LE. zero) THEN
+             ! There was no photsynthesis at this pixel, no reason to do the 
+             ! calculation
+             CYCLE
+          ENDIF
+
+          ! There was photosynthesis at this PFT, calculate the C13 fractionation
+          DO jl = 1,nlevels_tot
+  
+             IF (lai_per_level(ji,jv,jl) .GT. zero) THEN
+
+                IF (printlev_loc>=4) THEN
+                   WRITE(numout,*) 'leaf_ci, ',leaf_ci(ji,jv,jl)
+                   WRITE(numout,*) 'assimi_lev, ',assimi_lev(ji,jv,jl)
+                   WRITE(numout,*) 'assimtot - isotope - before calc, ',assimtot(ji,jv)
+                   WRITE(numout,*) 'lai_per_level, ',lai_per_level(ji,jv,jl)
+	           WRITE(numout,*) 'day, ',day
+	           WRITE(numout,*) 'pft, ',jv
+                ENDIF
+
+
+                ! Simple version of Farquhar model
+                ! delta_c13_assim(:,jv) = (-8 - c13_a - (c13_b - c13_a) * cimean(:,jv) / ccanopy(:)) 
+                delta_c13_assim(ji,jv) = delta_c13_assim(ji,jv) + (- c13_a - (c13_b - c13_a)* &
+                     leaf_ci(ji,jv,jl)/ccanopy(ji)) * &
+                     assimi_lev(ji,jv,jl) * lai_per_level(ji,jv,jl)
+                leaf_ci_out(ji,jv) = leaf_ci_out(ji,jv) +  &
+                     leaf_ci(ji,jv,jl) * &
+                     assimi_lev(ji,jv,jl) * lai_per_level(ji,jv,jl)
+                
+             ENDIF
+             
+             ! Simple version of Farquhar model with photorespiratioin, gi and gamma*
+             ! This code copied from the work by Thomas Eglin and Thomas Launois where it
+             ! was already commented out. When moving it to ORCHIDEE-CAN is has not been 
+             ! tested with ORCHIDEE-CAN. It is not clear why it was commented out.
+             ! was commented out
+!!$             IF (assimi(ji,jv) .GT. 0) THEN 
+!!$                delta_c13_assim(ji,jv) = delta_c13_assim(ji,jv) + (&
+!!$                     - c13_ab * (ccanopy(ji)-leaf_cs(ji,jv,jl))/(ccanopy(ji)) &
+!!$                     - c13_a * (leaf_cs(ji,jv,jl)-leaf_ci(ji,jv,jl))/(ccanopy(ji)) &
+!!$                     - (C13_es + c13_al) * (leaf_ci(ji,jv,jl)-leaf_cc(ji,jv,jl))/(ccanopy(ji)) &
+!!$                     - (c13_b+2.0) * leaf_cc(ji,jv,jl)/(ccanopy(ji)) &
+!!$                     - (C13_e * (Rd(ji)/(Rd(ji) + assimi(ji,jv))) + C13_f * CP(ji))/(ccanopy(ji))&
+!!$                     ) * assimi(ji,jv) * (laitab(jl+1)-laitab(jl))
+!!$             ENDIF
+
+             
+!!$                  (Rd(ji) + assimi(ji,jv)), Rd(ji),assimi(ji,jv)
+             
+             ! This code copied from the work by Thomas Eglin and Thomas Launois where it
+             ! was already commented out. When moving it to ORCHIDEE-CAN is has not been 
+             ! tested with ORCHIDEE-CAN. It is not clear why it was commented out.
+             ! was commented out
+             ! Modification M; Bordigoni 07/2008 : New calculation of c3-plants fractionation
+             ! according to Lloyd and Farquhar_Oecologia_1994
+!!$             delta_c13_assim(ji,jv) =  delta_c13_assim(ji,jv) +(- (&
+!!$                  4.4*(1-(leaf_ci(ji,jv,jl) / ccanopy(ji) )+0.025)+ &
+!!$                  0.075*(1.1+0.7)+ &
+!!$                  27.5*(( leaf_ci(ji,jv,jl) / ccanopy(ji))-0.1)- &
+!!$                  (11*0.1+8*(1.54*1.05*((temp_air(ji)-273.16)+2.5)))/ ccanopy(ji)) )* &
+!!$                  assimi(ji,jv) * (laitab(jl+1)-laitab(jl))
+
+          ENDDO ! photosynthesis layers
+
+          IF (assimtot(ji,jv) .GT. threshold_c13_assim) THEN
+
+             delta_c13_assim(ji,jv) = delta_c13_assim(ji,jv)/assimtot(ji,jv)
+             leaf_ci_out(ji,jv) = leaf_ci_out(ji,jv)/assimtot(ji,jv)
+
+          ELSE
+
+             delta_c13_assim(ji,jv) = zero
+             leaf_ci_out(ji,jv) = zero
+
+          ENDIF
+
+       ENDDO ! # PFTs
+          
+    ENDDO ! #kjpindex
+
+  END SUBROUTINE isotope_c13
+
+END MODULE diffuco
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/enerbil.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/enerbil.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/enerbil.f90	(revision 6412)
@@ -0,0 +1,7420 @@
+!  ==============================================================================================================================
+!  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 either with the original enerbil scheme or by the multi-layer energy 
+!! scheme. The module contains the following subroutines: enerbil_initialize, enerbil_main,
+!! enerbil_clear, enerbil_begin, enerbil_surftemp, enerbil_flux, enerbil_evapveg,
+!! mleb_initialixe, mleb_main, mleb_begin,
+!! mleb_reallocate_column, mleb_profile, mleb_lwdrad, mleb_boundarylayer_restitance,
+!! mleb_stomatal_resistance, mleb_alpha_beta_coeff, mleb_calc_column,
+!! mleb_pottemp, mleb_flux, mleb_evapveg
+!!
+!!\n DESCRIPTION                                : 
+!! \n
+!! \latexonly 
+!!     \input{enerbil_intro2.tex}
+!! \endlatexonly
+!!
+!! IMPORTANT NOTE: The coefficients A and B are defined differently than those in the referenced 
+!! literature and from those in the code and documentation of the atmospheric model LMDZ. For the
+!! avoidance of doubt, the coefficients as described here always refer to the ORCHIDEE coefficients, 
+!! and are denoted as such (with the marker: ORC). The re-definition of the coefficients takes place 
+!! within LMDZ before they are passed to ORCHIDEE. The following sequence of expressions is to be 
+!! found within the LMDZ module 'surf_land_orchidee':\n
+!!
+!! \latexonly 
+!!     \input{surflandLMDZ1.tex}
+!!     \input{surflandLMDZ2.tex}
+!!     \input{surflandLMDZ3.tex}
+!!     \input{surflandLMDZ4.tex}
+!! \endlatexonly
+!! \n
+!!
+!! \latexonly 
+!!     \input{enerbil_symbols.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S)                             : None
+!!
+!! REFERENCE(S)	                                : None 
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE enerbil
+
+  ! routines called : restput, restget
+  !
+  ! modules used
+  USE ioipsl
+  USE xios_orchidee
+  USE ioipsl_para 
+  USE constantes
+  USE pft_parameters
+  USE qsat_moisture
+  USE sechiba_io_p
+  USE constantes_soil
+  USE explicitsnow
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: enerbil_main, enerbil_initialize, enerbil_finalize, & 
+            & enerbil_clear, enerbil_begin, mleb_main, enerbil_write, mleb_initialize
+
+  ! variables used inside enerbil module : declaration and initialisation
+ 
+!  INTEGER(i_std), SAVE                          :: printlev_loc  !! local printlev for this module
+!!$OMP THREADPRIVATE(printlev_loc)
+  ! one dimension array allocated, computed and used in enerbil module exclusively
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: psold         !! Old surface dry static energy (J kg^{-1})
+!$OMP THREADPRIVATE(psold)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsol_sat      !! Saturated specific humudity for old temperature (kg kg^{-1})
+!$OMP THREADPRIVATE(qsol_sat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pdqsold       !! Deriv. of saturated specific humidity at old temp
+                                                                 !! (kg (kg s)^{-1})
+!$OMP THREADPRIVATE(pdqsold)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: psnew         !! New surface static energy (J kg^{-1})
+!$OMP THREADPRIVATE(psnew)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsol_sat_new  !! New saturated surface air moisture (kg kg^{-1})
+!$OMP THREADPRIVATE(qsol_sat_new)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: netrad        !! Net radiation (W m^{-2})
+!$OMP THREADPRIVATE(netrad)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwabs         !! LW radiation absorbed by the surface (W m^{-2})
+!$OMP THREADPRIVATE(lwabs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwup          !! Long-wave up radiation (W m^{-2})
+!$OMP THREADPRIVATE(lwup)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwnet         !! Net Long-wave radiation (W m^{-2})
+!$OMP THREADPRIVATE(lwnet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: fluxsubli     !! Energy of sublimation (mm day^{-1})
+!$OMP THREADPRIVATE(fluxsubli)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsat_air      !! Air saturated specific humidity (kg kg^{-1})
+!$OMP THREADPRIVATE(qsat_air)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tair          !! Air temperature (K)
+!$OMP THREADPRIVATE(tair)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: q_sol_pot               !! Potential surface humidity
+!$OMP THREADPRIVATE(q_sol_pot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: temp_sol_pot            !! Potential surface temperature (unstressed)
+!$OMP THREADPRIVATE(temp_sol_pot)
+
+  !
+  ! Multi-layer energy budget variables that are used throughout the program / module
+  !
+
+  REAL(r_std),SAVE                                :: canopy_height = 50.0d0       !! canopy height (m)
+  REAL(r_std),SAVE                                :: rho_veg = 1000.0d0           !! density of vegetation
+  REAL(r_std),SAVE                                :: leaf_tks = 0.001d0           !! leaf thickness
+  REAL(r_std),SAVE                                :: rho_soil = 1.0d0
+  !
+  ! Various parameterisation  factors
+  !
+  REAL(r_std), SAVE                               :: r_sto_v_fac
+!$OMP THREADPRIVATE(r_sto_v_fac)
+  REAL(r_std), SAVE                               :: big_r_h2o_fac
+!$OMP THREADPRIVATE(big_r_h2o_fac)
+
+  REAL(r_std), SAVE                               :: big_k_lw       !! LW extinction coefficient
+!$OMP THREADPRIVATE(big_k_lw)
+  REAL(r_std), SAVE                               :: big_k_sw       !! SW extinction coefficient 
+!$OMP THREADPRIVATE(big_k_sw)
+
+  REAL(r_std), SAVE                               :: k_ext_fac
+!$OMP THREADPRIVATE(k_ext_fac)
+
+  REAL(r_std), SAVE                               :: k_eddy_slope   !! coefficients for S-shape fuction for K_eddy
+!$OMP THREADPRIVATE(k_eddy_slope)
+  REAL(r_std), SAVE                               :: k_eddy_ustar
+!$OMP THREADPRIVATE(k_eddy_ustar)
+
+  REAL(r_std), SAVE                               :: ks_tune        !! coefficients for S-shape fuction for KS (K_eddy only for surface)
+!$OMP THREADPRIVATE(ks_tune)
+  REAL(r_std), SAVE                               :: ks_slope
+!$OMP THREADPRIVATE(ks_slope)
+  REAL(r_std), SAVE                               :: ks_veget
+!$OMP THREADPRIVATE(ks_veget)
+
+  REAL(r_std), SAVE                               :: sr_fac         !! stomatal resistance factor 
+!$OMP THREADPRIVATE(sr_fac)
+  REAL(r_std), SAVE                               :: br_fac         !! boundary resistance factor
+!$OMP THREADPRIVATE(br_fac)
+
+  REAL(r_std), SAVE                               :: surf_lev
+!$OMP THREADPRIVATE(surf_lev)
+
+  LOGICAL, SAVE                                   :: WC02    !! logical paramter for applying (Wohlfahrt & Cernusca 2002) Dynamic drag 
+!$OMP THREADPRIVATE(WC02)
+  REAL(r_std), SAVE                               :: a_1     !! a1 to a5: parameters for the sub-canopy wind profile  
+  REAL(r_std), SAVE                               :: a_2     !! the default values were set as the 
+  REAL(r_std), SAVE                               :: a_3     !! a1= 0.065; a2=0.001; a3=0.434; a4= -0.751; a5=0.071 
+  REAL(r_std), SAVE                               :: a_4
+  REAL(r_std), SAVE                               :: a_5
+!$OMP THREADPRIVATE(a_1)
+!$OMP THREADPRIVATE(a_2)
+!$OMP THREADPRIVATE(a_3)
+!$OMP THREADPRIVATE(a_4)
+!$OMP THREADPRIVATE(a_5)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: jtheta                   !! specific heat capacity of air (J / (kg K) )
+!$OMP THREADPRIVATE(jtheta)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: pad_deltah               !! Plant Area Density as a function of height above the ground (m^2/m^3)
+!$OMP THREADPRIVATE(pad_delta)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: box_height               !! height of each box edge, starting at the surface layer (m)
+!$OMP THREADPRIVATE(box_height)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: box_height_old           !! divisionof canopy levels from the previous time step
+!$OMP THREADPRIVATE(box_height_old)
+
+  !
+  ! Settings for the speciffic multi-layer energy budget uotput file  
+  !
+  CHARACTER(LEN=256), SAVE                        :: mleb_cdfname             !!To store the name of the multilayer netCDF output file 
+                                                                              !! (seperate to the rest)
+  LOGICAL,SAVE                                    :: first_call_mleb_histwrite!! detemine when to open and write headers
+                                                                              !! in the mleb_netcdf file
+!$OMP THREADPRIVATE(first_call_mleb_hist_write)
+
+  
+  
+CONTAINS
+
+  ! --------------------------------------------------------------------------------------
+   
+  ! insert function for the multilayer LW radiation scheme at the start of module
+
+  REAL(r_std) FUNCTION gu (x_in)
+    
+  REAL(r_std) :: k_ext = 0.9 
+  REAL(r_std) :: x_in, k_ext_fac
+  
+      !+++ TEMP +++
+       k_ext_fac = 1.0 
+           k_ext=k_ext*k_ext_fac 
+      !++++++++++++
+      gu = exp(-k_ext*x_in)    
+  END FUNCTION ! gu(x_in)
+
+
+  ! --------------------------------------------------------------------------------------
+
+
+  
+!!  =============================================================================================================================
+!! SUBROUTINE:              enerbil_initialize
+!!
+!>\BRIEF		    Allocate module variables, read from restart file or initialize with default values
+!!
+!! DESCRIPTION:             The purpose of this module is, firstly, to allocate space
+!! in memory for key variables within the 'enerbil' module. The second task is to retrieve previous data
+!! from the restart file. If the variables are not in restart file, default initialization is done. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S): None
+!! 
+!! FLOWCHART: None
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_initialize (kjit,     kjpindex,     index,    rest_id,  &
+                                 qair,                                       &
+                                 temp_sol, temp_sol_new, tsol_rad,           &
+                                 evapot,   evapot_corr,  qsurf,    fluxsens, &
+                                 fluxlat,  vevapp )
+ 
+    !! 0 Variable and parameter description
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number (-)
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index            !! Indeces of the points on the map (-)
+    INTEGER(i_std),INTENT (in)                         :: rest_id          !! Restart file identifier (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: qair             !! Lowest level specific humidity (kg kg^{-1})
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: temp_sol         !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: temp_sol_new     !! New soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: tsol_rad         !! Tsol_rad (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: evapot           !! Soil Potential Evaporation (mm/tstep)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: evapot_corr      !! Soil Potential Evaporation Correction (mm/tstep)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: qsurf            !! Surface specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: fluxsens         !! Sensible heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: fluxlat          !! Latent heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vevapp           !! Total of evaporation (mm day^{-1})
+
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                     :: ier
+
+!_ ================================================================================================================================
+    
+    IF (printlev>=3) WRITE (numout,*) 'enerbil_initialize : Start initillization'
+
+    !! 1. Allocate module variables
+    ALLOCATE (psold(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable ','','')
+
+    ALLOCATE (qsol_sat(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable ','','')
+
+    ALLOCATE (pdqsold(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable ','','')
+
+    ALLOCATE (psnew(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable ','','')
+
+    ALLOCATE (qsol_sat_new(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable qsol_sat_new','','')
+
+    ALLOCATE (netrad(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable netrad','','')
+
+    ALLOCATE (lwabs(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable lwabs','','')
+
+    ALLOCATE (lwup(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable lwup','','')
+
+    ALLOCATE (lwnet(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable lwnet','','')
+
+    ALLOCATE (fluxsubli(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable fluxsubli','','')
+
+    ALLOCATE (qsat_air(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable qsat_air','','')
+
+    ALLOCATE (tair(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable tair','','')
+
+    ALLOCATE (q_sol_pot(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable q_sol_pot','','')
+
+    ALLOCATE (temp_sol_pot(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable temp_sol_pot','','')
+
+    !! 2. Initialize variables from restart file or by default values
+    !! The variables read are: temp_sol (surface temperature), qsurf (near surface specific humidity),
+    !! evapot (soil potential evaporation), evapot_corr (corrected soil potential evaporation), tsolrad
+    !! (radiative surface temperature), evapora (evaporation), fluxlat (latent heat flux), fluxsens
+    !! (sensible heat flux) and temp_sol_new (new surface temperature).
+    IF (printlev>=3) WRITE (numout,*) 'Read a restart file for ENERBIL variables'
+    
+    CALL ioconf_setatt_p('UNITS', 'K')
+    CALL ioconf_setatt_p('LONG_NAME','Surface temperature')
+    CALL restget_p (rest_id, 'temp_sol', nbp_glo, 1, 1, kjit, .TRUE., temp_sol, "gather", nbp_glo, index_g)
+    
+    !Config Key   = ENERBIL_TSURF
+    !Config Desc  = Initial temperature if not found in restart
+    !Config If    = OK_SECHIBA
+    !Config Def   = 280.
+    !Config Help  = The initial value of surface temperature if its value is not found
+    !Config         in the restart file. This should only be used if the model is 
+    !Config         started without a restart file.
+    !Config Units = Kelvin [K]
+    CALL setvar_p (temp_sol, val_exp,'ENERBIL_TSURF', 280._r_std)
+    
+    ! Initialize temp_sol_new with temp_sol. These variables are always equal in the beginning of a new time step.
+    temp_sol_new(:) = temp_sol(:)
+
+    CALL ioconf_setatt_p('UNITS', 'g/g')
+    CALL ioconf_setatt_p('LONG_NAME','near surface specific humidity')
+    CALL restget_p (rest_id, 'qsurf', nbp_glo, 1, 1, kjit, .TRUE., qsurf, "gather", nbp_glo, index_g)
+    IF ( ALL( qsurf(:) .EQ. val_exp ) ) THEN 
+       qsurf(:) = qair(:)
+    ENDIF
+    
+    CALL ioconf_setatt_p('UNITS', 'mm day^{-1}')
+    CALL ioconf_setatt_p('LONG_NAME','Soil Potential Evaporation')
+    CALL restget_p (rest_id, 'evapot', nbp_glo, 1, 1, kjit, .TRUE., evapot, "gather", nbp_glo, index_g)
+    CALL setvar_p (evapot, val_exp, 'ENERBIL_EVAPOT', zero)
+    
+    CALL ioconf_setatt_p('UNITS', 'mm day^{-1}')
+    CALL ioconf_setatt_p('LONG_NAME','Corrected Soil Potential Evaporation')
+    CALL restget_p (rest_id, 'evapot_corr', nbp_glo, 1, 1, kjit, .TRUE., evapot_corr, "gather", nbp_glo, index_g)
+    !Config Key   = ENERBIL_EVAPOT
+    !Config Desc  = Initial Soil Potential Evaporation
+    !Config If    = OK_SECHIBA       
+    !Config Def   = 0.0
+    !Config Help  = The initial value of soil potential evaporation if its value 
+    !Config         is not found in the restart file. This should only be used if
+    !Config         the model is started without a restart file. 
+    !Config Units = 
+    CALL setvar_p (evapot_corr, val_exp, 'ENERBIL_EVAPOT', zero)
+    
+    CALL ioconf_setatt_p('UNITS', 'K')
+    CALL ioconf_setatt_p('LONG_NAME','Radiative surface temperature')
+    CALL restget_p (rest_id, 'tsolrad', nbp_glo, 1, 1, kjit, .TRUE., tsol_rad, "gather", nbp_glo, index_g)
+    IF ( ALL( tsol_rad(:) .EQ. val_exp ) ) THEN 
+       tsol_rad(:) = temp_sol(:)
+    ENDIF
+    
+    !! 1.3 Set the fluxes so that we have something reasonable and not NaN on some machines
+    CALL ioconf_setatt_p('UNITS', 'Kg/m^2/dt')
+    CALL ioconf_setatt_p('LONG_NAME','Evaporation')
+    CALL restget_p (rest_id, 'evapora', nbp_glo, 1, 1, kjit, .TRUE., vevapp, "gather", nbp_glo, index_g)
+    IF ( ALL( vevapp(:) .EQ. val_exp ) ) THEN 
+       vevapp(:) = zero
+    ENDIF
+    
+    CALL ioconf_setatt_p('UNITS', 'W/m^2')
+    CALL ioconf_setatt_p('LONG_NAME','Latent heat flux')
+    CALL restget_p (rest_id, 'fluxlat', nbp_glo, 1, 1, kjit, .TRUE., fluxlat, "gather", nbp_glo, index_g)
+    IF ( ALL( fluxlat(:) .EQ. val_exp ) ) THEN 
+       fluxlat(:) = zero
+    ENDIF
+    
+    CALL ioconf_setatt_p('UNITS', 'W/m^2')
+    CALL ioconf_setatt_p('LONG_NAME','Sensible heat flux')
+    CALL restget_p (rest_id, 'fluxsens', nbp_glo, 1, 1, kjit, .TRUE., fluxsens, "gather", nbp_glo, index_g)
+    IF ( ALL( fluxsens(:) .EQ. val_exp ) ) THEN 
+       fluxsens(:) = zero
+    ENDIF
+    
+    CALL ioconf_setatt_p('UNITS', 'K')
+    CALL ioconf_setatt_p('LONG_NAME','Potential surface temperature')
+    CALL restget_p (rest_id, 'tempsolpot', nbp_glo, 1, 1, kjit, .TRUE., temp_sol_pot, "gather", nbp_glo, index_g)
+    IF ( ALL( temp_sol_pot(:) .EQ. val_exp ) ) THEN 
+       temp_sol_pot = temp_sol
+    ENDIF
+    
+    CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+    CALL ioconf_setatt_p('LONG_NAME','Potential saturated surface humidity')
+    CALL restget_p (rest_id, 'qsolpot', nbp_glo, 1, 1, kjit, .TRUE., q_sol_pot, "gather", nbp_glo, index_g)
+    IF ( ALL( q_sol_pot(:) .EQ. val_exp ) ) THEN 
+       q_sol_pot = qsurf
+    ENDIF
+    
+  END SUBROUTINE enerbil_initialize
+   
+
+
+  !!  ===========================================================================================================================
+  !! SUBROUTINE		 		    : enerbil_main
+  !!
+  !!
+  !>\BRIEF				    Calls each part of the energy budget calculation in sequence 
+  !!
+  !! DESCRIPTION			    : 
+  !! This is the main routine for the 'enerbil' module. It is called
+  !! once during the initialisation of ORCHIDEE, and then once for each time step. It is called a final
+  !! time at the culmination of the last time step, for the writing of a restart file.\n
+  !!
+  !! The algorithm first calls 'enerbil_begin' for initialisation, followed by 'enerbil_surftemp' to
+  !! calculate the surface static energy and the saturated surface humidity for the new time step.
+  !! Next is the module 'enerbil_flux' which calculates the new surface temperature, the net radiation in
+  !! the surface layer, the total evaporation and the latent and sensible heat fluxes. Finally comes
+  !! 'enerbil_evapveg', which calculates the evaporation and transpiration from the vegetation.\n
+
+  !! \n
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	: evapot, evapot_corr, temp_sol, qsurf, fluxsens, fluxlat, tsol_rad,
+  !! vevapp, temp_sol_new, vevapnu, vevapsno, transpir, vevapwet
+  !!
+  !! REFERENCE(S)		:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available (22/12/11):
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf 
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers\n
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART			:
+  !! \latexonly 
+  !!     \includegraphics[scale=0.5]{enerbil_main_flowchart.png}
+  !! \endlatexonly
+  !! \n
+  !_ ==============================================================================================================================
+   
+  SUBROUTINE enerbil_main (kjit, kjpindex, &
+       & index, indexveg, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef, &
+       & qair, peqAcoef, peqBcoef, pb, rau, vbeta, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, &
+       & emis, soilflx, soilcap, q_cdrag, humrel, fluxsens, fluxlat, &
+       & vevapp, transpir, transpot, vevapnu, vevapwet, vevapsno, vevapflo, temp_sol, tsol_rad, &
+       & temp_sol_new, qsurf, evapot, evapot_corr, rest_id, hist_id, hist2_id, &
+       & precip_rain,  pgflux, snowdz, temp_sol_add)
+ 
+
+    !! 0 Variable and parameter description
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                           :: kjit             !! Time step number (-)
+    INTEGER(i_std), INTENT(in)                           :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),INTENT (in)                           :: rest_id,hist_id  !! _Restart_ file and _history_ file identifier (-)
+    INTEGER(i_std),INTENT (in)                           :: hist2_id         !! _history_ file 2 identifier (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: index            !! Indeces of the points on the map (-)
+    INTEGER(i_std),DIMENSION(kjpindex*nvm), INTENT(in)   :: indexveg         !! Indeces of the points on the 3D map
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: zlev             !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: lwdown           !! Down-welling long-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: swnet            !! Net surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: epot_air         !! Air potential energy (?? J)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: temp_air         !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: u                !! Eastward Lowest level wind speed  (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: v                !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: petAcoef         !! PetAcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: petBcoef         !! PetBcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qair             !! Lowest level specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: peqAcoef         !! PeqAcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: peqBcoef         !! PeqBcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: pb               !! Lowest level pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: rau              !! Air density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: vbeta            !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: vbeta1           !! Snow resistance (-) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: vbeta4           !! Bare soil resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: vbeta5           !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: emis             !! Emissivity (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: soilflx          !! Effective ground heat flux including both snow and soil (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: soilcap          !! Soil calorific capacity including both snow and soil (J K^{-1])
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: q_cdrag          !! Surface drag coefficient (-)
+
+    REAL(r_std),DIMENSION (kjpindex, nvm), INTENT (in)   :: humrel           !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: vbeta2           !! Interception resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: vbeta3           !! Vegetation resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: vbeta3pot        !! Vegetation resistance for potential transpiration
+    REAL(r_std),DIMENSION (kjpindex),INTENT (in)         :: precip_rain      !! Rainfall
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in)    :: snowdz           !! Snow depth at each snow layer
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vevapnu          !! Bare soil evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vevapsno         !! Snow evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vevapflo         !! Floodplains evaporation
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: transpir         !! Transpiration (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: transpot         !! Potential transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: vevapwet         !! Interception (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: temp_sol_new     !! New soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: temp_sol_add     !! Additional energy to melt snow for snow ablation case (K)    
+
+    !! 0.3 Modified variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: evapot           !! Soil Potential Evaporation (mm/tstep)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: evapot_corr      !! Soil Potential Evaporation Correction (mm/tstep)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: temp_sol         !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: qsurf            !! Surface specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: fluxsens         !! Sensible heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: fluxlat          !! Latent heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: tsol_rad         !! Tsol_rad (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vevapp           !! Total of evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: pgflux           !! Net energy into snowpack(W/m^2)
+
+    !! 0.4 Local variables
+
+    REAL(r_std),DIMENSION (kjpindex)                     :: epot_air_new, qair_new
+    REAL(r_std),DIMENSION (kjpindex)                     :: diffevap         !! Difference betwence vevapp and composing fluxes (Kg/m^2/s)
+    INTEGER(i_std)                                       :: ji,ii,iv
+
+
+!_ ================================================================================================================================
+    
+    !! 1. Computes some initialisation variables
+ 
+    !  Computes some initialisation variables psold (the old surface static energy), qsol_sat
+    ! (the saturated surface humidity) and pdqsold (the derivative of the saturated surface humidity,
+    ! calculated with respect to the surface temperature at the 'old' timestep)
+    CALL enerbil_begin (kjpindex, temp_sol, lwdown, swnet, pb, psold, qsol_sat, pdqsold, netrad, emis)
+
+
+    !! 2. Computes psnew (the surface static energy at the 'new' timestep) 
+    
+    ! Computes psnew (the surface static energy at the 'new' timestep), qsol_sat_new (the surface
+    ! saturated humidity at the 'new' timestep), temp_sol_new (the surface temperature at the 'new'
+    ! timestep), qair_new (the lowest atmospheric humidity at the 'new' timestep) and epot_air_new
+    ! (the lowest atmospheric evaporation potential at the 'new' timestep)
+    CALL enerbil_surftemp (kjpindex, zlev, emis, &
+       & epot_air, petAcoef, petBcoef, qair, peqAcoef, peqBcoef, soilflx, &
+       & rau, u, v, q_cdrag, vbeta,&
+       & vbeta1, vbeta5, soilcap, lwdown, swnet, psnew, qsol_sat_new, &
+       & temp_sol_new, qair_new, epot_air_new)
+
+!!$   REMOVED as of trunk commit 4215:
+!!$    ! 3. computes surface temperature and humidity for a saturated surface
+!!$    !
+!!$    CALL enerbil_pottemp (kjpindex, zlev, emis, &
+!!$       & epot_air, petAcoef, petBcoef, qair, peqAcoef, peqBcoef, soilflx, &
+!!$       & rau, u, v, q_cdrag, vbeta,&
+!!$       & vbeta1, vbeta5, soilcap, lwdown, swnet, q_sol_pot, temp_sol_pot)
+
+
+    !! 4. Diagnoses components of the energy budget
+    
+    ! Diagnoses lwup (upwards long wave radiation), lwnet (net long wave radiation), tsol_rad (radiative
+    ! ground temperature), netrad (net radiation), qsurf (surface humidity), vevapp (total evaporation),
+    ! evapot (evaporation potential), evapot_corr (evaporation potential correction factor), 
+    ! fluxlat (latent heat flux), fluxsubli (sublimination heat flux) and fluxsens (sensible heat flux).
+
+    CALL enerbil_flux (kjpindex, emis, temp_sol, rau, u, v, &
+       & q_cdrag, vbeta, vbeta1, vbeta5, &
+       & qair_new, epot_air_new, psnew, qsurf, &
+       & fluxsens , fluxlat , fluxsubli, vevapp, temp_sol_new, lwdown, swnet, &
+       & lwup, lwnet, pb, tsol_rad, netrad, evapot, evapot_corr, &
+       & precip_rain,snowdz,temp_air,pgflux, soilcap, temp_sol_add)
+
+    !! 5. Diagnoses the values for evaporation and transpiration 
+    
+    ! Diagnoses the values for evaporation and transpiration: vevapsno (snow evaporation), vevapnu 
+    ! (bare soil evaporation), transpir (transpiration) and vevapwet (interception)
+    CALL enerbil_evapveg (kjpindex, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5,  &
+       & rau, u, v, q_cdrag, qair_new, humrel, vevapsno, vevapnu , vevapflo, vevapwet, &
+       & transpir, transpot, evapot)
+
+
+    
+    !! 6. Write diagnosics 
+
+    CALL xios_orchidee_send_field("netrad",netrad)
+    CALL xios_orchidee_send_field("evapot",evapot/dt_sechiba)
+    CALL xios_orchidee_send_field("evapot_corr",evapot_corr/dt_sechiba)
+    CALL xios_orchidee_send_field("lwdown",lwabs)
+    CALL xios_orchidee_send_field("lwnet",lwnet)
+    CALL xios_orchidee_send_field("Qv",fluxsubli)
+    CALL xios_orchidee_send_field("PotSurfT",temp_sol_pot)
+
+    DO ji=1,kjpindex 
+       diffevap(ji) = vevapp(ji) - ( SUM(vevapwet(ji,:)) + & 
+            SUM(transpir(ji,:)) + vevapnu(ji) + vevapsno(ji) + vevapflo(ji) )  
+    ENDDO
+    CALL xios_orchidee_send_field("diffevap",diffevap/dt_sechiba) ! mm/s     
+
+    IF ( .NOT. almaoutput ) THEN
+       CALL histwrite_p(hist_id, 'netrad', kjit, netrad, kjpindex, index)
+       CALL histwrite_p(hist_id, 'evapot', kjit, evapot, kjpindex, index)
+       CALL histwrite_p(hist_id, 'evapot_corr', kjit, evapot_corr, kjpindex, index)
+       CALL histwrite_p(hist_id, 'lwdown', kjit, lwabs,  kjpindex, index)
+       CALL histwrite_p(hist_id, 'lwnet',  kjit, lwnet,  kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'netrad', kjit, netrad, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'evapot', kjit, evapot, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'evapot_corr', kjit, evapot_corr, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'lwdown', kjit, lwabs,  kjpindex, index)
+          CALL histwrite_p(hist2_id, 'lwnet',  kjit, lwnet,  kjpindex, index)
+       ENDIF
+    ELSE
+       CALL histwrite_p(hist_id, 'LWnet', kjit, lwnet, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Qv', kjit, fluxsubli, kjpindex, index)
+       CALL histwrite_p(hist_id, 'PotEvap', kjit, evapot_corr, kjpindex, index)
+       CALL histwrite_p(hist_id, 'PotEvapOld', kjit, evapot, kjpindex, index)
+       CALL histwrite_p(hist_id, 'PotSurfT', kjit, temp_sol_pot, kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'LWnet', kjit, lwnet, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qv', kjit, fluxsubli, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'PotEvap', kjit, evapot_corr, kjpindex, index)
+       ENDIF
+    ENDIF
+
+    IF (printlev>=3) WRITE (numout,*) ' enerbil_main Done '
+
+  END SUBROUTINE enerbil_main
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:               enerbil_finalize
+!!
+!>\BRIEF                     Write to restart file
+!!
+!! DESCRIPTION:              This subroutine writes the module variables and variables calculated in enerbil
+!!                           to restart file
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S): None
+!! 
+!! FLOWCHART: None
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE enerbil_finalize (kjit,   kjpindex,    rest_id,            &
+                               evapot, evapot_corr, temp_sol, tsol_rad, &
+                               qsurf,  fluxsens,    fluxlat,  vevapp )
+ 
+    !! 0 Variable and parameter description
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                        :: kjit             !! Time step number (-)
+    INTEGER(i_std), INTENT(in)                        :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),INTENT (in)                        :: rest_id          !! Restart file identifier (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: evapot           !! Soil Potential Evaporation (mm/tstep)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: evapot_corr      !! Soil Potential Evaporation Correction (mm/tstep)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: temp_sol         !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: tsol_rad         !! Tsol_rad (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: qsurf            !! Surface specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: fluxsens         !! Sensible heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: fluxlat          !! Latent heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: vevapp           !! Total of evaporation (mm day^{-1})
+
+!_ ================================================================================================================================
+    
+    !! 1. Write variables to restart file to be used for the next simulation
+    IF (printlev>=3) WRITE (numout,*) 'Write restart file with ENERBIL variables'
+
+    CALL restput_p(rest_id, 'temp_sol', nbp_glo, 1, 1, kjit,  temp_sol, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'qsurf', nbp_glo, 1, 1, kjit,  qsurf, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'evapot', nbp_glo, 1, 1, kjit,  evapot, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'evapot_corr', nbp_glo, 1, 1, kjit,  evapot_corr, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'tsolrad', nbp_glo, 1, 1, kjit,  tsol_rad, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'evapora', nbp_glo, 1, 1, kjit,  vevapp, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'fluxlat', nbp_glo, 1, 1, kjit,  fluxlat, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'fluxsens', nbp_glo, 1, 1, kjit,  fluxsens, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'tempsolpot', nbp_glo, 1, 1, kjit, temp_sol_pot, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'qsolpot', nbp_glo, 1, 1, kjit, q_sol_pot, 'scatter',  nbp_glo, index_g)
+    
+  END SUBROUTINE enerbil_finalize
+
+
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : enerbil_clear
+  !!
+  !>\BRIEF				    Routine deallocates clear output variables if already allocated.
+  !!
+  !! DESCRIPTION			    : This is a 'housekeeping' routine that deallocates the key output
+  !! variables, if they have already been allocated. The variables that are deallocated are psold,
+  !! qsol_sat, pdqsold, psnew, qsol_sat_new, netrad, lwabs, lwup, lwnet, fluxsubli, qsat_air, tair
+  !!
+  !! RECENT CHANGE(S)			    : None
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	            : None
+  !!
+  !! REFERENCES				    : None
+  !! 
+  !! FLOWCHART                              : None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_clear ()
+    IF ( ALLOCATED (psold)) DEALLOCATE (psold)
+    IF ( ALLOCATED (qsol_sat)) DEALLOCATE (qsol_sat)
+    IF ( ALLOCATED (pdqsold)) DEALLOCATE (pdqsold)
+    IF ( ALLOCATED (psnew)) DEALLOCATE (psnew)
+    IF ( ALLOCATED (qsol_sat_new)) DEALLOCATE (qsol_sat_new)
+    IF ( ALLOCATED (netrad)) DEALLOCATE (netrad)
+    IF ( ALLOCATED (lwabs)) DEALLOCATE (lwabs)
+    IF ( ALLOCATED (lwup)) DEALLOCATE (lwup)
+    IF ( ALLOCATED (lwnet)) DEALLOCATE (lwnet)
+    IF ( ALLOCATED (fluxsubli)) DEALLOCATE (fluxsubli)
+    IF ( ALLOCATED (qsat_air)) DEALLOCATE (qsat_air)
+    IF ( ALLOCATED (tair)) DEALLOCATE (tair)
+    IF ( ALLOCATED (q_sol_pot)) DEALLOCATE (q_sol_pot)
+    IF ( ALLOCATED (temp_sol_pot)) DEALLOCATE (temp_sol_pot)
+   
+  END SUBROUTINE enerbil_clear
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_begin
+  !!
+  !>\BRIEF					Preliminary variables required for the calculation of
+  !! the energy budget are derived.
+  !!
+  !! DESCRIPTION				: This routines computes preliminary variables required
+  !! for the calculation of the energy budget: the old surface static energy (psold), the surface saturation
+  !! humidity (qsol_sat), the derivative of satured specific humidity at the old temperature (pdqsold) 
+  !! and the net radiation (netrad).
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	                : psold, qsol_sat, pdqsold, netrad
+  !!
+  !! REFERENCE(S)				:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers\n
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART  : None                     
+  !! \n
+  !_ ==============================================================================================================================
+  
+  SUBROUTINE enerbil_begin (kjpindex, temp_sol, lwdown, swnet, pb, psold, qsol_sat, pdqsold, netrad, emis)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_sol         !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: lwdown           !! Down-welling long-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: swnet            !! Net surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: pb               !! Lowest level pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: emis             !! Emissivity (-)
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: psold            !! Old surface dry static energy (J kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: qsol_sat	   !! Saturated specific humudity for old temperature 
+                                                                           !! (kg kg^{-1})    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: pdqsold	   !! Derivative of satured specific humidity at the old 
+                                                                           !! temperature (kg (kg s)^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: netrad           !! Net radiation (W m^{-2})
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ji
+    REAL(r_std), DIMENSION(kjpindex)                   :: dev_qsol
+    REAL(r_std), PARAMETER                             :: missing = 999998.
+
+!_ ================================================================================================================================
+  
+  !! 1. Computes psold (the surface static energy for the old timestep)
+   
+    !! We here define the surface static energy for the 'old' timestep, in terms of the surface
+    !! temperature and heat capacity.
+    !! \latexonly 
+    !!     \input{enerbilbegin1.tex}
+    !! \endlatexonly
+    psold(:) = temp_sol(:)*cp_air
+  !! 2. Computes qsol_sat (the surface saturated humidity).
+ 
+    !! We call the routine 'qsatcalc' from within the module 'src_parameters/constantes_veg'.
+    CALL qsatcalc (kjpindex, temp_sol, pb, qsol_sat)
+    IF ( diag_qsat ) THEN
+      IF ( ANY(ABS(qsol_sat(:)) .GT. missing) ) THEN
+        DO ji = 1, kjpindex
+          IF ( ABS(qsol_sat(ji)) .GT. missing) THEN
+            WRITE(numout,*) 'ERROR on ji = ', ji
+            WRITE(numout,*) 'temp_sol(ji),  pb(ji) :', temp_sol(ji),  pb(ji)
+            CALL ipslerr_p (3,'enerbil_begin', &
+ &           'qsol too high ','','')
+          ENDIF
+        ENDDO
+      ENDIF
+    ENDIF
+    
+  !! 3. Computes pdqsold 
+    
+    !! Computes pdqsold (the derivative of the saturated humidity with respect to temperature
+    !! analysed at the surface temperature at the 'old' timestep.
+    !! We call the routine 'dev_qsatcalc' from qsat_moisture module.
+    CALL dev_qsatcalc (kjpindex, temp_sol, pb, dev_qsol)
+    
+    !! \latexonly 
+    !!     \input{enerbilbegin2.tex}
+    !! \endlatexonly
+    pdqsold(:) = dev_qsol(:)
+    
+
+    IF ( diag_qsat ) THEN
+      IF ( ANY(ABS( pdqsold(:)) .GT. missing) ) THEN
+        DO ji = 1, kjpindex
+          IF ( ABS( pdqsold(ji)) .GT. missing ) THEN
+            WRITE(numout,*) 'ERROR on ji = ', ji
+            WRITE(numout,*) 'temp_sol(ji),  pb(ji) :', temp_sol(ji),  pb(ji)
+            CALL ipslerr_p (3,'enerbil_begin', &
+ &           'pdqsold too high ','','')
+          ENDIF
+        ENDDO
+      ENDIF
+    ENDIF
+
+  !! 4. Computes the net radiation and the absorbed LW radiation absorbed at the surface. 
+
+    !! Long wave radiation absorbed by the surface is the product of emissivity and downwelling LW radiation    
+    !! \latexonly 
+    !!     \input{enerbilbegin3.tex}
+    !! \endlatexonly
+    lwabs(:) = emis(:) * lwdown(:)
+
+    !! Net radiation is calculated as:
+    !! \latexonly 
+    !!     \input{enerbilbegin4.tex}
+    !! \endlatexonly
+    netrad(:) = lwdown(:) + swnet (:) - (emis(:) * c_stefan * temp_sol(:)**4 + (un - emis(:)) * lwdown(:)) 
+
+    IF (printlev>=3) WRITE (numout,*) ' enerbil_begin done '
+
+  END SUBROUTINE enerbil_begin
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_surftemp
+  !!
+  !>\BRIEF					This routine computes the new surface static energy
+  !! (psnew) and the saturated humidity at the surface (qsol_sat_new). 
+  !!
+  !! DESCRIPTION				: This is the key part of the enerbil module, for which
+  !! the energy budget in the surface layer is solved and changes over the model timestep 'dt_sechiba' are
+  !! quantified for the surface static energy, surface temperature, surface humidity, the 'air' (or lowest
+  !! level atmospheric model) temperature, the 'air' (or lowest level atmospheric model) humidity, 
+  !! according to the method that is laid out by Dufresne \& Ghattas (2009) and Shultz et al. (2001).
+  !!
+  !! It computes the energy balance at the surface with an implicit scheme, that is connected to the 
+  !! Richtmyer and Morton algorithm of the PBL. By computing the surface temperature and surface humidity 
+  !! the routine also implicitly estimates the various fluxes which balance in order to give the new 
+  !! temperature. Thus once the surface temperature has been obtained all the fluxes need to be diagnosed. 
+  !!
+  !! Since the explicit snow scheme is adapted, the notion of skin layer in ORCHIDEE is abandoned and
+  !! the first thin snow layer is adopted to solve the surface energy budget.
+  !! Implicit method is still used for coupling to the atmosphere.
+  !! In this new scheme, the snow temperature profile is simulatenously solved
+  !! along with the surface snow temperature, and the details are referenced to Boone et al. (2010)
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	: psnew, qsol_sat_new, temp_sol_new, qair_new, epot_air_new
+  !!
+  !! REFERENCE(S)					:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available (22/12/11):
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pd 
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART    : None
+  !!
+  !_ ==============================================================================================================================  
+  
+
+  SUBROUTINE enerbil_surftemp (kjpindex, zlev, emis, epot_air, &
+     & petAcoef, petBcoef, qair, peqAcoef, peqBcoef, soilflx, rau, u, v, q_cdrag, vbeta,&
+     & vbeta1, vbeta5, soilcap, lwdown, swnet, psnew, qsol_sat_new, temp_sol_new, &
+     & qair_new, epot_air_new)
+
+
+    !! 0. Variable and parameter declaration 
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex      !! Domain size (-)
+    REAL(r_std),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 coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta         !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta1        !! Snow resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta5        !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilcap       !! Soil calorific capacity (J K^{-1])
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown        !! Down-welling long-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet         !! Net surface short-wave flux (W m^{-2})
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: psnew         !! New surface static energy (J kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qsol_sat_new  !! New saturated surface air moisture (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: temp_sol_new  !! New soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qair_new      !! New air moisture (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: epot_air_new  !! New air temperature (K)
+
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                   :: ji
+    REAL(r_std),DIMENSION (kjpindex) :: zicp
+    REAL(r_std)                      :: fevap
+    REAL(r_std)                      :: sensfl_old, larsub_old, lareva_old, dtheta, sum_old, sum_sns
+    REAL(r_std)                      :: zikt, zikq, netrad_sns, sensfl_sns, larsub_sns, lareva_sns
+    REAL(r_std)                      :: speed
+
+!_ ================================================================================================================================
+ 
+    zicp = un / cp_air
+    
+    DO ji=1,kjpindex
+    !! 1. Derivation of auxiliary variables
+      
+      !! \latexonly 
+      !!     \input{enerbilsurftemp1.tex}
+      !! \endlatexonly
+      speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+      !
+      !! \latexonly 
+      !!     \input{enerbilsurftemp2.tex}
+      !! \endlatexonly
+      zikt = 1/(rau(ji) * speed * q_cdrag(ji))
+      zikq = 1/(rau(ji) * speed * q_cdrag(ji))
+      
+    !! 2. Computation of fluxes for the old surface conditions
+     
+      !! As a reference, we first calculate the sensible and latent heat for the 'old' timestep.
+ 
+      !! 2.1 Sensible heat for the 'old' timestep
+      !! This is equation (64) of (Dufresne & Ghattas, 2009), rewritten in terms of H_old. We make the 
+      !! approximation that (P_r/P)^{kappa}=1 and convert the A and B coefficients to the ORCHIDEE
+      !! format (see introductory note, above). Also, the equation here is in terms of surface static
+      !! energy, which is defined as per section 3.1, above.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp3.tex}
+      !! \endlatexonly
+      sensfl_old = (petBcoef(ji) -  psold(ji)) / (zikt -  petAcoef(ji))
+      !! 2.2 Latent heat for the 'old' timestep
+      !! This is equation (70) of (Dufresne & Ghattas, 2009), rewritten in terms of {\lambda E}_{old}.
+      !! Again we convert the A and B coefficients from the LMDZ format to the ORCHIDEE format.\n
+      !! There are two forms of the equation - first for the latent heat as a result of sublimination
+      !! processes and then as a result of evaporative processes:
+      !! \latexonly 
+      !!     \input{enerbilsurftemp4.tex}
+      !! \endlatexonly
+      larsub_old = chalsu0 * vbeta1(ji) * (un - vbeta5(ji)) * &
+           (peqBcoef(ji) -  qsol_sat(ji)) / (zikq - vbeta1(ji) * (un - vbeta5(ji))* peqAcoef(ji))
+      !! \latexonly 
+      !!     \input{enerbilsurftemp5.tex}
+      !! \endlatexonly
+      lareva_old = chalev0 * (un - vbeta1(ji)) * (un - vbeta5(ji)) * vbeta(ji) * &
+           (peqBcoef(ji) - qsol_sat(ji)) / &
+           (zikq - (un - vbeta1(ji)) * (un - vbeta5(ji)) * vbeta(ji) * peqAcoef(ji)) &
+           + chalev0 * vbeta5(ji) * (peqBcoef(ji) -  qsol_sat(ji)) / (zikq - vbeta5(ji) * peqAcoef(ji))
+      
+    !! 3. Calculation of sensitivity terms
+     
+      !! We here calculate the sensitivity for the different fluxes to changes in dtheta, which is the
+      !! change in the surface static energy over the model time step (dt_sechiba).
+      
+      !! 3.1 Net radiation sensitivity
+      !! This is an explicit-implicit representation of the Stefan-Boltzmann law - the explicit terms 
+      !! are ${ps}_{old}^3$, and it is completed when multiplied by dtheta (defined above).
+      !! \latexonly 
+      !!     \input{enerbilsurftemp6.tex}
+      !! \endlatexonly
+      netrad_sns = zicp(ji) * quatre * emis(ji) * c_stefan * ((zicp(ji) * psold(ji))**3)
+      
+      !! 3.2 Sensible heat flux sensitivity
+      !! This is the temperature sensitivity term N_1^h derived in equation (66) of (Dufresne & Ghattas, 2009),
+      !! where we again assume that (P_r/P)^{kappa}=1, convert the A and B coefficients to the ORCHIDEE format,
+      !! and rewrite in terms of surface static energy, rather than temperature (see section 3.1, above).
+      !! \latexonly 
+      !!     \input{enerbilsurftemp7.tex}
+      !! \endlatexonly
+      sensfl_sns = un / (zikt -  petAcoef(ji))
+      !! 3.3 Latent heat flux sensitivity 
+      !! This is the humidity sensitivity term N_1^q derived in equation (72) of (Dufresne & Ghattas, 2009), where
+      !! the A and B coefficients are written in the ORCHIDEE format.
+      !! larsub_sns is the latent heat sensitivity for sublimination. The coefficient vbeta1 is the evaporation
+      !! coefficient. It represents the relationship between the real and potential evaporation. It is derived
+      !! in the module 'src_sechiba/diffuco_snow'.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp8.tex}
+      !! \endlatexonly
+      larsub_sns = chalsu0 * vbeta1(ji) * (un - vbeta5(ji)) * zicp(ji) * &
+           pdqsold(ji) / (zikq - vbeta1(ji) * (un - vbeta5(ji)) * peqAcoef(ji))
+
+      !! lareva_sns is the latent heat sensitivity for evaporation. vbeta1 (src_sechiba/diffuco_snow) 
+      !! and vbeta (src_sechiba/diffuco_comb) are the evaporation coefficients.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp9.tex}
+      !! \endlatexonly
+      lareva_sns = chalev0 * ((un - vbeta1(ji))*(un - vbeta5(ji)) * vbeta(ji) + vbeta5(ji)) * &
+           & zicp(ji) * pdqsold(ji) / &
+           (zikq - ((un - vbeta1(ji))*(un - vbeta5(ji)) * vbeta(ji) + vbeta5(ji)) * peqAcoef(ji))
+
+    !! 4. Solution of the energy balance
+      
+      !! 4.1 We calculate the total flux for the 'old' timestep.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp10.tex}
+      !! \endlatexonly
+      sum_old = netrad(ji) + sensfl_old + larsub_old + lareva_old + soilflx(ji)
+
+      !! 4.2 We calculate the total sensitivity dtheta (the change in the
+      !! surface static energy over the timestep.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp11.tex}
+      !! \endlatexonly
+      sum_sns = netrad_sns + sensfl_sns + larsub_sns + lareva_sns
+      !! 4.3 Calculation of dtheta (change in surface static energy over the
+      !! timestep.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp12.tex}
+      !! \endlatexonly
+
+      dtheta = dt_sechiba * sum_old / (zicp(ji) * soilcap(ji) + dt_sechiba * sum_sns)
+
+      !! 4.4 Determination of state variables for the 'new' timestep
+      !! No we have dtheta, we can determine the surface static energy that
+      !! corresponds to the 'new' timestep.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp13.tex}
+      !! \endlatexonly
+      psnew(ji) =  psold(ji) + dtheta
+      
+      !! The new surface saturated humidity can be calculated by equation (69)
+      !! of (Dufresne & Ghattas, 2009), in which we substitute dtheta for the
+      !! change between old and new temperature using the relationship from 3.1,
+      !! above.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp14.tex}
+      !! \endlatexonly
+      qsol_sat_new(ji) = qsol_sat(ji) + zicp(ji) * pdqsold(ji) * dtheta
+      !! The new surface temperature is determined from the new surface static temperature,
+      !! again by using the relationship in section 3.1.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp15.tex}
+      !! \endlatexonly
+      temp_sol_new(ji) = psnew(ji) / cp_air
+      
+      !! 4.5 Calculation of new evaporation potential and new evaporation latent heat
+      !! flux (???)
+      !! \latexonly 
+      !!     \input{enerbilsurftemp16.tex}
+      !! \endlatexonly
+      epot_air_new(ji) = zikt * (sensfl_old - sensfl_sns * dtheta) + psnew(ji)
+      
+      !! \latexonly 
+      !!     \input{enerbilsurftemp17.tex}
+      !! \endlatexonly
+      fevap = (lareva_old - lareva_sns * dtheta) + (larsub_old - larsub_sns * dtheta)
+
+      IF ( ABS(fevap) < EPSILON(un) ) THEN
+        
+        !! \latexonly 
+        !!     \input{enerbilsurftemp18.tex}
+        !! \endlatexonly
+        qair_new(ji) = qair(ji)
+      ELSE
+        !! \latexonly 
+        !!     \input{enerbilsurftemp19.tex}
+        !! \endlatexonly     
+        qair_new(ji) = zikq * un / ( chalsu0 *  vbeta1(ji) * (un - vbeta5(ji)) + &
+           & chalev0 * ((un - vbeta1(ji))*(un - vbeta5(ji)) * vbeta(ji) + vbeta5(ji)) ) &
+           & * fevap + qsol_sat_new(ji)
+      ENDIF
+
+    ENDDO
+
+    IF (printlev>=3) WRITE (numout,*) ' enerbil_surftemp done '
+
+  END SUBROUTINE enerbil_surftemp
+
+
+ !! =============================================================================================================================
+ !! SUBROUTINE		 			: enerbil_pottemp
+ !!
+ !>\BRIEF		This subroutine computes the surface temperature and humidity should the surface been unstressed	
+ !!
+ !! DESCRIPTION				: 
+ !!
+ !! MAIN OUTPUT VARIABLE(S)	: 
+ !!
+ !! REFERENCE(S)		:
+ !!
+ !! FLOWCHART    : None
+ !!
+ !_ ==============================================================================================================================  
+
+  SUBROUTINE enerbil_pottemp (kjpindex, zlev, emis, epot_air, &
+     & petAcoef, petBcoef, qair, peqAcoef, peqBcoef, soilflx, rau, u, v, q_cdrag, vbeta,&
+     & vbeta1, vbeta5, soilcap, lwdown, swnet, q_sol_pot, temp_sol_pot) 
+
+    ! interface 
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex      !! Domain size
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: zlev          !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: emis          !! Emissivity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air      !! Air potential energy
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petAcoef      !! PetAcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petBcoef      !! PetBcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair          !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqAcoef      !! PeqAcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqBcoef      !! PeqBcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilflx       !! Soil flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau           !! Density
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u, v          !! Wind
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag       !! Surface drag coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta         !! Resistance coefficient
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta1        !! Snow resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta5        !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilcap       !! Soil calorific capacity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown        !! Down-welling long-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet         !! Net surface short-wave flux
+    ! output fields
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: q_sol_pot     !! Potential surface air moisture
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: temp_sol_pot  !! Potential soil temperature
+
+
+    ! local declaration
+    INTEGER(i_std)                  :: ji
+    REAL(r_std),DIMENSION (kjpindex) :: zicp
+    REAL(r_std)                      :: fevap
+    REAL(r_std)                      :: sensfl_old, larsub_old, lareva_old, dtheta, sum_old, sum_sns
+    REAL(r_std)                      :: zikt, zikq, netrad_sns, sensfl_sns, larsub_sns, lareva_sns
+    REAL(r_std)                      :: speed
+
+!_ ==============================================================================================================================
+
+    zicp = un / cp_air
+    !
+    DO ji=1,kjpindex
+
+       dtheta = zero
+       fevap = zero
+
+       temp_sol_pot(ji) = temp_sol_pot(ji) + dtheta
+
+       q_sol_pot(ji) = q_sol_pot(ji) + fevap
+
+    ENDDO
+
+  END SUBROUTINE enerbil_pottemp
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_flux
+  !!
+  !>\BRIEF					Computes the new soil temperature, net radiation and
+  !! latent and sensible heat flux for the new time step.
+  !!
+  !! DESCRIPTION				: This routine diagnoses, based on the new soil temperature, 
+  !! the net radiation, the total evaporation, the latent heat flux, the sensible heat flux and the 
+  !! sublimination flux. It also diagnoses the potential evaporation used for the fluxes (evapot) and the potential
+  !! as defined by Penman & Monteith (Monteith, 1965) based on the correction term developed by Chris 
+  !! Milly (1992). This Penman-Monteith formulation is required for the estimation of bare soil evaporation 
+  !! when the 11 layer CWRR moisture scheme is used for the soil hydrology.
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	: qsurf, fluxsens, fluxlat, fluxsubli, vevapp, lwup, lwnet,
+  !! tsol_rad, netrad, evapot, evapot_corr
+  !!
+  !! REFERENCE(S)					:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available (22/12/11):
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+  !! - Monteith, JL, 1965. Evaporation and Environment, paper presented at Symposium of the Society
+  !! for Experimental Biology
+  !! - Monteith & Unsworth, 2008. Principles of Environmental Physics (third edition), published Elsevier
+  !! ISBN 978-0-12-505103-3
+  !! - Milly, P. C. D., 1992: Potential Evaporation and Soil Moisture in General Circulation Models. 
+  !! Journal of Climate, 5, pp. 209â226.
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART					: None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_flux (kjpindex, emis, temp_sol, rau, u, v, q_cdrag, vbeta, vbeta1, vbeta5, &
+       & qair, epot_air, psnew, qsurf, fluxsens, fluxlat, fluxsubli, vevapp, temp_sol_new, &
+       & lwdown, swnet, lwup, lwnet, pb, tsol_rad, netrad, evapot, evapot_corr,&
+       & precip_rain,snowdz,temp_air,pgflux, soilcap, temp_sol_add)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex      !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: emis          !! Emissivity (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_sol      !! Surface temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau           !! Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u,v           !! Wind velocity in components u and v (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag       !! Surface drag coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta         !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta1        !! Snow resistance  (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta5        !! Flood resistance 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair          !! Lowest level specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air      !! Air potential energy (J)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: psnew         !! New surface static energy (J kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_sol_new  !! New soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb            !! Lowest level pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(in)       :: snowdz        !! Snow depth
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_rain   !! Rainfall
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_air      !! Air temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown        !! Downward long wave radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet         !! Net short wave radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilcap       !! Soil calorific capacity including snow and soil (J K^{-1})       
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qsurf         !! Surface specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxsens      !! Sensible heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxlat       !! Latent heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxsubli     !! Energy of sublimation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: vevapp        !! Total of evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: lwup          !! Long-wave up radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: lwnet         !! Long-wave net radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: tsol_rad      !! Radiative surface temperature (W m^{-2})
+    REAL(r_std), DIMENSION (kjpindex),INTENT(out)            :: temp_sol_add  !! Additional energy to melt snow for snow ablation case (K)
+
+    
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: netrad        !! Net radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: evapot        !! Soil Potential Evaporation (mm/tstep)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: evapot_corr   !! Soil Potential Evaporation Correction (mm/tstep)
+    REAL(r_std), DIMENSION (kjpindex),INTENT(inout)          :: pgflux        !! Net energy into snowpack(W/m^2)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                               :: ji
+    REAL(r_std),DIMENSION (kjpindex)        		         :: grad_qsat
+    REAL(r_std)                               		         :: correction
+    REAL(r_std)                                			 :: speed              !! Speed (m s^{-1}), 
+    REAL(r_std)                                			 :: qc                 !! Surface drag coefficient (??)
+    LOGICAL,DIMENSION (kjpindex)            		         :: warning_correction
+    REAL(r_std), DIMENSION (kjpindex)                            :: zgflux
+    REAL(r_std), DIMENSION (kjpindex)                            :: qsol_sat_tmp
+    REAL(r_std), DIMENSION (kjpindex)                            :: zerocelcius
+    REAL(r_std), DIMENSION (kjpindex)                            :: PHPSNOW
+    REAL(r_std), DIMENSION (kjpindex)                            :: lwup_tmp
+    REAL(r_std), DIMENSION (kjpindex)                            :: netrad_tmp
+    REAL(r_std), DIMENSION (kjpindex)                            :: fluxsens_tmp
+    REAL(r_std), DIMENSION (kjpindex)                            :: fluxlat_tmp
+
+!_ ================================================================================================================================
+    
+    zerocelcius(:) = tp_00
+    CALL qsatcalc (kjpindex, zerocelcius, pb, qsol_sat_tmp)
+
+    DO ji=1,kjpindex
+       !! 1. Determination of 'housekeeping' variables
+      
+      !! The horizontal wind speed is calculated from the velocities along each axis using Pythagorus' theorem. 
+      !! \latexonly 
+      !!     \input{enerbilflux1.tex}
+      !! \endlatexonly
+      speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+      
+      !! From definition, the surface drag coefficient is defined:
+      !! \latexonly 
+      !!     \input{enerbilflux2.tex}
+      !! \endlatexonly
+      qc = speed * q_cdrag(ji)
+    
+    !! 2. Calculation of the net upward flux of longwave radiation
+      
+      !! We first of all calculate the radiation as a result of the Stefan-Boltzmann equation,
+      !! which is the sum of the calculated values at the surface temperature  at the 'old' 
+      !! temperature and the value that corresponds to the difference between the old temperature
+      !! and the temperature at the 'new' timestep.
+      !! \latexonly 
+      !!     \input{enerbilflux3.tex}
+      !! \endlatexonly
+      lwup(ji) = emis(ji) * c_stefan * temp_sol(ji)**4 + &
+           &     quatre * emis(ji) * c_stefan * temp_sol(ji)**3 * &
+           &     (temp_sol_new(ji) - temp_sol(ji))      
+      
+      !! We then add to this value that from the reflected longwave radiation:
+      !! \latexonly 
+      !!     \input{enerbilflux4.tex}
+      !! \endlatexonly
+      lwup(ji) = lwup(ji)  +  (un - emis(ji)) * lwdown(ji)
+      
+      !! The radiative surface temperature is calculated by inverting the Stefan-Boltzmann relation:
+      !! \latexonly 
+      !!     \input{enerbilflux5.tex}
+      !! \endlatexonly
+      !! The implicit solution computes an emitted long-wave flux which is a limited Taylor expansion
+      !! of the future surface temperature around the current values. Thus the long-wave flux does not 
+      !! correspond to the new surface temperature but some intermediate value. So we need to deduce the
+      !! radiative surface temperature to which this flux corresponds.
+      !!
+      tsol_rad(ji) = (lwup(ji)/ (emis(ji) * c_stefan)) **(1./quatre)
+     
+      !! qsurf (the surface specific humidity) is a simple diagnostic which will be used by the 
+      !! GCM to compute the dependence of of the surface layer stability on moisture.
+      !! \latexonly 
+      !!     \input{enerbilflux6.tex}
+      !! \endlatexonly
+      qsurf(ji) = (vbeta1(ji) * (un - vbeta5(ji)) + vbeta5(ji)) * qsol_sat_new(ji) + &
+           & (un - vbeta1(ji))*(un - vbeta5(ji)) * vbeta(ji) * qsol_sat_new(ji)
+      
+      !! \latexonly 
+      !!     \input{enerbilflux7.tex}
+      !! \endlatexonly
+      qsurf(ji) = MAX(qsurf(ji), qair(ji))
+      
+      !! Net downward radiation is the sum of the down-welling less the up-welling long wave flux, plus
+      !! the short wave radiation.
+      !! \latexonly 
+      !!     \emissivity absorbed lw radiationinput{enerbilflux8.tex}
+      !! \endlatexonly
+      netrad(ji) = lwdown(ji) + swnet(ji) - lwup(ji) 
+      
+      !! 'vevapp' is the sum of the total evaporative processes (snow plus non-snow processes).
+      !! \latexonly 
+      !!     \input{enerbilflux9.tex}
+      !! \endlatexonly
+      vevapp(ji) = dt_sechiba * rau(ji) * qc * (vbeta1(ji) * (un - vbeta5(ji)) + vbeta5(ji)) * &
+           & (qsol_sat_new(ji) - qair(ji)) + &
+           &  dt_sechiba * rau(ji) * qc * (un - vbeta1(ji))*(un-vbeta5(ji)) * vbeta(ji) * &
+           & (qsol_sat_new(ji) - qair(ji))
+      
+      !! The total latent heat flux is the sum of the snow plus non-snow processes.
+      !! \latexonly 
+      !!     \input{enerbilflux10.tex}
+      !! \endlatexonly
+      fluxlat(ji) = chalsu0 * rau(ji) * qc * vbeta1(ji) * (un - vbeta5(ji)) * &
+           & (qsol_sat_new(ji) - qair(ji)) + &
+           &  chalev0 * rau(ji) * qc * vbeta5(ji) *&
+           & (qsol_sat_new(ji) - qair(ji)) + &
+           &  chalev0 * rau(ji) * qc * (un - vbeta1(ji)) * (un - vbeta5(ji)) * vbeta(ji) * &
+           & (qsol_sat_new(ji) - qair(ji))
+      
+      !! The sublimination flux concerns is calculated using vbeta1, the snow resistance.
+      !! \latexonly 
+      !!     \input{enerbilflux11.tex}
+      !! \endlatexonly
+      fluxsubli(ji) = chalsu0 * rau(ji) * qc * vbeta1(ji) * (un - vbeta5(ji)) * &
+           & (qsol_sat_new(ji) - qair(ji)) 
+      
+      !! The sensible heat flux is a factor of the difference between the new surface static energy
+      !! and the potential energy of air.
+      !! \latexonly 
+      !!     \input{enerbilflux12.tex}
+      !! \endlatexonly
+      fluxsens(ji) =  rau(ji) * qc * (psnew(ji) - epot_air(ji))
+      
+      !! This is the net longwave downwards radiation.
+      !! \latexonly 
+      !!     \input{enerbilflux13.tex}
+      !! \endlatexonly
+      lwnet(ji) = lwdown(ji) - lwup(ji)
+      
+      !! Diagnoses the potential evaporation used for the fluxes (evapot)
+      !! \latexonly 
+      !!     \input{enerbilflux14.tex}
+      !! \endlatexonly  
+      evapot(ji) =  MAX(zero, dt_sechiba * rau(ji) * qc * (qsol_sat_new(ji) - qair(ji)))
+     
+      !! From definition we can say:
+      !! \latexonly 
+      !!     \input{enerbilflux15.tex}
+      !! \endlatexonly 
+      tair(ji)  =  epot_air(ji) / cp_air
+
+
+      !! To calculate net energy flux into the snowpack
+      PHPSNOW(ji) = precip_rain(ji)*(4.218E+3)*(MAX(tp_00,temp_air(ji))-tp_00)/dt_sechiba ! (w/m2)
+      pgflux(ji)  = netrad(ji) - fluxsens(ji) - fluxlat(ji) + PHPSNOW(ji)
+      
+
+      !! To get the extra energy used to melt the snowpack
+      IF (temp_sol_new (ji) > tp_00 .AND. &
+           SUM(snowdz(ji,:)) .GT. zero .AND. soilcap(ji) .GT. zero) THEN
+
+         lwup_tmp(ji) = emis(ji) * c_stefan * temp_sol(ji)**4 + &
+              quatre * emis(ji) * c_stefan * temp_sol(ji)**3 * (tp_00 - temp_sol(ji))
+              
+         lwup_tmp(ji) = lwup_tmp(ji)  +  (un - emis(ji)) * lwdown(ji)
+         netrad_tmp(ji) = lwdown(ji) + swnet(ji) - lwup_tmp(ji)
+         fluxsens_tmp(ji) =  rau(ji) * qc * cp_air * (tp_00 - epot_air(ji)/cp_air)
+         fluxlat_tmp(ji) = chalsu0 * rau(ji) * qc * vbeta1(ji) * (un-vbeta5(ji)) * &
+                        & (qsol_sat_tmp(ji) - qair(ji)) + &
+                        &  chalev0 * rau(ji) * qc * vbeta5(ji) *&
+                        & (qsol_sat_tmp(ji) - qair(ji)) + &
+                        &  chalev0 * rau(ji) * qc * (un - vbeta1(ji)) * (un-vbeta5(ji))* vbeta(ji) * &
+                        & (qsol_sat_tmp(ji) - qair(ji))
+
+         zgflux(ji)  = netrad_tmp(ji) - fluxsens_tmp(ji) - fluxlat_tmp(ji)+PHPSNOW(ji)
+
+         temp_sol_add(ji) = -(pgflux(ji) - zgflux(ji))*dt_sechiba/soilcap(ji)
+
+         pgflux(ji) = zgflux(ji)
+
+      ELSE
+
+         temp_sol_add(ji) = zero
+
+      ENDIF
+
+     ENDDO 
+
+  !! 3. Define qsat_air with the subroutine src_parameter:
+
+    CALL qsatcalc(kjpindex, tair, pb, qsat_air)
+
+    CALL dev_qsatcalc(kjpindex, tair, pb, grad_qsat)
+ 
+  ! grad_qsat(:)= (qsol_sat_new(:)- qsat_air(:)) / ((psnew(:) - epot_air(:)) / cp_air) ! * dt_sechiba
+
+    warning_correction(:)=.FALSE.
+    DO ji=1,kjpindex
+      
+      !! \latexonly 
+      !!     \input{enerbilflux16.tex}
+      !! \endlatexonly 
+      speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+      
+      !! \latexonly 
+      !!     \input{enerbilflux17.tex}
+      !! \endlatexonly 
+      qc = speed * q_cdrag(ji)
+       
+      !! Derive the potential as defined by Penman & Monteith (Monteith, 1965) based on the correction 
+      !! term developed by Chris Milly (1992).
+       IF ((evapot(ji) .GT. zero) .AND. ((psnew(ji) - epot_air(ji)) .NE. zero )) THEN
+          !
+          !! \latexonly 
+          !!     \input{enerbilflux18.tex}
+          !! \endlatexonly 
+          correction =  (quatre * emis(ji) * c_stefan * tair(ji)**3 + rau(ji) * qc * cp_air + &
+               &                  chalev0 * rau(ji) * qc * grad_qsat(ji) * vevapp(ji) / evapot(ji) )
+          
+          !! \latexonly 
+          !!     \input{enerbilflux19.tex}
+          !! \endlatexonly 
+          IF (ABS(correction) .GT. min_sechiba) THEN
+             correction = chalev0 * rau(ji) * qc * grad_qsat(ji) * (un - vevapp(ji)/evapot(ji)) / correction
+          ELSE
+             warning_correction(ji)=.TRUE.
+          ENDIF
+       ELSE
+          correction = zero
+       ENDIF
+       correction = MAX (zero, correction)
+      
+      !! \latexonly 
+      !!     \input{enerbilflux20.tex}
+      !! \endlatexonly 
+       evapot_corr(ji) = evapot(ji) / (un + correction)
+       
+    ENDDO
+    IF ( ANY(warning_correction) ) THEN
+       DO ji=1,kjpindex
+          IF ( warning_correction(ji) ) THEN
+             WRITE(numout,*) ji,"Denominateur de la correction de milly nul! Aucune correction appliquee"
+          ENDIF
+       ENDDO
+    ENDIF
+    IF (printlev>=3) WRITE (numout,*) ' enerbil_flux done '
+
+  END SUBROUTINE enerbil_flux
+
+
+  !!  ===========================================================================================================================
+  !! SUBROUTINE		 			: enerbil_evapveg
+  !!
+  !>\BRIEF					Splits total evaporation loss into individual process
+  !! components and calculates the assimilation.
+  !!
+  !! DESCRIPTION				: Based on the estimation of the fluxes in enerbil_flux, 
+  !! this routine splits the total evaporation into transpiration interception loss from vegetation, 
+  !! bare soil evaporation and snow sublimation. It then calculates the assimilation.
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	                : vevapsno, vevapnu, transpir, vevapwet
+  !!
+  !! REFERENCE(S)					:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available (22/12/11): 
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663. 
+  !!
+  !! FLOWCHART   : None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_evapveg (kjpindex, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, &
+     & rau, u, v, q_cdrag, qair, humrel, vevapsno, vevapnu , vevapflo, vevapwet, &
+     & transpir, transpot, evapot)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjpindex          !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: vbeta1            !! Snow resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: vbeta4            !! Bare soil resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: vbeta5            !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: rau               !! Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: u, v              !! Wind velocity in directions u and v (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: q_cdrag           !! Surface drag coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: qair              !! Lowest level specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: evapot            !! Soil Potential Evaporation (mm/tstep)
+    REAL(r_std),DIMENSION (kjpindex, nvm), INTENT (in)  :: humrel            !! Soil moisture stress (within range 0 to 1)
+!!$ DS 15022011 humrel was used in a previous version of Orchidee, developped by Nathalie. Need to be discussed if it should be introduce again             
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: vbeta2            !! Interception resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: vbeta3            !! Vegetation resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: vbeta3pot         !! Vegetation resistance for potential transpiration
+   
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: vevapsno          !! Snow evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: vevapnu           !! Bare soil evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: vevapflo          !! Floodplains evaporation
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: transpir          !! Transpiration (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: transpot          !! Potential Transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: vevapwet          !! Interception (mm day^{-1})
+
+    !! 0.3 Modified variables
+ 
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jv
+    REAL(r_std), DIMENSION(kjpindex)                    :: xx
+    REAL(r_std), DIMENSION(kjpindex)                    :: vbeta2sum, vbeta3sum
+    REAL(r_std)                                         :: speed             !! speed (m s^{-1})
+
+!_ ==============================================================================================================================
+    ! initialisation: utile pour calculer l'evaporation des floodplains dans lesquelles il y a de la vegetation
+    vbeta2sum(:) = 0.
+    vbeta3sum(:) = 0.
+    DO jv = 1, nvm
+      vbeta2sum(:) = vbeta2sum(:) + vbeta2(:,jv)
+      vbeta3sum(:) = vbeta3sum(:) + vbeta3(:,jv)
+    ENDDO 
+    
+    !! 1. Compute vevapsno (evaporation from snow) and vevapnu (bare soil evaporation)
+        
+    DO ji=1,kjpindex 
+
+      !! \latexonly 
+      !!     \input{enerbilevapveg1.tex}
+      !! \endlatexonly
+      speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+
+      
+      !! 1.1 Snow sublimation
+      !! \latexonly 
+      !!     \input{enerbilevapveg2.tex}
+      !! \endlatexonly
+      vevapsno(ji) = (un - vbeta5(ji)) * vbeta1(ji) * dt_sechiba * &
+          rau(ji) * speed * q_cdrag(ji) * (qsol_sat_new(ji) - qair(ji))
+
+
+      !! 1.2 Bare soil evaporation
+      !! \latexonly 
+      !!     \input{enerbilevapveg3.tex}
+      !! \endlatexonly
+      vevapnu(ji) = (un - vbeta1(ji)) * (un-vbeta5(ji)) * vbeta4(ji) * dt_sechiba * rau(ji) * speed * q_cdrag(ji) &
+         & * (qsol_sat_new(ji) - qair(ji))
+      !
+      ! 1.3 floodplains evaporation - transpiration et interception prioritaires dans les floodplains
+      !
+      vevapflo(ji) = vbeta5(ji) &
+           & * dt_sechiba * rau(ji) * speed * q_cdrag(ji) * (qsol_sat_new(ji) - qair(ji))
+
+    END DO
+
+    !! 2. Compute transpir (transpiration) and vevapwet (interception)
+  
+    !! Preliminaries
+    DO ji = 1, kjpindex
+       
+       !! \latexonly 
+       !!     \input{enerbilevapveg4.tex}
+       !! \endlatexonly
+       speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+       
+       !! \latexonly 
+       !!     \input{enerbilevapveg5.tex}
+       !! \endlatexonly
+       xx(ji) = dt_sechiba * (un-vbeta1(ji)) * (un-vbeta5(ji)) * (qsol_sat_new(ji)-qair(ji)) * rau(ji) * speed * q_cdrag(ji)
+     
+    ENDDO
+    
+    DO jv=1,nvm 
+      DO ji=1,kjpindex 
+        
+        !! 2.1 Calculate interception loss
+        !! \latexonly 
+        !!     \input{enerbilevapveg6.tex}
+        !! \endlatexonly
+        vevapwet(ji,jv) = xx(ji) * vbeta2(ji,jv)
+        ! 
+        !! 2.2 Calculate transpiration
+        !! \latexonly 
+        !!     \input{enerbilevapveg7.tex}
+        !! \endlatexonly
+        transpir (ji,jv) = xx(ji) * vbeta3(ji,jv)
+
+        transpot(ji,jv) = xx(ji) * vbeta3pot(ji,jv)
+
+      END DO
+    END DO
+
+    
+
+    IF (printlev>=3) WRITE (numout,*) ' enerbil_evapveg done '
+
+  END SUBROUTINE enerbil_evapveg
+
+ 
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: mleb_initialize
+  !!
+  !> BRIEF					: Initisalisation of the multi-layer energy budget model
+  !!
+  !! DESCRIPTION				: Initisalisation of the multi-layer energy budget model, allocate module variables,
+  !!                                              read from the run.def and set some of the parameterisation variables.
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	:
+  !!
+  !! REFERENCE(S)				:
+  !!
+  !! FLOWCHART  : None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE mleb_initialize
+
+  IMPLICIT NONE
+
+  !! 0.4 Local variables
+  INTEGER(i_std)                                     :: ier
+
+    IF (printlev>=3) WRITE (numout,*) 'mleb_initialize : Start initillization'
+
+    !! Initialize local printlev
+    !printlev_loc=get_printlev('enerbil')
+
+    !! 1. Initialize arrays
+    ALLOCATE (pad_deltah(0:jnlvls),stat=ier)
+     IF (ier.NE.0) THEN
+         WRITE (numout,*) ' error in pad_deltah allocation. '
+     END IF
+        
+     ALLOCATE (box_height(jnlvls+1),stat=ier)
+     IF (ier.NE.0) THEN
+         WRITE (numout,*) ' error in box_height allocation.'
+     END IF
+
+     ALLOCATE (box_height_old(jnlvls+1),stat=ier)
+     IF (ier.NE.0) THEN
+         WRITE (numout,*) ' error in box_height_old allocation.'
+     END IF
+
+     ALLOCATE (jtheta(jnlvls),stat=ier)
+     IF (ier.NE.0) THEN
+         WRITE (numout,*) ' error in jtheta  allocation.'
+     END IF
+
+    !! 2. Read parameters from the run.def
+
+    k_ext_fac = 1.0
+    CALL getin_p('K_EXT_FAC',k_ext_fac)
+
+    IF (jnlvls .eq. 1) THEN
+        ! no read-in profile for single layer case
+
+        ! set a default value of box_height
+        box_height(:) = 1.0d0
+
+        ! set a default value of pad_deltah
+        pad_deltah(:) = 1.0d0
+
+        k_eddy_slope = 1.0_r_std
+        k_eddy_ustar = 0.001_r_std
+
+    ELSE
+
+        !Config Key   = K_EDDY_SLOPE
+        !Config Desc  = 
+        !Config If    = 
+        !Config Def   = 1.0
+        !Config Help  = 
+        !Config Units = [-]
+        ! set a default value of k_eddy_slope
+        k_eddy_slope = 10.0_r_std
+        CALL getin_p('K_EDDY_SLOPE', k_eddy_slope)
+
+        !Config Key   = K_EDDY_USTAR
+        !Config Desc  = 
+        !Config If    = 
+        !Config Def   = 0.1
+        !Config Help  = 
+        !Config Units = [-]
+        ! set a default value of k_eddy_ustar
+        k_eddy_ustar = 0.1_r_std
+        CALL getin_p('K_EDDY_USTAR', k_eddy_ustar)
+    ENDIF
+
+        !Config Key   = mleb_cdfname
+        !Config If    = mleb_cdfname
+        !Config Desc  = Name of the output CDF file
+        !Config Def   = one_day??
+        !Config Help  = This values gives the name of the output CDF file. 
+        !Config         Default value is: col_cdf.nc
+        !Config Units = [-]
+        ! set a default value of mleb_cdfname
+        mleb_cdfname = 'col_cdf.nc'
+        CALL getin_p('mleb_cdfname', mleb_cdfname)
+
+        !Config Key   = LW_EXTINCTION_COEF
+        !Config If    = JENERBIL
+        !Config Desc  = Value of the extinction coeffecient
+        !Config Def   = one_day??
+        !Config Help  = This values gives the value of the LW extinction coefficient.
+        !Config         Default value is: 0.8
+        !Config Units = [-]
+        ! set a default value of big_k_lw (if there is nothing provided in  run.def)
+        big_k_lw = 0.8d0 ! first test the result with out this, as it has
+        ! not been included for many revesions
+        CALL getin_p('LW_EXTINCTION_COEF', big_k_lw)
+
+        !Config Key   = SW_EXTINCTION_COEF
+        !Config If    = JENERBIL
+        !Config Desc  = Value of the extinction coeffecient
+        !Config Def   = one_day??
+        !Config Help  = This values gives the value of the LW extinction coefficient.
+        !Config         Default value is: 0.45
+        !Config Units = [-]
+        ! set a default value of big_k_sw (if there is nothing provided in run.def)
+        big_k_sw = 0.45d0  ! first test the result with out this, as it
+        ! has  not been included for many revesions
+        CALL getin_p('SW_EXTINCTION_COEF', big_k_sw)
+
+        !Config Key   = KS_TUNE
+        !Config Desc  = 
+        !Config If    = 
+        !Config Def   = 1.0
+        !Config Help  = 
+        !Config Units = [-]
+        ! set a default value of ks_tune
+        ks_tune = 1.0_r_std
+        CALL getin_p('KS_TUNE', ks_tune)
+
+        !Config Key   = KS_SLOPE
+        !Config Desc  = 
+        !Config If    = 
+        !Config Def   = 20.0
+        !Config Help  = 
+        !Config Units = [-]
+        ! set a default value of 
+        ks_slope = 15.0_r_std
+        CALL getin_p('KS_SLOPE', ks_slope)
+
+        !Config Key   = KS_VEGET
+        !Config Desc  = 
+        !Config If    = 
+        !Config Def   = 0.35
+        !Config Help  = 
+        !Config Units = [-]
+        ! set a default value of ks_veget
+        ks_veget = 0.35_r_std
+        CALL getin_p('KS_VEGET', ks_veget)
+
+        !Config Key   = SR_FAC
+        !Config If    = JENERBIL
+        !Config Desc  = Value of the stomatal resistance factor
+        !Config Def   = one_day??
+        !Config Help  = This is the value of the stomatal resistance factor. 
+        !Config         Default value is: 1.0
+        !Config Units = [-]
+        ! set a default value of sr_fac
+        sr_fac = 1.0_r_std
+        CALL getin_p('SR_FAC', sr_fac)
+
+        !Config Key   = BR_FAC
+        !Config If    = JENERBIL
+        !Config Desc  = Value of the boundary resistance factor
+        !Config Def   = one_day??
+        !Config Help  = This is the value of the boundary resistance factor. 
+        !Config         Default value is: 1.0
+        !Config Units = [-]
+        ! set a default value of br_fac
+        br_fac = 1.0_r_std
+        CALL getin_p('BR_FAC', br_fac)
+
+        !Config Key   =  WC02
+        !Config If    =  WC02
+        !Config Desc  =  this is the logic variable for using vertical dynamic
+        !drag coefficient (Wohlfahrt and Cernusca, 2002)
+        !Config Def   =  Default is FALSE
+        !Config Help  =  
+        !Config          Default value is: FALSE
+        !Config Units = [-]
+        !
+        WC02 = .FALSE.
+        CALL getin_p('WC02', WC02)
+
+        !Config Key  = a_1 to a_5 
+        !Config IF   = WC02
+        !Config Desc = Sub-canopy wind spped parametrization 
+        !Config Defi = Default is FALSE 
+        !Config Help = 
+        !Config        Default value is: FALSE
+        !Config Units = [-]
+         a_1 =  6.140d0
+         a_2 =  0.001d0
+         a_3 =  0.434d0
+         a_4 = -0.751d0
+         a_5 =  0.071d0
+         CALL getin_p('A_1',a_1)
+         CALL getin_p('A_2',a_2)
+         CALL getin_p('A_3',a_3)
+         CALL getin_p('A_4',a_4)
+         CALL getin_p('A_5',a_5)
+
+
+    !! 3.1 Set values for the mleb calculations
+
+    rho_veg = 1000.0d0              ! assume that density of vegetation isas for pure water for now (1000 kg/m^3)
+    leaf_tks = 0.00014d0            ! leaf thickness (derived from TRYdatabase), values tried by JR,  0.00014d0,
+                                    ! 0.001d, 0.0017d0 
+
+    jtheta = 4.18d3                 ! specific heat capacity of vegetation(assumed equal to water J/(kg K))
+    !jtheta = jtheta * 0.5          ! see reference of
+                                    ! http://link.springer.com/article/10.1007%2Fs10765-010-0877-7
+                                    ! M. S. Jayalakshmy and  J. Philip  
+                                    ! Thermophysical Properties of Plant Leaves and Their Influence 
+                                    ! on the Environment Temperature, International Journal of 
+                                    ! Thermophysics, 2010, Volume 31, Issue 11-12, pp 2295-2304
+    r_sto_v_fac = 1.0d0
+    big_r_h2o_fac = 1.0d0
+
+
+    surf_lev = 0.0d0
+    pad_deltah(0) = 0.001d0
+
+
+    ! 3.2 Set the  mleb_cdfname
+    mleb_cdfname = '/home/orchidee04/aslanso/'//mleb_cdfname
+
+
+
+  END SUBROUTINE mleb_initialize
+
+  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+
+  !! ===========================================================================================================================
+  !! SUBROUTINE: mleb_main
+  !!
+  !!
+  !>\BRIEF: calls the main processes for the multi-layer version of the energy budget
+  !!          which may also be run in single-layer mode, when 'jnlvls' is set equal
+  !!          to 1
+  !!
+  !! DESCRIPTION:
+  !! 
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! MAIN OUTPUT VARIABLE(S): vevapnu, vevapsno, vevapflo, transpir, 
+  !!                          transpot, vevapwet, 
+  !!                          temp_surf_pres, temp_surf_next, flux_ground_h, 
+  !!                          flux_ground_le, flux_rn_grid, flux_h_grid, 
+  !!                          flux_le_grid, u_speed_grid
+  !!                          q_atmos_pres_grid, t_a_next_grid, q_a_next_grid
+  !!                          qsol_sat_new_out, qair_new, 
+  !!                          Collim_Abs_Tot, Collim_Alb_Tot
+  !!                          vbeta3, evapot, evapot_corr, temp_sol, qsurf
+  !!                          fluxsens, fluxlat, netrad, tsol_rad, vevapp
+  !!                          temp_sol_new, vbeta2sum, vbeta3sum
+  !!                          temp_atmos_pres_grid, temp_leaf_pres_grid, 
+  !!                          delta_temp_save  
+  !!
+  !! REFERENCE(S):
+  !!
+  !! FLOWCHART:
+  !_ ==============================================================================================================================
+
+   SUBROUTINE mleb_main (kjit, kjpindex, ldrestart_read, ldrestart_write, &
+                      & index, indexveg, zlev, lwdown, swnet, swdown, &
+                      & epot_air, temp_air, u, v, petAcoef, petBcoef, &
+                      & qair, peqAcoef, peqBcoef, pb, rau, &
+                      & vbeta, vbeta1, vbeta2, vbeta3, &
+                      & vbeta3pot, vbeta4, vbeta5, &
+                      & emis, soilflx, soilcap, q_cdrag, &
+                      & humrel, fluxsens, fluxlat, vevapp, transpir, &
+                      & transpot, vevapnu, vevapwet, vevapsno, &
+                      & vevapflo, temp_sol, tsol_rad, temp_sol_new, &
+                      & qsurf, evapot, evapot_corr, rest_id, hist_id, & 
+                      & hist2_id, &
+                      & flux_ground_h, flux_ground_le, flux_h_grid, flux_le_grid, &
+                      & t_a_next_grid, q_a_next_grid, temp_surf_next, &
+                      & temp_atmos_pres_grid, q_atmos_pres_grid, &
+                      & ok_mleb_history_file, mleb_step_count, &
+                      & temp_leaf_pres_grid, temp_surf_pres, E_supply, hydrol_flag, &
+                      & hydrol_flag2, hydrol_flag3, vbeta2sum, vbeta3sum, veget_max, &
+                      & qsol_sat_new_out, qair_new, delta_temp_save, netrad, veget, &
+                      & Collim_Abs_Tot, Collim_Alb_Tot, &
+                      & laieff_isotrop, h_array_out, z_array_out, &
+                      & transpir_supply_column, u_speed, profile_vbeta3, profile_rveget, &
+                      & max_height_store, u_speed_grid, flux_rn_grid, t2m_month_out)
+     IMPLICIT NONE
+
+
+
+     !! 0 Variable and parameter description 
+
+     !! 0.1 Input variables
+
+     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)                                       :: ok_mleb_history_file !! Flag that controls the netCDF output routine
+     LOGICAL, INTENT(in)                                       :: hydrol_flag      !! Flag that recalculates the energy budget for the new supply term (true/false)    
+     LOGICAL, DIMENSION (kjpindex), INTENT(in)                 :: hydrol_flag2     !! flag that 'trips' the alternative energy budget for each grid square
+     LOGICAL, DIMENSION (kjpindex, nvm), INTENT(in)            :: hydrol_flag3     !! flag that 'trips' the alternative energy budget for each grid square and PFT
+
+
+     INTEGER, INTENT(in)                                       :: mleb_step_count
+
+     INTEGER(i_std), INTENT(in)                                :: kjit             !! Time step number (-)
+     INTEGER(i_std), INTENT(in)                                :: kjpindex         !! Domain size (-) 
+
+     INTEGER(i_std), INTENT (in)                               :: rest_id,hist_id  !! _Restart_ file and _history_ file identifier (-)
+     INTEGER(i_std), INTENT (in)                               :: hist2_id         !! _history_ file 2 identifier (-)
+
+     INTEGER(i_std), DIMENSION (kjpindex), INTENT (in)         :: index            !! Indeces of the points on the map (-)
+     INTEGER(i_std), DIMENSION(kjpindex*nvm), INTENT(in)       :: indexveg         !! Indeces of the points on the 3D map
+
+     REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)          :: E_supply         !! Supply of water for transpiration (mm timestep^{-1})
+
+     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)            :: swdown           !! Down-welling 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)            :: peqAcoef         !! PeqAcoef (see note)
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)            :: peqBcoef         !! PeqBcoef (see note)
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)            :: pb               !! Lowest level pressure hPa)
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)            :: rau              !! Air density (kg m^{-3})
+    
+     REAL(r_std), DIMENSION (kjpindex), INTENT (inout)         :: vbeta            !! Resistance coefficient (-)
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)            :: vbeta1           !! Snow resistance (-) 
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)            :: vbeta4           !! Bare soil resistance (-)
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)            :: vbeta5           !! Floodplains resistance
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)            :: emis             !! Emissivity (-)
+    
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)            :: soilflx          !! Soil flux (W m^{-2})
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)            :: soilcap          !! Soil calorific capacity (J K^{-1])
+    
+     REAL(r_std), DIMENSION (kjpindex), INTENT (inout)         :: q_cdrag          !! Surface drag coefficient (-)
+!!$     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)        :: vbeta3pot        !! Vegetation resistance for potential transpiration
+!!$  REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)        :: vbetaco2         !! Vegetation resistance to CO2 (-)
+!!$  REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)        :: cimean           !! mean intercellular ci (from STOMATE) 
+!!$                                                                                !! (\mu mole m^{-2} s^{-1})
+
+     REAL(r_std), DIMENSION (kjpindex)                         :: qair             !! Lowest level specific humidity (kg kg^{-1})
+     REAL(r_std),  DIMENSION (kjpindex, nvm), INTENT(in)       :: veget_max        !! Max. fraction of vegetation type (LAI -> infty, unitless)
+     REAL(r_std),  DIMENSION (kjpindex, nvm), INTENT(in)       :: veget            !! Vegetation fraction for each pft 
+!!$  REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)         :: gpp              !! Assimilation ((gC m^{-2}), total area)                , INTENT (inout)
+
+
+     REAL(r_std),DIMENSION(kjpindex,nvm,ncirc,nlevels_tot), INTENT(in)     :: h_array_out             !! An output of h_array, to use in sechiba               
+     REAL(r_std),DIMENSION(kjpindex,nvm,ncirc,nlevels_tot), INTENT(in)     :: z_array_out             !! An output of h_array, to use in sechiba                             
+     REAL(r_std), DIMENSION(nlevels_tot, kjpindex, nvm), INTENT(in)        :: transpir_supply_column  !! Supply of water for transpiration 
+     REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)                     :: max_height_store
+     REAL(r_std), DIMENSION (kjpindex), INTENT(in)                         :: t2m_month_out           !! An output of t2m_month, from stomate season 
+     REAL(r_std), DIMENSION(nlevels_tot,kjpindex,nvm), INTENT(in)          :: laieff_isotrop          !! Effective LAI
+     REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT(in)          :: profile_vbeta3
+     REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT(in)          :: profile_rveget
+
+
+     !! 0.2 Output variables
+
+     REAL(r_std), DIMENSION (kjpindex), INTENT(out)          :: vevapnu          !! Bare soil evaporation (mm day^{-1})            , INTENT (out) 
+     REAL(r_std), DIMENSION (kjpindex), INTENT(out)          :: vevapsno         !! Snow evaporation (mm day^{-1})                 , INTENT (out)
+     REAL(r_std), DIMENSION (kjpindex), INTENT(out)          :: vevapflo         !! Floodplains evaporation                        , INTENT (out) 
+     REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)      :: transpir         !! Transpiration (mm day^{-1})                    , INTENT (out)
+     REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)      :: transpot         !! Potential transpiration                        , INTENT (out)
+     REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)      :: vevapwet         !! Interception (mm day^{-1})                     , INTENT (out)
+     REAL(r_std), INTENT(out)                                :: temp_surf_pres   !! temperature at surface (K) PRESENT STEP
+     REAL(r_std), INTENT(out)                                :: temp_surf_next   !! temperature at surface (K) NEXT STEP
+     REAL(r_std), INTENT(out)                                :: flux_ground_h    !! ground level sensible heat flux (W/m^2)
+     REAL(r_std), INTENT(out)                                :: flux_ground_le   !! ground level latent heat flux (W/m^2)
+
+     REAL(r_std), DIMENSION(kjpindex,jnlvls), INTENT(out)    :: flux_rn_grid      !! net radiationflux flux down the column (W/m^2) 
+     REAL(r_std), DIMENSION(kjpindex,jnlvls), INTENT(out)    :: flux_h_grid       !! sensible heat flux down the column (W/m^2)
+     REAL(r_std), DIMENSION(kjpindex,jnlvls), INTENT(out)    :: flux_le_grid      !! latent heat flux down the column (W/m^2)
+     REAL(r_std), DIMENSION(kjpindex,jnlvls), INTENT(out)    :: u_speed_grid      !! wind_speed down the column (m/s)
+     REAL(r_std), DIMENSION(kjpindex,jnlvls), INTENT(out)    :: q_atmos_pres_grid !! atmospheric specific humididy down the column (kg/kg) PRESENT STEP
+     REAL(r_std), DIMENSION(kjpindex,jnlvls), INTENT(out)    :: t_a_next_grid     !! the atmospheric temperature profile at the NEXT timestep
+     REAL(r_std), DIMENSION(kjpindex,jnlvls), INTENT(out)    :: q_a_next_grid     !! the atmospheric specific humidity profile at the NEXT timestep
+     REAL(r_std), DIMENSION (kjpindex), INTENT(out)          :: qsol_sat_new_out  !! New saturated surface air moisture (kg kg^{-1})
+     REAL(r_std),DIMENSION (kjpindex), INTENT(out)           :: qair_new
+
+
+     !! 0.3 Modified variables
+     REAL(r_std),DIMENSION(nlevels_tot), INTENT(inout)       :: Collim_Abs_Tot    !! collimated total absorption for a given level
+     REAL(r_std),DIMENSION(nlevels_tot), INTENT(inout)       :: Collim_Alb_Tot    !! Collimated (direct) total albedo for a given level
+
+     REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)    :: vbeta3            !! Vegetation resistance (-)
+     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          !! Surface temperature (K)
+     REAL(r_std), DIMENSION (kjpindex), INTENT(inout)        :: qsurf             !! Surface specific humidity (kg kg^{-1})
+     REAL(r_std), DIMENSION (kjpindex), INTENT(inout)        :: fluxsens          !! Top level sensible heat flux (W m^{-2})
+     REAL(r_std), DIMENSION (kjpindex), INTENT(inout)        :: fluxlat           !! Top level latent heat flux (W m^{-2})
+     REAL(r_std), DIMENSION (kjpindex), INTENT(inout)        :: netrad            !! Net radiation 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), INTENT(inout)        :: temp_sol_new      !! New soil temperature (K)
+
+     REAL(r_std), DIMENSION(kjpindex), INTENT(inout)         :: vbeta2sum
+     REAL(r_std), DIMENSION(kjpindex), INTENT(inout)         :: vbeta3sum
+
+
+     REAL(r_std), DIMENSION (kjpindex,jnlvls), INTENT(inout) :: temp_atmos_pres_grid    ! atmospheric temperature down the column (K) PRESENT STEP
+     REAL(r_std), DIMENSION (kjpindex,jnlvls), INTENT(inout) :: temp_leaf_pres_grid     ! leaf temperature down the column (K) PRESENT STEP
+
+     REAL(r_std),DIMENSION (kjpindex), INTENT(inout)         :: delta_temp_save     
+
+     
+     !! 0.4 Local variables
+     LOGICAL, DIMENSION (kjpindex)                :: warning_correction
+
+     INTEGER(i_std)                           	  :: i, j
+     INTEGER(i_std)                    		      :: ji, jv
+     INTEGER(i_std)                               :: ier
+
+     REAL(r_std), DIMENSION(jnlvls)               :: horiz_flux_t,  horiz_flux_q
+     REAL(r_std)                                  :: u_star                 ! friction velocity (m/s)
+     REAL(r_std), DIMENSION (0:jnlvls)            :: jrpad                  ! Plant Area Density, replacement for values above (as definitions between different
+                                                                            !    parts of the model was becoming confusing)
+                                                                            ! 'jrpad' is the total one-sided leaf area per unit of layer volume
+     REAL(r_std), DIMENSION (jnlvls)              :: h_flux, le_flux
+     REAL(r_std), DIMENSION (jnlvls)              :: u_speed                ! wind speed at specified canopy level (m/s)
+     REAL(r_std), DIMENSION (jnlvls)              :: jalpha  
+     REAL(r_std), DIMENSION (jnlvls)              :: jbeta 
+     REAL(r_std), DIMENSION (jnlvls)              :: k_eddy                 ! eddy transport coefficient (m^2 s-1)
+     REAL(r_std)                                  :: k_eddy_surf            ! surface eddy transport coefficient (m^2 s-1)
+     REAL(r_std), DIMENSION (jnlvls)              :: down_sw_tab, down_lw_tab
+     REAL(r_std), DIMENSION (jnlvls)              :: big_r, big_r_prime
+     REAL(r_std)                                  :: layer_height
+     REAL(r_std), DIMENSION(jnlvls)               :: delta_h                ! height of each level (m)
+     REAL(r_std), DIMENSION (jnlvls)              :: delta_z                ! vertical difference between the middle of each box (m)
+                                                                            !   and the middle of the first layer (m)
+     REAL(r_std), DIMENSION(kjpindex)             :: jalpha_surf, jbeta_surf
+     REAL(r_std), DIMENSION(jnlvls)               :: big_e, big_f, big_g
+     REAL(r_std), DIMENSION(jnlvls)               :: a_t, b_t, c_t, d_t
+     REAL(r_std), DIMENSION(jnlvls)               :: a_q, b_q, c_q, d_q
+     REAL(r_std), DIMENSION(jnlvls)               :: jemissivity
+     REAL(r_std), DIMENSION(jnlvls)               :: big_pad                ! plant area density at each level (m^2/m^3)
+     REAL(r_std), DIMENSION(jnlvls)               :: eta_1, eta_2, eta_3, eta_4, jomega
+     REAL(r_std)                                  :: eta_1_surf, eta_2_surf
+     REAL(r_std)                                  :: eta_3_surf, eta_4_surf, eta_3_above
+     REAL(r_std)                                  :: eta_1_above, eta_4_above, eta_2_above           
+
+     REAL(r_std), DIMENSION (kjpindex,jnlvls)     :: temp_leaf_next_grid     ! leaf temperature down the column (K) PRESENT STEP
+
+     REAL(r_std)                                  :: delta_energy_surf
+     REAL(r_std), DIMENSION (kjpindex,jnlvls)     :: delta_energy
+     REAL(r_std), DIMENSION(jnlvls)               :: jomega_sw
+     REAL(r_std)                                  :: jomega_surf
+     REAL(r_std)                                  :: jemissivity_surf
+     REAL(r_std)                                  :: jomega_sw_surf         ! emissivity of surface layer
+     REAL(r_std), DIMENSION(jnlvls+1)             :: top_lev    
+     REAL(r_std), DIMENSION(kjpindex)             :: q_sat_surf
+     REAL(r_std)                                  :: zikt, zikq, speed
+     REAL(r_std)                                  :: delta_temp             ! change in temperature over the time step (Kelvins)
+     REAL(r_std), DIMENSION(kjpindex)             :: jpdqsold
+     REAL(r_std),DIMENSION (kjpindex)             :: epot_air_new
+     CHARACTER(LEN=256)                           :: var_name               !! To store variables names for I/O
+     REAL(r_std), DIMENSION (jnlvls)              :: t_l_pres, t_l_next
+     REAL, DIMENSION (0:jnlvls+1, 0:jnlvls+1)     :: ngu_alpha
+     REAL(r_std), DIMENSION(kjpindex)             :: dev_qsol
+     REAL(r_std), DIMENSION(kjpindex)             :: gs_effective           !! 'effective' stomatal conductance
+     REAL(r_std), DIMENSION(kjpindex)             :: vbeta3_effective
+
+     REAL(r_std), DIMENSION (kjpindex)            :: grad_qsat
+     REAL(r_std)                                  :: correction
+     REAL(r_std)                                  :: qc                     !! Surface drag coefficient (??)
+
+     REAL(r_std)                                  :: light_surf_absorbed
+     REAL(r_std), DIMENSION(jnlvls)               :: light_layer_absorbed
+
+     REAL(r_std)                                  :: pft_running_total
+     REAL(r_std), DIMENSION(0:jnlvls)             :: pad_deltah_running_total
+     REAL(r_std), DIMENSION(jnlvls+1)             :: box_height_running_total
+
+
+    ! each potential input variable is listed separately - I can't see a cleaner way to 
+    !   achieve that this using Fortran. This places a limit of 50 on the number of canopy 
+    !   levels in the energy budget profile, which is sufficient for the moment.
+
+    REAL(r_std)          :: pad_lev_1, pad_lev_2, pad_lev_3, pad_lev_4 
+    REAL(r_std)          :: pad_lev_5, pad_lev_6, pad_lev_7, pad_lev_8 
+    REAL(r_std)          :: pad_lev_9, pad_lev_10, pad_lev_11, pad_lev_12 
+    REAL(r_std)          :: pad_lev_13, pad_lev_14, pad_lev_15, pad_lev_16 
+    REAL(r_std)          :: pad_lev_17, pad_lev_18, pad_lev_19, pad_lev_20
+    REAL(r_std)          :: pad_lev_21, pad_lev_22, pad_lev_23, pad_lev_24 
+    REAL(r_std)          :: pad_lev_25, pad_lev_26, pad_lev_27, pad_lev_28 
+    REAL(r_std)          :: pad_lev_29, pad_lev_30, pad_lev_31, pad_lev_32 
+    REAL(r_std)          :: pad_lev_33, pad_lev_34, pad_lev_35, pad_lev_36 
+    REAL(r_std)          :: pad_lev_37, pad_lev_38, pad_lev_39, pad_lev_40
+    REAL(r_std)          :: pad_lev_41, pad_lev_42, pad_lev_43, pad_lev_44 
+    REAL(r_std)          :: pad_lev_45, pad_lev_46, pad_lev_47, pad_lev_48 
+    REAL(r_std)          :: pad_lev_49, pad_lev_50    
+
+    REAL(r_std)          :: height_lev_1, height_lev_2, height_lev_3, height_lev_4 
+    REAL(r_std)          :: height_lev_5, height_lev_6, height_lev_7, height_lev_8 
+    REAL(r_std)          :: height_lev_9, height_lev_10, height_lev_11, height_lev_12 
+    REAL(r_std)          :: height_lev_13, height_lev_14, height_lev_15, height_lev_16 
+    REAL(r_std)          :: height_lev_17, height_lev_18, height_lev_19, height_lev_20
+    REAL(r_std)          :: height_lev_21, height_lev_22, height_lev_23, height_lev_24 
+    REAL(r_std)          :: height_lev_25, height_lev_26, height_lev_27, height_lev_28 
+    REAL(r_std)          :: height_lev_29, height_lev_30, height_lev_31, height_lev_32 
+    REAL(r_std)          :: height_lev_33, height_lev_34, height_lev_35, height_lev_36 
+    REAL(r_std)          :: height_lev_37, height_lev_38, height_lev_39, height_lev_40
+    REAL(r_std)          :: height_lev_41, height_lev_42, height_lev_43, height_lev_44 
+    REAL(r_std)          :: height_lev_45, height_lev_46, height_lev_47, height_lev_48 
+    REAL(r_std)          :: height_lev_49, height_lev_50
+
+    CHARACTER(len=256)   :: jname
+    CHARACTER(len=256)   :: jname2
+    CHARACTER(len=256)   :: format_string
+
+
+    REAL(r_std), DIMENSION (0:jnlvls+1)          :: ngu_bign
+    REAL(r_std), DIMENSION (0:jnlvls+1)          :: ngu_alpha_insert
+
+     
+    REAL(r_std), DIMENSION(jnlvls)               :: flux_netrad       ! net radiation flux for each layer
+    REAL(r_std), DIMENSION(jnlvls)               :: flux_netsw        ! net radiation contributed from short-wave
+    REAL(r_std), DIMENSION(jnlvls)               :: flux_netlw        ! net radiation contributed from long-wave
+ 
+    LOGICAL                                       :: new_sub=.FALSE. !temporarry for development of new sub routine
+
+!_ =======================================================================================
+
+
+    IF (printlev_loc>=4) THEN
+        WRITE (numout,*) '240215 start of enerbil, tair is: ', tair
+        WRITE (numout,*) '061116 in mleb_main, epot_air is: ', epot_air 
+        WRITE (numout,*) '20150327 lwdown in mleb_main:', lwdown(:)
+        WRITE (numout,*) 'start of mleb_main vbeta',vbeta(:)
+        WRITE (numout,*) 'hydrol_flag', hydrol_flag
+    END IF ! (printlev_loc>=4) THEN
+
+    ! for cases in which we exit the loop if hydrol_flag2 is false
+    epot_air_new = epot_air
+    temp_sol_new = temp_sol
+
+    ! DEBUG, check laieff_isotrop before pad and bx_height calc.
+    IF (printlev_loc>=4) THEN
+        DO ji = 1,1
+           DO jv = 4,4
+              DO i = (jnlvls_under + 1) , (jnlvls_under + jnlvls_canopy)
+                 WRITE (numout, *) 'before ns laieff_isotrop:',i-jnlvls_under+1, ji, jv, &
+                                  &'is', laieff_isotrop(i-jnlvls_under,ji, jv)
+              END DO ! i 
+           END DO ! jv
+       END DO ! ji
+       WRITE(numout,*)'kjit',kjit 
+    END IF ! (printlev_loc>=4)
+    !
+
+    ! To test the new subroitine vs the original code
+    IF(new_sub) THEN
+
+       ! call the new subroutine - make this more precise
+       CALL mleb_boxheight(kjpindex,laieff_isotrop, z_array_out,max_height_store, &
+                      & rau,temp_atmos_pres_grid,q_atmos_pres_grid,temp_leaf_pres_grid, &
+                      & box_height,top_lev, pad_deltah, jrpad)
+
+
+    ELSE
+    ! Use the original code
+    ! ------------------------------------------------------------------------------------
+    !
+    ! there are two ways to arrive at the MLA (mass per unit leaf area, kg/m^2), 
+    ! which we then multiply by the LAD (leaf area density, m^2/m^3) to arrive at the 
+    ! vegetation matter per m in height
+
+    ! 1) as in Nobel, Park S. (2005) 'Physiochemical and Environmental Plant Physiology' 
+    ! Edition 3, published Elsevier, chapter 7.1, p. 309
+    !    - assume leaf has a specific heat of water (4.19 kJ kg^-1 degC^-1 at 20 degC)
+    !    - assume leaf has thickness 300micrometres
+    !    - assume leaf has density of 700kg/m^3 (water is 1000kg/m^3 but leaves are often 
+    !        30% air)
+    !    - this gives (300 x 10^-6 m)(700 kg m^-3) = 0.21 kg m^-2
+
+    ! 2) Using LMA (leaf per unit mass area, m^2/kg) from the TRY database
+    !    - for Eucalyptus delegatensis we have 155 cm^2/g ---> 0.155 m^2/g. 
+    !      This is dried weight of the leaf.
+    !    - 100 gC/m^2 soil
+    !    - 100 * 2 * 10 = 2000 g C / m^2 soil
+    !    Dry weight / Fresh weight = 8 / SLA ---> g FW / m^2 (here we are assuming a dry 
+    !                                               weight to fresh weight ratio of 1:9)
+    !                              = 8 / 0.155
+    !                              = 516 g FW / m^2
+    !                              = 0.516 kg / m^2
+    ! 
+    ! ------------------------------------------------------------------------------------
+
+    IF (printlev_loc>=4) THEN  
+        WRITE (numout, *) 'SUM(laieff_isotrop(1:jnlvls_canopy, test_grid,test_pft)) is: ', &
+                                &  SUM(laieff_isotrop(1:jnlvls_canopy,test_grid,test_pft)) 
+    END IF !(printlev_loc>=4)
+
+     IF (jnlvls .ne. 1) THEN
+        IF (jnlvls .ne. (jnlvls_under + jnlvls_canopy + jnlvls_over)) THEN
+            WRITE (numout, *) 'number of levels in canopy column imbalance'
+            STOP
+        END IF
+     END IF       
+
+     IF (.NOT. ok_impose_can_structure) THEN 
+       
+          pft_running_total = 0.0d0
+          box_height_running_total = 0.0d0
+          pad_deltah_running_total = 0.0d0
+
+          DO ji = 1,1
+              ! Currently, the mleb only runs for one PFT, and therefore
+              ! jv is set to the PFT that is used instead of 1,nvm. 
+              ! DO jv = 1,nvm 
+               DO jv = 4,4
+  
+                ! IF (veget_max(ji,jv) .GT. zero .AND. veget(ji,jv) .GT. zero) THEN 
+
+                ! IF ((SUM(laieff_isotrop(1:jnlvls_canopy, ji, jv)) .gt. min_sechiba) .AND. &
+                !      & (SUM(z_array_out(ji, jv, 1, :)) .gt. min_sechiba)) T/HEN
+
+                 !IF (SUM(z_array_out(ji, jv, 1, :)) .gt. min_sechiba) THEN
+
+                     ! update plant area density
+                      pad_deltah(:) = 0.001d0
+                      ! n.b. the first level of lai_eff_isotrop represents the understorey.
+                      ! We set this equal to the min!
+                      DO i = (jnlvls_under + 1) , (jnlvls_under + jnlvls_canopy)
+                         pad_deltah(i) = laieff_isotrop(i-jnlvls_under+1, ji, jv) * cos(pi/3.0d0) 
+                          IF (pad_deltah(i) .lt. 1.0d-3) THEN
+                              pad_deltah(i) = 1.0d-3
+                          END IF
+                          IF (printlev_loc>=4) THEN
+                               WRITE (numout, *) '251016 laieff_isotrop:',i-jnlvls_under+1, ji, jv, &
+                                    'is', laieff_isotrop(i-jnlvls_under, ji, jv)
+                               WRITE (numout, *) '160315 pad_deltah level: ', i,' is: ', pad_deltah(i)
+                          END IF ! (printlev_loc>=4)
+                       END DO ! i = (jnlvls_under + 1) , (jnlvls_under + jnlvls_canopy)
+
+                       IF (printlev_loc>=4) THEN
+                           WRITE (numout, *) 'in calculate box_height section,pft',jv
+                           WRITE (numout, *) 'max_height_store(ji,jv) is: ', max_height_store(ji, jv)
+                           WRITE (numout, *) 'z_array_out(ji,jv,1,:) is: ', z_array_out(ji, jv, 1, :)
+                       END IF ! (printlev_loc>=4) THEN
+
+                      DO i = 1, jnlvls_under - 1
+                           box_height(i) = (i) * (z_array_out(ji, jv, 1, 2) - z_array_out(ji, jv, 1, 1)) / (jnlvls_under)
+                      END DO ! 1, jnlvls_under - 1 
+
+                      box_height(jnlvls_under) = z_array_out(ji, jv, 1, 2)
+
+
+
+                       DO i = (jnlvls_under + 1), (jnlvls_under + jnlvls_canopy - 1)
+                           box_height(i) = z_array_out(ji, jv, 1, i - jnlvls_under + 2)
+                       END DO ! i = (jnlvls_under + 1), (jnlvls_under + jnlvls_canopy - 1)
+
+
+                      box_height(jnlvls_under + jnlvls_canopy) = max_height_store(ji, jv)
+
+                       DO i = (jnlvls_under + jnlvls_canopy + 1), (jnlvls_under + jnlvls_canopy + jnlvls_over - 1)
+                           box_height(i) = max_height_store(ji, jv) + &
+                                           & (( i - (jnlvls_under + jnlvls_canopy) ) * &
+                                           & (49.0d0 - max_height_store(ji, jv) )/ jnlvls_over )
+                      END DO ! i = (jnlvls_under + jnlvls_canopy + 1), (jnlvls_under + jnlvls_canopy + jnlvls_over)
+
+
+                       box_height(jnlvls_under + jnlvls_canopy + jnlvls_over) = 49.0d0
+                       box_height(jnlvls_under + jnlvls_canopy + jnlvls_over+1) = 50.0d0
+
+                       jrpad(:) = pad_deltah(:)
+
+                       IF (printlev_loc>=4) THEN
+                           DO i = 1, jnlvls
+                               WRITE(numout, *) 'lev: ', i, ' b_h: ', box_height(i), ' p_d: ', pad_deltah(i)
+                           END DO ! i = 1, jnlvls
+                       END IF ! (printlev_loc>=4) THEN
+
+               ! END IF ! (SUM(laieff_isotrop(1:jnlvls_canopy, ji, jv)) .ne. 0.0)
+
+
+
+                 ! IF (SUM(laieff_isotrop(1:jnlvls_canopy, ji, jv)) .gt. min_sechiba) THEN
+                      !  pft_running_total = pft_running_total + 1
+               ! END IF
+
+               !  box_height_running_total = box_height_running_total + box_height ! NOT needed for one PFT
+               !  pad_deltah_running_total = pad_deltah_running_total + pad_deltah ! NOT needed for one PFT 
+
+               ! END IF !(veget_max(ji,jv) .GT. zero .AND. veget(ji,jv) .GT. zero) THEN 
+
+          END DO ! jv = 2, nvm
+
+              IF (printlev_loc>=4) THEN
+                 WRITE(numout, *) '100515 pft_running_total is: ', pft_running_total
+                 WRITE(numout, *) '100515 box_height_running_total(:) is: ', box_height_running_total(:)
+                 WRITE(numout, *) '100515 pad_deltah_running_total(:) is: ', pad_deltah_running_total(:)
+              END IF ! (printlev_loc>=4) THEN
+              
+              ! IF (pft_running_total .gt. min_sechiba) THEN
+              !    box_height = box_height_running_total / pft_running_total
+              !    pad_deltah = pad_deltah_running_total / pft_running_total
+              ! ELSE
+              !    box_height = 0.0d0
+              !    pad_deltah = 0.0d0
+              ! ENDIF
+
+             !  box_height = box_height_running_total / 1.0d0  ! NOT needed for one PFT
+             !  pad_deltah = pad_deltah_running_total / 1.0d0  ! NOT needed for one PFT
+
+
+              box_height_old = box_height
+
+     !         IF (l_first_enerbil_column) THEN
+     !            l_first_enerbil_column = .FALSE.
+     !            IF (printlev_loc>=4) WRITE(numout, *) '020315 not calling mleb_reallocate_column'
+     !         ELSE
+     !            IF (printlev_loc>=4) WRITE(numout, *) '020315 calling mleb_reallocate_column'
+
+     !           According to James Ryder, mleb_reallocate does not need to be
+     !           called every time. Should be fixed at one point.
+                 CALL mleb_reallocate_column(box_height_old, box_height,  &
+                     &  temp_atmos_pres_grid, q_atmos_pres_grid, temp_leaf_pres_grid, &
+                     &  jtheta, rho_veg, leaf_tks, rau, pad_deltah, kjpindex)
+     !        ENDIF
+
+          !   IF(printlev_loc >= 4)THEN
+          !      WRITE(numout,*) 'box_height_old', box_height_old(:)
+          !      WRITE(numout,*) 'box_height', box_height(:)
+          !      WRITE(numout,*) 'temp_atmos_pres_grid',temp_atmos_pres_grid(ji,:)
+          !      WRITE(numout,*) 'q_atmos_pres_grid',q_atmos_pres_grid(ji,:)
+          !      WRITE(numout,*) 'temp_leaf_pres_grid',temp_leaf_pres_grid(ji,:)
+          !   ENDIF ! (printlev_loc >= 4) 
+             box_height_old = box_height
+
+
+          END DO ! ji = 1, kjpindex
+
+    END IF ! (ok_impose_can_structure) THEN 
+
+    top_lev(:) = box_height(:)
+    END IF ! new_sub
+
+    ! end the new subruotine here. do not know whether top_lev should included
+    ! or not, or if we need if at all. Maybe just substitute top_lev with
+    ! box_height (aslanso).
+    
+    ! calculate wind speed based on input velocities
+    speed = MAX(min_wind, SQRT (u(1)*u(1) + v(1)*v(1)))! something odd here,missing dimension
+
+    ! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
+
+    ! as per the original scheme
+    CALL mleb_begin (kjpindex, temp_sol, lwdown, swnet, pb, &
+                         & psold, qsol_sat, pdqsold, netrad, emis, &
+                         & dev_qsol)
+    ! calculates the in-canopy transport profile
+    IF (jnlvls .eq. 1) THEN
+        ! no transport profile for single layer case
+        delta_h(:) = 1.0d0
+        delta_z(:) = 1.0d0
+    ELSE
+        CALL mleb_profile (pad_deltah, layer_height, delta_z, &
+                    & delta_h, box_height, k_eddy, &
+                    & u_star, speed, u_speed, big_pad, &
+                    & k_eddy_slope,k_eddy_ustar, k_eddy_surf, surf_lev, top_lev, swnet(1), jrpad, & 
+                    & a_1, a_2, a_3, a_4, a_5, WC02)
+    END IF !(jnlvls .eq. 1)    
+
+    IF (jnlvls .eq. 1) THEN
+       ! no radiation profile for single layer case
+       eta_1(:)=zero
+       eta_2(:)=zero
+       eta_3(:)=zero
+       eta_4(:)=zero
+       jomega(:)=zero
+       jomega_sw(:)=zero
+       jemissivity(:)=zero
+       jemissivity_surf=zero
+       eta_1_surf=zero
+       eta_2_surf=zero
+       eta_3_surf=zero
+       eta_4_surf=zero
+       ngu_alpha(:,:)=zero
+       jomega_surf=zero
+       jomega_sw_surf=zero
+       eta_1_above=zero
+       eta_2_above=zero
+       eta_3_above=zero
+       eta_4_above=zero
+    ELSE
+        CALL mleb_lwrad (jomega, jemissivity, temp_leaf_pres_grid, temp_surf_pres, &
+                                & pad_deltah, jemissivity_surf, jomega_surf, jomega_sw_surf, &
+                                & eta_3_above, eta_1_above, ngu_alpha, ngu_alpha_insert, kjpindex, &
+                                & big_k_lw, big_k_sw) 
+    END IF !(jnlvls .eq. 1)    
+
+
+
+    ! calculates the boundary layer resistance
+    IF (jnlvls .eq. 1) THEN
+        ! use assigned beta coefficients for single layer case
+    ELSE
+        CALL mleb_boundarylayer_resistance (big_r, u_speed, temp_atmos_pres_grid, &
+                & kjpindex, br_fac, q_cdrag, pad_deltah, &
+                & jrpad)
+    END IF !(jnlvls .eq. 1) 
+
+
+    ! calculates the stomatal resistance
+    IF (jnlvls .eq. 1) THEN
+        ! use assigned beta coefficients for single layer case
+    ELSE
+        CALL mleb_stomatal_resistance (pad_deltah, swnet, lwdown, pb, & 
+                & down_sw_tab, down_lw_tab, big_r_prime, &
+                & temp_atmos_pres_grid, q_atmos_pres_grid, big_r, &
+                & u_speed, r_sto_v_fac, big_r_h2o_fac, rau, kjpindex, &
+                & sr_fac, q_cdrag, &
+                & delta_h, jrpad, profile_rveget)
+    END IF !(jnlvls .eq. 1)        
+      
+    ! calculates the alpha and beta coefficients
+    CALL mleb_alpha_beta_coeff (temp_atmos_pres_grid, temp_leaf_pres_grid, &
+                    & jalpha, jbeta, jalpha_surf, jbeta_surf, & 
+                    & temp_surf_pres, q_sat_surf, &
+                    & kjpindex, pb, temp_sol, &
+                    & jpdqsold)
+
+    ! the central energy budget calculation routine
+
+    IF(printlev_loc>=4) WRITE(numout,*)'before mleb_calc_column, epot_air',epot_air
+    CALL mleb_calc_column (pad_deltah, layer_height, big_r, big_r_prime, delta_z, &
+                 & k_eddy, swnet, swdown, lwdown, &
+                 & temp_atmos_pres_grid, q_atmos_pres_grid, & 
+                 & a_t, b_t, c_t, d_t, a_q, b_q, c_q, d_q, & 
+                 & big_e, big_f, big_g, jalpha, jbeta, temp_leaf_pres_grid, delta_h, &
+                 & eta_1, eta_2, eta_3, eta_4, k_eddy_surf, jtheta, &
+                 & jalpha_surf, jbeta_surf, rau, temp_surf_pres, &
+                 & soilcap, soilflx, speed, q_cdrag, kjpindex, &
+                 & flux_ground_h, flux_ground_le, flux_h_grid, flux_le_grid, &
+                 & u_speed, t_a_next_grid, q_a_next_grid, & 
+                 & temp_surf_next, eta_1_surf, eta_2_surf, eta_3_surf, eta_4_surf, &
+                 & temp_leaf_next_grid, epot_air_new, delta_temp, &
+                 & horiz_flux_t, horiz_flux_q, &
+                 & ngu_bign, ngu_alpha, ngu_alpha_insert, qair_new, qair, &
+                 & emis, temp_sol_new, vbeta1, vbeta4, vbeta5, vbeta2, &
+                 & vbeta3, vbeta3pot, vbeta, fluxsens, fluxlat, netrad, &
+                 & petAcoef, petBcoef, peqAcoef, peqBcoef, &
+                 & u, v, E_supply, hydrol_flag, hydrol_flag2, &
+                 & hydrol_flag3, vbeta2sum, vbeta3sum, veget_max, veget, &
+                 & delta_temp_save, mleb_step_count, &
+                 & Collim_Abs_Tot, Collim_Alb_Tot, light_surf_absorbed, light_layer_absorbed, &
+                 & transpir_supply_column, pb, profile_vbeta3, profile_rveget, u_speed_grid, &
+                 & flux_netrad, flux_netsw, flux_netlw, flux_rn_grid, &
+                 & ks_tune, ks_slope, ks_veget, t2m_month_out )
+
+
+    ! call the modified potential temperature subroutine
+
+    CALL mleb_pottemp (kjpindex, zlev, emis, &
+       & epot_air, petAcoef, petBcoef, qair, peqAcoef, peqBcoef, &
+       & soilflx, rau, u, v, q_cdrag, &
+       & vbeta, vbeta1, vbeta5, soilcap, lwdown, swnet, &
+       & q_sol_pot, temp_sol_pot)
+
+    IF (printlev_loc>= 4) THEN
+       WRITE(numout,*)'before mleb_flux, epot_air',epot_air
+       WRITE(numout,*)'before mleb_flux, epot_air',epot_air_new
+    ENDIF !printlev_loc >= 4
+
+    ! call the modified flux calculation subroutine 
+    CALL mleb_flux (kjpindex, emis, temp_sol, rau, u, v, &
+        & q_cdrag, vbeta, vbeta1, vbeta5, &
+        & qair_new, epot_air_new, psnew, qsurf, &
+        & fluxsens , fluxlat , fluxsubli, vevapp, &
+        & temp_sol_new, lwdown, swnet, &
+        & lwup, lwnet, pb, tsol_rad, netrad, &
+        & evapot, evapot_corr)
+
+
+    ! Diagnoses the values for evaporation and transpiration: vevapsno 
+    !(snow evaporation), vevapnu 
+    ! (bare soil evaporation), transpir (transpiration), gpp (assimilation) 
+    ! and vevapwet (interception)
+    CALL mleb_evapveg (kjpindex,  vbeta1, vbeta2, vbeta3, &
+                 & vbeta3pot, vbeta4, vbeta5, &
+                 & rau, u, v, q_cdrag, qair_new, humrel, &
+                 & vevapsno, vevapnu, vevapflo, vevapwet, &
+                 & transpir, transpot, evapot)
+
+
+     ! surface layer check
+     delta_energy_surf = (temp_surf_next - temp_surf_pres) * rho_soil * soilcap(1)
+
+     ! outputs the multilayer components to a seperate netCDF file - call removed for now
+     IF (jnlvls .eq. 1) THEN
+        ! rely on history file output single layer case
+     ELSE
+        ! only open and write to the mleb history file, if the
+        ! ok_mleb_history_file flag is true
+        IF(ok_mleb_history_file) THEN
+        CALL mleb_netcdf(first_call_mleb_histwrite, t_a_next_grid(1,:), q_a_next_grid(1,:), &
+                 & temp_leaf_next_grid(1,:), &
+                 & flux_h_grid(1,:), flux_le_grid(1,:), flux_ground_h, flux_ground_le, &
+                 & k_eddy, u_speed, temp_surf_next, &
+                 & eta_1, eta_2, eta_3, eta_4, jomega, &
+                 & eta_1_surf, eta_2_surf, eta_3_surf, eta_4_surf, &
+                 & lwdown(1), swnet(1), &
+                 & temp_atmos_pres_grid(1,:), q_atmos_pres_grid(1,:), b_t, b_q, soilflx(1), &
+                 & jomega_surf, jemissivity_surf, jomega_sw_surf, jemissivity, &
+                 & jomega_sw, temp_leaf_pres_grid(1,:), temp_surf_pres, &
+                 & big_r, big_r_prime, horiz_flux_t,  horiz_flux_q, &
+                 & soilcap(1), eta_3_above, eta_1_above, eta_4_above, &
+                 & eta_2_above, pad_deltah, mleb_cdfname, &
+                 & ngu_bign, ngu_alpha(1,:), ngu_alpha_insert, qsol_sat_new(1), kjit, &
+                 & light_surf_absorbed, light_layer_absorbed, box_height)                 
+         ELSE
+            ! do nothing
+         ENDIF ! (ok_mleb_history_file)
+     END IF !(jnlvls .eq. 1)        
+ 
+     ! Write to history files
+     !!$     CALL histwrite_p(hist_id, 'evapot', kjit, evapot, kjpindex, index)
+     !!$     CALL histwrite_p(hist_id, 'evapot_corr', kjit, evapot_corr, kjpindex, index)
+     !!$     CALL histwrite_p(hist2_id, 'transpot', kjit, transpot, kjpindex, index)
+
+     ! prepare for the next timestep
+     temp_atmos_pres_grid(:,:) = t_a_next_grid(:,:)
+     q_atmos_pres_grid(:,:) = q_a_next_grid(:,:)
+     temp_leaf_pres_grid(:,:) = temp_leaf_next_grid(:,:)
+
+     temp_surf_pres = temp_surf_next
+
+     qsol_sat_new_out(:) = qsol_sat_new
+     
+ END SUBROUTINE mleb_main
+
+ 
+  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+ !!  ===========================================================================================================================
+ !! SUBROUTINE: mleb_netcdf
+ !!
+ !!
+ !>\BRIEF: produces an output netCDF file for the multilayer scheme 
+ !!           (though it significantly slows the runtime, so this 
+ !!           subroutine is not for general use) 
+ !!
+ !! DESCRIPTION:
+ !! 
+ !!
+ !! RECENT CHANGE(S): None
+ !!
+ !! MAIN OUTPUT VARIABLE(S): none
+ !!
+ !! REFERENCE(S):
+ !!
+ !! FLOWCHART:
+ !_ ==============================================================================================================================
+
+
+ SUBROUTINE mleb_netcdf(first_call_mleb_histwrite, t_a_next_grid, q_a_next_grid, &
+                     & temp_leaf_next_grid, &
+                     & flux_h, flux_le, flux_ground_h, flux_ground_le, &
+                     & k_eddy, u_speed, temp_surf_next, &
+                     & eta_1, eta_2, eta_3, eta_4, jomega, &
+                     & eta_1_surf, eta_2_surf, eta_3_surf, eta_4_surf, &
+                     & down_lw_ac, down_sw_ac, &
+                     & temp_atmos_pres, q_atmos_pres, b_t, b_q, heat_soil, &
+                     & jomega_surf, jemissivity_surf, jomega_sw_surf, jemissivity, & 
+                     & jomega_sw, temp_leaf_pres, temp_surf_pres, &
+                     & big_r, big_r_prime, horiz_flux_h, horiz_flux_le, &
+                     & theta_zero, eta_3_above, eta_1_above, eta_4_above, &
+                     & eta_2_above, pad_deltah, mleb_cdfname, &
+                     & ngu_bign, ngu_alpha, ngu_alpha_insert, qsol_sat_new, kjit, &
+                     & light_surf_absorbed, light_layer_absorbed, box_height)  
+ 
+    USE netcdf
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    LOGICAL                                              :: first_call_mleb_histwrite ! detemine whether we open and write headers in
+                                                                                      ! the mleb history file
+
+    CHARACTER(LEN=80), INTENT(in)                        :: mleb_cdfname          
+
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)          :: jemissivity       
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)               :: temp_atmos_pres    
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)          :: b_t, b_q
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)          :: q_atmos_pres     
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)          :: big_r, big_r_prime  
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)          :: t_a_next_grid     
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)          :: temp_leaf_next_grid, temp_leaf_pres         ! leaf temperature down the column (K) PRESENT STEP
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)          :: q_a_next_grid        ! atmospheric specific humididy down the column (kg/kg) PRESENT STEP
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)          :: flux_h, flux_le     ! leaf temperature down the column (K) PRESENT STEP
+    REAL(r_std), DIMENSION (jnlvls)                      :: horiz_flux_h,  horiz_flux_le        
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)          :: k_eddy              ! eddy transport coefficient (m^2 s-1)
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)          :: u_speed             ! (m/s)
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)          :: jomega_sw
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)          :: eta_1, eta_2, eta_3, eta_4, jomega
+
+    REAL(r_std), DIMENSION (jnlvls+1), INTENT(in)        :: box_height
+
+    REAL, DIMENSION (0:jnlvls+1), INTENT(in)             :: ngu_alpha
+    REAL(r_std), DIMENSION (0:jnlvls+1), INTENT(in)      :: ngu_alpha_insert
+
+    REAL(r_std), DIMENSION (0:jnlvls), INTENT(in)        :: pad_deltah         ! eddy transport coefficient (m^2 s-1)    
+    REAL(r_std), DIMENSION (0:jnlvls+1), INTENT(in)      :: ngu_bign
+
+    REAL(r_std), INTENT(in)                              :: flux_ground_h, flux_ground_le
+    REAL(r_std), INTENT(in)                              :: jomega_surf   
+    REAL(r_std), INTENT(in)                              :: jemissivity_surf    
+    REAL(r_std), INTENT(in)                              :: jomega_sw_surf    
+    REAL(r_std), INTENT(in)                              :: temp_surf_next, temp_surf_pres, qsol_sat_new    
+    REAL(r_std), INTENT(in)                              :: eta_1_surf, eta_2_surf
+    REAL(r_std), INTENT(in)                              :: eta_3_surf, eta_4_surf, eta_3_above
+    REAL(r_std), INTENT(in)                              :: eta_1_above, eta_4_above, eta_2_above   
+    REAL(r_std), INTENT(in)                              :: down_lw_ac             ! input downwelling lw radiation above the canopy (watts/m^2)
+    REAL(r_std), INTENT(in)                              :: down_sw_ac             ! input downwelling sw radiation above the canopy (watts/m^2) 
+    REAL(r_std), INTENT(in)                              :: heat_soil              ! heat flux from or to deeper soil (layered scheme in ORCHIDEE) (W m^-2)
+    REAL(r_std), INTENT(in)                              :: theta_zero             ! heat capacity of the infinitesimal surface layer (J/ (K m^2))
+
+    INTEGER(i_std), INTENT(in)                           :: kjit
+
+    REAL(r_std), INTENT(in)                              :: light_surf_absorbed
+    REAL(r_std), DIMENSION(:), INTENT(in)                :: light_layer_absorbed
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std), SAVE                     :: tap_id, qap_id, tlp_id, qlp_id              ! ID integers
+    INTEGER(i_std), SAVE                     :: tan_id, qan_id, tln_id, qln_id              ! ID integers
+    INTEGER(i_std), SAVE                     :: bt_id, bq_id                                ! ID integers
+    INTEGER(i_std), SAVE                     :: bigr_id, bigrprime_id                       ! ID integers
+    INTEGER(i_std), SAVE                     :: horiz_f_h_id, horiz_f_le_id                 ! ID integers
+    INTEGER(i_std), SAVE                     :: hflux_id, leflux_id, keddy_id, uspeed_id    ! ID integers
+    INTEGER(i_std), SAVE                     :: tsn_id, tsp_id, qsn_id                              ! ID integers
+    INTEGER(i_std), SAVE                     :: e1_id, e2_id, e3_id, e4_id                  ! ID integers
+    INTEGER(i_std), SAVE                     :: e1s_id, e2s_id, e3s_id, e4s_id              ! ID integers
+    INTEGER(i_std), SAVE                     :: e3a_id, e1a_id, e2a_id, e4a_id              ! ID integers
+    INTEGER(i_std), SAVE                     :: lw_id, sw_id, hs_id                         ! ID integers
+    INTEGER(i_std), SAVE                     :: jos_id, jes_id, josws_id                    ! ID integers
+    INTEGER(i_std), SAVE                     :: je_id, jo_id, josw_id                       ! ID integers
+    INTEGER(i_std), SAVE                     :: tz_id, pad_id                               ! ID integers  
+    INTEGER(i_std), SAVE                     :: ngu_bign_id, ngu_bign_s_id, ngu_bign_a_id   ! ID integers
+    INTEGER(i_std), SAVE                     :: ngu_alpha_id, ngu_alpha_s_id, ngu_alpha_a_id   ! ID integers
+    INTEGER(i_std), SAVE                     :: ngu_alphai_id, ngu_alphai_s_id, ngu_alphai_a_id   ! ID integers
+    INTEGER(i_std), SAVE                     :: msa_id, mla_id                            ! ID integers
+    INTEGER(i_std), SAVE                     :: mleb_step_count    
+    INTEGER(i_std), SAVE                     :: iret, iret2, fid, fid2, fid3
+    INTEGER(i_std), SAVE                     :: ibh_id
+
+    INTEGER(i_std)                           :: ii, jj, nlonid, nlatid, varid
+    INTEGER(i_std)                           :: TimeDimID, jtid, ts_id, HeightDimID, i
+    INTEGER(i_std)                           :: height_dim_id, height_dim_id2, time_dim_id
+    INTEGER(i_std)                           :: jstartnc_b, jcountnc_b
+    INTEGER(i_std)                           :: dimids_b
+    INTEGER(i_std)                           :: dimids(2) 
+    INTEGER(i_std)                           :: dimids2(2) 
+    INTEGER, DIMENSION(2)                    :: jstartnc, jcountnc    
+    LOGICAL                                  :: ok_mleb_history_file    
+
+    REAL(r_std), DIMENSION(jnlvls)           :: flux_h_combo, flux_le_combo
+    REAL(r_std), DIMENSION (jnlvls)          :: array_jomega_surf
+    REAL(r_std), DIMENSION (jnlvls)          :: array_jemissivity_surf 
+    REAL(r_std), DIMENSION (jnlvls)          :: array_jomega_sw_surf 
+    REAL(r_std), DIMENSION (jnlvls)          :: array_temp_surf_pres
+    REAL(r_std), DIMENSION (jnlvls)          :: array_temp_surf_next
+    REAL(r_std), DIMENSION (jnlvls)          :: array_qsol_sat_new
+    REAL(r_std), DIMENSION (jnlvls)          :: array_theta_zero
+    REAL(r_std), DIMENSION (jnlvls)          :: array_eta_1_surf, array_eta_2_surf
+    REAL(r_std), DIMENSION (jnlvls)          :: array_eta_3_surf, array_eta_4_surf 
+    REAL(r_std), DIMENSION (jnlvls)          :: array_eta_3_above, array_eta_1_above
+    REAL(r_std), DIMENSION (jnlvls)          :: array_eta_2_above, array_eta_4_above
+    REAL(r_std), DIMENSION (jnlvls)          :: array_down_lw_ac, array_down_sw_ac
+    REAL(r_std), DIMENSION (jnlvls)          :: array_heat_soil
+    REAL(r_std), DIMENSION (jnlvls)          :: array_ngu_bign_surf
+    REAL(r_std), DIMENSION (jnlvls)          :: array_ngu_bign_above
+    REAL(r_std), DIMENSION (jnlvls)          :: array_ngu_bign
+    REAL(r_std), DIMENSION (jnlvls)          :: array_ngu_alpha_surf
+    REAL(r_std), DIMENSION (jnlvls)          :: array_ngu_alpha_above
+    REAL(r_std), DIMENSION (jnlvls)          :: array_ngu_alpha
+
+    REAL(r_std), DIMENSION (jnlvls)          :: array_ngu_alphai_surf
+    REAL(r_std), DIMENSION (jnlvls)          :: array_ngu_alphai_above
+    REAL(r_std), DIMENSION (jnlvls)          :: array_ngu_alphai
+
+    REAL(r_std), DIMENSION (jnlvls)          :: array_light_surf_absorbed
+    REAL(r_std), DIMENSION (jnlvls)          :: array_light_layer_absorbed
+ !_ ==============================================================================================================================
+
+    REAL(r_std), DIMENSION (jnlvls)          :: intermediate_box_height
+ 
+    ! parameters, dimensions and variable set-ups (only runs once)
+ 
+    IF (first_call_mleb_histwrite) THEN
+
+        first_call_mleb_histwrite = .FALSE.
+
+        ! âŠ define the parameters here
+ 
+        iret = nf90_create(mleb_cdfname, nf90_write, fid)
+        
+  
+        ! define the dimensions
+        
+        iret = nf90_def_dim(fid, "height", jnlvls, height_dim_id)
+        iret = nf90_def_dim(fid, "time", nf90_unlimited, time_dim_id)
+
+        dimids = (/ height_dim_id, time_dim_id /)
+
+ 
+        ! define the variables
+        iret = nf90_def_var(fid,"temp_atmos_pres",nf90_real4, dimids, tap_id)
+        iret = nf90_def_var(fid,"q_atmos_pres",nf90_real4, dimids, qap_id)
+
+        iret = nf90_def_var(fid,"t_a_next_grid",nf90_real4, dimids, tan_id)
+        iret = nf90_def_var(fid,"q_a_next_grid",nf90_real4, dimids, qan_id)
+
+        iret = nf90_def_var(fid,"temp_leaf_pres",nf90_real4, dimids, tlp_id)
+        
+        iret = nf90_def_var(fid,"temp_leaf_next_grid",nf90_real4, dimids, tln_id)
+
+        iret = nf90_def_var(fid,"big_r",nf90_real4, dimids, bigr_id)
+        iret = nf90_def_var(fid,"big_r_prime",nf90_real4, dimids, bigrprime_id)
+
+        iret = nf90_def_var(fid,"h_flux",nf90_real4, dimids, hflux_id)
+        iret = nf90_def_var(fid,"le_flux",nf90_real4, dimids, leflux_id)
+
+        iret = nf90_def_var(fid,"horiz_flux_h",nf90_real4, dimids, horiz_f_h_id)
+        iret = nf90_def_var(fid,"horiz_flux_le",nf90_real4, dimids, horiz_f_le_id)
+
+        iret = nf90_def_var(fid,"k_eddy",nf90_real4, dimids, keddy_id)
+
+        iret = nf90_def_var(fid,"pad_deltah",nf90_real4, dimids, pad_id)
+
+        iret = nf90_def_var(fid,"u_speed",nf90_real4, dimids, uspeed_id)
+
+        iret = nf90_def_var(fid,"b_t",nf90_real4, dimids, bt_id)
+        iret = nf90_def_var(fid,"b_q",nf90_real4, dimids, bq_id)
+
+        iret = nf90_def_var(fid,"temp_surf_pres",nf90_real4, dimids, tsp_id)
+        iret = nf90_def_var(fid,"temp_surf_next",nf90_real4, dimids, tsn_id)
+        iret = nf90_def_var(fid,"qsol_sat_new",nf90_real4, dimids, qsn_id)
+
+        iret = nf90_def_var(fid,"qsol_sat_new",nf90_real4, dimids, qsn_id)
+        iret = nf90_def_var(fid,"theta_zero",nf90_real4, dimids, tz_id)
+
+        iret = nf90_def_var(fid,"eta_1",nf90_real4, dimids, e1_id)
+        iret = nf90_def_var(fid,"eta_2",nf90_real4, dimids, e2_id)
+        iret = nf90_def_var(fid,"eta_3",nf90_real4, dimids, e3_id)
+        iret = nf90_def_var(fid,"eta_4",nf90_real4, dimids, e4_id)
+
+        iret = nf90_def_var(fid,"eta_1_surf",nf90_real4, dimids, e1s_id)
+        iret = nf90_def_var(fid,"eta_2_surf",nf90_real4, dimids, e2s_id)
+        iret = nf90_def_var(fid,"eta_3_surf",nf90_real4, dimids, e3s_id)
+        iret = nf90_def_var(fid,"eta_4_surf",nf90_real4, dimids, e4s_id)
+
+        iret = nf90_def_var(fid,"eta_1_above",nf90_real4, dimids, e1a_id)
+        iret = nf90_def_var(fid,"eta_2_above",nf90_real4, dimids, e2a_id)
+        iret = nf90_def_var(fid,"eta_3_above",nf90_real4, dimids, e3a_id)
+        iret = nf90_def_var(fid,"eta_4_above",nf90_real4, dimids, e4a_id)
+
+        iret = nf90_def_var(fid,"lw_down_ac",nf90_real4, dimids, lw_id)
+        iret = nf90_def_var(fid,"sw_down_ac",nf90_real4, dimids, sw_id)
+
+        iret = nf90_def_var(fid,"heat_soil",nf90_real4, dimids, hs_id)
+
+        iret = nf90_def_var(fid,"jomega",nf90_real4, dimids, jo_id)
+        iret = nf90_def_var(fid,"jomega_sw",nf90_real4, dimids, josw_id)
+        iret = nf90_def_var(fid,"jomega_surf",nf90_real4, dimids, jos_id)
+        iret = nf90_def_var(fid,"jemissivity",nf90_real4, dimids, je_id)
+        iret = nf90_def_var(fid,"jemissivity_surf",nf90_real4, dimids, jes_id)
+        iret = nf90_def_var(fid,"jomega_sw_surf",nf90_real4, dimids, josws_id)
+
+        iret = nf90_def_var(fid,"ngu_bign",nf90_real4, dimids, ngu_bign_id)
+        iret = nf90_def_var(fid,"ngu_bign_surf",nf90_real4, dimids, ngu_bign_s_id)
+        iret = nf90_def_var(fid,"ngu_bign_above",nf90_real4, dimids, ngu_bign_a_id)
+        iret = nf90_def_var(fid,"ngu_alpha",nf90_real4, dimids, ngu_alpha_id)
+        iret = nf90_def_var(fid,"ngu_alpha_surf",nf90_real4, dimids, ngu_alpha_s_id)
+        iret = nf90_def_var(fid,"ngu_alpha_above",nf90_real4, dimids, ngu_alpha_a_id)
+
+        iret = nf90_def_var(fid,"ngu_alphai",nf90_real4, dimids, ngu_alphai_id)
+        iret = nf90_def_var(fid,"ngu_alphai_surf",nf90_real4, dimids, ngu_alphai_s_id)
+        iret = nf90_def_var(fid,"ngu_alphai_above",nf90_real4, dimids, ngu_alphai_a_id)
+
+        iret = nf90_def_var(fid,"light_surf_absorbed",nf90_real4, dimids, msa_id)
+        iret = nf90_def_var(fid,"light_layer_absorbed",nf90_real4, dimids, mla_id)
+
+        iret = nf90_def_var(fid,"intermediate_box_height",nf90_real4, dimids, ibh_id)
+
+        iret = nf90_enddef (fid)
+         
+    END IF !(first_call_mleb_histwrite)
+
+    intermediate_box_height(1:jnlvls) = box_height(1:jnlvls)
+
+    ! open the netCDF file at each step
+    iret = nf90_open(mleb_cdfname, nf90_Write, fid) 
+
+    jstartnc = (/ 1, 1 /)  ! vector of integers specifying the index in the variable from 
+                           !   which the first of the data values will be read
+    jcountnc = (/ jnlvls, 1 /)  ! vector of integers specifying the number of indices 
+                                 !   selected along each dimension
+
+    mleb_step_count = mleb_step_count + 1    ! this is the time step counter
+    
+    jstartnc(2) = mleb_step_count   ! (2) refers to the time dimension at present (it 
+                                     !   must always come last)
+ 
+    flux_h_combo(1) = flux_ground_h
+    flux_h_combo(2:jnlvls) = flux_h(2:jnlvls)
+    
+    flux_le_combo(1) = flux_ground_le
+    flux_le_combo(2:jnlvls) = flux_le(2:jnlvls) 
+
+    array_temp_surf_pres(1) = temp_surf_pres
+    array_temp_surf_pres(2:jnlvls) = 0.0d0
+    
+    array_temp_surf_next(1) = temp_surf_next
+    array_temp_surf_next(2:jnlvls) = 0.0d0
+    
+    array_qsol_sat_new(1) = qsol_sat_new
+    array_qsol_sat_new(2:jnlvls) = 0.0d0
+
+    array_eta_1_surf(1) = eta_1_surf
+    array_eta_1_surf(2:jnlvls) = 0.0d0
+    
+    array_eta_2_surf(1) = eta_2_surf
+    array_eta_2_surf(2:jnlvls) = 0.0d0    
+ 
+    array_eta_3_surf(1) = eta_3_surf
+    array_eta_3_surf(2:jnlvls) = 0.0d0    
+
+    array_eta_1_above(1) = eta_1_above
+    array_eta_1_above(2:jnlvls) = 0.0d0  
+
+    array_eta_2_above(1) = eta_2_above
+    array_eta_2_above(2:jnlvls) = 0.0d0  
+
+    array_eta_3_above(1) = eta_3_above
+    array_eta_3_above(2:jnlvls) = 0.0d0  
+
+    array_eta_4_above(1) = eta_4_above
+    array_eta_4_above(2:jnlvls) = 0.0d0  
+
+    array_eta_4_surf(1) = eta_4_surf
+    array_eta_4_surf(2:jnlvls) = 0.0d0
+    
+    array_down_lw_ac(1) = down_lw_ac
+    array_down_lw_ac(2:jnlvls) = 0.0d0 
+    array_down_sw_ac(1) = down_sw_ac
+    array_down_sw_ac(2:jnlvls) = 0.0d0
+    
+    array_heat_soil(1) = heat_soil
+    array_heat_soil(2:jnlvls) = 0.0d0
+
+    array_jomega_surf(1) = jomega_surf
+    array_jomega_surf(2:jnlvls) = 0.0d0
+
+    array_theta_zero(1) = theta_zero
+    array_theta_zero(2:jnlvls) = 0.0d0
+    
+    array_jemissivity_surf(1) = jemissivity_surf
+    array_jemissivity_surf(2:jnlvls) = 0.0d0
+
+    array_jomega_sw_surf(1) = jomega_sw_surf    
+    array_jomega_sw_surf(2:jnlvls) = 0.0d0     
+
+    array_ngu_bign_surf(1) = ngu_bign(0)    
+    array_ngu_bign_surf(2:jnlvls) = 0.0d0            
+
+    array_ngu_bign_above(1) = ngu_bign(jnlvls+1)
+    array_ngu_bign_above(2:jnlvls) = 0.0d0 
+
+    array_ngu_bign(1:jnlvls) = ngu_bign(1:jnlvls)    
+
+
+
+    array_ngu_alpha_surf(1) = ngu_alpha(0)    
+    array_ngu_alpha_surf(2:jnlvls) = 0.0d0            
+
+    array_ngu_alpha_above(1) = ngu_alpha(jnlvls+1)
+    array_ngu_alpha_above(2:jnlvls) = 0.0d0 
+
+    array_ngu_alpha(1:jnlvls) = ngu_alpha(1:jnlvls) 
+
+
+
+    array_ngu_alphai_surf(1) = ngu_alpha_insert(0)    
+    array_ngu_alphai_surf(2:jnlvls) = 0.0d0            
+
+    array_ngu_alphai_above(1) = ngu_alpha_insert(jnlvls+1)
+    array_ngu_alphai_above(2:jnlvls) = 0.0d0 
+
+    array_ngu_alphai(1:jnlvls) = ngu_alpha_insert(1:jnlvls) 
+
+    array_light_surf_absorbed(1) = light_surf_absorbed
+    array_light_surf_absorbed(2:jnlvls) = 0.0d0 
+
+    array_light_layer_absorbed(1:jnlvls) = light_layer_absorbed(1:jnlvls) 
+
+    IF (printlev_loc>=4) THEN
+        WRITE(numout, *) '240215 in mleb_netcdf, after column allocation'
+    END IF ! (printlev_loc>=4) THEN
+
+
+    iret = nf90_put_var(fid, bt_id, b_t(:), start = jstartnc, count = jcountnc) 
+    iret = nf90_put_var(fid, bq_id, b_q(:), start = jstartnc, count = jcountnc)
+
+    iret = nf90_put_var(fid, tap_id, temp_atmos_pres(:), start = jstartnc, count = jcountnc) 
+    iret = nf90_put_var(fid, qap_id, q_atmos_pres(:), start = jstartnc, count = jcountnc)
+     
+    iret = nf90_put_var(fid, tan_id, t_a_next_grid(:), start = jstartnc, count = jcountnc) 
+    iret = nf90_put_var(fid, qan_id, q_a_next_grid(:), start = jstartnc, count = jcountnc)         
+
+    iret = nf90_put_var(fid, qsn_id, array_qsol_sat_new(:), start = jstartnc, count = jcountnc)         
+
+    iret = nf90_put_var(fid, tlp_id, temp_leaf_pres(:), start = jstartnc, count = jcountnc)         
+
+    iret = nf90_put_var(fid, tln_id, temp_leaf_next_grid(:), start = jstartnc, count = jcountnc)         
+
+    iret = nf90_put_var(fid, bigr_id, big_r(:), start = jstartnc, count = jcountnc)         
+    iret = nf90_put_var(fid, bigrprime_id, big_r_prime(:), start = jstartnc, count = jcountnc)
+     
+    iret = nf90_put_var(fid, hflux_id, flux_h_combo(:), start = jstartnc, count = jcountnc)         
+    iret = nf90_put_var(fid, leflux_id, flux_le_combo(:), start = jstartnc, count = jcountnc)         
+
+    iret = nf90_put_var(fid, horiz_f_h_id, horiz_flux_h(:), start = jstartnc, count = jcountnc)         
+    iret = nf90_put_var(fid, horiz_f_le_id, horiz_flux_le(:), start = jstartnc, count = jcountnc)
+
+    iret = nf90_put_var(fid, keddy_id, k_eddy(:), start = jstartnc, count = jcountnc)              
+    
+    iret = nf90_put_var(fid, pad_id, pad_deltah(:), start = jstartnc, count = jcountnc)              
+    
+    iret = nf90_put_var(fid, uspeed_id, u_speed(:), start = jstartnc, count = jcountnc)              
+
+    iret = nf90_put_var(fid, e1_id, eta_1(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, e2_id, eta_2(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, e3_id, eta_3(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, e4_id, eta_4(:), start = jstartnc, count = jcountnc)              
+
+    iret = nf90_put_var(fid, tsp_id, array_temp_surf_pres(:), start = jstartnc, count = jcountnc)              
+
+    iret = nf90_put_var(fid, tsn_id, array_temp_surf_next(:), start = jstartnc, count = jcountnc)              
+
+    iret = nf90_put_var(fid, e1s_id, array_eta_1_surf(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, e2s_id, array_eta_2_surf(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, e3s_id, array_eta_3_surf(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, e4s_id, array_eta_4_surf(:), start = jstartnc, count = jcountnc)              
+
+    iret = nf90_put_var(fid, e1a_id, array_eta_1_above(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, e2a_id, array_eta_2_above(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, e3a_id, array_eta_3_above(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, e4a_id, array_eta_4_above(:), start = jstartnc, count = jcountnc)              
+
+
+    iret = nf90_put_var(fid, lw_id, array_down_lw_ac(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, sw_id, array_down_sw_ac(:), start = jstartnc, count = jcountnc) 
+
+    iret = nf90_put_var(fid, hs_id, array_heat_soil(:), start = jstartnc, count = jcountnc) 
+
+    iret = nf90_put_var(fid, tz_id, array_theta_zero(:), start = jstartnc, count = jcountnc) 
+
+    iret = nf90_put_var(fid, jo_id, jomega(:), start = jstartnc, count = jcountnc) 
+    iret = nf90_put_var(fid, josw_id, jomega_sw(:), start = jstartnc, count = jcountnc) 
+    iret = nf90_put_var(fid, jos_id, array_jomega_surf(:), start = jstartnc, count = jcountnc) 
+    iret = nf90_put_var(fid, je_id, jemissivity(:), start = jstartnc, count = jcountnc) 
+    iret = nf90_put_var(fid, jes_id, array_jemissivity_surf(:), start = jstartnc, count = jcountnc) 
+    iret = nf90_put_var(fid, josws_id, array_jomega_sw_surf(:), start = jstartnc, count = jcountnc) 
+
+    iret = nf90_put_var(fid, ngu_bign_id, array_ngu_bign(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, ngu_bign_s_id, array_ngu_bign_surf(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, ngu_bign_a_id, array_ngu_bign_above(:), start = jstartnc, count = jcountnc)     
+
+
+    iret = nf90_put_var(fid, ngu_alpha_id, array_ngu_alpha(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, ngu_alpha_s_id, array_ngu_alpha_surf(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, ngu_alpha_a_id, array_ngu_alpha_above(:), start = jstartnc, count = jcountnc)   
+
+
+    iret = nf90_put_var(fid, ngu_alphai_id, array_ngu_alphai(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, ngu_alphai_s_id, array_ngu_alphai_surf(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, ngu_alphai_a_id, array_ngu_alphai_above(:), start = jstartnc, count = jcountnc)   
+
+    iret = nf90_put_var(fid, msa_id, array_light_surf_absorbed(:), start = jstartnc, count = jcountnc)              
+    iret = nf90_put_var(fid, mla_id, array_light_layer_absorbed(:), start = jstartnc, count = jcountnc) 
+
+    iret = nf90_put_var(fid, ibh_id, intermediate_box_height(:), start = jstartnc, count = jcountnc) 
+
+    ! close the netCDF file and write to disk                   
+    iret = nf90_close(fid)
+
+ 
+ END SUBROUTINE mleb_netcdf
+
+ 
+  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ !! ===========================================================================================================================
+ !! SUBROUTINE: mleb_lwrad
+ !!
+ !!
+ !>\BRIEF: calculates the radiation balance with a multilayer canopy, includingthe radiation matrix, 
+ !!           as outlined in reference below  
+ !!
+ !! DESCRIPTION:
+ !! 
+ !!
+ !! RECENT CHANGE(S): None
+ !!
+ !! MAIN OUTPUT VARIABLE(S): eta_1, eta_2, eta_3, eta_4, jomega, jemissivity, 
+ !!                            temp_leaf_pres_grid, temp_surf_pres,
+ !!                            pad_deltah, jomega_sw, eta_1_surf, 
+ !!                            eta_2_surf, eta_3_surf, eta_4_surf,
+ !!                            jemissivity_surf, jomega_surf, jomega_sw_surf, 
+ !!                            eta_3_above, eta_1_above, eta_4_above, 
+ !!                            eta_2_above, ngu_alpha, ngu_alpha_insert, 
+ !!                            kjpindex, big_k_lw, big_k_sw
+ !!
+ !! REFERENCE(S): Gu, L. et al., 1999. Micrometeorology, biophysical exchanges and NEE 
+ !!                  decomposition in a two-storey boreal forest - development and test 
+ !!                  of an integrated model. Agricultural and Forest Meteorology, 94, pp.123â148.
+ !!
+ !! FLOWCHART:
+ !_ ==============================================================================================================================
+
+ SUBROUTINE mleb_lwrad (jomega, jemissivity, temp_leaf_pres_grid, temp_surf_pres, &
+                                & pad_deltah, jemissivity_surf, jomega_surf, jomega_sw_surf, &
+                                & eta_3_above, eta_1_above, ngu_alpha, ngu_alpha_insert, kjpindex, &
+                                & big_k_lw, big_k_sw) 
+
+     IMPLICIT NONE
+
+
+     !! 0.1 Input variables
+     INTEGER(i_std), INTENT(in)                             :: kjpindex               !! Domain size (-)
+
+     REAL(r_std), DIMENSION (kjpindex,jnlvls), INTENT(in)   :: temp_leaf_pres_grid    ! leaf temperature down the column (K) PRESENT STEP
+     REAL(r_std), INTENT(in)                                :: temp_surf_pres
+     REAL(r_std), DIMENSION (0:jnlvls), INTENT(in)          :: pad_deltah
+     REAL(r_std), INTENT(in)                                :: big_k_lw
+     REAL(r_std), INTENT(in)                                :: big_k_sw
+
+     !! 0.2 Output variables
+     REAL(r_std), INTENT(out)                               :: jemissivity_surf                     ! emissivity of surface layer
+     REAL(r_std), INTENT(out)                               :: jomega_surf
+     REAL(r_std), INTENT(out)                               :: jomega_sw_surf
+     REAL(r_std), INTENT(out)                               :: eta_3_above, eta_1_above
+
+     REAL, DIMENSION (0:jnlvls+1, 0:jnlvls+1), INTENT(out)  :: ngu_alpha
+     REAL(r_std), DIMENSION(0:jnlvls+1), INTENT(out)        :: ngu_alpha_insert
+
+     REAL(r_std), DIMENSION(jnlvls), INTENT(out)            :: jomega
+
+     REAL(r_std), DIMENSION(jnlvls), INTENT(out)            :: jemissivity
+
+
+     !! 0.3 Modified variables
+
+
+     !! 0.4 Local variables
+     INTEGER(i_std)                                         :: i, j, k, m, ji, jk
+
+     REAL(r_std)                                            :: rho_albedo_surf
+     REAL(r_std)                                            :: jcounter, jcounter2
+     REAL(r_std)                                            :: series_sub1_surf
+     REAL(r_std)                                            :: series_sub2_surf, series_sub1_sw_surf
+     REAL(r_std)                                            :: temp_surf
+     REAL(r_std)                                            :: jfactor
+
+     REAL(r_std), DIMENSION(jnlvls)                         :: temp_leaf_pres    ! leaf temperature down the column (K) PRESENT STEP
+     REAL(r_std), DIMENSION(jnlvls)                         :: series_sub1, series_sub2
+     REAL(r_std), DIMENSION(jnlvls)                         :: series_sub1_sw, series_sub2_sw  
+     REAL(r_std), DIMENSION(jnlvls)                         :: rho_albedo                           ! albedo of each vegetation layer
+     REAL(r_std), DIMENSION (jnlvls)                        :: jomega_sw
+
+     REAL(r_std), DIMENSION (0:jnlvls)                      :: jpad    
+     REAL(r_std), DIMENSION (0:jnlvls)                      :: acc_pad        
+     REAL(r_std)                                            :: total_ngu_bign 
+
+     ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+     DO jk = 1, kjpindex
+
+         temp_leaf_pres(:) = temp_leaf_pres_grid(jk,:)  
+         jemissivity(:) = 0.96d0 != 0.96d0
+         jomega_sw_surf = 1.0d0
+         jomega_surf = 1.0d0         
+         jemissivity_surf = 0.96d0 != 0.96d0
+         temp_surf =  0.0d0  !(not used)             
+         series_sub1(:) = 1.0d0
+         series_sub2(:) = 1.0d0 
+         series_sub1_sw(:) = 1.0d0
+         series_sub2_sw(:) = 1.0d0  
+         rho_albedo(:) = 0.4d0
+         rho_albedo_surf = 0.4d0           
+         rho_albedo(:) = 0.4d0
+         rho_albedo_surf = 0.4d0    
+         jomega_surf = 1.0d0
+         jomega_sw_surf = 1.0d0
+         jemissivity_surf = 0.96d0
+         jemissivity(:) = 0.96d0
+         jcounter = 1.0d0
+         jfactor = 1.0d0
+         series_sub1_surf = 1.0d0
+    
+         ! calculate omega coefficient for each level
+         DO i=1, jnlvls
+             jomega(i) = 1 - (exp(-1.0d0 * big_k_lw * pad_deltah(i) ) )
+         END DO ! i = 1, jnlvls
+    
+         DO i=1, jnlvls
+             jomega_sw(i) = 1 - (exp(-1.0d0 * big_k_sw * pad_deltah(i) ) ) 
+         END DO ! i = 1, jnlvls 
+
+
+
+         eta_1_above = 0.0d0     
+    
+         eta_1_above = (series_sub1(1) * jomega(1) * (1.0d0 - jemissivity(1))) 
+    
+         DO i = 2, jnlvls-1
+             eta_1_above = eta_1_above + &
+                            & (series_sub1(i) * jomega(i) * (1.0d0 - jemissivity(i))) 
+         END DO ! i = 2, jnlvls-2
+    
+         eta_1_above = eta_1_above + &
+                    & series_sub1(jnlvls) * jomega(jnlvls) * (1.0d0 - jemissivity(jnlvls))
+    
+         eta_1_above = eta_1_above + &
+                    & series_sub1_surf * jomega_surf * (1.0d0 - jemissivity(jnlvls))
+
+    
+        eta_3_above = 0.0d0
+    
+        DO j = jnlvls, 1
+            jfactor = 1.0d0
+            DO k = jnlvls, j
+                jfactor = jfactor * (1.0d0 - jomega(k))
+            END DO ! k = jnlvls, j
+            eta_3_above = eta_3_above + & 
+                           & (jomega(j) * jfactor * c_stefan * temp_leaf_pres(j)**4.0d0)
+        END DO ! j = jnlvls, 1
+    
+        eta_3_above = eta_3_above + (jomega_surf * jfactor * c_stefan * temp_surf_pres**4.0d0)
+    
+
+        ! ------------------------------------------------------------------------------------
+ 
+
+        ! we here calculate the radiation matrix
+
+        m = jnlvls
+
+        DO i = 0, jnlvls
+           jpad(i) = pad_deltah(i)
+        END DO ! i = 0, jnlvls
+
+
+        ! define acc_pad
+    
+        acc_pad(jnlvls) = 0.0d0
+    
+        DO i = m-1, 0, -1
+           acc_pad(i) = jpad(i+1) + acc_pad(i+1)
+        END DO ! i = m-1, 0, -1
+                       
+        IF (printlev_loc>=4) THEN
+            WRITE (numout,*) 'in jradiation matrix  acc_pad: ', acc_pad(:)
+        END IF ! (printlev_loc>=4) THEN
+ 
+ 
+        DO i = 0, m+1   
+           DO j = 0, m+1
+ 
+              IF ((i .eq. 0) .and. (j .eq. 0)) THEN
+                 ngu_alpha(i,j) = -1.0d0
+                 ngu_alpha_insert(i) = -1.0d0 
+
+              ELSE IF ((i .eq. 0) .and. ((j .ge. 1) .and. (j .le. m))) THEN
+                 ngu_alpha(i,j) = gu(acc_pad(0) - acc_pad(j-1)) - gu(acc_pad(0)-acc_pad(j))
+
+              ELSE IF ((i .eq. 0) .and. (j .eq. (m+1)))  THEN
+                 ngu_alpha(i,j) = gu(acc_pad(0))
+    
+              ELSE IF (((i .ge. 1) .and. (i .le. m)) &
+                        &  .and. ((j .ge. 1) .and. (j .le. (i-1)))) THEN
+                 ngu_alpha(i,j) = gu(acc_pad(j) - acc_pad(i-1)) - gu(acc_pad(j-1)-acc_pad(i-1)) &
+                        & - gu(acc_pad(j) - acc_pad(i)) + gu(acc_pad(j-1)-acc_pad(i))
+    
+              ELSE IF (((i .ge. 1) .and. (i .le. m)) .and. (j .eq. i))  THEN
+
+                 ! this is a departure from the matrix scheme, because I am treating 
+                 !   the temperature of the infinitesimal soil surface layer, and each 
+                 !   vegetation layer, as implicit when (i = j). Radiation from each of the 
+                 !   other levels is treated explicitly - i.e. by using the Gu scheme
+
+                 ! following line is from the full scheme, for completeness
+                 ! ngu_alpha(i,j) = 2.0d0 * gu(acc_pad(i-1) - acc_pad(i)) - 2.0d0 
+                 ngu_alpha_insert(i) = gu(acc_pad(i-1) - acc_pad(i)) 
+                 ! test to see influence of absorbed/emitted from the same layer in the cycle
+                 ngu_alpha(i,j) = 0.0d0 
+
+              ELSE IF (((i .ge. 1).and.(i .le. m)).and.(((j .ge. (i+1)) .and. (j .le. m))))  THEN
+                  ngu_alpha(i,j) = gu(acc_pad(i) - acc_pad(j-1)) - gu(acc_pad(i)-acc_pad(j))  &
+                         & - gu(acc_pad(i-1) - acc_pad(j-1)) + gu(acc_pad(i-1)-acc_pad(j))
+
+              ELSE IF ((i .eq. (m+1)) .and. (j .eq. 0))  THEN
+                  ngu_alpha(i,j) = gu(acc_pad(0))
+
+              ELSE IF ((i .eq. (m+1)) .and. ((j .ge. 1) .and. (j .le. m)))  THEN
+                  ngu_alpha(i,j) = gu(acc_pad(j)) - gu(acc_pad(j-1))   
+
+              ELSE IF ((i .eq. (m+1)) .and. (j .eq. (m+1)))  THEN
+                  ngu_alpha(i,j) = -1.0d0
+                  ngu_alpha_insert(i) = -1.0d0   
+
+              ELSE IF (((i .ge. 1) .and. (i .le. m)) .and. (j .eq. (0)))  THEN
+                  ngu_alpha(i,j) = gu(acc_pad(0) - acc_pad(i-1)) - gu(acc_pad(0) - acc_pad(i))
+
+              ELSE IF (((i .ge. 1) .and. (i .le. m)) .and. (j .eq. (m+1)))  THEN
+                  ngu_alpha(i,j) = gu(acc_pad(i)) - gu(acc_pad(i-1))  
+
+              ELSE 
+
+              END IF
+
+           END DO ! j = 0, m+1
+    
+        END DO ! i = 0, m+1
+
+      END DO ! jk = 1, kjpindex
+
+      ! end of radiation matrix calculate
+
+ END SUBROUTINE mleb_lwrad
+
+
+ ! ---------------------------------------------------------------------------------------------------------------------------------
+
+ !!  ===========================================================================================================================
+ !! SUBROUTINE: mleb_calc_column
+ !!
+ !!
+ !>\BRIEF: calculates the energy, for either the multilayer or the single layer case 
+ !!
+ !! DESCRIPTION: This module calculates the coefficients that are required to determine the energy 
+ !!                                               budget at each time step.
+ !! 
+ !!
+ !! RECENT CHANGE(S): None
+ !!
+ !! MAIN OUTPUT VARIABLE(S): big_e, big_f, big_g, flux_h_grid, flux_le_grid, 
+ !!                               a_t, b_t, c_t, d_t, a_q, b_q, c_q, d_q, 
+ !!                               t_a_next_grid, q_a_next_grid, horiz_flux_t, horiz_flux_q, 
+ !!                               temp_surf_next, flux_ground_h, flux_ground_le, delta_temp, 
+ !!                               temp_leaf_next_grid, temp_sol_new, delta_temp_save, epot_air_new, 
+ !!                               big_r, big_r_prime, speed, vbeta3, eta_1, eta_2, eta_3, eta_4, 
+ !!                               eta_1_surf, eta_2_surf, eta_3_surf, eta_4_surf, qair_new, 
+ !!                               qair, fluxsens, fluxlat, vbeta2sum, vbeta3sum
+ !!
+ !! REFERENCE(S): Best, M.J. et al., 2004. A proposed structure for coupling tiled surfaces 
+ !!                 with the planetary boundary layer. Journal of Hydrometeorology, 
+ !!                 5, pp.1271â1278.
+ !!
+ !!               Polcher, J. et al., 1998. A proposal for a general interface between land 
+ !!                  surface schemes and general circulation models. Global and Planetary 
+ !!                  Change, 19, pp.261â276
+ !!    
+ !!               Ryder, J. Towards a multi-layer representation of the energy balance in a 
+ !!                  land surface model... working document (see DOFOCO cloud)
+ !!
+ !! FLOWCHART: 
+ !_ ==============================================================================================================================
+
+
+ SUBROUTINE mleb_calc_column (pad_deltah, layer_height, big_r, big_r_prime, delta_z,      &
+                      & k_eddy, swnet, swdown, lwdown,                                    &
+                      & temp_atmos_pres_grid, q_atmos_pres_grid,                          &
+                      & a_t, b_t, c_t, d_t,                                               &
+                      & a_q, b_q, c_q, d_q,                                               &
+                      & big_e, big_f, big_g,                                              &
+                      & jalpha, jbeta, temp_leaf_pres_grid, delta_h,                      &
+                      & eta_1, eta_2, eta_3, eta_4,                                       &
+                      & k_eddy_surf,                                                      &
+                      & jtheta,                                                           &
+                      & jalpha_surf, jbeta_surf, rau,                                     &
+                      & temp_surf_pres, soilcap, soilflx, speed,                          &
+                      & q_cdrag,                                                          &
+                      & kjpindex,                                                         &
+                      & flux_ground_h, flux_ground_le, flux_h_grid, flux_le_grid,         &
+                      & u_speed, t_a_next_grid, q_a_next_grid,                            &
+                      & temp_surf_next,                                                   &
+                      & eta_1_surf, eta_2_surf, eta_3_surf, eta_4_surf,                   &
+                      & temp_leaf_next_grid, epot_air_new, delta_temp,                    &
+                      & horiz_flux_t, horiz_flux_q,                                       &
+                      & ngu_bign, ngu_alpha, ngu_alpha_insert, qair_new, qair,            &
+                      & emis, temp_sol_new, vbeta1, vbeta4, vbeta5, vbeta2,               &
+                      & vbeta3, vbeta3pot, vbeta, fluxsens, fluxlat, netrad,              &
+                      & petAcoef, petBcoef, peqAcoef, peqBcoef,                           &
+                      & u, v, E_supply,                                          &
+                      & hydrol_flag, hydrol_flag2,                                        &
+                      & hydrol_flag3, vbeta2sum, vbeta3sum, veget_max, veget,             &
+                      & delta_temp_save, mleb_step_count,                                 &
+                      & Collim_Abs_Tot, Collim_Alb_Tot, light_surf_absorbed,              &
+                      & light_layer_absorbed, transpir_supply_column, pb, profile_vbeta3, &
+                      & profile_rveget, u_speed_grid,                                     &
+                      & flux_netrad, flux_netsw, flux_netlw, flux_rn_grid,                &
+                      & ks_tune, ks_slope, ks_veget, t2m_month_out) 
+
+
+
+     ! 
+
+     IMPLICIT NONE
+
+
+     ! 0.1 input variables
+   
+
+     INTEGER(i_std), INTENT(in)                                    :: kjpindex                   !! Domain size (-)
+     REAL(r_std), INTENT (in)                                      :: layer_height               !! layer height (m)
+
+     REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(in)         :: temp_leaf_pres_grid        !! leaf temperature down the column (K) PRESENT STEP
+     REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(in)         :: temp_atmos_pres_grid       !! atmospheric temperature at the present timestep (K)
+     REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(in)         :: q_atmos_pres_grid          !! specific humidity at the present timestep (kg/kg)
+
+
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)                :: q_cdrag                    !! Surface drag coefficient (-)
+     REAL(r_std), DIMENSION (jnlvls), INTENT(in)                   :: jtheta                     !! specific heat capacity of air (J / (kg K) )
+
+     REAL(r_std), DIMENSION (jnlvls), INTENT (inout)               :: k_eddy                     !! eddy diffusivity between each level (m^2 / s)
+     REAL(r_std), INTENT (in)                                      :: k_eddy_surf                !! eddy diffusivity at the lowest level (if used)
+
+     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)                :: swdown                     !! Down-welling short-wave flux (W m^2)
+     REAL(r_std), DIMENSION (0:jnlvls), INTENT(in)                 :: pad_deltah                 !! leaf area density at each level (m^2 / m^3)
+     REAL(r_std), DIMENSION (jnlvls), INTENT(in)                   :: jalpha, jbeta
+     REAL(r_std), DIMENSION(kjpindex), INTENT(in)                  :: jalpha_surf, jbeta_surf
+     REAL(r_std), INTENT(in)                                       :: temp_surf_pres
+     REAL(r_std), DIMENSION (jnlvls), INTENT(in)                   :: delta_z                    !! separation of levels (m)
+     REAL(r_std), DIMENSION(jnlvls), INTENT(in)                    :: delta_h                    !! height of each level (m)
+
+
+     REAL(r_std),DIMENSION (kjpindex), INTENT (in)                 :: soilcap                    !! Soil calorific capacity (J K^{-1])
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)                :: soilflx                    !! Soil flux (W m^{-2})
+ 
+     REAL(r_std), DIMENSION (jnlvls), INTENT(in)                   :: u_speed                    !! wind speed at each level (m/s)
+
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)                :: emis                       !! Emissivity (-)
+     REAL(r_std), DIMENSION (kjpindex), INTENT(in)                 :: rau                        !! Air density (kg m^{-3})
+     REAL(r_std), DIMENSION (0:jnlvls+1, 0:jnlvls+1), INTENT(in)   :: ngu_alpha
+
+
+     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)                :: peqAcoef                   !! PeqAcoef (see note)
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)                :: peqBcoef                   !! PeqBcoef (see note) 
+     REAL(r_std), DIMENSION (kjpindex), INTENT (inout)             :: vbeta                      !! Resistance coefficient (-)
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)                :: vbeta1                     !! Snow resistance (-) 
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)                :: vbeta4                     !! Bare soil resistance (-)
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)                :: vbeta5                     !! Floodplains resistance
+     REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)            :: vbeta2                     !! Interception resistance (-)
+     REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)            :: vbeta3pot                  !! Vegetation resistance for potential transpiration
+!    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)            :: vbetaco2                   !! Vegetation resistance to CO2 (-)
+     REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)            :: E_supply                   !! Supply of water for transpiration @tex $(m.s^{-1})$ @endtex
+     REAL(r_std),  DIMENSION (kjpindex, nvm), INTENT(in)           :: veget_max                  !! Max. fraction of vegetation type (LAI -> infty, unitless)
+     REAL(r_std),  DIMENSION (kjpindex, nvm), INTENT(in)           :: veget                      !! Vegetation fraction for each pft 
+     INTEGER, INTENT(in)                                           :: mleb_step_count
+     REAL(r_std), DIMENSION(nlevels_tot, kjpindex, nvm), INTENT(in) &
+                                                                   :: transpir_supply_column     !! Supply of water for transpiration 
+
+     REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT(in) &
+                                                                   :: profile_vbeta3
+     REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT(in) &
+                                                                   :: profile_rveget
+     REAL(r_std),DIMENSION (kjpindex), INTENT(in)                  :: t2m_month_out              !! An output of t2m_longterm, from stomate season 
+
+     REAL(r_std), INTENT(in)                                       :: ks_tune                    !! coefficient for tuning the forest floor evapotranspiration
+     REAL(r_std), INTENT(in)                                       :: ks_slope                   !! coefficient for S-shape function 
+     REAL(r_std), INTENT(in)                                       :: ks_veget                   !! coefficient for S-shape function
+
+     ! 0.2 output variables
+     REAL(r_std), DIMENSION (jnlvls), INTENT(out)                  :: big_e, big_f, big_g
+     REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(out)        :: flux_h_grid, flux_le_grid  !! sensible and latent heat flux respectively at each level (both W/m^2)
+     REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(out)        :: flux_rn_grid               !! net radiation flux at each level (W/m^2)
+     REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(out)        :: u_speed_grid               !! wind profile at each level (m/s)
+     REAL(r_std), DIMENSION (jnlvls), INTENT(out)                  :: a_t, b_t, c_t, d_t
+     REAL(r_std), DIMENSION (jnlvls), INTENT(out)                  :: a_q, b_q, c_q, d_q 
+     REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(out)        :: t_a_next_grid
+     REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(out)        :: q_a_next_grid
+     REAL(r_std), DIMENSION (jnlvls), INTENT(out)                  :: horiz_flux_t,  horiz_flux_q
+     REAL(r_std), INTENT(out)                                      :: temp_surf_next             !! temperature of surface at respectively present and next timestep (K)
+     REAL(r_std), INTENT(out)                                      :: flux_ground_h, flux_ground_le    !! sensible and latent heat flux respectively from the ground (both W/m^2)
+     REAL(r_std), INTENT(out)                                      :: delta_temp                 !! change in temperature over the time step (Kelvins)
+     REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(out)        :: temp_leaf_next_grid
+     REAL(r_std), INTENT(out)                                      :: light_surf_absorbed
+     REAL(r_std), DIMENSION(jnlvls), INTENT(out)                   :: light_layer_absorbed
+  
+     REAL(r_std), DIMENSION (jnlvls), INTENT(out)                  :: flux_netrad                !! net radiation flux for each layer  
+     REAL(r_std), DIMENSION (jnlvls), INTENT(out)                  :: flux_netsw                 !! net radiation contributed from short-wave
+     REAL(r_std), DIMENSION (jnlvls), INTENT(out)                  :: flux_netlw                 !! net radiation contributed from long-wave
+
+     ! 0.3 modified variables
+     REAL(r_std), DIMENSION (kjpindex), INTENT(inout)              :: temp_sol_new               !! New ground temperature (K)
+     REAL(r_std),DIMENSION (kjpindex), INTENT(inout)               :: delta_temp_save     
+     REAL(r_std), DIMENSION (kjpindex), INTENT(inout)              :: epot_air_new
+     REAL(r_std), DIMENSION (jnlvls), INTENT(inout)                :: big_r, big_r_prime         !! stomatal resistance for sensible and latent heat flux at each level (s/m)    
+     REAL(r_std), INTENT(inout)                                    :: speed                      !! wind speed above the canopy (m/s), as defined by old enerbil
+     REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (inout)         :: vbeta3                     !! Vegetation resistance (-)
+     REAL(r_std), DIMENSION (jnlvls), INTENT (inout)               :: eta_1, eta_2
+     REAL(r_std), DIMENSION (jnlvls), INTENT (inout)               :: eta_3, eta_4
+     REAL(r_std), INTENT (inout)                                   :: eta_1_surf, eta_2_surf
+     REAL(r_std), INTENT (inout)                                   :: eta_3_surf, eta_4_surf
+     REAL(r_std), DIMENSION (kjpindex), INTENT (inout)             :: qair_new, qair
+     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)             :: vbeta2sum, vbeta3sum
+     REAL(r_std), DIMENSION (kjpindex), INTENT(inout)              :: netrad                     !! Net radiation flux (W m^{-2})   added by YC 
+     REAL(r_std),DIMENSION(nlevels_tot), INTENT(inout)             :: Collim_Abs_Tot             !! collimated total absorption for a given level
+     REAL(r_std),DIMENSION(nlevels_tot), INTENT(inout)             :: Collim_Alb_Tot             !! Collimated (direct) total albedo for a given level
+
+     ! 0.4 local variables
+     INTEGER(i_std)                                                :: i, j, m, n, ji, jv, jk, jm
+     REAL(r_std), DIMENSION (jnlvls)                               :: x_1, x_2, x_3, x_4, x_5, x_6
+     REAL(r_std), DIMENSION (jnlvls)                               :: y_1, y_2, y_3, y_4, y_5, y_6 
+     REAL(r_std), DIMENSION (jnlvls)                               :: t_a_pres
+     REAL(r_std), DIMENSION (jnlvls)                               :: q_a_pres
+     REAL(r_std), DIMENSION (jnlvls)                               :: t_l_pres, t_l_next
+     REAL(r_std), DIMENSION (jnlvls)                               :: q_l_pres, q_l_next
+     REAL(r_std), DIMENSION (jnlvls)                               :: big_e_top
+     REAL(r_std), DIMENSION (jnlvls)                               :: big_f_top
+     REAL(r_std), DIMENSION (jnlvls)                               :: big_g_top
+     REAL(r_std), DIMENSION (jnlvls)                               :: big_efg_bottom
+     REAL(r_std), DIMENSION (jnlvls)                               :: source_sink_t, source_sink_q
+     REAL(r_std), DIMENSION (jnlvls)                               :: source_sink_sum_t, source_sink_sum_q
+     REAL(r_std), DIMENSION (jnlvls)                               :: source_sink_t_l
+     REAL(r_std), DIMENSION (jnlvls)                               :: temp_leaf_pres           !! leaf temperature down the column (K) PRESENT STEP
+     REAL(r_std), DIMENSION (jnlvls)                               :: temp_atmos_pres          !! atmospheric temperature at the present timestep (K)
+     REAL(r_std), DIMENSION (jnlvls)                               :: q_atmos_pres             !! specific humidity at the present timestep (kg/kg)
+     REAL(r_std), DIMENSION (jnlvls)                               :: flux_h                   !! sensible heat flux at each level (both W/m^2)
+     REAL(r_std), DIMENSION (jnlvls)                               :: flux_le                  !! latent heat flux at each level (both W/m^2)
+     REAL(r_std), DIMENSION (jnlvls)                               :: t_a_next
+     REAL(r_std), DIMENSION (jnlvls)                               :: q_a_next
+
+     REAL(r_std)                                                   :: big_omega_1, big_omega_2
+     REAL(r_std)                                                   :: big_omega_3, big_omega_4
+     REAL(r_std)                                                   :: big_omega_5, big_omega_6
+     REAL(r_std)                                                   :: big_omega_7, big_omega_8
+     REAL(r_std)                                                   :: big_omega_5_sub, big_omega_6_sub
+     REAL(r_std)                                                   :: big_omega_7_sub, big_omega_8_sub
+     REAL(r_std)                                                   :: xi_1, xi_2, xi_3, xi_4
+
+!    REAL(r_std)                                                   :: source_sink_sum_t
+!    REAL(r_std)                                                   :: source_sink_sum_q
+
+     REAL(r_std)                                                   :: fevap, turb_factor
+     REAL(r_std)                                                   :: M_1_h, N_1_h, M_1_q, N_1_q
+
+     REAL(r_std)                                                   :: jtchalev0, jtcp_air, jtrau
+     REAL(r_std), DIMENSION (kjpindex)                             :: beta_diffuco                !! the 'beta coefficient' from the existing scheme, for the surface layer (-) 
+     REAL(r_std), DIMENSION (kjpindex)                             :: beta_diffuco_evap           !! the 'beta coefficient' from the existing scheme, for the surface layer (-)
+     REAL(r_std), DIMENSION (kjpindex)                             :: beta_diffuco_sub            !! the 'beta coefficient' from the existing scheme, for the surface layer (-)
+     REAL(r_std), DIMENSION (kjpindex)                             :: beta_diffuco_evap_notrans
+     REAL(r_std), DIMENSION (kjpindex)                             :: beta_diffuco_evap_trans
+
+     REAL(r_std), DIMENSION (kjpindex)                             :: evap_fraction               !! a evapotranspiration fraction based on vbeta3, vbeta4 and other paramters  
+
+     REAL(r_std), DIMENSION (jnlvls)                               :: delta_t_a, sum_flux_a
+     REAL(r_std), DIMENSION (jnlvls)                               :: delta_q_a, sum_flux_q_a
+
+     REAL(r_std), DIMENSION (jnlvls)                               :: delta_temp_leaf
+     REAL(r_std), DIMENSION (jnlvls)                               :: sum_flux_leaf
+
+     REAL(r_std), DIMENSION (0:jnlvls+1)                           :: gu_alpha_sum
+     REAL(r_std), DIMENSION (0:jnlvls+1)                           :: ngu_temp_solid, ngu_bign
+     REAL(r_std), DIMENSION (0:jnlvls+1)                           :: ngu_alpha_insert    
+     REAL(r_std), DIMENSION (0:jnlvls+1)                           :: ngu_alpha_insert2    
+
+     LOGICAL                                                       :: hydrol_flag                  !! Flag that recalculates the energy budget for the new supply term (true/false)    
+     LOGICAL, DIMENSION (kjpindex), INTENT(in)                     :: hydrol_flag2
+     LOGICAL, DIMENSION (kjpindex, nvm), INTENT(in)                :: hydrol_flag3                 !! flag that 'trips' the alternative energy budget for each grid square
+ 
+     REAL(r_std), DIMENSION (0:jnlvls)                             :: pad_deltah_temp              !! leaf area density at each level (m^2 / m^3)
+
+     INTEGER                                                       :: convergence_count
+
+     REAL(r_std), DIMENSION (jnlvls)                               :: phi_trans
+
+
+     ! 090215 new column variables
+
+     REAL(r_std), DIMENSION (jnlvls)                               :: column_air_relhum
+     REAL(r_std), DIMENSION (jnlvls)                               :: column_q_surf_leaf
+     REAL(r_std), DIMENSION (jnlvls)                               :: column_r_sv_leaf
+     REAL(r_std), DIMENSION (jnlvls)                               :: column_r_sto_v_leaf
+     REAL(r_std), DIMENSION (jnlvls)                               :: column_evap
+     REAL(r_std), DIMENSION (jnlvls)                               :: column_qsatt_leaf
+
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)                :: pb                           !! Lowest level pressure (Pa)
+
+     REAL(r_std), DIMENSION (kjpindex)                             :: ks_weight_1                  !! for the calculation of evap_fraction 
+     REAL(r_std), DIMENSION (kjpindex)                             :: ks_weight_2                  !! weight_1 for vbeta3; weight_2 for vbeta4 
+     REAL(r_std)                                                   :: temp_sol_err                 !! the absolute error of temp_sol surface temperatrure 
+     REAL(r_std)                                                   :: epsilon_err                  !! mechain error + numerical error set to 1.0E-15  
+     REAL(r_std)                                                   :: temp_sol_dummy1
+     REAL(r_std)                                                   :: temp_sol_dummy2
+     REAL(r_std)                                                   :: vbeta3_pixel                 !! temporary variable to calculate vbeta3 at the pixel level
+ !! ==============================================================================================================================
+     !      
+     epsilon_err = 1.0E-15
+
+     ! initialise variables
+
+     phi_trans(:) = 0.0d0 !1.0d4
+
+     flux_h(:) = 0.0d0; flux_le(:) = 0.0d0
+
+     source_sink_t(:) = 0.0d0; source_sink_q(:) = 0.0d0
+     temp_surf_next = 0.0d0
+
+     big_e = 0.0d0; big_f = 0.0d0; big_g = 0.0d0
+
+     i = 0; ji = 0
+
+     x_1 = 0.0d0; x_2 = 0.0d0; x_3 = 0.0d0; 
+     x_4 = 0.0d0; x_5 = 0.0d0; x_6 = 0.0d0
+     y_1 = 0.0d0; y_2 = 0.0d0; y_3 = 0.0d0; 
+     y_4 = 0.0d0; y_5 = 0.0d0; y_6 = 0.0d0
+
+     ! t_a_pres = temp_atmos_pres
+     t_a_next = 0.0d0
+     ! q_a_pres = q_atmos_pres
+     q_a_next = 0.0d0
+
+     t_l_next = 0.0d0; q_l_pres = 0.0d0; q_l_next = 0.0d0
+
+     ! n.b. set resistance of uppermost layer to <approaching infinity>
+     big_r(jnlvls) = 1.0d20; big_r_prime(jnlvls) = 1.0d20
+
+     light_surf_absorbed = 0.0d0
+     light_layer_absorbed = 0.0d0
+
+
+     ! 121013 we need to re-calculate beta_diffuco_evap_trans, specifically vbeta3sum
+
+     IF (printlev_loc>=4) THEN
+        WRITE(numout, *) 'in mleb_calc_column, big_r_prime is: ', big_r_prime
+        WRITE(numout, *) 'in mleb_calc_column, profile_rveget is: ', profile_rveget(test_grid,test_pft, :)
+     END IF ! (printlev_loc>=4)
+
+
+     ! hydrol_flag = .FALSE. ! AL: this is added at somepoint after DOFOCO
+     ! rev2566. I have asked JR whether this is needed or not.
+
+
+     gridloop: DO ji=1, kjpindex  ! -----------------------------------------------------------------
+
+        ! $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$  start convergence loop here  $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+
+        temp_sol_err = 0.0_r_std
+        convergence_loop: DO jm = 1, 20
+
+           !++++++++++copy the solved temperature for next time step i
+           ! from previous covergence loop step result   
+           temp_sol_dummy1 = temp_surf_next 
+           !++++++++++++++++++++++++++++++
+
+
+           ! calculate the revised vbeta3sum, based on the revised vbeta3
+
+           IF (hydrol_flag) THEN  ! overall hydrol flag
+
+
+              vbeta3sum(ji) = 0.0d0
+              DO jv = 1, nvm
+!!$                   !++++++++++
+!!$                   IF(ji == test_grid .AND. jv == test_pft)THEN
+!!$                      WRITE(numout,*) 'vbeta3 vnkldsvd 1',vbeta3(ji,jv)
+!!$                   ENDIF
+!!$                   !+++++++++++
+                 vbeta3sum(ji) = vbeta3sum(ji) + vbeta3(ji,jv)
+              ENDDO ! jv = 1, nvm    
+
+              vbeta(ji) = vbeta4(ji) + vbeta2sum(ji) + vbeta3sum(ji)
+
+           END IF ! IF (hydrol_flag .eq. .TRUE.) 
+
+           temp_leaf_pres(:) = temp_leaf_pres_grid(ji,:)
+           t_a_pres(:) = temp_atmos_pres_grid(ji,:) 
+           q_a_pres(:) = q_atmos_pres_grid(ji,:)
+           t_l_pres(:) = temp_leaf_pres_grid(ji,:)
+
+
+           !+++++ CHECK ++++++
+           ! This loop causes a bug where we have incorrect results for large scale simulations.
+           ! Apparently, if we exit here some variables are not getting properly calculated for the pixels
+           ! which have no water stress.  This will cause a performance problem, so best to continue
+           ! looking into this.  One variable where it was very noticable was temp_sol_new. For now, we 
+           ! skip it using HACK_ENERBIL_HYDROL=y.
+           IF(.NOT. HACK_ENERBIL_HYDROL) THEN
+              IF (hydrol_flag) THEN
+                 ! are we on the second call of enerbil, with the corrections to transpiration
+                 IF (.NOT. hydrol_flag2(ji)) THEN
+                    ! no need to run mleb_calc_column again if (E_supply .gt. transpir_mod) for all PFTs at this
+                    !   particular grid point
+                    ! WRITE (*,*) '091013 hydrol_flag2 is false so we are exiting the gridloop'
+                    t_a_next_grid(ji,:) = temp_atmos_pres_grid(ji,:)
+                    q_a_next_grid(ji,:) = q_atmos_pres_grid(ji,:)
+                    temp_leaf_next_grid(ji,:) = temp_leaf_pres_grid(ji,:)
+
+                    temp_sol_new(ji) = temp_sol_new(ji)
+                    IF(test_grid == ji) WRITE(numout,*) "ruieozenerbil mleb_calc_column 1",temp_sol_new(ji)
+                    temp_surf_next = temp_surf_next
+                    qsol_sat_new(ji) = qsol_sat_new(ji)
+                    qair(ji) = qair(ji)
+                    qair_new(ji) = qair(ji)
+
+                    fluxsens(ji) = fluxsens(ji)
+                    fluxlat(ji) = fluxlat(ji)
+                    vbeta2sum(ji) = vbeta2sum(ji)
+                    vbeta3sum(ji) = vbeta3sum(ji)
+                    vbeta3(ji,:) = vbeta3(ji,:)
+
+                    CYCLE gridloop
+
+                 ELSE
+
+                    ! hydrol_flag is not set, so carry on with the energy budget calculation
+
+                 END IF ! IF (hydrol_flag2(ji) .eq. .FALSE.)
+              ELSE
+                 ! we are on the first call of enerbil
+              END IF ! IF (hydrol_flag .eq. .TRUE.) 
+           ENDIF
+           !+++++++++++++++++++++++++++++++++++++++++++
+
+           ! we are inside the loop over grid squares - speed is calculated from the horizontal
+           !   velocities u and v, which are the input parameters
+           speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+
+
+           ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+           !! A note on the A and B coefficients:
+           !! The values passed down from the coupled model are petAcoef, petBcoef, peqAcoef and
+           !!   peqBcoef, allocated per gridsquare.
+           !!
+           !! n.b. for the uncoupled mode, only b_t and b_q (at the uppermost level) have a value. 
+           !!      All of the other coefficients are zero.
+           !!
+           !! however, for the coupled mode, a_t, b_t, a_q and b_q should all have values.
+           !! c_t, d_t, c_q and d_q should not have values as they are derived internal to enerbil
+           !! (they represent the interaction between the atmosphere in the canopy and the vegetation)
+           !! and so are all initialised here.
+           !!
+           !! The interaction between the coefficients within the module 'surf_land_orchidee' (within LMDZ) 
+           !! is as follows:
+           !! 
+           !! petAcoef (orchidee) = petBcoef (lmdz) * delta_t
+           !!
+           !! petBcoef (orchidee) = petAcoef (lmdz)
+           !!
+           !! peqAcoef (orchidee) = peqBcoef (lmdz) * delta_t
+           !!
+           !! peqBcoef (orchidee) = peqAcoef (lmdz)
+
+           !! enerbil_equiv ========================================
+           IF(printlev_loc >= 4) THEN
+              WRITE (numout,*) 'start mleb_calc_column'
+              WRITE (numout,*) 'a_t',a_t
+              WRITE (numout,*) 'b_t',b_t
+           ENDIF
+           a_t(jnlvls) = petAcoef(ji)        ! n.b. kjpindex = 1 corresponds to the bare soil PFT
+           b_t(jnlvls) = petBcoef(ji)/cp_air ! n.b. kjpindex = 1 corresponds to the bare soil PFT 
+           ! (petBcoef is in units of surface static energy - 
+           ! (cp_air * temp) as pressure difference between the 
+           ! surface and the lowest layer of the atmosphere is 
+           ! assumed negligable)
+           ! ======================================================
+           IF(printlev_loc >= 4) THEN
+              WRITE (numout,*) 'a_t(jnlvls)',a_t(jnlvls)
+              WRITE (numout,*) 'b_t(jnlvls)',b_t(jnlvls)
+           ENDIF
+
+           c_t(jnlvls) = 0.0d0
+           d_t(jnlvls) = 0.0d0
+
+
+           ! ====================================================================================
+           a_q(jnlvls) = peqAcoef(ji) ! n.b. kjpindex = 1 corresponds to the bare soil PFT
+           b_q(jnlvls) = peqBcoef(ji) ! n.b. kjpindex = 1 corresponds to the bare soil PFT 
+           !      (peqBcoef is already in units of (kg/kg)
+           ! ====================================================================================
+           c_q(jnlvls) = 0.0d0
+           d_q(jnlvls) = 0.0d0
+
+
+           beta_diffuco(ji) =  1.0d0 * vbeta1(ji) * (un - vbeta5(ji)) + &
+                & (un - vbeta1(ji)) * (un - vbeta5(ji)) * vbeta(ji) + vbeta5(ji)
+
+
+           ! seperating the beta_diffuco term above into expressions for sublimination (snow) and
+           !   evaporation
+           beta_diffuco_sub(ji) = vbeta1(ji) * (1.0d0 - vbeta5(ji))
+           beta_diffuco_evap(ji) = (1.0d0 - vbeta1(ji)) * &
+                & (1.0d0 -vbeta5(ji)) * vbeta(ji) + vbeta5(ji)
+
+
+           ! the version of the evaporation expression above for which the transpiration term is 
+           !   removed
+           beta_diffuco_evap_notrans(ji) = (1.0d0 - vbeta1(ji)) * &
+                & (1.0d0 - vbeta5(ji)) * (vbeta4(ji) + vbeta2sum(ji)) + vbeta5(ji)
+
+           ! the version of the evaporation expression above for which the transpiration term is 
+           !   included
+           beta_diffuco_evap_trans(ji) = (1.0d0 - vbeta1(ji)) * &
+                & (1.0d0 - vbeta5(ji)) * vbeta3sum(ji)
+
+           ! Gu radiation total calculation 
+
+           IF (jnlvls .eq. 1) THEN
+
+              eta_1_surf = 1.0d0 - (1.0d0 - emis(ji))
+              eta_4_surf = 1.0d0
+
+              eta_2_surf = - c_stefan * 4.0d0 * emis(ji) * (psold(ji)/cp_air)**3
+              eta_3_surf = - 3.0d0 * c_stefan * emis(ji) * ((psold(ji)/cp_air)**4)
+
+              eta_1(1) = 0.0d0 
+              eta_2(1) = c_stefan * 4.0d0 * temp_leaf_pres(1)**3
+              eta_3(1) = c_stefan * 3.0d0 * temp_leaf_pres(1)**4 
+              eta_4(1) = 0.0d0
+
+           ELSE
+
+              eta_4 = 0.0d0
+              eta_4_surf = 1.0d0
+
+              ngu_temp_solid(0) = c_stefan * ((psold(ji)/cp_air)**4)
+
+              DO i = 1, jnlvls
+                 ngu_temp_solid(i) = c_stefan * (temp_leaf_pres(i)**4) 
+              END DO ! i = 1, jnlvls
+
+              ngu_temp_solid(jnlvls+1) = lwdown(ji)
+
+              ngu_bign(:) = 0.0d0
+
+              ngu_alpha_insert2(0) = - 1.0d0 * ngu_temp_solid(0)
+              DO i = 1, jnlvls
+                 ngu_alpha_insert2(i) = (2.0d0 * ngu_alpha_insert(i) - 2.0d0) * ngu_temp_solid(i)
+              END DO ! i = 1, jnlvls 
+              ngu_alpha_insert2(jnlvls+1) = - 1.0d0 * ngu_temp_solid(jnlvls+1)
+
+              DO i = 0, jnlvls + 1 
+                 DO j = 0, jnlvls + 1
+                    IF (i .ne. j) THEN
+                       ngu_bign(i) = ngu_bign(i) + ( ngu_alpha(i,j) * ngu_temp_solid(j) )
+                    ELSE
+                       ngu_bign(i) = ngu_bign(i) + 0.0d0
+                    END IF ! (i .ne. j)            
+                 END DO ! j = 0, jnlvls + 1
+              END DO ! i = 0, jnlvls + 1
+
+              ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+              DO i = 1, jnlvls
+
+                 eta_1(i) = 0.0d0 
+
+                 eta_2(i) = (2.0d0*ngu_alpha_insert(i)-2.0d0) &
+                      &  * c_stefan * 4.0d0 * temp_leaf_pres(i)**3
+
+                 eta_3(i) = -(2.0d0*ngu_alpha_insert(i) - 2.0d0) &
+                      &  * c_stefan * 3.0d0 * temp_leaf_pres(i)**4 + ngu_bign(i)
+
+              END DO ! i = 1, jnlvls
+
+              ! The Gu method assumes black body emitters for simplicity
+
+              eta_1_surf = 0.0d0
+
+              eta_2_surf = - 4.0d0 * c_stefan * (((1.0d0/cp_air) * psold(ji))**3)      
+
+              eta_3_surf = - (c_stefan * (3.0d0 * (psold(ji)/cp_air)**4) + ngu_bign(0))
+
+              ! jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjj
+              IF ((.NOT. ok_impose_can_structure).AND. (SUM(collim_abs_tot(:)) > min_sechiba)) THEN
+
+                 light_surf_absorbed = 0.0d0
+
+                 DO i = 1 + 1, jnlvls_canopy + 1                     
+                    ! +++ TEMP +++ 
+                    ! test for night time air temperature gradient 
+                    ! 230515 add (need to discusse with James for 
+                    ! checking the calculation of soil surface absorption
+                    ! equals to summation of ( leaf surface absorption +
+                    ! leaf surface albedo ) in each level instead of
+                    ! surface level only
+                    ! ++++++++++++++++++:q
+
+                    light_surf_absorbed = light_surf_absorbed + Collim_Abs_Tot(i) + Collim_Alb_Tot(i)  
+                    ! light_surf_absorbed = light_surf_absorbed + Collim_Abs_Tot(i)       
+                 END DO
+
+                 ! comment out for the testing 
+                 ! light_surf_absorbed = 1.0d0 - (light_surf_absorbed + Collim_Alb_Tot(jnlvls_canopy+1) )
+                 light_surf_absorbed = (1.0d0 - light_surf_absorbed )
+
+                 IF (printlev_loc>=4) THEN
+                    WRITE (numout, *) 'light_surf_absorbed is: ', light_surf_absorbed 
+                    WRITE (numout, *) 'Collim_Alb_Tot is: ', Collim_Alb_Tot
+                    WRITE (numout, *) 'Collim_Abs_Tot is: ', Collim_Abs_Tot
+                 END IF ! (printlev_loc>=4)!
+
+                 light_layer_absorbed = 0.0d0
+
+                 DO i = 2, jnlvls_canopy+1
+                    light_layer_absorbed(i + jnlvls_under - 1) = Collim_Abs_Tot(i)
+                 END DO
+
+                 IF (printlev_loc>=4) THEN
+                    WRITE (numout, *) 'light_layer_absorbed is: ', light_layer_absorbed
+                 END IF ! (printlev_loc>=4)
+
+                 eta_4(:) = light_layer_absorbed 
+                 eta_4_surf = light_surf_absorbed 
+
+                 IF (printlev_loc>=4) THEN
+                    WRITE (numout, *) 'leaf level absorption eta_4:', eta_4(:)
+                    WRITE (numout, *) 'soil surface absorption eta_4_surf:', eta_4_surf
+                 END IF ! (printlev_loc>=4) THEN
+
+
+              END IF ! (ok_impose_can_structure)
+
+           END IF ! (jnlvls doesn't equal 1)    
+
+
+
+           ! this is just for the lowermost vegetation layer...)
+           ! special case for 'single layer model', which should reduce to the ORCHIDEE trunk
+
+           IF (jnlvls .eq. 1) THEN
+
+              x_1(1) = 0.0d0; x_2(1) = 0.0d0; x_3(1) = 0.0d0; x_4(1) = 0.0d0; x_5(1) = 0.0d0
+
+              y_1(1) = 0.0d0; y_2(1) = 0.0d0; y_3(1) = 0.0d0; y_4(1) = 0.0d0; y_5(1) = 0.0d0
+
+              DO i = jnlvls, jnlvls
+
+                 big_e_top(i) = (-(dt_sechiba*a_q(i)*chalev0*rau(ji))/                                &
+                      &  (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i)*                                 &
+                      &  big_r_prime(i)*jtheta(i)))                                                  &
+                      &  - ((dt_sechiba* d_t(i) * cp_air * rau(ji)) /                                   & 
+                      & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * big_r(i) * jtheta(i)))   
+
+                 big_f_top(i) = (-(dt_sechiba*a_t(i)*cp_air*rau(ji))/                                 &
+                      & (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i)*                                  &
+                      & big_r(i)*jtheta(i)))                                                         &
+                      & -((dt_sechiba* d_q(i) * chalev0 * rau(ji)) /                                    &
+                      & (rho_veg*leaf_tks * pad_deltah(i)* delta_h(i) * big_r_prime(i) * jtheta(i)))
+
+                 big_g_top(i) = (t_l_pres(i) + dt_sechiba* eta_3(i)/                                  &
+                      & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i))                  &  
+                      &  + (eta_1(i) * lwdown(ji) * dt_sechiba)/                                        &
+                      & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i))                  &
+                      &  + (eta_4(i) * swdown(ji) * dt_sechiba)/                                        &
+                      & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i))                  &
+                      &  + (chalev0 * rau(ji) * dt_sechiba* jbeta(i))/                                  &
+                      & (rho_veg*leaf_tks * pad_deltah(i) *delta_h(i) *  big_r_prime(i) * jtheta(i)) &
+                      &  - (dt_sechiba* cp_air * rau(ji) * b_t(i))/                                     &
+                      & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * big_r(i) * jtheta(i))       &
+                      &  - (dt_sechiba* chalev0 * rau(ji) * b_q(i))/                                    &
+                      & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * big_r_prime(i) * jtheta(i)))
+
+                 big_efg_bottom(i) =                                                               &
+                      & ( 1.0d0 - (dt_sechiba* jalpha(i) * chalev0 * rau(ji))/                          &
+                      &  (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * big_r_prime(i)*jtheta(i))  &
+                      &  - (dt_sechiba* cp_air * rau(ji)) /                                             &
+                      & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i) * big_r(i))       &
+                      &  - (eta_2(i) * dt_sechiba) /                                                    & 
+                      & (rho_veg *leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i))                 &
+                      &  + (dt_sechiba* chalev0 * rau(ji) * cp_air * c_t(i)) /                          &
+                      & (rho_veg *leaf_tks * pad_deltah(i) * delta_h(i) *                            &
+                      &  jtheta(i) * big_r(i)) )
+
+                 big_e(i) = big_e_top(i) / big_efg_bottom(i)
+
+                 big_f(i) = big_f_top(i) / big_efg_bottom(i)
+
+                 big_g(i) = big_g_top(i) / big_efg_bottom(i)
+
+              END DO ! i = jnlvls, jnlvls
+
+           ELSE ! IF (jnlvls doesn't equal 1)....
+
+              DO i = jnlvls, jnlvls
+
+                 IF (hydrol_flag) THEN
+
+                    big_e_top(i) =                                                                     &
+                         &   ((dt_sechiba* d_t(i) * cp_air * rau(ji)) /                                    & 
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i) * big_r(i)))   
+
+                    big_f_top(i) = ( + (dt_sechiba * a_t(i) * cp_air * rau(ji))/                          &
+                         & (rho_veg*leaf_tks * pad_deltah(i)* delta_h(i)* jtheta(i) * big_r(i)) )    
+
+                    big_g_top(i) = (t_l_pres(i) + dt_sechiba* eta_3(i)/                                   &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i))                  & 
+                         &  + (eta_1(i) * lwdown(ji) * dt_sechiba)/                                        &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i))                  &
+                         &  + (eta_4(i) * swdown(ji) * dt_sechiba)/                                        & 
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i))                  &
+                         &  + (dt_sechiba * cp_air * rau(ji) * b_t(i))/                                    &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i) * big_r(i) )      &
+                         &  - (dt_sechiba * phi_trans(i)) /                                                &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i)))
+
+                    big_efg_bottom(i) =                                                                 &
+                         & ( 1.0d0                                                                       &
+                         &  + (dt_sechiba * cp_air * rau(ji)) /                                             &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i) * big_r(i))        &
+                         &  - (eta_2(i) * dt_sechiba) /                                                     & 
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i))                   &
+                         &  - (dt_sechiba * chalev0 * rau(ji) * cp_air * c_t(i)) /                          &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i) * big_r(i)) )
+
+                    big_e(i) = big_e_top(i) / big_efg_bottom(i)
+
+                    big_f(i) = big_f_top(i) / big_efg_bottom(i)
+
+                    big_g(i) = big_g_top(i) / big_efg_bottom(i)
+
+                 ELSE ! following if not (hydrol_flag)
+
+                    big_e_top(i) = (+(dt_sechiba*a_q(i)*chalev0*rau(ji))/                                 &
+                         &  (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i)*                                 &
+                         &  big_r_prime(i)*jtheta(i)))                                                  &
+                         &  + ((dt_sechiba* d_t(i) * cp_air * rau(ji)) /                                   & 
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * big_r(i) * jtheta(i)))   
+
+                    big_f_top(i) = (+(dt_sechiba*a_t(i)*cp_air*rau(ji))/                                  &
+                         & (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i)*                                  &
+                         & big_r(i)*jtheta(i)))                                                         &
+                         & +((dt_sechiba* d_q(i) * chalev0 * rau(ji)) /                                    & 
+                         & (rho_veg*leaf_tks * pad_deltah(i)* delta_h(i) * big_r_prime(i) * jtheta(i)))
+
+                    big_g_top(i) = (t_l_pres(i) + dt_sechiba* eta_3(i)/                                   &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i))                  & 
+                         &  + (eta_1(i) * lwdown(ji) * dt_sechiba)/                                        &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i))                  &
+                         &  + (eta_4(i) * swdown(ji) * dt_sechiba)/                                        & 
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i))                  &
+                         &  - (chalev0 * rau(ji) * dt_sechiba* jbeta(i))/                                  &
+                         & (rho_veg*leaf_tks * pad_deltah(i) *delta_h(i) *  big_r_prime(i) * jtheta(i)) &
+                         &  + (dt_sechiba* cp_air * rau(ji) * b_t(i))/                                     &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * big_r(i) * jtheta(i))       &
+                         &  + (dt_sechiba* chalev0 * rau(ji) * b_q(i))/                                    & 
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * big_r_prime(i) * jtheta(i)))
+
+                    big_efg_bottom(i) =                                                                &
+                         & ( 1.0d0 + (dt_sechiba* jalpha(i) * chalev0 * rau(ji))/                          &
+                         &  (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * big_r_prime(i)*jtheta(i))  &
+                         &  + (dt_sechiba* cp_air * rau(ji)) /                                             &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i) * big_r(i))       &
+                         &  - (eta_2(i) * dt_sechiba) /                                                    & 
+                         & (rho_veg *leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i))                 &
+                         &  - (dt_sechiba* chalev0 * rau(ji) * cp_air * c_t(i)) /                          &
+                         & (rho_veg *leaf_tks * pad_deltah(i) * delta_h(i) *                            &
+                         &  jtheta(i) * big_r(i)) )
+
+                    big_e(i) = big_e_top(i) / big_efg_bottom(i)
+
+                    big_f(i) = big_f_top(i) / big_efg_bottom(i)
+
+                    big_g(i) = big_g_top(i) / big_efg_bottom(i)
+
+                 END IF ! (hydrol_flag)
+
+              END DO ! i = jnlvls, jnlvls
+
+
+              DO i=jnlvls-1, 2, -1
+
+                 ! --------------------------------------------------------------------
+
+                 IF (hydrol_flag) THEN
+
+
+                    ! -------------------------------------------------------------------
+
+                    x_1(i) = 1 - ( dt_sechiba* ( (a_t(i+1) * (k_eddy(i)/(delta_z(i)*delta_h(i))))  &
+                         &           - (k_eddy(i)/(delta_z(i)*delta_h(i)))                  &
+                         &           - (k_eddy(i-1)/(delta_z(i-1)*delta_h(i)))              &
+                         &           - ((1.0d0)/(big_r(i)*delta_h(i)))))                    &
+                         &           - ((k_eddy(i) * c_t(i+1)) /                            &
+                         &             (delta_z(i)*delta_h(i))) * big_f(i+1) * dt_sechiba
+
+                    x_2(i) = t_a_pres(i) + ((b_t(i+1)*k_eddy(i)*dt_sechiba)/(delta_z(i) * delta_h(i)))     &
+                         & + ((k_eddy(i) * c_t(i+1)) / (delta_z(i) * delta_h(i))) * big_g(i+1) * dt_sechiba
+
+                    x_3(i) = (k_eddy(i-1)/(delta_z(i-1)*delta_h(i))) * dt_sechiba
+
+                    x_4(i) = (k_eddy(i) * d_t(i+1) / (delta_z(i) * delta_h(i))) * dt_sechiba               &
+                         &  + ((k_eddy(i) * c_t(i+1)) / (delta_z(i) * delta_h(i))) * big_e(i+1) * dt_sechiba
+
+                    x_5(i) = + (dt_sechiba) / (delta_h(i) * big_r(i))
+
+                    ! -------------------------------------------------------------------
+
+                    y_1(i) = 1 - ( dt_sechiba* ( (a_q(i+1) * k_eddy(i)/(delta_z(i)*delta_h(i)))       &
+                         &  - (k_eddy(i)/(delta_z(i)*delta_h(i)))                             &
+                         &  - (k_eddy(i-1)/(delta_z(i-1)*delta_h(i)))                         &
+                         &  ))  
+
+                    y_2(i) = q_a_pres(i) +                                                                 &
+                         & ((b_q(i+1) * k_eddy(i) * dt_sechiba)/(delta_z(i) * delta_h(i)))                     &
+                         & + ((k_eddy(i) * c_q(i+1)) / (delta_z(i) * delta_h(i))) * big_g(i+1) * dt_sechiba    &
+                         & + (dt_sechiba * phi_trans(i)) / (delta_h(i) * chalev0 * rau(ji))
+
+                    y_3(i) = (k_eddy(i-1)/(delta_z(i-1)*delta_h(i))) * dt_sechiba
+
+
+
+                    y_4(i) = (k_eddy(i) * d_q(i+1) / (delta_z(i) * delta_h(i))) * dt_sechiba          
+
+                    y_5(i) = 0.0d0 ! + (jalpha(i) * dt_sechiba) / (delta_h(i) * big_r_prime(i))
+
+                    ! -------------------------------------------------------------------
+                    a_t(i) = x_3(i) / (x_1(i) - (x_4(i) * (y_4(i) / y_1(i))))
+                    b_t(i) = ( x_2(i) + (x_4(i) * (y_2(i)/y_1(i))) )  /        &
+                         & (x_1(i) - (x_4(i) *(y_4(i)/y_1(i))))
+                    c_t(i) = ( (x_4(i) * (y_5(i)/y_1(i))) + x_5(i)) /          &
+                         & (x_1(i) - (x_4(i)*(y_4(i)/y_1(i))))
+                    d_t(i) = ( x_4(i) * (y_3(i)/y_1(i))  )   /                 &
+                         & (x_1(i) - (x_4(i) * (y_4(i) / y_1(i))))
+                    IF(printlev_loc >= 4) THEN
+                       WRITE(numout,*)'hydrol_flag TRUE'      
+                       WRITE(numout,*)'a_t(i)', a_t(i)
+                       WRITE(numout,*)'b_t(i)', b_t(i)
+                    ENDIF
+
+                    ! -------------------------------------------------------------------
+
+                    a_q(i) = y_3(i) / (y_1(i) - (y_4(i) * (x_4(i) / x_1(i))))
+                    b_q(i) = ( y_2(i) + (y_4(i) * (x_2(i)/x_1(i))) )  /        &
+                         & (y_1(i) - (y_4(i) *(x_4(i)/x_1(i))))
+                    c_q(i) = ( (y_4(i) * (x_5(i)/x_1(i))) + y_5(i)) /          &
+                         & (y_1(i) - (y_4(i)*(x_4(i)/x_1(i))))
+                    d_q(i) = ( y_4(i) * (x_3(i)/x_1(i))  )   /                 &
+                         & (y_1(i) - (y_4(i) * (x_4(i) / x_1(i))))
+
+                    ! -------------------------------------------------------------------
+
+
+                    big_e_top(i) =                                                                        &
+                         &   ((dt_sechiba* d_t(i) * cp_air * rau(ji)) /                                    & 
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i)* jtheta(i) * big_r(i)))   
+
+                    big_f_top(i) = ( + (dt_sechiba* a_t(i) * cp_air * rau(ji))/                              &
+                         & (rho_veg*leaf_tks * pad_deltah(i)* delta_h(i) * jtheta(i)* big_r(i)) )    
+
+
+                    big_g_top(i) = (t_l_pres(i) + dt_sechiba* eta_3(i)/                                      &
+                         & (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i)*jtheta(i))                        & 
+                         &  + (eta_1(i) * lwdown(ji) * dt_sechiba)/                                        &
+                         & (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i)*jtheta(i))                        &
+                         &  + (eta_4(i) * swdown(ji) * dt_sechiba)/                                        & 
+                         & (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i)*jtheta(i))                        &
+                         &  + (dt_sechiba * cp_air * rau(ji) * b_t(i))/                                    &
+                         & (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i)* jtheta(i) * big_r(i) )           &
+                                !  &  - (dt_sechiba * phi_trans) / (delta_h(i) * jtheta(i) * rho_veg))
+                         &  - (dt_sechiba * phi_trans(i)) /                                                &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i)))
+
+
+                    big_efg_bottom(i) =                                                                  &
+                         & ( 1.0d0                                                                      &
+                         &  + (dt_sechiba * cp_air * rau(ji)) /                                            &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i)  * big_r(i))      &
+                         &  - (eta_2(i) * dt_sechiba) /                                                    & 
+                         & (rho_veg *leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i))                 &
+                         &  - (dt_sechiba * cp_air * rau(ji) * c_t(i)) /                                   &
+                         & (rho_veg *leaf_tks * pad_deltah(i) * delta_h(i) *jtheta(i) * big_r(i)) )
+
+
+                    big_e(i) = big_e_top(i) / big_efg_bottom(i)
+
+                    big_f(i) = big_f_top(i) / big_efg_bottom(i)
+
+                    big_g(i) = big_g_top(i) / big_efg_bottom(i)
+
+
+                 ELSE ! following if not (hydrol_flag)
+
+                    IF(printlev_loc >= 4 ) THEN
+                       WRITE(numout,*) 'dt_sechiba',dt_sechiba
+                       WRITE(numout,*) 'a_t(i+1)',a_t(i+1)
+                       WRITE(numout,*) 'k_eddy(i)', k_eddy(i)
+                       WRITE(numout,*) 'delta_z(i)',delta_z(i)
+                       WRITE(numout,*) 'delta_h(i)',delta_h(i)
+                       WRITE(numout,*) 'k_eddy(i-1)',k_eddy(i-1)
+                       WRITE(numout,*) 'delta_z(i-1)', delta_z(i-1)
+                       WRITE(numout,*) 'big_r(i)', big_r(i)
+                       WRITE(numout,*) 'c_t(i+1)', c_t(i+1)
+                       WRITE(numout,*) 'big_f(i+1)', big_f(i+1)
+                    ENDIF ! (printlev_lov >=  4)
+
+                    ! --------------------------------------------------------------------
+
+                    x_1(i) = 1 - ( dt_sechiba* ( (a_t(i+1) * (k_eddy(i)/(delta_z(i)*delta_h(i))))       &
+                         &           - (k_eddy(i)/(delta_z(i)*delta_h(i)))                      &
+                         &           - (k_eddy(i-1)/(delta_z(i-1)*delta_h(i)))                  &
+                         &           - ((1.0d0)/(big_r(i)*delta_h(i)))))                        &
+                         &           - ((k_eddy(i) * c_t(i+1)) /                                &
+                         &             (delta_z(i)*delta_h(i))) * big_f(i+1) * dt_sechiba
+
+                    x_2(i) = t_a_pres(i) + ((b_t(i+1)*k_eddy(i)*dt_sechiba)/(delta_z(i) * delta_h(i)))  &
+                         & + ((k_eddy(i) * c_t(i+1)) / (delta_z(i) * delta_h(i))) * big_g(i+1) * dt_sechiba
+
+                    x_3(i) = (k_eddy(i-1)/(delta_z(i-1)*delta_h(i))) * dt_sechiba
+
+                    x_4(i) = (k_eddy(i) * d_t(i+1) / (delta_z(i) * delta_h(i))) * dt_sechiba            &
+                         &  + ((k_eddy(i) * c_t(i+1)) / (delta_z(i) * delta_h(i))) * big_e(i+1) * dt_sechiba
+
+                    x_5(i) = + (dt_sechiba) / (delta_h(i) * big_r(i))
+
+                    ! -------------------------------------------------------------------
+
+                    y_1(i) = 1.0d0 - ( dt_sechiba* ( (a_q(i+1) * (k_eddy(i)/(delta_z(i)*delta_h(i))))   &
+                         &  - (k_eddy(i)/(delta_z(i)*delta_h(i)))                                      &
+                         &  - (k_eddy(i-1)/(delta_z(i-1)*delta_h(i)))                                  &
+                         &  - ((1.0d0)/(big_r_prime(i)*delta_h(i)))))                                  &
+                         &  - ((k_eddy(i) * c_q(i+1)) / (delta_z(i)*delta_h(i))) * big_e(i+1) * dt_sechiba
+
+                    y_2(i) = q_a_pres(i) +                                                           &
+                         & ((b_q(i+1) * k_eddy(i) * dt_sechiba)/(delta_z(i) * delta_h(i)))                &
+                         & + (jbeta(i) * dt_sechiba)  / (big_r_prime(i)*delta_h(i))                       &
+                         & + ((k_eddy(i) * c_q(i+1)) / (delta_z(i) * delta_h(i))) * big_g(i+1) * dt_sechiba
+
+                    y_3(i) = (k_eddy(i-1)/(delta_z(i-1)*delta_h(i))) * dt_sechiba
+
+                    y_4(i) = (k_eddy(i) * d_q(i+1) / (delta_z(i) * delta_h(i))) * dt_sechiba            &
+                         &  + ((k_eddy(i) * c_q(i+1)) / (delta_z(i) * delta_h(i))) * big_f(i+1) * dt_sechiba
+
+                    y_5(i) = + (jalpha(i) * dt_sechiba) / (delta_h(i) * big_r_prime(i))
+
+                    ! -------------------------------------------------------------------
+
+                    a_t(i) = x_3(i) / (x_1(i) - (x_4(i) * (y_4(i) / y_1(i))))
+                    b_t(i) = ( x_2(i) + (x_4(i) * (y_2(i)/y_1(i))) )  /        &
+                         & (x_1(i) - (x_4(i) *(y_4(i)/y_1(i))))
+                    c_t(i) = ( (x_4(i) * (y_5(i)/y_1(i))) + x_5(i)) /          &
+                         & (x_1(i) - (x_4(i)*(y_4(i)/y_1(i))))
+                    d_t(i) = ( x_4(i) * (y_3(i)/y_1(i))  )   /                 &
+                         & (x_1(i) - (x_4(i) * (y_4(i) / y_1(i))))
+                    IF(printlev_loc >= 4) THEN 
+                       WRITE(numout,*)'hydrol_flag FALSE'
+                       WRITE(numout,*)'a_t(i)', a_t(i)
+                       WRITE(numout,*)'b_t(i)', b_t(i)
+                    ENDIF
+                    ! -------------------------------------------------------------------
+
+                    a_q(i) = y_3(i) / (y_1(i) - (y_4(i) * (x_4(i) / x_1(i))))
+                    b_q(i) = ( y_2(i) + (y_4(i) * (x_2(i)/x_1(i))) )  /        &
+                         & (y_1(i) - (y_4(i) *(x_4(i)/x_1(i))))
+                    c_q(i) = ( (y_4(i) * (x_5(i)/x_1(i))) + y_5(i)) /          &
+                         & (y_1(i) - (y_4(i)*(x_4(i)/x_1(i))))
+                    d_q(i) = ( y_4(i) * (x_3(i)/x_1(i))  )   /                 &
+                         & (y_1(i) - (y_4(i) * (x_4(i) / x_1(i))))
+
+                    ! -------------------------------------------------------------------
+
+                    big_e_top(i) = (+(dt_sechiba*a_q(i)*chalev0*rau(ji))/                             &
+                         & (rho_veg*leaf_tks * pad_deltah(i)*delta_h(i)*big_r_prime(i)*jtheta(i)))  &
+                         & + ((dt_sechiba* d_t(i) * cp_air * rau(ji)) /                                &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i) * big_r(i) * jtheta(i)))   
+
+                    big_f_top(i) = ( + (dt_sechiba* a_t(i) * cp_air * rau(ji))/                       &
+                         & (rho_veg*leaf_tks * pad_deltah(i)* delta_h(i)                            &
+                         & * big_r(i) * jtheta(i)) )                                                &
+                         & + ((dt_sechiba* d_q(i) * chalev0 * rau(ji)) /                               &
+                         & (rho_veg*leaf_tks * pad_deltah(i) * delta_h(i)                           &
+                         & * big_r_prime(i) * jtheta(i)))
+
+                    big_g_top(i) = (t_l_pres(i)+dt_sechiba*eta_3(i)/                                  &
+                         & (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i)*jtheta(i))                    & 
+                         & + (eta_1(i)*lwdown(ji)*dt_sechiba)/                                         &
+                         & (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i)*jtheta(i))                    &
+                         & + (eta_4(i)*swdown(ji)*dt_sechiba)/                                         &
+                         & (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i)*jtheta(i))                    &
+                         & - (chalev0*rau(ji)*dt_sechiba*jbeta(i))/                                    &
+                         & (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i) *                             &
+                         &  big_r_prime(i)*jtheta(i))                                               &
+                         & + (dt_sechiba*cp_air*rau(ji)*b_t(i))/                                       &
+                         & (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i)*big_r(i)* jtheta(i))          &
+                         & + (dt_sechiba*chalev0*rau(ji)*b_q(i))/                                      &
+                         & (rho_veg*leaf_tks*pad_deltah(i)*delta_h(i)*                              &
+                         & big_r_prime(i)*jtheta(i)) )
+
+                    big_efg_bottom(i) =                                                            &
+                         & ( 1.0d0 + (dt_sechiba* jalpha(i) * chalev0 * rau(ji)) /                     &
+                         & (rho_veg *leaf_tks * pad_deltah(i) * delta_h(i) *                        &
+                         & big_r_prime(i) * jtheta(i))                                              &
+                         & + (dt_sechiba* cp_air * rau(ji)) /                                          &
+                         & (rho_veg *leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i) * big_r(i))  &
+                         & - (eta_2(i) * dt_sechiba) /                                                 &
+                         & (rho_veg*leaf_tks * pad_deltah(i)  * delta_h(i) * jtheta(i))             &
+                         & - (dt_sechiba* chalev0 * rau(ji) * c_q(i)) /                                & 
+                         & (rho_veg *leaf_tks* pad_deltah(i) * delta_h(i) * jtheta(i)               &
+                         & * big_r_prime(i))                                                        &
+                         & - (dt_sechiba* cp_air * rau(ji) * c_t(i))/                                  &
+                         & (rho_veg *leaf_tks * pad_deltah(i) * delta_h(i) * jtheta(i) * big_r(i)))
+
+                    big_e(i) = big_e_top(i) / big_efg_bottom(i)
+
+                    big_f(i) = big_f_top(i) / big_efg_bottom(i)
+
+                    big_g(i) = big_g_top(i) / big_efg_bottom(i)
+
+                 END IF ! (hydrol_flag)               
+                 ! -------------------------------------------------------------------
+
+              END DO !i = jnlvls-1, 2, -1
+
+
+
+              IF (hydrol_flag) THEN
+
+                 ! -------------------------------------------------------------------
+
+                 x_1(1) = 1.0d0 - dt_sechiba* ((a_t(2) * k_eddy(1)) / (delta_z(1) * delta_h(1))     &
+                      &  +  (k_eddy(1) * c_t(2) * big_f(2)) / (delta_z(1) * delta_h(1))       &
+                      &  -  (k_eddy(1)/ (delta_z(1) * delta_h(1)))                            &
+                      &  -  ( 1.0d0 / (delta_h(1) * big_r(1))) )
+
+                 x_2(1) = t_a_pres(1)+dt_sechiba*(  (k_eddy(1) * b_t(2))/(delta_z(1) * delta_h(1))  &
+                      &   +  (k_eddy(1) * c_t(2) * big_g(2))/(delta_z(1) * delta_h(1)) )
+
+                 x_3(1) = dt_sechiba* (1.0d0 / delta_h(1)) * ( 1.0d0 / (rau(ji) * cp_air) )    
+
+                 x_4(1) = dt_sechiba* ( (k_eddy(1) * c_t(2) * big_e(2)) + (k_eddy(1) * d_t(2)) ) /  &
+                      & (delta_z(1) * delta_h(1)) 
+
+                 x_5(1) = + dt_sechiba* ( 1.0d0 / (delta_h(1) * big_r(1)) )
+
+                 ! -------------------------------------------------------------------
+
+                 y_1(1) = 1.0d0 - dt_sechiba* (    (a_q(2) * k_eddy(1)) / (delta_z(1)*delta_h(1))   &
+                      &  +  (k_eddy(1) * c_q(2) * big_e(2)) / (delta_z(1) * delta_h(1))       &
+                      &  -  (k_eddy(1) / (delta_z(1) * delta_h(1)))                           &
+                      &  -  ( 1.0d0 / (delta_h(1) * big_r_prime(1))) )
+
+                 y_2(1) = q_a_pres(1)+dt_sechiba*(  (k_eddy(1) * b_q(2))/(delta_z(1) * delta_h(1))  &
+                      &   +  (k_eddy(1) * c_q(2) * big_g(2))/(delta_z(1) * delta_h(1))        &
+                      &   + jbeta(1) / (delta_h(1) * big_r_prime(1)) )
+
+                 y_3(1) = dt_sechiba* (1.0d0 / delta_h(1)) * ( 1.0d0 / (rau(ji) * chalev0) )
+
+                 y_4(1) = dt_sechiba* ( (k_eddy(1)* c_q(2) * big_f(2)) + (k_eddy(1) * d_q(2)) ) /  &
+                      &   (delta_z(1) * delta_h(1)) 
+
+                 y_5(1) = + dt_sechiba* ( jalpha(1) / (delta_h(1) * big_r_prime(1)) )
+
+                 ! -------------------------------------------------------------------
+
+                 a_t(1) = x_3(1) / (x_1(1) - (x_4(1) * (y_4(1) / y_1(1))))
+                 b_t(1) = ( x_2(1) + (x_4(1) * (y_2(1)/y_1(1))) )  /         &
+                      & (x_1(1) - (x_4(1) *(y_4(1)/y_1(1))))
+                 c_t(1) = ( (x_4(1) * (y_5(1)/y_1(1))) + x_5(1)) /           &
+                      & (x_1(1) - (x_4(1)*(y_4(1)/y_1(1))))
+                 d_t(1) = ( x_4(1) * (y_3(1)/y_1(1))  )   /                  &
+                      & (x_1(1) - (x_4(1) * (y_4(1) / y_1(1))))
+                 IF(printlev_loc >= 4) THEN
+                    WRITE(numout,*)'hydrol_flag TRUE'
+                    WRITE(numout,*)'a_t(i)', a_t(i)
+                    WRITE(numout,*)'b_t(i)', b_t(i)
+                 ENDIF
+                 ! -------------------------------------------------------------------
+
+                 a_q(1) = y_3(1) / (y_1(1) - (y_4(1) * (x_4(1) / x_1(1))))
+                 b_q(1) = ( y_2(1) + (y_4(1) * (x_2(1)/x_1(1))) )  /         &
+                      & (y_1(1) - (y_4(1) *(x_4(1)/x_1(1))))
+                 c_q(1) = ( (y_4(1) * (x_5(1)/x_1(1))) + y_5(1)) /           & 
+                      & (y_1(1) - (y_4(1)*(x_4(1)/x_1(1))))
+                 d_q(1) = ( y_4(1) * (x_3(1)/x_1(1))  )   /                  &
+                      & (y_1(1) - (y_4(1) * (x_4(1) / x_1(1))))
+
+              ELSE ! following if not (hydrol_flag)
+
+                 x_1(1) = 1.0d0 - dt_sechiba* ((a_t(2) * k_eddy(1)) / (delta_z(1)*delta_h(1))       &
+                      &  +  (k_eddy(1) * c_t(2) * big_f(2)) / (delta_z(1) * delta_h(1))       &
+                      &  -  (k_eddy(1) / (delta_z(1) * delta_h(1)))                           &
+                      &  -  ( 1.0d0 / (delta_h(1) * big_r(1))) )
+
+                 x_2(1) = t_a_pres(1)+dt_sechiba*(  (k_eddy(1) * b_t(2))/(delta_z(1) * delta_h(1))  &
+                      &   +  (k_eddy(1) * c_t(2) * big_g(2))/(delta_z(1) * delta_h(1)) )
+
+                 x_3(1) = dt_sechiba* (1.0d0 / delta_h(1)) * ( 1.0d0 / (rau(ji) * cp_air) )    
+
+                 x_4(1) = dt_sechiba* ( (k_eddy(1) * c_t(2) * big_e(2)) + (k_eddy(1) * d_t(2)) ) /  &
+                      & (delta_z(1) * delta_h(1)) 
+
+                 x_5(1) = + dt_sechiba* ( 1.0d0 / (delta_h(1) * big_r(1)) )
+
+                 ! -------------------------------------------------------------------
+
+                 y_1(1) = 1.0d0 - dt_sechiba* (    (a_q(2) * k_eddy(1)) / (delta_z(1)*delta_h(1))   &
+                      &  +  (k_eddy(1) * c_q(2) * big_e(2)) / (delta_z(1) * delta_h(1))       &
+                      &  -  (k_eddy(1) / (delta_z(1) * delta_h(1)))                           &
+                      &  -  ( 1.0d0 / (delta_h(1) * big_r_prime(1))) )
+
+                 y_2(1) = q_a_pres(1)+dt_sechiba*(  (k_eddy(1) * b_q(2))/(delta_z(1) * delta_h(1))  &
+                      &   +  (k_eddy(1) * c_q(2) * big_g(2))/(delta_z(1) * delta_h(1))        &
+                      &   + jbeta(1) / (delta_h(1) * big_r_prime(1)) )
+
+                 y_3(1) = dt_sechiba* (1.0d0 / delta_h(1)) * ( 1.0d0 / (rau(ji) * chalev0) )
+
+                 y_4(1) = dt_sechiba* ( (k_eddy(1) * c_q(2) * big_f(2)) + (k_eddy(1) * d_q(2)) ) /  &
+                      &   (delta_z(1) * delta_h(1)) 
+
+                 y_5(1) = + dt_sechiba* ( jalpha(1) / (delta_h(1) * big_r_prime(1)) )
+
+                 ! -------------------------------------------------------------------
+
+                 a_t(1) = x_3(1) / (x_1(1) - (x_4(1) * (y_4(1) / y_1(1))))
+                 b_t(1) = ( x_2(1) + (x_4(1) * (y_2(1)/y_1(1))) )  /         &
+                      & (x_1(1) - (x_4(1) *(y_4(1)/y_1(1))))
+                 c_t(1) = ( (x_4(1) * (y_5(1)/y_1(1))) + x_5(1)) /           &
+                      & (x_1(1) - (x_4(1)*(y_4(1)/y_1(1))))
+                 d_t(1) = ( x_4(1) * (y_3(1)/y_1(1))  )   /                  &
+                      & (x_1(1) - (x_4(1) * (y_4(1) / y_1(1))))
+                 IF(printlev_loc >= 4) THEN
+                    WRITE(numout,*)'hydrol_flag FALSE'
+                    WRITE(numout,*)'a_t(i)', a_t(i)
+                    WRITE(numout,*)'b_t(i)', b_t(i)
+                 ENDIF
+                 ! -------------------------------------------------------------------
+
+                 a_q(1) = y_3(1) / (y_1(1) - (y_4(1) * (x_4(1) / x_1(1))))
+                 b_q(1) = ( y_2(1) + (y_4(1) * (x_2(1)/x_1(1))) )  /         &
+                      & (y_1(1) - (y_4(1) *(x_4(1)/x_1(1))))
+                 c_q(1) = ( (y_4(1) * (x_5(1)/x_1(1))) + y_5(1)) /           & 
+                      & (y_1(1) - (y_4(1)*(x_4(1)/x_1(1))))
+                 d_q(1) = ( y_4(1) * (x_3(1)/x_1(1))  )   /                  &
+                      & (y_1(1) - (y_4(1) * (x_4(1) / x_1(1))))
+
+                 ! -------------------------------------------------------------------
+
+              END IF ! (hydrol_flag)
+
+           END IF
+
+
+           big_e_top(1) = (+(dt_sechiba* a_q(1) * chalev0 * rau(ji)) /                              &
+                & (rho_veg *leaf_tks * pad_deltah(1) * delta_h(1) * jtheta(1) * big_r_prime(1)))   &
+                & +((dt_sechiba* d_t(1) * cp_air * rau(ji)) /                                         &
+                & (rho_veg*leaf_tks * pad_deltah(1) * delta_h(1) * jtheta(1) * big_r(1)) )   
+
+
+           big_f_top(1) = (+(dt_sechiba* a_t(1) * cp_air * rau(ji)) /                              &
+                & (rho_veg*leaf_tks * pad_deltah(1) * delta_h(1)* jtheta(1) * big_r(1)))          &
+                & + ((dt_sechiba* d_q(1) * chalev0 * rau(ji)) /                                      &
+                & (rho_veg*leaf_tks * pad_deltah(1) * delta_h(1) * jtheta(1) * big_r_prime(1)))
+
+
+           big_g_top(1) = (t_l_pres(1) + dt_sechiba* eta_3(1) /                                    &
+                & (rho_veg*leaf_tks * pad_deltah(1) * delta_h(1) * jtheta(1))                     & 
+                & + (eta_1(1) * lwdown(ji) * dt_sechiba)/                                            &
+                & (rho_veg *leaf_tks* pad_deltah(1) * delta_h(1) * jtheta(1))                     &
+                &  + (eta_4(1) * swdown(ji) * dt_sechiba)/                                           &
+                & (rho_veg *leaf_tks* pad_deltah(1) * delta_h(1) * jtheta(1))                     &
+                &  - (chalev0 * rau(ji) * dt_sechiba* jbeta(1))/                                     & 
+                & (rho_veg *leaf_tks* pad_deltah(1) * delta_h(1) * jtheta(1) * big_r_prime(1))    &
+                &  + (dt_sechiba* cp_air * rau(ji) * b_t(1)) /                                       &
+                & (rho_veg *leaf_tks* pad_deltah(1) * delta_h(1) * jtheta(1) * big_r(1))          &
+                &  + (dt_sechiba * chalev0 * rau(ji) * b_q(1)) /                                     &
+                & (rho_veg *leaf_tks * pad_deltah(1) * delta_h(1) * jtheta(1) * big_r_prime(1)))
+
+
+           big_efg_bottom(1) = ( 1.0d0 + (dt_sechiba *jalpha(1) * chalev0 * rau(ji))/              &
+                & (rho_veg *leaf_tks * pad_deltah(1) * delta_h(1) * jtheta(1) * big_r_prime(1) )  &
+                & + (dt_sechiba * cp_air * rau(ji)) /                                                &
+                & (rho_veg *leaf_tks * pad_deltah(1) * delta_h(1) * jtheta(1) * big_r(1))         &
+                & - (eta_2(1) * dt_sechiba) /                                                        &
+                                ! & - (0.0d0 * dt_sechiba) /                                                         &
+                & (rho_veg*leaf_tks * pad_deltah(1)  * delta_h(1) * jtheta(1))                    &
+                & - (dt_sechiba * chalev0 * rau(ji) * c_q(1)) /                                      &
+                & (rho_veg *leaf_tks * pad_deltah(1) * delta_h(1) * jtheta(1) * big_r_prime(1))   &
+                & - (dt_sechiba * cp_air * rau(ji) * c_t(1))/                                        &
+                & (rho_veg *leaf_tks * pad_deltah(1) * delta_h(1) * jtheta(1) * big_r(1)))
+
+
+           big_e(1) = big_e_top(1) / big_efg_bottom(1)
+
+           big_f(1) = big_f_top(1) / big_efg_bottom(1)
+
+           big_g(1) = big_g_top(1) / big_efg_bottom(1)    
+
+
+           ! --------------------------------------------------------------------------------------------------------------
+
+
+           IF (jnlvls .eq. 1) THEN
+              turb_factor = speed * q_cdrag(ji)         ! surface turbulence calculated as in existing ORCHIDEE
+           ELSE
+              turb_factor = u_speed(1) * q_cdrag(ji) * ks_tune    ! surface turbulence calculated as in existing ORCHIDEE
+           END IF
+
+
+
+           ! components for surface sensible heat flux    
+
+           big_omega_1 = 1.0d0 - (rau(ji) * 1.0d0) * turb_factor * &
+                & (a_t(1) + c_t(1) * big_f(1)) 
+
+           big_omega_2 = + (rau(ji) * cp_air) * turb_factor * &
+                & (b_t(1) + c_t(1) * big_g(1))
+
+           big_omega_3 = - rau(ji) * cp_air * turb_factor   
+
+           big_omega_4 = + rau(ji) * cp_air * turb_factor * &
+                & (c_t(1) * big_e(1) + d_t(1))
+
+
+
+           ! components for surface latent heat flux (evaporation)
+
+           big_omega_5 = 1.0d0 - (rau(ji) * 1.0d0) * turb_factor  * & 
+                & (a_q(1) + c_q(1) * big_e(1)) 
+
+           big_omega_6 = + (rau(ji) * chalev0) * turb_factor  * &
+                & (b_q(1) + c_q(1) * big_g(1) - jbeta_surf(ji) )
+
+           big_omega_7 = - jalpha_surf(ji) * rau(ji) * chalev0 * turb_factor 
+
+           big_omega_8 = + rau(ji) * chalev0 * turb_factor  * &
+                & (c_q(1) * big_f(1) + d_q(1))
+
+
+           ! components for surface latent heat flux (sublimination)
+
+           big_omega_5_sub = 1.0d0 - (rau(ji) * 1.0d0) * turb_factor* & 
+                & (a_q(1) + c_q(1) * big_e(1)) 
+
+           big_omega_6_sub = + (rau(ji) * chalsu0) * turb_factor * &
+                & (b_q(1) + c_q(1) * big_g(1) - jbeta_surf(ji) )
+
+           big_omega_7_sub = - jalpha_surf(ji) * rau(ji) * chalsu0 * turb_factor  
+
+           big_omega_8_sub = + rau(ji) * chalsu0 * turb_factor *  &
+                & (c_q(1) * big_f(1) + d_q(1))
+
+
+           ! --------------------------------------------------------------------------------------------------------------
+
+           xi_1 = ( big_omega_2 + (big_omega_4/big_omega_5) * big_omega_6 )  / &
+                &  ( big_omega_1 - (big_omega_4/big_omega_5) * big_omega_8 )
+
+           xi_2 = ( big_omega_3 + (big_omega_4/big_omega_5) * big_omega_7 )  / &
+                &  ( big_omega_1 - (big_omega_4/big_omega_5) * big_omega_8 )
+
+           !+++++++++++++++++++++++++++++++++++++++++++++++++++++
+           ! Here we try to paramterize the surface evaporation  
+           ! with the combination of the vebta3, vbeta4, ks_slope, ks_veget
+           ! and other variables such as pgap(=1-veget), day of growth etc  
+           ! air_temperature as an indicator to account 
+           ! seasonal grass leaf-fall at forest floor     
+           !+++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+           !+++CHECK+++
+           ! veget and vbeta3 have a PFT-dimension. How should this dimension be accounted for?
+           ! Set up a S-shape function (from 0 to 1) based on the site dependent vegetation cover fraction  
+           ! for the calculation of the weighting for vebta3 or vbeta4  
+           ! paramteriziation the surface evapotranspiration coefficient for the boundary condition for the 
+           ! multilayer scheme
+           ks_weight_1(ji) = 1.0_r_std / (1.0_r_std + EXP (-ks_slope * SUM((veget(ji,:)) - ks_veget) )) 
+           ks_weight_2(ji) = 1.0_r_std - ks_weight_1(ji) 
+           !++++++++++++
+
+           ! Add a conditional rule to consider the temperature constrain the growing season
+           ! of forest floor when the vegetation cover below certain threshood or critiria             
+           ! "ks_veget" and longterm average temperature below certain value (15oC) 
+           ! the grass was assume to be reduced having little contribution on total evapotraspiration.  
+           !IF ( veget(ji,jv) .LT. ks_veget) THEN
+           !	 ks_weight_1(ji) = 1.0_r_std / (((1.0_r_std + abs( t2m_month_out(ji) - 288.15)/15.) ) +  & 
+           !				 &               EXP (-ks_slope *(veget(ji,jv) - ks_veget) ))
+           !	 ks_weight_2(ji) = 1.0_r_std - ks_weight_1(ji)  
+
+           !ENDIF     
+
+           !+++CHECK++++
+           ! veget and vbeta3 have a PFT-dimension. How should this dimension be accounted for? vbeta3 is the 
+           ! vbeta for each PFT. Use a the analogy of a parallel electric circuit to calculate the total vbeta3 
+           ! for the pixel. 
+           vbeta3_pixel = zero
+           DO jv = 1,nvm
+              IF (vbeta3(ji,jv).GT.min_sechiba) THEN
+                 vbeta3_pixel = vbeta3_pixel + 1/vbeta3(ji,jv)
+              ENDIF
+           ENDDO
+
+           ! Calculate the total weighting coefficient both from vbeta4 and vbeta3
+           IF (vbeta3_pixel.GT.min_sechiba) THEN
+              evap_fraction(ji) =  (  ks_weight_1(ji) * vbeta4(ji) & 
+                   &  + ks_weight_2(ji) * (1/vbeta3_pixel) )
+           ELSE
+              evap_fraction(ji) =  ks_weight_1(ji) * vbeta4(ji)
+           ENDIF
+           !+++++++++++++
+
+           ! evap_fraction(ji) =  vbeta3(ji,jv) 
+           ! set up a upper limited for the potential evapotranspiration rate 
+           ! thus if the veget ~1.0, there is little forest floor evapotranspiration   
+           IF  ( evap_fraction(ji) .GT. 1.0_r_std ) THEN
+              evap_fraction(ji) =  1.0_r_std
+           ENDIF
+
+
+           ! set a lowerbound/miinum of evapofraction, as we tune this parameter 
+           ! IF (evap_fraction(ji) .LT.  0.01_r_std) THEN
+           !     evap_fraction(ji) = 0.01_r_std
+           ! ENDIF
+
+           ! We still need to add some parmeters from the  phenology for the
+           ! decedious forest type.
+           ! IF the is decidious tree.....
+           ! evapo_fraction(ji) = f(day start to growth, vb3, vb4)
+           !
+
+           IF (printlev_loc>=4) THEN
+
+              WRITE (numout, '(A40,F10.5)') 'veget_fraction:', veget(test_grid, test_pft) 
+              WRITE (numout, '(A40,F10.5)') 'beta3:', vbeta3(test_grid, test_pft)
+              WRITE (numout, '(A40,F10.5)') 'beta4:', vbeta4(ji)
+              WRITE (numout, '(A40,F10.5)') 'ks_weight_1:', ks_weight_1(ji)
+              WRITE (numout, '(A40,F10.5)') 'ks_weight_2:', ks_weight_2(ji)
+              WRITE (numout, '(A40,F10.5)') 'ks_tune:', ks_tune
+              WRITE (numout, '(A40,F10.5)') 'forest_floor_evapo_fraction:', evap_fraction(ji)
+              !WRITE (numout, '(A40,F10.5)') 'longterm_temperature:', t2m_month_out(test_grid)
+              !+++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+           END IF ! (printlev_loc>=4) THEN
+
+
+           IF (.NOT. ok_impose_can_structure) THEN
+
+              xi_3 = evap_fraction(ji)  *                                                 &
+                   & ( big_omega_6 + (big_omega_8/big_omega_1) * big_omega_2 ) /         &
+                   & ( big_omega_5 - (big_omega_8/big_omega_1) * big_omega_4 )  +        &
+                   & beta_diffuco_sub(ji) *                                              &
+                   & ( big_omega_6_sub + (big_omega_8_sub/big_omega_1) * big_omega_2 ) / &
+                   & ( big_omega_5_sub - (big_omega_8_sub/big_omega_1) * big_omega_4 ) 
+
+              xi_4 = evap_fraction(ji) *                                                  &
+                   & ( big_omega_7 + (big_omega_8/big_omega_1) * big_omega_3 ) /         &
+                   &  ( big_omega_5 - (big_omega_8/big_omega_1) * big_omega_4 ) +        &
+                   & beta_diffuco_sub(ji) *                                              &
+                   & ( big_omega_7_sub + (big_omega_8_sub/big_omega_1) * big_omega_3 ) / &
+                   &  ( big_omega_5_sub - (big_omega_8_sub/big_omega_1) * big_omega_4 ) 
+
+           ELSE
+
+              xi_3 = beta_diffuco_evap(ji)  *                                             &
+                   & ( big_omega_6 + (big_omega_8/big_omega_1) * big_omega_2 ) /         &
+                   & ( big_omega_5 - (big_omega_8/big_omega_1) * big_omega_4 )  +        &
+                   & beta_diffuco_sub(ji) *                                              &
+                   & ( big_omega_6_sub + (big_omega_8_sub/big_omega_1) * big_omega_2 ) / &
+                   & ( big_omega_5_sub - (big_omega_8_sub/big_omega_1) * big_omega_4 ) 
+
+              xi_4 = beta_diffuco_evap(ji) *                                              &
+                   & ( big_omega_7 + (big_omega_8/big_omega_1) * big_omega_3 ) /         &
+                   &  ( big_omega_5 - (big_omega_8/big_omega_1) * big_omega_4 ) +        &
+                   & beta_diffuco_sub(ji) *                                              &
+                   & ( big_omega_7_sub + (big_omega_8_sub/big_omega_1) * big_omega_3 ) / &
+                   &  ( big_omega_5_sub - (big_omega_8_sub/big_omega_1) * big_omega_4 )     
+
+           END IF ! (ok_impose_can_structure)
+
+           IF (printlev_loc>=4) THEN
+
+              WRITE (numout, *) 'prior to temp_surf_next'
+              WRITE (numout, *) 'psold(ji)/cp_air:', psold(ji)/cp_air
+              WRITE (numout, *) 'dt_sechiba:', dt_sechiba
+              WRITE (numout, *) '(dt_sechiba/soilcap(ji)):', (dt_sechiba/soilcap(ji))
+              WRITE (numout, *) 'xi_1:', xi_1
+              WRITE (numout, *) 'xi_2:', xi_2
+              WRITE (numout, *) 'xi_3:', xi_3
+              WRITE (numout, *) 'xi_4:', xi_4
+
+              WRITE (numout, *) 'eta_1_surf*lwdown(ji):', eta_1_surf*lwdown(ji)
+              WRITE (numout, *) 'eta_2_surf:', eta_2_surf
+              WRITE (numout, *) 'eta_3_surf:', eta_3_surf
+              WRITE (numout, *) 'eta_4_surf:', eta_4_surf
+              WRITE (numout, *) 'swnet(ji):', swnet(ji)
+              WRITE (numout, *) 'swdown(ji):', swdown(ji)
+              WRITE (numout, *) 'eta_4_surf*swnet(ji):', eta_4_surf*swdown(ji)
+
+              WRITE (numout, *) 'soilflx(ji):', soilflx(ji)
+
+              WRITE (numout, *) 'x_1(1), x_2(1), x_3(1), x_4(1), x_5(1):', x_1(1), x_2(1), x_3(1), x_4(1), x_5(1)
+              WRITE (numout, *) 'y_1(1), y_2(1), y_3(1), y_4(1), y_5(1):', y_1(1), y_2(1), y_3(1), y_4(1), y_5(1)
+
+              WRITE (numout, *) 'a_t(1), b_t(1), c_t(1), d_t(1):', a_t(1), b_t(1), c_t(1), d_t(1)
+              WRITE (numout, *) 'a_q(1), b_q(1), c_q(1), d_q(1):', a_q(1), b_q(1), c_q(1), d_q(1)
+
+              WRITE (numout, *) 'a_t(jnlvls), b_t(jnlvls), c_t(jnlvls), d_t(jnlvls):', a_t(1), b_t(1), c_t(1), d_t(1)
+              WRITE (numout, *) 'a_q(jnlvls), b_q(jnlvls), c_q(jnlvls), d_q(jnlvls):', a_q(1), b_q(1), c_q(1), d_q(1)
+
+              WRITE (numout, *) 'big_r_prime(1): ', big_r_prime(1)
+
+              WRITE (numout, *) 'big_omega_1, big_omega_2: ', big_omega_1, big_omega_2
+              WRITE (numout, *) 'big_omega_3, big_omega_4: ', big_omega_3, big_omega_4
+              WRITE (numout, *) 'big_omega_5, big_omega_6: ', big_omega_5, big_omega_6
+              WRITE (numout, *) 'big_omega_7, big_omega_8: ', big_omega_7, big_omega_8
+
+              WRITE (numout, *) 'big_e(1), big_f(1), big_g(1): ', big_e(1), big_f(1), big_g(1)
+
+           END IF ! (printlev_loc>=4)
+
+           temp_surf_next = ( psold(ji)/cp_air  + (dt_sechiba/soilcap(ji)) * ( xi_1 + xi_3   &
+                & + eta_1_surf*lwdown(ji)                                  &
+                & + eta_4_surf*swdown(ji)                                  &
+                & - eta_3_surf + soilflx(ji)) ) /                          &
+                & ( 1.0d0 - (xi_2 + xi_4 + eta_2_surf) * (dt_sechiba/soilcap(ji)))
+
+           temp_sol_new(ji) = temp_surf_next
+
+
+           psnew(ji) = temp_surf_next * cp_air
+
+           qsol_sat_new(ji) = qsol_sat(ji) + &
+                &  (1.0d0/(cp_air)) * pdqsold(ji) * &
+                &  (psnew(ji) - psold(ji))
+
+
+           delta_temp = temp_surf_next - psold(ji)/cp_air
+
+           epot_air_new(ji) = (1.0d0/( rau(ji) * speed * q_cdrag(ji))) *                 &
+                & (cp_air * b_t(1) - psold(ji) - cp_air * delta_temp) /          &
+                & ((1.0d0/( rau(ji) * speed * q_cdrag(ji))) - a_t(1) ) +         &
+                & cp_air * temp_surf_next
+
+           IF (printlev_loc>=4) THEN
+              WRITE (numout,*) 'temp_surf_next:', temp_surf_next
+              WRITE (numout,*) 'psold and psnew:', psold,psnew
+              WRITE (numout,*) 'q_cdrag:', q_cdrag
+              WRITE (numout,*) 'speed:', speed
+              WRITE (numout,*) 'delta_temp:', delta_temp
+              WRITE (numout,*) 'rau:', rau
+              WRITE (numout,*) 'cp_air:', cp_air
+           ENDIF ! (printlev_loc=>4)   
+           ! section modified from enerbil_flux
+
+           !! \latexonly 
+           !!     \input{enerbilsurftemp17.tex}
+           !! \endlatexonly
+
+           fevap = (chalev0 * beta_diffuco_evap(ji) +                                         &
+                & chalsu0 * beta_diffuco_sub(ji)) * ((b_q(1) - qsol_sat(ji)) /             &
+                & ((1.0d0/(rau(ji)*speed*q_cdrag(ji))) - a_q(1) ) )                        &
+                & - (chalev0 * beta_diffuco_evap(ji) + chalsu0 * beta_diffuco_sub(ji))     &
+                & * ((pdqsold(ji)/cp_air) /                                                &
+                & ((1.0d0/(rau(ji)*speed*q_cdrag(ji))) - a_q(1) )  )  *                    &
+                & (cp_air*temp_surf_next - psold(ji))
+
+
+           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) = (1.0d0/( rau(ji) * speed * q_cdrag(ji))) * un / &
+                   & ( chalsu0 *  vbeta1(ji) * (un - vbeta5(ji)) + &
+                   & chalev0 * ((un - vbeta1(ji))*(un - vbeta5(ji)) * vbeta(ji) * 1.0d0 + vbeta5(ji)) ) &
+                   & * fevap + qsol_sat_new(ji)  
+           ENDIF ! (ABS(fevap) < EPSILON(un))
+           IF(printlev_loc >= 4)THEN
+              WRITE(numout,*)'Why is qair_new the same as qsol_sat_new?'
+              WRITE(numout,*)'first term', 1.0d0/( rau(ji) * speed * q_cdrag(ji))  
+              WRITE(numout,*)'vbeta',vbeta(ji)
+              WRITE(numout,*)'vbeta1',vbeta1(ji)
+              WRITE(numout,*)'vbeta5',vbeta5(ji)
+              WRITE(numout,*)'chalev0',chalev0
+              WRITE(numout,*)'chalsu0',chalsu0
+              WRITE(numout,*)'fevap',fevap
+              WRITE(numout,*)'qair_new(ji)',qair_new(ji)
+           ENDIF
+
+           ! Calculate new series of beta_v3
+
+           IF (hydrol_flag) THEN  ! overall hydrol flag
+              ! vbeta2sum(:) = zero
+              IF (hydrol_flag2(ji)) THEN
+                 DO jv = 1, nvm
+                    IF (.NOT. hydrol_flag3(ji, jv)) THEN 
+                       ! this is for cases when the supply term is higher than the 
+                       !     transpiration) - i.e. the normal state of affairs
+                       ! WRITE(numout,*) '201013 vbeta3(ji,jv) is unchanged as: ', vbeta3(ji,jv)
+                    ELSE
+                       ! WRITE(numout,*) '261113 vbeta3(ji,jv) is originally: ', vbeta3(ji,jv)
+                       IF(printlev_loc >= 4) THEN
+                          WRITE(numout,*)'dt_sechiba',dt_sechiba
+                          WRITE(numout,*)'vbeta1',vbeta1(ji)
+                          WRITE(numout,*)'qsol_sat_new',qsol_sat_new(ji)
+                          WRITE(numout,*)'qair_new',qair_new(ji)
+                          WRITE(numout,*)'rau',rau(ji)
+                          WRITE(numout,*)'speed',speed
+                          WRITE(numout,*)'q_cdrag',q_cdrag(ji)
+                       ENDIF
+                       !+++CHECK+++
+                       ! The if-statement was added to prevent crashes
+                       ! Check whether it makes sense that vbeta3 = 0 when 
+                       ! vbeta1 = 1
+                       IF ( (vbeta1(ji) .NE. 1.0d0) .AND. &
+                            & (qsol_sat_new(ji) .NE. qair_new(ji)) ) THEN
+                          vbeta3(ji,jv) = ( veget_max(ji,jv)* E_supply(ji,jv) ) / &
+                               & ( dt_sechiba * (1.0d0 - vbeta1(ji)) * (qsol_sat_new(ji) - qair_new(ji)) * &
+                               & ( rau(ji) * speed * q_cdrag(ji)) )
+                       ELSE
+                          vbeta3(ji,jv) = zero
+                       ENDIF
+                       !+++++++++++
+                       ! WRITE(numout,*) '261113 new vbeta3(ji,jv) is: ', vbeta3(ji,jv)    
+                    END IF ! (hydrol_flag3(ji, jv) .eq. .FALSE.)
+                 ENDDO ! jv = 1, nvm
+              ELSE
+                 ! do nothing
+              END IF ! (hydrol_flag2(ji) .eq. .TRUE.)        
+           END IF ! IF (hydrol_flag .eq. .TRUE.)       
+
+           ! end 281013 calculate new series of beta_v3 
+
+           IF (hydrol_flag) THEN
+              ! We aim to calculate a new delta_temp using the new vbeta3
+           ELSE
+              ! in non-hydrol interface case (the first call to the energy budget in the sechiba cycle,
+              !     we can exit this loop straightaway)
+              EXIT convergence_loop 
+           END IF
+
+
+           !++++ copy the current step in convergence loop for checking the error ++++++ 
+           temp_sol_dummy2 = temp_surf_next
+           !+++++++++++++++++++++++
+
+           temp_sol_err = abs(temp_sol_dummy2 - temp_sol_dummy1) 
+           ! print out the absolute error
+!!$                 WRITE(numout, '(A40,ES18.6)') "120615 Absolute Error:", temp_sol_err
+
+           !+++++++ set a critiria then we exit the loop +++++
+           !IF ( temp_sol_error .LT. epsilon_err ) THEN
+           !    EXIT convergence_loop 
+           !ENDIF    
+           !++++++++++++++++++++++++++++++++++++++++++++++++++
+        END DO convergence_loop
+        ! $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$  end convergence loop here  $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+
+
+        flux_ground_h = - (xi_1 + (xi_2 * temp_surf_next))
+        flux_ground_le = - (xi_3 + (xi_4 * temp_surf_next))   
+
+        ! work up the column for atmospheric temperature and humidity, and 
+        !    vegetation temperature 
+
+        t_l_next(1) = big_e(1) * (flux_ground_le) + big_f(1) * (flux_ground_h) + big_g(1)
+
+        t_a_next(1) = (a_t(1) * (flux_ground_h)) + b_t(1) + &
+             & (c_t(1) * t_l_next(1)) + (d_t(1) * (flux_ground_le)) 
+
+        q_a_next(1) = (a_q(1) * (flux_ground_le)) + b_q(1) + &
+             & (c_q(1) * t_l_next(1)) + (d_q(1) * (flux_ground_h)) 
+
+        IF (jnlvls .gt. 1) THEN    
+           DO i = 2, jnlvls
+              t_l_next(i) = (big_e(i) * q_a_next(i-1)) + &
+                   & (big_f(i) * t_a_next(i-1)) + big_g(i)
+
+              t_a_next(i) = (a_t(i) * t_a_next(i-1)) + b_t(i) + &
+                   & (c_t(i) * t_l_next(i)) + (d_t(i) * q_a_next(i-1))
+
+              q_a_next(i) = (a_q(i) * q_a_next(i-1)) + b_q(i) + &
+                   & (c_q(i) * t_l_next(i)) + (d_q(i) * t_a_next(i-1))
+           END DO ! i = 1, jnlvls
+        END IF ! (jnlvls .gt. 1) THEN
+
+        t_a_next_grid(ji, :) = t_a_next(:)
+
+        q_a_next_grid(ji, :) = q_a_next(:)
+
+        temp_leaf_next_grid(ji, :) = t_l_next(:)
+
+        column_qsatt_leaf(:) = t_l_next(:) * jalpha(:) + jbeta(:)
+
+        ! the lowest level flux is always the flux from the ground
+        ! n.b. sign convention: positive flux is the flow of heat from high temperature to low
+        !   temperature or from high humidity to low humidity respectably
+
+        flux_h(1) = flux_ground_h
+        flux_le(1) = flux_ground_le
+
+
+        IF (jnlvls .gt. 1) THEN
+           DO i = 2, jnlvls
+              flux_h(i) = - cp_air * rau(ji) * &
+                   & (t_a_next(i) - t_a_next(i-1)) * k_eddy(i-1)/delta_z(i-1)
+              flux_le(i) = - chalev0 * rau(ji) * &
+                   & (q_a_next(i) - q_a_next(i-1)) * k_eddy(i-1)/delta_z(i-1)
+           END DO ! i = 2, jnlvls
+        END IF !  (jnlvls .eq. 1) THEN   
+
+
+        flux_h_grid(ji,  :) = flux_h(:)
+        flux_le_grid(ji, :) = flux_le(:)
+        u_speed_grid(ji, :) = u_speed(:) ! Although the u_speed is not directly in jcala (from mleb_profile)  
+        ! here, we save the wind profile for each grid.  
+
+        IF (.NOT. ok_impose_can_structure) THEN 
+
+           DO i = 11, 20 ! 090215 calculate provisional column values of q_surf_leaf
+              !  column_q_surf_leaf(i) = vbeta1(ji) * ( ( 1.0d0 - vbeta5(ji)) + vbeta5(ji) ) * column_qsatt_leaf(i) + &
+              !                         &  (1.0d0 - vbeta1(ji)) * (1.0d0 - vbeta5(ji)) * (vbeta4(ji) + vbeta2sum(ji) + &
+              !                         &  vbeta3sum(ji)) * column_qsatt_leaf(i)
+              !aslacolumn_q_surf_leaf(i) = profile_vbeta3(ji,jv,(i-10)) * column_qsatt_leaf(i)
+              !aslacolumn_q_surf_leaf(i) = MAX(column_q_surf_leaf(i), q_a_next(i))
+           END DO ! i = 1, jnlvls
+
+        END IF ! (ok_impose_can_structure) THEN 
+
+
+        ! Calculation of the net shortwave & longwave radiation
+        ! short-wave radiation term can be calculated from eta4 
+        ! loing-wave radiation tern can be calculated from eta1 to eta3   
+
+        DO i =1, jnlvls
+
+           IF (i .EQ. 1) THEN
+              ! IF (i .eq.1) which means that the surface layer net radiation term shoudle be equals 
+              ! (LE + H + G) + (h_horizontal + le_horizontal)    
+              ! note the sign of eta_3 is not the same for surface and leave layer balance calculation
+              ! here, the longwave and shortwave were separated according to eta1, eta2, eta3 and eta4 
+              flux_netsw(i) = eta_4_surf*swdown(ji) 
+              flux_netsw(i) = flux_netsw(i) + (eta_4(i) * swdown(ji))
+
+              flux_netlw(i) = eta_1_surf*lwdown(ji) + (eta_2_surf * temp_surf_next) - eta_3_surf 
+              flux_netlw(i) = flux_netlw(i) + (eta_1(i) * lwdown(ji)) + (eta_2(i)*t_l_next(i)) +  eta_3(i) 
+           ELSE IF (i .EQ. jnlvls) THEN
+              flux_netsw(i) =  swnet(ji) 
+              flux_netlw(i) =  lwdown(ji) - lwup(ji) 
+           ELSE
+              ! For Other layers, 
+              ! the net rdiation can be calculated as the summation of leave layer energy balance (hrizontal terms) and 
+              ! previous layer netradiation term (vertical term)  
+              ! here, the longwave and shortwave were separated according to eta1, eta2, eta3 and eta4 
+              flux_netsw(i) =  (eta_4(i) * swdown(ji)) + flux_netsw(i-1)                         
+              flux_netlw(i) =  (eta_1(i) * lwdown(ji)) + (eta_2(i)*t_l_next(i)) +  eta_3(i)  +  flux_netlw(i-1) 
+           ENDIF
+
+           flux_netrad(i) = flux_netsw(i) + flux_netlw(i) - soilflx(ji)                                 
+
+        ENDDO
+
+        !+++++++++++++++++++++++++++++++++++++++++
+
+        flux_rn_grid(ji, :) = flux_netrad(:)
+        flux_h_grid(ji, :)  = flux_h(:)
+        flux_le_grid(ji, :) = flux_le(:)
+
+        fluxsens(ji) = flux_h(jnlvls)
+        fluxlat(ji) = flux_le(jnlvls)  
+
+        IF (.NOT. ok_impose_can_structure) THEN 
+           DO i = 1, jnlvls ! 090215 calculate relhum of air
+              column_air_relhum(i) = (  (column_q_surf_leaf(i) * pb(ji)) / (tetens_1 + column_q_surf_leaf(i) * tetens_2)   )  / &
+                   & ( (column_qsatt_leaf(i) * pb(ji)) / (tetens_1 + column_qsatt_leaf(i) * tetens_2) )
+           END DO ! i = 1, jnlvls
+        END IF ! (ok_impose_can_structure) THEN 
+
+
+
+        IF (printlev_loc>=4) THEN
+
+           WRITE (numout,*) 'balance test delta temp: ', temp_surf_next - (psold(ji)/cp_air)
+
+           WRITE (numout,*) 'balance test fluxes sum: ', (-flux_h(1) - flux_le(1) + &
+                & eta_1_surf*lwdown(ji) + eta_4_surf*swdown(ji) + eta_3_surf + soilflx(ji)   &
+                & + eta_2_surf * temp_surf_next) &
+                & * (dt_sechiba/soilcap(ji))
+
+           WRITE (numout,*) 'balance test delta temp / (dt_sechiba/soilcap(ji): ', &
+                & (temp_surf_next - (psold(ji)/cp_air)) / (dt_sechiba/soilcap(ji))
+
+           WRITE (numout,*) 'balance test fluxes sum: ', -flux_h(1) - flux_le(1) + &
+                & eta_1_surf*lwdown(ji) + eta_4_surf*swdown(ji) + soilflx(ji)   &
+                & + (eta_2_surf * temp_surf_next) - eta_3_surf
+
+           WRITE (numout,*) 'total balance test: ', &
+                & (temp_surf_next - (psold(ji)/cp_air)) / (dt_sechiba/soilcap(ji)) - &
+                & (-flux_h(1) - flux_le(1) + &
+                & eta_1_surf*lwdown(ji) + eta_4_surf*swdown(ji) + soilflx(ji)   &
+                & + (eta_2_surf * temp_surf_next) - eta_3_surf)
+
+           WRITE (numout,*) 'balance test flux_h(1): ', flux_h(1)
+           WRITE (numout,*) 'balance test flux_le(1): ', flux_le(1)
+           WRITE (numout,*) 'balance test eta_1_surf*lwdown(ji): ', eta_1_surf*lwdown(ji)
+           WRITE (numout,*) 'balance test eta_1_surf', eta_1_surf
+           WRITE (numout,*) 'balance test lwdown', lwdown(ji)
+           WRITE (numout,*) 'balance test eta_2_surf * temp_surf_next: ', eta_2_surf * temp_surf_next
+           WRITE (numout,*) 'balance test eta_3_surf: ', eta_3_surf
+           WRITE (numout,*) 'balance test eta_4_surf*swdown(ji): ', eta_4_surf*swdown(ji)
+           WRITE (numout,*) 'balance test soilflx(ji): ', soilflx(ji)
+
+        END IF !(printlev_loc>=4) 
+
+
+        source_sink_t(1) = cp_air * rau(ji) * &
+             & ((t_a_next(1) - t_a_pres(1)) * delta_h(1)) / dt_sechiba
+
+        source_sink_q(1) = chalev0 * rau(ji) * &
+             & ((q_a_next(1) - q_a_pres(1)) * delta_h(1)) / dt_sechiba
+
+        source_sink_t_l(1) = ((t_l_next(1) - t_l_pres(1)) * delta_h(1)) / dt_sechiba
+
+        horiz_flux_t(1) = (t_l_next(1) - t_a_next(1))/big_r(1) * cp_air * rau(ji) 
+
+        horiz_flux_q(1) = (((jalpha(1) * t_l_next(1) + jbeta(1)) - q_a_next(1))/ &
+             & big_r_prime(1)) * chalev0 * rau(ji)
+
+        IF (jnlvls .gt. 1) THEN
+           DO i = 2, jnlvls
+
+              source_sink_t(i) = cp_air * rau(ji) * &
+                   & ((t_a_next(i) - t_a_pres(i)) * delta_h(i)) / dt_sechiba
+              source_sink_q(i) = chalev0 * rau(ji) * &
+                   & ((q_a_next(i) - q_a_pres(i)) * delta_h(i)) / dt_sechiba
+
+              source_sink_t_l(i) = ((t_l_next(i) - t_l_pres(i)) * delta_h(i)) / dt_sechiba
+
+              horiz_flux_t(i) = (t_l_next(i) - t_a_next(i))/big_r(i) * cp_air * rau(ji) 
+
+              !    IF (.NOT. ok_impose_can_structure) THEN
+              !        horiz_flux_q(i) = phi_trans(i)
+              !    ELSE
+              horiz_flux_q(i) = (((jalpha(i) * t_l_next(i) + jbeta(i)) - q_a_next(i))/ &
+                   & big_r_prime(i)) * chalev0 * rau(ji)
+              !    END IF 
+
+           END DO ! i = 1, jnlvls
+        END IF ! (jnlvls .gt. 1) THEN
+
+        IF (jnlvls .gt. 1) THEN  
+
+           delta_t_a(1) = cp_air * rau(ji) * ((t_a_next(1) - t_a_pres(1)) &
+                & * delta_h(1)) / dt_sechiba
+           sum_flux_a(1) = - flux_h(1+1) + ( flux_h(1) + horiz_flux_t(1) )
+
+           delta_q_a(1) = chalev0 * rau(ji) * &
+                & ((q_a_next(1) - q_a_pres(1)) * delta_h(1)) / &
+                & dt_sechiba
+
+           sum_flux_q_a(1) = - flux_le(1+1) + ( flux_le(1) + horiz_flux_q(1) )
+
+           DO i = 2, jnlvls-1
+              delta_t_a(i) = cp_air * rau(ji) * ((t_a_next(i) - t_a_pres(i)) &
+                   & * delta_h(i)) / dt_sechiba
+              sum_flux_a(i) = - flux_h(i+1) + ( flux_h(i) + horiz_flux_t(i) )
+           END DO ! i = 1, jnlvls-1
+
+           DO i = 2, jnlvls-1
+              delta_q_a(i) = chalev0 * rau(ji) * &
+                   & ((q_a_next(i) - q_a_pres(i)) * delta_h(i)) / &
+                   & dt_sechiba
+              sum_flux_q_a(i) = - flux_le(i+1) + ( flux_le(i) + horiz_flux_q(i) )
+           END DO ! i = 1, jnlvls-1
+
+
+           DO i = 1, jnlvls-1
+              delta_temp_leaf(i) = rho_veg*leaf_tks * pad_deltah(i) * jtheta(i) * &
+                   & ((t_l_next(i) - t_l_pres(i)) * delta_h(i)) / &
+                   & dt_sechiba
+              sum_flux_leaf(i) = (eta_1(i) * lwdown(ji)) + (eta_2(i)*t_l_next(i)) + &
+                   & eta_3(i) + (eta_4(i) * swdown(ji)) - &
+                   & ( horiz_flux_t(i) + horiz_flux_q(i))
+           END DO ! i = 1, jnlvls-1
+
+           DO i = 1, jnlvls-1
+              IF (ABS(source_sink_t(i) - sum_flux_a(i)) .gt. 1.0d-5) THEN
+                 WRITE (numout,*) 'level: ', i, ' does not balance at atmos temperature'
+              ELSE
+                 ! do nothing
+              END IF
+
+              IF (ABS(source_sink_q(i) - sum_flux_q_a(i)) .gt. 1.0d-5) THEN
+                 WRITE (numout,*) 'level: ', i, ' does not balance at atmos specific humidity'
+              ELSE
+                 ! do nothing
+              END IF
+
+              IF (ABS(delta_temp_leaf(i) - sum_flux_leaf(i)) .gt. 1.0d-5) THEN
+                 WRITE (numout,*) 'level: ', i, ' does not balance at leaf temperature'
+              ELSE
+                 ! do nothing
+              END IF
+
+           END DO ! i = 1, jnlvls-1
+
+           DO i = 1, jnlvls-1
+              source_sink_sum_t = (source_sink_sum_t + source_sink_t(i) + horiz_flux_t(i))
+              source_sink_sum_q = (source_sink_sum_q + source_sink_q(i) + horiz_flux_q(i))
+           END DO ! i = 1, jnlvls-1
+
+        END IF ! (jnlvls .gt. 1) THEN
+
+     END DO gridloop ! ji=1,kjpindex  ! ------------------------------------------------------------
+
+
+   END SUBROUTINE mleb_calc_column
+
+
+ ! -------------------------------------------------------------------------------------------------
+
+ !!  ===========================================================================================================================
+ !! SUBROUTINE: mleb_alpha_beta_coeff 
+ !!
+ !!
+ !>\BRIEF: calculates the rate of change of saturated surface humidity of the leaf surface 
+ !!
+ !! DESCRIPTION: 
+ !! 
+ !!
+ !! RECENT CHANGE(S): None
+ !!
+ !! MAIN OUTPUT VARIABLE(S) : jalpha, jbeta, jalpha_surf, jbeta_surf, q_sat_surf, temp_surf_pres
+ !!
+ !! REFERENCE(S): Monteith & Unsworth (2008 edition)
+ !!
+ !! FLOWCHART: 
+ !_ ==============================================================================================================================
+
+
+ SUBROUTINE mleb_alpha_beta_coeff (temp_atmos_pres_grid, temp_leaf_pres_grid, jalpha, jbeta, &
+               & jalpha_surf, jbeta_surf, temp_surf_pres, q_sat_surf, kjpindex, &
+               & pb, temp_sol, jpdqsold)
+
+    ! we use the approach outlined in Monteith & Unsworth (2008 edition)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex                       !! Domain size (-)
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)           :: pb                             !! Lowest level pressure (hPa)
+    REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT (in)   :: temp_atmos_pres_grid           !! atmospheric temperature down the column (K)
+    REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT (in)   :: temp_leaf_pres_grid            !! leaf temperature down the column (K)
+
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: temp_sol                       !! Soil temperature (K)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (jnlvls), INTENT (out)            :: jalpha, jbeta
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: jalpha_surf, jbeta_surf
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: q_sat_surf
+
+
+    !! 0.3 Modified variables
+    REAL(r_std), INTENT (inout)                              :: temp_surf_pres                 !! surface temperature at PRESENT time step (Kelvins)
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION (jnlvls)                          :: temp_atmos                     !! atmospheric temperature down the column (K)
+    REAL(r_std), DIMENSION (jnlvls)                          :: temp_leaf                      !! leaf temperature down the column (K)
+
+    INTEGER(i_std)                                           :: ji                             !! grid point loop
+    INTEGER(i_std)                                           :: i                              !! levels loop
+
+    REAL(r_std)                                              :: lambda_const = 2480.0d0        !! (J g^-1) at 10degC n.b. this changes by 2.4 per degree
+    REAL(r_std)                                              :: bigm_w = 18.0d0                !! (g mol^-1) approximate molar mass of water
+    REAL(r_std)                                              :: bigr_const = 8.314d0           !! (J mol^-1 K^-1) the molar gas constant
+    REAL(r_std)                                              :: eta_const = 0.622d0            !! ratio of molecular mass of water to molecular mass of air
+    REAL(r_std)                                              :: biga_const = 17.27d0
+    REAL(r_std)                                              :: tstar_const = 273.0d0          !! (Kelvins)
+    REAL(r_std)                                              :: tprime_const = 36.0d0          !! (Kelvins)
+    REAL(r_std)                                              :: e_sat_tstar = 0.611d0          !! (kPa)
+    REAL(r_std)                                              :: zrapp,zcorr,ztemperature,zqsat !! Temporary vector variables      
+    REAL(r_std), DIMENSION (jnlvls)                          :: q_sat                          !! (kg/kg)
+    REAL(r_std), DIMENSION (jnlvls)                          :: big_delta                      !! delta q_sat / delta temp at leaf temperature
+    REAL(r_std), DIMENSION (jnlvls)                          :: leaf_qsol_sat                    !! Soil temperature (K)
+    REAL(r_std), DIMENSION (jnlvls)                          :: leaf_dev_qsol                    !! Soil temperature (K)
+    REAL(r_std), DIMENSION (jnlvls)                          :: leaf_pdqsold                     !! Soil temperature (K)
+    REAL(r_std), DIMENSION (kjpindex)                        :: big_delta_surf
+    REAL(r_std), DIMENSION (kjpindex)                        :: j_qsol_sat, j_dev_qsol
+    REAL(r_std), DIMENSION (kjpindex)                        :: jpdqsold
+    REAL(r_std), DIMENSION (kjpindex)                        :: j_dev_q, j_q_sat
+
+
+!   =from qsat_moisture=================================================================================================
+
+    !! 1. Initialisation
+    zrapp = msmlr_h2o/msmlr_air
+    zcorr = 0.00320991_r_std
+
+    jalpha(:) = 0.0d0
+    jbeta(:) = 0.0d0
+    jalpha_surf(:) = 0.0d0 
+    jbeta_surf(:) = 0.0d0
+
+    q_sat(:) = 0.0d0
+    big_delta(:) = 0.0d0
+    leaf_qsol_sat(:) = 0.0d0
+    leaf_dev_qsol(:) = 0.0d0
+    leaf_pdqsold(:) = 0.0d0
+    big_delta_surf(:) = 0.0d0 
+    j_qsol_sat(:) = 0.0d0
+    j_dev_qsol(:) = 0.0d0
+    jpdqsold(:) = 0.0d0
+
+    DO ji = 1, kjpindex
+      
+       !! 2. Computes saturated humidity one time and store in qsfrict local array
+         
+       ztemperature = temp_sol(ji)
+       j_qsol_sat(:) = 0.0d0
+       j_dev_qsol(:) = 0.0d0
+
+       CALL qsatcalc (kjpindex, temp_sol, pb, j_qsol_sat)
+
+       CALL dev_qsatcalc (kjpindex, temp_sol, pb, j_dev_qsol)
+
+       temp_surf_pres = temp_sol(ji)
+
+       !+++ According to r2093 in the trunk, the line below is modified to avoid possible instability in the coupling.
+
+       ! jpdqsold(ji) = j_dev_qsol(ji) * ( pb(ji)**kappa ) / cp_air
+
+       jpdqsold(ji) = j_dev_qsol(ji)
+
+       q_sat(:) = 0.0d0
+       big_delta(:) = 0.0d0
+
+       ! calculate jalpha_surf and jbeta_surf first of all:
+
+       ! Using Tetens' method for close approximation of saturated specific humidity 
+       !   (e.g. 2.27 of Monteith & Unsworth (2008)) and the specific humidity approximation 
+       !   in terms of vapour pressure (e.g. 2.32 of Monteith & Unsworth (2008))
+        
+       q_sat_surf(ji) = (eta_const / 100000.0d0)  * (e_sat_tstar*1000.0d0) *  &
+          & EXP((biga_const*(temp_surf_pres - tstar_const)/(temp_surf_pres - tprime_const)))
+
+ 
+       big_delta_surf(ji) = ( lambda_const * bigm_w * q_sat_surf(ji) ) / &
+                      & ( bigr_const * (temp_surf_pres)**2 )
+
+       IF (printlev_loc>=4) THEN
+           WRITE (numout,*) 'in calc_jalpha_jbeta, big_delta_surf is: ', big_delta_surf(ji)    
+       END IF !(printlev_loc>=4)
+
+       ! jalpha_surf(ji) = j_dev_qsol(ji)
+       jalpha_surf(ji) = jpdqsold(ji)
+       jbeta_surf(ji) = j_qsol_sat(ji) - temp_sol(ji) * jpdqsold(ji)
+       q_sat_surf(ji) = j_qsol_sat(ji)
+
+       IF (jnlvls .gt. 1) THEN
+
+           DO i=1, jnlvls
+
+               temp_atmos(i) = temp_atmos_pres_grid(ji,i)
+               temp_leaf(i) = temp_leaf_pres_grid(ji,i)
+
+               ! Using Tetens' method for close approximation of saturated specific humidity 
+               !   (see 2.27 of Monteith & Unsworth (2008)) and the specific humidity 
+               !   approximation in terms of vapour pressure (see 2.32 of Monteith & Unsworth (2008))
+        
+               q_sat(i) = (eta_const / 100000.0d0)  * (e_sat_tstar*1000.0d0) *  &
+                   & EXP((biga_const*(temp_leaf(i) - tstar_const)/(temp_leaf(i) - tprime_const)))
+
+               big_delta(i) = ( lambda_const * bigm_w * q_sat(i) ) / &
+                   & ( bigr_const * temp_leaf(i)**2 )
+
+               jalpha(i) = big_delta(i) 
+               jbeta(i) = q_sat(i) - (temp_leaf(i) * jalpha(i))
+
+               CALL qsatcalc (kjpindex, temp_leaf_pres_grid(:,i), pb, j_q_sat)
+
+               !   CALL dev_qsatcalc (kjpindex, temp_sol, pb, dev_qsol) jtest3
+               CALL dev_qsatcalc (kjpindex, temp_leaf_pres_grid(:,i), pb, j_dev_q)
+
+               jalpha(i) = j_dev_q(ji) * ( pb(ji)**kappa ) / cp_air
+           
+               jbeta(i) = j_q_sat(ji) - temp_leaf(i) * j_dev_q(ji) * ( pb(ji)**kappa ) / cp_air
+
+           END DO !i = 1, jnlvls
+
+       END IF ! IF (jnlvls .gt. 1)
+
+    END DO ! ji = 1, kjpindex
+
+ END SUBROUTINE mleb_alpha_beta_coeff 
+
+
+ ! -------------------------------------------------------------------------------------------------
+
+ !!  ===========================================================================================================================
+ !! SUBROUTINE                  : mleb_profile
+ !!
+ !!
+ !>\BRIEF                       : calculates the rate of change of saturated surface humidity of the leaf surface 
+ !!
+ !! DESCRIPTION                 : This routine will allocate a LAD to each level of the canopy using the approach 
+ !!                                           of Yang et al. (1999) and the parameters they allocate to an aspen stand (if not 
+ !!                                           already known through read-in data). Based on this LAD profile, canopy turbulence 
+ !!                                           statistics will be allocated using the method of Massman & Weil (1999).
+ !! 
+ !!
+ !! RECENT CHANGE(S): None
+ !!
+ !! MAIN OUTPUT VARIABLE(S)     : jalpha, jbeta, jalpha_surf, jbeta_surf, q_sat_surf, temp_surf_pres
+ !!
+ !! REFERENCE(S)                : Massman, W.J. & Weil, J.C., 1999. An analytical one-dimensional second-order 
+ !!                               closure model of turbu lence statistics and the lagrangian time scale within and 
+ !!                               above plant canopies of arbitrary structure. Boundary-Layer Meteorology, 91, 
+ !!                               pp.81â107.
+ !!
+ !!                               Raupach, M.R., Antonia R.A. and Rajagpalan, S., 1991. 'Rough-wall turbulent 
+ !!                               boundary layers', Applied Mechanics Review, 44, pp. 1-25
+ !!
+ !!                               Yang, X., Witcosky, J.J. & Miller, D.R., 1999. Vertical overstory canopy 
+ !!                               architecture of temperate deciduous in the Eastern United States. Forest Science, 
+ !!                               45(3), pp.349â358.
+ !!
+ !!                               Wohlfahrt G. and A. Cernusca 2002, Monmentum tansfer by a mountain
+ !!                               meadow canopy: a simulation analysis based on Massman's (1997) model,
+ !!                               Boundary Layer Meteorology, 103, 391-407  
+ !!
+ !! FLOWCHART           : 
+ !_ ==============================================================================================================================
+
+
+ SUBROUTINE mleb_profile (pad_deltah, layer_height, delta_z, &
+                      & delta_h, box_height, k_eddy, &
+                      & u_star, speed, u_speed, big_pad, & 
+                      & k_eddy_slope,k_eddy_ustar, k_eddy_surf, surf_lev, top_lev, swnet, jrpad, &  
+                      & a_1, a_2, a_3, a_4, a_5, WC02)
+
+    IMPLICIT NONE
+
+    !! 0 Variable and parameter description
+
+    !! 0.1 Input variables
+    REAL(r_std), DIMENSION (0:jnlvls), INTENT(in)    :: pad_deltah             !! Plant Area Density as a function of height above the ground (m^2/m^3)
+    REAL(r_std), DIMENSION(jnlvls+1), INTENT(in)     :: box_height             !! height of each box edge, starting at the surface layer (m)
+    REAL(r_std), INTENT(in)                          :: surf_lev
+    REAL(r_std), DIMENSION(jnlvls+1), INTENT(in)     :: top_lev
+    REAL(r_std), INTENT(in)                          :: swnet                  !! Net surface short-wave flux (W m^{-2})
+    REAL(r_std), INTENT(in)                          :: k_eddy_slope           !! for k_eddy parameterization  
+    REAL(r_std), INTENT(in)                          :: k_eddy_ustar           !! for k_eddy parameterization 
+
+    !! 0.2 Output variables
+    REAL(r_std), INTENT(out)                         :: u_star                 !! friction velocity (m/s)
+    REAL(r_std), INTENT(out)                         :: layer_height           !! the height of each layer in the canopy (assumed equal for now) (m)
+    REAL(r_std), DIMENSION (jnlvls)                  :: cum_pad_deltah         !! Cumulative Plant Area Density multiplied by layer height (m^2/m^3)
+    REAL(r_std), DIMENSION (jnlvls), INTENT(out)     :: delta_z                !! change in height (m)
+    REAL(r_std), DIMENSION (jnlvls), INTENT(out)     :: u_speed                !! vertical wind speed (m/s)
+    REAL(r_std), DIMENSION (jnlvls), INTENT(out)     :: big_pad 
+    REAL(r_std), DIMENSION (jnlvls), INTENT(out)     :: k_eddy                 !! calculated eddy diffusivity coefficient (m^2/s)
+    REAL(r_std), DIMENSION (jnlvls), INTENT(out)     :: delta_h                !! height of each level (m)
+    REAL(r_std), DIMENSION (0:jnlvls), INTENT(out)   :: jrpad                  !! Plant Area Density, replacement for values above (as definitions between different
+                                                                               !!    parts of the model was becoming confusing)
+                                                                               !!    'jrpad' is the total one-sided leaf area per unit of layer volume
+
+    !! 0.3 Modified variables
+
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION (jnlvls)                   :: cum_jrpad             !! Cumulative Plant Area Density (m^2/m^3)
+
+    !! 0.4 Local variables
+    REAL(r_std)                                       :: speed
+    REAL(r_std)                                       :: param_b=0.426d0
+    REAL(r_std)                                       :: param_c=1.856d0
+    REAL(r_std)                                       :: c_d=0.2d0
+    REAL(r_std)                                       :: p_m=1.0d0
+    REAL(r_std)                                       :: jlambda
+    REAL(r_std)                                       :: jalpha=0.05d0
+    REAL(r_std)                                       :: small_n
+    INTEGER(i_std)                                    :: i
+    INTEGER(i_std)                                    :: j, k, m, n
+    REAL(r_std)                                       :: c_1, c_2, c_3         !! coefficients as defined in Massman & Weil (1999) p. 83
+    REAL(r_std), DIMENSION (jnlvls+1)                 :: jepsilon              !! epsilon coefficient as in Massman & Weil (1999), 
+                                                                               !!   equation (6) and just after
+    REAL(r_std), DIMENSION (jnlvls)                   :: eta_z                 !! eta coefficient as in Massman & Weil (1999), equation (3)
+    REAL(r_std), DIMENSION (jnlvls)                   :: sigma_exp_1
+    REAL(r_std), DIMENSION (jnlvls)                   :: sigma_exp_2
+    REAL(r_std), DIMENSION (jnlvls)                   :: sigma_exp_3
+    REAL(r_std), DIMENSION (jnlvls)                   :: sigma_e_over_u_star   !! sigma_e normalised by u_star (-)
+    REAL(r_std), DIMENSION (jnlvls)                   :: sigma_u_over_u_star   !! sigma_u normalised by u_star (-)
+    REAL(r_std), DIMENSION (jnlvls)                   :: sigma_v_over_u_star   !! sigma_v normalised by u_star (-)
+    REAL(r_std), DIMENSION (jnlvls)                   :: sigma_w_over_u_star   !! sigma_w normalised by u_star (-)
+    REAL(r_std), DIMENSION (jnlvls)                   :: sigma_u               !! standard deviation in u-stream (horizontal) velocity (m/s); Massman & Weil eqn. (11)
+    REAL(r_std), DIMENSION (jnlvls)                   :: sigma_v               !! standard deviation in v-stream (horizontal) velocity (m/s); Massman & Weil eqn. (11)
+    REAL(r_std), DIMENSION (jnlvls)                   :: sigma_w               !! standard deviation in w-stream (vertical) velocity (m/s); Massman & Weil eqn. (11)
+
+    REAL(r_std)                                       :: k_eddy_surf           !! ?? not used ?? 
+
+    REAL(r_std)                                       :: gamma_1=2.4d0
+    REAL(r_std)                                       :: gamma_2=1.9d0
+    REAL(r_std)                                       :: gamma_3=1.25d0
+    REAL(r_std)                                       :: nu_1, nu_2, nu_3
+    REAL(r_std)                                       :: bigb1
+    REAL(r_std)                                       :: rp_a_1 = 1.25d0       !! Raupach et al. (1991) co-efficients
+    REAL(r_std)                                       :: rp_a_0 = 0.25d0       !! Raupach et al. (1991) co-efficients
+    REAL(r_std)                                       :: rp_c_0 = 0.3d0        !! Raupach et al. (1991) co-efficients 
+    REAL(r_std), DIMENSION (0:jnlvls)                 :: gu_l
+    REAL(r_std)                                       :: gu_ext = 0.7d0
+    REAL(r_std), DIMENSION (jnlvls)                   :: middle_layer_height   !! the height in the middle of each layer in the canopy (m)
+    REAL(r_std), DIMENSION (jnlvls+1)                 :: z_h                   !! height above ground at the base of each layer (m)
+    REAL(r_std), DIMENSION (jnlvls+1)                 :: jeta
+    REAL(r_std), DIMENSION (jnlvls)                   :: t_lagrangian          !! Lagrangian timescale (s)
+
+    ! Parameter for dynamic drag coefficient cd_z
+    ! Ref:  Wohlfahrt G. and A. Cernusca 2002, Monmentum tansfer by a mountain
+    ! meadow canopy: a simulation analysis based on Massman's (1997) model,
+    ! Boundary Layer Meteorology, 103, 391-407 
+    ! a negtive sign was adeed on a_4 (this could be the typo in origial paper) 
+    LOGICAL, INTENT(in)                               :: WC02                     ! flage for the drag_coefficient is depend on LAI profile
+    REAL(r_std), DIMENSION(jnlvls)                    :: c_dz
+    REAL(r_std), INTENT(in)                           :: a_1 
+    REAL(r_std), INTENT(in)                           :: a_2 
+    REAL(r_std), INTENT(in)                           :: a_3 
+    REAL(r_std), INTENT(in)                           :: a_4 
+    REAL(r_std), INTENT(in)                           :: a_5 
+
+
+    layer_height = 0.0_r_std
+    middle_layer_height = 0.0_r_std
+    z_h = 0.0_r_std
+    jepsilon = 0.0_r_std
+    cum_pad_deltah = 0.0_r_std
+    small_n = 0.0_r_std
+    bigb1 = 0.0_r_std
+    sigma_exp_1 = 0.0_r_std
+    sigma_exp_2 = 0.0_r_std
+    sigma_exp_3 = 0.0_r_std
+
+    nu_1 = (gamma_1**2.0_r_std+gamma_2**2.0_r_std+gamma_3**2.0_r_std)**(-0.5_r_std)
+    nu_3 = (gamma_1**2.0_r_std+gamma_2**2.0_r_std+gamma_3**2.0_r_std)**(3.0_r_std/2.0_r_std)   
+    nu_2 = nu_3/6.0_r_std-(gamma_3**2.0_r_std/(2.0_r_std*nu_1))
+
+    DO i=1, jnlvls
+        delta_h(i) = box_height(i+1) - box_height(i)
+
+        IF(printlev_loc>= 4) THEN
+           WRITE(numout,*)'191016 in enerbil  box_height(i+1),box_height(i)',box_height(i+1),box_height(i)
+           WRITE(numout,*)'191016 in enerbil, delta_h(i)',delta_h(i) 
+        ENDIF
+    END DO !i=1, jnlvls
+
+
+    DO i=1, jnlvls-1
+        delta_z(i) = (box_height(i+1) + (delta_h(i+1)/2.0_r_std)) - &
+                         &  (box_height(i) + (delta_h(i)/2.0_r_std))
+    END DO !i=1, jnlvls
+
+    DO i=1, jnlvls+1
+        z_h(i) = box_height(i)
+        jeta(i) = z_h(i) / canopy_height
+        ! this is from Yang et al. (1999), equation 1
+        !++++TEMP++++
+        ! for single layer case without STOMATE
+        !jepsilon(i) = 1.0_r_std - exp ((-1.0_r_std)*(( (1-jeta(i)) /param_b ) ** (param_c)))
+        jepsilon(i) = 1.0_r_std 
+        !+++++++++++++
+    END DO !i=1, jnlvls+1
+
+    DO i=1, jnlvls
+        middle_layer_height(i) = (z_h(i) + z_h(i+1)) / 2.0_r_std
+    END DO !i=1, jnlvls
+
+
+    delta_h(1) = top_lev(1) - surf_lev
+     
+    DO i = 2, jnlvls
+        delta_h(i) = top_lev(i) - top_lev(i-1)
+    END DO ! i = 2, jnlvls 
+
+    DO i = 1, jnlvls-1
+        delta_z(i) = (delta_h(i) + delta_h(i+1))/2.0_r_std
+    END DO ! i = 1, jnlvls-1
+
+
+    ! coefficients c_1, c_2 and c_3 as defined in Massman & Weil (1999) p. 83
+
+    c_1 = 0.320_r_std
+    c_2 = 0.264_r_std
+    c_3 = 15.1_r_std
+
+    cum_pad_deltah(jnlvls) = pad_deltah(jnlvls)
+    DO i=jnlvls-1, 1, -1
+        cum_pad_deltah(i) = cum_pad_deltah(i+1) + pad_deltah(i)
+    END DO !i=1, jnlvls
+
+    DO i=1, jnlvls
+        big_pad(i) = pad_deltah(i) / delta_h(i)
+    END DO ! i=1, jnlvls
+
+    ! here we define jrpad correctly - the total one-sided leaf area per unit of layer volume
+    DO i=1, jnlvls
+        jrpad(i) = pad_deltah(i) / delta_h(i)
+    END DO !i=1, jnlvls
+
+    !+++++ CHECK +++++++
+    !Calculate the eta_z with Dynamic Drag Coeffiient (c_dz) or Static Drag Coefficient Constance(c_d)
+    IF ( WC02 ) THEN
+    !Dyanaic Drage Coefficient vertical
+        c_dz(:) = c_d !set default value c_dz to c_d
+        DO i = 1, jnlvls
+           c_dz(i) =  a_1**(-1.0_r_std*cum_pad_deltah(i)/a_2) + a_3**(-1.0_r_std*cum_pad_deltah(i)/a_4) + a_5   
+           !WRITE(numout, *) 'C_Deff(z):', c_dz(i), 'PAIcum:',cum_pad_deltah(i)
+        ENDDO 
+           eta_z(1) = (( c_dz(1) * pad_deltah(1)  )  )
+        DO i=2, jnlvls
+           eta_z(i) = (( c_dz(i) * pad_deltah(i)  )  ) + eta_z(i-1)
+        !   WRITE(numout, *) 'eta_z:', eta_z(i)
+        END DO 
+            
+    ELSE
+    !Constant Drag Coefficient
+           eta_z(1) = (( c_d * pad_deltah(1) ) / p_m )
+        DO i=2, jnlvls
+           eta_z(i) = (( c_d * pad_deltah(i) ) / p_m ) + eta_z(i-1)
+        END DO 
+             
+    ENDIF
+   !+++++++++++++++++++++++
+
+    u_star = speed * (c_1 - c_2 * exp (- c_3 * eta_z(jnlvls) ) )
+
+    jlambda = SQRT( 7.0_r_std / (3.0_r_std * jalpha**2.0_r_std * nu_1 * nu_3 ) + & 
+                      & (1.0_r_std / 3.0_r_std - (gamma_3**2.0_r_std * nu_1**2.0_r_std ))/  &
+                      & (3.0_r_std * jalpha**2.0_r_std * nu_1 * nu_2))
+
+    small_n = eta_z(jnlvls)/((2.0_r_std*(u_star**2.0_r_std))/(speed**2.0_r_std))
+
+
+    bigb1 = -(9.0_r_std* u_star / speed)/(2.0_r_std* jalpha * nu_1 * & 
+               & (9.0_r_std/4.0_r_std - ((jlambda**2.0_r_std*u_star**4.0_r_std)/speed**4.0_r_std)))
+
+    DO i=1, jnlvls
+        sigma_exp_1(i) = -jlambda * eta_z(jnlvls) * ( 1.0_r_std - eta_z(i) / eta_z(jnlvls))
+        sigma_exp_2(i) = -3.0_r_std * small_n * ( 1.0_r_std - ( eta_z(i) / eta_z(jnlvls)))
+        sigma_exp_3(i) = -jlambda * eta_z(jnlvls) * (1.0_r_std - eta_z(i) / eta_z(jnlvls))
+        sigma_e_over_u_star(i) = ( nu_3 * &
+                             & EXP (sigma_exp_1(i)) + bigb1 *( EXP( sigma_exp_2(i)) - &
+                             & EXP( sigma_exp_3(i))))**(1.0_r_std/3.0_r_std)
+        sigma_u_over_u_star(i) = gamma_1 * nu_1 * sigma_e_over_u_star(i)
+        sigma_v_over_u_star(i) = gamma_2 * nu_1 * sigma_e_over_u_star(i)
+        sigma_w_over_u_star(i) = gamma_3 * nu_1 * sigma_e_over_u_star(i)
+        sigma_u(i) = sigma_u_over_u_star(i) * u_star
+        sigma_v(i) = sigma_v_over_u_star(i) * u_star
+        sigma_w(i) = sigma_w_over_u_star(i) * u_star
+        u_speed(i) = speed * exp (-small_n * (1-(eta_z(i)/eta_z(jnlvls))))
+
+        !++++SET a MINIMUM wind speed  +++++
+        u_speed(i) = MAX (0.05_r_std, u_speed(i) ) 
+        !++++++++++++++++++++++++++++++++++++   
+     END DO !i=1, jnlvls
+
+
+    IF (jnlvls .eq. 1) THEN
+        u_speed(1) = speed
+    END IF
+
+    ! approximate the Lagrangian timescale using the parameterisation of Raupach (1989)
+    ! where 0.4_r_std is the von Karmen constant
+
+    DO i=1, jnlvls
+        t_lagrangian(i) = (canopy_height/u_star) *                                      &
+                       &    (max (rp_c_0, 0.4_r_std * ( z_h(i) - (0.63_r_std*canopy_height) )   &
+                       &     / (rp_a_1 * canopy_height)))
+    END DO !i=1, jnlvls
+
+    ! this is the eddy diffusivity approximation for the far-field (also Raupach, 1989)
+
+    DO i=1, jnlvls
+
+        k_eddy(i) = (sigma_w(i))**2 * t_lagrangian(i)
+
+    END DO !i=1, jnlvls
+
+
+    !+++ FOR NIGHTTIME K_EDDY was parameterized as a S-shape funtion based on threshood ustar value ++++
+    ! Here we use a paramterization method for scaling the K_eddy based on u*
+    ! 
+    ! u_star < 0.3 cut 50% 
+    ! u_star > 0.3 increase from 50 %
+    ! K_EDDY_SLOPE determine the increasing/decreasing rate 
+    !     
+      k_eddy = k_eddy * (1.0 / (1.0 + EXP (-k_eddy_slope * (u_star- k_eddy_ustar))) ) 
+    !++++++++++++++++++++++++++++++++++++++
+
+ END SUBROUTINE mleb_profile
+
+    
+ !!  ===========================================================================================================================
+ !! SUBROUTINE                  : mleb_stomatal_resistance
+ !!
+ !!
+ !>\BRIEF                       : 
+ !!
+ !! DESCRIPTION                 : 
+ !! 
+ !!
+ !! RECENT CHANGE(S)            : None
+ !!
+ !! MAIN OUTPUT VARIABLE(S)     :     down_sw_tab, down_lw_tab, big_r_prime
+ !!
+ !! REFERENCE(S)                :     Gao, W., Wesely, M.L. & Doskey, P.V., 1993. Numerical modeling of the turbulent 
+ !!                                   diffusion and chemistry of NOx, O3, Isoprene, and other reactive trace gases in 
+ !!                                   and above a forest canopy. Journal of Geophysical Research, 98(D10), pp.18339â18353
+ !!
+ !!                                   Guimberteau, M., 2010. ModÃ©lisation de lâhydrologie continentale et influences de 
+ !!                                   l'irrigation sur le cycle de l'eau.
+ !!
+ !!                                   Monteith J., Unsworth M., 2008. Principles of environmental physics. Published 
+ !!                                   Academic Press (Elsevier), ISBN: 978-0-12-505103-3
+ !!
+ !! FLOWCHART           : 
+ !_ ==============================================================================================================================
+
+
+ ! -------------------------------------------------------------------------------------------------
+
+ SUBROUTINE mleb_stomatal_resistance (pad_deltah, swnet, lwdown, pb, &
+                      & down_sw_tab, down_lw_tab, big_r_prime, temp_atmos_pres_grid, &
+                      & q_atmos_pres_grid, big_r, u_speed, r_sto_v_fac, big_r_h2o_fac, &
+                      & rau, kjpindex, sr_fac, q_cdrag, delta_h, jrpad, &
+                      & profile_rveget)
+
+
+
+
+    IMPLICIT NONE
+    
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                                   :: kjpindex         !! Domain size (-)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)                :: rau              !! Air density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)                 :: swnet            !! Net surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)                 :: lwdown           !! Down-welling long-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)                 :: pb               !! Lowest level pressure (hPa)
+    REAL(r_std), DIMENSION (0:jnlvls), INTENT(in)                :: pad_deltah       !! Plant Area Density multiplied by layer height
+    REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(in)        :: temp_atmos_pres_grid
+    REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(in)        :: q_atmos_pres_grid
+    REAL(r_std), DIMENSION(jnlvls), INTENT(in)                   :: big_r    
+    REAL(r_std), DIMENSION(jnlvls), INTENT(in)                   :: u_speed
+    REAL(r_std), INTENT(in)                                      :: r_sto_v_fac, big_r_h2o_fac    
+    REAL(r_std), INTENT(in)                                      :: sr_fac           !! parameterisation factor   
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)               :: q_cdrag          !! Surface drag coefficient (-)
+    REAL(r_std), DIMENSION(jnlvls), INTENT(in)                   :: delta_h          !! height of each level (m)
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT(in) :: profile_rveget
+    REAL(r_std), DIMENSION (0:jnlvls), INTENT(in)                :: jrpad            !! Plant Area Density, replacement for values above
+                                                                                     !!   (as definitions between different
+                                                                                     !! parts of the model was becoming confusing)
+                                                                                     !!   'jrpad' is the total one-sided leaf area per unit of layer volume
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION (jnlvls), INTENT (out)                :: down_sw_tab, down_lw_tab
+    REAL(r_std), DIMENSION (jnlvls), INTENT(out)                 :: big_r_prime
+
+
+    !! 0.3 Modified variables
+
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                               :: i, j, jk             !! loop counters
+    
+    REAL(r_std), DIMENSION (jnlvls)                              :: temp_atmos_pres    
+    REAL(r_std), DIMENSION (jnlvls)                              :: q_atmos_pres    
+    ! constants from Tetens' expression for saturated vapor pressure (see Monteith &
+    !   Unsworth 2.1)  bigA (-), tstar (K), tprime(K)
+    REAL(r_std)                                                  :: biga_const = 17.27_r_std
+    REAL(r_std)                                                  :: tstar_const = 273.0_r_std
+    REAL(r_std)                                                  :: tprime_const = 36.0_r_std 
+    REAL(r_std)                                                  :: e_sat_tstar = 0.611_r_std  !vapor pressure at T* (kPa)
+    !! laitab is the accumulated LAI from the top of the canopy (see Gao et al., 1993)
+    REAL(r_std), DIMENSION (jnlvls)                              :: laitab
+    REAL(r_std), DIMENSION (jnlvls)                              :: e_sat_tair 
+    !! extinction coefficient used is that from from src_parameters of 0.5_r_std for all PFTs               
+    REAL(r_std)                                                  :: ext_coef_sw = 0.5_r_std
+    REAL(r_std)                                                  :: ext_coef_lw = 0.8_r_std
+    ! this is the assumed minimum average stomatal resistance (s/m)
+    REAL(r_std)                                                  :: k_0 = 25.0d-2
+    ! PFT dependent number that is characterised by vegetation (value for PFT8, 
+    !   from Guimberteau, Table 2.2) (-)
+    REAL(r_std)                                                  :: bigr_0 = 125.0_r_std ! solar radiation constant (Wm^-2)
+    REAL(r_std)                                                  :: lambda = 1.5d-3
+    ! coefficient for the increase of stomatal closure under hydrological deficit 
+    !   (m^2 s kg^(-1))
+    REAL(r_std), DIMENSION (jnlvls)                              :: delta_c
+    ! deficit of water in the atmosphere at the level in question (kg m^-3)
+    REAL(r_std), DIMENSION (jnlvls)                              :: q_sat_ta, r_sto_v
+    REAL(r_std)                                                  :: big_l =2.46d6           !(J/kg)
+    REAL(r_std)                                                  :: r_b = 30.0_r_std            ! leaf boundary layer resistance
+    ! (see Guimberteau section 4.2)
+    REAL(r_std)                                                  :: r_sv = 25.0_r_std           ! structural resistance for PFT8 (s/m) 
+    REAL(r_std)                                                  :: r_a = 0.0_r_std             ! aerodynamic resistance represented by the eddy
+    REAL(r_std)                                                  :: bigu_sv = 0.8_r_std         ! water uptake function
+    REAL(r_std)                                                  :: small_d                 ! characteristic leaf length (m)
+    REAL(r_std), DIMENSION(jnlvls)                               :: bigd_h2o                ! molecular diffusivity of water
+    REAL(r_std), DIMENSION(jnlvls)                               :: nu_air                  ! kinematic viscosity of air
+    REAL(r_std), DIMENSION(jnlvls)                               :: schmidt                 ! schmidt number
+    REAL(r_std), DIMENSION(jnlvls)                               :: sherwood                ! sherwood number
+    REAL(r_std), DIMENSION(jnlvls)                               :: reynolds                ! reynolds number
+    REAL(r_std), DIMENSION(jnlvls)                               :: big_r_h2o               ! h2o leaf boundary layer resistance
+    REAL(r_std)                                                  :: smalla = 23.0_r_std        ! this is the assumed minimum average stomatal resistance (s/m)
+
+    r_sto_v=zero
+    big_r_h2o=zero
+
+
+   !---initialized the big_r_prime
+    big_r_prime(:)= 1.0d3
+   !----
+
+ 
+    IF (.NOT. ok_impose_can_structure) THEN 
+
+    DO jk = 1, kjpindex
+
+        temp_atmos_pres(:) = temp_atmos_pres_grid(jk,:)
+        q_atmos_pres(:) = q_atmos_pres_grid(jk,:)
+
+        small_d = 0.05_r_std                            ! set the leaf length to 5cm for now
+        ! physical dimensions for aspen leaf length: www.ag.ndsu.edu/trees/handbook/th-3-103.pdf
+    
+        ! n.b. for Eucalyptus delegatensis:
+        ! http://davisla.wordpress.com/2012/04/07/plant-of-the-week-eucalyptus-delegatensis/
+        ! 'juvenile leaf being up to 25cm long and 10cm broad the mature 18cm long and 3cm broad'
+    
+    
+        ! calculate steps of LAI (using the same formulation as in diffuco.f90 for co2)
+        laitab = 0.0_r_std
+     
+        ! calculate light fraction that comes through at a given LAI for each vegetation type
+        ! laitab(jnlvls) = 0
+     
+        IF (jnlvls .eq. 1) THEN
+            ! omit the layered calculation for single layer case
+        ELSE
+    
+                DO i=jnlvls-1, 1, -1
+                    
+                     laitab(i) = (jrpad(i+1) * delta_h(i+1) ) + laitab(i+1)             
+
+                END DO !i=jnlvls, 1, -1
+        
+                DO i=1, jnlvls
+                     down_sw_tab(i) = swnet(1) * exp (-ext_coef_sw * laitab(i))
+                     down_lw_tab(i) = lwdown(1) * exp (-ext_coef_lw * laitab(i))
+                END DO !i=1, jnlvls
+
+
+                DO i=1, jnlvls
+                     q_sat_ta(i) = (0.622_r_std/ pb(1))  *e_sat_tstar* 1000.0_r_std * &
+                       & EXP((biga_const*(temp_atmos_pres(i) - tstar_const) / &
+                       & (temp_atmos_pres(i) - tprime_const)))
+            
+                     delta_c(i) = rau(1) * MAX (q_sat_ta(i) - q_atmos_pres(i), zero) /100.0_r_std
+                END DO !i=1, jnlvls
+    
+                DO i=1, jnlvls
+                     IF (down_sw_tab(i) .ne. 0.0d0) THEN
+                          r_sto_v(i) = (smalla/k_0) * (1/pad_deltah(i)) * &
+                                & ((down_sw_tab(i)+bigr_0)/down_sw_tab(i))  &
+                                & * (un + lambda * (delta_c(i)/smalla) )
+                     ELSE
+                          r_sto_v(i) = 1.0d20
+                     END IF
+                END DO !i=1,jnlvls
+
+                IF(printlev_loc >= 4) THEN
+                     WRITE(numout, *) '100316 nlevels_tot is: ', nlevels_tot
+                     WRITE(numout, *) '100316 (jnlvls_under + nlevels_tot) is: ', (jnlvls_under + nlevels_tot)
+                ENDIF
+  
+                IF (.NOT. ok_impose_can_structure) THEN 
+                     r_sto_v(:) = 1.0d20
+                     ! r_sto_v(10:19) = profile_rveget(ji,jv,1:nlevels_tot) 
+                     ! r_sto_v(jnlvls_under:(jnlvls_under + nlevels_tot)) = profile_rveget(ji,jv,1:nlevels_tot) !asla 
+                END IF ! (ok_impose_can_structure) THEN 
+
+                IF(printlev_loc >=4 ) THEN
+                     DO i = 1, jnlvls
+                          WRITE (numout,*) 'r_sto_v(i) is: ', r_sto_v(i)
+                     END DO
+                ENDIF
+             
+                ! We're using the expression from ORCHIDEE as in Guimberteau (2010)
+    
+                DO i = 1, jnlvls
+    
+                   ! n.b. the transition point from laminar to turbulent flow occurs when the 
+                   !   Reynolds number passes 8,000 to 25,000 (Baldochhi, 1988)
+
+                   bigd_h2o(i) = 2.26d-5 + (1.51d-7 * (temp_atmos_pres(i) - 273.15_r_std))
+                   nu_air(i) = 1.35d-5 + (1.0d-7 * (temp_atmos_pres(i) - 273.15_r_std))
+                   schmidt(i) = nu_air(i) / bigd_h2o(i)
+    
+                   reynolds(i) = (small_d * u_speed(i))/nu_air(i)
+    
+                   ! is the flow laminar or turbulent?
+                   IF (reynolds(i) .le. 8000.0_r_std) THEN
+                       sherwood(i) = 0.66_r_std * (reynolds(i))**(0.5_r_std) + (schmidt(i))**(0.33_r_std)
+                   ELSE IF (reynolds(i) .gt. 8000.0_r_std) THEN
+                       sherwood(i) = 0.03_r_std * (reynolds(i))**(0.8_r_std) + (schmidt(i))**(0.33_r_std)
+                   END IF
+    
+                   big_r_h2o(i) = small_d / (bigd_h2o(i) * sherwood(i))
+                   ! +++ TEMP +++ use the same expression of leaf boundary+++++++++++++++++++++++++++++++++++++++
+                   ! resistance in the subroutineL diffuco_trans_co2 
+                       big_r_h2o(i) = (1.0_r_std /25.0_r_std)/(22.4_r_std*temp_atmos_pres(i)/273._r_std/1000._r_std) 
+                       !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+                       big_r_prime(i) = ((r_sto_v(i) * r_sto_v_fac) + (big_r_h2o(i) * big_r_h2o_fac)) !/ pad_deltah(i)
+
+
+                END DO ! i=1, jnlvls
+    
+            END IF ! (jnlvls .eq. 1)
+    
+            big_r_prime = big_r + ((r_sto_v * r_sto_v_fac) + (big_r_h2o * big_r_h2o_fac))
+            big_r_prime = big_r_prime * sr_fac
+    
+            big_r_prime(jnlvls) = 1.0d20   ! the top level resistance should be approaching 
+                                         !   infinity (see diagram) need to implement this 
+                                         !   more elegantly
+                                         
+            IF (printlev_loc>=4) WRITE(numout, *) 'big_r_prime is: ', big_r_prime
+
+
+          END DO ! jk = 1, kjpindex
+
+
+
+    ELSE ! (.NOT. ok_impose_can_structure)
+
+        DO jk = 1, kjpindex
+
+            temp_atmos_pres(:) = temp_atmos_pres_grid(jk,:)
+            q_atmos_pres(:) = q_atmos_pres_grid(jk,:)
+
+            small_d = 0.05_r_std                            ! set the leaf length to 5cm for now
+            ! physical dimensions for aspen leaf length: www.ag.ndsu.edu/trees/handbook/th-3-103.pdf
+    
+            ! n.b. for Eucalyptus delegatensis:
+            ! http://davisla.wordpress.com/2012/04/07/plant-of-the-week-eucalyptus-delegatensis/
+            ! 'juvenile leaf being up to 25cm long and 10cm broad the mature 18cm long and 3cm broad'
+    
+    
+            ! calculate steps of LAI (using the same formulation as in diffuco.f90 for co2)
+            laitab = 0.0_r_std
+     
+            ! calculate light fraction that comes through at a given LAI for each vegetation type
+            ! laitab(jnlvls) = 0
+     
+            IF (jnlvls .eq. 1) THEN
+                ! omit the layered calculation for single layer case
+            ELSE
+    
+                DO i=jnlvls-1, 1, -1
+         
+                     ! laitab(i) = (pad_deltah(i+1) * delta_h(i+1)) + laitab(i+1)   
+                     ! laitab(i) = (pad_deltah(i+1) ) + laitab(i+1)             
+                     laitab(i) = (jrpad(i+1) * delta_h(i+1) ) + laitab(i+1)             
+
+                END DO !i=jnlvls, 1, -1
+        
+                DO i=1, jnlvls
+                     down_sw_tab(i) = swnet(1) * exp (-ext_coef_sw * laitab(i))
+                     down_lw_tab(i) = lwdown(1) * exp (-ext_coef_lw * laitab(i))
+                END DO !i=1, jnlvls
+
+                IF (printlev_loc>=4) THEN
+                    
+                    DO i=jnlvls-1, 1, -1
+                       WRITE (numout,*) 'laitab, level: ', i, ' is: ', laitab(i)
+                    END DO !i=1, jnlvls
+                       
+                    DO i=jnlvls-1, 1, -1
+                       WRITE (numout,*) 'down_sw_tab, level: ', i, ' is: ', down_sw_tab(i)
+                    END DO !i=1, jnlvls
+
+                    DO i=jnlvls-1, 1, -1
+                       WRITE (numout,*) 'down_lw_tab, level: ', i, ' is: ', down_lw_tab(i)
+                    END DO !i=1, jnlvls
+                       
+                END IF ! (printlev_loc>=4)       
+    
+                DO i=1, jnlvls
+                     q_sat_ta(i) = (0.622_r_std/ pb(1))  *e_sat_tstar* 1000.0_r_std * &
+                       & EXP((biga_const*(temp_atmos_pres(i) - tstar_const) / &
+                       & (temp_atmos_pres(i) - tprime_const)))
+            
+                     delta_c(i) = rau(1) * MAX (q_sat_ta(i) - q_atmos_pres(i), zero) /100.0_r_std
+                END DO !i=1, jnlvls
+    
+                DO i=1, jnlvls
+                     IF (down_sw_tab(i) .ne. 0.0d0) THEN
+                          r_sto_v(i) = (smalla/k_0) * (1/pad_deltah(i)) * &
+                                & ((down_sw_tab(i)+bigr_0)/down_sw_tab(i))  &
+                                & * (un + lambda * (delta_c(i)/smalla) )
+                     ELSE
+                          r_sto_v(i) = 1.0d20
+                     END IF
+                END DO !i=1,jnlvls
+         
+             
+                ! We're using the expression from ORCHIDEE as in Guimberteau (2010)
+    
+                DO i = 1, jnlvls
+     
+                   ! n.b. the transition point from laminar to turbulent flow occurs when the 
+                   !   Reynolds number passes 8,000 to 25,000 (Baldochhi, 1988)
+    
+                   bigd_h2o(i) = 2.26d-5 + (1.51d-7 * (temp_atmos_pres(i) - 273.15_r_std))
+                   nu_air(i) = 1.35d-5 + (1.0d-7 * (temp_atmos_pres(i) - 273.15_r_std))
+                   schmidt(i) = nu_air(i) / bigd_h2o(i)
+    
+                   reynolds(i) = (small_d * u_speed(i))/nu_air(i)
+    
+                   ! is the flow laminar or turbulent?
+                   IF (reynolds(i) .le. 8000.0_r_std) THEN
+                       sherwood(i) = 0.66_r_std * (reynolds(i))**(0.5_r_std) + (schmidt(i))**(0.33_r_std)
+                   ELSE IF (reynolds(i) .gt. 8000.0_r_std) THEN
+                       sherwood(i) = 0.03_r_std * (reynolds(i))**(0.8_r_std) + (schmidt(i))**(0.33_r_std)
+                   END IF
+    
+                   big_r_h2o(i) = small_d / (bigd_h2o(i) * sherwood(i))
+
+                   big_r_prime(i) = ((r_sto_v(i) * r_sto_v_fac) + (big_r_h2o(i) * big_r_h2o_fac)) !/ pad_deltah(i)
+
+                END DO ! i=1, jnlvls
+    
+            END IF ! (jnlvls .eq. 1)
+    
+            big_r_prime = big_r + ((r_sto_v * r_sto_v_fac) + (big_r_h2o * big_r_h2o_fac))
+            big_r_prime = big_r_prime * sr_fac
+             
+            big_r_prime(jnlvls) = 1.0d20   ! the top level resistance should be approaching 
+                                         !   infinity (see diagram) need to implement this 
+                                         !   more elegantly
+                                         
+            IF (printlev_loc>=4) WRITE (numout, *) 'big_r_prime is: ', big_r_prime
+
+          END DO ! jk = 1, kjpindex
+
+     END IF ! (ok_impose_can_structure)
+    
+ END SUBROUTINE mleb_stomatal_resistance
+
+    
+ ! -------------------------------------------------------------------------------------------------
+
+ !!  ===========================================================================================================================
+ !! SUBROUTINE                  : mleb_boundarylayer_resistance
+ !!
+ !!
+ !>\BRIEF                       : 
+ !!
+ !! DESCRIPTION                 : 
+ !! 
+ !!
+ !! RECENT CHANGE(S): None
+ !!
+ !! MAIN OUTPUT VARIABLE(S)     :     down_sw_tab, down_lw_tab, big_r_prime
+ !!
+ !! REFERENCE(S)                :     Baldocchi, D.D., 1988. A multi-layer model for estimating sulfur dioxide deposition 
+ !!                                      to a deciduous oak forest canopy. Atmospheric Environment (1967), 22(5), 
+ !!                                      pp.869â884
+ !!
+ !! FLOWCHART                   : 
+ !_ ==============================================================================================================================
+
+
+
+ SUBROUTINE mleb_boundarylayer_resistance (big_r, u_speed, temp_atmos_pres_grid, &
+                                            & kjpindex, br_fac, q_cdrag, &
+                                            & pad_deltah, jrpad)
+  
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                     :: kjpindex             !! Domain size (-)
+    REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(in)          :: temp_atmos_pres_grid !! atmospheric temperature down the column (K) PRESENT STEP
+    REAL(r_std), DIMENSION (jnlvls), INTENT(in)                    :: u_speed
+    REAL(r_std), INTENT(in)                                        :: br_fac
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)                 :: q_cdrag              !! Surface drag coefficient (-)
+    REAL(r_std), DIMENSION (0:jnlvls), INTENT(in)                  :: pad_deltah           !! Plant Area Density multiplied by layer height
+    REAL(r_std), DIMENSION (0:jnlvls), INTENT(in)                  :: jrpad                !! Plant Area Density, replacement for values above (as definitions between different
+                                                                                           !!    parts of the model was becoming confusing)
+                                                                                           !!   'jrpad' is the total one-sided leaf area per unit of layer volume
+
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(jnlvls), INTENT(out)                    :: big_r
+
+    !! 0.3 Modified variables
+
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION (jnlvls)                                :: temp_atmos_pres      !! atmospheric temperature down the column (K) PRESENT STEP
+    REAL(r_std)                                                    :: r_a = 0.0_r_std      !! aerodynamic resistance is represented by the eddy
+    ! diffusivity coefficients so I have set this to zero 
+    REAL(r_std)                                                    :: r_b = 30.0_r_std     !! leaf boundary layer resistance
+    INTEGER(i_std)                                                 :: i, jk
+    REAL(r_std)                                                    :: small_d              !! characteristic leaf length (m)
+    REAL(r_std)                                                    :: big_l                !! characteristic leaf dimension (m)
+    REAL(r_std)                                                    :: big_d                !! molecular diffusivity of air
+    REAL(r_std)                                                    :: sherwood             !! Sherwood number
+    REAL(r_std)                                                    :: prandtl              !! Prandtl number 
+    REAL(r_std), DIMENSION (jnlvls)                                :: nusselt              !! Nusselt number
+    REAL(r_std), DIMENSION (jnlvls)                                :: bigd_h               !! heat diffusivity of air (m^2 s^-1)
+    REAL(r_std), DIMENSION (jnlvls)                                :: nu_air               !! the kinematic viscosity of air
+    REAL(r_std), DIMENSION (jnlvls)                                :: reynolds             !! reynolds number
+    REAL(r_std), DIMENSION(jnlvls)                                 :: big_r_heat
+
+
+    DO jk = 1, kjpindex
+
+        temp_atmos_pres(:) = temp_atmos_pres_grid(jk,:)
+ 
+        IF (jnlvls .eq. 1) THEN
+
+            big_r(:)=un
+
+            ! omit the layered calculation for single layer case
+        ELSE
+    
+            small_d = 0.01_r_std                                ! set the leaf length to 1cm for now
+            big_l = 0.01_r_std                                  ! set the leaf length to 1cm for now
+            prandtl = 1.0_r_std                                 ! set the Prandtl number to 1 for now
+!            DO i = 1, jnlvls
+!                big_r(i) = 200.0_r_std * (0.05_r_std / u_speed (i))
+!            END DO ! i = 1, jnlvls
+    
+            DO i = 1, jnlvls
+    
+                bigd_h(i) = 1.9d-5 + (1.26d-5 * (temp_atmos_pres(i) - 273.15_r_std))
+                nu_air(i) = 1.35d-5 + (1.0d-7 * (temp_atmos_pres(i) - 273.15_r_std))
+                reynolds(i) = (big_l * u_speed(i)) / nu_air(i)
+    
+                ! is the flow laminar or turbulent?
+                IF (prandtl .lt. 0.6_r_std) THEN
+                    nusselt(i) = 0.332_r_std * (reynolds(i))**(1.0_r_std/2.0_r_std) + (prandtl)**(1.0_r_std/3.0_r_std)
+                ELSE IF (prandtl .ge. 0.6_r_std) THEN
+                    nusselt(i) = 0.0296_r_std * (reynolds(i))**(4.0_r_std/5.0_r_std) + (prandtl)**(1.0_r_std/3.0_r_std)
+                END IF
+    
+                big_r_heat(i) = small_d / (bigd_h(i) * nusselt(i))
+    
+            END DO ! i=1, jnlvls
+    
+        END IF ! (jnlvls .eq. 1)
+    
+        ! big_r = big_r +  big_r_heat 
+
+        big_r = big_r_heat 
+        
+        big_r = big_r * br_fac
+    
+        big_r(jnlvls) = 1.0d20         ! n.b. the top level resistance should be approaching 
+                                       !   infinity (see diagram) need to implement this more 
+                                       !   elegantly 
+    END DO ! jk = 1, kjpindex
+
+ END SUBROUTINE mleb_boundarylayer_resistance
+
+    
+ ! -------------------------------------------------------------------------------------------------
+
+
+ SUBROUTINE mleb_calc_fluxes(temp_atmos_next, q_atmos_next, k_eddy, delta_z,  &
+                          & h_flux, le_flux)
+
+    ! this subroutine no longer used
+
+    ! calculate flux profiles
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    !! 0.2 Output variables
+    !! 0.3 Modified variables
+    !! 0.4 Local variables
+
+
+    REAL(r_std), DIMENSION (jnlvls)               :: temp_atmos_next    !! atmospheric temperature down the column (K) NEXT STEP
+    REAL(r_std), DIMENSION (jnlvls)               :: q_atmos_next       
+    REAL(r_std), DIMENSION (jnlvls)               :: k_eddy             !! eddy transport coefficient (m^2 s-1)
+    REAL(r_std), DIMENSION (jnlvls)               :: delta_z            !! vertical difference between the middle of each box (m)
+    REAL(r_std), DIMENSION (jnlvls)               :: h_flux, le_flux
+    INTEGER(i_std)                                :: i
+    REAL(r_std)                                   :: rho_air            !! temporary for number checking   
+
+    IF (jnlvls .gt. 1) THEN
+
+        DO i = 1, jnlvls-1
+            h_flux(i) = -1.0_r_std * cp_air * rho_air * &
+              & ((temp_atmos_next(i+1) - temp_atmos_next(i)) * k_eddy(i))/delta_z(i)
+        END DO ! i = 1, jnlvls-1
+
+        IF (printlev_loc>=4) THEN
+            WRITE(numout,*) 'cp_air * rho_air is: ', cp_air * rho_air
+            WRITE(numout,*) 'h_flux_top is: ', h_flux(jnlvls-1)
+        END IF !(printlev_loc>=4)
+
+        DO i = 1, jnlvls-1
+            le_flux(i) = -1.0_r_std * chalev0 * rho_air * &
+              & ((q_atmos_next(i+1) - q_atmos_next(i)) * k_eddy(i))/delta_z(i)
+        END DO ! i = 1, jnlvls-1
+
+    END IF ! (jnlvls .gt. 1) THEN
+
+    IF (printlev_loc>=4) THEN
+       WRITE(numout,*) 'chalev0 * rho_air is: ', chalev0 * rho_air
+       WRITE(numout,*) 'le_flux_top is: ', le_flux(jnlvls-1)
+    END IF !(printlev_loc>=4)
+
+ END SUBROUTINE mleb_calc_fluxes
+
+
+ ! ---------------------------------------------------------------------------------------
+
+  !!  ====================================================================================
+  !! SUBROUTINE                 : mleb_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 mleb_begin (kjpindex, temp_sol, lwdown, swnet, pb, psold, qsol_sat, &
+                               & pdqsold, netrad, emis, dev_qsol)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_sol         !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: lwdown           !! Down-welling long-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: swnet            !! Net surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: pb               !! Lowest level pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: emis             !! Emissivity (-)
+
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: psold            !! Old surface dry static energy (J kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: qsol_sat         !! Saturated specific humudity for old temperature 
+                                                                           !! (kg kg^{-1})    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: pdqsold          !! Derivative of satured specific humidity at the old 
+                                                                           !! temperature (kg (kg s)^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: netrad           !! Net radiation (W m^{-2})
+    REAL(r_std), DIMENSION(kjpindex)                   :: dev_qsol
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ji
+
+    REAL(r_std), PARAMETER                             :: missing = 999998.
+!_ ================================================================================================================================
+  
+  !  write(numout, *) 'mleb_begin lwdown:', lwdown(:)
+  !! 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'
+    IF(printlev_loc >= 4) WRITE(numout,*)'271016 mleb_begin, temp_sol', temp_sol
+    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,'mleb_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)
+    
+    IF (printlev_loc>=4) THEN
+!!$       WRITE(numout,*) '***** 010213 *****'
+!!$       WRITE(numout,*) ' '
+!!$       WRITE(numout,*) 'after CALL dev_qsatcalc'
+!!$       WRITE(numout,*) 'temp_sol(1) is: ', temp_sol(1)
+!!$       WRITE(numout,*) 'pb(1) is: ', pb(1)
+!!$       WRITE(numout,*) 'dev_qsol(1) is: ', dev_qsol(1)        
+!!$       WRITE(numout,*) 'EFFECTIVE jalpha is: ', dev_qsol(1)
+!!$       WRITE(numout,*) 'EFFECTIVE jbeta is: ', qsol_sat(1) - temp_sol(1) * dev_qsol(1)
+    ENDIF  ! (printlev_loc>=4)
+
+
+!+++ According to r2093 in the trunk, this causes and instabilty in the coupling
+!    DO ji = 1, kjpindex
+!!$    
+!!$    !! \latexonly 
+!!$    !!     \input{enerbilbegin2.tex}
+!!$    !! \endlatexonly
+!      pdqsold(ji) = dev_qsol(ji) * ( pb(ji)**kappa ) / cp_air
+!    ENDDO
+
+    pdqsold(:) = dev_qsol(:)
+!+++++++++
+
+    IF ( diag_qsat ) THEN
+      IF ( ANY(ABS( pdqsold(:)) .GT. missing) ) THEN
+        DO ji = 1, kjpindex
+          IF ( ABS( pdqsold(ji)) .GT. missing ) THEN
+            WRITE(numout,*) 'ERROR on ji = ', ji
+            WRITE(numout,*) 'temp_sol(ji),  pb(ji) :', temp_sol(ji),  pb(ji)
+            CALL ipslerr (3,'enerbil_begin', &
+ &           'pdqsold too high ','','')
+          ENDIF
+        ENDDO
+      ENDIF
+    ENDIF
+
+
+  !! 4. Computes the net radiation and the absorbed LW radiation absorbed at the surface. 
+
+    !! Long wave radiation absorbed by the surface is the product of emissivity and downwelling LW radiation    
+    !! \latexonly 
+    !!     \input{enerbilbegin3.tex}
+    !! \endlatexonly
+    lwabs(:) = emis(:) * lwdown(:)
+
+    !! Net radiation is calculated as:
+    !! \latexonly 
+    !!     \input{enerbilbegin4.tex}
+    !! \endlatexonly
+    netrad(:) = lwdown(:) + swnet (:) - (emis(:) * c_stefan * temp_sol(:)**4 + &
+                 & (un - emis(:)) * lwdown(:)) 
+    !
+    IF (printlev>=3) WRITE (numout,*) ' mleb_begin done '
+
+
+    !+++ TEMP FOR NIGHTTIME K_EDDY_FAC ++++
+    !DO ji =1, kjpindex
+    !      IF (swnet(ji) <= 0 ) THEN
+    !          k_eddy_fac =0.01
+    !      ELSE
+    !          CALL getin_p('K_EDDY_FAC', k_eddy_fac) 
+    !      ENDIF
+    !ENDDO
+    !+++++++++++++++++++++++++++++++++++++
+
+
+  END SUBROUTINE mleb_begin
+
+ ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+
+
+
+ !! =============================================================================================================================
+ !! SUBROUTINE                  : mleb_pottemp
+ !!
+ !>\BRIEF       This subroutine computes the surface temperature and humidity should the surface been unstressed    
+ !!
+ !! DESCRIPTION             : 
+ !!
+ !! MAIN OUTPUT VARIABLE(S) : q_sol_pot, temp_sol_pot
+ !!
+ !! REFERENCE(S)        :
+ !!
+ !! FLOWCHART    : None
+ !!
+ !_ ==============================================================================================================================  
+
+  SUBROUTINE mleb_pottemp (kjpindex, zlev, emis, epot_air, &
+     & petAcoef, petBcoef, qair, peqAcoef, peqBcoef, soilflx, rau, u, v, q_cdrag, vbeta,&
+     & vbeta1, vbeta5, soilcap, lwdown, swnet, q_sol_pot, temp_sol_pot) 
+
+    !! 0.1 Input variables
+    !! 0.2 Output variables
+    !! 0.3 Modified variables
+    !! 0.4 Local variables
+
+    ! interface 
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex      !! Domain size
+    ! input fields
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: zlev          !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: emis          !! Emissivity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air      !! Air potential energy
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petAcoef      !! PetAcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petBcoef      !! PetBcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair          !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqAcoef      !! PeqAcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqBcoef      !! PeqBcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilflx       !! Soil flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau           !! Density
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u, v          !! Wind
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag       !! Surface drag coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta         !! Resistance coefficient
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta1        !! Snow resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta5        !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilcap       !! Soil calorific capacity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown        !! Down-welling long-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet         !! Net surface short-wave flux
+    ! output fields
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: q_sol_pot     !! Potential surface air moisture
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: temp_sol_pot  !! Potential soil temperature
+
+
+    ! local declaration
+    INTEGER(i_std)                  :: ji
+    REAL(r_std),DIMENSION (kjpindex) :: zicp
+    REAL(r_std)                      :: fevap
+    REAL(r_std)                      :: sensfl_old, larsub_old, lareva_old, dtheta, sum_old, sum_sns
+    REAL(r_std)                      :: zikt, zikq, netrad_sns, sensfl_sns, larsub_sns, lareva_sns
+    REAL(r_std)                      :: speed
+
+!_ ==============================================================================================================================
+
+    zicp = un / cp_air
+
+    ! initialisation of variables
+    temp_sol_pot(:)=zero
+    q_sol_pot(:)=zero
+
+    !
+    DO ji=1,kjpindex
+
+       dtheta = zero
+       fevap = zero
+
+       temp_sol_pot(ji) = temp_sol_pot(ji) + dtheta
+
+       q_sol_pot(ji) = q_sol_pot(ji) + fevap
+
+    ENDDO
+
+  END SUBROUTINE mleb_pottemp
+
+
+
+  ! ------------------------------------------------------------------------------------------------------------------------------
+
+
+
+
+  SUBROUTINE mleb_evapveg (kjpindex, vbeta1, vbeta2, vbeta3, vbeta3pot, &
+     & vbeta4, vbeta5, rau, u, v, q_cdrag, qair, humrel, &
+!!$     & vbeta4, vbeta5, cimean, ccanopy, rau, u, v, q_cdrag, qair, humrel, &
+     & vevapsno, vevapnu , vevapflo, vevapwet, transpir, transpot, evapot)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjpindex          !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: vbeta1            !! Snow resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: vbeta4            !! Bare soil resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: vbeta5            !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: rau               !! Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: u, v              !! Wind velocity in directions u and v (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: q_cdrag           !! Surface drag coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: qair              !! Lowest level specific humidity (kg kg^{-1})
+!!$    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: ccanopy           !! CO2 concentration in the canopy (ppm)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: evapot            !! Soil Potential Evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex, nvm), INTENT (in)  :: humrel            !! Soil moisture stress (within range 0 to 1)
+    !!$ DS 15022011 humrel was used in a previous version of Orchidee, developped by Nathalie. Need to be discussed if it should be introduce again             
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: vbeta2            !! Interception resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: vbeta3            !! Vegetation resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: vbeta3pot         !! Vegetation resistance for potential transpiration
+!!$    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: cimean            !! STOMATE: mean intercellular ci \mu mole m^{-2} s^{-1}
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: vevapsno          !! Snow evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: vevapnu           !! Bare soil evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: vevapflo         !! Floodplains evaporation
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: transpir          !! Transpiration (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: transpot          !! Potential Transpiration
+    ! JR GPP calculation is now carried out in diffuco 
+!   REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: gpp               !! Assimilation (gC m^{-2}, total area)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: vevapwet          !! Interception (mm day^{-1})
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jv
+    REAL(r_std), DIMENSION(kjpindex)                    :: xx
+    REAL(r_std), DIMENSION(kjpindex)                    :: vbeta2sum, vbeta3sum
+    REAL(r_std)                                     :: speed         !! Speed (m s^{-1})
+!_ ==============================================================================================================================
+    ! initialisation: utile pour calculer l'evaporation des floodplains dans lesquelles il y a de la vegetation
+    vbeta2sum(:) = 0.
+    vbeta3sum(:) = 0.
+    DO jv = 1, nvm
+      vbeta2sum(:) = vbeta2sum(:) + vbeta2(:,jv)
+      vbeta3sum(:) = vbeta3sum(:) + vbeta3(:,jv)
+    ENDDO 
+    
+    IF (printlev_loc>=4) WRITE (numout,*) '041113 vbeta3sum is: ', vbeta3sum   
+
+    !! 1. Compute vevapsno (evaporation from snow) and vevapnu (bare soil evaporation)
+
+    DO ji=1,kjpindex 
+
+        !! \latexonly 
+        !!     \input{enerbilevapveg1.tex}
+        !! \endlatexonly
+        speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+
+      
+        !! 1.1 Snow sublimation
+        !! \latexonly 
+        !!     \input{enerbilevapveg2.tex}
+        !! \endlatexonly
+        vevapsno(ji) = (un - vbeta5(ji)) * vbeta1(ji) * dt_sechiba * rau(ji) * speed * &
+                      & q_cdrag(ji) * (qsol_sat_new(ji) - qair(ji))
+
+        !! 1.2 Bare soil evaporation
+        !! \latexonly 
+        !!     \input{enerbilevapveg3.tex}
+        !! \endlatexonly
+        vevapnu(ji) = (un - vbeta1(ji)) * (un-vbeta5(ji)) * vbeta4(ji) * dt_sechiba * &
+                     & rau(ji) * speed * q_cdrag(ji) * (qsol_sat_new(ji) - qair(ji))
+
+        !
+        ! 1.3 floodplains evaporation - transpiration et interception prioritaires dans les floodplains
+        !
+        vevapflo(ji) = vbeta5(ji) * (1 - vbeta2sum(ji) - vbeta3sum(ji)) &
+             & * dt_sechiba * rau(ji) * speed * q_cdrag(ji) * (qsol_sat_new(ji) - qair(ji))
+
+    END DO
+
+    !! 2. Compute transpir (transpiration) and vevapwet (interception)
+  
+    !! Preliminaries
+    DO ji = 1, kjpindex
+       
+        !! \latexonly 
+        !!     \input{enerbilevapveg4.tex}
+        !! \endlatexonly
+        speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+       
+        !! \latexonly 
+        !!     \input{enerbilevapveg5.tex}
+        !! \endlatexonly
+        !+++TEMP+++
+!!$        IF (printlev_loc>=4) THEN
+!!$           WRITE(numout,*) 'Checking transpir'
+!!$           WRITE(numout,*) 'vbeta1(ji), ',vbeta1(ji)
+!!$           WRITE(numout,*) 'qsol_sat_new(ji)', qsol_sat_new(ji)
+!!$           WRITE(numout,*) 'qair(ji), ', qair(ji)
+!!$           WRITE(numout,*) 'rau(ji), ', rau(ji)
+!!$           WRITE(numout,*) 'speed, ', speed
+!!$           WRITE(numout,*) 'q_cdrag(ji)', q_cdrag(ji)
+!!$           WRITE(numout,*) 'vbeta3(ji,jv)', vbeta3(ji,:)
+!!$        ENDIF
+        xx(ji) = dt_sechiba * (un-vbeta1(ji)) * (qsol_sat_new(ji)-qair(ji)) &
+                 & * rau(ji) * speed * q_cdrag(ji)
+        !++++++++++
+     
+    ENDDO
+    
+    DO jv=1,nvm 
+      DO ji=1,kjpindex 
+        
+        !! 2.1 Calculate interception loss
+        !! \latexonly 
+        !!     \input{enerbilevapveg6.tex}
+        !! \endlatexonly
+        vevapwet(ji,jv) = xx(ji) * vbeta2(ji,jv)
+        ! 
+        !! 2.2 Calculate transpiration
+        !! \latexonly 
+        !!     \input{enerbilevapveg7.tex}
+        !! \endlatexonly
+        transpir (ji,jv) = xx(ji) * vbeta3(ji,jv)
+
+           ! IF (jv .eq. 4) THEN
+           !      WRITE(numout,*) '261113b in first calc PFT4, vbeta3(ji,jv) is: ', vbeta3(ji,jv)
+           !      WRITE(numout,*) '261113b in first calc PFT4, transpir (ji,jv) is: ', transpir (ji,jv)
+           !      WRITE(numout,*) '261113b in first calc PFT4, (1.0_r_std - vbeta1(ji)) is: ', (1.0_r_std - vbeta1(ji))
+           !      WRITE(numout,*) '261113b in first calc PFT4, qsol_sat_new(ji) is: ', qsol_sat_new(ji)
+           !      WRITE(numout,*) '261113b in first calc PFT4, qair(ji) is: ', qair(ji)
+           !      WRITE(numout,*) '261113b in first calc PFT4, ( rau(ji) * speed * q_cdrag(ji)) is: ', ( rau(ji) * speed * q_cdrag(ji))
+           ! END IF
+
+        transpot(ji,jv) = xx(ji) * vbeta3pot(ji,jv)
+
+      END DO
+    END DO
+
+    IF (printlev>=4) WRITE (numout,*) ' enerbil_evapveg done '
+
+  END SUBROUTINE mleb_evapveg
+
+
+  !!  =============================================================================================================================
+  !! 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 mleb_flux (kjpindex, emis, temp_sol, rau, u, v, q_cdrag, vbeta, vbeta1, vbeta5, &
+       & qair, epot_air, psnew, qsurf, fluxsens, fluxlat, fluxsubli, vevapp, temp_sol_new, &
+       & lwdown, swnet, lwup, lwnet, pb, tsol_rad, netrad, evapot, evapot_corr)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex      !! Domain size (-)
+    REAL(r_std),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 coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta         !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta1        !! Snow resistance  (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta5        !! Flood resistance 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair          !! Lowest level specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air      !! Air potential energy (J)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: psnew         !! New surface static energy (J kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_sol_new  !! New soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb            !! Lowest level pressure (hPa)
+
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qsurf         !! Surface specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex)                         :: fluxsens      !! Sensible heat flux (W m^{-2})   ! not output here, calculated in mleb_calc_column instead
+    REAL(r_std),DIMENSION (kjpindex)                         :: fluxlat       !! Latent heat flux (W m^{-2})     ! not output here, calculated in mleb_calc_column instead
+    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)
+
+       !! 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)
+
+       !! The implicit solution computes an emitted long-wave flux which is a limited Taylor expansion 
+       !! of the future surface temperature around the current values. Thus the long-wave flux does not  
+       !! correspond to the new surface temperature but some intermediate value. So we need to deduce the 
+       !! radiative surface temperature to which this flux corresponds. 
+       !! 
+
+       tsol_rad(ji) = (lwup(ji)/ (emis(ji) * c_stefan)) **(1./quatre) 
+
+       !! qsurf (the surface specific humidity) is a simple diagnostic which will be used by the 
+       !! GCM to compute the dependence of of the surface layer stability on moisture.
+       !! \latexonly 
+       !!     \input{enerbilflux6.tex}
+       !! \endlatexonly
+       qsurf(ji) = (vbeta1(ji) * (un - vbeta5(ji)) + vbeta5(ji)) * qsol_sat_new(ji) + &
+            & (un - vbeta1(ji))*(un - vbeta5(ji)) * vbeta(ji) * qsol_sat_new(ji)
+
+       IF (ji .eq. 1 .AND. (printlev_loc>=4)) THEN
+          WRITE(numout,*) "qsurf(1) is: ", qsurf(1) 
+          WRITE(numout,*) "qair(1) is: ", qair(1) 
+       END IF
+
+       !! \latexonly 
+       !!     \input{enerbilflux7.tex}
+       !! \endlatexonly
+       qsurf(ji) = MAX(qsurf(ji), qair(ji))
+
+       !! Net downward radiation is the sum of the down-welling less the up-welling long wave flux, plus
+       !! the short wave radiation.
+       !! \latexonly 
+       !!     \emissivity absorbed lw radiationinput{enerbilflux8.tex}
+       !! \endlatexonly
+       netrad(ji) = lwdown(ji) + swnet(ji) - lwup(ji) 
+
+       !! 'vevapp' is the sum of the total evaporative processes (snow plus non-snow processes).
+       !! \latexonly 
+       !!     \input{enerbilflux9.tex}
+       !! \endlatexonly
+       vevapp(ji) = dt_sechiba * rau(ji) * qc * (vbeta1(ji) * (un - vbeta5(ji)) + vbeta5(ji)) * &
+            & (qsol_sat_new(ji) - qair(ji)) + &
+            &  dt_sechiba * rau(ji) * qc * (un - vbeta1(ji))*(un-vbeta5(ji)) * vbeta(ji) * &
+            & (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
+       ! ( commented out here, as calculated in mleb_calc_column for now)
+       ! fluxlat(ji) = chalsu0 * rau(ji) * qc * vbeta1(ji) * (un - vbeta5(ji)) * &
+       !      & (qsol_sat_new(ji) - qair(ji)) + &
+       !      &  chalev0 * rau(ji) * qc * vbeta5(ji) *&
+       !      & (qsol_sat_new(ji) - qair(ji)) + &
+       !      &  chalev0 * rau(ji) * qc * (un - vbeta1(ji)) * (un - vbeta5(ji)) * vbeta(ji) * &
+       !      & (valpha(ji) * qsol_sat_new(ji) - qair(ji))
+
+       !! The sublimination flux concerns is calculated using vbeta1, the snow resistance.
+       !! \latexonly 
+       !!     \input{enerbilflux11.tex}
+       !! \endlatexonly
+       fluxsubli(ji) = chalsu0 * rau(ji) * qc * vbeta1(ji) * (un - vbeta5(ji)) * &
+            & (qsol_sat_new(ji) - qair(ji)) 
+
+       !! The sensible heat flux is a factor of the difference between the new surface static energy
+       !! and the potential energy of air.
+       !! \latexonly 
+       !!     \input{enerbilflux12.tex}
+       !! \endlatexonly
+       !fluxsens(ji) =  rau(ji) * qc * (psnew(ji) - epot_air(ji))
+
+       !! This is the net longwave downwards radiation.
+       !! \latexonly 
+       !!     \input{enerbilflux13.tex}
+       !! \endlatexonly
+       lwnet(ji) = lwdown(ji) - lwup(ji)
+
+       !! Diagnoses the potential evaporation used for the fluxes (evapot)
+       !! \latexonly 
+       !!     \input{enerbilflux14.tex}
+       !! \endlatexonly  
+       evapot(ji) =  MAX(zero, dt_sechiba * rau(ji) * qc * (qsol_sat_new(ji) - qair(ji)))
+
+       !! From definition we can say:
+       !! \latexonly 
+       !!     \input{enerbilflux15.tex}
+       !! \endlatexonly 
+
+       IF(printlev_loc >= 4) THEN
+            WRITE(numout,*)'071116 mleb_flux tair before',tair(ji)
+            WRITE(numout,*)'071116 mleb_flux epot_air before',epot_air(ji)
+       ENDIF 
+       tair(ji)  =  epot_air(ji) / cp_air
+       IF(printlev_loc >= 4) WRITE(numout,*)'071116 mleb_flux tair after',tair(ji)
+
+    ENDDO ! DO ji=1,kjpindex
+
+    !! 3. Define qsat_air with the subroutine src_parameter:
+
+    ! WRITE(*,*) '181113a test, pre call to qsatcalc enerbil line 6210; tair is: ', tair
+    CALL qsatcalc(kjpindex, tair, pb, qsat_air)
+    CALL dev_qsatcalc(kjpindex, tair, pb, grad_qsat)
+
+    ! grad_qsat(:)= (qsol_sat_new(:)- qsat_air(:)) / ((psnew(:) - epot_air(:)) / cp_air) ! * dt_sechiba
+    !- Penser a sortir evapot en meme temps qu'evapot_corr tdo.
+
+    warning_correction(:)=.FALSE.
+    DO ji=1,kjpindex
+
+       !! \latexonly 
+       !!     \input{enerbilflux16.tex}
+       !! \endlatexonly 
+       speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+
+       !! \latexonly 
+       !!     \input{enerbilflux17.tex}
+       !! \endlatexonly 
+       qc = speed * q_cdrag(ji)
+
+       !! Derive the potential as defined by Penman & Monteith (Monteith, 1965) based on the correction 
+       !! term developed by Chris Milly (1992).
+       IF ((evapot(ji) .GT. zero) .AND. ((psnew(ji) - epot_air(ji)) .NE. zero )) THEN
+          
+          !! \latexonly 
+          !!     \input{enerbilflux18.tex}
+          !! \endlatexonly 
+          correction =  (quatre * emis(ji) * c_stefan * tair(ji)**3 + rau(ji) * qc * cp_air + &
+               &                  chalev0 * rau(ji) * qc * grad_qsat(ji) * vevapp(ji) / evapot(ji) )
+
+          !! \latexonly 
+          !!     \input{enerbilflux19.tex}
+          !! \endlatexonly 
+          IF (ABS(correction) .GT. min_sechiba) THEN
+             correction = chalev0 * rau(ji) * qc * grad_qsat(ji) * (un - vevapp(ji)/evapot(ji)) / correction
+          ELSE
+             warning_correction(ji)=.TRUE.
+          ENDIF
+
+       ELSE
+
+          correction = zero
+
+       ENDIF
+
+       correction = MAX (zero, correction)
+
+       !! \latexonly 
+       !!     \input{enerbilflux20.tex}
+       !! \endlatexonly 
+       evapot_corr(ji) = evapot(ji) / (un + correction)
+
+    ENDDO
+
+    IF ( ANY(warning_correction) ) THEN
+       DO ji=1,kjpindex
+          IF ( warning_correction(ji) ) THEN
+             WRITE(numout,*) ji,"Denumerator of the Milly Correction is zero, so no correction has been applied"
+          ENDIF
+       ENDDO
+    ENDIF
+
+    IF (printlev>=4) WRITE (numout,*) ' enerbil_flux done '
+
+  END SUBROUTINE mleb_flux
+
+
+ !!  ===========================================================================================================================
+  !! SUBROUTINE                 : enerbil_write
+  !!
+  !!
+  !>\BRIEF                      Write a bunch of variables to the history file
+  !!
+  !! DESCRIPTION                : 
+  !! Originally the routine enerbil_main was used for this, but that seemed to create
+  !! problems with uninitialized variables when it was called after mleb_main.
+  !! \n
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! MAIN OUTPUT VARIABLE(S)    : None
+  !!
+  !! REFERENCE(S)       :
+  !!
+  !! FLOWCHART          :
+  !! \n
+  !_ ==============================================================================================================================
+   
+  SUBROUTINE enerbil_write (kjit, kjpindex, &
+       & index, lwdown, temp_sol, &
+!!$       & index, lwdown, ccanopy, temp_sol, &
+       & temp_sol_new, evapot, evapot_corr, 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)                           :: hist_id       !! _Restart_ file and _history_ file identifier (-)
+    INTEGER(i_std),INTENT (in)                           :: hist2_id      !! _history_ file 2 identifier (-)
+    
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: index         !! Indeces of the points on the map (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: lwdown        !! Down-welling long-wave flux (W m^{-2})
+!!$    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: ccanopy       !! CO_2 concentration in the canopy (ppm)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: evapot        !! Soil Potential Evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: evapot_corr   !! Soil Potential Evaporation Correction (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: temp_sol      !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: temp_sol_new  !! New soil temperature (K)
+
+    !! 0.2 Output variables
+    
+    !! 0.3 Modified variables
+    
+    
+    !! 0.4 Local variables
+
+
+!_ ================================================================================================================================
+    
+    
+    
+     !CALL xios_orchidee_send_field("netrad",netrad)
+     CALL xios_orchidee_send_field("evapot",evapot*one_day/dt_sechiba)
+     CALL xios_orchidee_send_field("evapot_corr",evapot_corr*one_day/dt_sechiba)
+     CALL xios_orchidee_send_field("lwdown",lwabs)
+     CALL xios_orchidee_send_field("lwnet",lwnet)
+     CALL xios_orchidee_send_field("Qv",fluxsubli)
+     CALL xios_orchidee_send_field("PotSurfT",temp_sol_pot)
+     
+     IF ( .NOT. almaoutput ) THEN
+        !CALL histwrite_p(hist_id, 'netrad', kjit, netrad, kjpindex, index)
+        CALL histwrite_p(hist_id, 'evapot', kjit, evapot, kjpindex, index)
+        CALL histwrite_p(hist_id, 'evapot_corr', kjit, evapot_corr, kjpindex, index)
+        CALL histwrite_p(hist_id, 'lwdown', kjit, lwabs,  kjpindex, index)
+        CALL histwrite_p(hist_id, 'lwnet',  kjit, lwnet,  kjpindex, index)
+        IF ( hist2_id > 0 ) THEN
+           !CALL histwrite_p(hist2_id, 'netrad', kjit, netrad, kjpindex, index)
+           CALL histwrite_p(hist2_id, 'evapot', kjit, evapot, kjpindex, index)
+           CALL histwrite_p(hist2_id, 'evapot_corr', kjit, evapot_corr, kjpindex, index)
+           CALL histwrite_p(hist2_id, 'lwdown', kjit, lwabs,  kjpindex, index)
+           CALL histwrite_p(hist2_id, 'lwnet',  kjit, lwnet,  kjpindex, index)
+        ENDIF
+     ELSE
+        CALL histwrite_p(hist_id, 'LWnet', kjit, lwnet, kjpindex, index)
+        CALL histwrite_p(hist_id, 'Qv', kjit, fluxsubli, kjpindex, index)
+        CALL histwrite_p(hist_id, 'PotEvap', kjit, evapot_corr, kjpindex, index)
+        CALL histwrite_p(hist_id, 'PotEvapOld', kjit, evapot, kjpindex, index)
+        CALL histwrite_p(hist_id, 'PotSurfT', kjit, temp_sol_pot, kjpindex, index)
+        IF ( hist2_id > 0 ) THEN
+           CALL histwrite_p(hist2_id, 'LWnet', kjit, lwnet, kjpindex, index)
+           CALL histwrite_p(hist2_id, 'Qv', kjit, fluxsubli, kjpindex, index)
+           CALL histwrite_p(hist2_id, 'PotEvap', kjit, evapot_corr, kjpindex, index)
+        ENDIF
+     ENDIF
+     
+    IF (printlev>=4) WRITE (numout,*) ' enerbil_main Done '
+
+  END SUBROUTINE enerbil_write
+
+  ! --------------------------------------------------------------------------------------------------------
+
+!! ADD HEADER
+
+  SUBROUTINE mleb_reallocate_column(present_height, next_height, temp_atmos_pres_grid,   &
+                               &   q_atmos_pres_grid, temp_leaf_pres_grid,               &
+                               &   jtheta, rho_veg, leaf_tks, rau, pad_deltah, kjpindex)
+
+    REAL(r_std), DIMENSION (0:jnlvls)                                         :: present_height             ! present height above zero in column (m)
+    REAL(r_std), DIMENSION (0:jnlvls)                                         :: next_height                ! next height above zero in column (m)
+    REAL(r_std), DIMENSION (jnlvls)                                           :: delta_h_present             ! present box height in column (m)
+    REAL(r_std), DIMENSION (jnlvls)                                           :: delta_h_next                ! next box height in column (m)
+    REAL(r_std), DIMENSION (kjpindex, jnlvls)                                 :: temp_atmos_pres_grid
+    REAL(r_std), DIMENSION (kjpindex, jnlvls)                                 :: q_atmos_pres_grid
+    REAL(r_std), DIMENSION (kjpindex, jnlvls)                                 :: temp_leaf_pres_grid
+    REAL(r_std), DIMENSION (jnlvls)                                           :: present_energy             ! energy stored in present box space (J)
+    REAL(r_std), DIMENSION (jnlvls)                                           :: next_energy                ! energy stored in next box space (J)
+    REAL(r_std)                                                               :: sum_next_energy            ! energy stored in the next step over the whole column
+    REAL(r_std), DIMENSION (jnlvls_canopy)                                    :: present_energy_tree        ! energy stored in present vegetation box space (J)
+    REAL(r_std), DIMENSION (jnlvls_canopy)                                    :: next_energy_tree           ! energy stored in next vegetation box space (J)
+    INTEGER(i_std)                                                            :: i, j                       ! integers for counting
+    INTEGER(i_std)                                                            :: m, n, l                    ! number of levels in each part of the canopy 
+                                                                                                            !  (lower canopy, over canopy, above canopy)
+    INTEGER(i_std)                                                            :: total_layers               ! total number of layers in model
+    REAL(r_std)                                                               :: rho_veg                    ! temporary for number checking
+    REAL(r_std)                                                               :: leaf_tks                   ! leaf thickness
+    REAL(r_std), DIMENSION (jnlvls)                                           :: jtheta
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)                            :: rau                        !! Air density (kg m^{-3})
+    REAL(r_std), DIMENSION (0:jnlvls)                                         :: pad_deltah                 ! Plant Area Density multiplied by layer height
+    INTEGER(i_std), INTENT(in)                                                :: kjpindex                   !! Domain size (-) 
+
+    !_ ======================================================================================================================
+
+    m = jnlvls_under ! 5 ! number of levels in the lower canopy (treated as empty space for now)
+    n = jnlvls_canopy ! 5 ! number of levels in the over canopy (where the vegetation is)
+    l = jnlvls_over ! 5 ! number of levels above the canopy, but below the interface point with LMDz 
+
+    total_layers = m + n + l
+
+    ! ALLOCATE ( present_height(0:total_layers) )
+    ! ALLOCATE ( next_height(0:total_layers) )
+
+    ! ALLOCATE ( present_energy(total_layers) )
+    ! ALLOCATE ( next_energy(total_layers) )
+
+    ! ALLOCATE ( present_energy_tree(n) )
+    ! ALLOCATE ( next_energy_tree(n) )
+
+    present_energy(:) = 1.0d0
+
+
+    DO i=1, jnlvls
+        delta_h_present(i) = present_height(i) - present_height(i-1)
+    END DO !i=1, jnlvls
+
+    DO i=1, jnlvls
+        delta_h_next(i) = next_height(i) - next_height(i-1)
+    END DO !i=1, jnlvls
+
+    DO i=1, jnlvls
+        present_energy(i) = delta_h_present(i) * cp_air * rau(1) * temp_atmos_pres_grid(1, i) ! temporary rau set to first pixel in series
+    END DO !i=1, jnlvls
+
+    DO i=1, jnlvls_canopy
+        present_energy_tree(i) = delta_h_present(i) * rho_veg * leaf_tks * pad_deltah(i) * jtheta(i) * temp_leaf_pres_grid(1, i) ! temporary rau set to first pixel in series
+    END DO !i=1, jnlvls
+
+    ! initialise variables (just use simple ones here, whilst testing the arithmetic)
+    ! present_energy(:) = 1.0d0
+    next_energy(:) = 0.0d0
+    sum_next_energy = 0.0d0
+    next_energy_tree(:) = 0.0d0
+   
+    IF(printlev_loc >= 4 ) THEN
+       WRITE(numout,*) 'next_height and present_height'
+    !   DO j = 0, total_layers           ! next step loop
+         DO i = 0, total_layers       ! present step loop
+            WRITE(numout,*) i,' ; ', next_height(i),' ; ', present_height(i)   
+         END DO
+    !   END DO
+    ENDIF ! (printlev_loc>=4)
+
+
+    DO i = 0, total_layers - 1           ! next step loop
+   !     WRITE(numout, *) 'present level depth ', i, ' : ', present_height(i+1) - present_height(i)
+    END DO
+
+    DO i = 0, total_layers - 1          ! next step loop
+!        WRITE(numout, *) 'next level depth ', i, ' : ', next_height(i+1) - next_height(i)
+    END DO
+
+
+    ! we re-allocate the energy in each atmospheric level (to reflect the new profile)
+    ! I hope that the below catches all the possible variations
+
+    DO j = 0, total_layers-1           ! next step loop
+      DO i = 0, total_layers-1         ! present step loop
+         IF ((present_height(i) .ge. next_height(j)) .and. (present_height(i) .lt. next_height(j+1))) THEN
+            IF (present_height(i+1) .gt. next_height(j+1)) THEN
+                next_energy(j+1) = next_energy(j+1) + &
+                                   & present_energy(i+1) * (next_height(j+1) - present_height(i))  &
+                                   & / (present_height(i+1) - present_height(i))
+            ELSE
+                next_energy(j+1) = next_energy(j+1) + present_energy(i+1)
+            ENDIF
+         ENDIF
+
+         
+         IF ((present_height(i) .lt. next_height(j)) .and. (present_height(i+1) .gt. next_height(j+1))) THEN
+              next_energy(j+1) = next_energy(j+1) + &
+                                  & present_energy(i+1) * (next_height(j+1) - next_height(j)) &
+                                  & / (present_height(i+1) - present_height(i))             
+         ENDIF
+
+         IF ((present_height(i) .lt. next_height(j)) .and. (present_height(i+1) .le. next_height(j+1))) THEN
+            IF (present_height(i+1) .gt. next_height(j)) THEN
+               next_energy(j+1) = next_energy(j+1) + &
+                                  &  present_energy(i+1) * (present_height(i+1) - next_height(j)) &
+                                  &  / (present_height(i+1) - present_height(i))
+            ENDIF
+         ENDIF
+      END DO ! i = 0, total_layers   ! next step loop
+    END DO ! j = 0, total_layers     ! present step loop
+
+
+    ! the heat storage in leaves is only for the layers in the upper canopy (at least for the moment)
+
+    DO i = 0, n-1
+    ! DO i = 0, total_layers-1
+        next_energy_tree(i + 1) = ((next_height(m+i+1) - next_height(m+i)) / &
+                                & (present_height(m+i+1) - present_height(m+i))) &
+                                & * (present_energy_tree(i + 1)) 
+    END DO ! i = 0, total_layers-1
+
+    ! WRITE(numout, *) '140115d next_energy(:) is: ', next_energy
+    ! WRITE(numout, *) '140115d next_energy_tree(:) is: ', next_energy_tree
+
+    DO i=1, jnlvls
+        temp_atmos_pres_grid(1, i) = present_energy(i) / ( delta_h_present(i) * cp_air * rau(1) ) 
+    END DO !i=1, jnlvls
+
+    DO i=1, jnlvls_canopy
+        temp_leaf_pres_grid(1, i) = present_energy_tree(i) / ( delta_h_present(i) * rho_veg * leaf_tks * pad_deltah(i) * jtheta(i) )
+    END DO !i=1, jnlvls
+
+    IF (printlev_loc>=4) THEN
+		DO i = 1, total_layers
+		   WRITE(numout,*) 'level: ', i, ' next_energy(j) is: ', next_energy(i)
+		END DO ! i = 1, total_layers
+
+		DO i = 1, m
+		   WRITE(numout,*) 'level: ', i, ' next_energy_tree(j) is: ', next_energy_tree(i)
+		END DO ! i = 1, total_layers
+    END IF ! (printlev_loc>=4) THEN
+
+
+  END SUBROUTINE mleb_reallocate_column 
+
+
+  ! --------------------------------------------------------------------------------------------------------
+
+ !!
+ !===========================================================================================================================
+ !! SUBROUTINE: mleb_boxheight
+ !!
+ !!
+ !>\BRIEF: calculates box heights and plant area density 
+ !!
+ !! DESCRIPTION: MAKE more detailed
+ !! 
+ !!
+ !! RECENT CHANGE(S): None
+ !!
+ !! MAIN OUTPUT VARIABLE(S): none
+ !!
+ !! REFERENCE(S):
+ !!
+ !! FLOWCHART:
+ !_
+ !==============================================================================================================================
+
+
+  SUBROUTINE  mleb_boxheight(kjpindex,laieff_isotrop, z_array_out, max_height_store, &
+                      & rau,temp_atmos_pres_grid, q_atmos_pres_grid,temp_leaf_pres_grid, &
+                      & box_height,top_lev, pad_deltah, jrpad)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+     INTEGER(i_std), INTENT(in)                                            :: kjpindex                !! Domain size (-)
+     REAL(r_std), DIMENSION(nlevels_tot,kjpindex,nvm), INTENT(in)          :: laieff_isotrop          !! Effective LAI
+     REAL(r_std),DIMENSION(kjpindex,nvm,ncirc,nlevels_tot), INTENT(in)     :: z_array_out             !! An output of h_array, to use in sechiba 
+     REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)                     :: max_height_store
+     REAL(r_std), DIMENSION (kjpindex), INTENT (in)                        :: rau                     !! Air density (kg m^{-3})
+
+
+    !! 0.2 Output variables
+     REAL(r_std), DIMENSION(jnlvls+1), INTENT(out)            :: top_lev
+     REAL(r_std), DIMENSION (0:jnlvls), INTENT(out)            :: jrpad                  !! PlantArea Density, replacement for values above 
+                                                                            !!(as definitions between different)
+     REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(out)     ::q_atmos_pres_grid
+
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(jnlvls+1), INTENT(out)               :: box_height
+    REAL(r_std), DIMENSION(jnlvls+1), INTENT(out)               :: pad_deltah
+    REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(out)      :: temp_leaf_pres_grid
+    REAL(r_std), DIMENSION (kjpindex, jnlvls), INTENT(out)      :: temp_atmos_pres_grid
+
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                               :: iv,i,ji,kjit,jv ! fix the indexing
+    INTEGER(i_std)                               :: ij    
+ 
+    REAL(r_std)                                  :: pft_running_total
+    REAL(r_std), DIMENSION(0:jnlvls)             :: pad_deltah_running_total
+    REAL(r_std), DIMENSION(jnlvls+1)             :: box_height_running_total
+    REAL(r_std), DIMENSION(jnlvls+1)             :: box_height_old
+
+
+! note to my self. When box_height,boc_height_old and pad_deltah is module var, are they then
+! needed in the subroutine call??
+
+
+! ------------------------------------------------------------------------------------
+    !
+    ! there are two ways to arrive at the MLA (mass per unit leaf area, kg/m^2), 
+    ! which we then multiply by the LAD (leaf area density, m^2/m^3) to arrive
+    ! at the 
+    ! vegetation matter per m in height
+
+    ! 1) as in Nobel, Park S. (2005) 'Physiochemical and Environmental Plant
+    ! Physiology' 
+    ! Edition 3, published Elsevier, chapter 7.1, p. 309
+    !    - assume leaf has a specific heat of water (4.19 kJ kg^-1 degC^-1 at 20
+    !    degC)
+    !    - assume leaf has thickness 300micrometres
+    !    - assume leaf has density of 700kg/m^3 (water is 1000kg/m^3 but leaves
+    !    are often 
+    !        30% air)
+    !    - this gives (300 x 10^-6 m)(700 kg m^-3) = 0.21 kg m^-2
+
+    ! 2) Using LMA (leaf per unit mass area, m^2/kg) from the TRY database
+    !    - for Eucalyptus delegatensis we have 155 cm^2/g ---> 0.155 m^2/g. 
+    !      This is dried weight of the leaf.
+    !    - 100 gC/m^2 soil
+    !    - 100 * 2 * 10 = 2000 g C / m^2 soil
+    !    Dry weight / Fresh weight = 8 / SLA ---> g FW / m^2 (here we are
+    !    assuming a dry 
+    !                                               weight to fresh weight ratio
+    !                                               of 1:9)
+    !                              = 8 / 0.155
+    !                              = 516 g FW / m^2
+    !                              = 0.516 kg / m^2
+    ! 
+    ! ------------------------------------------------------------------------------------
+
+     ! asla WRITE(numout, *) 'kjpindex', kjpindex
+    ! asla  WRITE(numout, *) 'rau',rau
+     ! asla WRITE(numout, *) 'jtheta',jtheta
+     ! asla WRITE(numout, *) 'rho_veg', rho_veg
+     ! asla WRITE(numout, *) 'leaf_tks',leaf_tks
+     ! asla WRITE(numout, *) 'jnlvls', jnlvls
+     IF (printlev_loc>=4) THEN
+         WRITE (numout, *) 'SUM(laieff_isotrop(1:jnlvls_canopy, test_grid,test_pft)) is: ', &
+                                & SUM(laieff_isotrop(1:jnlvls_canopy,test_grid,test_pft))
+     END IF !(printlev_loc>=4)
+
+     IF (jnlvls .ne. 1) THEN
+        IF (jnlvls .ne. (jnlvls_under + jnlvls_canopy + jnlvls_over)) THEN
+            WRITE (numout, *) 'number of levels in canopy column imbalance'
+            STOP
+        END IF
+     END IF
+
+     IF (.NOT. ok_impose_can_structure) THEN
+
+         pft_running_total = 0.0d0
+         box_height_running_total = 0.0d0
+         pad_deltah_running_total = 0.0d0
+
+          DO ji = 1,1
+              ! Currently, the mleb only runs for one PFT, and therefore
+              ! jv is set to the PFT that is used instead of 1,nvm. 
+              ! DO jv = 1,nvm 
+               DO jv = 10,10
+
+                ! IF (veget_max(ji,jv) .GT. zero .AND. veget(ji,jv) .GT. zero)
+                ! THEN 
+
+                ! IF ((SUM(laieff_isotrop(1:jnlvls_canopy, ji, jv)) .gt.
+                ! min_sechiba) .AND. &
+                !      & (SUM(z_array_out(ji, jv, 1, :)) .gt. min_sechiba))
+                !      T/HEN
+
+                 !IF (SUM(z_array_out(ji, jv, 1, :)) .gt. min_sechiba) THEN
+
+                      ! update plant area density
+                      pad_deltah(:) = 0.001d0
+                      ! n.b. the first level of lai_eff_isotrop represents the
+                      ! understorey.
+                      ! We set this equal to the min!
+                      DO i = (jnlvls_under + 1) , (jnlvls_under + jnlvls_canopy)
+                         pad_deltah(i) = laieff_isotrop(i-jnlvls_under+1, ji,jv) * cos(pi/3.0d0)
+                          IF (pad_deltah(i) .lt. 1.0d-3) THEN
+                              pad_deltah(i) = 1.0d-3
+                          END IF
+                          IF (printlev_loc>=4) THEN
+                               WRITE (numout, *) '251016 laieff_isotrop:',i-jnlvls_under+1, ji, jv, 'is', &
+                                    laieff_isotrop(i-jnlvls_under,ji, jv)
+                              WRITE (numout, *) '160315 pad_deltah level: ',i,' is: ', pad_deltah(i)
+                          END IF ! (printlev_loc>=4)
+                       END DO ! i = (jnlvls_under + 1) , (jnlvls_under +jnlvls_canopy)
+
+                       IF (printlev_loc>=4) THEN
+                           WRITE (numout, *) 'in calculate box_heightsection,pft',jv
+                           WRITE (numout, *) 'max_height_store(ji,jv) is: ',max_height_store(ji, jv)
+                           WRITE (numout, *) 'z_array_out(ji,jv,1,:) is: ',z_array_out(ji, jv, 1, :)
+                       END IF ! (printlev_loc>=4) THEN
+
+                       DO i = 1, jnlvls_under - 1
+                           box_height(i) = (i) * (z_array_out(ji, jv, 1, 2) -z_array_out(ji, jv, 1, 1)) / (jnlvls_under)
+                       END DO ! 1, jnlvls_under - 1 
+
+                       box_height(jnlvls_under) = z_array_out(ji, jv, 1, 2)
+
+
+
+                       DO i = (jnlvls_under + 1), (jnlvls_under + jnlvls_canopy- 1)
+                           box_height(i) = z_array_out(ji, jv, 1, i -jnlvls_under + 2)
+                       END DO ! i = (jnlvls_under + 1), (jnlvls_under +jnlvls_canopy - 1)
+
+
+                       box_height(jnlvls_under + jnlvls_canopy) = max_height_store(ji, jv)
+
+                       DO i = (jnlvls_under + jnlvls_canopy + 1), (jnlvls_under+ jnlvls_canopy + jnlvls_over - 1)
+                           box_height(i) = max_height_store(ji, jv) + &
+                                           & (( i - (jnlvls_under +jnlvls_canopy) ) * &
+                                           & (49.0d0 - max_height_store(ji, jv))/ jnlvls_over )
+                       END DO ! i = (jnlvls_under + jnlvls_canopy + 1),(jnlvls_under + jnlvls_canopy + jnlvls_over)
+
+
+                       box_height(jnlvls_under + jnlvls_canopy + jnlvls_over) =49.0d0
+                       box_height(jnlvls_under + jnlvls_canopy + jnlvls_over+1)= 50.0d0
+
+                       jrpad(:) = pad_deltah(:)
+
+                       IF (printlev_loc>=4) THEN
+                           DO i = 1, jnlvls
+                               WRITE(numout, *) 'lev: ', i, ' b_h: ',box_height(i), ' p_d: ', pad_deltah(i)
+                           END DO ! i = 1, jnlvls
+                       END IF ! (printlev_loc>=4) THEN
+
+                ! END IF ! (SUM(laieff_isotrop(1:jnlvls_canopy, ji, jv)) .ne.
+                ! 0.0)
+
+
+
+                 ! IF (SUM(laieff_isotrop(1:jnlvls_canopy, ji, jv)) .gt.
+                 ! min_sechiba) THEN
+                      !  pft_running_total = pft_running_total + 1
+                 ! END IF
+
+                !  box_height_running_total = box_height_running_total +
+                !  box_height ! NOT needed for one PFT
+                !  pad_deltah_running_total = pad_deltah_running_total +
+                !  pad_deltah ! NOT needed for one PFT 
+
+               ! END IF !(veget_max(ji,jv) .GT. zero .AND. veget(ji,jv) .GT.
+               ! zero) THEN 
+
+          END DO ! jv = 2, nvm
+             IF (printlev_loc>=4) THEN
+                WRITE(numout, *) '100515 pft_running_total is: ',pft_running_total
+                WRITE(numout, *) '100515 box_height_running_total(:) is: ',box_height_running_total(:)
+                WRITE(numout, *) '100515 pad_deltah_running_total(:) is: ',pad_deltah_running_total(:)
+             END IF ! (printlev_loc>=4) THEN
+
+              ! IF (pft_running_total .gt. min_sechiba) THEN
+              !    box_height = box_height_running_total / pft_running_total
+              !    pad_deltah = pad_deltah_running_total / pft_running_total
+              ! ELSE
+              !    box_height = 0.0d0
+              !    pad_deltah = 0.0d0
+              ! ENDIF
+
+             !  box_height = box_height_running_total / 1.0d0  ! NOT needed for
+             !  one PFT
+             !  pad_deltah = pad_deltah_running_total / 1.0d0  ! NOT needed for
+             !  one PFT
+
+
+              box_height_old = box_height
+
+     !         IF (l_first_enerbil_column) THEN
+     !            l_first_enerbil_column = .FALSE.
+     !            IF (printlev_loc>=4) WRITE(numout, *) '020315 not calling
+     !            mleb_reallocate_column'
+     !         ELSE
+     !            IF (printlev_loc>=4) WRITE(numout, *) '020315 calling
+     !            mleb_reallocate_column'
+
+     !           According to James Ryder, mleb_reallocate does not need to be
+     !           called every time. Should be fixed at one point.
+                 CALL mleb_reallocate_column(box_height_old, box_height,  &
+                     &  temp_atmos_pres_grid, q_atmos_pres_grid,temp_leaf_pres_grid, &
+                     &  jtheta, rho_veg, leaf_tks, rau, pad_deltah, kjpindex)
+     !        ENDIF
+
+             IF(printlev_loc >= 4)THEN
+                WRITE(numout,*) 'box_height_old', box_height_old(:)
+                WRITE(numout,*) 'box_height', box_height(:)
+                WRITE(numout,*) 'temp_atmos_pres_grid',temp_atmos_pres_grid(ji,:)
+                WRITE(numout,*) 'q_atmos_pres_grid',q_atmos_pres_grid(ji,:) 
+                WRITE(numout,*) 'temp_leaf_pres_grid',temp_leaf_pres_grid(ji,:)
+             ENDIF ! (printlev_loc >= 4)
+             box_height_old = box_height
+
+
+          END DO ! ji = 1, kjpindex
+    ELSE
+    ! in cases ok_impose_can_structure is true mleb does not work
+    
+
+    END IF ! (ok_impose_can_structure) THEN 
+
+    top_lev(:) = box_height(:)
+
+
+  END SUBROUTINE mleb_boxheight
+
+  ! --------------------------------------------------------------------------------------------------------
+
+
+END MODULE enerbil
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/explicitsnow.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/explicitsnow.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/explicitsnow.f90	(revision 6412)
@@ -0,0 +1,1590 @@
+! ================================================================================================================================
+!  MODULE       : explicitsnow
+!
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF  Computes hydrologic snow processes on continental points.
+!!
+!!\n DESCRIPTION: This module computes hydrologic snow processes on continental points.
+!!
+!! RECENT CHANGES: 
+!!
+!! REFERENCES	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE explicitsnow
+  USE ioipsl_para
+  USE constantes_soil
+  USE constantes
+  USE pft_parameters 
+  USE qsat_moisture 
+  USE sechiba_io_p
+  USE xios_orchidee
+
+  IMPLICIT NONE
+
+  ! Public routines :
+  PRIVATE
+  PUBLIC :: explicitsnow_main, explicitsnow_initialize, explicitsnow_finalize
+
+CONTAINS
+
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_initialize
+!!
+!>\BRIEF        Read variables for explictsnow module from restart file
+!!                
+!! DESCRIPTION  : Read variables for explictsnow module from restart file
+!!
+!! \n
+!_
+!================================================================================================================================
+  SUBROUTINE explicitsnow_initialize( kjit,     kjpindex, rest_id,    snowrho,   &
+                                      snowtemp, snowdz,   snowheat,   snowgrain)
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                           :: kjit           !! Time step number 
+    INTEGER(i_std), INTENT(in)                           :: kjpindex       !! Domain size
+    INTEGER(i_std),INTENT (in)                           :: rest_id        !! Restart file identifier
+    
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowrho        !! Snow density (Kg/m^3)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowtemp       !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowdz         !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowheat       !! Snow heat content (J/m^2)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowgrain      !! Snow grainsize (m)
+    
+    
+    !! 1. Read from restart file
+    CALL restget_p (rest_id, 'snowrho', nbp_glo, nsnow, 1, kjit,.TRUE.,snowrho, "gather", nbp_glo, index_g)
+    CALL setvar_p (snowrho, val_exp, 'Snow Density profile', xrhosmin)
+    
+    CALL restget_p (rest_id, 'snowtemp', nbp_glo,  nsnow, 1, kjit,.TRUE.,snowtemp, "gather", nbp_glo,  index_g)
+    CALL setvar_p (snowtemp, val_exp, 'Snow Temperature profile', tp_00)
+    
+    CALL restget_p (rest_id, 'snowdz', nbp_glo,  nsnow, 1, kjit,.TRUE.,snowdz, "gather", nbp_glo,  index_g)
+    CALL setvar_p (snowdz, val_exp, 'Snow depth profile', 0.0)
+    
+    CALL restget_p (rest_id, 'snowheat', nbp_glo,  nsnow, 1, kjit,.TRUE.,snowheat, "gather", nbp_glo,  index_g)
+    CALL setvar_p (snowheat, val_exp, 'Snow Heat profile', 0.0)
+    
+    CALL restget_p (rest_id, 'snowgrain', nbp_glo,  nsnow, 1, kjit,.TRUE.,snowgrain, "gather", nbp_glo,  index_g)
+    CALL setvar_p (snowgrain, val_exp, 'Snow grain profile', 0.0)
+    
+  END SUBROUTINE explicitsnow_initialize
+  
+
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_main
+!!
+!>\BRIEF        Main call for snow calculations
+!!                
+!! DESCRIPTION  : Main routine for calculation of the snow processes with explictsnow module.
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  SUBROUTINE explicitsnow_main(kjpindex,    precip_rain,  precip_snow,   temp_air,    pb,       & ! in
+                               u,           v,            temp_sol_new,  soilcap,     pgflux,   & ! in
+                               frac_nobio,  totfrac_nobio,gtemp,                                & ! in
+                               lambda_snow, cgrnd_snow,   dgrnd_snow,                           & ! in  
+                               vevapsno,    snow_age,     snow_nobio_age,snow_nobio,  snowrho,  & ! inout
+                               snowgrain,   snowdz,       snowtemp,      snowheat,    snow,     & ! inout
+                               temp_sol_add,          					        & ! inout
+                               snowliq,     subsnownobio, grndflux,      snowmelt,    tot_melt, & ! output
+                               subsinksoil )                                                      ! output
+             
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                               :: kjpindex         !! Domain size
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_rain      !! Rainfall
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_snow      !! Snowfall
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: temp_air         !! Air temperature
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: pb               !! Surface pressure
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: u,v              !! Horizontal wind speed
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: temp_sol_new     !! Surface temperature
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: soilcap          !! Soil capacity
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: pgflux           !! Net energy into snowpack
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(in)     :: frac_nobio       !! Fraction of continental ice, lakes, ...
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: totfrac_nobio    !! Total fraction of continental ice+lakes+ ...
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: gtemp            !! First soil layer temperature 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: lambda_snow      !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (in)     :: cgrnd_snow       !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (in)     :: dgrnd_snow       !! Integration coefficient for snow numerical scheme
+
+
+    !! 0.2 Output fields
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)     :: snowliq          !! Snow liquid content (m)
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(out)    :: subsnownobio     !! Sublimation of snow on other surface types (ice, lakes, ...)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: grndflux         !! Net flux into soil [W/m2]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: snowmelt         !! Snow melt [mm/dt_sechiba]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: tot_melt         !! Total melt from ice and snow
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: subsinksoil      !! Excess of sublimation as a sink for the soil
+
+    !! 0.3 Modified fields
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapsno         !! Snow evaporation  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: snow_age         !! Snow age
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout)  :: snow_nobio       !! Ice water balance
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout)  :: snow_nobio_age   !! Snow age on ice, lakes, ...
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowrho          !! Snow density (Kg/m^3)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowgrain        !! Snow grainsize (m)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowdz           !! Snow layer thickness [m]
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowtemp         !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowheat         !! Snow heat content (J/m^2)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: snow             !! Snow mass [Kg/m^2]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: temp_sol_add     !! Additional energy to melt snow for snow ablation case (K)
+
+ 
+    !! 0.4 Local declaration
+    INTEGER(i_std)                                           :: ji, iv, jj,m,jv
+    REAL(r_std),DIMENSION  (kjpindex)                        :: snow_depth_tmp
+    REAL(r_std),DIMENSION  (kjpindex)                        :: snowmelt_from_maxmass
+    REAL(r_std)                                              :: snowdzm1
+    REAL(r_std), DIMENSION (kjpindex)                        :: thrufal          !! Water leaving snow pack [kg/m2/s]
+    REAL(r_std), DIMENSION (kjpindex)                        :: d_age            !! Snow age change
+    REAL(r_std), DIMENSION (kjpindex)                        :: xx               !! Temporary
+    REAL(r_std), DIMENSION (kjpindex)                        :: snowmelt_tmp,snowmelt_ice,icemelt,temp_sol_new_old
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                  :: snowdz_old
+    REAL(r_std), DIMENSION (kjpindex)                        :: ZLIQHEATXS
+    REAL(r_std), DIMENSION (kjpindex)                        :: ZSNOWEVAPS, ZSNOWDZ,subsnowveg,ZSNOWMELT_XS
+    REAL(r_std)                                              :: maxmass_snowdepth, snow_d1k
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                  :: WSNOWDZ,SMASS
+    REAL(r_std), DIMENSION (kjpindex)                        :: SMASSC,snowacc,snow_remove
+    INTEGER(i_std) :: locjj
+    REAL(r_std)                                              :: grndflux_tmp
+    REAL(r_std), DIMENSION (nsnow)                           :: snowtemp_tmp
+    REAL(r_std)                                              :: s2flux_tmp,fromsoilflux
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                  :: pcapa_snow 
+    REAL(r_std), DIMENSION (kjpindex)                        :: psnowhmass
+    REAL(r_std), PARAMETER                                   :: XP00 = 1.E5
+
+
+    !! 1. Initialization
+    
+    temp_sol_new_old = temp_sol_new
+    snowmelt_ice(:) = zero
+    icemelt(:) = zero
+    tot_melt(:) = zero
+    snowmelt(:) = zero
+    snowmelt_from_maxmass(:) = zero
+
+    
+    !! 2. on Vegetation
+    ! 2.1 Snow fall
+    CALL explicitsnow_fall(kjpindex,precip_snow,temp_air,u,v,totfrac_nobio,snowrho,snowdz,&
+         & snowheat,snowgrain,snowtemp,psnowhmass)
+    
+    ! 2.2 calculate the new snow discretization
+    snow_depth_tmp(:) = SUM(snowdz(:,:),2)
+    
+    snowdz_old = snowdz
+    
+    CALL explicitsnow_levels(kjpindex,snow_depth_tmp, snowdz)
+    
+    ! 2.3 Snow heat redistribution
+    CALL explicitsnow_transf(kjpindex,snowdz_old,snowdz,snowrho,snowheat,snowgrain)
+    
+    ! 2.4 Diagonize water portion of the snow from snow heat content:
+    DO ji=1, kjpindex
+       IF (SUM(snowdz(ji,:)) .GT. 0.0) THEN
+          snowtemp(ji,:) = snow3ltemp_1d(snowheat(ji,:),snowrho(ji,:),snowdz(ji,:))
+          snowliq(ji,:) = snow3lliq_1d(snowheat(ji,:),snowrho(ji,:),snowdz(ji,:),snowtemp(ji,:))
+       ELSE
+          snowliq(ji,:) = zero
+          snowtemp(ji,:) = tp_00
+       ENDIF
+    END DO
+    
+    ! 2.5 snow compaction
+    CALL explicitsnow_compactn(kjpindex,snowtemp,snowrho,snowdz)
+    ! Update snow heat 
+    DO ji = 1, kjpindex
+       snowheat(ji,:) = snow3lheat_1d(snowliq(ji,:),snowrho(ji,:),snowdz(ji,:),snowtemp(ji,:))
+    ENDDO
+
+    !2.6 Calculate the snow temperature profile based on heat diffusion
+    CALL explicitsnow_profile (kjpindex,cgrnd_snow,dgrnd_snow,lambda_snow,temp_sol_new, snowtemp,snowdz,temp_sol_add)
+    
+    !2.7 Test whether snow is existed on the ground or not
+    grndflux(:)=0.0
+    CALL explicitsnow_gone(kjpindex,pgflux,&
+         & snowheat,snowtemp,snowdz,snowrho,snowliq,grndflux,snowmelt)
+    
+    !2.8 Calculate snow melt/refreezing processes
+    CALL explicitsnow_melt_refrz(kjpindex,precip_rain,pgflux,soilcap,&
+         & snowtemp,snowdz,snowrho,snowliq,snowmelt,grndflux,temp_air)
+    
+    
+    ! 2.9 Snow sublimation changing snow thickness
+    snow(:) = 0.0
+    DO ji=1,kjpindex !domain size
+       snow(ji) = SUM(snowrho(ji,:) * snowdz(ji,:))
+    ENDDO
+    
+    subsnownobio(:,:) = zero
+    subsinksoil(:) = zero
+    
+    DO ji=1, kjpindex ! domain size
+       IF ( snow(ji) > snowcri ) THEN
+          subsnownobio(ji,iice) = frac_nobio(ji,iice)*vevapsno(ji)
+          subsnowveg(ji) = vevapsno(ji) - subsnownobio(ji,iice)
+       ELSE
+          IF ( frac_nobio(ji,iice) .GT. min_sechiba) THEN
+             subsnownobio(ji,iice) = vevapsno(ji)
+             subsnowveg(ji) = zero
+          ELSE
+             subsnownobio(ji,iice) = zero
+             subsnowveg(ji) = vevapsno(ji)
+          ENDIF
+       ENDIF
+       
+       !! 2.8.1 Check that sublimation on the vegetated fraction is possible.
+       IF (subsnowveg(ji) .GT. snow(ji)) THEN
+          IF( (un - totfrac_nobio(ji)).GT.min_sechiba) THEN
+             subsinksoil (ji) = (subsnowveg(ji) - snow(ji))/ (un - totfrac_nobio(ji))
+          END IF
+          ! Sublimation is thus limited to what is available
+          subsnowveg(ji) = snow(ji)
+          snow(ji) = zero
+          snowdz(ji,:)  =  0
+          snowliq(ji,:)   =  0
+          snowtemp(ji,:) = tp_00 
+          vevapsno(ji) = subsnowveg(ji) + subsnownobio(ji,iice)
+       ELSE
+          ! Calculating the snow accumulation  
+          WSNOWDZ(ji,:)= snowdz(ji,:)*snowrho(ji,:)
+          SMASSC (ji)= 0.0
+          DO jj=1,nsnow
+             SMASS(ji,jj)   = SMASSC(ji) + WSNOWDZ(ji,jj)
+             SMASSC(ji)      = SMASSC(ji) + WSNOWDZ(ji,jj)
+          ENDDO
+          ! Finding the layer
+          locjj=1
+          DO jj=1,nsnow-1
+             IF ((SMASS(ji,jj) .LE. subsnowveg(ji)) .AND. (SMASS(ji,jj+1) .GE. subsnowveg(ji)) ) THEN
+                locjj=jj+1
+             ENDIF
+          ENDDO
+          
+          ! Calculating the removal of snow depth
+          IF (locjj .EQ. 1) THEN
+             ZSNOWEVAPS(ji)  = subsnowveg(ji)/snowrho(ji,1)
+             ZSNOWDZ(ji)     = snowdz(ji,1) - ZSNOWEVAPS(ji)
+             snowdz(ji,1)     = MAX(0.0, ZSNOWDZ(ji))
+          ELSE IF (locjj .GT. 1) THEN
+             snowacc(ji)=0
+             DO jj=1,locjj-1
+                snowacc(ji)=snowacc(ji)+snowdz(ji,jj)*snowrho(ji,jj)
+                snowdz(ji,jj)=0
+             ENDDO
+             ZSNOWEVAPS(ji)  = (subsnowveg(ji)-snowacc(ji))/snowrho(ji,locjj)
+             ZSNOWDZ(ji)     = snowdz(ji,locjj) - ZSNOWEVAPS(ji)
+             snowdz(ji,locjj)     = MAX(0.0, ZSNOWDZ(ji))
+!          ELSE
+!             ZSNOWEVAPS(ji)  = subsnowveg(ji)/snowrho(ji,1)
+!             ZSNOWDZ(ji)     = snowdz(ji,1) - ZSNOWEVAPS(ji)
+!             snowdz(ji,1)     = MAX(0.0, ZSNOWDZ(ji))
+          ENDIF
+          
+       ENDIF
+    ENDDO
+    
+! 2.9.1 Snowmelt_from_maxmass 
+
+     DO ji=1,kjpindex !domain size
+       snow(ji) = SUM(snowrho(ji,:) * snowdz(ji,:))
+       IF(snow(ji).GT.maxmass_snow)THEN
+           IF (snow(ji).GT.(1.2*maxmass_snow)) THEN 
+              ! melt faster for points where accumulation is too high
+              snow_d1k = trois * soilcap(ji) / chalfu0
+           ELSE
+              ! standard melting
+              snow_d1k = un * soilcap(ji) / chalfu0
+           ENDIF
+           snowmelt_from_maxmass(ji) = MIN((snow(ji) - maxmass_snow),snow_d1k)
+           ! Calculating the snow accumulation  
+           WSNOWDZ(ji,:)= snowdz(ji,:)*snowrho(ji,:) ! WSNOWDZ en kg/m2
+           SMASSC (ji)= 0.0
+           DO jj=nsnow,1,-1
+             SMASS(ji,jj)   = SMASSC(ji) + WSNOWDZ(ji,jj)
+             SMASSC(ji)      = SMASSC(ji) + WSNOWDZ(ji,jj)
+           ENDDO
+
+          ! Finding the layer
+          locjj = nsnow
+          DO jj=nsnow,2,-1
+             IF ((SMASS(ji,jj) .LE. snowmelt_from_maxmass(ji)) .AND. (SMASS(ji,jj-1) .GE. snowmelt_from_maxmass(ji)) ) THEN
+                locjj=jj-1
+             ENDIF
+          ENDDO
+          
+          ! Calculating the removal of snow depth
+          IF (locjj .EQ. 3) THEN
+! ZSNOWMELT_XS : Epaisseur de la couche qui a disparu partiellement 
+             ZSNOWMELT_XS(ji)  = snowmelt_from_maxmass(ji)/snowrho(ji,3)
+             ZSNOWDZ(ji)     = snowdz(ji,3) - ZSNOWMELT_XS(ji)
+             snowdz(ji,3)     = MAX(0.0, ZSNOWDZ(ji))
+          ELSE IF (locjj .LT. 3) THEN
+             snow_remove(ji)=0   ! masse de neige des couches qui disparaissent totalement
+             DO jj=3,locjj+1,-1
+                snow_remove(ji)=snow_remove(ji)+snowdz(ji,jj)*snowrho(ji,jj)
+                snowdz(ji,jj)=0
+             ENDDO
+             ZSNOWMELT_XS(ji)  = (snowmelt_from_maxmass(ji) - snow_remove(ji))/snowrho(ji,locjj)
+             ZSNOWDZ(ji)     = snowdz(ji,locjj) - ZSNOWMELT_XS(ji)
+             snowdz(ji,locjj)     = MAX(0.0, ZSNOWDZ(ji))             
+          ENDIF
+      ENDIF
+      
+    ENDDO   
+    
+    !2.10 Calculate snow grain size using the updated thermal gradient
+    
+    CALL explicitsnow_grain(kjpindex,snowliq,snowdz,gtemp,snowtemp,pb,snowgrain)
+    
+    !2.11  Update snow heat
+    ! Update the heat content (variable stored each time step)
+    ! using current snow temperature and liquid water content:
+    !
+    ! First, make check to make sure heat content not too large
+    ! (this can result due to signifigant heating of thin snowpacks):
+    ! add any excess heat to ground flux:
+    !
+    DO ji=1,kjpindex
+       DO jj=1,nsnow
+          ZLIQHEATXS(ji)  = MAX(0.0, snowliq(ji,jj)*ph2o - 0.10*snowdz(ji,jj)*snowrho(ji,jj))*chalfu0/dt_sechiba
+          snowliq(ji,jj) = snowliq(ji,jj) - ZLIQHEATXS(ji)*dt_sechiba/(ph2o*chalfu0)
+          snowliq(ji,jj) = MAX(0.0, snowliq(ji,jj))
+          grndflux(ji)   = grndflux(ji)   + ZLIQHEATXS(ji)
+       ENDDO
+    ENDDO
+    
+    snow(:) = 0.0
+    DO ji=1,kjpindex !domain size
+       snow(ji) = SUM(snowrho(ji,:) * snowdz(ji,:))
+    ENDDO
+        
+    DO ji = 1, kjpindex
+       snowheat(ji,:) = snow3lheat_1d(snowliq(ji,:),snowrho(ji,:),snowdz(ji,:),snowtemp(ji,:))
+    ENDDO
+    
+    !3. on land ice (using the default ORCHIDEE snow scheme)
+    
+    DO ji = 1,kjpindex
+       
+       !! 3.1. It is snowing
+       
+       snow_nobio(ji,iice) = snow_nobio(ji,iice) + frac_nobio(ji,iice)*precip_snow(ji) + &
+            & frac_nobio(ji,iice)*precip_rain(ji)
+       
+       !! 3.2. Sublimation - was calculated before it can give us negative snow_nobio but that is OK
+       !!      Once it goes below a certain values (-maxmass_snow for instance) we should kill
+       !!      the frac_nobio(ji,iice) !
+       
+       snow_nobio(ji,iice) = snow_nobio(ji,iice) - subsnownobio(ji,iice)
+       
+       !! 3.3. ice melt only for continental ice fraction
+       
+       snowmelt_tmp(ji) = zero
+       IF (temp_sol_new_old(ji) .GT. tp_00) THEN
+          
+          !! 3.3.1 If there is snow on the ice-fraction it can melt
+          
+          snowmelt_tmp(ji) = frac_nobio(ji,iice)*(temp_sol_new_old(ji) - tp_00) * soilcap(ji) / chalfu0
+          
+          IF ( snowmelt_tmp(ji) .GT. snow_nobio(ji,iice) ) THEN
+             snowmelt_tmp(ji) = MAX( 0., snow_nobio(ji,iice))
+          ENDIF
+          snowmelt_ice(ji) = snowmelt_ice(ji) + snowmelt_tmp(ji)
+          snow_nobio(ji,iice) = snow_nobio(ji,iice) - snowmelt_tmp(ji)
+          
+       ENDIF
+
+       !! Ice melt only if there is more than a given mass : maxmass_snow, i.e. only weight melts glaciers !
+       
+       IF ( snow_nobio(ji,iice) .GE. maxmass_snow ) THEN
+          icemelt(ji) = snow_nobio(ji,iice) - maxmass_snow
+          snow_nobio(ji,iice) = maxmass_snow
+       ENDIF
+       
+    END DO
+    
+    
+    !! 4. On other surface types - not done yet
+    
+    IF ( nnobio .GT. 1 ) THEN
+       WRITE(numout,*) 'WE HAVE',nnobio-1,' SURFACE TYPES I DO NOT KNOW'
+       WRITE(numout,*) 'CANNOT TREAT SNOW ON THESE SURFACE TYPES'
+       CALL ipslerr_p(3,'explicitsnow_main','Cannot treat snow on these surface types.','','')
+    ENDIF
+    
+    !! 5. Computes snow age on land and land ice (for albedo)
+    
+    DO ji = 1, kjpindex
+       
+       !! 5.1. Snow age on land 
+       
+       IF (snow(ji) .LE. zero) THEN
+          snow_age(ji) = zero
+       ELSE
+          snow_age(ji) =(snow_age(ji) + (un - snow_age(ji)/max_snow_age) * dt_sechiba/one_day) &
+               & * EXP(-precip_snow(ji) / snow_trans)
+       ENDIF
+       
+       !! 5.2. Snow age on land ice
+       
+       !! Age of snow on ice: a little bit different because in cold regions, we really
+       !! cannot negect the effect of cold temperatures on snow metamorphism any more.
+       
+       IF (snow_nobio(ji,iice) .LE. zero) THEN
+          snow_nobio_age(ji,iice) = zero
+       ELSE
+          
+          d_age(ji) = ( snow_nobio_age(ji,iice) + &
+               &  (un - snow_nobio_age(ji,iice)/max_snow_age) * dt_sechiba/one_day ) * &
+               &  EXP(-precip_snow(ji) / snow_trans) - snow_nobio_age(ji,iice)
+          IF (d_age(ji) .GT. 0. ) THEN
+             xx(ji) = MAX( tp_00 - temp_sol_new(ji), zero )
+             xx(ji) = ( xx(ji) / 7._r_std ) ** 4._r_std
+             d_age(ji) = d_age(ji) / (un+xx(ji))
+          ENDIF
+          snow_nobio_age(ji,iice) = MAX( snow_nobio_age(ji,iice) + d_age(ji), zero )
+          
+       ENDIF
+       
+    ENDDO
+    
+    
+    !! 6. Check the snow on land 
+    DO ji=1,kjpindex
+       IF (snow(ji) .EQ. 0) THEN
+          snowrho(ji,:)=50.0
+          snowgrain(ji,:)=0.0
+          snowdz(ji,:)=0.0
+          snowliq(ji,:)=0.0
+       ENDIF
+    ENDDO
+    
+    
+    ! Snow melt only if there is more than a given mass : maxmass_snow
+    ! Here I suggest to remove the snow based on a certain threshold of snow
+    ! depth instead of snow mass because it is quite difficult for
+    ! explictsnow module to calculate other snow properties following the
+    ! removal of snow mass
+    ! to define the threshold of snow depth based on old snow density (330
+    ! kg/m3)
+    !       maxmass_snowdepth=maxmass_snow/sn_dens 
+!    snowmelt_from_maxmass(:) = 0.0
+    
+    !! 7. compute total melt 
+    
+    DO ji=1,kjpindex 
+       tot_melt(ji) = icemelt(ji) + snowmelt(ji) + snowmelt_ice(ji) + snowmelt_from_maxmass(ji)
+    ENDDO
+    IF (printlev>=3) WRITE(numout,*) 'explicitsnow_main done'
+    
+    ! Write output variables
+    CALL xios_orchidee_send_field("snowliq",snowliq)
+    CALL xios_orchidee_send_field("snowrho",snowrho)
+    CALL xios_orchidee_send_field("snowheat",snowheat)
+    CALL xios_orchidee_send_field("snowgrain",snowgrain)
+    CALL xios_orchidee_send_field("snowmelt_from_maxmass",snowmelt_from_maxmass)
+    CALL xios_orchidee_send_field("soilcap",soilcap)
+
+  END SUBROUTINE explicitsnow_main
+  
+
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_finalize
+!!
+!>\BRIEF        Write variables for explictsnow module to restart file
+!!                
+!! DESCRIPTION  : Write variables for explictsnow module to restart file
+!!
+!! \n
+!_
+!================================================================================================================================
+  SUBROUTINE explicitsnow_finalize ( kjit,     kjpindex, rest_id,    snowrho,   &
+       snowtemp, snowdz,   snowheat,   snowgrain)
+    
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                           :: kjit           !! Time step number 
+    INTEGER(i_std), INTENT(in)                           :: kjpindex       !! Domain size
+    INTEGER(i_std),INTENT (in)                           :: rest_id        !! Restart file identifier
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowrho        !! Snow density (Kg/m^3)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowtemp       !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowdz         !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowheat       !! Snow heat content (J/m^2)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowgrain      !! Snow grainsize (m)
+    
+    
+    !! 1. Write to restart file
+    CALL restput_p(rest_id, 'snowrho', nbp_glo, nsnow, 1, kjit, snowrho, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snowtemp', nbp_glo, nsnow, 1, kjit, snowtemp, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snowdz', nbp_glo, nsnow, 1, kjit, snowdz, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snowheat', nbp_glo, nsnow, 1, kjit, snowheat, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snowgrain', nbp_glo, nsnow, 1, kjit, snowgrain, 'scatter', nbp_glo, index_g)
+    
+  END SUBROUTINE explicitsnow_finalize
+  
+
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_grain
+!!
+!>\BRIEF        Compute evolution of snow grain size
+!!                
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : R. Jordan (1991)
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+
+
+ SUBROUTINE explicitsnow_grain(kjpindex,snowliq,snowdz,gtemp,snowtemp,pb,snowgrain)
+
+      !! 0.1 Input variables
+      INTEGER(i_std),INTENT(in)                                  :: kjpindex         !! Domain size
+      REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)           :: snowliq          !! Liquid water content
+      REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)           :: snowdz           !! Snow depth (m)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)                 :: gtemp            !! First soil layer temperature
+      REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)           :: snowtemp         !! Snow temperature
+      REAL(r_std),DIMENSION (kjpindex),INTENT(in)                :: pb               !! Surface pressure (hpa) 
+
+      !! 0.2 Output variables
+
+      !! 0.3 Modified variables
+
+      REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)        :: snowgrain        !! Snow grain size (m)
+
+      !! 0.4 Local variables
+      REAL(r_std),DIMENSION(kjpindex,nsnow)                      :: zsnowdz,zdz,ztheta
+      REAL(r_std),DIMENSION(kjpindex,0:nsnow)                    :: ztemp,zdiff,ztgrad,zthetaa,zfrac,&
+                                                                    zexpo,zckt_liq,zckt_ice,zckt
+      REAL(r_std),DIMENSION(kjpindex,nsnow)                      :: zrhomin,zgrainmin
+      INTEGER(i_std) :: ji,jj
+
+      !! 0.5 Local parameters
+      REAL(r_std), PARAMETER                                     :: ztheta_crit = 0.02     !! m3 m-3
+      REAL(r_std), PARAMETER                                     :: zc1_ice     = 8.047E+9 !! kg m-3 K
+      REAL(r_std), PARAMETER                                     :: zc1_liq     = 5.726E+8 !! kg m-3 K
+      REAL(r_std), PARAMETER                                     :: zdeos       = 0.92E-4  !! effective diffusion
+                                                                                           !! coef for water vapor in snow
+                                                                                           !! at 0C and 1000 mb (m2 s-1)
+      REAL(r_std), PARAMETER                                     :: zg1         = 5.0E-7   !! m4 kg-1
+      REAL(r_std), PARAMETER                                     :: zg2         = 4.0E-12  !! m2 s-1
+      REAL(r_std), PARAMETER                                     :: ztheta_w      = 0.05   !! m3 m-3
+      REAL(r_std), PARAMETER                                     :: ztheta_crit_w = 0.14   !! m3 m-3
+      REAL(r_std), PARAMETER                                     :: zdzmin        = 0.01   !! m : minimum thickness
+                                                                                           !! for thermal gradient evaluation:
+                                                                                           !! to prevent excessive gradients
+                                                                                           !! for vanishingly thin snowpacks.
+      REAL(r_std), PARAMETER                                     :: xp00=1.E5 
+      !! 1. initialize
+ 
+      DO ji=1,kjpindex 
+
+
+         zsnowdz(ji,:)  = MAX(xsnowdmin/nsnow, snowdz(ji,:))
+
+         DO jj=1,nsnow-1
+            zdz(ji,jj)      = zsnowdz(ji,jj) + zsnowdz(ji,jj+1)
+         ENDDO
+            zdz(ji,nsnow)     = zsnowdz(ji,nsnow)
+
+         ! compute interface average volumetric water content (m3 m-3):
+         ! first, layer avg VWC:
+         !
+          ztheta(ji,:) = snowliq(ji,:)/MAX(xsnowdmin, zsnowdz(ji,:))
+
+         ! at interfaces:
+          zthetaa(ji,0)      = ztheta(ji,1)
+          DO jj=1,nsnow-1
+             zthetaa(ji,jj)  = (zsnowdz(ji,jj)  *ztheta(ji,jj)   +             &
+                                   zsnowdz(ji,jj+1)*ztheta(ji,jj+1))/zdz(ji,jj)
+          ENDDO
+          zthetaa(ji,nsnow) = ztheta(ji,nsnow)
+          ! compute interface average temperatures (K):
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          !
+          ztemp(ji,0)      = snowtemp(ji,1)
+          DO jj=1,nsnow-1
+             ztemp(ji,jj)  = (zsnowdz(ji,jj)  *snowtemp(ji,jj)   +             &
+                                 zsnowdz(ji,jj+1)*snowtemp(ji,jj+1))/zdz(ji,jj)
+          ENDDO
+          ztemp(ji,nsnow) = snowtemp(ji,nsnow)
+!
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          ! compute variation of saturation vapor pressure with temperature
+          ! for solid and liquid phases:
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          zexpo(ji,:)    = chalsu0/(xrv*ztemp(ji,:))
+          zckt_ice(ji,:) = (zc1_ice/ztemp(ji,:)**2)*(zexpo(ji,:) - 1.0)*EXP(-zexpo(ji,:))
+          !
+          zexpo(ji,:)    = chalev0/(xrv*ztemp(ji,:))
+          zckt_liq(ji,:) = (zc1_liq/ztemp(ji,:)**2)*(zexpo(ji,:) - 1.0)*EXP(-zexpo(ji,:))
+          !
+          ! compute the weighted ice/liquid total variation (N m-2 K):
+          !
+          zfrac(ji,:)    = MIN(1.0, zthetaa(ji,:)/ztheta_crit)
+          zckt(ji,:)     = zfrac(ji,:)*zckt_liq(ji,:) + (1.0 - zfrac(ji,:))*zckt_ice(ji,:)
+
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          ! Compute effective diffusion coefficient (m2 s-1):
+          ! -diffudivity relative to a reference diffusion at 1000 mb and freezing point
+          !  multiplied by phase energy coefficient
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          !
+          DO jj=0,nsnow
+             zdiff(ji,jj) = zdeos*(xp00/(pb(ji)*100.))*((ztemp(ji,jj)/tp_00)**6)*zckt(ji,jj)
+          ENDDO 
+
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          ! Temperature gradient (K m-1):
+
+          ztgrad(ji,0)      = 0.0 ! uppermost layer-mean and surface T's are assumed to be equal
+          DO jj=1,nsnow-1
+             ztgrad(ji,jj)  = 2*(snowtemp(ji,jj)-snowtemp(ji,jj+1))/MAX(zdzmin, zdz(ji,jj))
+          ENDDO
+          !
+          ! assume at base of snow, temperature is in equilibrium with soil
+          ! (but obviously must be at or below freezing point!)
+          !
+          ztgrad(ji,nsnow) = 2*(snowtemp(ji,nsnow) - MIN(tp_00, gtemp(ji)))/MAX(zdzmin, zdz(ji,nsnow))
+          ! prognostic grain size (m) equation:
+          !-------------------------------------------------------------------
+          ! first compute the minimum grain size (m):
+          !
+          zrhomin(ji,:)     = xrhosmin
+          zgrainmin(ji,:)   = snow3lgrain_1d(zrhomin(ji,:))
+
+          ! dry snow:
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          !
+          DO jj=1,nsnow
+
+             IF(ztheta(ji,jj) == 0.0) THEN
+
+              ! only allow growth due to vapor flux INTO layer: 
+              ! aab add sublimation(only condensation) as upper BC...?
+
+                snowgrain(ji,jj)  = snowgrain(ji,jj) +                                      &
+                                       (dt_sechiba*zg1/MAX(zgrainmin(ji,jj),snowgrain(ji,jj)))*      &
+                                       ( zdiff(ji,jj-1)*MAX(0.0,ztgrad(ji,jj-1)) -                &
+                                       zdiff(ji,jj)  *MIN(0.0,ztgrad(ji,jj)) )
+             ELSE
+ 
+              ! wet snow
+              ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+              !
+                snowgrain(ji,jj)  = snowgrain(ji,jj) +                                      &
+                                       (dt_sechiba*zg2/MAX(zgrainmin(ji,jj),snowgrain(ji,jj)))*      &
+                                       MIN(ztheta_crit_w, ztheta(ji,jj) + ztheta_w)
+             END IF
+
+          ENDDO
+
+
+      ENDDO
+
+
+    END SUBROUTINE explicitsnow_grain
+
+!!
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_compactn
+!!
+!>\BRIEF        Compute Compaction/Settling
+!!                
+!! DESCRIPTION  : 
+!!     Snow compaction due to overburden and settling.
+!!     Mass is unchanged: layer thickness is reduced
+!!     in proportion to density increases. Method
+!!     of Anderson (1976): see Loth and Graf, 1993,
+!!     J. of Geophys. Res., 98, 10,451-10,464.
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : Loth and Graf (1993), Mellor (1964) and Anderson (1976)
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+
+
+   SUBROUTINE explicitsnow_compactn(kjpindex,snowtemp,snowrho,snowdz)
+
+         !! 0.1 Input variables
+
+         INTEGER(i_std),INTENT(in)                                 :: kjpindex         !! Domain size
+         REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)          :: snowtemp         !! Snow temperature
+
+         !! 0.2 Output variables
+
+         !! 0.3 Modified variables
+
+         REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)       :: snowrho          !! Snow density (Kg/m^3)
+         REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)       :: snowdz           !! Snow depth
+
+         !! 0.4 Local variables
+
+         REAL(r_std),DIMENSION(kjpindex,nsnow)                     :: zwsnowdz,zsmass,zsnowrho2,zviscocity,zsettle 
+         REAL(r_std),DIMENSION(kjpindex)                           :: zsmassc          !! cummulative snow mass (kg/m2)
+         REAL(r_std),DIMENSION(kjpindex)                           :: snowdepth_crit
+         INTEGER(i_std)                                            :: ji,jj
+
+        !! 1. initialize
+
+        zsnowrho2  = snowrho
+        zsettle(:,:)    = ZSNOWCMPCT_ACM
+        zviscocity(:,:) = ZSNOWCMPCT_V0
+
+        !! 2. Calculating Cumulative snow mass (kg/m2):
+
+        DO ji=1, kjpindex
+
+
+            IF (SUM(snowdz(ji,:)) .GT. 0.0) THEN 
+
+              zwsnowdz(ji,:)= snowdz(ji,:)*snowrho(ji,:)
+
+              zsmassc (ji)= 0.0
+
+              DO jj=1,nsnow
+                 zsmass(ji,jj)   = zsmassc(ji) + zwsnowdz(ji,jj)
+                 zsmassc(ji)      = zsmassc(ji) + zwsnowdz(ji,jj)
+              ENDDO
+
+
+              !! 3. Computing compaction/Settling
+              ! ----------------------
+              ! Compaction/settling if density below upper limit
+              ! (compaction is generally quite small above ~ 500 kg m-3):
+              !
+              DO jj=1,nsnow
+                 IF (snowrho(ji,jj) .LT. xrhosmax) THEN
+            
+              !
+              ! First calculate settling due to freshly fallen snow: (NOTE:bug here for the snow temperature profile)
+              !
+             
+              zsettle(ji,jj)     = ZSNOWCMPCT_ACM*EXP(                                      &
+                                     -ZSNOWCMPCT_BCM*(tp_00-MIN(tp_00,snowtemp(ji,jj)))                      &
+                                     -ZSNOWCMPCT_CCM*MAX(0.0,                                  &
+                                      snowrho(ji,jj)-ZSNOWCMPCT_RHOD))
+              !
+              ! Snow viscocity:
+              !
+              zviscocity(ji,jj)   = ZSNOWCMPCT_V0*EXP( ZSNOWCMPCT_VT*(tp_00-MIN(tp_00,snowtemp(ji,jj))) +        &
+                                  ZSNOWCMPCT_VR*snowrho(ji,jj) )
+
+              ! Calculate snow density: compaction from weight/over-burden
+              ! Anderson 1976 method:
+              zsnowrho2(ji,jj)    = snowrho(ji,jj) + snowrho(ji,jj)*dt_sechiba*(          &
+                                   (cte_grav*zsmass(ji,jj)/zviscocity(ji,jj))                 &
+                                    + zsettle(ji,jj) )
+              ! Conserve mass by decreasing grid thicknesses in response
+              ! to density increases
+              !
+              snowdz(ji,jj)  = snowdz(ji,jj)*(snowrho(ji,jj)/zsnowrho2(ji,jj))
+
+                 ENDIF
+              ENDDO
+
+              ! Update density (kg m-3):
+              snowrho(ji,:) = zsnowrho2(ji,:)
+
+            ENDIF
+
+        ENDDO
+
+      END SUBROUTINE explicitsnow_compactn
+
+!!
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_transf
+!!
+!>\BRIEF        Computing snow mass and heat redistribution due to grid thickness configuration resetting
+!!                
+!! DESCRIPTION  : Snow mass and heat redistibution due to grid thickness
+!!                configuration resetting. Total mass and heat content
+!!                of the overall snowpack unchanged/conserved within this routine. 
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+
+   SUBROUTINE explicitsnow_transf(kjpindex,snowdz_old,snowdz,snowrho,snowheat,snowgrain)
+
+     !! 0.1 Input variables
+
+     INTEGER(i_std),INTENT(in)                                           :: kjpindex         !! Domain size
+     REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)                    :: snowdz_old       !! Snow depth at the previous time step 
+
+     !! 0.2 Output variables
+
+     !! 0.3 Modified variables
+
+     REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)                 :: snowrho          !! Snow density (Kg/m^3)
+     REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)                 :: snowgrain        !! Snow grain size (m)
+     REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)                 :: snowdz           !! Snow depth (m)
+     REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)                 :: snowheat         !! Snow heat content/enthalpy (J/m2)
+                                                                        
+     !! 0.4 Local varibles                                              
+      
+     REAL(r_std),DIMENSION(kjpindex,0:nsnow)                             :: zsnowzo
+     REAL(r_std),DIMENSION(kjpindex,0:nsnow)                             :: zsnowzn 
+     REAL(r_std),DIMENSION(kjpindex,nsnow)                               :: zsnowddz 
+     REAL(r_std),DIMENSION(kjpindex,nsnow)                               :: zdelta
+     REAL(r_std),DIMENSION(kjpindex,nsnow)                               :: zsnowrhon,zsnowheatn,zsnowgrainn
+     REAL(r_std),DIMENSION(kjpindex)                                     :: zsnowmix_delta
+     REAL(r_std),DIMENSION(kjpindex)                                     :: zsumheat, zsumswe, zsumgrain
+     INTEGER(i_std),DIMENSION(nsnow,2)                                   :: locflag
+     REAL(r_std)                                                         :: psnow
+     INTEGER(i_std)                                                      :: ji,jj,jjj
+
+     ! Initialization
+     zsumheat(:)       = 0.0
+     zsumswe(:)        = 0.0
+     zsumgrain(:)      = 0.0
+     zsnowmix_delta(:) = 0.0
+     locflag(:,:)        = 0
+
+     DO ji=1, kjpindex 
+ 
+
+        psnow = SUM(snowdz(ji,:))
+
+        IF (psnow .GE. xsnowcritd .AND. snowdz_old(ji,1) .NE. 0 .AND. snowdz_old(ji,2) .NE. 0 .AND. snowdz_old(ji,3) .NE. 0) THEN
+          !
+          zsnowzo(ji,0)     = 0.
+          zsnowzn(ji,0)     = 0.
+          zsnowzo(ji,1)     = snowdz_old(ji,1)
+          zsnowzn(ji,1)     = snowdz(ji,1)
+          !
+          DO jj=2,nsnow
+             zsnowzo(ji,jj) = zsnowzo(ji,jj-1) + snowdz_old(ji,jj)
+             zsnowzn(ji,jj) = zsnowzn(ji,jj-1) + snowdz(ji,jj)
+          ENDDO
+
+          DO jj=1,nsnow
+
+             IF (jj .EQ. 1) THEN 
+                locflag(jj,1)=1 
+             ELSE       
+                DO jjj=nsnow,1,-1
+
+                   !upper bound of the snow layer
+                   IF (zsnowzn(ji,jj-1) .LE. zsnowzo(ji,jjj)) THEN
+                      locflag(jj,1) = jjj
+                   ENDIF
+                ENDDO
+	     ENDIF
+
+             IF (jj .EQ. nsnow) THEN 
+                locflag(jj,2)=nsnow 
+             ELSE       
+                DO jjj=nsnow,1,-1
+
+                   !lower bound of the snow layer
+                   IF (zsnowzn(ji,jj)   .LE. zsnowzo(ji,jjj)) THEN
+                      locflag(jj,2) = jjj
+                   ENDIF
+                ENDDO
+             ENDIF
+
+             !to interpolate
+             ! when heavy snow occurred
+             IF (locflag(jj,1) .EQ. locflag(jj,2)) THEN 
+
+                zsnowrhon(ji,jj) = snowrho(ji,locflag(jj,1))
+
+                zsnowheatn(ji,jj) = snowheat(ji,locflag(jj,1))*snowdz(ji,jj)/snowdz_old(ji,locflag(jj,1)) 
+
+                zsnowgrainn(ji,jj) = snowgrain(ji,locflag(jj,1)) 
+
+             ELSE 
+
+                !snow density
+                zsnowrhon(ji,jj) = snowrho(ji,locflag(jj,1)) * &
+                                      (zsnowzo(ji,locflag(jj,1))-zsnowzn(ji,jj-1)) + &
+                                      snowrho(ji,locflag(jj,2)) * &
+                                      (zsnowzn(ji,jj)-zsnowzo(ji,locflag(jj,2)-1))
+
+                DO jjj=locflag(jj,1),locflag(jj,2)-1
+                   zsnowrhon(ji,jj)=zsnowrhon(ji,jj) + &
+                   (jjj-locflag(jj,1))*snowrho(ji,jjj)*snowdz_old(ji,jjj)  
+                ENDDO
+
+                zsnowrhon(ji,jj) = zsnowrhon(ji,jj) / snowdz(ji,jj)
+
+
+                !snow heat
+                IF (snowdz_old(ji,locflag(jj,1)) .GT. 0.0) THEN
+
+                   zsnowheatn(ji,jj) = snowheat(ji,locflag(jj,1)) * &
+                                 (zsnowzo(ji,locflag(jj,1))-zsnowzn(ji,jj-1))/snowdz_old(ji,locflag(jj,1)) + &
+                                       snowheat(ji,locflag(jj,2)) * &
+                                 (zsnowzn(ji,jj)-zsnowzo(ji,locflag(jj,2)-1))/snowdz_old(ji,locflag(jj,2))
+	        ELSE
+                   zsnowheatn(ji,jj) = snowheat(ji,locflag(jj,2))/snowdz_old(ji,locflag(jj,2)) * &
+                        (zsnowzn(ji,locflag(jj,1))-zsnowzo(ji,locflag(jj,1)))	   
+		ENDIF
+
+                DO jjj=locflag(jj,1),locflag(jj,2)-1
+                   zsnowheatn(ji,jj)=zsnowheatn(ji,jj) + &
+                                        (jjj-locflag(jj,1))*snowheat(ji,jjj)
+                ENDDO
+
+
+                !snow grain
+                zsnowgrainn(ji,jj) = snowgrain(ji,locflag(jj,1)) * &
+                                      (zsnowzo(ji,locflag(jj,1))-zsnowzn(ji,jj-1)) + &
+                                      snowgrain(ji,locflag(jj,2)) * &
+                                      (zsnowzn(ji,jj)-zsnowzo(ji,locflag(jj,2)-1))
+
+                DO jjj=locflag(jj,1),locflag(jj,2)-1
+                   zsnowgrainn(ji,jj)=zsnowgrainn(ji,jj) + &
+                   (jjj-locflag(jj,1))*snowgrain(ji,jjj)*snowdz_old(ji,jjj)
+                ENDDO
+
+                zsnowgrainn(ji,jj) = zsnowgrainn(ji,jj) / snowdz(ji,jj)
+
+             ENDIF
+                        
+          ENDDO
+
+          snowrho(ji,:)    = zsnowrhon(ji,:)
+          snowheat(ji,:)   = zsnowheatn(ji,:)
+          snowgrain(ji,:)  = zsnowgrainn(ji,:)
+
+        ENDIF
+
+          ! Vanishing or very thin snowpack check:
+          ! -----------------------------------------
+          !
+          ! NOTE: ONLY for very shallow snowpacks, mix properties (homogeneous):
+          ! this avoids problems related to heat and mass exchange for
+          ! thin layers during heavy snowfall or signifigant melt: one
+          ! new/old layer can exceed the thickness of several old/new layers.
+          ! Therefore, mix (conservative):
+          !
+          ! modified by Tao Wang
+        IF (psnow > 0 .AND. (psnow < xsnowcritd .OR. snowdz_old(ji,1) &
+            & .eq. 0 .OR. snowdz_old(ji,2) .eq. 0 .OR. snowdz_old(ji,3) .eq. 0)) THEN
+                zsumheat(ji) = SUM(snowheat(ji,:))
+                zsumswe(ji)  = SUM(snowrho(ji,:)*snowdz_old(ji,:))
+                zsumgrain(ji)= SUM(snowgrain(ji,:)*snowdz_old(ji,:))
+                zsnowmix_delta(ji) = 1.0
+                DO jj=1,nsnow
+                   zsnowheatn(ji,jj)  = zsnowmix_delta(ji)*(zsumheat(ji)/nsnow)
+                   snowdz(ji,jj)    = zsnowmix_delta(ji)*(psnow/nsnow) 
+                   zsnowrhon(ji,jj)   = zsnowmix_delta(ji)*(zsumswe(ji)/psnow)
+                   zsnowgrainn(ji,jj) = zsnowmix_delta(ji)*(zsumgrain(ji)/psnow)
+                ENDDO
+          ! Update mass (density and thickness), heat and grain size:
+          ! ------------------------------------------------------------
+          !
+          snowrho(ji,:)    = zsnowrhon(ji,:)
+          snowheat(ji,:)   = zsnowheatn(ji,:)
+          snowgrain(ji,:)  = zsnowgrainn(ji,:)
+
+        ENDIF
+
+     ENDDO
+
+
+   END SUBROUTINE explicitsnow_transf
+
+  
+!!
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_fall
+!!
+!>\BRIEF    Computes snowfall    
+!!                
+!! DESCRIPTION  : Computes snowfall    
+!routine. 
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+ 
+   SUBROUTINE explicitsnow_fall(kjpindex,precip_snow,temp_air,u,v,totfrac_nobio,snowrho,snowdz,&
+                        & snowheat,snowgrain,snowtemp,psnowhmass)
+
+       !! 0.1 Input variables
+
+       INTEGER(i_std),INTENT(in)                              :: kjpindex            !! Domain size
+       REAL(r_std),DIMENSION(kjpindex),INTENT(in)             :: precip_snow         !! Snow rate (SWE) (kg/m2 per dt_sechiba)
+       REAL(r_std),DIMENSION(kjpindex),INTENT(in)             :: temp_air            !! Air temperature
+       REAL(r_std),DIMENSION(kjpindex),INTENT(in)             :: u,v                 !! Horizontal wind speed
+       REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)       :: snowtemp            !! Snow temperature
+       REAL(r_std),DIMENSION(kjpindex),INTENT(in)             :: totfrac_nobio
+       !! 0.2 Output variables
+
+       REAL(r_std), DIMENSION(kjpindex),INTENT(out)           :: psnowhmass          !! Heat content of snowfall (J/m2)
+
+       !! 0.3 Modified variables
+ 
+       REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)    :: snowrho             !! Snow density profile (kg/m3)
+       REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)    :: snowdz              !! Snow layer thickness profile (m)
+       REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)    :: snowheat            !! Snow heat content/enthalpy (J/m2)
+       REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)    :: snowgrain           !! Snow grain size (m)
+
+       !! 0.4 Local variables
+
+       REAL(r_std), DIMENSION(kjpindex)                       :: rhosnew             !! Snowfall density
+       REAL(r_std), DIMENSION(kjpindex)                       :: dsnowfall           !! Snowfall thickness (m)
+       REAL(r_std), DIMENSION(kjpindex,nsnow)                 :: snowdz_old
+       REAL(r_std), DIMENSION(kjpindex)                       :: snow_depth,snow_depth_old,newgrain
+       REAL(r_std)                                            :: snowfall_delta,speed
+       INTEGER(i_std)                                         :: ji,jj
+
+       !! 1. initialize the variables
+
+       snowdz_old = snowdz
+       DO ji=1,kjpindex
+                 snow_depth(ji) = SUM(snowdz(ji,:))
+       ENDDO
+
+       snow_depth_old = snow_depth
+ 
+       snowfall_delta = 0.0 
+
+       !! 2. incorporate snowfall into snowpack 
+       DO ji = 1, kjpindex
+   
+       speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+        
+          ! new snow fall on snowpack 
+          ! NOTE: when the surface temperature is zero, it means that snowfall has no
+          ! heat content but it can be used for increasing the thickness and changing the density (maybe it is a bug)
+          psnowhmass(ji) = 0.0
+          IF ( (precip_snow(ji) .GT. 0.0) ) THEN
+
+             !calculate
+
+             psnowhmass(ji) = precip_snow(ji)*(un-totfrac_nobio(ji))* &
+                                (xci*(snowtemp(ji,1)-tp_00)-chalfu0)
+            
+             ! Snowfall density: Following CROCUS (Pahaut 1976)
+             !
+             rhosnew(ji)   = MAX(xrhosmin, snowfall_a_sn + snowfall_b_sn*(temp_air(ji)-tp_00)+         &
+                   snowfall_c_sn*SQRT(speed))
+
+             ! Augment total pack depth:
+             ! Note that dsnowfall(ji) can be equal to zero if totfrac_nobio(ji)=1
+             dsnowfall(ji) = (precip_snow(ji)*(un-totfrac_nobio(ji)))/rhosnew(ji) !snowfall thickness (m)
+
+             snow_depth(ji) = snow_depth(ji) + dsnowfall(ji) 
+
+
+             ! Fresh snowfall changes the snowpack density and liquid content in uppermost layer 
+
+             IF (dsnowfall(ji) .GT. zero) THEN
+               snowrho(ji,1) = (snowdz(ji,1)*snowrho(ji,1) + dsnowfall(ji)*rhosnew(ji))/     &
+                                (snowdz(ji,1)+dsnowfall(ji))
+
+               snowdz(ji,1) = snowdz(ji,1) + dsnowfall(ji)
+
+               ! Add energy of snowfall to snowpack:
+               ! Update heat content (J/m2) (therefore the snow temperature
+               ! and liquid content):
+               !
+               snowheat(ji,1)  = snowheat(ji,1) + psnowhmass(ji)
+               !
+               ! Incorporate snowfall grain size:
+               !
+               newgrain(ji)    = MIN(dgrain_new_max, snow3lgrain_0d(rhosnew(ji)))
+               
+               snowgrain(ji,1) = (snowdz_old(ji,1)*snowgrain(ji,1) + dsnowfall(ji)*newgrain(ji))/ &
+                    snowdz(ji,1)
+            ENDIF
+          ELSE
+            dsnowfall(ji) = 0.
+          ENDIF
+
+          ! new snow fall on snow free surface. 
+          ! we use the linearization for the new snow fall on snow-free ground 
+
+          IF ( (dsnowfall(ji) .GT. zero) .AND. (snow_depth_old(ji) .EQ. zero) ) THEN
+
+             snowfall_delta = 1.0
+              
+             DO jj=1,nsnow
+
+                snowdz(ji,jj)   = snowfall_delta*(dsnowfall(ji)/nsnow) + &
+                                  (1.0-snowfall_delta)*snowdz(ji,jj)
+
+                snowheat(ji,jj)   = snowfall_delta*(psnowhmass(ji)/nsnow) + &
+                                  (1.0-snowfall_delta)*snowheat(ji,jj)
+
+                snowrho(ji,jj)    = snowfall_delta*rhosnew(ji)            + &
+                                  (1.0-snowfall_delta)*snowrho(ji,jj)
+
+                snowgrain(ji,jj)=   snowfall_delta*newgrain(ji)           + &
+                                  (1.0-snowfall_delta)*snowgrain(ji,jj)
+
+             ENDDO
+
+
+          ENDIF
+
+
+       ENDDO 
+
+     END SUBROUTINE explicitsnow_fall
+
+!!
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_gone
+!!
+!>\BRIEF        Check whether snow is gone 
+!!                
+!! DESCRIPTION  : If so, set thickness (and therefore mass and heat) and liquid
+!!                content to zero, and adjust fluxes of water, evaporation and
+!!                heat into underlying surface. 
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+
+   SUBROUTINE explicitsnow_gone(kjpindex,pgflux,&
+                        snowheat,snowtemp,snowdz,snowrho,snowliq,grndflux,snowmelt)
+
+     !! 0.1 Input variables
+
+     INTEGER(i_std), INTENT(in)                                 :: kjpindex     !! Domain size
+     REAL(r_std),DIMENSION (kjpindex), INTENT (in)              :: pgflux       !! Net energy into snow pack(w/m2)
+     REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in)          :: snowheat     !! Snow heat content (J/m^2)
+
+     !! 0.2 Output variables
+
+     !! 0.3 Modified variables
+
+     REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)     :: snowtemp     !! Snow temperature
+     REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)     :: snowdz       !! Snow depth
+     REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(inout)      :: snowrho      !! Snow density (Kg/m^3)
+     REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(inout)      :: snowliq      !! Liquid water content
+     REAL(r_std),DIMENSION(kjpindex), INTENT(inout)             :: grndflux     !! Soil/snow interface heat flux (W/m2)
+     REAL(r_std),DIMENSION(kjpindex),INTENT(inout)              :: snowmelt     !! Snow melt
+     REAL(r_std),DIMENSION(kjpindex)                            :: thrufal      !! Water leaving snowpack(kg/m2/s)
+
+     !! 0.4 Local variables
+
+     INTEGER(i_std)                                             :: ji,jj
+     REAL(r_std),DIMENSION(kjpindex)                            :: snowgone_delta
+     REAL(r_std),DIMENSION (kjpindex)                           :: totsnowheat  !!snow heat content at each layer 
+     REAL(r_std),DIMENSION(kjpindex)                            :: snowdepth_crit
+
+     ! first caculate total snowpack snow heat content
+     snowgone_delta(:) = un
+     thrufal(:)=0.0
+     snowmelt(:)=0
+     totsnowheat(:)  = SUM(snowheat(:,:),2) 
+     
+     DO ji = 1, kjpindex 
+
+           IF ( (SUM(snowdz(ji,:)) .GT. min_sechiba)) THEN
+
+              IF( pgflux(ji) >= (-totsnowheat(ji)/dt_sechiba) ) THEN
+
+                 grndflux(ji) = pgflux(ji) + (totsnowheat(ji)/dt_sechiba)
+
+                 thrufal(ji)=SUM(snowrho(ji,:)*snowdz(ji,:))
+
+                 snowgone_delta(ji) = 0.0       
+
+                 snowmelt(ji) = snowmelt(ji)+thrufal(ji)
+
+              ENDIF
+
+              ! update of snow state (either still present or not)
+
+              DO jj=1,nsnow
+                 snowdz(ji,jj)  =   snowdz(ji,jj) *snowgone_delta(ji)
+                 snowliq(ji,jj)   =   snowliq(ji,jj) *snowgone_delta(ji)
+                 snowtemp(ji,jj) = (1.0-snowgone_delta(ji))*tp_00 + snowtemp(ji,jj)*snowgone_delta(ji)
+              ENDDO
+
+           ELSE
+              snowdz(ji,:)=0.
+              snowliq(ji,:)=0.
+              snowmelt(ji)=snowmelt(ji)+SUM(snowrho(ji,:)*snowdz(ji,:))
+           ENDIF
+
+     ENDDO 
+
+   END SUBROUTINE explicitsnow_gone
+
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_melt_refrz
+!!
+!>\BRIEF        Computes snow melt and refreezing processes within snowpack
+!!                
+!! DESCRIPTION  : 
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+
+   SUBROUTINE explicitsnow_melt_refrz(kjpindex,precip_rain,pgflux,soilcap,&
+                     snowtemp,snowdz,snowrho,snowliq,snowmelt,grndflux,temp_air)
+
+      !! 0.1 Input variables
+
+      INTEGER(i_std), INTENT (in)                             :: kjpindex     !! Domain size
+      REAL(r_std),DIMENSION (kjpindex,nsnow)                  :: pcapa_snow   !! Heat capacity for snow
+      REAL(r_std),DIMENSION (kjpindex), INTENT(in)            :: precip_rain  !! Rainfall      
+      REAL(r_std),DIMENSION (kjpindex), INTENT(in)            :: temp_air     !! Air temperature
+      REAL(r_std),DIMENSION (kjpindex),INTENT(in)             :: pgflux       !! Net energy into snowpack(w/m2)
+      REAL(r_std),DIMENSION (kjpindex),INTENT(in)             :: soilcap      !! Soil heat capacity
+
+      !! 0.2 Output variables
+
+      !! 0.3 Modified variables
+
+      REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)  :: snowtemp     !! Snow temperature 
+      REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)  :: snowdz       !! Snow depth
+      REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowrho      !! Snow layer density (Kg/m^3)
+      REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowliq      !! Liquid water content
+      REAL(r_std),DIMENSION(kjpindex),INTENT(inout)           :: grndflux     !! Net energy input to soil 
+      REAL(r_std),DIMENSION (kjpindex), INTENT(inout)         :: snowmelt     !! Snowmelt
+
+      !! 0.4 Local variables
+
+      REAL(r_std),DIMENSION (kjpindex)                        :: meltxs       !! Residual snowmelt energy applied to underlying soil
+      REAL(r_std)                                             :: enerin,melttot,hrain 
+      REAL(r_std),DIMENSION (nsnow)                           :: zsnowlwe
+      REAL(r_std),DIMENSION (nsnow)                           :: flowliq
+      REAL(r_std),DIMENSION (kjpindex)                        :: snowmass
+      REAL(r_std),DIMENSION (nsnow)                           :: zphase       !! Phase change (from ice to water) (J/m2)
+      REAL(r_std),DIMENSION (nsnow)                           :: zphase2      !! Phase change (from water to ice)
+      REAL(r_std),DIMENSION (nsnow)                           :: zphase3      !! Phase change related with net energy input to snowpack
+      REAL(r_std),DIMENSION (nsnow)                           :: zsnowdz      !! Snow layer depth
+      REAL(r_std),DIMENSION (nsnow)                           :: zsnowmelt    !! Snow melt (liquid water) (m)
+      REAL(r_std),DIMENSION (nsnow)                           :: zsnowtemp
+      REAL(r_std),DIMENSION (nsnow)                           :: zmeltxs      !! Excess melt
+      REAL(r_std),DIMENSION (nsnow)                           :: zwholdmax    !! Maximum liquid water holding (m)
+      REAL(r_std),DIMENSION (nsnow)                           :: zcmprsfact   !! Compression factor due to densification from melting
+      REAL(r_std),DIMENSION (nsnow)                           :: zscap        !! Snow heat capacity (J/m3 K)
+      REAL(r_std),DIMENSION (nsnow)                           :: zsnowliq     !! (m)
+      REAL(r_std),DIMENSION (nsnow)                           :: snowtemp_old
+      REAL(r_std),DIMENSION (0:nsnow)                         :: zflowliqt    !!(m)
+      REAL(r_std)                                             :: zrainfall,zpcpxs
+      REAL(r_std)                                             :: ztotwcap
+      REAL(r_std),DIMENSION(kjpindex,nsnow)                   :: snowdz_old,snowliq_old
+      INTEGER(i_std)                                          :: jj,ji, iv
+      REAL(r_std),DIMENSION(nsnow)                            :: snowdz_old2
+      REAL(r_std),DIMENSION(nsnow)                            :: zsnowrho 
+    
+      !initialize
+      snowdz_old = snowdz
+      snowliq_old = snowliq
+
+      DO ji = 1, kjpindex
+
+
+         snowmass(ji) = SUM(snowrho(ji,:) * snowdz(ji,:))
+         IF ((snowmass(ji) .GT. min_sechiba)) THEN
+
+           !! 1 snow melting due to positive snowpack snow temperature
+ 
+             !! 1.0 total liquid equivalent water content of each snow layer
+
+               zsnowlwe(:) = snowrho(ji,:) * snowdz(ji,:)/ ph2o 
+
+             !! 1.1 phase change (J/m2)
+
+               pcapa_snow(ji,:) = snowrho(ji,:)*xci
+
+               zphase(:)  = MIN(pcapa_snow(ji,:)*MAX(0.0, snowtemp(ji,:)-tp_00)*      &
+                                snowdz(ji,:),                                       &
+                            MAX(0.0,zsnowlwe(:)-snowliq(ji,:))*chalfu0*ph2o)
+
+             !! 1.2 update snow liq water and temperature if melting
+
+               zsnowmelt(:) = zphase(:)/(chalfu0*ph2o)
+
+             !! 1.3 cool off the snow layer temperature due to melt
+
+               zsnowtemp(:) = snowtemp(ji,:) - zphase(:)/(pcapa_snow(ji,:)* snowdz(ji,:))
+
+               snowtemp(ji,:) = MIN(tp_00, zsnowtemp(:))
+
+               zmeltxs(:)   = (zsnowtemp(:)-snowtemp(ji,:))*pcapa_snow(ji,:)*snowdz(ji,:)
+
+             !! 1.4 loss of snowpack depth and liquid equivalent water
+
+               zwholdmax(:) = snow3lhold_1d(snowrho(ji,:),snowdz(ji,:)) ! 1 dimension
+
+               zcmprsfact(:) = (zsnowlwe(:)-MIN(snowliq(ji,:)+zsnowmelt(:),zwholdmax(:)))/ &
+                               (zsnowlwe(:)-MIN(snowliq(ji,:),zwholdmax(:)))
+
+               snowdz(ji,:)    = snowdz(ji,:)*zcmprsfact(:)
+
+               snowrho(ji,:)     = zsnowlwe(:)*ph2o/snowdz(ji,:)
+
+               snowliq(ji,:)   = snowliq(ji,:) + zsnowmelt(:)
+
+
+           !! 2 snow refreezing process
+              !! 2.1 freeze liquid water in any layer
+               zscap(:)     = snowrho(ji,:)*xci  !J K-1 m-3
+               zphase2(:)    = MIN(zscap(:)*                                          &
+                                MAX(0.0, tp_00 - snowtemp(ji,:))*snowdz(ji,:),             &
+                                snowliq(ji,:)*chalfu0*ph2o)
+
+               ! warm layer and reduce liquid if freezing occurs
+               zsnowdz(:) = MAX(xsnowdmin/nsnow, snowdz(ji,:))
+               snowtemp_old(:) = snowtemp(ji,:) 
+               snowtemp(ji,:) = snowtemp(ji,:) + zphase2(:)/(zscap(:)*zsnowdz(:))
+               
+               ! Reduce liquid portion if freezing occurs:
+               snowliq(ji,:) = snowliq(ji,:) - ( (snowtemp(ji,:)-snowtemp_old(:))*       &
+               zscap(:)*zsnowdz(:)/(chalfu0*ph2o) )
+               snowliq(ji,:) = MAX(snowliq(ji,:), 0.0)
+           !! 3. thickness change due to snowmelt in excess of holding capacity
+               zwholdmax(:) = snow3lhold_1d(snowrho(ji,:),snowdz(ji,:)) ! 1 dimension
+               flowliq(:) = MAX(0.,(snowliq(ji,:)-zwholdmax(:)))
+               snowliq(ji,:)  = snowliq(ji,:) - flowliq(:)
+               snowdz(ji,:) = snowdz(ji,:) - flowliq(:)*ph2o/snowrho(ji,:)
+               ! to prevent possible very small negative values (machine
+               ! prescision as snow vanishes
+               snowdz(ji,:) = MAX(0.0, snowdz(ji,:)) 
+
+           !! 4. liquid water flow
+               ztotwcap = SUM(zwholdmax(:)) 
+               ! Rain entering snow (m):
+               !ORCHIDEE has assumed that all precipitation entering snow has
+               !left the snowpack and finally become runoff in hydrol_soil. Here we just put zrainfall as 0.0
+               !!zrainfall = precip_rain(ji)/ph2o ! rainfall (m)
+               zrainfall = 0.0
+
+               zflowliqt(0) = MIN(zrainfall,ztotwcap)
+               ! Rain assumed to directly pass through the pack to runoff (m):
+               zpcpxs = zrainfall - zflowliqt(0)
+               !
+               DO jj=1,nsnow
+                  zflowliqt(jj) = flowliq(jj)
+               ENDDO
+
+               ! translated into a density increase:
+               flowliq(:) = 0.0                ! clear this array for work
+               zsnowliq(:) = snowliq(ji,:)      ! reset liquid water content
+               !
+
+               DO jj=1,nsnow
+                  snowliq(ji,jj)  = snowliq(ji,jj) + zflowliqt(jj-1)
+                  flowliq(jj)   = MAX(0.0, (snowliq(ji,jj)-zwholdmax(jj)))
+                  snowliq(ji,jj)  = snowliq(ji,jj) - flowliq(jj)
+
+                  !Modified by Tao Wang based on previous ISBA-ES scheme
+                  snowrho(ji,jj)  = snowrho(ji,jj)  + (snowliq(ji,jj) - zsnowliq(jj))*       &
+                                        & ph2o/MAX(xsnowdmin/nsnow,snowdz(ji,jj))
+
+                  zflowliqt(jj) = zflowliqt(jj) + flowliq(jj)  
+               ENDDO
+
+               snowmelt(ji)  = snowmelt(ji) + (zflowliqt(nsnow) + zpcpxs) *  ph2o
+
+             ! excess heat from melting, using it to warm underlying ground to conserve energy
+               meltxs(ji) = SUM(zmeltxs(:))/dt_sechiba  ! (W/m2)
+
+             ! energy flux into the soil 
+               grndflux(ji) = grndflux(ji) + meltxs(ji)  
+
+         ELSE
+               snowdz(ji,:)=0.
+               snowliq(ji,:)=0.
+               snowmelt(ji)=snowmelt(ji)+SUM(snowrho(ji,:)*snowdz(ji,:))
+         ENDIF
+
+      ENDDO
+
+    END SUBROUTINE explicitsnow_melt_refrz
+
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_levels
+!!
+!>\BRIEF        Computes snow discretization based on given total snow depth
+!!                
+!! DESCRIPTION  : 
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================ 
+  SUBROUTINE explicitsnow_levels( kjpindex,snow_thick, snowdz)
+    
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                                     :: kjpindex     !! Domain size
+    REAL(r_std),DIMENSION (kjpindex),   INTENT (in)                :: snow_thick   !! Total snow depth
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)         :: snowdz                           !! Snow depth
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                                 :: il,it,ji
+    INTEGER(i_std)                                                 :: i,j, ix
+    REAL(r_std), DIMENSION(kjpindex)                               :: xi, xf
+    REAL(r_std), PARAMETER, DIMENSION(3)                           :: ZSGCOEF1  = (/0.25, 0.50, 0.25/) !! Snow grid parameters 
+    REAL(r_std), PARAMETER, DIMENSION(2)                           :: ZSGCOEF2  = (/0.05, 0.34/)       !! Snow grid parameters 
+    REAL(r_std), PARAMETER                                         :: ZSNOWTRANS = 0.20                !! Minimum total snow depth at which surface layer thickness is constant (m)
+    REAL(r_std), PARAMETER                                         :: XSNOWCRITD = 0.03                !! (m)
+
+    DO ji=1,kjpindex
+       IF ( snow_thick(ji) .LE. (XSNOWCRITD+0.01)) THEN
+
+        snowdz(ji,1) = MIN(0.01, snow_thick(ji)/nsnow)
+        snowdz(ji,3) = MIN(0.01, snow_thick(ji)/nsnow)
+        snowdz(ji,2) = snow_thick(ji) - snowdz(ji,1) - snowdz(ji,3)
+   
+       ENDIF 
+    ENDDO
+
+    WHERE ( snow_thick(:) .LE. ZSNOWTRANS .AND. &
+            snow_thick(:) .GT. (XSNOWCRITD+0.01) )
+       !
+        snowdz(:,1) = snow_thick(:)*ZSGCOEF1(1)
+        snowdz(:,2) = snow_thick(:)*ZSGCOEF1(2) 
+        snowdz(:,3) = snow_thick(:)*ZSGCOEF1(3)
+       !
+    END WHERE
+
+     DO ji = 1,kjpindex
+      IF (snow_thick(ji) .GT. ZSNOWTRANS) THEN
+          snowdz(ji,1) = ZSGCOEF2(1)
+          snowdz(ji,2) = (snow_thick(ji)-ZSGCOEF2(1))*ZSGCOEF2(2) + ZSGCOEF2(1)
+        !When using simple finite differences, limit the thickness
+        !factor between the top and 2nd layers to at most 10
+          snowdz(ji,2)  = MIN(10*ZSGCOEF2(1),  snowdz(ji,2) )
+          snowdz(ji,3)  = snow_thick(ji) - snowdz(ji,2) - snowdz(ji,1)
+
+      ENDIF
+    ENDDO
+      
+
+  END SUBROUTINE explicitsnow_levels
+
+!!
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_profile
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : In this routine solves the numerical soil thermal scheme, ie calculates the new soil temperature profile.
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_
+!================================================================================================================================
+  SUBROUTINE explicitsnow_profile (kjpindex, cgrnd_snow,dgrnd_snow,lambda_snow,temp_sol_new, snowtemp,snowdz,temp_sol_add)
+
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex     !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_sol_new !! skin temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow),INTENT (in)      :: cgrnd_snow   !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow),INTENT (in)      :: dgrnd_snow   !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex),INTENT(in)             :: lambda_snow  !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow),INTENT(in)       :: snowdz       !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex),INTENT(inout)          :: temp_sol_add !! Additional energy to melt snow for snow ablation case (K)
+
+    !! 0.3 Modified variable
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (inout)   :: snowtemp
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jg
+!_
+!================================================================================================================================
+  !! 1. Computes the snow temperatures ptn.
+    DO ji = 1,kjpindex
+      IF (SUM(snowdz(ji,:)) .GT. 0) THEN
+        snowtemp(ji,1) = (lambda_snow(ji) * cgrnd_snow(ji,1) + (temp_sol_new(ji)+temp_sol_add(ji))) / &
+             (lambda_snow(ji) * (un - dgrnd_snow(ji,1)) + un)
+        temp_sol_add(ji) = zero 
+        DO jg = 1,nsnow-1
+            snowtemp(ji,jg+1) = cgrnd_snow(ji,jg) + dgrnd_snow(ji,jg) * snowtemp(ji,jg)
+        ENDDO
+      ENDIF
+    ENDDO
+    IF (printlev>=3) WRITE (numout,*) ' explicitsnow_profile done '
+
+  END SUBROUTINE explicitsnow_profile
+
+END MODULE explicitsnow
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/hydrol.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/hydrol.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/hydrol.f90	(revision 6412)
@@ -0,0 +1,6516 @@
+! ===================================================================================================\n
+! MODULE        : hydrol
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module computes the soil moisture processes on continental points. 
+!!
+!!\n DESCRIPTION : contains hydrol_main, hydrol_initialize, hydrol_finalise, hydrol_init, 
+!!                 hydrol_var_init, hydrol_alma,
+!!                 hydrol_vegupd, hydrol_canop, hydrol_flood, hydrol_soil.
+!!                 The assumption in this module is that very high vertical resolution is
+!!                 needed in order to properly resolve the vertical diffusion of water in
+!!                 the soils. Furthermore we have taken into account the sub-grid variability
+!!                 of soil properties and vegetation cover by allowing the co-existence of
+!!                 different soil moisture columns in the same grid box.
+!!                 This routine was originaly developed by Patricia deRosnay.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) :
+!! - de Rosnay, P., J. Polcher, M. Bruen, and K. Laval, Impact of a physically based soil
+!! water flow and soil-plant interaction representation for modeling large-scale land surface
+!! processes, J. Geophys. Res, 107 (10.1029), 2002. \n
+!! - de Rosnay, P. and Polcher J. (1998) Modeling root water uptake in a complex land surface scheme coupled 
+!! to a GCM. Hydrology and Earth System Sciences, 2(2-3):239-256. \n
+!! - de Rosnay, P., M. Bruen, and J. Polcher, Sensitivity of surface fluxes to the number of layers in the soil 
+!! model used in GCMs, Geophysical research letters, 27 (20), 3329 - 3332, 2000. \n
+!! - dâOrgeval, T., J. Polcher, and P. De Rosnay, Sensitivity of the West African hydrological
+!! cycle in ORCHIDEE to infiltration processes, Hydrol. Earth Syst. Sci. Discuss, 5, 2251 - 2292, 2008. \n
+!! - Carsel, R., and R. Parrish, Developing joint probability distributions of soil water retention
+!! characteristics, Water Resources Research, 24 (5), 755 - 769, 1988. \n
+!! - Mualem, Y., A new model for predicting the hydraulic conductivity of unsaturated porous
+!! media, Water Resources Research, 12 (3), 513 - 522, 1976. \n
+!! - Van Genuchten, M., A closed-form equation for predicting the hydraulic conductivity of
+!! unsaturated soils, Soil Science Society of America Journal, 44 (5), 892 - 898, 1980. \n
+!! - Campoy, A., Ducharne, A., Cheruy, F., Hourdin, F., Polcher, J., and Dupont, J.-C., Response 
+!! of land surface fluxes and precipitation to different soil bottom hydrological conditions in a
+!! general circulation model,  J. Geophys. Res, in press, 2013. \n
+!! - Gouttevin, I., Krinner, G., Ciais, P., Polcher, J., and Legout, C. , 2012. Multi-scale validation
+!! of a new soil freezing scheme for a land-surface model with physically-based hydrology.
+!! The Cryosphere, 6, 407-430, doi: 10.5194/tc-6-407-2012. \n
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ===============================================================================================\n
+MODULE hydrol
+
+  USE ioipsl
+  USE xios_orchidee
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE sechiba_io_p
+  USE grid
+  USE explicitsnow
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: hydrol_main, hydrol_initialize, hydrol_finalize, hydrol_clear
+
+  !
+  ! variables used inside hydrol module : declaration and initialisation
+  !
+  LOGICAL, SAVE                                   :: first_hydrol_main=.TRUE.  !! Initialisation has to be done one time (true/false)
+!$OMP THREADPRIVATE(first_hydrol_main)
+  LOGICAL, SAVE                                   :: doponds=.FALSE.           !! Reinfiltration flag (true/false)
+!$OMP THREADPRIVATE(doponds)
+  REAL(r_std), SAVE                               :: froz_frac_corr            !! Coefficient for water frozen fraction correction
+!$OMP THREADPRIVATE(froz_frac_corr)
+  REAL(r_std), SAVE                               :: max_froz_hydro            !! Coefficient for water frozen fraction correction 
+!$OMP THREADPRIVATE(max_froz_hydro) 
+  REAL(r_std), SAVE                               :: smtot_corr                !! Coefficient for water frozen fraction correction 
+!$OMP THREADPRIVATE(smtot_corr)
+  LOGICAL, SAVE                                   :: do_rsoil=.FALSE.          !! Flag to calculate rsoil for bare soile evap
+!$OMP THREADPRIVATE(do_rsoil)
+  LOGICAL, SAVE                                   :: ok_dynroot                !! Flag to activate dynamic root profile to optimize soil
+                                                                               !! moisture usage, similar to Beer et al. 2007
+!$OMP THREADPRIVATE(ok_dynroot)
+  CHARACTER(LEN=80) , SAVE                        :: var_name                  !! To store variables names for I/O
+!$OMP THREADPRIVATE(var_name)
+  !
+  REAL(r_std), PARAMETER                          :: allowed_err =  2.0E-8_r_std
+  REAL(r_std), PARAMETER                          :: EPS1 = EPSILON(un)        !! A small number
+  ! one dimension array allocated, computed, saved and got in hydrol module
+  ! Values per soil type
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: nvan                !! Van Genuchten coeficients n (unitless)
+                                                                          ! RK: 1/n=1-m
+!$OMP THREADPRIVATE(nvan)                                                 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: avan                !! Van Genuchten coeficients a
+                                                                         !!  @tex $(mm^{-1})$ @endtex
+!$OMP THREADPRIVATE(avan)                                                
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcr                 !! Residual volumetric water content
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex
+!$OMP THREADPRIVATE(mcr)                                                 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcs                 !! Saturated volumetric water content
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex
+!$OMP THREADPRIVATE(mcs)                                                  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: ks                  !! Hydraulic conductivity at saturation
+                                                                         !!  @tex $(mm d^{-1})$ @endtex
+!$OMP THREADPRIVATE(ks)                                                  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: pcent               !! Fraction of saturated volumetric soil moisture above 
+                                                                         !! which transpir is max (0-1, unitless)
+!$OMP THREADPRIVATE(pcent)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcf                 !! Volumetric water content at field capacity
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex 
+!$OMP THREADPRIVATE(mcf)                                                 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcw                 !! Volumetric water content at wilting point
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex 
+!$OMP THREADPRIVATE(mcw)                                                 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mc_awet             !! Vol. wat. cont. above which albedo is cst
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex 
+!$OMP THREADPRIVATE(mc_awet)                                             
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mc_adry             !! Vol. wat. cont. below which albedo is cst
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex 
+!$OMP THREADPRIVATE(mc_adry)                                             
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watveg_beg   !! Total amount of water on vegetation at start of time 
+                                                                         !! step @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(tot_watveg_beg)                                      
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watveg_end   !! Total amount of water on vegetation at end of time step
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(tot_watveg_end)                                      
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watsoil_beg  !! Total amount of water in the soil at start of time step
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(tot_watsoil_beg)                                     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watsoil_end  !! Total amount of water in the soil at end of time step
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(tot_watsoil_end)                                     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: snow_beg         !! Total amount of snow at start of time step
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(snow_beg)                                            
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: snow_end         !! Total amount of snow at end of time step
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(snow_end)                                           
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: delsoilmoist     !! Change in soil moisture @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(delsoilmoist)                                         
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: delintercept     !! Change in interception storage
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(delintercept)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: delswe           !! Change in SWE @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(delswe)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION (:)       :: undermcr         !! Nb of tiles under mcr for a given time step
+!$OMP THREADPRIVATE(undermcr) 
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_veget       !! zero/one when veget fraction is zero/higher (1)
+!$OMP THREADPRIVATE(mask_veget)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_soiltile    !! zero/one where soil tile is zero/higher (1)
+!$OMP THREADPRIVATE(mask_soiltile)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: humrelv          !! Water stress index for transpiration
+                                                                         !! for each soiltile x PFT couple (0-1, unitless)
+!$OMP THREADPRIVATE(humrelv)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: vegstressv       !! Water stress index for vegetation growth
+                                                                         !! for each soiltile x PFT couple (0-1, unitless)
+!$OMP THREADPRIVATE(vegstressv)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:):: us               !! Water stress index for transpiration 
+                                                                         !! (by soil layer and PFT) (0-1, unitless)
+!$OMP THREADPRIVATE(us)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: precisol         !! Throughfall per PFT 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(precisol)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: precisol_ns      !! Throughfall per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(precisol_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: ae_ns            !! Bare soil evaporation per soiltile
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(ae_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: evap_bare_lim_ns !! Limitation factor (beta) for bare soil evaporation 
+                                                                         !! per soiltile (used to deconvoluate vevapnu)  
+                                                                         !!  (0-1, unitless) 
+!$OMP THREADPRIVATE(evap_bare_lim_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: free_drain_coef  !! Coefficient for free drainage at bottom
+                                                                         !!  (0-1, unitless) 
+!$OMP THREADPRIVATE(free_drain_coef) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: zwt_force        !! Prescribed water table depth (m)
+!$OMP THREADPRIVATE(zwt_force) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: frac_bare_ns     !! Evaporating bare soil fraction per soiltile
+                                                                         !!  (0-1, unitless)
+!$OMP THREADPRIVATE(frac_bare_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: rootsink         !! Transpiration sink by soil layer and soiltile
+                                                                         !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(rootsink)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: subsnowveg       !! Sublimation of snow on vegetation 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(subsnowveg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: subsnownobio     !! Sublimation of snow on other surface types  
+                                                                         !! (ice, lakes,...) @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(subsnownobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: icemelt          !! Ice melt @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(icemelt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: subsinksoil      !! Excess of sublimation as a sink for the soil
+                                                                         !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(subsinksoil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: vegtot           !! Total Total fraction of grid-cell covered by PFTs
+                                                                         !! (bare soil + vegetation) (1; 1)
+!$OMP THREADPRIVATE(vegtot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: resdist          !! Soiltile values from previous time-step (1; 1)
+  
+!$OMP THREADPRIVATE(resdist)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: vegtot_old       !! Total Total fraction of grid-cell covered by PFTs
+                                                                         !! from previous time-step (1; 1)
+!$OMP THREADPRIVATE(vegtot_old)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: mx_eau_var       !! Maximum water content of the soil @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(mx_eau_var)
+
+  ! arrays used by cwrr scheme
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: nroot            !! Normalized root length fraction in each soil layer 
+                                                                         !! (0-1, unitless)
+                                                                         !! DIM = kjpindex * nvm * nslm
+!$OMP THREADPRIVATE(nroot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: kfact_root       !! Factor to increase Ks towards the surface
+                                                                         !! (unitless)
+                                                                         !! DIM = kjpindex * nslm * nstm
+!$OMP THREADPRIVATE(kfact_root)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: kfact            !! Factor to reduce Ks with depth (unitless)
+                                                                         !! DIM = nslm * nscm
+!$OMP THREADPRIVATE(kfact)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: zz               !! Depth of nodes [znh in vertical_soil] transformed into (mm) 
+!$OMP THREADPRIVATE(zz)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: dz               !! Internode thickness [dnh in vertical_soil] transformed into (mm)
+!$OMP THREADPRIVATE(dz)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: dh               !! Layer thickness [dlh in vertical_soil] transformed into (mm)
+!$OMP THREADPRIVATE(dh)
+  INTEGER(i_std), SAVE                               :: itopmax          !! Number of layers where the node is above 0.1m depth
+!$OMP THREADPRIVATE(itopmax)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: mc_lin   !! 50 Vol. Wat. Contents to linearize K and D, for each texture 
+                                                                 !!  @tex $(m^{3} m^{-3})$ @endtex
+                                                                 !! DIM = imin:imax * nscm
+!$OMP THREADPRIVATE(mc_lin)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: k_lin    !! 50 values of unsaturated K, for each soil layer and texture
+                                                                 !!  @tex $(mm d^{-1})$ @endtex
+                                                                 !! DIM = imin:imax * nslm * nscm
+!$OMP THREADPRIVATE(k_lin)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: d_lin    !! 50 values of diffusivity D, for each soil layer and texture
+                                                                 !!  @tex $(mm^2 d^{-1})$ @endtex
+                                                                 !! DIM = imin:imax * nslm * nscm
+!$OMP THREADPRIVATE(d_lin)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: a_lin    !! 50 values of the slope in K=a*mc+b, for each soil layer and texture
+                                                                 !!  @tex $(mm d^{-1})$ @endtex
+                                                                 !! DIM = imin:imax * nslm * nscm
+!$OMP THREADPRIVATE(a_lin)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: b_lin    !! 50 values of y-intercept in K=a*mc+b, for each soil layer and texture
+                                                                 !!  @tex $(m^{3} m^{-3})$ @endtex
+                                                                 !! DIM = imin:imax * nslm * nscm
+!$OMP THREADPRIVATE(b_lin)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: humtot   !! Total Soil Moisture @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(humtot)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:)          :: resolv   !! Mask of land points where to solve the diffusion equation
+                                                                 !! (true/false)
+!$OMP THREADPRIVATE(resolv)
+
+!! linarization coefficients of hydraulic conductivity K (hydrol_soil_coef)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: k        !! Hydraulic conductivity K for each soil layer
+                                                                 !!  @tex $(mm d^{-1})$ @endtex
+                                                                 !! DIM = (:,nslm)
+!$OMP THREADPRIVATE(k)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: kk_moy   !! Mean hydraulic conductivity over soiltiles (mm/d)
+!$OMP THREADPRIVATE(kk_moy)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: kk       !! Hydraulic conductivity for each soiltiles (mm/d)
+!$OMP THREADPRIVATE(kk)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: a        !! Slope in K=a*mc+b(:,nslm)
+                                                                 !!  @tex $(mm d^{-1})$ @endtex
+                                                                 !! DIM = (:,nslm)
+!$OMP THREADPRIVATE(a)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: b        !! y-intercept in K=a*mc+b
+                                                                 !!  @tex $(m^{3} m^{-3})$ @endtex
+                                                                 !! DIM = (:,nslm)
+!$OMP THREADPRIVATE(b)
+!! linarization coefficients of hydraulic diffusivity D (hydrol_soil_coef)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: d        !! Diffusivity D for each soil layer
+                                                                 !!  @tex $(mm^2 d^{-1})$ @endtex
+                                                                 !! DIM = (:,nslm)
+!$OMP THREADPRIVATE(d)
+!! matrix coefficients (hydrol_soil_tridiag and hydrol_soil_setup), see De Rosnay (1999), p155-157
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: e        !! Left-hand tridiagonal matrix coefficients
+!$OMP THREADPRIVATE(e)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: f        !! Left-hand tridiagonal matrix coefficients
+!$OMP THREADPRIVATE(f)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: g1       !! Left-hand tridiagonal matrix coefficients
+!$OMP THREADPRIVATE(g1)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: ep       !! Right-hand matrix coefficients
+!$OMP THREADPRIVATE(ep)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: fp       !! Right-hand atrix coefficients
+!$OMP THREADPRIVATE(fp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: gp       !! Right-hand atrix coefficients
+!$OMP THREADPRIVATE(gp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: rhs      !! Right-hand system
+!$OMP THREADPRIVATE(rhs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: srhs     !! Temporarily stored rhs
+!$OMP THREADPRIVATE(srhs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: tmat             !! Left-hand tridiagonal matrix
+!$OMP THREADPRIVATE(tmat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: stmat            !! Temporarily stored tmat
+  !$OMP THREADPRIVATE(stmat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: water2infilt     !! Water to be infiltrated
+                                                                         !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(water2infilt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc              !! Total moisture content per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(tmc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmcr             !! Total moisture constent at residual per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmcr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmcs             !! Total moisture constent at saturation per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmcs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter       !! Total moisture in the litter per soiltile
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tmc_litt_mea     !! Total moisture in the litter over the grid
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litt_mea)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_wilt  !! Total moisture of litter at wilt point per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter_wilt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_field !! Total moisture of litter at field cap. per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter_field)
+!!! A CHANGER DANS TOUT HYDROL: tmc_litter_res et sat ne devraient pas dependre de ji - tdo
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_res   !! Total moisture of litter at residual moisture per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter_res)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_sat   !! Total moisture of litter at saturation per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter_sat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_awet  !! Total moisture of litter at mc_awet per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter_awet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_adry  !! Total moisture of litter at mc_adry per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter_adry)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tmc_litt_wet_mea !! Total moisture in the litter over the grid below which 
+                                                                         !! albedo is fixed constant
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litt_wet_mea)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tmc_litt_dry_mea !! Total moisture in the litter over the grid above which 
+                                                                         !! albedo is constant
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litt_dry_mea)
+  LOGICAL, SAVE                                      :: tmc_init_updated = .FALSE. !! Flag allowing to determine if tmc is initialized.
+!$OMP THREADPRIVATE(tmc_init_updated)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: v1               !! Temporary variable (:)
+!$OMP THREADPRIVATE(v1)
+
+  !! par type de sol :
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: ru_ns            !! Surface runoff per soiltile
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(ru_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: dr_ns            !! Drainage per soiltile
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(dr_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tr_ns            !! Transpiration per soiltile
+!$OMP THREADPRIVATE(tr_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: vegetmax_soil    !! (:,nvm,nstm) percentage of each veg. type on each soil 
+                                                                         !! of each grid point 
+!$OMP THREADPRIVATE(vegetmax_soil)
+REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: mc                 !! Total volumetric water content at the calculation nodes
+                                                                         !! (eg : liquid + frozen)
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex
+!$OMP THREADPRIVATE(mc)
+   REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: mcl              !! Liquid water content
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex
+!$OMP THREADPRIVATE(mcl)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: soilmoist        !! (:,nslm) Mean of each soil layer's moisture
+                                                                         !! across soiltiles
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(soilmoist)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: soil_wet         !! Soil wetness above mcw (0-1, unitless)
+!$OMP THREADPRIVATE(soil_wet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: soil_wet_litter  !! Soil wetness aove mvw in the litter (0-1, unitless)
+!$OMP THREADPRIVATE(soil_wet_litter)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)   :: qflux_ns         !! Diffusive water fluxes between soil layers 
+!$OMP THREADPRIVATE(qflux_ns) 
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)     :: check_top_ns     !! Diagnostic calculated in hydrol_diag_soil_flux 
+                                                                         !! (water balance residu of top soil layer) 
+!$OMP THREADPRIVATE(check_top_ns) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: frac_hydro_diag       !! 
+!$OMP THREADPRIVATE(frac_hydro_diag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: profil_froz_hydro     !! Frozen fraction for each hydrological soil layer
+!$OMP THREADPRIVATE(profil_froz_hydro)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: profil_froz_hydro_ns  !! As  profil_froz_hydro per soiltile
+!$OMP THREADPRIVATE(profil_froz_hydro_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: temp_hydro            !! Temp profile on hydrological levels
+!$OMP THREADPRIVATE(temp_hydro)
+! INTEGER(i_std), SAVE                                :: printlev_loc          !!Local printlev in hydrol module
+!!$OMP THREADPRIVATE(printlev_loc)
+
+
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_initialize
+!!
+!>\BRIEF         Allocate module variables, read from restart file or initialize with default values
+!!
+!! DESCRIPTION :
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_initialize ( kjit,           kjpindex,  index,         rest_id,          &
+                                 njsc,           soiltile,  veget,         veget_max,        &
+                                 humrel,         vegstress, drysoil_frac,                    &
+                                 shumdiag_perma,    qsintveg,                        &
+                                 evap_bare_lim,  snow,      snow_age,      snow_nobio,       &
+                                 snow_nobio_age, snowrho,   snowtemp,      snowgrain,        &
+                                 snowdz,         snowheat,  &
+                                 mc_layh,       mcl_layh,  tmc_layh)
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index            !! Indeces of the points on the map
+    INTEGER(i_std),INTENT (in)                         :: rest_id          !! Restart file identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile         !! Fraction of each soil tile within vegtot (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget            !! Fraction of vegetation type           
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max        !! Max. fraction of vegetation type (LAI -> infty)
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: humrel         !! Relative humidity
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: vegstress      !! Veg. moisture stress (only for vegetation growth)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: drysoil_frac   !! function of litter wetness
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out)  :: shumdiag_perma !! Percent of porosity filled with water (mc/mcs) used for the thermal computations
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: qsintveg       !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)        :: evap_bare_lim  !! Limitation factor for bare soil evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: snow           !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: snow_age       !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out):: snow_nobio     !! Water balance on ice, lakes, .. [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out):: snow_nobio_age !! Snow age on ice, lakes, ...
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowrho        !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowtemp       !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowgrain      !! Snow grainsize
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowdz         !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowheat       !! Snow heat content
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out)  :: mc_layh        !! Volumetric moisture content for each layer in hydrol (liquid+ice) m3/m3
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out)  :: mcl_layh       !! Volumetric moisture content for each layer in hydrol (liquid) m3/m3
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out)  :: tmc_layh       !! Total soil moisture content for each layer in hydrol (liquid+ice), mm
+    REAL(r_std),DIMENSION (kjpindex)                     :: soilwetdummy   !! Temporary variable never used
+
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                       :: jsl
+
+!_ ================================================================================================================================
+
+    CALL hydrol_init (kjit, kjpindex, index, rest_id, njsc, veget_max, soiltile, &
+         humrel, vegstress, snow,       snow_age,   snow_nobio, snow_nobio_age, qsintveg, &
+         snowdz, snowgrain, snowrho,    snowtemp,   snowheat, &
+         drysoil_frac, evap_bare_lim)
+    
+    CALL hydrol_var_init (kjpindex, veget, veget_max, &
+         soiltile, njsc, mx_eau_var, shumdiag_perma, &
+         drysoil_frac, qsintveg, mc_layh, mcl_layh, tmc_layh) 
+
+    !! Initialize hydrol_alma routine if the variables were not found in the restart file. This is done in the end of 
+    !! hydrol_initialize so that all variables(humtot,..) that will be used are initialized.
+    IF (ALL(tot_watveg_beg(:)==val_exp) .OR.  ALL(tot_watsoil_beg(:)==val_exp) .OR. ALL(snow_beg(:)==val_exp)) THEN
+       ! The output variable soilwetdummy is not calculated at first call to hydrol_alma.
+       CALL hydrol_alma(kjpindex, index, .TRUE., qsintveg, snow, snow_nobio, soilwetdummy)
+    END IF
+    
+    !! Calculate itopmax indicating the number of layers where the node is above 0.1m depth 
+    itopmax=1 
+    DO jsl = 1, nslm 
+       ! znh : depth of nodes 
+       IF (znh(jsl) <= 0.1) THEN 
+          itopmax=jsl 
+       END IF 
+    END DO 
+    IF (printlev>=3) WRITE(numout,*) "Number of layers where the node is above 0.1m depth: itopmax=",itopmax 
+
+  END SUBROUTINE hydrol_initialize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_main
+!!
+!>\BRIEF         
+!!
+!! DESCRIPTION :
+!! - called every time step
+!! - initialization and finalization part are not done in here
+!!
+!! - 1 computes snow  ==> explicitsnow
+!! - 2 computes vegetations reservoirs  ==> hydrol_vegupd
+!! - 3 computes canopy  ==> hydrol_canop
+!! - 4 computes surface reservoir  ==> hydrol_flood
+!! - 5 computes soil hydrology ==> hydrol_soil
+!!
+!! IMPORTANT NOTICE : The water fluxes are used in their integrated form, over the time step 
+!! dt_sechiba, with a unit of kg m^{-2}.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_main (kjit, kjpindex, &
+       & index, indexveg, indexsoil, indexlayer, indexnbdl, &
+       & temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max, njsc, &
+       & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age,  &
+       & tot_melt, transpir, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, &
+       & humrel, vegstress, drysoil_frac, evapot, evapot_penm, evap_bare_lim, flood_frac, flood_res, &
+       & shumdiag,shumdiag_perma, k_litt, litterhumdiag, soilcap, soiltile, reinf_slope, rest_id, hist_id, hist2_id,&
+       & stempdiag, &
+       & temp_air, pb, u, v, tq_cdrag, swnet, pgflux, &
+       & snowrho,snowtemp,snowgrain,snowdz,snowheat,snowliq, &
+       & grndflux,gtemp,tot_bare_soil, &
+       & lambda_snow,cgrnd_snow,dgrnd_snow,temp_sol_add, &
+       & mc_layh, mcl_layh, tmc_layh, tmc_pft, drainage_pft, swc_pft, swc, ksave,  e_frac)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+  
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size
+    INTEGER(i_std),INTENT (in)                         :: rest_id,hist_id  !! _Restart_ file and _history_ file identifier
+    INTEGER(i_std),INTENT (in)                         :: hist2_id         !! _history_ file 2 identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index            !! Indeces of the points on the map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in):: indexveg        !! Indeces of the points on the 3D map for veg
+    INTEGER(i_std),DIMENSION (kjpindex*nstm), INTENT (in):: indexsoil      !! Indeces of the points on the 3D map for soil
+    INTEGER(i_std),DIMENSION (kjpindex*nslm), INTENT (in):: indexlayer     !! Indeces of the points on the 3D map for soil layers
+    INTEGER(i_std),DIMENSION (kjpindex*nslm), INTENT (in):: indexnbdl      !! Indeces of the points on the 3D map for of diagnostic soil layers
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_rain      !! Rain precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_snow      !! Snow precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: returnflow       !! Routed water which comes back into the soil (from the 
+                                                                           !! bottom) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: reinfiltration   !! Routed water which comes back into the soil (at the 
+                                                                           !! top) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: irrigation       !! Water from irrigation returning to soil moisture  
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_sol_new     !! New soil temperature
+
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: frac_nobio     !! Fraction of ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: totfrac_nobio    !! Total fraction of ice+lakes+...
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: soilcap          !! Soil capacity
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile         !! Fraction of each soil tile within vegtot (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vevapwet         !! Interception loss
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget            !! Fraction of vegetation type           
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max        !! Max. fraction of vegetation type (LAI -> infty)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintmax         !! Maximum water on vegetation for interception
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: transpir         !! Transpiration
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: reinf_slope      !! Slope coef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot           !! Soil Potential Evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot_penm      !! Soil Potential Evaporation Correction
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: flood_frac       !! flood fraction
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in) :: stempdiag        !! Diagnostic temp profile from thermosoil
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: temp_air         !! Air temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: u,v              !! Horizontal wind speed
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: tq_cdrag         !! Surface drag coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: pb               !! Surface pressure
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: swnet            !! Net shortwave radiation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: pgflux           !! Net energy into snowpack
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: gtemp            !! First soil layer temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: tot_bare_soil    !! Total evaporating bare soil fraction 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: lambda_snow      !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in):: cgrnd_snow       !! Integration coefficient for snow numerical scheme
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in):: dgrnd_snow       !! Integration coefficient for snow numerical scheme
+    REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(inout) :: ksave     !! Soil conductivity (mm/d) copy of k
+    REAL(r_std), DIMENSION(kjpindex,nvm,nbdl,nstm), INTENT(in)  :: e_frac   !! Fraction of water transpired supplied by individual layers (no units) 
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress        !! Veg. moisture stress (only for vegetation growth)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: drysoil_frac     !! function of litter wetness
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out):: shumdiag         !! Relative soil moisture in each soil layer 
+                                                                           !! with respect to (mcf-mcw)
+                                                                           !! (unitless; can be out of 0-1)
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out):: shumdiag_perma   !! Percent of porosity filled with water (mc/mcs) used for the thermal computations 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: k_litt           !! litter approximate conductivity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: litterhumdiag    !! litter humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: tot_melt         !! Total melt    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: floodout         !! Flux out of floodplains
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: tmc_pft          !! Total soil water per PFT (mm/m2) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: drainage_pft     !! Drainage per PFT (mm/m2)   
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: swc_pft          !! Relative Soil water content [tmcr:tmcs] per pft (-)    
+    REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(inout) :: swc       !! Soil water content (copy of mc), which is need for 
+                                                                           !! the hydraulic architecture   
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout):: qsintveg         !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex), INTENT(inout)    :: evap_bare_lim    !! Limitation factor (beta) for bare soil evaporation    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout):: humrel           !! Relative humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: vevapnu          !! Bare soil evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: vevapsno         !! Snow evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: vevapflo         !! Floodplain evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: flood_res        !! flood reservoir estimate
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: snow             !! Snow mass [kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: snow_age         !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio  !! Water balance on ice, lakes, .. [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio_age !! Snow age on ice, lakes, ...
+    !! We consider that any water on the ice is snow and we only peforme a water balance to have consistency.
+    !! The water balance is limite to + or - 10^6 so that accumulation is not endless
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: runoff       !! Complete surface runoff
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: drainage     !! Drainage
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowrho      !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowtemp     !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowgrain    !! Snow grainsize
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowdz       !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowheat     !! Snow heat content
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)   :: snowliq      !! Snow liquid content (m)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)         :: grndflux     !! Net flux into soil W/m2
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out)     :: mc_layh      !! Volumetric moisture content for each layer in hydrol(liquid + ice) [m3/m3)]
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out)     :: mcl_layh     !! Volumetric moisture content for each layer in hydrol(liquid) [m3/m3]
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out)     :: tmc_layh     !! Total soil moisture content for each layer in hydrol(liquid + ice) [mm]
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)       :: temp_sol_add !! additional surface temperature due to the melt of first layer
+                                                                           !! at the present time-step @tex ($K$) @endtex
+
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: jst              !! Index of soil tiles (unitless, 1-3)
+    INTEGER(i_std)                                     :: jsl              !! Index of soil layers (unitless)
+    INTEGER(i_std)                                     :: ji, jv
+    REAL(r_std),DIMENSION (kjpindex)                   :: soilwet          !! A temporary diagnostic of soil wetness
+    REAL(r_std),DIMENSION (kjpindex)                   :: njsc_tmp         !! Temporary REAL value for njsc to write it
+    REAL(r_std), DIMENSION (kjpindex)                  :: snowmelt         !! Snow melt [mm/dt_sechiba]
+    REAL(r_std), DIMENSION (kjpindex,nstm)             :: tmc_top          !! Moisture content in the itopmax upper layers, per tile
+    REAL(r_std), DIMENSION (kjpindex)                  :: humtot_top       !! Moisture content in the itopmax upper layers, for diagnistics
+    REAL(r_std), DIMENSION(kjpindex)                   :: histvar          !! Temporary variable when computations are needed
+    REAL(r_std), DIMENSION (kjpindex,nvm)              :: frac_bare        !! Fraction(of veget_max) of bare soil in each vegetation type
+    INTEGER(i_std), DIMENSION(kjpindex*imax)           :: mc_lin_axis_index
+    REAL(r_std), DIMENSION(kjpindex)                   :: twbr             !! Grid-cell mean of TWBR Total Water Budget Residu[kg/m2/dt]
+    REAL(r_std),DIMENSION (kjpindex,nslm)              :: land_nroot       !! To ouput the grid-cell mean of nroot
+    REAL(r_std),DIMENSION (kjpindex,nslm)              :: land_dlh         !! To ouput the soil layer thickness on all grid points [m]
+    REAL(r_std),DIMENSION (kjpindex,nslm)              :: land_mcs         !! To ouput the grid-cell mean of mcs
+    REAL(r_std),DIMENSION (kjpindex)                   :: drain_upd        !! Change in drainage due to decrease in vegtot
+                                                                           !! on mc [kg/m2/dt]
+    REAL(r_std),DIMENSION (kjpindex)                   :: runoff_upd       !! Change in runoff due to decrease in vegtot
+                                                                           !! on water2infilt[kg/m2/dt]
+   
+
+!_ ================================================================================================================================
+
+    !! Initialize local printlev
+    !printlev_loc=get_printlev('hydrol')
+
+    !! 1. Update vegtot_old and recalculate vegtot
+    vegtot_old(:) = vegtot(:)
+    
+    DO ji = 1, kjpindex
+       vegtot(ji) = SUM(veget_max(ji,:))
+    ENDDO
+    
+    !! 3. Shared time step
+    IF (printlev>=3) WRITE (numout,*) 'hydrol pas de temps = ',dt_sechiba
+
+    ! 
+    !! 3.1 Calculate snow processes with explicit method or bucket snow model
+    CALL explicitsnow_main(kjpindex,    precip_rain,  precip_snow,   temp_air,    pb,       &
+         u,           v,            temp_sol_new,  soilcap,     pgflux,   &
+         frac_nobio,  totfrac_nobio,gtemp,          &
+         lambda_snow, cgrnd_snow,   dgrnd_snow,                           & 
+         vevapsno,    snow_age,     snow_nobio_age,snow_nobio,  snowrho,  &
+         snowgrain,   snowdz,       snowtemp,      snowheat,    snow,     &
+         temp_sol_add,          					       &
+         snowliq,     subsnownobio, grndflux,      snowmelt,    tot_melt, &
+         subsinksoil)            
+        
+    !
+    !! 3.2 computes vegetations reservoirs  ==>hydrol_vegupd
+! Modif temp vuichard
+    CALL hydrol_vegupd(kjpindex, veget, veget_max, soiltile, qsintveg, frac_bare, drain_upd, runoff_upd)
+
+    !! Calculate kfact_root
+    !! An exponential factor is used to increase ks near the surface depending
+    !on the amount of roots in the soil 
+    !! through a geometric average over the vegets
+    !! This comes from the PhD thesis of d'Orgeval, 2006, p82; d'Orgeval et al.
+    !2008, Eqs. 3-4
+    !! (Calibrated against Hapex-Sahel measurements)
+    !! Since rev 2916: veget_max/2 is used instead of veget
+    kfact_root(:,:,:) = un
+    DO jsl = 1, nslm
+       DO jv = 2, nvm
+          jst = pref_soil_veg(jv)
+          DO ji = 1, kjpindex
+             IF(soiltile(ji,jst) .GT. min_sechiba) THEN
+                kfact_root(ji,jsl,jst) = kfact_root(ji,jsl,jst) * &
+                     & MAX((MAXVAL(ks_usda)/ks(njsc(ji)))**(- vegetmax_soil(ji,jv,jst)/2* (humcste(jv)*zz(jsl)/mille - un)/deux), &
+                     un)
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDDO
+
+    !
+    !! 3.3 computes canopy  ==>hydrol_canop
+    CALL hydrol_canop(kjpindex, precip_rain, vevapwet, veget_max, veget, qsintmax, qsintveg,precisol,tot_melt)
+
+    !
+    !! 3.4 computes surface reservoir  ==>hydrol_flood
+    CALL hydrol_flood(kjpindex,  vevapflo, flood_frac, flood_res, floodout)
+
+    !
+    !! 3.5 computes soil hydrology ==>hydrol_soil
+
+    CALL hydrol_soil(kjpindex, veget_max, soiltile, njsc, reinf_slope,  &
+         transpir, vevapnu, evapot, evapot_penm, runoff, drainage, & 
+         returnflow, reinfiltration, irrigation, &
+         tot_melt,evap_bare_lim, shumdiag, shumdiag_perma, &
+         k_litt, litterhumdiag, humrel, vegstress, drysoil_frac,&
+         stempdiag,snow,snowdz, tot_bare_soil, u, v, tq_cdrag, &
+         mc_layh, mcl_layh, tmc_layh, swc, ksave, e_frac)
+
+    ! The update fluxes come from hydrol_vegupd
+    drainage(:) =  drainage(:) +  drain_upd(:)
+    runoff(:) =  runoff(:) +  runoff_upd(:)
+
+    DO jv=1,nvm
+          tmc_pft(:,jv)      = tmc(:,pref_soil_veg(jv))
+          drainage_pft(:,jv) = dr_ns(:,pref_soil_veg(jv))
+          swc_pft(:,jv)      = ( tmc(:,pref_soil_veg(jv)) - tmcr(:,pref_soil_veg(jv)) ) &
+                               / ( tmcs(:,pref_soil_veg(jv)) - tmcr(:,pref_soil_veg(jv)))
+    ENDDO
+
+    !! 12.10 Copy mc to swc for use in sechiba_hydrol_arch, when we do not use
+    !! soil to root resistance
+        swc(:,:,:) = mc(:,:,:)
+    !! 4 write out file  ==> hydrol_alma/histwrite(*)
+    !
+    ! If we use the ALMA standards
+    CALL hydrol_alma(kjpindex, index, .FALSE., qsintveg, snow, snow_nobio, soilwet)
+    
+
+    ! Calcuate the moisture in the upper itopmax layers corresponding to 0.1m (humtot_top): 
+    ! For ORCHIDEE with nslm=11 and zmaxh=2, itopmax=6.
+    ! We compute tmc_top as tmc but only for the first itopmax layers. Then we compute a humtot with this variable.
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          tmc_top(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+          DO jsl = 2, itopmax
+             tmc_top(ji,jst) = tmc_top(ji,jst) + dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+          ENDDO
+       ENDDO
+    ENDDO
+
+    ! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
+    humtot_top(:) = zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          humtot_top(ji) = humtot_top(ji) + soiltile(ji,jst) * tmc_top(ji,jst) * vegtot(ji)
+       ENDDO
+    ENDDO
+
+    ! Calculate the Total Water Budget Residu (in kg/m2 over dt_sechiba)
+    ! All the delstocks and fluxes below are averaged over the mesh
+    ! snow_nobio included in delswe
+    ! Does not include the routing reservoirs, although the flux to/from routing are integrated
+    DO ji=1,kjpindex
+       twbr(ji) = (delsoilmoist(ji) + delintercept(ji) + delswe(ji)) &
+            - ( precip_rain(ji) + precip_snow(ji) + irrigation(ji) + floodout(ji) &
+            + returnflow(ji) + reinfiltration(ji) ) &
+            + ( runoff(ji) + drainage(ji) + SUM(vevapwet(ji,:)) &
+            + SUM(transpir(ji,:)) + vevapnu(ji) + vevapsno(ji) + vevapflo(ji) ) 
+    ENDDO
+    ! Transform unit from kg/m2/dt to kg/m2/s (or mm/s)
+    CALL xios_orchidee_send_field("twbr",twbr/dt_sechiba)
+    ! Number of tiles undermcr at end of timestep
+    CALL xios_orchidee_send_field("undermcr",undermcr) 
+    
+    ! Calculate land_nroot : grid-cell mean of nroot  
+    ! Do not treat PFT1 because it has no roots
+    land_nroot(:,:) = zero
+    DO jsl=1,nslm
+       DO jv=2,nvm
+          DO ji=1,kjpindex
+               IF ( vegtot(ji) > min_sechiba ) THEN 
+               land_nroot(ji,jsl) = land_nroot(ji,jsl) + veget_max(ji,jv) * nroot(ji,jv,jsl) / vegtot(ji) 
+            END IF
+          END DO
+       ENDDO
+    ENDDO
+    CALL xios_orchidee_send_field("nroot",land_nroot)   
+
+    DO jsl=1,nslm
+       land_dlh(:,jsl)=dlh(jsl)
+    ENDDO
+    CALL xios_orchidee_send_field("dlh",land_dlh)
+
+    ! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
+    land_mcs(:,:) = zero
+    DO jsl=1,nslm
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             land_mcs(ji,jsl) = land_mcs(ji,jsl) + soiltile(ji,jst) * tmcs(ji,jst) * vegtot(ji) 
+          ENDDO
+       ENDDO
+    ENDDO
+    CALL xios_orchidee_send_field("mcs",land_mcs/(zmaxh* mille)) ! in m3/m3
+    CALL xios_orchidee_send_field("water2infilt",water2infilt)   
+    CALL xios_orchidee_send_field("mc",mc)
+    CALL xios_orchidee_send_field("kfact_root",kfact_root)
+    CALL xios_orchidee_send_field("rootsink",rootsink)
+    CALL xios_orchidee_send_field("vegetmax_soil",vegetmax_soil)
+    CALL xios_orchidee_send_field("evapnu_soil",ae_ns/dt_sechiba)
+    CALL xios_orchidee_send_field("drainage_soil",dr_ns/dt_sechiba)
+    CALL xios_orchidee_send_field("transpir_soil",tr_ns/dt_sechiba)
+    CALL xios_orchidee_send_field("runoff_soil",ru_ns/dt_sechiba)
+    CALL xios_orchidee_send_field("humrel",humrel)     
+    CALL xios_orchidee_send_field("drainage",drainage/dt_sechiba) ! [kg m-2 s-1]
+    CALL xios_orchidee_send_field("runoff",runoff/dt_sechiba) ! [kg m-2 s-1]
+    CALL xios_orchidee_send_field("precisol",precisol/dt_sechiba)
+    CALL xios_orchidee_send_field("precip_rain",precip_rain/dt_sechiba)
+    CALL xios_orchidee_send_field("precip_snow",precip_snow/dt_sechiba)
+    CALL xios_orchidee_send_field("qsintmax",qsintmax)
+    CALL xios_orchidee_send_field("qsintveg",qsintveg)
+    CALL xios_orchidee_send_field("qsintveg_tot",SUM(qsintveg(:,:),dim=2))
+    histvar(:)=(precip_rain(:)-SUM(precisol(:,:),dim=2))
+    CALL xios_orchidee_send_field("prveg",histvar/dt_sechiba)
+
+    IF ( do_floodplains ) THEN
+       CALL xios_orchidee_send_field("floodout",floodout/dt_sechiba)
+    END IF
+
+    CALL xios_orchidee_send_field("snowmelt",snowmelt/dt_sechiba)
+    CALL xios_orchidee_send_field("tot_melt",tot_melt/dt_sechiba)
+
+    CALL xios_orchidee_send_field("soilmoist",soilmoist)
+    CALL xios_orchidee_send_field("tmc",tmc)
+    CALL xios_orchidee_send_field("humtot",humtot)
+    CALL xios_orchidee_send_field("humtot_top",humtot_top)
+
+    CALL xios_orchidee_send_field("snowdz",snowdz)
+    CALL xios_orchidee_send_field("frac_bare",frac_bare)
+
+    CALL xios_orchidee_send_field("soilwet",soilwet)
+    CALL xios_orchidee_send_field("delsoilmoist",delsoilmoist)
+    CALL xios_orchidee_send_field("delswe",delswe)
+    CALL xios_orchidee_send_field("delintercept",delintercept)  
+
+    IF (ok_freeze_cwrr) THEN
+       CALL xios_orchidee_send_field("profil_froz_hydro",profil_froz_hydro)
+       CALL xios_orchidee_send_field("temp_hydro",temp_hydro)
+       CALL xios_orchidee_send_field("kk_moy",kk_moy)
+    END IF
+    CALL xios_orchidee_send_field("profil_froz_hydro_ns", profil_froz_hydro_ns)
+
+    IF ( .NOT. almaoutput ) THEN
+!!       CALL histwrite_p(hist_id, 'frac_bare', kjit, frac_bare, kjpindex*nvm, indexveg)
+
+       DO jst=1,nstm
+          ! var_name= "mc_1" ... "mc_3"
+          WRITE (var_name,"('moistc_',i1)") jst
+          CALL histwrite_p(hist_id, TRIM(var_name), kjit,mc(:,:,jst), kjpindex*nslm, indexlayer)
+
+          ! var_name= "kfactroot_1" ... "kfactroot_3"
+          WRITE (var_name,"('kfactroot_',i1)") jst
+          CALL histwrite_p(hist_id, TRIM(var_name), kjit, kfact_root(:,:,jst), kjpindex*nslm, indexlayer)
+
+          ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+          WRITE (var_name,"('vegetsoil_',i1)") jst
+          CALL histwrite_p(hist_id, TRIM(var_name), kjit,vegetmax_soil(:,:,jst), kjpindex*nvm, indexveg)
+       ENDDO
+       CALL histwrite_p(hist_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'humtot_soil', kjit, tmc, kjpindex*nstm, indexsoil)
+       ! mrso is a perfect duplicate of humtot
+       CALL histwrite_p(hist_id, 'humtot', kjit, humtot, kjpindex, index)
+       CALL histwrite_p(hist_id, 'mrso', kjit, humtot, kjpindex, index)
+       CALL histwrite_p(hist_id, 'mrsos', kjit, humtot_top, kjpindex, index)
+       njsc_tmp(:)=njsc(:)
+       CALL histwrite_p(hist_id, 'soilindex', kjit, njsc_tmp, kjpindex, index)
+       CALL histwrite_p(hist_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg)
+!      CALL histwrite_p(hist_id, 'drainage', kjit, drainage, kjpindex, index)
+       ! NB! According to histdef in intersurf, the variables 'runoff' and 'mrros' have different units
+       CALL histwrite_p(hist_id, 'runoff', kjit, runoff, kjpindex, index)
+       CALL histwrite_p(hist_id, 'mrros', kjit, runoff, kjpindex, index)
+       histvar(:)=(runoff(:)+drainage(:))
+       CALL histwrite_p(hist_id, 'mrro', kjit, histvar, kjpindex, index)
+       CALL histwrite_p(hist_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'rain', kjit, precip_rain, kjpindex, index)
+
+       histvar(:)=(precip_rain(:)-SUM(precisol(:,:),dim=2))
+       CALL histwrite_p(hist_id, 'prveg', kjit, histvar, kjpindex, index)
+
+       CALL histwrite_p(hist_id, 'snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite_p(hist_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'snowmelt',kjit,snowmelt,kjpindex,index)
+       CALL histwrite_p(hist_id, 'shumdiag_perma',kjit,shumdiag_perma,kjpindex*nbdl,indexnbdl)
+
+       IF ( do_floodplains ) THEN
+          CALL histwrite_p(hist_id, 'floodout', kjit, floodout, kjpindex, index)
+       ENDIF
+       !
+       IF ( hist2_id > 0 ) THEN
+          DO jst=1,nstm
+             ! var_name= "mc_1" ... "mc_3"
+             WRITE (var_name,"('moistc_',i1)") jst
+             CALL histwrite_p(hist2_id, TRIM(var_name), kjit,mc(:,:,jst), kjpindex*nslm, indexlayer)
+
+             ! var_name= "kfactroot_1" ... "kfactroot_3"
+             WRITE (var_name,"('kfactroot_',i1)") jst
+             CALL histwrite_p(hist2_id, TRIM(var_name), kjit, kfact_root(:,:,jst), kjpindex*nslm, indexlayer)
+
+             ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+             WRITE (var_name,"('vegetsoil_',i1)") jst
+             CALL histwrite_p(hist2_id, TRIM(var_name), kjit,vegetmax_soil(:,:,jst), kjpindex*nvm, indexveg)
+          ENDDO
+          CALL histwrite_p(hist2_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite_p(hist2_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite_p(hist2_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite_p(hist2_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite_p(hist2_id, 'humtot_soil', kjit, tmc, kjpindex*nstm, indexsoil)
+          ! mrso is a perfect duplicate of humtot
+          CALL histwrite_p(hist2_id, 'humtot', kjit, humtot, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'mrso', kjit, humtot, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'mrsos', kjit, humtot_top, kjpindex, index)
+          njsc_tmp(:)=njsc(:)
+          CALL histwrite_p(hist2_id, 'soilindex', kjit, njsc_tmp, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'drainage', kjit, drainage, kjpindex, index)
+          ! NB! According to histdef in intersurf, the variables 'runoff' and 'mrros' have different units
+          CALL histwrite_p(hist2_id, 'runoff', kjit, runoff, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'mrros', kjit, runoff, kjpindex, index)
+          histvar(:)=(runoff(:)+drainage(:))
+          CALL histwrite_p(hist2_id, 'mrro', kjit, histvar, kjpindex, index)
+
+          IF ( do_floodplains ) THEN
+             CALL histwrite_p(hist2_id, 'floodout', kjit, floodout, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'rain', kjit, precip_rain, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'snowmelt',kjit,snowmelt,kjpindex,index)
+          CALL histwrite_p(hist2_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+       ENDIF
+    ELSE
+       CALL histwrite_p(hist_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Qs', kjit, runoff, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Qsb', kjit, drainage, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Qsm', kjit, snowmelt, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelSWE', kjit, delswe, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
+       !
+       CALL histwrite_p(hist_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
+       CALL histwrite_p(hist_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+       !
+       CALL histwrite_p(hist_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+       !
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qs', kjit, runoff, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qsb', kjit, drainage, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qsm', kjit, snowmelt, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSWE', kjit, delswe, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
+          !
+          CALL histwrite_p(hist2_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
+          CALL histwrite_p(hist2_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+          !
+          CALL histwrite_p(hist2_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+          !
+       ENDIF
+    ENDIF
+
+    IF (ok_freeze_cwrr) THEN
+       CALL histwrite_p(hist_id, 'profil_froz_hydro', kjit,profil_froz_hydro , kjpindex*nslm, indexlayer)
+       DO jst=1,nstm
+          WRITE (var_name,"('profil_froz_hydro_',i1)") jst
+          CALL histwrite_p(hist_id, TRIM(var_name), kjit, profil_froz_hydro_ns(:,:,jst), kjpindex*nslm, indexlayer)
+       ENDDO
+       CALL histwrite_p(hist_id, 'temp_hydro', kjit,temp_hydro , kjpindex*nslm, indexlayer)
+       CALL histwrite_p(hist_id, 'kk_moy', kjit, kk_moy,kjpindex*nslm, indexlayer) ! averaged over soiltiles
+    ENDIF
+
+    IF (first_hydrol_main) THEN 
+       first_hydrol_main=.FALSE.
+    ENDIF
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_main Done '
+
+  END SUBROUTINE hydrol_main
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_finalize
+!!
+!>\BRIEF         
+!!
+!! DESCRIPTION : This subroutine writes the module variables and variables calculated in hydrol to restart file
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_finalize( kjit,           kjpindex,   rest_id,  vegstress,  &
+                              qsintveg,       humrel,     snow,     snow_age, snow_nobio, &
+                              snow_nobio_age, snowrho,    snowtemp, snowdz,     &
+                              snowheat,       snowgrain,  &
+                              drysoil_frac, evap_bare_lim)
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                           :: kjit           !! Time step number 
+    INTEGER(i_std), INTENT(in)                           :: kjpindex       !! Domain size
+    INTEGER(i_std),INTENT (in)                           :: rest_id        !! Restart file identifier
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: vegstress      !! Veg. moisture stress (only for vegetation growth)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintveg       !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: humrel
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: snow           !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: snow_age       !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio     !! Water balance on ice, lakes, .. [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio_age !! Snow age on ice, lakes, ...
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowrho        !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowtemp       !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowdz         !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowheat       !! Snow heat content
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowgrain      !! Snow grainsize
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)          :: drysoil_frac   !! function of litter wetness
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)          :: evap_bare_lim
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                       :: jst, jsl
+   
+!_ ================================================================================================================================
+
+
+    IF (printlev>=3) WRITE (numout,*) 'Write restart file with HYDROLOGIC variables '
+    CALL restput_p(rest_id, 'moistc', nbp_glo,  nslm, nstm, kjit, mc, 'scatter',  nbp_glo, index_g) 
+    CALL restput_p(rest_id, 'moistcl', nbp_glo,  nslm, nstm, kjit, mcl, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'us', nbp_glo, nvm, nstm, nslm, kjit, us, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'free_drain_coef', nbp_glo,   nstm, 1, kjit,  free_drain_coef, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'zwt_force', nbp_glo,   nstm, 1, kjit,  zwt_force, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'water2infilt', nbp_glo,   nstm, 1, kjit,  water2infilt, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'ae_ns', nbp_glo,   nstm, 1, kjit,  ae_ns, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'vegstress', nbp_glo,   nvm, 1, kjit,  vegstress, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow', nbp_glo,   1, 1, kjit,  snow, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow_age', nbp_glo,   1, 1, kjit,  snow_age, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow_nobio', nbp_glo,   nnobio, 1, kjit,  snow_nobio, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow_nobio_age', nbp_glo,   nnobio, 1, kjit,  snow_nobio_age, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'qsintveg', nbp_glo, nvm, 1, kjit,  qsintveg, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'evap_bare_lim_ns', nbp_glo, nstm, 1, kjit,  evap_bare_lim_ns, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'evap_bare_lim', nbp_glo, 1, 1, kjit,  evap_bare_lim, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'resdist', nbp_glo, nstm, 1, kjit,  resdist, 'scatter',  nbp_glo, index_g)  
+    CALL restput_p(rest_id, 'vegtot_old', nbp_glo, 1, 1, kjit,  vegtot_old, 'scatter',  nbp_glo, index_g)            
+    CALL restput_p(rest_id, 'drysoil_frac', nbp_glo,   1, 1, kjit, drysoil_frac, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'humrel', nbp_glo,   nvm, 1, kjit,  humrel, 'scatter',  nbp_glo, index_g)
+
+    CALL restput_p(rest_id, 'tot_watveg_beg', nbp_glo,  1, 1, kjit,  tot_watveg_beg, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'tot_watsoil_beg', nbp_glo, 1, 1, kjit,  tot_watsoil_beg, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow_beg', nbp_glo,        1, 1, kjit,  snow_beg, 'scatter',  nbp_glo, index_g)
+    
+    ! Write variables for explictsnow module to restart file
+    CALL explicitsnow_finalize ( kjit,     kjpindex, rest_id,    snowrho,   &
+         snowtemp, snowdz,   snowheat,   snowgrain)
+
+  END SUBROUTINE hydrol_finalize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_init
+!!
+!>\BRIEF        Initializations and memory allocation   
+!!
+!! DESCRIPTION  :
+!! - 1 Some initializations
+!! - 2 make dynamic allocation with good dimension
+!! - 2.1 array allocation for soil textur
+!! - 2.2 Soil texture choice
+!! - 3 Other array allocation
+!! - 4 Open restart input file and read data for HYDROLOGIC process
+!! - 5 get restart values if none were found in the restart file
+!! - 6 Vegetation array      
+!! - 7 set humrelv from us
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!!_ hydrol_init
+
+  SUBROUTINE hydrol_init(kjit, kjpindex, index, rest_id, njsc, veget_max, soiltile, &
+       humrel,  vegstress, snow,       snow_age,   snow_nobio, snow_nobio_age, qsintveg, &
+       snowdz,  snowgrain, snowrho,    snowtemp,   snowheat, &
+       drysoil_frac, evap_bare_lim)
+    
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                         :: kjit               !! Time step number 
+    INTEGER(i_std), INTENT (in)                         :: kjpindex           !! Domain size
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: index              !! Indeces of the points on the map
+    INTEGER(i_std), INTENT (in)                         :: rest_id            !! _Restart_ file identifier 
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: njsc               !! Index of the dominant soil textural class in the 
+                                                                              !! grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget_max          !! Carte de vegetation max
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in)  :: soiltile           !! Fraction of each soil tile within vegtot (0-1, unitless)
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: humrel             !! Stress hydrique, relative humidity
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: vegstress          !! Veg. moisture stress (only for vegetation growth)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: snow               !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: snow_age           !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio       !! Snow on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio_age   !! Snow age on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: qsintveg         !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)    :: snowdz           !! Snow depth
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)    :: snowgrain        !! Snow grain size
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)    :: snowheat         !! Snow heat content
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)    :: snowtemp         !! Snow temperature
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)    :: snowrho          !! Snow density
+    REAL(r_std),DIMENSION (kjpindex),INTENT(out)          :: drysoil_frac     !! function of litter wetness
+    REAL(r_std),DIMENSION (kjpindex),INTENT(out)          :: evap_bare_lim
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ier                   !! Error code
+    INTEGER(i_std)                                     :: ji                    !! Index of land grid cells (1)
+    INTEGER(i_std)                                     :: jv                    !! Index of PFTs (1)
+    INTEGER(i_std)                                     :: jst                   !! Index of soil tiles (1)
+    INTEGER(i_std)                                     :: jsl                   !! Index of soil layers (1)
+    INTEGER(i_std)                                     :: jsc                   !! Index of soil texture (1)
+    INTEGER(i_std), PARAMETER                          :: error_level = 3       !! Error level for consistency check
+                                                                                !! Switch to 2 tu turn fatal errors into warnings  
+    REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: free_drain_max        !! Temporary var for initialization of free_drain_coef 
+    REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: zwt_default           !! Temporary variable for initialization of zwt_force
+    LOGICAL                                            :: zforce                !! To test if we force the WT in any of the soiltiles
+
+!_ ================================================================================================================================
+
+    !! 1 Some initializations
+    !
+    !Config Key   = DO_PONDS
+    !Config Desc  = Should we include ponds 
+    !Config Def   = n
+    !Config If    = 
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the ponds and return 
+    !Config         the water into the soil moisture. If this is 
+    !Config         activated, then there is no reinfiltration 
+    !Config         computed inside the hydrol module.
+    !Config Units = [FLAG]
+    !
+    doponds = .FALSE.
+    CALL getin_p('DO_PONDS', doponds)
+
+    !Config Key   = FROZ_FRAC_CORR
+    !Config Desc  = Coefficient for the frozen fraction correction
+    !Config Def   = 1.0
+    !Config If    = OK_FREEZE
+    !Config Help  =
+    !Config Units = [-]
+    !
+    froz_frac_corr = 1.0
+    CALL getin_p("FROZ_FRAC_CORR", froz_frac_corr)    
+
+    !Config Key   = MAX_FROZ_HYDRO 
+    !Config Desc  = Coefficient for the frozen fraction correction 
+    !Config Def   = 1.0 
+    !Config If    = OK_FREEZE 
+    !Config Help  = 
+    !Config Units = [-] 
+    max_froz_hydro = 1.0 
+    CALL getin_p("MAX_FROZ_HYDRO", max_froz_hydro) 
+    
+    !Config Key   = SMTOT_CORR 
+    !Config Desc  = Coefficient for the frozen fraction correction 
+    !Config Def   = 2.0 
+    !Config If    = OK_FREEZE 
+    !Config Help  = 
+    !Config Units = [-] 
+    smtot_corr = 2.0 
+    CALL getin_p("SMTOT_CORR", smtot_corr)
+
+    !Config Key   = DO_RSOIL
+    !Config Desc  = Should we reduce soil evaporation with a soil resistance
+    !Config Def   = n
+    !Config If    = 
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to calculate a soil resistance to reduce the soil evaporation
+    !Config Units = [FLAG]
+    !
+    do_rsoil = .FALSE.
+    CALL getin_p('DO_RSOIL', do_rsoil)
+
+    !Config Key   = OK_DYNROOT 
+    !Config Desc  = Calculate dynamic root profile to optimize soil moisture usage   
+    !Config Def   = n 
+    !Config If    = 
+    !Config Help  =  
+    !Config Units = [FLAG] 
+    ok_dynroot = .FALSE. 
+    CALL getin_p('OK_DYNROOT',ok_dynroot)
+
+    !! 2 make dynamic allocation with good dimension
+
+    !! 2.1 array allocation for soil texture
+    !  Some of these variables may already be allocated in sechiba_hydrol_arch
+    !  if hydraulic architecture is used to calculate plant water stress. If
+    !  so ier is not defined. Therefore the if-statement testing ier should be
+    !  within the .NOT. ALLOCATED if-statement.
+    IF (.NOT. ALLOCATED(nvan)) THEN
+       ALLOCATE (nvan(nscm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable nvan','','')
+    ENDIF
+
+    IF (.NOT. ALLOCATED(avan)) THEN
+       ALLOCATE (avan(nscm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable avan','','')
+    ENDIF
+
+    IF (.NOT. ALLOCATED(mcr)) THEN
+       ALLOCATE (mcr(nscm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable mcr','','')
+    ENDIF
+       
+    IF (.NOT. ALLOCATED(mcs)) THEN
+       ALLOCATE (mcs(nscm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable mcs','','')
+    ENDIF
+       
+    ALLOCATE (ks(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable ks','','')
+
+    ALLOCATE (pcent(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable pcent','','')
+
+    ALLOCATE (mcf(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable mcf','','')
+
+    ALLOCATE (mcw(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable mcw','','')
+    
+    ALLOCATE (mc_awet(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable mc_awet','','')
+
+    ALLOCATE (mc_adry(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable mc_adry','','')
+       
+    !!__2.2 Soil texture choose
+
+    SELECTCASE (nscm)
+    CASE (3)
+              
+       nvan(:) = nvan_fao(:)       
+       avan(:) = avan_fao(:)
+       mcr(:) = mcr_fao(:)
+       mcs(:) = mcs_fao(:)
+       ks(:) = ks_fao(:)
+       pcent(:) = pcent_fao(:)
+       mcf(:) = mcf_fao(:)
+       mcw(:) = mcw_fao(:)
+       mc_awet(:) = mc_awet_fao(:)
+       mc_adry(:) = mc_adry_fao(:)
+    CASE (12)
+       
+       nvan(:) = nvan_usda(:)
+       avan(:) = avan_usda(:)
+       mcr(:) = mcr_usda(:)
+       mcs(:) = mcs_usda(:)
+       ks(:) = ks_usda(:)
+       pcent(:) = pcent_usda(:)
+       mcf(:) = mcf_usda(:)
+       mcw(:) = mcw_usda(:)
+       mc_awet(:) = mc_awet_usda(:)
+       mc_adry(:) = mc_adry_usda(:)
+       
+    CASE DEFAULT
+       WRITE (numout,*) 'Unsupported soil type classification. Choose between zobler and usda according to the map'
+       CALL ipslerr_p(3,'hydrol_init','Unsupported soil type classification. ',&
+            'Choose between zobler and usda according to the map','')
+    ENDSELECT
+
+    !! 2.3 Read in the run.def the parameters values defined by the user
+
+    !Config Key   = CWRR_N_VANGENUCHTEN
+    !Config Desc  = Van genuchten coefficient n
+    !Config If    = 
+    !Config Def   = 1.89, 1.56, 1.31
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [-]
+    CALL getin_p("CWRR_N_VANGENUCHTEN",nvan)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(nvan(:) <= zero) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for CWRR_N_VANGENUCHTEN.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_A_VANGENUCHTEN
+    !Config Desc  = Van genuchten coefficient a
+    !Config If    = 
+    !Config Def   = 0.0075, 0.0036, 0.0019
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [1/mm]  
+    CALL getin_p("CWRR_A_VANGENUCHTEN",avan)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(avan(:) <= zero) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for CWRR_A_VANGENUCHTEN.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_RESIDUAL
+    !Config Desc  = Residual soil water content
+    !Config If    = 
+    !Config Def   = 0.065, 0.078, 0.095
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [m3/m3]  
+    CALL getin_p("VWC_RESIDUAL",mcr)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mcr(:) < zero) .OR. ANY(mcr(:) > 1.)  ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_RESIDUAL.", &
+            &     "This parameter is ranged between 0 and 1. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+    
+    !Config Key   = VWC_SAT
+    !Config Desc  = Saturated soil water content
+    !Config If    = 
+    !Config Def   = 0.41, 0.43, 0.41
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [m3/m3]  
+    CALL getin_p("VWC_SAT",mcs)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mcs(:) < zero) .OR. ANY(mcs(:) > 1.) .OR. ANY(mcs(:) <= mcr(:)) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_SAT.", &
+            &     "This parameter should be greater than VWC_RESIDUAL and less than 1. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_KS 
+    !Config Desc  = Hydraulic conductivity Saturation
+    !Config If    = 
+    !Config Def   = 1060.8, 249.6, 62.4
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [mm/d]   
+    CALL getin_p("CWRR_KS",ks)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(ks(:) <= zero) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for CWRR_KS.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = WETNESS_TRANSPIR_MAX
+    !Config Desc  = Soil moisture above which transpir is max
+    !Config If    = 
+    !Config Def   = 0.5, 0.5, 0.5
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [-]    
+    CALL getin_p("WETNESS_TRANSPIR_MAX",pcent)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(pcent(:) <= zero) .OR. ANY(pcent(:) > 1.) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for WETNESS_TRANSPIR_MAX.", &
+            &     "This parameter should be positive and less or equals than 1. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_FC 
+    !Config Desc  = Volumetric water content field capacity
+    !Config If    = 
+    !Config Def   = 0.32, 0.32, 0.32
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [m3/m3]   
+    CALL getin_p("VWC_FC",mcf)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mcf(:) > mcs(:)) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_FC.", &
+            &     "This parameter should be less than VWC_SAT. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_WP
+    !Config Desc  = Volumetric water content Wilting pt
+    !Config If    = 
+    !Config Def   = 0.10, 0.10, 0.10 
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [m3/m3]   
+    CALL getin_p("VWC_WP",mcw)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mcw(:) > mcf(:)) .OR. ANY(mcw(:) < mcr(:)) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_WP.", &
+            &     "This parameter should be greater or equal than VWC_RESIDUAL and less or equal than VWC_SAT.", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_MIN_FOR_WET_ALB
+    !Config Desc  = Vol. wat. cont. above which albedo is cst
+    !Config If    = 
+    !Config Def   = 0.25, 0.25, 0.25
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [m3/m3]  
+    CALL getin_p("VWC_MIN_FOR_WET_ALB",mc_awet)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mc_awet(:) < 0) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_MIN_FOR_WET_ALB.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_MAX_FOR_DRY_ALB
+    !Config Desc  = Vol. wat. cont. below which albedo is cst
+    !Config If    = 
+    !Config Def   = 0.1, 0.1, 0.1
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [m3/m3]   
+    CALL getin_p("VWC_MAX_FOR_DRY_ALB",mc_adry)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mc_adry(:) < 0) .OR. ANY(mc_adry(:) > mc_awet(:)) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_MAX_FOR_DRY_ALB.", &
+            &     "This parameter should be positive and not greater than VWC_MIN_FOR_WET_ALB.", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !! 3 Other array allocation
+
+
+    ALLOCATE (mask_veget(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_veget','','')
+
+    ALLOCATE (mask_soiltile(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_soiltile','','')
+
+    ALLOCATE (humrelv(kjpindex,nvm,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable humrelv','','')
+
+    ALLOCATE (vegstressv(kjpindex,nvm,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegstressv','','')
+
+    ALLOCATE (us(kjpindex,nvm,nstm,nslm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable us','','')
+
+    ALLOCATE (precisol(kjpindex,nvm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable precisol','','')
+
+    ALLOCATE (precisol_ns(kjpindex,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable precisol_nc','','')
+
+    ALLOCATE (free_drain_coef(kjpindex,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable free_drain_coef','','')
+
+    ALLOCATE (zwt_force(kjpindex,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable zwt_force','','')
+
+    ALLOCATE (frac_bare_ns(kjpindex,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable frac_bare_ns','','')
+
+    ALLOCATE (water2infilt(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable water2infilt','','')
+
+    ALLOCATE (ae_ns(kjpindex,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ae_ns','','')
+
+    ALLOCATE (evap_bare_lim_ns(kjpindex,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable evap_bare_lim_ns','','')
+
+    ALLOCATE (rootsink(kjpindex,nslm,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable rootsink','','')
+
+    ALLOCATE (subsnowveg(kjpindex),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsnowveg','','')
+
+    ALLOCATE (subsnownobio(kjpindex,nnobio),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsnownobio','','')
+
+    ALLOCATE (icemelt(kjpindex),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable icemelt','','')
+
+    ALLOCATE (subsinksoil(kjpindex),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsinksoil','','')
+
+    ALLOCATE (mx_eau_var(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mx_eau_var','','')
+
+    ALLOCATE (vegtot(kjpindex),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegtot','','')
+
+    ALLOCATE (vegtot_old(kjpindex),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegtot_old','','')
+
+    ALLOCATE (resdist(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable resdist','','')
+
+    ALLOCATE (humtot(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable humtot','','')
+
+    ALLOCATE (resolv(kjpindex),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable resolv','','')
+
+    ALLOCATE (k(kjpindex,nslm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable k','','')
+
+    IF (ok_freeze_cwrr) THEN
+       ALLOCATE (kk_moy(kjpindex,nslm),stat=ier) 
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kk_moy','','')
+       kk_moy(:,:) = 276.48
+
+       ALLOCATE (kk(kjpindex,nslm,nstm),stat=ier) 
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kk','','')
+       kk(:,:,:) = 276.48
+    ENDIF
+
+    ALLOCATE (a(kjpindex,nslm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable a','','')
+
+    ALLOCATE (b(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable b','','')
+
+    ALLOCATE (d(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable d','','')
+
+    ALLOCATE (e(kjpindex,nslm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable e','','')
+
+    ALLOCATE (f(kjpindex,nslm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable f','','')
+
+    ALLOCATE (g1(kjpindex,nslm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable g1','','')
+
+    ALLOCATE (ep(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ep','','')
+
+    ALLOCATE (fp(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable fp','','')
+
+    ALLOCATE (gp(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable gp','','')
+
+    ALLOCATE (rhs(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable rhs','','')
+
+    ALLOCATE (srhs(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable srhs','','')
+
+    ALLOCATE (tmc(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc','','')
+
+    ALLOCATE (tmcs(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcs','','')
+
+    ALLOCATE (tmcr(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcr','','')
+
+    ALLOCATE (tmc_litter(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter','','')
+
+    ALLOCATE (tmc_litt_mea(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_mea','','')
+
+    ALLOCATE (tmc_litter_res(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_res','','')
+
+    ALLOCATE (tmc_litter_wilt(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_wilt','','')
+
+    ALLOCATE (tmc_litter_field(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_field','','')
+
+    ALLOCATE (tmc_litter_sat(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_sat','','')
+
+    ALLOCATE (tmc_litter_awet(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_awet','','')
+
+    ALLOCATE (tmc_litter_adry(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_adry','','')
+
+    ALLOCATE (tmc_litt_wet_mea(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_wet_mea','','')
+
+    ALLOCATE (tmc_litt_dry_mea(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_dry_mea','','')
+
+    ALLOCATE (v1(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable v1','','')
+
+    ALLOCATE (ru_ns(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ru_ns','','')
+    ru_ns(:,:) = zero
+
+    ALLOCATE (dr_ns(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dr_ns','','')
+    dr_ns(:,:) = zero
+
+    ALLOCATE (tr_ns(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tr_ns','','')
+
+    ALLOCATE (vegetmax_soil(kjpindex,nvm,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegetmax_soil','','')
+
+    ALLOCATE (mc(kjpindex,nslm,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc','','')
+
+    ALLOCATE (mcl(kjpindex, nslm, nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcl','','')
+
+    IF (ok_freeze_cwrr) THEN
+       ALLOCATE (profil_froz_hydro(kjpindex, nslm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable profil_froz_hydrol','','')
+       profil_froz_hydro(:,:) = zero
+       
+       ALLOCATE (temp_hydro(kjpindex, nslm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable temp_hydro','','')
+       temp_hydro(:,:) = 280.
+    ENDIF
+    
+    ALLOCATE (profil_froz_hydro_ns(kjpindex, nslm, nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable profil_froz_hydro_ns','','')
+    profil_froz_hydro_ns(:,:,:) = zero
+    
+    ALLOCATE (frac_hydro_diag(nslm, nbdl),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable frac_hydro_diag','','')
+
+    ALLOCATE (soilmoist(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soilmoist','','')
+
+    ALLOCATE (soil_wet(kjpindex,nslm,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soil_wet','','')
+
+    ALLOCATE (soil_wet_litter(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soil_wet_litter','','')
+
+    ALLOCATE (qflux_ns(kjpindex,nslm,nstm),stat=ier)  
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable qflux_ns','','') 
+
+    ALLOCATE (check_top_ns(kjpindex,nstm),stat=ier)  
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable check_top_ns','','') 
+
+    ALLOCATE (tmat(kjpindex,nslm,3),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmat','','')
+
+    ALLOCATE (stmat(kjpindex,nslm,3),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable stmat','','')
+
+    ALLOCATE (nroot(kjpindex,nvm,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable nroot','','')
+
+    ALLOCATE (kfact_root(kjpindex, nslm, nstm), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kfact_root','','')
+
+    ALLOCATE (kfact(nslm, nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kfact','','')
+
+    ALLOCATE (zz(nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable zz','','')
+
+    ALLOCATE (dz(nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dz','','')
+    
+    ALLOCATE (dh(nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dh','','')
+
+    ALLOCATE (mc_lin(imin:imax, nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_lin','','')
+
+    ALLOCATE (k_lin(imin:imax, nslm, nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable k_lin','','')
+
+    ALLOCATE (d_lin(imin:imax, nslm, nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable d_lin','','')
+
+    ALLOCATE (a_lin(imin:imax, nslm, nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable a_lin','','')
+
+    ALLOCATE (b_lin(imin:imax, nslm, nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable b_lin','','')
+
+    ALLOCATE (undermcr(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable undermcr','','')
+
+    ALLOCATE (tot_watveg_beg(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watveg_beg','','')
+    
+    ALLOCATE (tot_watveg_end(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watvag_end','','')
+    
+    ALLOCATE (tot_watsoil_beg(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watsoil_beg','','')
+    
+    ALLOCATE (tot_watsoil_end(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watsoil_end','','')
+    
+    ALLOCATE (delsoilmoist(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delsoilmoist','','')
+    
+    ALLOCATE (delintercept(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delintercept','','')
+    
+    ALLOCATE (delswe(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delswe','','')
+    
+    ALLOCATE (snow_beg(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snow_beg','','')
+    
+    ALLOCATE (snow_end(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snow_end','','')
+    
+    !! 4 Open restart input file and read data for HYDROLOGIC process
+    IF (printlev>=3) WRITE (numout,*) ' we have to read a restart file for HYDROLOGIC variables'
+
+    IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
+    CALL restget_p (rest_id, 'moistc', nbp_glo, nslm , nstm, kjit, .TRUE., mc, "gather", nbp_glo, index_g)
+
+    IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')  
+    CALL restget_p (rest_id, 'moistcl', nbp_glo, nslm , nstm, kjit, .TRUE., mcl, "gather", nbp_glo, index_g)
+
+    IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','us') 
+    CALL restget_p (rest_id, 'us', nbp_glo, nvm, nstm, nslm, kjit, .TRUE., us, "gather", nbp_glo, index_g)   
+    !
+    var_name= 'free_drain_coef'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Coefficient for free drainage at bottom of soil')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., free_drain_coef, "gather", nbp_glo, index_g)
+    !
+    var_name= 'zwt_force'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', 'm')
+       CALL ioconf_setatt_p('LONG_NAME','Prescribed water table depth')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., zwt_force, "gather", nbp_glo, index_g)
+    !
+    var_name= 'water2infilt'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Remaining water to be infiltrated on top of the soil')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., water2infilt, "gather", nbp_glo, index_g)
+    !
+    var_name= 'ae_ns'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+       CALL ioconf_setatt_p('LONG_NAME','Bare soil evap on each soil type')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., ae_ns, "gather", nbp_glo, index_g)
+    !
+    var_name= 'snow'        
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+       CALL ioconf_setatt_p('LONG_NAME','Snow mass')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, 1  , 1, kjit, .TRUE., snow, "gather", nbp_glo, index_g)
+    !
+    var_name= 'snow_age'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', 'd')
+       CALL ioconf_setatt_p('LONG_NAME','Snow age')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, 1  , 1, kjit, .TRUE., snow_age, "gather", nbp_glo, index_g)
+    !
+    var_name= 'snow_nobio'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+       CALL ioconf_setatt_p('LONG_NAME','Snow on other surface types')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, nnobio  , 1, kjit, .TRUE., snow_nobio, "gather", nbp_glo, index_g)
+    !
+    var_name= 'snow_nobio_age'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', 'd')
+       CALL ioconf_setatt_p('LONG_NAME','Snow age on other surface types')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, nnobio  , 1, kjit, .TRUE., snow_nobio_age, "gather", nbp_glo, index_g)
+    !
+    var_name= 'qsintveg'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+       CALL ioconf_setatt_p('LONG_NAME','Intercepted moisture')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., qsintveg, "gather", nbp_glo, index_g)
+
+    var_name= 'evap_bare_lim_ns'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', '?')
+       CALL ioconf_setatt_p('LONG_NAME','?')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., evap_bare_lim_ns, "gather", nbp_glo, index_g)
+    CALL setvar_p (evap_bare_lim_ns, val_exp, 'NO_KEYWORD', 0.0)
+
+    var_name= 'resdist'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','soiltile values from previous time-step')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., resdist, "gather", nbp_glo, index_g)
+
+    var_name = 'veget_old'
+    IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','vegtot from previous time-step')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., vegtot_old, "gather", nbp_glo, index_g)
+
+       ! Read drysoil_frac. It will be initalized later in hydrol_var_init if the varaible is not find in restart file.
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '')
+          CALL ioconf_setatt_p('LONG_NAME','Function of litter wetness')
+       ENDIF
+       CALL restget_p (rest_id, 'drysoil_frac', nbp_glo, 1  , 1, kjit, .TRUE., drysoil_frac, "gather", nbp_glo, index_g)
+
+
+    !! 5 get restart values if none were found in the restart file
+       !
+       !Config Key   = HYDROL_MOISTURE_CONTENT
+       !Config Desc  = Soil moisture on each soil tile and levels
+       !Config If    = 
+       !Config Def   = 0.3
+       !Config Help  = The initial value of mc if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = [m3/m3]
+       !
+       CALL setvar_p (mc, val_exp, 'HYDROL_MOISTURE_CONTENT', 0.3_r_std)
+
+       ! Initialize mcl as mc if it is not found in the restart file
+       IF ( ALL(mcl(:,:,:)==val_exp) ) THEN
+          mcl(:,:,:) = mc(:,:,:)
+       END IF
+
+       
+       !Config Key   = US_INIT
+       !Config Desc  = US_NVM_NSTM_NSLM
+       !Config If    = 
+       !Config Def   = 0.0
+       !Config Help  = The initial value of us (relative moisture) if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = [-]
+       !
+       DO jsl=1,nslm
+          CALL setvar_p (us(:,:,:,jsl), val_exp, 'US_INIT', zero)
+       ENDDO
+       !
+       !Config Key   = ZWT_FORCE
+       !Config Desc  = Prescribed water depth, dimension nstm
+       !Config If    = 
+       !Config Def   = undef undef undef
+       !Config Help  = The initial value of zwt_force if its value is not found
+       !Config         in the restart file. undef corresponds to a case whith no forced WT. 
+       !Config         This should only be used if the model is started without a restart file.
+       !Config Units = [m]
+       
+       ALLOCATE (zwt_default(nstm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable zwt_default','','')
+       zwt_default(:) = undef_sechiba
+       CALL setvar_p (zwt_force, val_exp, 'ZWT_FORCE', zwt_default )
+
+       zforce = .FALSE.
+       DO jst=1,nstm
+          IF (zwt_force(1,jst) <= zmaxh) zforce = .TRUE. ! AD16*** check if OK with vertical_soil
+       ENDDO
+       !
+       !Config Key   = FREE_DRAIN_COEF
+       !Config Desc  = Coefficient for free drainage at bottom, dimension nstm
+       !Config If    = 
+       !Config Def   = 1.0 1.0 1.0
+       !Config Help  = The initial value of free drainage coefficient if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = [-]
+              
+       ALLOCATE (free_drain_max(nstm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init',&
+        'Problem in allocate of variable free_drain_max','','')
+       free_drain_max(:)=1.0
+
+       CALL setvar_p (free_drain_coef, val_exp, 'FREE_DRAIN_COEF', free_drain_max)
+       IF (printlev>=2) WRITE (numout,*) ' hydrol_init => free_drain_coef = ', &
+          free_drain_coef(1,:)
+       DEALLOCATE(free_drain_max)
+
+       !
+       !Config Key   = WATER_TO_INFILT
+       !Config Desc  = Water to be infiltrated on top of the soil
+       !Config If    = 
+       !Config Def   = 0.0
+       !Config Help  = The initial value of free drainage if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = [mm]
+       !
+       CALL setvar_p (water2infilt, val_exp, 'WATER_TO_INFILT', zero)
+       !
+       !Config Key   = EVAPNU_SOIL
+       !Config Desc  = Bare soil evap on each soil if not found in restart
+       !Config If    = 
+       !Config Def   = 0.0
+       !Config Help  = The initial value of bare soils evap if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = [mm]
+       !
+       CALL setvar_p (ae_ns, val_exp, 'EVAPNU_SOIL', zero)
+       !
+       !Config Key  = HYDROL_SNOW
+       !Config Desc  = Initial snow mass if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of snow mass if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units =
+       !
+       CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', zero)
+       !
+       !Config Key   = HYDROL_SNOWAGE
+       !Config Desc  = Initial snow age if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of snow age if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = ***
+       !
+       CALL setvar_p (snow_age, val_exp, 'HYDROL_SNOWAGE', zero)
+       !
+       !Config Key   = HYDROL_SNOW_NOBIO
+       !Config Desc  = Initial snow amount on ice, lakes, etc. if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of snow if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = [mm]
+       !
+       CALL setvar_p (snow_nobio, val_exp, 'HYDROL_SNOW_NOBIO', zero)
+       !
+       !Config Key   = HYDROL_SNOW_NOBIO_AGE
+       !Config Desc  = Initial snow age on ice, lakes, etc. if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of snow age if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = ***
+       !
+       CALL setvar_p (snow_nobio_age, val_exp, 'HYDROL_SNOW_NOBIO_AGE', zero)
+       !
+       !Config Key   = HYDROL_QSV
+       !Config Desc  = Initial water on canopy if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of moisture on canopy if its value 
+       !Config         is not found in the restart file. This should only be used if
+       !Config         the model is started without a restart file. 
+       !Config Units = [mm]
+       !
+       CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', zero)
+
+    !! 6 Vegetation array      
+       !
+       ! If resdist is not in restart file, initialize with soiltile
+       IF ( MINVAL(resdist) .EQ.  MAXVAL(resdist) .AND. MINVAL(resdist) .EQ. val_exp) THEN
+          resdist(:,:) = soiltile(:,:)
+       ENDIF
+       
+       !
+       !  Remember that it is only frac_nobio + SUM(veget_max(,:)) that is equal to 1. Thus we need vegtot
+       !
+       IF ( ALL(vegtot_old(:) == val_exp) ) THEN 
+          ! vegtot_old was not found in restart file
+          DO ji = 1, kjpindex
+             vegtot_old(ji) = SUM(veget_max(ji,:))
+          ENDDO
+       ENDIF
+      
+       ! In the initialization phase, vegtot must take the value from the previous time-step. 
+       ! This is because hydrol_main is done before veget_max is updated at the end of the time step.
+       vegtot(:) = vegtot_old(:)       
+
+       !
+       ! compute the masks for veget
+
+       mask_veget(:,:) = 0
+       mask_soiltile(:,:) = 0
+
+       DO jst=1,nstm
+          DO ji = 1, kjpindex
+             IF(soiltile(ji,jst) .GT. min_sechiba) THEN
+                mask_soiltile(ji,jst) = 1
+             ENDIF
+          END DO
+       ENDDO
+          
+       DO jv = 1, nvm
+          DO ji = 1, kjpindex
+             IF(veget_max(ji,jv) .GT. min_sechiba) THEN
+                mask_veget(ji,jv) = 1
+             ENDIF
+          END DO
+       END DO
+
+       humrelv(:,:,:) = SUM(us,dim=4)
+
+          
+       !! 7a. Set vegstress
+     
+       var_name= 'vegstress'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Vegetation growth moisture stress')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., vegstress, "gather", nbp_glo, index_g)
+
+       vegstressv(:,:,:) = humrelv(:,:,:)
+       ! Calculate vegstress if it is not found in restart file
+       IF (ALL(vegstress(:,:)==val_exp)) THEN
+          DO jv=1,nvm
+             DO ji=1,kjpindex
+                vegstress(ji,jv)=vegstress(ji,jv) + vegstressv(ji,jv,pref_soil_veg(jv))
+             END DO
+          END DO
+       END IF
+       !! 7b. Set humrel   
+       ! Read humrel from restart file
+       var_name= 'humrel'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '')
+          CALL ioconf_setatt_p('LONG_NAME','Relative humidity')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., humrel, "gather", nbp_glo, index_g)
+
+       ! Calculate humrel if it is not found in restart file
+       IF (ALL(humrel(:,:)==val_exp)) THEN
+          ! set humrel from humrelv, assuming equi-repartition for the first time step
+          humrel(:,:) = zero
+          DO jv=1,nvm
+             DO ji=1,kjpindex
+                humrel(ji,jv)=humrel(ji,jv) + humrelv(ji,jv,pref_soil_veg(jv))      
+             END DO
+          END DO
+       END IF
+
+       ! Read evap_bare_lim from restart file
+       var_name= 'evap_bare_lim'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '')
+          CALL ioconf_setatt_p('LONG_NAME','Limitation factor for bare soil evaporation')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., evap_bare_lim, "gather", nbp_glo, index_g)
+
+       ! Calculate evap_bare_lim if it was not found in the restart file.
+       IF ( ALL(evap_bare_lim(:) == val_exp) ) THEN
+          DO ji = 1, kjpindex
+             evap_bare_lim(ji) =  SUM(evap_bare_lim_ns(ji,:)*vegtot(ji)*soiltile(ji,:))
+          ENDDO
+       END IF
+
+
+    ! Read from restart file       
+    ! The variables tot_watsoil_beg, tot_watsoil_beg and snwo_beg will be initialized in the end of 
+    ! hydrol_initialize if they were not found in the restart file.
+       
+    var_name= 'tot_watveg_beg'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', '?')
+       CALL ioconf_setatt_p('LONG_NAME','?')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., tot_watveg_beg, "gather", nbp_glo, index_g)
+    
+    var_name= 'tot_watsoil_beg'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', '?')
+       CALL ioconf_setatt_p('LONG_NAME','?')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., tot_watsoil_beg, "gather", nbp_glo, index_g)
+    
+    var_name= 'snow_beg'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', '?')
+       CALL ioconf_setatt_p('LONG_NAME','?')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., snow_beg, "gather", nbp_glo, index_g)
+       
+ 
+    ! Initialize variables for explictsnow module by reading restart file
+    CALL explicitsnow_initialize( kjit,     kjpindex, rest_id,    snowrho,   &
+         snowtemp, snowdz,   snowheat,   snowgrain)
+
+    
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_init done '
+    
+  END SUBROUTINE hydrol_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_clear
+!!
+!>\BRIEF        Deallocate arrays 
+!!
+!_ ================================================================================================================================
+!_ hydrol_clear
+
+  SUBROUTINE hydrol_clear()
+
+    ! Allocation for soiltile related parameters
+    IF ( ALLOCATED (nvan)) DEALLOCATE (nvan)
+    IF ( ALLOCATED (avan)) DEALLOCATE (avan)
+    IF ( ALLOCATED (mcr)) DEALLOCATE (mcr)
+    IF ( ALLOCATED (mcs)) DEALLOCATE (mcs)
+    IF ( ALLOCATED (ks)) DEALLOCATE (ks)
+    IF ( ALLOCATED (pcent)) DEALLOCATE (pcent)
+    IF ( ALLOCATED (mcf)) DEALLOCATE (mcf)
+    IF ( ALLOCATED (mcw)) DEALLOCATE (mcw)
+    IF ( ALLOCATED (mc_awet)) DEALLOCATE (mc_awet)
+    IF ( ALLOCATED (mc_adry)) DEALLOCATE (mc_adry)
+    ! Other arrays
+    IF (ALLOCATED (mask_veget)) DEALLOCATE (mask_veget)
+    IF (ALLOCATED (mask_soiltile)) DEALLOCATE (mask_soiltile)
+    IF (ALLOCATED (humrelv)) DEALLOCATE (humrelv)
+    IF (ALLOCATED (vegstressv)) DEALLOCATE (vegstressv)
+    IF (ALLOCATED (us)) DEALLOCATE (us)
+    IF (ALLOCATED  (precisol)) DEALLOCATE (precisol)
+    IF (ALLOCATED  (precisol_ns)) DEALLOCATE (precisol_ns)
+    IF (ALLOCATED  (free_drain_coef)) DEALLOCATE (free_drain_coef)
+    IF (ALLOCATED  (frac_bare_ns)) DEALLOCATE (frac_bare_ns)
+    IF (ALLOCATED  (water2infilt)) DEALLOCATE (water2infilt)
+    IF (ALLOCATED  (ae_ns)) DEALLOCATE (ae_ns)
+    IF (ALLOCATED  (evap_bare_lim_ns)) DEALLOCATE (evap_bare_lim_ns)
+    IF (ALLOCATED  (rootsink)) DEALLOCATE (rootsink)
+    IF (ALLOCATED  (subsnowveg)) DEALLOCATE (subsnowveg)
+    IF (ALLOCATED  (subsnownobio)) DEALLOCATE (subsnownobio)
+    IF (ALLOCATED  (icemelt)) DEALLOCATE (icemelt)
+    IF (ALLOCATED  (subsinksoil)) DEALLOCATE (subsinksoil)
+    IF (ALLOCATED  (mx_eau_var)) DEALLOCATE (mx_eau_var)
+    IF (ALLOCATED  (vegtot)) DEALLOCATE (vegtot)
+    IF (ALLOCATED  (vegtot_old)) DEALLOCATE (vegtot_old)
+    IF (ALLOCATED  (resdist)) DEALLOCATE (resdist)
+    IF (ALLOCATED  (tot_watveg_beg)) DEALLOCATE (tot_watveg_beg)
+    IF (ALLOCATED  (tot_watveg_end)) DEALLOCATE (tot_watveg_end)
+    IF (ALLOCATED  (tot_watsoil_beg)) DEALLOCATE (tot_watsoil_beg)
+    IF (ALLOCATED  (tot_watsoil_end)) DEALLOCATE (tot_watsoil_end)
+    IF (ALLOCATED  (delsoilmoist)) DEALLOCATE (delsoilmoist)
+    IF (ALLOCATED  (delintercept)) DEALLOCATE (delintercept)
+    IF (ALLOCATED  (snow_beg)) DEALLOCATE (snow_beg)
+    IF (ALLOCATED  (snow_end)) DEALLOCATE (snow_end)
+    IF (ALLOCATED  (delswe)) DEALLOCATE (delswe)
+    IF (ALLOCATED  (undermcr)) DEALLOCATE (undermcr)
+    IF (ALLOCATED  (v1)) DEALLOCATE (v1)
+    IF (ALLOCATED  (humtot)) DEALLOCATE (humtot)
+    IF (ALLOCATED  (resolv)) DEALLOCATE (resolv)
+    IF (ALLOCATED  (k)) DEALLOCATE (k)
+    IF (ALLOCATED  (kk)) DEALLOCATE (kk)
+    IF (ALLOCATED  (kk_moy)) DEALLOCATE (kk_moy)
+    IF (ALLOCATED  (a)) DEALLOCATE (a)
+    IF (ALLOCATED  (b)) DEALLOCATE (b)
+    IF (ALLOCATED  (d)) DEALLOCATE (d)
+    IF (ALLOCATED  (e)) DEALLOCATE (e)
+    IF (ALLOCATED  (f)) DEALLOCATE (f)
+    IF (ALLOCATED  (g1)) DEALLOCATE (g1)
+    IF (ALLOCATED  (ep)) DEALLOCATE (ep)
+    IF (ALLOCATED  (fp)) DEALLOCATE (fp)
+    IF (ALLOCATED  (gp)) DEALLOCATE (gp)
+    IF (ALLOCATED  (rhs)) DEALLOCATE (rhs)
+    IF (ALLOCATED  (srhs)) DEALLOCATE (srhs)
+    IF (ALLOCATED  (tmc)) DEALLOCATE (tmc)
+    IF (ALLOCATED  (tmcs)) DEALLOCATE (tmcs)
+    IF (ALLOCATED  (tmcr)) DEALLOCATE (tmcr)
+    IF (ALLOCATED  (tmc_litter)) DEALLOCATE (tmc_litter)
+    IF (ALLOCATED  (tmc_litt_mea)) DEALLOCATE (tmc_litt_mea)
+    IF (ALLOCATED  (tmc_litter_res)) DEALLOCATE (tmc_litter_res)
+    IF (ALLOCATED  (tmc_litter_wilt)) DEALLOCATE (tmc_litter_wilt)
+    IF (ALLOCATED  (tmc_litter_field)) DEALLOCATE (tmc_litter_field)
+    IF (ALLOCATED  (tmc_litter_sat)) DEALLOCATE (tmc_litter_sat)
+    IF (ALLOCATED  (tmc_litter_awet)) DEALLOCATE (tmc_litter_awet)
+    IF (ALLOCATED  (tmc_litter_adry)) DEALLOCATE (tmc_litter_adry)
+    IF (ALLOCATED  (tmc_litt_wet_mea)) DEALLOCATE (tmc_litt_wet_mea)
+    IF (ALLOCATED  (tmc_litt_dry_mea)) DEALLOCATE (tmc_litt_dry_mea)
+    IF (ALLOCATED  (ru_ns)) DEALLOCATE (ru_ns)
+    IF (ALLOCATED  (dr_ns)) DEALLOCATE (dr_ns)
+    IF (ALLOCATED  (tr_ns)) DEALLOCATE (tr_ns)
+    IF (ALLOCATED  (vegetmax_soil)) DEALLOCATE (vegetmax_soil)
+    IF (ALLOCATED  (mc)) DEALLOCATE (mc)
+    IF (ALLOCATED  (soilmoist)) DEALLOCATE (soilmoist)
+    IF (ALLOCATED  (soil_wet)) DEALLOCATE (soil_wet)
+    IF (ALLOCATED  (soil_wet_litter)) DEALLOCATE (soil_wet_litter)
+    IF (ALLOCATED  (qflux_ns)) DEALLOCATE (qflux_ns)
+    IF (ALLOCATED  (tmat)) DEALLOCATE (tmat)
+    IF (ALLOCATED  (stmat)) DEALLOCATE (stmat)
+    IF (ALLOCATED  (nroot)) DEALLOCATE (nroot)
+    IF (ALLOCATED  (kfact_root)) DEALLOCATE (kfact_root)
+    IF (ALLOCATED  (kfact)) DEALLOCATE (kfact)
+    IF (ALLOCATED  (zz)) DEALLOCATE (zz)
+    IF (ALLOCATED  (dz)) DEALLOCATE (dz)
+    IF (ALLOCATED  (dh)) DEALLOCATE (dh)
+    IF (ALLOCATED  (mc_lin)) DEALLOCATE (mc_lin)
+    IF (ALLOCATED  (k_lin)) DEALLOCATE (k_lin)
+    IF (ALLOCATED  (d_lin)) DEALLOCATE (d_lin)
+    IF (ALLOCATED  (a_lin)) DEALLOCATE (a_lin)
+    IF (ALLOCATED  (b_lin)) DEALLOCATE (b_lin)
+    IF (ALLOCATED  (frac_hydro_diag)) DEALLOCATE (frac_hydro_diag)
+    
+
+  END SUBROUTINE hydrol_clear
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_tmc_update
+!!
+!>\BRIEF        This routine updates the soil moisture profiles when the vegetation fraction have changed. 
+!!
+!! DESCRIPTION  :
+!! 
+!!    This routine update tmc and mc with variation of veget_max (LAND_USE or DGVM activated)
+!! 
+!!
+!!
+!!
+!! RECENT CHANGE(S) : Adaptation to excluding nobio from soiltile(1)
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_tmc_update
+  SUBROUTINE hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, drain_upd, runoff_upd)
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                            :: kjpindex      !! domain size
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)     :: veget_max     !! max fraction of vegetation type
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)   :: soiltile      !! Fraction of each soil tile (0-1, unitless)
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: drain_upd        !! Change in drainage due to decrease in vegtot
+                                                                              !! on mc [kg/m2/dt]
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: runoff_upd       !! Change in runoff due to decrease in vegtot
+                                                                              !! on water2infilt[kg/m2/dt]
+    
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)  :: qsintveg   !! Amount of water in the canopy interception 
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                           :: ji, jv, jst,jsl
+    LOGICAL                                  :: soil_upd        !! True if soiltile changed since last time step
+    LOGICAL                                  :: vegtot_upd      !! True if vegtot changed since last time step
+    REAL(r_std), DIMENSION(kjpindex,nstm)    :: vmr             !! Change in soiltile (within vegtot)
+    REAL(r_std), DIMENSION(kjpindex)         :: vmr_sum
+    REAL(r_std), DIMENSION(kjpindex)         :: delvegtot    
+    REAL(r_std), DIMENSION(kjpindex,nslm)    :: mc_dilu         !! Total loss of moisture content
+    REAL(r_std), DIMENSION(kjpindex)         :: infil_dilu      !! Total loss for water2infilt
+    REAL(r_std), DIMENSION(kjpindex,nstm)    :: tmc_old         !! tmc before calculations
+    REAL(r_std), DIMENSION(kjpindex,nstm)    :: water2infilt_old!! water2infilt before calculations
+    REAL(r_std), DIMENSION (kjpindex,nvm)    :: qsintveg_old    !! qsintveg before calculations
+    REAL(r_std), DIMENSION(kjpindex)         :: test
+    REAL(r_std), DIMENSION(kjpindex,nslm,nstm) :: mcaux        !! serves to hold the chnage in mc when vegtot decreases
+
+    
+    !! 1. If a PFT has disapperead as result from a veget_max change, 
+    !!    then add canopy water to surface water.
+    !     Other adaptations of qsintveg are delt by the normal functioning of hydrol_canop
+
+    DO ji=1,kjpindex
+       IF (vegtot_old(ji) .GT.min_sechiba) THEN
+          DO jv=1,nvm
+             IF ((veget_max(ji,jv).LT.min_sechiba).AND.(qsintveg(ji,jv).GT.0.)) THEN
+                jst=pref_soil_veg(jv) ! soil tile index
+                water2infilt(ji,jst) = water2infilt(ji,jst) + qsintveg(ji,jv)/(resdist(ji,jst)*vegtot_old(ji))
+                qsintveg(ji,jv) = zero
+             ENDIF
+          ENDDO
+       ENDIF
+    ENDDO
+   
+    !! 2. We now deal with the changes of soiltile and corresponding soil moistures
+    !!    Because sum(soiltile)=1 whatever vegtot, we need to distinguish two cases:
+    !!    - when vegtot changes (meaning that the nobio fraction changes too),
+    !!    - and when vegtot does not changes (a priori the most frequent case)
+
+    vegtot_upd = SUM(ABS((vegtot(:)-vegtot_old(:)))) .GT. zero ! True if at least one land point with a vegtot change
+    runoff_upd(:) = zero
+    drain_upd(:) = zero
+    IF (vegtot_upd) THEN
+       ! We find here the processing specific to the chnages of nobio fraction and vegtot
+
+       delvegtot(:) = vegtot(:) - vegtot_old(:)
+
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+
+             IF (delvegtot(ji) .GT. min_sechiba) THEN
+
+                !! 2.1. If vegtot increases (nobio decreases), then the mc in each soiltile is decreased
+                !!      assuming the same proportions for each soiltile, and each soil layer
+                
+                mc(ji,:,jst) = mc(ji,:,jst) * vegtot_old(ji)/vegtot(ji) ! vegtot cannot be zero as > vegtot_old
+                water2infilt(ji,jst) = water2infilt(ji,jst) * vegtot_old(ji)/vegtot(ji)
+
+             ELSE
+
+                !! 2.2 If vegtot decreases (nobio increases), then the mc in each soiltile should increase,
+                !!     but should not exceed mcs
+                !!     For simplicity, we choose to send the corresponding water volume to drainage
+                !!     We do the same for water2infilt but send the excess to surface runoff
+
+                IF (vegtot(ji) .GT.min_sechiba) THEN
+                   mcaux(ji,:,jst) =  mc(ji,:,jst) * (vegtot_old(ji)-vegtot(ji))/vegtot(ji) ! mcaux is the delta mc
+                ELSE ! we just have nobio in the grid-cell
+                   mcaux(ji,:,jst) =  mc(ji,:,jst)
+                ENDIF
+                
+                drain_upd(ji) = drain_upd(ji) + dz(2) * ( trois*mcaux(ji,1,jst) + mcaux(ji,2,jst) )/huit
+                DO jsl = 2,nslm-1
+                   drain_upd(ji) = drain_upd(ji) + dz(jsl) * (trois*mcaux(ji,jsl,jst)+mcaux(ji,jsl-1,jst))/huit &
+                        + dz(jsl+1) * (trois*mcaux(ji,jsl,jst)+mcaux(ji,jsl+1,jst))/huit
+                ENDDO
+                drain_upd(ji) = drain_upd(ji) + dz(nslm) * (trois*mcaux(ji,nslm,jst) + mcaux(ji,nslm-1,jst))/huit
+
+                IF (vegtot(ji) .GT.min_sechiba) THEN
+                   runoff_upd(ji) = runoff_upd(ji) + water2infilt(ji,jst) * (vegtot_old(ji)-vegtot(ji))/vegtot(ji)
+                ELSE ! we just have nobio in the grid-cell
+                   runoff_upd(ji) = runoff_upd(ji) + water2infilt(ji,jst)
+                ENDIF
+
+             ENDIF
+             
+          ENDDO
+       ENDDO
+       
+    ENDIF
+    
+    !! 3. At the end of step 2, we are back to a case where vegtot changes are treated, so we can use soiltile
+    !!    as a fraction of vegtot to process the mc transfers between soil tiles due to the changes of vegetation map
+   
+    !! 3.1 Check if soiltiles changed since last time step
+    soil_upd=SUM(ABS(soiltile(:,:)-resdist(:,:))) .GT. zero
+    IF (printlev>=3) WRITE (numout,*) 'soil_upd ', soil_upd
+        
+    IF (soil_upd) THEN
+     
+       !! 3.2 Define the change in soiltile
+       !  resdist is the previous values of soiltiles, previous timestep, 
+       !  so before new map
+       vmr(:,:) = soiltile(:,:) - resdist(:,:)  
+
+       ! Total area loss by the three soil tiles
+       DO ji=1,kjpindex
+          vmr_sum(ji)=SUM(vmr(ji,:),MASK=vmr(ji,:).LT.zero)
+       ENDDO
+
+       !! 3.3 Shrinking soil tiles
+       !! 3.3.1 Total loss of moisture content from the shrinking soil tiles, expressed by soil layer
+       mc_dilu(:,:)=zero
+       DO jst=1,nstm
+          DO jsl = 1, nslm
+             DO ji=1,kjpindex
+                IF ( vmr(ji,jst) < zero ) THEN
+                   mc_dilu(ji,jsl) = mc_dilu(ji,jsl) + mc(ji,jsl,jst) * &
+                        vmr(ji,jst) / vmr_sum(ji)
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+
+       !! 3.3.2 Total loss of water2inft from the shrinking soil tiles
+       infil_dilu(:)=zero
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF ( vmr(ji,jst) < zero ) THEN
+                infil_dilu(ji) = infil_dilu(ji) + water2infilt(ji,jst) * &
+                     vmr(ji,jst) / vmr_sum(ji)
+             ENDIF
+          ENDDO
+       ENDDO
+
+       !! 3.4 Each gaining soil tile gets moisture proportionally 
+       !!     to both the total loss and its areal increase 
+
+       ! As the original mc from each soil tile are in [mcr,mcs] and 
+       ! we do weighted avrage, the new mc are in [mcr,mcs]
+       ! The case where the soiltile is created (soiltile_old=0) works 
+       ! as the other cases
+
+       ! 3.4.1 Update mc(kjpindex,nslm,nstm) !m3/m3
+       DO jst=1,nstm
+          DO jsl = 1, nslm
+             DO ji=1,kjpindex
+                IF ( vmr(ji,jst) > zero ) THEN
+                   mc(ji,jsl,jst) = ( mc(ji,jsl,jst) * resdist(ji,jst) + mc_dilu(ji,jsl) * vmr(ji,jst) ) / soiltile(ji,jst)
+                   ! NB : soiltile can not be zero for case vmr > zero, see slowproc_veget
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+       
+       ! 3.4.2 Update water2inft
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF ( vmr(ji,jst) > zero ) THEN !donc soiltile>0     
+                water2infilt(ji,jst) = ( water2infilt(ji,jst) * &
+                     resdist(ji,jst) + infil_dilu(ji) * vmr(ji,jst) ) / &
+                     soiltile(ji,jst)
+             ENDIF !donc resdist>0
+          ENDDO
+       ENDDO
+
+       ! 3.4.3 Case where soiltile < min_sechiba 
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF ( soiltile(ji,jst) .LT. min_sechiba ) THEN
+                water2infilt(ji,jst) = zero
+                mc(ji,:,jst) = zero
+             ENDIF
+          ENDDO
+       ENDDO
+
+    ENDIF ! soil_upd
+
+    !! 4. Update tmc and humtot
+    
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+             tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+             DO jsl = 2,nslm-1
+                tmc(ji,jst) = tmc(ji,jst) + dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                     + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+             ENDDO
+             tmc(ji,jst) = tmc(ji,jst) + dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+             tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
+             ! WARNING tmc is increased by includes water2infilt(ji,jst)
+       ENDDO
+    ENDDO
+
+    humtot(:) = zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          humtot(ji) = humtot(ji) + vegtot(ji) * soiltile(ji,jst) * tmc(ji,jst) ! average over grid-cell
+       ENDDO
+    ENDDO
+
+    !! Now that the work is done, update resdist
+    resdist(:,:) = soiltile(:,:)
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_tmc_update done '
+
+  END SUBROUTINE hydrol_tmc_update
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_var_init
+!!
+!>\BRIEF        This routine initializes hydrologic parameters to define K and D, and diagnostic hydrologic variables.  
+!!
+!! DESCRIPTION  :
+!! - 1 compute the depths
+!! - 2 compute the profile for roots
+!! - 3 compute the profile for ksat, a and n Van Genuchten parameter
+!! - 4 compute the linearized values of k, a, b and d for the resolution of Fokker Planck equation
+!! - 5 water reservoirs initialisation
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_var_init
+
+  SUBROUTINE hydrol_var_init (kjpindex, veget, veget_max, soiltile, njsc, &
+       mx_eau_var, shumdiag_perma, &
+       drysoil_frac, qsintveg, mc_layh, mcl_layh, tmc_layh) 
+
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                          :: kjpindex      !! Domain size (number of grid cells) (1)
+    ! input fields
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget_max     !! PFT fractions within grid-cells (1; 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget         !! Effective fraction of vegetation by PFT (1; 1)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: njsc          !! Index of the dominant soil textural class 
+                                                                         !! in the grid cell (1-nscm, unitless) 
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile      !! Fraction of each soil tile within vegtot (0-1, unitless)
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: mx_eau_var    !! Maximum water content of the soil 
+                                                                         !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out) :: shumdiag_perma!! Percent of porosity filled with water (mc/mcs)
+                                                                         !! used for the thermal computations
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)    :: drysoil_frac  !! function of litter humidity
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out):: mc_layh       !! Volumetric soil moisture content for each layer in hydrol(liquid+ice) [m3/m3]
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out):: mcl_layh      !! Volumetric soil moisture content for each layer in hydrol(liquid) [m3/m3]
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out):: tmc_layh      !! Total soil moisture content for each layer in hydrol(liquid+ice) [mm]
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)  :: qsintveg    !! Water on vegetation due to interception
+                                                                         !! @tex $(kg m^{-2})$ @endtex  
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jv        !! Grid-cell and PFT indices (1)
+    INTEGER(i_std)                                      :: jst, jsc, jsl !! Soiltile, Soil Texture, and Soil layer indices (1)
+    INTEGER(i_std)                                      :: i, jd         !! Index (1)
+    REAL(r_std)                                         :: m             !! m=1-1/n (unitless)
+    REAL(r_std)                                         :: frac          !! Relative linearized VWC (unitless)
+    REAL(r_std)                                         :: avan_mod      !! VG parameter a modified from  exponantial profile
+                                                                         !! @tex $(mm^{-1})$ @endtex
+    REAL(r_std)                                         :: nvan_mod      !! VG parameter n  modified from  exponantial profile
+                                                                         !! (unitless)
+    REAL(r_std), DIMENSION(nslm,nscm)                   :: afact, nfact  !! Multiplicative factor for decay of a and n with depth
+                                                                         !! (unitless)
+    ! parameters for "soil densification" with depth
+    REAL(r_std)                                         :: dp_comp       !! Depth at which the 'compacted' value of ksat
+                                                                         !! is reached (m)
+    REAL(r_std)                                         :: f_ks          !! Exponential factor for decay of ksat with depth 
+                                                                         !! @tex $(m^{-1})$ @endtex 
+    ! Fixed parameters from fitted relationships
+    REAL(r_std)                                         :: n0            !! fitted value for relation log((n-n0)/(n_ref-n0)) = 
+                                                                         !! nk_rel * log(k/k_ref) 
+                                                                         !! (unitless)
+    REAL(r_std)                                         :: nk_rel        !! fitted value for relation log((n-n0)/(n_ref-n0)) = 
+                                                                         !! nk_rel * log(k/k_ref) 
+                                                                         !! (unitless)
+    REAL(r_std)                                         :: a0            !! fitted value for relation log((a-a0)/(a_ref-a0)) = 
+                                                                         !! ak_rel * log(k/k_ref) 
+                                                                         !! @tex $(mm^{-1})$ @endtex
+    REAL(r_std)                                         :: ak_rel        !! fitted value for relation log((a-a0)/(a_ref-a0)) = 
+                                                                         !! ak_rel * log(k/k_ref)
+                                                                         !! (unitless) 
+    REAL(r_std)                                         :: kfact_max     !! Maximum factor for Ks decay with depth (unitless)
+    REAL(r_std)                                         :: k_tmp, tmc_litter_ratio
+    INTEGER(i_std), PARAMETER                           :: error_level = 3 !! Error level for consistency check
+                                                                           !! Switch to 2 tu turn fatal errors into warnings
+    REAL(r_std), DIMENSION (kjpindex,nslm,nstm)         :: tmc_layh_s      !! total soil moisture content for each layer in hydrol and for each soiltile (mm)
+    INTEGER(i_std)                                      :: jiref           !! To identify the mc_lins where k_lin and d_lin 
+                                                                           !! need special treatment
+
+!_ ================================================================================================================================
+
+
+    !
+    !Config Key   = CWRR_NKS_N0 
+    !Config Desc  = fitted value for relation log((n-n0)/(n_ref-n0)) = nk_rel * log(k/k_ref)
+    !Config Def   = 0.95
+    !Config If    = 
+    !Config Help  =
+    !Config Units = [-]
+    n0 = 0.95
+    CALL getin_p("CWRR_NKS_N0",n0)
+
+    !! Check parameter value (correct range)
+    IF ( n0 < zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for CWRR_NKS_N0.", &
+            &     "This parameter should be non-negative. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_NKS_POWER
+    !Config Desc  = fitted value for relation log((n-n0)/(n_ref-n0)) = nk_rel * log(k/k_ref)
+    !Config Def   = 0.34
+    !Config If    = 
+    !Config Help  =
+    !Config Units = [-]
+    nk_rel = 0.34
+    CALL getin_p("CWRR_NKS_POWER",nk_rel)
+
+    !! Check parameter value (correct range)
+    IF ( nk_rel < zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for CWRR_NKS_POWER.", &
+            &     "This parameter should be non-negative. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_AKS_A0 
+    !Config Desc  = fitted value for relation log((a-a0)/(a_ref-a0)) = ak_rel * log(k/k_ref)
+    !Config Def   = 0.00012
+    !Config If    = 
+    !Config Help  =
+    !Config Units = [1/mm]
+    a0 = 0.00012
+    CALL getin_p("CWRR_AKS_A0",a0)
+
+    !! Check parameter value (correct range)
+    IF ( a0 < zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for CWRR_AKS_A0.", &
+            &     "This parameter should be non-negative. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_AKS_POWER
+    !Config Desc  = fitted value for relation log((a-a0)/(a_ref-a0)) = ak_rel * log(k/k_ref)
+    !Config Def   = 0.53
+    !Config If    = 
+    !Config Help  =
+    !Config Units = [-]
+    ak_rel = 0.53
+    CALL getin_p("CWRR_AKS_POWER",ak_rel)
+
+    !! Check parameter value (correct range)
+    IF ( nk_rel < zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for CWRR_AKS_POWER.", &
+            &     "This parameter should be non-negative. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = KFACT_DECAY_RATE
+    !Config Desc  = Factor for Ks decay with depth
+    !Config Def   = 2.0
+    !Config If    = 
+    !Config Help  =  
+    !Config Units = [1/m]
+    f_ks = 2.0
+    CALL getin_p ("KFACT_DECAY_RATE", f_ks)
+
+    !! Check parameter value (correct range)
+    IF ( f_ks < zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for KFACT_DECAY_RATE.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = KFACT_STARTING_DEPTH
+    !Config Desc  = Depth for compacted value of Ks 
+    !Config Def   = 0.3
+    !Config If    =
+    !Config Help  =  
+    !Config Units = [m]
+    dp_comp = 0.3
+    CALL getin_p ("KFACT_STARTING_DEPTH", dp_comp)
+
+    !! Check parameter value (correct range)
+    IF ( dp_comp <= zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for KFACT_STARTING_DEPTH.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = KFACT_MAX
+    !Config Desc  = Maximum Factor for Ks increase due to vegetation
+    !Config Def   = 10.0
+    !Config If    = 
+    !Config Help  =
+    !Config Units = [-]
+    kfact_max = 10.0
+    CALL getin_p ("KFACT_MAX", kfact_max)
+
+    !! Check parameter value (correct range)
+    IF ( kfact_max < 10. ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for KFACT_MAX.", &
+            &     "This parameter should be greater than 10. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+    
+    !-
+    !! 1. Create local variables in mm for the vertical depths
+    !!    Vertical depth variables (znh, dnh, dlh) are stored in module vertical_soil_var in m.
+    DO jsl=1,nslm
+       zz(jsl) = znh(jsl)*mille
+       dz(jsl) = dnh(jsl)*mille
+       dh(jsl) = dlh(jsl)*mille
+    ENDDO
+
+    !- 
+    !! 2. Compute the root density profile if not ok_dynroot 
+    !!    For the case with ok_dynroot, the calculations are done at each time step in hydrol_soil 
+    IF (.NOT. ok_dynroot) THEN 
+       DO ji=1, kjpindex
+          !-
+          !! The three following equations concerning nroot computation are derived from the integrals  
+          !! of equations C9 to C11 of De Rosnay's (1999) PhD thesis (page 158). 
+          !! The occasional absence of minus sign before humcste parameter is correct. 
+          DO jv = 1,nvm
+             DO jsl = 2, nslm-1 
+                nroot(ji,jv,jsl) = (EXP(-humcste(jv)*zz(jsl)/mille)) * &
+                     & (EXP(humcste(jv)*dz(jsl)/mille/deux) - &
+                     & EXP(-humcste(jv)*dz(jsl+1)/mille/deux))/ &
+                     & (EXP(-humcste(jv)*dz(2)/mille/deux) &
+                     & -EXP(-humcste(jv)*zz(nslm)/mille))
+             ENDDO
+             nroot(ji,jv,1) = zero
+             nroot(ji,jv,nslm) = (EXP(humcste(jv)*dz(nslm)/mille/deux) -un) * &
+                  & EXP(-humcste(jv)*zz(nslm)/mille) / &
+                  & (EXP(-humcste(jv)*dz(2)/mille/deux) &
+                  & -EXP(-humcste(jv)*zz(nslm)/mille))
+          ENDDO
+       ENDDO
+    ENDIF   
+
+    !-
+    !! 3 Compute the profile for ksat, a and n
+    !-
+
+    ! For every soil texture
+    DO jsc = 1, nscm 
+       DO jsl=1,nslm
+          ! PhD thesis of d'Orgeval, 2006, p81, Eq. 4.38; d'Orgeval et al. 2008, Eq. 2
+          ! Calibrated against Hapex-Sahel measurements
+          kfact(jsl,jsc) = MIN(MAX(EXP(- f_ks * (zz(jsl)/mille - dp_comp)), un/kfact_max),un)
+          ! PhD thesis of d'Orgeval, 2006, p81, Eqs. 4.39; 4.42, and Fig 4.14 
+          
+          nfact(jsl,jsc) = ( kfact(jsl,jsc) )**nk_rel
+          afact(jsl,jsc) = ( kfact(jsl,jsc) )**ak_rel
+       ENDDO
+    ENDDO
+
+    ! For every soil texture
+    DO jsc = 1, nscm
+       !-
+       !! 4 compute the linearized values of k, a, b and d
+       !-
+       ! Calculate the matrix coef for Dublin model (de Rosnay, 1999; p149)
+       ! piece-wise linearised hydraulic conductivity k_lin=alin * mc_lin + b_lin
+       ! and diffusivity d_lin in each interval of mc, called mc_lin,
+       ! between imin, for residual mcr, and imax for saturation mcs.
+
+       ! We define 51 bounds for 50 bins of mc between mcr and mcs
+       mc_lin(imin,jsc)=mcr(jsc)
+       mc_lin(imax,jsc)=mcs(jsc)
+       DO ji= imin+1, imax-1 ! ji=2,50
+          mc_lin(ji,jsc) = mcr(jsc) + (ji-imin)*(mcs(jsc)-mcr(jsc))/(imax-imin)
+       ENDDO
+
+       DO jsl = 1, nslm
+          ! From PhD thesis of d'Orgeval, 2006, p81, Eq. 4.42
+          nvan_mod = n0 + (nvan(jsc)-n0) * nfact(jsl,jsc)
+          avan_mod = a0 + (avan(jsc)-a0) * afact(jsl,jsc)
+          m = un - un / nvan_mod
+          ! We apply Van Genuchten equation for K(theta) based on Ks(z)=ks(jsc) * kfact(jsl,jsc)
+          DO ji = imax,imin,-1 
+             frac=MIN(un,(mc_lin(ji,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
+             k_lin(ji,jsl,jsc) = ks(jsc) * kfact(jsl,jsc) * (frac**0.5) * ( un - ( un - frac ** (un/m)) ** m )**2
+          ENDDO
+
+          ! k_lin should not be zero, nor too small
+          ! We track jiref, the bin under which mc is too small and we may get zero k_lin     
+          ji=imax-1
+          DO WHILE ((k_lin(ji,jsl,jsc) > 1.e-32) .and. (ji>0))
+             jiref=ji
+             ji=ji-1
+          ENDDO
+          DO ji=jiref-1,imin,-1
+             k_lin(ji,jsl,jsc)=k_lin(ji+1,jsl,jsc)/10.
+          ENDDO
+         
+          DO ji = imin,imax-1 ! ji=1,50
+             ! We deduce a_lin and b_lin based on continuity between segments k_lin = a_lin*mc-lin+b_lin
+             a_lin(ji,jsl,jsc) = (k_lin(ji+1,jsl,jsc)-k_lin(ji,jsl,jsc)) / (mc_lin(ji+1,jsc)-mc_lin(ji,jsc))
+             b_lin(ji,jsl,jsc)  = k_lin(ji,jsl,jsc) - a_lin(ji,jsl,jsc)*mc_lin(ji,jsc)
+
+             ! We calculate the d_lin for each mc bin, from Van Genuchten equation for D(theta)
+             ! d_lin is constant and taken as the arithmetic mean between the values at the bounds of each bin 
+             IF (ji.NE.imin .AND. ji.NE.imax-1) THEN
+                frac=MIN(un,(mc_lin(ji,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
+                d_lin(ji,jsl,jsc) =(k_lin(ji,jsl,jsc) / (avan_mod*m*nvan_mod)) *  &
+                     ( (frac**(-un/m))/(mc_lin(ji,jsc)-mcr(jsc)) ) * &
+                     (  frac**(-un/m) -un ) ** (-m)
+                frac=MIN(un,(mc_lin(ji+1,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
+                d_lin(ji+1,jsl,jsc) =(k_lin(ji+1,jsl,jsc) / (avan_mod*m*nvan_mod))*&
+                     ( (frac**(-un/m))/(mc_lin(ji+1,jsc)-mcr(jsc)) ) * &
+                     (  frac**(-un/m) -un ) ** (-m)
+                d_lin(ji,jsl,jsc) = undemi * (d_lin(ji,jsl,jsc)+d_lin(ji+1,jsl,jsc))
+             ELSE IF(ji.EQ.imax-1) THEN
+                d_lin(ji,jsl,jsc) =(k_lin(ji,jsl,jsc) / (avan_mod*m*nvan_mod)) * &
+                     ( (frac**(-un/m))/(mc_lin(ji,jsc)-mcr(jsc)) ) *  &
+                     (  frac**(-un/m) -un ) ** (-m)
+             ENDIF
+          ENDDO
+
+          ! Special case for ji=imin
+          d_lin(imin,jsl,jsc) = d_lin(imin+1,jsl,jsc)/1000.
+
+          ! We adjust d_lin where k_lin was previously adjusted otherwise we might get non-monotonous variations
+          ! We don't want d_lin = zero
+          DO ji=jiref-1,imin,-1
+             d_lin(ji,jsl,jsc)=d_lin(ji+1,jsl,jsc)/10.
+          ENDDO
+
+       ENDDO
+    ENDDO
+    
+
+    !! 5 Water reservoir initialisation
+    !
+!!$    DO jst = 1,nstm
+!!$       DO ji = 1, kjpindex
+!!$          mx_eau_var(ji) = mx_eau_var(ji) + soiltile(ji,jst)*&
+!!$               &   zmaxh*mille*mcs(njsc(ji))
+!!$       END DO
+!!$    END DO
+    
+    mx_eau_var(:) = zero
+    mx_eau_var(:) = zmaxh*mille*mcs(njsc(:)) 
+
+    DO ji = 1,kjpindex 
+       IF (vegtot(ji) .LE. zero) THEN
+          mx_eau_var(ji) = mx_eau_nobio*zmaxh
+          ! Aurelien: what does vegtot=0 mean? is it like frac_nobio=1? But if 0<frac_nobio<1 ???
+       ENDIF
+
+    END DO
+
+    ! Compute the litter humidity, shumdiag and fry
+    shumdiag_perma(:,:) = zero
+    humtot(:) = zero
+    tmc(:,:) = zero
+
+    ! Loop on soiltiles to compute the variables (ji,jst)
+    DO jst=1,nstm 
+       DO ji = 1, kjpindex
+          tmcs(ji,jst)=zmaxh* mille*mcs(njsc(ji))
+          tmcr(ji,jst)=zmaxh* mille*mcr(njsc(ji))
+       ENDDO
+    ENDDO
+       
+    ! The total soil moisture for each soiltile:
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          tmc(ji,jst)= dz(2) * ( trois*mc(ji,1,jst)+ mc(ji,2,jst))/huit
+       END DO
+    ENDDO
+
+    DO jst=1,nstm 
+       DO jsl=2,nslm-1
+          DO ji=1,kjpindex
+             tmc(ji,jst) = tmc(ji,jst) + dz(jsl) * ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1)*(trois*mc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
+          END DO
+       END DO
+    ENDDO
+
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          tmc(ji,jst) = tmc(ji,jst) +  dz(nslm) * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+          tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
+       ENDDO
+    END DO
+
+!JG: hydrol_tmc_update should not be called in the initialization phase. Call of hydrol_tmc_update makes the model restart differenlty.    
+!    ! If veget has been updated before restart (with LAND USE or DGVM),
+!    ! tmc and mc must be modified with respect to humtot conservation.
+!   CALL hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg)
+
+    ! The litter variables:
+    ! level 1
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          tmc_litter(ji,jst) = dz(2) * (trois*mc(ji,1,jst)+mc(ji,2,jst))/huit
+          tmc_litter_wilt(ji,jst) = dz(2) * mcw(njsc(ji)) / deux
+          tmc_litter_res(ji,jst) = dz(2) * mcr(njsc(ji)) / deux
+          tmc_litter_field(ji,jst) = dz(2) * mcf(njsc(ji)) / deux
+          tmc_litter_sat(ji,jst) = dz(2) * mcs(njsc(ji)) / deux
+          tmc_litter_awet(ji,jst) = dz(2) * mc_awet(njsc(ji)) / deux
+          tmc_litter_adry(ji,jst) = dz(2) * mc_adry(njsc(ji)) / deux
+       ENDDO
+    END DO
+    ! sum from level 2 to 4
+    DO jst=1,nstm 
+       DO jsl=2,4
+          DO ji=1,kjpindex
+             tmc_litter(ji,jst) = tmc_litter(ji,jst) + dz(jsl) * & 
+                  & ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1)*(trois*mc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
+             tmc_litter_wilt(ji,jst) = tmc_litter_wilt(ji,jst) + &
+                  &(dz(jsl)+ dz(jsl+1))*& 
+                  & mcw(njsc(ji))/deux
+             tmc_litter_res(ji,jst) = tmc_litter_res(ji,jst) + &
+                  &(dz(jsl)+ dz(jsl+1))*& 
+                  & mcr(njsc(ji))/deux
+             tmc_litter_sat(ji,jst) = tmc_litter_sat(ji,jst) + &
+                  &(dz(jsl)+ dz(jsl+1))* & 
+                  & mcs(njsc(ji))/deux
+             tmc_litter_field(ji,jst) = tmc_litter_field(ji,jst) + &
+                  & (dz(jsl)+ dz(jsl+1))* & 
+                  & mcf(njsc(ji))/deux
+             tmc_litter_awet(ji,jst) = tmc_litter_awet(ji,jst) + &
+                  &(dz(jsl)+ dz(jsl+1))* & 
+                  & mc_awet(njsc(ji))/deux
+             tmc_litter_adry(ji,jst) = tmc_litter_adry(ji,jst) + &
+                  & (dz(jsl)+ dz(jsl+1))* & 
+                  & mc_adry(njsc(ji))/deux
+          END DO
+       END DO
+    END DO
+
+    ! Soil wetness profiles (W-Ww)/(Ws-Ww)
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          soil_wet(ji,1,jst) = MIN(un, MAX(zero,&
+               &(trois*mc(ji,1,jst) + mc(ji,2,jst) - quatre*mcw(njsc(ji)))&
+               & /(quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+          ! here we set that humrelv=0 in PFT1
+          humrelv(ji,1,jst) = zero
+       ENDDO
+    END DO
+
+    DO jst=1,nstm 
+       DO jsl=2,nslm-1
+          DO ji=1,kjpindex
+             soil_wet(ji,jsl,jst) = MIN(un, MAX(zero,&
+                  & (trois*mc(ji,jsl,jst) + & 
+                  & mc(ji,jsl-1,jst) *(dz(jsl)/(dz(jsl)+dz(jsl+1))) &
+                  & + mc(ji,jsl+1,jst)*(dz(jsl+1)/(dz(jsl)+dz(jsl+1))) &
+                  & - quatre*mcw(njsc(ji))) / (quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+          END DO
+       END DO
+    END DO
+
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          soil_wet(ji,nslm,jst) = MIN(un, MAX(zero,&
+               & (trois*mc(ji,nslm,jst) &
+               & + mc(ji,nslm-1,jst)-quatre*mcw(njsc(ji)))/(quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+       ENDDO
+    END DO
+
+    ! Calculate frac_hydro_diag for interpolation between hydrological and diagnostic axes
+    CALL hydrol_calculate_frac_hydro_diag
+
+    ! Calculate shumdiag_perma (at diagnostic levels)
+    ! Use resdist instead of soiltile because we here need to have 
+    ! shumdiag_perma at the value from previous time step.
+    ! Here, soilmoist is only used as a temporary variable to calculate shumdiag_perma
+    ! (based on resdist=soiltile from previous timestep, but normally equal to soiltile)
+    ! For consistency with hydrol_soil, we want to calculate a grid-cell average
+    soilmoist(:,:) = zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          soilmoist(ji,1) = soilmoist(ji,1) + resdist(ji,jst) * &
+               dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+          DO jsl = 2,nslm-1
+             soilmoist(ji,jsl) = soilmoist(ji,jsl) + resdist(ji,jst) * &
+                  ( dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit )
+          END DO
+          soilmoist(ji,nslm) = soilmoist(ji,nslm) + resdist(ji,jst) * &
+               dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+       ENDDO
+    ENDDO
+    DO ji=1,kjpindex
+        soilmoist(ji,:) = soilmoist(ji,:) * vegtot_old(ji) ! grid cell average 
+    ENDDO
+    
+    ! -- shumdiag_perma for restart
+    !  For consistency with hydrol_soil, we want to calculate a grid-cell average
+    DO jd=1,nbdl
+       DO ji=1,kjpindex        
+          DO jsl = 1, nslm
+             shumdiag_perma(ji,jd) = soilmoist(ji,jsl)*frac_hydro_diag(jsl,jd) &
+                  /(dh(jsl)*mcs(njsc(ji)))
+          ENDDO
+          shumdiag_perma(ji,jd) = MAX(MIN(shumdiag_perma(ji,jd), un), zero) 
+       ENDDO
+    ENDDO
+               
+    ! Calculate drysoil_frac if it was not found in the restart file
+    ! For simplicity, we set drysoil_frac to 0.5 in this case
+    IF (ALL(drysoil_frac(:) == val_exp)) THEN
+       DO ji=1,kjpindex
+          drysoil_frac(ji) = 0.5
+       END DO
+    END IF
+
+    !! Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in 
+    !! thermosoil for the thermal conductivity. Calculate also total soil moisture content(tmc_layh) 
+    !! needed in thermosoil for the heat capacity.
+    ! These values are only used in thermosoil_init in absence of a restart file
+    ! For this case, we calculate them based on mc and mcl from the restart files,
+    ! and vegtot and soiltile which correspond to the new vegetation map
+    ! This creates a little inconsistency (since mc corresponds to the previous vegetation map)
+    ! but it's not important since it's just when we start from scratch
+    !! The multiplication by vegtot creates grid-cell average values *** to be checked for consistency with thermosoil
+    mc_layh(:,:) = zero
+    mcl_layh(:,:) = zero
+    tmc_layh(:,:) = zero
+    DO jst=1,nstm
+      DO ji=1,kjpindex
+         DO jsl=1,nslm
+            mc_layh(ji,jsl) = mc_layh(ji,jsl) + mc(ji,jsl,jst) * soiltile(ji,jst)  * vegtot(ji)
+            mcl_layh(ji,jsl) = mcl_layh(ji,jsl) + mcl(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
+         ENDDO
+         tmc_layh_s(ji,1,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit 
+         DO jsl = 2,nslm-1
+            tmc_layh_s(ji,jsl,jst) = dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit 
+         ENDDO
+         tmc_layh_s(ji,nslm,jst) = dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+         DO jsl = 1,nslm
+            tmc_layh(ji,jsl) = tmc_layh(ji,jsl) + tmc_layh_s(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
+         ENDDO
+      END DO
+    END DO
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_var_init done '
+
+  END SUBROUTINE hydrol_var_init
+
+
+   
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_canop
+!!
+!>\BRIEF        This routine computes canopy processes.
+!!
+!! DESCRIPTION  :
+!! - 1 evaporation off the continents
+!! - 1.1 The interception loss is take off the canopy. 
+!! - 1.2 precip_rain is shared for each vegetation type
+!! - 1.3 Limits the effect and sum what receives soil
+!! - 1.4 swap qsintveg to the new value
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_canop
+
+  SUBROUTINE hydrol_canop (kjpindex, precip_rain, vevapwet, veget_max, veget, qsintmax, &
+       & qsintveg,precisol,tot_melt)
+
+    ! 
+    ! interface description
+    !
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex    !! Domain size
+    ! input fields
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_rain !! Rain precipitation
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: vevapwet    !! Interception loss
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: veget_max   !! max fraction of vegetation type
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: veget       !! Fraction of vegetation type 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: qsintmax    !! Maximum water on vegetation for interception
+    REAL(r_std), DIMENSION  (kjpindex), INTENT (in)          :: tot_melt    !! Total melt
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)       :: precisol    !! Water fallen onto the ground (throughfall)
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: qsintveg    !! Water on vegetation due to interception
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jv
+    REAL(r_std), DIMENSION (kjpindex,nvm)                    :: zqsintvegnew
+
+!_ ================================================================================================================================
+
+    ! boucle sur les points continentaux
+    ! calcul de qsintveg au pas de temps suivant
+    ! par ajout du flux interception loss
+    ! calcule par enerbil en fonction
+    ! des calculs faits dans diffuco
+    ! calcul de ce qui tombe sur le sol
+    ! avec accumulation dans precisol
+    ! essayer d'harmoniser le traitement du sol nu
+    ! avec celui des differents types de vegetation
+    ! fait si on impose qsintmax ( ,1) = 0.0
+    !
+    ! loop for continental subdomain
+    !
+    !
+    !! 1 evaporation off the continents
+    !
+    !! 1.1 The interception loss is take off the canopy. 
+    DO jv=2,nvm
+       qsintveg(:,jv) = qsintveg(:,jv) - vevapwet(:,jv)
+    END DO
+
+    !     It is raining :
+    !! 1.2 precip_rain is shared for each vegetation type
+    !
+    qsintveg(:,1) = zero
+    DO jv=2,nvm
+       qsintveg(:,jv) = qsintveg(:,jv) + veget(:,jv) * ((1-throughfall_by_pft(jv))*precip_rain(:))
+    END DO
+
+    !
+    !! 1.3 Limits the effect and sum what receives soil
+    !
+    precisol(:,1)=veget_max(:,1)*precip_rain(:)
+    DO jv=2,nvm
+       DO ji = 1, kjpindex
+          zqsintvegnew(ji,jv) = MIN (qsintveg(ji,jv),qsintmax(ji,jv)) 
+          precisol(ji,jv) = (veget(ji,jv)*throughfall_by_pft(jv)*precip_rain(ji)) + &
+               qsintveg(ji,jv) - zqsintvegnew (ji,jv) + &
+               (veget_max(ji,jv) - veget(ji,jv))*precip_rain(ji)
+       ENDDO
+    END DO
+    !    
+    DO jv=1,nvm
+       DO ji = 1, kjpindex
+          IF (vegtot(ji).GT.min_sechiba) THEN
+             precisol(ji,jv) = precisol(ji,jv)+tot_melt(ji)*veget_max(ji,jv)/vegtot(ji)
+          ENDIF
+       ENDDO
+    END DO
+    !   
+    !
+    !! 1.4 swap qsintveg to the new value
+    !
+    DO jv=2,nvm
+       qsintveg(:,jv) = zqsintvegnew (:,jv)
+    END DO
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_canop done '
+
+  END SUBROUTINE hydrol_canop
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_vegupd
+!!
+!>\BRIEF        Vegetation update   
+!!
+!! DESCRIPTION  :
+!!   The vegetation cover has changed and we need to adapt the reservoir distribution 
+!!   and the distribution of plants on different soil types.
+!!   You may note that this occurs after evaporation and so on have been computed. It is
+!!   not a problem as a new vegetation fraction will start with humrel=0 and thus will have no
+!!   evaporation. If this is not the case it should have been caught above.
+!!
+!! - 1 Update of vegetation is it needed?
+!! - 2 calculate water mass that we have to redistribute
+!! - 3 put it into reservoir of plant whose surface area has grown
+!! - 4 Soil tile gestion
+!! - 5 update the corresponding masks
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_vegupd
+
+  SUBROUTINE hydrol_vegupd(kjpindex, veget, veget_max, soiltile, qsintveg, frac_bare, drain_upd, runoff_upd)
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex 
+    ! input fields
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in)    :: veget            !! New vegetation map
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)     :: veget_max        !! Max. fraction of vegetation type
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)   :: soiltile         !! Fraction of each soil tile within vegtot (0-1, unitless)
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)    :: frac_bare        !! Fraction(of veget_max) of bare soil
+                                                                              !! in each vegetation type
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: drain_upd        !! Change in drainage due to decrease in vegtot
+                                                                              !! on mc [kg/m2/dt]
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: runoff_upd       !! Change in runoff due to decrease in vegtot
+                                                                              !! on water2infilt[kg/m2/dt]
+    
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)  :: qsintveg         !! Water on old vegetation 
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                 :: ji,jv,jst
+
+!_ ================================================================================================================================
+
+    !! 1 If veget has been updated at last time step (with LAND USE or DGVM),
+    !! tmc and mc must be modified with respect to humtot conservation.
+    CALL hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, drain_upd, runoff_upd)
+
+    ! Compute the masks for veget
+    
+    mask_veget(:,:) = 0
+    mask_soiltile(:,:) = 0
+    
+    DO jst=1,nstm
+       DO ji = 1, kjpindex
+          IF(soiltile(ji,jst) .GT. min_sechiba) THEN
+             mask_soiltile(ji,jst) = 1
+          ENDIF
+       END DO
+    ENDDO
+          
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          IF(veget_max(ji,jv) .GT. min_sechiba) THEN
+             mask_veget(ji,jv) = 1
+          ENDIF
+       END DO
+    END DO
+
+    ! Compute vegetmax_soil 
+    vegetmax_soil(:,:,:) = zero
+    DO jv = 1, nvm
+       jst = pref_soil_veg(jv)
+       DO ji=1,kjpindex
+          ! for veget distribution used in sechiba via humrel
+          IF (mask_soiltile(ji,jst).GT.0 .AND. vegtot(ji) > min_sechiba) THEN
+             vegetmax_soil(ji,jv,jst)=veget_max(ji,jv)/soiltile(ji,jst)
+          ENDIF
+       ENDDO
+    ENDDO
+
+    ! Calculate frac_bare (previosly done in slowproc_veget)
+    DO ji =1, kjpindex
+       IF( veget_max(ji,1) .GT. min_sechiba ) THEN
+          frac_bare(ji,1) = un
+       ELSE
+          frac_bare(ji,1) = zero
+       ENDIF
+    ENDDO
+    DO jv = 2, nvm
+       DO ji =1, kjpindex
+          IF( veget_max(ji,jv) .GT. min_sechiba ) THEN
+             frac_bare(ji,jv) = un - veget(ji,jv)/veget_max(ji,jv)
+          ELSE
+             frac_bare(ji,jv) = zero
+          ENDIF
+       ENDDO
+    ENDDO
+
+    ! Tout dans cette routine est maintenant certainement obsolete (veget_max etant constant) en dehors des lignes 
+    ! suivantes et le calcul de frac_bare:
+    frac_bare_ns(:,:) = zero
+    DO jst = 1, nstm
+       DO jv = 1, nvm
+          DO ji =1, kjpindex
+             IF(vegtot(ji) .GT. min_sechiba) THEN
+                frac_bare_ns(ji,jst) = frac_bare_ns(ji,jst) + vegetmax_soil(ji,jv,jst) * frac_bare(ji,jv) / vegtot(ji)
+             ENDIF
+          END DO
+       ENDDO
+    END DO
+    
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_vegupd done '
+
+  END SUBROUTINE hydrol_vegupd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_flood
+!!
+!>\BRIEF        This routine computes the evolution of the surface reservoir (floodplain).  
+!!
+!! DESCRIPTION  :
+!! - 1 Take out vevapflo from the reservoir and transfer the remaining to subsinksoil
+!! - 2 Compute the total flux from floodplain floodout (transfered to routing)
+!! - 3 Discriminate between precip over land and over floodplain
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_flood
+
+  SUBROUTINE hydrol_flood (kjpindex, vevapflo, flood_frac, flood_res, floodout)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex         !!
+    ! input fields
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: flood_frac       !! Fraction of floodplains in grid box
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: floodout         !! Flux to take out from floodplains
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: flood_res        !! Floodplains reservoir estimate
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapflo         !! Evaporation over floodplains
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jv           !! Indices
+    REAL(r_std), DIMENSION (kjpindex)                        :: temp             !! 
+
+!_ ================================================================================================================================
+    !- 
+    !! 1 Take out vevapflo from the reservoir and transfer the remaining to subsinksoil 
+    !-
+    DO ji = 1,kjpindex
+       temp(ji) = MIN(flood_res(ji), vevapflo(ji))
+    ENDDO
+    DO ji = 1,kjpindex
+       flood_res(ji) = flood_res(ji) - temp(ji)
+       subsinksoil(ji) = subsinksoil(ji) + vevapflo(ji) - temp(ji)
+       vevapflo(ji) = temp(ji)
+    ENDDO
+
+    !- 
+    !! 2 Compute the total flux from floodplain floodout (transfered to routing) 
+    !-
+    DO ji = 1,kjpindex
+       floodout(ji) = vevapflo(ji) - flood_frac(ji) * SUM(precisol(ji,:))
+    ENDDO
+
+    !-
+    !! 3 Discriminate between precip over land and over floodplain
+    !-
+    DO jv=1, nvm
+       DO ji = 1,kjpindex
+          precisol(ji,jv) = precisol(ji,jv) * (1 - flood_frac(ji))
+       ENDDO
+    ENDDO 
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_flood done'
+
+  END SUBROUTINE hydrol_flood
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_soil
+!!
+!>\BRIEF        This routine computes soil processes with CWRR scheme (Richards equation solved by finite differences).
+!! Note that the water fluxes are in kg/m2/dt_sechiba.
+!!
+!! DESCRIPTION  :
+!! 0. Initialisation, and split 2d variables to 3d variables, per soil tile
+!! -- START MAIN LOOP (prognostic loop to update mc and mcl) OVER SOILTILES
+!! 1. FIRSTLY, WE CHANGE MC BASED ON EXTERNAL FLUXES, ALL APPLIED AT THE SOIL SURFACE
+!! 1.1 Reduces water2infilt and water2extract to their difference 
+!! 1.2 To remove water2extract (including bare soilevaporation) from top layer
+!! 1.3 Infiltration
+!! 1.4 Reinfiltration of surface runoff : compute temporary surface water and extract from runoff
+!! 2. SECONDLY, WE UPDATE MC FROM DIFFUSION, INCLUDING DRAINAGE AND ROOTSINK
+!!    This will act on mcl (liquid water content) only
+!! 2.1 K and D are recomputed after infiltration
+!! 2.2 Set the tridiagonal matrix coefficients for the diffusion/redistribution scheme
+!! 2.3 We define mcl (liquid water content) based on mc and profil_froz_hydro_ns
+!! 2.4 We calculate the total SM at the beginning of the routine tridiag for water conservation check
+!! 2.5 Defining where diffusion is solved : everywhere
+!! 2.6 We define the system of linear equations for mcl redistribution
+!! 2.7 Solves diffusion equations
+!! 2.8 Computes drainage = bottom boundary condition, consistent with rhs(ji,jsl=nslm)
+!! 2.9 For water conservation check during redistribution, we calculate the total liquid SM
+!!     at the end of the routine tridiag, and we compare the difference with the flux...
+!! 3. AFTER DIFFUSION/REDISTRIBUTION
+!! 3.1 Updating mc, as all the following checks against saturation will compare mc to mcs
+!! 3.2 Correct here the possible over-saturation values (subroutine hydrol_soil_smooth_over_mcs2 acts on mc)
+!!     Here hydrol_soil_smooth_over_mcs2 discard all excess as ru_corr_ns, oriented to either ru_ns or dr_ns
+!! 3.3 Negative runoff is reported to drainage
+!! 3.4 Optional block to force saturation below zwt_force
+!! 3.5 Diagnosing the effective water table depth
+!! 3.6 Diagnose under_mcr to adapt water stress calculation below
+!! 4. At the end of the prognostic calculations, we recompute important moisture variables
+!! 4.1 Total soil moisture content (water2infilt added below)
+!! 4.2 mcl is a module variable; we update it here for calculating bare soil evaporation,
+!! 5. Optional check of the water balance of soil column (if check_cwrr)
+!! 5.1 Computation of the vertical water fluxes
+!! 6. SM DIAGNOSTICS FOR OTHER ROUTINES, MODULES, OR NEXT STEP
+!! 6.1 Total soil moisture, soil moisture at litter levels, soil wetness, us, humrelv, vesgtressv
+!! 6.2 We need to turn off evaporation when is_under_mcr
+!! 6.3 Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in thermosoil
+!! 6.4 The hydraulic conductivities exported here are the ones used in the diffusion/redistribution
+!! -- ENDING THE MAIN LOOP ON SOILTILES
+!! 7. Summing 3d variables into 2d variables
+!! 8. XIOS export of local variables, including water conservation checks
+!! 9. COMPUTING EVAP_BARE_LIM_NS FOR NEXT TIME STEP, WITH A LOOP ON SOILTILES
+!!    The principle is to run a dummy integration of the water redistribution scheme
+!!    to check if the SM profile can sustain a potential evaporation.
+!!    If not, the dummy integration is redone from the SM profile of the end of the normal integration,
+!!    with a boundary condition leading to a very severe water limitation: mc(1)=mcr
+!! 10. evap_bar_lim is the grid-cell scale beta
+!!
+!! RECENT CHANGE(S) : 2016 by A. Ducharne
+!!                    2017 by A. S. LansÃž, implementing the soil to root
+!!                    resistance developed for ORCHIDEE by Emilie Joetzjer. Ref: Williams et al.,
+!!                    2001(TreePhys) and Duursma et al., 2012 (GMD)  
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil
+
+  SUBROUTINE hydrol_soil (kjpindex, veget_max, soiltile, njsc, reinf_slope, &
+       & transpir, vevapnu, evapot, evapot_penm, runoff, drainage, &
+       & returnflow, reinfiltration, irrigation, &
+       & tot_melt, evap_bare_lim, shumdiag, shumdiag_perma,&
+       & k_litt, litterhumdiag, humrel,vegstress, drysoil_frac, &
+       & stempdiag,snow, &
+       & snowdz, tot_bare_soil, u, v, tq_cdrag, mc_layh, mcl_layh, tmc_layh, &
+       & swc, ksave,  e_frac)
+    ! 
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)       :: veget_max        !! Map of max vegetation types [-]
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: njsc             !! Index of the dominant soil textural class 
+                                                                                 !!   in the grid cell (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltile         !! Fraction of each soil tile within vegtot (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: transpir         !! Transpiration  
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)           :: reinf_slope      !! Fraction of surface runoff that reinfiltrates
+                                                                                 !!  (unitless, [0-1])
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: returnflow       !! Water returning to the soil from the bottom
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: reinfiltration   !! Water returning to the top of the soil
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: irrigation       !! Irrigation
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evapot           !! Potential evaporation
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evapot_penm      !! Potential evaporation "Penman" (Milly's correction)
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: tot_melt         !! Total melt from snow and ice
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)       :: stempdiag        !! Diagnostic temp profile from thermosoil
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: snow             !! Snow mass
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex,nsnow),INTENT(in)       :: snowdz           !! Snow depth (m)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: tot_bare_soil    !! Total evaporating bare soil fraction 
+                                                                                 !!  (unitless, [0-1])
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)             :: u,v              !! Horizontal wind speed
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)             :: tq_cdrag         !! Surface drag coefficient (-)
+    REAL(r_std), DIMENSION(kjpindex,nvm,nbdl,nstm),INTENT(in):: e_frac           !! Fraction of water transpired supplied by individual layers (no units) 
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: runoff           !! Surface runoff
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: drainage         !! Drainage
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: evap_bare_lim    !! Limitation factor (beta) for bare soil evaporation  
+                                                                                 !! on each soil column (unitless, [0-1])
+    REAL(r_std), DIMENSION (kjpindex,nbdl), INTENT (out)     :: shumdiag         !! Relative soil moisture in each diag soil layer 
+                                                                                 !! with respect to (mcf-mcw) (unitless, [0-1])
+    REAL(r_std), DIMENSION (kjpindex,nbdl), INTENT (out)     :: shumdiag_perma   !! Percent of porosity filled with water (mc/mcs)
+                                                                                 !! in each diag soil layer (for the thermal computations)
+                                                                                 !! (unitless, [0-1])
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: k_litt           !! Litter approximated hydraulic conductivity
+                                                                                 !!  @tex $(mm d^{-1})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: litterhumdiag    !! Mean of soil_wet_litter across soil tiles
+                                                                                 !! (unitless, [0-1])
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out)      :: vegstress        !! Veg. moisture stress (only for vegetation 
+                                                                                 !! growth) (unitless, [0-1])
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: drysoil_frac     !! Function of the litter humidity
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out)     :: mc_layh          !! Volumetric water content (liquid + ice) for each soil layer
+                                                                                 !! averaged over the mesh (for thermosoil)
+                                                                                 !!  @tex $(m^{3} m^{-3})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out)     :: mcl_layh         !! Volumetric liquid water content for each soil layer 
+                                                                                 !! averaged over the mesh (for thermosoil)
+                                                                                 !!  @tex $(m^{3} m^{-3})$ @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out)     :: tmc_layh         !! Soil moisture (liquid + ice) for soil each layer 
+                                                                                 !! averaged over the mesh (for thermosoil)
+                                                                                 !!  @tex $(m^{3} m^{-3})$ @endtex 
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)           :: vevapnu        !! Bare soil evaporation
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (inout)      :: humrel         !! Relative humidity (0-1, dimensionless)
+    REAL(r_std), DIMENSION (kjpindex,nslm,nstm), INTENT(inout) :: swc            !! Soilwater content (a copy of mc)
+    REAL(r_std), DIMENSION (kjpindex,nslm,nstm), INTENT(inout) :: ksave          !! Soil conductivity (a copy of k for each soil type)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                 :: ji, jv, jsl, jst, ivm      !! Indices
+    REAL(r_std), PARAMETER                         :: frac_mcs = 0.66            !! Temporary depth
+    REAL(r_std), DIMENSION(kjpindex)               :: temp                       !! Temporary value for fluxes
+    REAL(r_std), DIMENSION(kjpindex)               :: tmcold                     !! Total SM at beginning of hydrol_soil (kg/m2)
+    REAL(r_std), DIMENSION(kjpindex)               :: tmcint                     !! Ancillary total SM (kg/m2)
+    REAL(r_std), DIMENSION(kjpindex,nslm)          :: mcint                      !! To save mc values for future use
+    REAL(r_std), DIMENSION(kjpindex,nslm)          :: mclint                     !! To save mcl values for future use
+    LOGICAL, DIMENSION(kjpindex,nstm)              :: is_under_mcr               !! Identifies under residual soil moisture points
+    LOGICAL, DIMENSION(kjpindex)                   :: is_over_mcs                !! Identifies over saturated soil moisture points 
+    REAL(r_std), DIMENSION(kjpindex)               :: deltahum,diff              !!
+    LOGICAL(r_std), DIMENSION(kjpindex)            :: test                       !!
+    REAL(r_std), DIMENSION(kjpindex)               :: water2extract              !! Water flux to be extracted at the soil surface
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: returnflow_soil            !! Water from the routing back to the bottom of 
+                                                                                 !! the soil @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: reinfiltration_soil        !! Water from the routing back to the top of the 
+                                                                                 !! soil @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: irrigation_soil            !! Water from irrigation returning to soil moisture 
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: flux_infilt                !! Water to infiltrate
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: flux_bottom                !! Flux at bottom of the soil column
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: flux_top                   !! Flux at top of the soil column (for bare soil evap)
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: qinfilt_ns                 !! Effective infiltration flux per soil tile
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex   
+    REAL(r_std), DIMENSION (kjpindex)              :: qinfilt                    !! Effective infiltration flux  
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: ru_infilt_ns               !! Surface runoff from hydrol_soil_infilt per soil tile
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex   
+    REAL(r_std), DIMENSION (kjpindex)              :: ru_infilt                  !! Surface runoff from hydrol_soil_infilt 
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: ru_corr_ns                 !! Surface runoff produced to correct excess per soil tile
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex)              :: ru_corr                    !! Surface runoff produced to correct excess 
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex  
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: ru_corr2_ns                !! Correction of negative surface runoff per soil tile
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex)              :: ru_corr2                   !! Correction of negative surface runoff
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: dr_corr_ns                 !! Drainage produced to correct excess
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: dr_corrnum_ns              !! Drainage produced to correct numerical errors in tridiag
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex    
+    REAL(r_std), DIMENSION (kjpindex)              :: dr_corr                    !! Drainage produced to correct excess 
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex)              :: dr_corrnum                 !! Drainage produced to correct numerical errors in tridiag
+                                                                                 !!  @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex,nslm)         :: dmc                        !! Delta mc when forcing saturation (zwt_force) 
+                                                                                 !!  @tex $(m^{3} m^{-3})$ @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: dr_force_ns                !! Delta drainage when forcing saturation (zwt_force) 
+                                                                                 !!  per soil tile  @tex $(kg m^{-2})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex)              :: dr_force                   !! Delta drainage when forcing saturation (zwt_force)
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex  
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: wtd_ns                     !! Effective water table depth (m)
+    REAL(r_std), DIMENSION (kjpindex)              :: wtd                        !! Mean water table depth in the grid-cell (m)
+    REAL(r_std), DIMENSION (kjpindex,nslm,nstm)    :: tmc_layh_ns                !! Soil moisture content forin  each soil layer
+                                                                                 !! and each soiltile
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex
+
+    ! For the calculation of soil_wet and us/humrel/vegstress 
+    REAL(r_std), DIMENSION (kjpindex,nslm)         :: sm                         !! Soil moisture of each layer
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex,nslm)         :: smw                        !! Soil moisture of each layer at wilting point
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nslm)         :: smf                        !! Soil moisture of each layer at field capacity
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex   
+    REAL(r_std), DIMENSION (kjpindex,nslm)         :: sms                        !! Soil moisture of each layer at saturation
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nslm)         :: sm_nostress                !! Soil moisture of each layer at which us reaches 1
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex 
+    ! For water conservation checks (in mm/dtstep unless otherwise mentioned)
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: check_infilt_ns             !! Water conservation diagnostic at routine scale
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: check1_ns                   !! Water conservation diagnostic at routine scale
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: check_tr_ns                 !! Water conservation diagnostic at routine scale
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: check_over_ns               !! Water conservation diagnostic at routine scale
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: check_under_ns              !! Water conservation diagnostic at routine scale
+    REAL(r_std), DIMENSION(kjpindex)               :: tmci                        !! Total soil moisture at beginning of routine (kg/m2)
+    REAL(r_std), DIMENSION(kjpindex)               :: tmcf                        !! Total soil moisture at end of routine (kg/m2)
+    REAL(r_std), DIMENSION(kjpindex)               :: diag_tr                     !! Transpiration flux
+    REAL(r_std), DIMENSION (kjpindex)              :: check_infilt                !! Water conservation diagnostic at routine scale 
+    REAL(r_std), DIMENSION (kjpindex)              :: check1                      !! Water conservation diagnostic at routine scale 
+    REAL(r_std), DIMENSION (kjpindex)              :: check_tr                    !! Water conservation diagnostic at routine scale 
+    REAL(r_std), DIMENSION (kjpindex)              :: check_over                  !! Water conservation diagnostic at routine scale 
+    REAL(r_std), DIMENSION (kjpindex)              :: check_under                 !! Water conservation diagnostic at routine scale
+    ! Diagnostic of the vertical soil water fluxes   
+    REAL(r_std), DIMENSION (kjpindex,nslm)         :: qflux                       !! Local upward flux into soil layer  
+                                                                                  !! from lower interface 
+                                                                                  !!  @tex $(kg m^{-2})$ @endtex  
+    REAL(r_std), DIMENSION (kjpindex)              :: check_top                   !! Water budget residu in top soil layer 
+                                                                                  !!  @tex $(kg m^{-2})$ @endtex  
+
+
+    ! Variables for calculation of a soil resistance, option do_rsoil (following the formulation of Sellers et al 1992, implemented in Oleson et al. 2008)
+    REAL(r_std)                                    :: speed                       !! magnitude of wind speed required for Aerodynamic resistance
+    REAL(r_std)                                    :: ra                          !! diagnosed aerodynamic resistance
+    REAL(r_std), DIMENSION(kjpindex)               :: mc_rel                      !! first layer relative soil moisture, required for rsoil
+    REAL(r_std), DIMENSION(kjpindex)               :: evap_soil                   !! soil evaporation from Oleson et al 2008
+    REAL(r_std), DIMENSION(kjpindex,nstm)          :: r_soil_ns                   !! soil resistance from Oleson et al 2008
+    REAL(r_std), DIMENSION(kjpindex)               :: r_soil                      !! soil resistance from Oleson et al 2008
+    REAL(r_std), DIMENSION(kjpindex)               :: tmcs_litter                 !! Saturated soil moisture in the 4 "litter" soil layers
+    REAL(r_std), DIMENSION (nslm)                  :: nroot_tmp                   !! Temporary variable to calculate the nroot
+
+!_ ================================================================================================================================
+
+    !! 0.1 Arrays with DIMENSION(kjpindex)
+    
+    returnflow_soil(:) = zero
+    reinfiltration_soil(:) = zero
+    irrigation_soil(:) = zero
+    qflux_ns(:,:,:) = zero
+    mc_layh(:,:) = zero ! for thermosoil
+    mcl_layh(:,:) = zero ! for thermosoil
+    tmc_layh(:,:) = zero ! for thermosoil
+    tmc_layh_ns(:,:,:) = zero
+    IF (ok_freeze_cwrr) THEN
+       kk(:,:,:)=zero
+       kk_moy(:,:)=zero
+    ENDIF
+    undermcr(:) = zero ! needs to be initialized outside from jst loop
+
+    IF (ok_freeze_cwrr) THEN
+       
+       ! 0.1 Calculate the temperature and fozen fraction at the hydrological levels
+       
+       ! AD16*** This subroutine could probably be simplified massively given
+       ! that hydro and T share the same vertical discretization 
+       ! Here stempdiag is in from thermosoil and temp_hydro is out
+       CALL hydrol_calculate_temp_hydro(kjpindex, stempdiag, snow,snowdz)
+       
+       ! Calculates profil_froz_hydro_ns as a function of temp_hydro, and mc if ok_thermodynamical_freezing
+       ! These values will be kept till the end of the prognostic loop
+       DO jst=1,nstm
+          CALL hydrol_soil_froz(kjpindex,jst,njsc)
+       ENDDO
+
+    ELSE
+  
+       profil_froz_hydro_ns(:,:,:) = zero
+             
+    ENDIF
+    
+    !! 0.2 Split 2d variables to 3d variables, per soil tile
+    !  Here, the evaporative fluxes are distributed over the soiltiles as a function of the 
+    !  corresponding control factors; they are normalized to vegtot
+    !  At step 7, the reverse transformation is used for the fluxes produced in hydrol_soil
+    !  flux_cell(ji)=sum(flux_ns(ji,jst)*soiltile(ji,jst)*vegtot(ji))
+
+    IF(ok_hydrol_arch)THEN
+
+       CALL hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir,humrel, evap_bare_lim, tot_bare_soil, e_frac)
+
+    ELSE 
+
+       CALL hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel, evap_bare_lim, tot_bare_soil)
+
+    ENDIF ! (ok_hydrol_arch)   
+
+
+    !! 0.3 Common variables related to routing, with all return flow applied to the soil surface
+    ! The fluxes coming from the routing are uniformly splitted into the soiltiles,
+    !    but are normalized to vegtot like the above fluxes: 
+    !            flux_ns(ji,jst)=flux_cell(ji)/vegtot(ji)
+    ! It is the case for : irrigation_soil(ji) and reinfiltration_soil(ji) cf below
+    ! It is also the case for subsinksoil(ji), which is divided by (1-tot_frac_nobio) at creation in hydrol_snow
+    ! AD16*** The transformation in 0.2 and 0.3 is likely to induce conservation problems
+    !         when tot_frac_nobio NE 0, since sum(soiltile) NE vegtot in this case
+    
+    DO ji=1,kjpindex
+       IF(vegtot(ji).GT.min_sechiba) THEN
+          ! returnflow_soil is assumed to enter from the bottom, but it is not possible with CWRR
+          returnflow_soil(ji) = zero
+          reinfiltration_soil(ji) = (returnflow(ji) + reinfiltration(ji))/vegtot(ji)
+          irrigation_soil(ji) = irrigation(ji)/vegtot(ji)
+       ELSE
+          returnflow_soil(ji) = zero
+          reinfiltration_soil(ji) = zero
+          irrigation_soil(ji) = zero
+       ENDIF
+    ENDDO       
+    
+    !! -- START MAIN LOOP (prognostic loop to update mc and mcl) OVER SOILTILES
+    !!    The called subroutines work on arrays with DIMENSION(kjpindex),
+    !!    recursively used for each soiltile jst
+    
+    DO jst = 1,nstm
+
+       is_under_mcr(:,jst) = .FALSE.
+       is_over_mcs(:) = .FALSE.
+       
+       !! 0.4. Keep initial values for future check-up
+       
+       ! Total moisture content (including water2infilt) is saved for balance checks at the end
+       ! In hydrol_tmc_update, tmc is increased by water2infilt(ji,jst), but mc is not modified !
+       tmcold(:) = tmc(:,jst)
+       
+       ! The value of mc is kept in mcint (nstm dimension removed), in case needed for water balance checks 
+       DO jsl = 1, nslm
+          DO ji = 1, kjpindex
+             mcint(ji,jsl) = mask_soiltile(ji,jst) * mc(ji,jsl,jst)
+          ENDDO
+       ENDDO
+       !
+       ! Initial total moisture content : tmcint does not include water2infilt, contrarily to tmcold
+       DO ji = 1, kjpindex
+          tmcint(ji) = dz(2) * ( trois*mcint(ji,1) + mcint(ji,2) )/huit 
+       ENDDO
+       DO jsl = 2,nslm-1
+          DO ji = 1, kjpindex
+             tmcint(ji) = tmcint(ji) + dz(jsl) &
+                  & * (trois*mcint(ji,jsl)+mcint(ji,jsl-1))/huit &
+                  & + dz(jsl+1) * (trois*mcint(ji,jsl)+mcint(ji,jsl+1))/huit
+          ENDDO
+       ENDDO
+       DO ji = 1, kjpindex
+          tmcint(ji) = tmcint(ji) + dz(nslm) &
+               & * (trois * mcint(ji,nslm) + mcint(ji,nslm-1))/huit
+       ENDDO
+
+       !! 1. FIRSTLY, WE CHANGE MC BASED ON EXTERNAL FLUXES, ALL APPLIED AT THE SOIL SURFACE
+       !!   Input = water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) + precisol_ns(ji,jst)
+       !!      - negative evaporation fluxes (MIN(ae_ns(ji,jst),zero)+ MIN(subsinksoil(ji),zero))
+       !!   Output = MAX(ae_ns(ji,jst),zero) + subsinksoil(ji) = positive evaporation flux = water2extract
+       ! In practice, negative subsinksoil(ji) is not possible 
+
+       !! 1.1 Reduces water2infilt and water2extract to their difference 
+
+       ! Compares water2infilt and water2extract to keep only difference
+       ! Here, temp is used as a temporary variable to store the min of water to infiltrate vs evaporate
+       DO ji = 1, kjpindex
+          temp(ji) = MIN(water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) &
+                         - MIN(ae_ns(ji,jst),zero) - MIN(subsinksoil(ji),zero) + precisol_ns(ji,jst), &
+                           MAX(ae_ns(ji,jst),zero) + MAX(subsinksoil(ji),zero) )
+       ENDDO
+
+       ! The water to infiltrate at the soil surface is either 0, or the difference to what has to be evaporated
+       !   - the initial water2infilt (right hand side) results from qsintveg changes with vegetation updates
+       !   - irrigation_soil is the input flux to the soil surface from irrigation 
+       !   - reinfiltration_soil is the input flux to the soil surface from routing 'including returnflow)
+       !   - eventually, water2infilt holds all fluxes to the soil surface except precisol (reduced by water2extract)
+       DO ji = 1, kjpindex
+          water2infilt(ji,jst) = water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) &
+                - MIN(ae_ns(ji,jst),zero) - MIN(subsinksoil(ji),zero) + precisol_ns(ji,jst) &
+                - temp(ji) 
+       ENDDO       
+             
+       ! The water to evaporate from the sol surface is either the difference to what has to be infiltrated, or 0
+       !   - subsinksoil is the residual from sublimation is the snowpack is not sufficient
+       !   - how are the negative values of ae_ns taken into account ??? 
+       DO ji = 1, kjpindex
+          water2extract(ji) =  MAX(ae_ns(ji,jst),zero) + MAX(subsinksoil(ji),zero) - temp(ji) 
+       ENDDO
+
+       ! Here we acknowledge that subsinksoil is part of ae_ns, but ae_ns is not used further
+       ae_ns(:,jst) = ae_ns(:,jst) + subsinksoil(:)  
+
+       !! 1.2 To remove water2extract (including bare soil) from top layer
+       flux_top(:) = water2extract(:)
+
+       !! 1.3 Infiltration
+
+       !! Definition of flux_infilt
+       DO ji = 1, kjpindex
+          ! Initialise the flux to be infiltrated  
+          flux_infilt(ji) = water2infilt(ji,jst) 
+       ENDDO
+       
+       !! K and D are computed for the profile of mc before infiltration
+       !! They depend on the fraction of soil ice, given by profil_froz_hydro_ns
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+
+       !! Infiltration and surface runoff are computed
+       !! Infiltration stems from comparing liquid water2infilt to initial total mc (liquid+ice)
+       !! The conductivity comes from hydrol_soil_coef and relates to the liquid phase only
+       !  This seems consistent with ok_freeze
+       CALL hydrol_soil_infilt(kjpindex, jst, njsc, flux_infilt, qinfilt_ns, ru_infilt_ns, &
+            check_infilt_ns)
+       ru_ns(:,jst) = ru_infilt_ns(:,jst) 
+
+       !! 1.4 Reinfiltration of surface runoff : compute temporary surface water and extract from runoff
+       ! Evrything here is liquid
+       ! RK: water2infilt is both a volume for future reinfiltration (in mm) and a correction term for surface runoff (in mm/dt_sechiba) 
+       IF ( .NOT. doponds ) THEN ! this is the general case...
+          DO ji = 1, kjpindex
+             water2infilt(ji,jst) = reinf_slope(ji) * ru_ns(ji,jst)
+          ENDDO
+       ELSE
+          DO ji = 1, kjpindex           
+             water2infilt(ji,jst) = zero
+          ENDDO
+       ENDIF
+       !
+       DO ji = 1, kjpindex           
+          ru_ns(ji,jst) = ru_ns(ji,jst) - water2infilt(ji,jst)
+       END DO
+
+       !! 2. SECONDLY, WE UPDATE MC FROM DIFFUSION, INCLUDING DRAINAGE AND ROOTSINK
+       !!    This will act on mcl only
+       
+       !! 2.1 K and D are recomputed after infiltration
+       !! They depend on the fraction of soil ice, still given by profil_froz_hydro_ns 
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+ 
+       !! 2.2 Set the tridiagonal matrix coefficients for the diffusion/redistribution scheme
+       !! This process will further act on mcl only, based on a, b, d from hydrol_soil_coef
+       CALL hydrol_soil_setup(kjpindex,jst)
+
+       !! 2.3 We define mcl (liquid water content) based on mc and profil_froz_hydro_ns 
+       DO jsl = 1, nslm
+          DO ji =1, kjpindex
+             mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(njsc(ji)) + &
+                  (un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
+             ! we always have mcl<=mc
+             ! if mc>mcr, then mcl>mcr; if mc=mcr,mcl=mcr; if mc<mcr, then mcl<mcr
+             ! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep mcl=mc
+          ENDDO
+       ENDDO
+
+       ! The value of mcl is kept in mclint (nstm dimension removed), used in the flux computation after diffusion
+       DO jsl = 1, nslm
+          DO ji = 1, kjpindex
+             mclint(ji,jsl) = mask_soiltile(ji,jst) * mcl(ji,jsl,jst)
+          ENDDO
+       ENDDO
+
+       !! 2.4 We calculate the total SM at the beginning of the routine tridiag for water conservation check
+       !  (on mcl only, since the diffusion only modifies mcl)
+       tmci(:) = dz(2) * ( trois*mcl(:,1,jst) + mcl(:,2,jst) )/huit
+       DO jsl = 2,nslm-1
+          tmci(:) = tmci(:) + dz(jsl) * (trois*mcl(:,jsl,jst)+mcl(:,jsl-1,jst))/huit &
+               + dz(jsl+1) * (trois*mcl(:,jsl,jst)+mcl(:,jsl+1,jst))/huit
+       ENDDO
+       tmci(:) = tmci(:) + dz(nslm) * (trois*mcl(:,nslm,jst) + mcl(:,nslm-1,jst))/huit
+
+       !! 2.5 Defining where diffusion is solved : everywhere
+       !! Since mc>mcs is not possible after infiltration, and we accept that mc<mcr
+       !! (corrected later by shutting off all evaporative fluxes in this case)
+       !  Nothing is done if resolv=F
+       resolv(:) = (mask_soiltile(:,jst) .GT. 0)
+
+       !! 2.6 We define the system of linear equations for mcl redistribution,
+       !! based on the matrix coefficients from hydrol_soil_setup
+       !! following the PhD thesis of de Rosnay (1999), p155-157
+       !! The bare soil evaporation (subtracted from infiltration) is used directly as flux_top
+       ! rhs for right-hand side term; fp for f'; gp for g'; ep for e'; with flux=0 !
+       
+       !- First layer
+       DO ji = 1, kjpindex
+          tmat(ji,1,1) = zero
+          tmat(ji,1,2) = f(ji,1)
+          tmat(ji,1,3) = g1(ji,1)
+          rhs(ji,1)    = fp(ji,1) * mcl(ji,1,jst) + gp(ji,1)*mcl(ji,2,jst) &
+               &  - flux_top(ji) - (b(ji,1)+b(ji,2))/deux *(dt_sechiba/one_day) - rootsink(ji,1,jst)
+       ENDDO
+       !- soil body
+       DO jsl=2, nslm-1
+          DO ji = 1, kjpindex
+             tmat(ji,jsl,1) = e(ji,jsl)
+             tmat(ji,jsl,2) = f(ji,jsl)
+             tmat(ji,jsl,3) = g1(ji,jsl)
+             rhs(ji,jsl) = ep(ji,jsl)*mcl(ji,jsl-1,jst) + fp(ji,jsl)*mcl(ji,jsl,jst) &
+                  & +  gp(ji,jsl) * mcl(ji,jsl+1,jst) & 
+                  & + (b(ji,jsl-1) - b(ji,jsl+1)) * (dt_sechiba/one_day) / deux & 
+                  & - rootsink(ji,jsl,jst) 
+          ENDDO
+       ENDDO       
+       !- Last layer, including drainage
+       DO ji = 1, kjpindex
+          jsl=nslm
+          tmat(ji,jsl,1) = e(ji,jsl)
+          tmat(ji,jsl,2) = f(ji,jsl)
+          tmat(ji,jsl,3) = zero
+          rhs(ji,jsl) = ep(ji,jsl)*mcl(ji,jsl-1,jst) + fp(ji,jsl)*mcl(ji,jsl,jst) &
+               & + (b(ji,jsl-1) + b(ji,jsl)*(un-deux*free_drain_coef(ji,jst))) * (dt_sechiba/one_day) / deux &
+               & - rootsink(ji,jsl,jst)
+       ENDDO
+       !- Store the equations in case needed again
+       DO jsl=1,nslm
+          DO ji = 1, kjpindex
+             srhs(ji,jsl) = rhs(ji,jsl)
+             stmat(ji,jsl,1) = tmat(ji,jsl,1)
+             stmat(ji,jsl,2) = tmat(ji,jsl,2)
+             stmat(ji,jsl,3) = tmat(ji,jsl,3) 
+          ENDDO
+       ENDDO
+       
+       !! 2.7 Solves diffusion equations, but only in grid-cells where resolv is true, i.e. everywhere (cf 2.2)
+       !!     The result is an updated mcl profile
+
+       CALL hydrol_soil_tridiag(kjpindex,jst)
+
+       !! 2.8 Computes drainage = bottom boundary condition, consistent with rhs(ji,jsl=nslm)
+       ! dr_ns in mm/dt_sechiba, from k in mm/d
+       ! This should be done where resolv=T, like tridiag (drainage is part of the linear system !)
+       DO ji = 1, kjpindex
+          IF (resolv(ji)) THEN
+             dr_ns(ji,jst) = mask_soiltile(ji,jst)*k(ji,nslm)*free_drain_coef(ji,jst) * (dt_sechiba/one_day)
+          ELSE
+             dr_ns(ji,jst) = zero
+          ENDIF
+       ENDDO
+
+       !! 2.9 For water conservation check during redistribution AND CORRECTION, 
+       !!     we calculate the total liquid SM at the end of the routine tridiag
+       tmcf(:) = dz(2) * ( trois*mcl(:,1,jst) + mcl(:,2,jst) )/huit
+       DO jsl = 2,nslm-1
+          tmcf(:) = tmcf(:) + dz(jsl) * (trois*mcl(:,jsl,jst)+mcl(:,jsl-1,jst))/huit &
+               + dz(jsl+1) * (trois*mcl(:,jsl,jst)+mcl(:,jsl+1,jst))/huit
+       ENDDO
+       tmcf(:) = tmcf(:) + dz(nslm) * (trois*mcl(:,nslm,jst) + mcl(:,nslm-1,jst))/huit
+          
+       !! And we compare the difference with the flux...
+       ! Normally, tcmf=tmci-flux_top(ji)-transpir-dr_ns
+       DO ji=1,kjpindex
+          diag_tr(ji)=SUM(rootsink(ji,:,jst))
+       ENDDO
+       ! Here, check_tr_ns holds the inaccuracy during the redistribution phase
+       check_tr_ns(:,jst) = tmcf(:)-(tmci(:)-flux_top(:)-dr_ns(:,jst)-diag_tr(:))
+
+       !! We solve here the numerical errors that happen when the soil is close to saturation
+       !! and drainage very high, and which lead to negative check_tr_ns: the soil dries more 
+       !! than what is demanded by the fluxes, so we need to increase the fluxes.
+       !! This is done by increasing the drainage.
+       !! There are also instances of positive check_tr_ns, larger when the drainage is high
+       !! They are similarly corrected by a decrease of dr_ns, in the limit of keeping a positive drainage.
+       DO ji=1,kjpindex
+          IF ( check_tr_ns(ji,jst) .LT. zero ) THEN
+              dr_corrnum_ns(ji,jst) = -check_tr_ns(ji,jst)
+          ELSE
+              dr_corrnum_ns(ji,jst) = -MIN(dr_ns(ji,jst),check_tr_ns(ji,jst))             
+          ENDIF
+          dr_ns(ji,jst) = dr_ns(ji,jst) + dr_corrnum_ns(ji,jst) ! dr_ns increases/decrease if check_tr negative/positive
+       ENDDO
+       !! For water conservation check during redistribution
+       IF (check_cwrr) THEN          
+          check_tr_ns(:,jst) = tmcf(:)-(tmci(:)-flux_top(:)-dr_ns(:,jst)-diag_tr(:)) 
+       ENDIF
+
+       !! 3. AFTER DIFFUSION/REDISTRIBUTION
+
+       !! 3.1 Updating mc, as all the following checks against saturation will compare mc to mcs
+       !      The frozen fraction is constant, so that any water flux to/from a layer changes
+       !      both mcl and the ice amount. The assumption behind this is that water entering/leaving
+       !      a soil layer immediately freezes/melts with the proportion profil_froz_hydro_ns/(1-profil_...)
+       DO jsl = 1, nslm
+          DO ji =1, kjpindex
+             mc(ji,jsl,jst) = MAX( mcl(ji,jsl,jst), mcl(ji,jsl,jst) + &
+                  profil_froz_hydro_ns(ji,jsl,jst)*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
+             ! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we get mc=mcl
+          ENDDO
+       ENDDO
+
+       !! 3.2 Correct here the possible over-saturation values (subroutine hydrol_soil_smooth_over_mcs2 acts on mc)
+       !    Oversaturation results from numerical inaccuracies and can be frequent if free_drain_coef=0
+       !    Here hydrol_soil_smooth_over_mcs2 discard all excess as ru_corr_ns, oriented to either ru_ns or dr_ns
+       !    The former routine hydrol_soil_smooth_over_mcs, which keeps most of the excess in the soiltile
+       !    after smoothing, first downward then upward, is kept in the module but not used here 
+       dr_corr_ns(:,jst) = zero
+       ru_corr_ns(:,jst) = zero
+       call hydrol_soil_smooth_over_mcs2(kjpindex, jst, njsc, is_over_mcs, ru_corr_ns, check_over_ns)
+       
+       ! In absence of freezing, if F is large enough, the correction of oversaturation is sent to drainage       
+       DO ji = 1, kjpindex
+          IF ((free_drain_coef(ji,jst) .GE. 0.5) .AND. (.NOT. ok_freeze_cwrr) ) THEN
+             dr_corr_ns(ji,jst) = ru_corr_ns(ji,jst) 
+             ru_corr_ns(ji,jst) = zero
+          ENDIF
+       ENDDO
+       dr_ns(:,jst) = dr_ns(:,jst) + dr_corr_ns(:,jst)
+       ru_ns(:,jst) = ru_ns(:,jst) + ru_corr_ns(:,jst)
+
+       !! 3.3 Negative runoff is reported to drainage
+       !  Since we computed ru_ns directly from hydrol_soil_infilt, ru_ns should not be negative
+             
+       ru_corr2_ns(:,jst) = zero
+       DO ji = 1, kjpindex
+          IF (ru_ns(ji,jst) .LT. zero) THEN
+             IF (printlev>=3)  WRITE (numout,*) 'NEGATIVE RU_NS: runoff and drainage before correction',&
+                  ru_ns(ji,jst),dr_ns(ji,jst)
+             dr_ns(ji,jst)=dr_ns(ji,jst)+ru_ns(ji,jst)
+             ru_corr2_ns(ji,jst) = -ru_ns(ji,jst)
+             ru_ns(ji,jst)= 0.
+          END IF          
+       ENDDO
+
+       !! 3.4 Optional block to force saturation below zwt_force
+       ! We test if zwt_force(1,jst) <= zmaxh, to avoid steps 1 and 2 if unnecessary
+       
+       IF (zwt_force(1,jst) <= zmaxh) THEN
+
+          !! We force the nodes below zwt_force to be saturated
+          !  As above, we compare mc to mcs 
+          DO jsl = 1,nslm
+             DO ji = 1, kjpindex
+                dmc(ji,jsl) = zero
+                IF ( ( zz(jsl) >= zwt_force(ji,jst)*mille ) ) THEN
+                   dmc(ji,jsl) = mcs(njsc(ji)) - mc(ji,jsl,jst) ! addition to reach mcs (m3/m3) = positive value
+                   mc(ji,jsl,jst) = mcs(njsc(ji))
+                ENDIF
+             ENDDO
+          ENDDO
+          
+          !! To ensure conservation, this needs to be balanced by a negative change in drainage (in kg/m2/dt)
+          DO ji = 1, kjpindex
+             dr_force_ns(ji,jst) = dz(2) * ( trois*dmc(ji,1) + dmc(ji,2) )/huit ! top layer = initialization
+          ENDDO
+          DO jsl = 2,nslm-1 ! intermediate layers
+             DO ji = 1, kjpindex
+                dr_force_ns(ji,jst) = dr_force_ns(ji,jst) + dz(jsl) &
+                     & * (trois*dmc(ji,jsl)+dmc(ji,jsl-1))/huit &
+                     & + dz(jsl+1) * (trois*dmc(ji,jsl)+dmc(ji,jsl+1))/huit
+             ENDDO
+          ENDDO
+          DO ji = 1, kjpindex
+             dr_force_ns(ji,jst) = dr_force_ns(ji,jst) + dz(nslm) & ! bottom layer
+                  & * (trois * dmc(ji,nslm) + dmc(ji,nslm-1))/huit
+             dr_ns(ji,jst) = dr_ns(ji,jst) - dr_force_ns(ji,jst) ! dr_force_ns is positive and dr_ns must be reduced
+          END DO
+
+       ELSE          
+
+          dr_force_ns(:,jst) = zero 
+
+       ENDIF
+
+       !! 3.5 Diagnosing the effective water table depth:
+       !!     Defined as as the smallest jsl value when mc(jsl) is no more at saturation (mcs), starting from the bottom
+       !      If there is a part of the soil which is saturated but underlain with unsaturated nodes,
+       !      this is not considered as a water table
+       DO ji = 1, kjpindex
+          wtd_ns(ji,jst) = undef_sechiba ! in meters
+          jsl=nslm
+          DO WHILE ( (mc(ji,jsl,jst) .EQ. mcs(njsc(ji))) .AND. (jsl > 1) )
+             wtd_ns(ji,jst) = zz(jsl)/mille ! in meters
+             jsl=jsl-1
+          ENDDO
+       ENDDO
+
+       !! 3.6 Diagnose under_mcr to adapt water stress calculation below
+       !      This routine does not change tmc but decides where we should turn off ET to prevent further mc decrease
+       !      Like above, the tests are made on total mc, compared to mcr
+       CALL hydrol_soil_smooth_under_mcr(kjpindex, jst, njsc, is_under_mcr, check_under_ns)
+ 
+       !! 4. At the end of the prognostic calculations, we recompute important moisture variables
+
+       !! 4.1 Total soil moisture content (water2infilt added below)
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+       ENDDO
+       DO jsl = 2,nslm-1
+          DO ji = 1, kjpindex
+             tmc(ji,jst) = tmc(ji,jst) + dz(jsl) &
+                  & * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+          ENDDO
+       ENDDO
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = tmc(ji,jst) + dz(nslm) &
+               & * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+       END DO
+
+       !! 4.2 mcl is a module variable; we update it here for calculating bare soil evaporation,
+       !!     and in case we would like to export it (xios)
+       DO jsl = 1, nslm
+          DO ji =1, kjpindex
+             mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(njsc(ji)) + &
+                  (un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
+             ! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep mcl=mc
+          ENDDO
+       ENDDO
+       
+       !! 5. Optional check of the water balance of soil column (if check_cwrr)
+
+       IF (check_cwrr) THEN
+          !! 5.1 Computation of the vertical water fluxes and water balance of the top layer 
+          CALL hydrol_diag_soil_flux(kjpindex,jst,mclint,flux_top)
+       ENDIF
+
+       !! 6. SM DIAGNOSTICS FOR OTHER ROUTINES, MODULES, OR NEXT STEP
+       !    Starting here, mc and mcl should not change anymore 
+       
+       !! 6.1 Total soil moisture, soil moisture at litter levels, soil wetness, us, humrelv, vesgtressv
+       !!     (based on mc)
+
+       !! In output, tmc includes water2infilt(ji,jst)
+       DO ji=1,kjpindex
+          tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
+       END DO
+       
+       ! The litter is the 4 top levels of the soil
+       ! Compute various field of soil moisture for the litter (used for stomate and for albedo)
+       DO ji=1,kjpindex
+          tmc_litter(ji,jst) = dz(2) * ( trois*mc(ji,1,jst)+ mc(ji,2,jst))/huit
+       END DO
+       ! sum from level 1 to 4
+       DO jsl=2,4
+          DO ji=1,kjpindex
+             tmc_litter(ji,jst) = tmc_litter(ji,jst) + dz(jsl) * & 
+                  & ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1)*(trois*mc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
+          END DO
+       END DO
+
+       ! Subsequent calculation of soil_wet_litter (tmc-tmcw)/(tmcf-tmcw)
+       DO ji=1,kjpindex
+          soil_wet_litter(ji,jst) = MIN(un, MAX(zero,&
+               & (tmc_litter(ji,jst)-tmc_litter_wilt(ji,jst)) / &
+               & (tmc_litter_field(ji,jst)-tmc_litter_wilt(ji,jst)) ))
+       END DO
+
+       ! Preliminary calculation of various soil moistures (for each layer, in kg/m2)
+       sm(:,1)  = dz(2) * (trois*mcl(:,1,jst) + mcl(:,2,jst))/huit
+       smw(:,1) = dz(2) * (quatre*mcw(njsc(:)))/huit
+       smf(:,1) = dz(2) * (quatre*mcf(njsc(:)))/huit
+       sms(:,1) = dz(2) * (quatre*mcs(njsc(:)))/huit
+       DO jsl = 2,nslm-1
+          sm(:,jsl)  = dz(jsl) * (trois*mcl(:,jsl,jst)+mcl(:,jsl-1,jst))/huit &
+               + dz(jsl+1) * (trois*mcl(:,jsl,jst)+mcl(:,jsl+1,jst))/huit
+          smw(:,jsl) = dz(jsl) * ( quatre*mcw(njsc(:)) )/huit &
+               + dz(jsl+1) * ( quatre*mcw(njsc(:)) )/huit
+          smf(:,jsl) = dz(jsl) * ( quatre*mcf(njsc(:)) )/huit &
+               + dz(jsl+1) * ( quatre*mcf(njsc(:)) )/huit
+          sms(:,jsl) = dz(jsl) * ( quatre*mcs(njsc(:)) )/huit &
+               + dz(jsl+1) * ( quatre*mcs(njsc(:)) )/huit
+       ENDDO
+       sm(:,nslm)  = dz(nslm) * (trois*mcl(:,nslm,jst) + mcl(:,nslm-1,jst))/huit      
+       smw(:,nslm) = dz(nslm) * (quatre*mcw(njsc(:)))/huit
+       smf(:,nslm) = dz(nslm) * (quatre*mcf(njsc(:)))/huit
+       sms(:,nslm) = dz(nslm) * (quatre*mcs(njsc(:)))/huit
+       ! sm_nostress = soil moisture of each layer at which us reaches 1, here at the middle of [smw,smf]
+       DO jsl = 1,nslm
+          sm_nostress(:,jsl) = smw(:,jsl) + pcent(njsc(:)) * (smf(:,jsl)-smw(:,jsl))
+       END DO
+       
+       ! Saturated litter soil moisture for rsoil 
+       tmcs_litter(:) = zero 
+       DO jsl = 1,4 
+          tmcs_litter(:) = tmcs_litter(:) + sms(:,jsl) 
+       END DO 
+      
+       ! Soil wetness profiles (W-Ww)/(Ws-Ww)
+       ! soil_wet is the ratio of available soil moisture to max available soil moisture
+       ! (ie soil moisture at saturation minus soil moisture at wilting point).
+       ! soil wet is a water stress for stomate, to control C decomposition
+       DO jsl=1,nslm
+          DO ji=1,kjpindex
+             soil_wet(ji,jsl,jst) = MIN(un, MAX(zero, &
+                  (sm(ji,jsl)-smw(ji,jsl))/(sms(ji,jsl)-smw(ji,jsl)) ))
+          END DO
+       END DO
+
+       ! Compute us and the new humrelv to use in sechiba (with loops on the vegetation types)
+       ! This is the water stress for transpiration (diffuco) and photosynthesis (diffuco)
+       ! humrel is never used in stomate
+
+       ! -- PFT1
+       humrelv(:,1,jst) = zero        
+       ! -- Top layer
+       DO jv = 2,nvm
+          DO ji=1,kjpindex
+             !- Here we make the assumption that roots do not take water from the 1st layer. 
+             us(ji,jv,jst,1) = zero
+             humrelv(ji,jv,jst) = zero ! initialisation of the sum
+          END DO
+       ENDDO
+
+       !! Dynamic nroot to optimize water use: the root profile used to weight the water stress function  
+       !! of each soil layer is updated at each time step in order to match the soil water profile  
+       !! (the soil water content of each layer available for transpiration) 
+       IF (ok_dynroot) THEN 
+          DO jv = 1, nvm 
+             IF ( is_tree(jv) ) THEN 
+                DO ji = 1, kjpindex 
+                   nroot_tmp(:) = zero 
+                   DO jsl = 2, nslm 
+                      nroot_tmp(jsl) = MAX(zero,sm(ji,jsl)-smw(ji,jsl) ) 
+                   ENDDO 
+                   IF (SUM(nroot_tmp(:)) .GT. min_sechiba ) THEN 
+                      nroot(ji,jv,:) = nroot_tmp(:)/SUM(nroot_tmp(:)) 
+                   ELSE 
+                      nroot(ji,jv,:) = zero 
+                   END IF 
+                ENDDO 
+             ELSE 
+                ! Specific case for grasses where we only consider the first 1m of soil.                 
+                DO ji = 1, kjpindex 
+                   nroot_tmp(:) = zero 
+                   DO jsl = 2, nslm 
+                      IF (znt(jsl) .LT. un) THEN 
+                         nroot_tmp(jsl) = MAX(zero,sm(ji,jsl)-smw(ji,jsl) ) 
+                      END IF 
+                   ENDDO 
+                    
+                   IF (SUM(nroot_tmp(:)) .GT. min_sechiba ) THEN 
+                      DO jsl = 2,nslm 
+                         IF (znt(jsl) .LT. un) THEN 
+                            nroot(ji,jv,jsl) = nroot_tmp(jsl)/SUM(nroot_tmp(:)) 
+                         ELSE 
+                            nroot(ji,jv,jsl) = zero 
+                         END IF 
+                      ENDDO 
+                      nroot(ji,jv,1) = zero 
+                   END IF 
+                ENDDO 
+             END IF 
+          ENDDO 
+       ENDIF
+
+       ! -- Intermediate and bottom layers
+       DO jsl = 2,nslm
+          DO jv = 2, nvm
+             DO ji=1,kjpindex
+                ! AD16*** Although plants can only withdraw liquid water, we compute here the water stress
+                ! based on mc and the corresponding thresholds mcs, pcent, or potentially mcw and mcf
+                ! This is consistent with assuming that ice is uniformly distributed within the poral space
+                ! In such a case, freezing makes mcl and the "liquid" porosity smaller than the "total" values
+                ! And it is the same for all the moisture thresholds, which are proportional to porosity.
+                ! Since the stress is based on relative moisture, it could thus be independent from the porosity
+                ! at first order, thus independent from freezing.             
+                IF(new_watstress) THEN 
+                   IF((sm(ji,jsl)-smw(ji,jsl)) .GT. min_sechiba) THEN 
+                     us(ji,jv,jst,jsl) = MIN(un, MAX(zero, & 
+                          (EXP(- alpha_watstress * & 
+                          ( (smf(ji,jsl) - smw(ji,jsl)) / ( sm_nostress(ji,jsl) - smw(ji,jsl)) ) * & 
+                          ( (sm_nostress(ji,jsl) - sm(ji,jsl)) / ( sm(ji,jsl) - smw(ji,jsl)) ) ) ) ))& 
+                          * nroot(ji,jv,jsl) 
+                   ELSE 
+                      us(ji,jv,jst,jsl) = 0. 
+                   ENDIF 
+                ELSE 
+                   us(ji,jv,jst,jsl) = MIN(un, MAX(zero, & 
+                        (sm(ji,jsl)-smw(ji,jsl))/(sm_nostress(ji,jsl)-smw(ji,jsl)) )) * nroot(ji,jv,jsl) 
+                ENDIF
+                humrelv(ji,jv,jst) = humrelv(ji,jv,jst) + us(ji,jv,jst,jsl)
+             END DO
+          END DO
+       ENDDO
+
+       !! vegstressv is the water stress for phenology in stomate
+       !! It varies linearly from zero at wilting point to 1 at field capacity
+       vegstressv(:,:,jst) = zero
+       DO jv = 2, nvm
+          DO ji=1,kjpindex
+             DO jsl=1,nslm
+                vegstressv(ji,jv,jst) = vegstressv(ji,jv,jst) + &
+                     MIN(un, MAX(zero, (sm(ji,jsl)-smw(ji,jsl))/(smf(ji,jsl)-smw(ji,jsl)) )) &
+                     * nroot(ji,jv,jsl)
+             END DO
+          END DO
+       END DO
+
+
+       ! -- If the PFT is absent, the corresponding humrelv and vegstressv = 0
+       DO jv = 2, nvm
+          DO ji = 1, kjpindex
+             IF (vegetmax_soil(ji,jv,jst) .LT. min_sechiba) THEN
+                humrelv(ji,jv,jst) = zero
+                vegstressv(ji,jv,jst) = zero
+                us(ji,jv,jst,:) = zero
+             ENDIF
+          END DO
+       END DO
+
+       !! 6.2 We need to turn off evaporation when is_under_mcr
+       !!     We set us, humrelv and vegstressv to zero in this case
+       !!     WARNING: It's different from having locally us=0 in the soil layers(s) where mc<mcr
+       !!              This part is crucial to preserve water conservation
+       DO jsl = 1,nslm
+          DO jv = 2, nvm
+             WHERE (is_under_mcr(:,jst))
+                us(:,jv,jst,jsl) = zero
+             ENDWHERE
+          ENDDO
+       ENDDO
+       DO jv = 2, nvm
+          WHERE (is_under_mcr(:,jst))
+             humrelv(:,jv,jst) = zero
+          ENDWHERE
+       ENDDO
+       
+       ! For consistency in stomate, we also set moderwilt and soil_wet to zero in this case. 
+       ! They are used later for shumdiag and shumdiag_perma
+       DO jsl = 1,nslm
+          WHERE (is_under_mcr(:,jst))
+             soil_wet(:,jsl,jst) = zero
+          ENDWHERE
+       ENDDO
+
+       ! Counting the nb of under_mcr occurences in each grid-cell 
+       WHERE (is_under_mcr(:,jst))
+          undermcr = undermcr + un
+       ENDWHERE
+
+       !! 6.3 Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in 
+       !!     thermosoil for the thermal conductivity. Calculate also total soil moisture content(tmc_layh) 
+       !!     needed in thermosoil for the heat capacity.
+       !! The multiplication by vegtot creates grid-cell average values
+       ! *** To be checked for consistency with the use of nobio properties in thermosoil
+       DO ji=1,kjpindex
+          DO jsl=1,nslm
+             mc_layh(ji,jsl) = mc_layh(ji,jsl) + mc(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji) 
+             mcl_layh(ji,jsl) = mcl_layh(ji,jsl) + mcl(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
+          ENDDO
+          tmc_layh_ns(ji,1,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+          DO jsl = 2,nslm-1
+             tmc_layh_ns(ji,jsl,jst) = dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+          ENDDO
+          tmc_layh_ns(ji,nslm,jst) = dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+          DO jsl = 1,nslm
+             tmc_layh(ji,jsl) = tmc_layh(ji,jsl) + tmc_layh_ns(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
+          ENDDO
+       END DO
+
+       !! 6.4 The hydraulic conductivities exported here are the ones used in the diffusion/redistribution
+       ! (no call of hydrol_soil_coef since 2.1)
+       ! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
+       IF (ok_freeze_cwrr) THEN
+          DO ji = 1, kjpindex
+             kk_moy(ji,:) = kk_moy(ji,:) + soiltile(ji,jst) * k(ji,:) * vegtot(ji)
+             kk(ji,:,jst) = k(ji,:)
+          ENDDO
+       ENDIF
+       
+      IF (printlev>=3) WRITE (numout,*) ' prognostic/diagnostic part of hydrol_soil done for jst =', jst          
+
+   END DO  ! end of loop on soiltile
+
+    !! -- ENDING THE MAIN LOOP ON SOILTILES
+
+    !! 7. Summing 3d variables into 2d variables 
+    CALL hydrol_diag_soil (kjpindex, veget_max, soiltile, njsc, runoff, drainage, &
+         & evapot, vevapnu, returnflow, reinfiltration, irrigation, &
+         & shumdiag,shumdiag_perma, k_litt, litterhumdiag, humrel, vegstress, drysoil_frac,tot_melt)
+
+    ! Means of wtd, runoff and drainage corrections, across soiltiles    
+    wtd(:) = zero 
+    ru_corr(:) = zero
+    ru_corr2(:) = zero
+    dr_corr(:) = zero
+    dr_corrnum(:) = zero
+    dr_force(:) = zero
+    DO jst = 1, nstm
+       DO ji = 1, kjpindex 
+          wtd(ji) = wtd(ji) + soiltile(ji,jst) * wtd_ns(ji,jst) ! average over vegtot only
+          IF (vegtot(ji) .GT. min_sechiba) THEN ! to mimic hydrol_diag_soil
+             ! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
+             ru_corr(ji) = ru_corr(ji) + vegtot(ji) * soiltile(ji,jst) * ru_corr_ns(ji,jst) 
+             ru_corr2(ji) = ru_corr2(ji) + vegtot(ji) * soiltile(ji,jst) * ru_corr2_ns(ji,jst) 
+             dr_corr(ji) = dr_corr(ji) + vegtot(ji) * soiltile(ji,jst) * dr_corr_ns(ji,jst) 
+             dr_corrnum(ji) = dr_corrnum(ji) + vegtot(ji) * soiltile(ji,jst) * dr_corrnum_ns(ji,jst)
+             dr_force(ji) = dr_force(ji) - vegtot(ji) * soiltile(ji,jst) * dr_force_ns(ji,jst)
+                                       ! the sign is OK to get a negative drainage flux
+          ENDIF
+       ENDDO
+    ENDDO
+
+    ! Means local variables, including water conservation checks
+    ru_infilt(:)=0.
+    qinfilt(:)=0.
+    check_infilt(:)=0.
+    check_tr(:)=0.
+    check_over(:)=0.
+    check_under(:)=0.
+    qflux(:,:)=0
+    check_top(:)=0. 
+
+    DO jst = 1, nstm
+       DO ji = 1, kjpindex 
+          IF (vegtot(ji) .GT. min_sechiba) THEN ! to mimic hydrol_diag_soil
+             ! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
+             ru_infilt(ji) = ru_infilt(ji) + vegtot(ji) * soiltile(ji,jst) * ru_infilt_ns(ji,jst)
+             qinfilt(ji) = qinfilt(ji) + vegtot(ji) * soiltile(ji,jst) * qinfilt_ns(ji,jst)
+          ENDIF
+       ENDDO
+    ENDDO
+ 
+    IF (check_cwrr) THEN
+       DO jst = 1, nstm
+          DO ji = 1, kjpindex 
+             IF (vegtot(ji) .GT. min_sechiba) THEN ! to mimic hydrol_diag_soil
+                ! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
+                check_infilt(ji) = check_infilt(ji) + vegtot(ji) * soiltile(ji,jst) * check_infilt_ns(ji,jst)
+                check_tr(ji) = check_tr(ji) + vegtot(ji) * soiltile(ji,jst) * check_tr_ns(ji,jst)
+                check_over(ji) = check_over(ji) + vegtot(ji) * soiltile(ji,jst) * check_over_ns(ji,jst)
+                check_under(ji) =  check_under(ji) + vegtot(ji) * soiltile(ji,jst) * check_under_ns(ji,jst)
+                !
+                qflux(ji,:) = qflux(ji,:) + vegtot(ji) * soiltile(ji,jst) * qflux_ns(ji,:,jst) 
+                check_top(ji) =  check_top(ji) + vegtot(ji) * soiltile(ji,jst) * check_top_ns(ji,jst)
+             ENDIF
+          ENDDO
+       ENDDO
+    END IF
+    !! 8. COMPUTING EVAP_BARE_LIM_NS FOR NEXT TIME STEP, WITH A LOOP ON SOILTILES
+    !!    The principle is to run a dummy integration of the water redistribution scheme
+    !!    to check if the SM profile can sustain a potential evaporation.
+    !!    If not, the dummy integration is redone from the SM profile of the end of the normal integration,
+    !!    with a boundary condition leading to a very severe water limitation: mc(1)=mcr
+
+    ! evap_bare_lim = beta factor for bare soil evaporation
+    evap_bare_lim(:) = zero
+    evap_bare_lim_ns(:,:) = zero
+
+    ! Loop on soil tiles  
+    DO jst = 1,nstm
+
+       !! 8.1 Save actual mc, mcl, and tmc for restoring at the end of the time step
+       !!      and calculate tmcint corresponding to mc without water2infilt
+       DO jsl = 1, nslm
+          DO ji = 1, kjpindex
+             mcint(ji,jsl) = mask_soiltile(ji,jst) * mc(ji,jsl,jst)
+             mclint(ji,jsl) = mask_soiltile(ji,jst) * mcl(ji,jsl,jst)
+          ENDDO
+       ENDDO
+
+       DO ji = 1, kjpindex
+          temp(ji) = tmc(ji,jst)
+          tmcint(ji) = temp(ji) - water2infilt(ji,jst) ! to estimate bare soil evap based on water budget
+       ENDDO
+
+       !! 8.2 Since we estimate bare soile evap for the next time step, we update profil_froz_hydro and mcl
+       !     (effect of mc only, the change in temp_hydro is neglected)
+       IF ( ok_freeze_cwrr ) CALL hydrol_soil_froz(kjpindex,jst,njsc)
+        DO jsl = 1, nslm
+          DO ji =1, kjpindex
+             mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(njsc(ji)) + &
+                  (un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
+             ! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep mcl=mc
+          ENDDO
+       ENDDO          
+
+       !! 8.3 K and D are recomputed for the updated profile of mc/mcl
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+
+       !! 8.4 Set the tridiagonal matrix coefficients for the diffusion/redistribution scheme
+       CALL hydrol_soil_setup(kjpindex,jst)
+       resolv(:) = (mask_soiltile(:,jst) .GT. 0) 
+
+       !! 8.5 We define the system of linear equations, based on matrix coefficients, 
+
+       !- Impose potential evaporation as flux_top in mm/step, assuming the water is available
+       ! Note that this should lead to never have evapnu>evapot_penm(ji)
+
+       DO ji = 1, kjpindex            
+          IF (vegtot(ji).GT.min_sechiba) THEN               
+             ! We calculate a reduced demand, by means of a soil resistance 
+             IF (do_rsoil) THEN 
+                mc_rel(ji) = tmc_litter(ji,jst)/tmcs_litter(ji) 
+                ! based on SM in the top 4 soil layers (litter) to smooth variability 
+                r_soil_ns(ji,jst) = exp(8.206 - 4.255 * mc_rel(ji)) 
+             ELSE 
+                r_soil_ns(ji,jst) = zero 
+             ENDIF 
+          
+             ! Aerodynamic resistance 
+             speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji))) 
+             IF (speed * tq_cdrag(ji) .GT. min_sechiba) THEN 
+                ra = un / (speed * tq_cdrag(ji)) 
+                evap_soil(ji) = evapot_penm(ji) / (un + r_soil_ns(ji,jst)/ra) 
+             ELSE 
+                evap_soil(ji) = evapot_penm(ji) 
+             ENDIF  
+
+       ! AD16*** et si evap_bare_lim_ns<0 ?? car on suppose que tmcint > tmc(new)
+       ! (water2inflit permet de propager de la ponded water d'un pas de temps a l'autre:
+       ! peut-on s'en servir pour creer des cas d'evapnu potentielle negative ? a gerer dans diffuco ?)
+       
+             flux_top(ji) = evapot_penm(ji) * &
+                  AINT(frac_bare_ns(ji,jst)+un-min_sechiba)
+          ELSE
+             flux_top(ji) = zero
+          ENDIF
+       ENDDO
+
+       ! We don't use rootsinks, because we assume there is no transpiration in the bare soil fraction (??)
+       !- First layer
+       DO ji = 1, kjpindex
+          tmat(ji,1,1) = zero
+          tmat(ji,1,2) = f(ji,1)
+          tmat(ji,1,3) = g1(ji,1)
+          rhs(ji,1)    = fp(ji,1) * mcl(ji,1,jst) + gp(ji,1)*mcl(ji,2,jst) &
+               - flux_top(ji) - (b(ji,1)+b(ji,2))/deux *(dt_sechiba/one_day)
+       ENDDO
+       !- soil body
+       DO jsl=2, nslm-1
+          DO ji = 1, kjpindex
+             tmat(ji,jsl,1) = e(ji,jsl)
+             tmat(ji,jsl,2) = f(ji,jsl)
+             tmat(ji,jsl,3) = g1(ji,jsl)
+             rhs(ji,jsl) = ep(ji,jsl)*mcl(ji,jsl-1,jst) + fp(ji,jsl)*mcl(ji,jsl,jst) &
+                  +  gp(ji,jsl) * mcl(ji,jsl+1,jst) &
+                  + (b(ji,jsl-1) - b(ji,jsl+1)) * (dt_sechiba/one_day) / deux
+          ENDDO
+       ENDDO
+       !- Last layer
+       DO ji = 1, kjpindex
+          jsl=nslm
+          tmat(ji,jsl,1) = e(ji,jsl)
+          tmat(ji,jsl,2) = f(ji,jsl)
+          tmat(ji,jsl,3) = zero
+          rhs(ji,jsl) = ep(ji,jsl)*mcl(ji,jsl-1,jst) + fp(ji,jsl)*mcl(ji,jsl,jst) &
+               + (b(ji,jsl-1) + b(ji,jsl)*(un-deux*free_drain_coef(ji,jst))) * (dt_sechiba/one_day) / deux
+       ENDDO
+       !- Store the equations for later use (9.6)
+       DO jsl=1,nslm
+          DO ji = 1, kjpindex
+             srhs(ji,jsl) = rhs(ji,jsl)
+             stmat(ji,jsl,1) = tmat(ji,jsl,1)
+             stmat(ji,jsl,2) = tmat(ji,jsl,2)
+             stmat(ji,jsl,3) = tmat(ji,jsl,3)
+          ENDDO
+       ENDDO
+
+       !! 8.6 Solve the diffusion equation, assuming that flux_top=evapot_penm (updates mcl)
+       CALL hydrol_soil_tridiag(kjpindex,jst)
+
+       !! 9.7 Alternative solution with mc(1)=mcr in points where the above solution leads to mcl<mcr 
+       ! hydrol_soil_tridiag calculates mc recursively from the top as a fonction of rhs and tmat 
+       ! We re-use these the above values, but for mc(1)=mcr and the related tmat
+       
+       DO ji = 1, kjpindex
+          ! by construction, mc and mcl are always on the same side of mcr, so we can use mcl here
+          resolv(ji) = (mcl(ji,1,jst).LT.(mcr(njsc(ji))).AND.flux_top(ji).GT.min_sechiba)
+       ENDDO
+       !! Reset the coefficient for diffusion (tridiag is only solved if resolv(ji) = .TRUE.)O
+       DO jsl=1,nslm
+          !- The new condition is to put the upper layer at residual soil moisture
+          DO ji = 1, kjpindex
+             rhs(ji,jsl) = srhs(ji,jsl)
+             tmat(ji,jsl,1) = stmat(ji,jsl,1)
+             tmat(ji,jsl,2) = stmat(ji,jsl,2)
+             tmat(ji,jsl,3) = stmat(ji,jsl,3)
+          END DO
+       END DO
+       
+       DO ji = 1, kjpindex
+          tmat(ji,1,2) = un
+          tmat(ji,1,3) = zero
+          rhs(ji,1) = mcr(njsc(ji))
+       ENDDO
+       
+       ! Solves the diffusion equation with new surface bc where resolv=T 
+       CALL hydrol_soil_tridiag(kjpindex,jst)
+
+       !! 8.8 In both case, we have drainage to be consistent with rhs
+       DO ji = 1, kjpindex
+          flux_bottom(ji) = mask_soiltile(ji,jst)*k(ji,nslm)*free_drain_coef(ji,jst) * (dt_sechiba/one_day)
+       ENDDO
+       
+       !! 8.9 Water budget to assess the top flux = soil evaporation
+       !      Where resolv=F at the 2nd step (9.6), it should simply be the potential evaporation
+
+       ! Total soil moisture content for water budget
+
+       DO jsl = 1, nslm
+          DO ji =1, kjpindex
+             mc(ji,jsl,jst) = MAX( mcl(ji,jsl,jst), mcl(ji,jsl,jst) + &
+                  profil_froz_hydro_ns(ji,jsl,jst)*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
+             ! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we get mc=mcl
+          ENDDO
+       ENDDO
+       
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+       ENDDO       
+       DO jsl = 2,nslm-1
+          DO ji = 1, kjpindex
+             tmc(ji,jst) = tmc(ji,jst) + dz(jsl) &
+                  * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+          ENDDO
+       ENDDO
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = tmc(ji,jst) + dz(nslm) &
+               * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+       END DO
+    
+       ! Deduce upper flux from soil moisture variation and bottom flux
+       ! TMCi-D-BSE=TMC (BSE=bare soil evap=TMCi-TMC-D)
+       ! The numerical errors of tridiag close to saturation cannot be simply solved here,
+       ! we can only hope they are not too large because we don't add water at this stage... 
+       DO ji = 1, kjpindex
+          evap_bare_lim_ns(ji,jst) = mask_soiltile(ji,jst) * &
+               (tmcint(ji)-tmc(ji,jst)-flux_bottom(ji))
+       END DO
+
+       !! 8.10 evap_bare_lim_ns is turned from an evaporation rate to a beta
+       DO ji = 1, kjpindex
+          ! Here we weight evap_bare_lim_ns by the fraction of bare evaporating soil. 
+          ! This is given by frac_bare_ns, taking into account bare soil under vegetation
+          IF(vegtot(ji) .GT. min_sechiba) THEN
+             evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) * frac_bare_ns(ji,jst)
+          ELSE
+             evap_bare_lim_ns(ji,jst) = 0.
+          ENDIF
+       END DO
+
+       ! We divide by evapot, which is consistent with diffuco (evap_bare_lim_ns < evapot_penm/evapot)
+       ! Further decrease if tmc_litter is below the wilting point
+
+       IF (do_rsoil) THEN 
+          DO ji=1,kjpindex 
+             IF (evapot(ji).GT.min_sechiba) THEN 
+                evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) / evapot(ji) 
+             ELSE 
+                evap_bare_lim_ns(ji,jst) = zero ! not redundant with the is_under_mcr case below 
+                                                ! but not necessarily useful 
+             END IF 
+             evap_bare_lim_ns(ji,jst)=MAX(MIN(evap_bare_lim_ns(ji,jst),1.),0.) 
+          END DO 
+       ELSE 
+          DO ji=1,kjpindex 
+             IF ((evapot(ji).GT.min_sechiba) .AND. & 
+                  (tmc_litter(ji,jst).GT.(tmc_litter_wilt(ji,jst)))) THEN 
+                evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) / evapot(ji) 
+             ELSEIF((evapot(ji).GT.min_sechiba).AND. & 
+                  (tmc_litter(ji,jst).GT.(tmc_litter_res(ji,jst)))) THEN 
+                evap_bare_lim_ns(ji,jst) =  (un/deux) * evap_bare_lim_ns(ji,jst) / evapot(ji) 
+                ! This is very arbitrary, with no justification from the literature 
+             ELSE 
+                evap_bare_lim_ns(ji,jst) = zero 
+             END IF 
+             evap_bare_lim_ns(ji,jst)=MAX(MIN(evap_bare_lim_ns(ji,jst),1.),0.) 
+          END DO 
+       ENDIF       
+
+       !! 8.11 Set evap_bare_lim_ns to zero if is_under_mcr at the end of the prognostic loop
+       !!      (cf us, humrelv, vegstressv in 5.2)
+       WHERE (is_under_mcr(:,jst))
+          evap_bare_lim_ns(:,jst) = zero
+       ENDWHERE
+
+       !! 8.12 Restores mc, mcl, and tmc, to erase the effect of the dummy integrations
+       !!      on these prognostic variables 
+       DO jsl = 1, nslm
+          DO ji = 1, kjpindex
+             mc(ji,jsl,jst) = mask_soiltile(ji,jst) * mcint(ji,jsl)
+             mcl(ji,jsl,jst) = mask_soiltile(ji,jst) * mclint(ji,jsl)
+          ENDDO
+       ENDDO
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = temp(ji)
+       ENDDO
+
+    ENDDO !end loop on tiles for dummy integration
+
+    !! 9. evap_bar_lim is the grid-cell scale beta
+    DO ji = 1, kjpindex
+       evap_bare_lim(ji) =  SUM(evap_bare_lim_ns(ji,:)*vegtot(ji)*soiltile(ji,:))
+       r_soil(ji) =  SUM(r_soil_ns(ji,:)*vegtot(ji)*soiltile(ji,:))
+    ENDDO
+
+
+    !! 10. XIOS export of local variables, including water conservation checks
+
+    CALL xios_orchidee_send_field("wtd",wtd) ! in m
+    CALL xios_orchidee_send_field("ru_corr",ru_corr/dt_sechiba)   ! adjustment flux added to surface runoff (included in runoff)
+    CALL xios_orchidee_send_field("ru_corr2",ru_corr2/dt_sechiba)
+    CALL xios_orchidee_send_field("dr_corr",dr_corr/dt_sechiba)   ! adjustment flux added to drainage (included in drainage)
+    CALL xios_orchidee_send_field("dr_corrnum",dr_corrnum/dt_sechiba) 
+    CALL xios_orchidee_send_field("dr_force",dr_force/dt_sechiba) ! adjustement flux added to drainage to sustain a forced wtd
+    CALL xios_orchidee_send_field("qinfilt",qinfilt/dt_sechiba)
+    CALL xios_orchidee_send_field("ru_infilt",ru_infilt/dt_sechiba)
+    CALL xios_orchidee_send_field("r_soil",r_soil)                ! kg/m2
+    IF (check_cwrr) THEN
+       CALL xios_orchidee_send_field("check_infilt",check_infilt/dt_sechiba)
+       CALL xios_orchidee_send_field("check_tr",check_tr/dt_sechiba)
+       CALL xios_orchidee_send_field("check_over",check_over/dt_sechiba)
+       CALL xios_orchidee_send_field("check_under",check_under/dt_sechiba)    
+
+       ! Variables calculated in hydrol_diag_soil_flux 
+       CALL xios_orchidee_send_field("qflux",qflux/dt_sechiba) ! upward water flux at the low interface of each layer 
+       CALL xios_orchidee_send_field("check_top",check_top/dt_sechiba) !water budget residu in top layer  
+    END IF
+
+  END SUBROUTINE hydrol_soil
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_infilt
+!!
+!>\BRIEF        Infiltration
+!!
+!! DESCRIPTION  :
+!! 1. We calculate the total SM at the beginning of the routine
+!! 2. Infiltration process
+!! 2.1 Initialization of time counter and infiltration rate
+!! 2.2 Infiltration layer by layer, accounting for an exponential law for subgrid variability
+!! 2.3 Resulting infiltration and surface runoff
+!! 3. For water conservation check, we calculate the total SM at the beginning of the routine,
+!!    and export the difference with the flux
+!! 5. Local verification 
+!!
+!! RECENT CHANGE(S) : 2016 by A. Ducharne
+!! Adding checks and interactions variables with hydrol_soil, but the processes are unchanged
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_infilt
+
+  SUBROUTINE hydrol_soil_infilt(kjpindex, ins, njsc, flux_infilt, qinfilt_ns, ru_infilt, check)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! GLOBAL (in or inout)
+    INTEGER(i_std), INTENT(in)                        :: kjpindex        !! Domain size
+    INTEGER(i_std), INTENT(in)                        :: ins
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)  :: njsc            !! Index of the dominant soil textural class in the grid cell
+                                                                         !!  (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)    :: flux_infilt     !! Water to infiltrate
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check       !! delta SM - flux (mm/dt_sechiba)
+    REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: ru_infilt   !! Surface runoff from soil_infilt (mm/dt_sechiba)
+    REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: qinfilt_ns  !! Effective infiltration flux (mm/dt_sechiba)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                :: ji, jsl      !! Indices
+    REAL(r_std), DIMENSION (kjpindex)             :: wat_inf_pot  !! infiltrable water in the layer
+    REAL(r_std), DIMENSION (kjpindex)             :: wat_inf      !! infiltrated water in the layer
+    REAL(r_std), DIMENSION (kjpindex)             :: dt_tmp       !! time remaining before the end of the time step
+    REAL(r_std), DIMENSION (kjpindex)             :: dt_inf       !! the time it takes to complete the infiltration in the 
+                                                                  !! layer 
+    REAL(r_std)                                   :: k_m          !! the mean conductivity used for the saturated front
+    REAL(r_std), DIMENSION (kjpindex)             :: infilt_tmp   !! infiltration rate for the considered layer 
+    REAL(r_std), DIMENSION (kjpindex)             :: infilt_tot   !! total infiltration 
+    REAL(r_std), DIMENSION (kjpindex)             :: flux_tmp     !! rate at which precip hits the ground
+
+    REAL(r_std), DIMENSION(kjpindex)              :: tmci         !! total SM at beginning of routine (kg/m2)
+    REAL(r_std), DIMENSION(kjpindex)              :: tmcf         !! total SM at end of routine (kg/m2)
+    
+
+!_ ================================================================================================================================
+
+    ! If data (or coupling with GCM) was available, a parameterization for subgrid rainfall could be performed
+
+    !! 1. We calculate the total SM at the beginning of the routine
+    IF (check_cwrr) THEN
+       tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
+       DO jsl = 2,nslm-1
+          tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
+               + dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
+       ENDDO
+       tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
+    ENDIF
+
+    !! 2. Infiltration process
+
+    !! 2.1 Initialization
+
+    DO ji = 1, kjpindex
+       !! First we fill up the first layer (about 1mm) without any resistance and quasi-immediately
+       wat_inf_pot(ji) = MAX((mcs(njsc(ji))-mc(ji,1,ins)) * dz(2) / deux, zero)
+       wat_inf(ji) = MIN(wat_inf_pot(ji), flux_infilt(ji))
+       mc(ji,1,ins) = mc(ji,1,ins) + wat_inf(ji) * deux / dz(2)
+       !
+    ENDDO
+
+    !! Initialize a countdown for infiltration during the time-step and the value of potential runoff
+    dt_tmp(:) = dt_sechiba / one_day
+    infilt_tot(:) = wat_inf(:)
+    !! Compute the rate at which water will try to infiltrate each layer
+    ! flux_temp is converted here to the same unit as k_m
+    flux_tmp(:) = (flux_infilt(:)-wat_inf(:)) / dt_tmp(:)
+
+    !! 2.2 Infiltration layer by layer 
+    DO jsl = 2, nslm-1
+       DO ji = 1, kjpindex
+          !! Infiltrability of each layer if under a saturated one
+          ! This is computed by an simple arithmetic average because 
+          ! the time step (30min) is not appropriate for a geometric average (advised by Haverkamp and Vauclin)
+          k_m = (k(ji,jsl) + ks(njsc(ji))*kfact(jsl-1,njsc(ji))*kfact_root(ji,jsl,ins)) / deux 
+
+          IF (ok_freeze_cwrr) THEN
+             IF (temp_hydro(ji, jsl) .LT. ZeroCelsius) THEN
+                k_m = k(ji,jsl)
+             ENDIF
+          ENDIF
+
+          !! We compute the mean rate at which water actually infiltrate:
+          ! Subgrid: Exponential distribution of k around k_m, but average p directly used 
+          ! See d'Orgeval 2006, p 78, but it's not fully clear to me (AD16***)
+          infilt_tmp(ji) = k_m * (un - EXP(- flux_tmp(ji) / k_m)) 
+
+          !! From which we deduce the time it takes to fill up the layer or to end the time step...
+          wat_inf_pot(ji) =  MAX((mcs(njsc(ji))-mc(ji,jsl,ins)) * (dz(jsl) + dz(jsl+1)) / deux, zero)
+          IF ( infilt_tmp(ji) > min_sechiba) THEN
+             dt_inf(ji) =  MIN(wat_inf_pot(ji)/infilt_tmp(ji), dt_tmp(ji))
+             ! The water infiltration TIME has to limited by what is still available for infiltration.
+             IF ( dt_inf(ji) * infilt_tmp(ji) > flux_infilt(ji)-infilt_tot(ji) ) THEN
+                dt_inf(ji) = MAX(flux_infilt(ji)-infilt_tot(ji),zero)/infilt_tmp(ji)
+             ENDIF
+          ELSE
+             dt_inf(ji) = dt_tmp(ji)
+          ENDIF
+
+          !! The water enters in the layer
+          wat_inf(ji) = dt_inf(ji) * infilt_tmp(ji)
+          ! bviously the moisture content
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) + &
+               & wat_inf(ji) * deux / (dz(jsl) + dz(jsl+1))
+          ! the time remaining before the next time step
+          dt_tmp(ji) = dt_tmp(ji) - dt_inf(ji)
+          ! and finally the infilt_tot (which is just used to check if there is a problem, below) 
+          infilt_tot(ji) = infilt_tot(ji) + infilt_tmp(ji) * dt_inf(ji)
+       ENDDO
+    ENDDO
+
+    !! 2.3 Resulting infiltration and surface runoff
+    ru_infilt(:,ins) = flux_infilt(:) - infilt_tot(:)
+    qinfilt_ns(:,ins) = infilt_tot(:)
+
+    !! 3. For water conservation check: we calculate the total SM at the beginning of the routine
+    !!    and export the difference with the flux
+    IF (check_cwrr) THEN
+       tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
+       DO jsl = 2,nslm-1
+          tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
+               + dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
+       ENDDO
+       tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
+       ! Normally, tcmf=tmci+infilt_tot
+       check(:,ins) = tmcf(:)-(tmci(:)+infilt_tot(:))
+    ENDIF
+    
+    !! 5. Local verification
+    DO ji = 1, kjpindex
+       IF (infilt_tot(ji) .LT. -min_sechiba .OR. infilt_tot(ji) .GT. flux_infilt(ji) + min_sechiba) THEN
+          WRITE (numout,*) 'Error in the calculation of infilt tot', infilt_tot(ji)
+          WRITE (numout,*) 'k, ji, jst, mc', k(ji,1:2), ji, ins, mc(ji,1,ins)
+          CALL ipslerr_p(3, 'hydrol_soil_infilt', 'We will STOP now.','Error in calculation of infilt tot','')
+       ENDIF
+    ENDDO
+
+  END SUBROUTINE hydrol_soil_infilt
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_smooth_under_mcr
+!!
+!>\BRIEF        : Modifies the soil moisture profile to avoid under-residual values, 
+!!                then diagnoses the points where such "excess" values remain. 
+!!
+!! DESCRIPTION  :
+!! The "excesses" under-residual are corrected from top to bottom, by transfer of excesses 
+!! to the lower layers. The reverse transfer is performed to smooth any remaining "excess" in the bottom layer.
+!! If some "excess" remain afterwards, the entire soil profile is at the threshold value (mcs or mcr), 
+!! and the remaining "excess" is necessarily concentrated in the top layer. 
+!! This allowing diagnosing the flag is_under_mcr. 
+!! Eventually, the remaining "excess" is split over the entire profile
+!! 1. We calculate the total SM at the beginning of the routine
+!! 2. Smoothes the profile to avoid negative values of punctual soil moisture
+!! Note that we check that mc > min_sechiba in hydrol_soil 
+!! 3. For water conservation check, We calculate the total SM at the beginning of the routine,
+!!    and export the difference with the flux
+!!
+!! RECENT CHANGE(S) : 2016 by A. Ducharne
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_smooth_under_mcr
+
+  SUBROUTINE hydrol_soil_smooth_under_mcr(kjpindex, ins, njsc, is_under_mcr, check)
+
+    !- arguments
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex     !! Domain size
+    INTEGER(i_std), INTENT(in)                         :: ins          !! Soiltile index (1-nstm, unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: njsc         !! Index of the dominant soil textural class in grid cell 
+                                                                       !! (1-nscm, unitless)    
+    
+    !! 0.2 Output variables
+
+    LOGICAL, DIMENSION(kjpindex,nstm), INTENT(out)     :: is_under_mcr !! Flag diagnosing under residual soil moisture
+    REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check        !! delta SM - flux
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                       :: ji,jsl
+    REAL(r_std)                          :: excess
+    REAL(r_std), DIMENSION(kjpindex)     :: excessji
+    REAL(r_std), DIMENSION(kjpindex)     :: tmci      !! total SM at beginning of routine
+    REAL(r_std), DIMENSION(kjpindex)     :: tmcf      !! total SM at end of routine
+
+!_ ================================================================================================================================       
+
+    !! 1. We calculate the total SM at the beginning of the routine
+    IF (check_cwrr) THEN
+       tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
+       DO jsl = 2,nslm-1
+          tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
+               + dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
+       ENDDO
+       tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
+    ENDIF
+
+    !! 2. Smoothes the profile to avoid negative values of punctual soil moisture
+
+    ! 2.1 smoothing from top to bottom
+    DO jsl = 1,nslm-2
+       DO ji=1, kjpindex
+          excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
+          mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) - excess * &
+               &  (dz(jsl)+dz(jsl+1))/(dz(jsl+1)+dz(jsl+2))
+       ENDDO
+    ENDDO
+
+    jsl = nslm-1
+    DO ji=1, kjpindex
+       excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
+       mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
+       mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) - excess * &
+            &  (dz(jsl)+dz(jsl+1))/dz(jsl+1)
+    ENDDO
+
+    jsl = nslm
+    DO ji=1, kjpindex
+       excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
+       mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
+       mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) - excess * &
+            &  dz(jsl)/(dz(jsl-1)+dz(jsl))
+    ENDDO
+
+    ! 2.2 smoothing from bottom to top
+    DO jsl = nslm-1,2,-1
+       DO ji=1, kjpindex
+          excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
+          mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) - excess * &
+               &  (dz(jsl)+dz(jsl+1))/(dz(jsl-1)+dz(jsl))
+       ENDDO
+    ENDDO
+
+    ! 2.3 diagnoses is_under_mcr(ji), and updates the entire profile 
+    ! excess > 0
+    DO ji=1, kjpindex
+       excessji(ji) = mask_soiltile(ji,ins) * MAX(mcr(njsc(ji))-mc(ji,1,ins),zero)
+    ENDDO
+    DO ji=1, kjpindex
+       mc(ji,1,ins) = mc(ji,1,ins) + excessji(ji) ! then mc(1)=mcr
+       is_under_mcr(ji,ins) = (excessji(ji) .GT. min_sechiba)
+    ENDDO
+
+    ! 2.4 The amount of water corresponding to excess in the top soil layer is redistributed in all soil layers
+      ! -excess(ji) * dz(2) / deux donne le deficit total, negatif, en mm
+      ! diviser par la profondeur totale en mm donne des delta_mc identiques en chaque couche, en mm
+      ! retransformes en delta_mm par couche selon les bonnes eqs (eqs_hydrol.pdf, Eqs 13-15), puis sommes
+      ! retourne bien le deficit total en mm
+    DO jsl = 1, nslm
+       DO ji=1, kjpindex
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) - excessji(ji) * dz(2) / (deux * zmaxh*mille)
+       ENDDO
+    ENDDO
+    ! This can lead to mc(jsl) < mcr depending on the value of excess,
+    ! but this is no major pb for the diffusion
+    ! Yet, we need to prevent evaporation if is_under_mcr
+    
+    !! Note that we check that mc > min_sechiba in hydrol_soil 
+
+    ! We just make sure that mc remains at 0 where soiltile=0
+    DO jsl = 1, nslm
+       DO ji=1, kjpindex
+          mc(ji,jsl,ins) = mask_soiltile(ji,ins) * mc(ji,jsl,ins)
+       ENDDO
+    ENDDO
+
+    !! 3. For water conservation check, We calculate the total SM at the beginning of the routine,
+    !!    and export the difference with the flux
+    IF (check_cwrr) THEN
+       tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
+       DO jsl = 2,nslm-1
+          tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
+               + dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
+       ENDDO
+       tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
+       ! Normally, tcmf=tmci since we just redistribute the deficit 
+       check(:,ins) = tmcf(:)-tmci(:)
+    ENDIF
+       
+  END SUBROUTINE hydrol_soil_smooth_under_mcr
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_smooth_over_mcs
+!!
+!>\BRIEF        : Modifies the soil moisture profile to avoid over-saturation values, 
+!!                by putting the excess in ru_ns
+!!                Thus, no point remain where such "excess" values remain (is_over_mcs becomes useless) 
+!!
+!! DESCRIPTION  :
+!! The "excesses" over-saturation are corrected from top to bottom, by transfer of excesses 
+!! to the lower layers. The reverse transfer is performed to smooth any remaining "excess" in the bottom layer.
+!! If some "excess" remain afterwards, the entire soil profile is at the threshold value (mcs or mcr), 
+!! and the remaining "excess" is necessarily concentrated in the top layer. 
+!! Eventually, the remaining "excess" creates rudr_corr, to be added to ru_ns or dr_ns
+!! 1. We calculate the total SM at the beginning of the routine
+!! 2. In case of over-saturation we put the water where it is possible by smoothing
+!! 3. The excess is transformed into surface runoff, with conversion from m3/m3 to kg/m2
+!! 4. For water conservation checks, we calculate the total SM at the beginning of the routine,
+!!    and export the difference with the flux
+!!
+!! RECENT CHANGE(S) : 2016 by A. Ducharne
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_smooth_over_mcs
+
+  SUBROUTINE hydrol_soil_smooth_over_mcs(kjpindex, ins, njsc, is_over_mcs, rudr_corr, check)
+
+    !- arguments
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                           :: kjpindex        !! Domain size
+    INTEGER(i_std), INTENT(in)                           :: ins             !! Soiltile index (1-nstm, unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: njsc            !! Index of the dominant soil textural class in grid cell 
+                                                                            !! (1-nscm, unitless)
+    
+    !! 0.2 Output variables
+
+    LOGICAL, DIMENSION(kjpindex), INTENT(out)            :: is_over_mcs     !! Flag diagnosing over saturated soil moisture  
+    REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out)   :: check           !! delta SM - flux
+    
+    !! 0.3 Modified variables   
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(inout):: rudr_corr         !! Surface runoff produced to correct excess (mm/dtstep)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                        :: ji,jsl
+    REAL(r_std)                           :: excess
+    REAL(r_std), DIMENSION(kjpindex)      :: tmci    !! total SM at beginning of routine
+    REAL(r_std), DIMENSION(kjpindex)      :: tmcf    !! total SM at end of routine
+
+    !_ ================================================================================================================================
+
+    !! 1. We calculate the total SM at the beginning of the routine
+    IF (check_cwrr) THEN
+       tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
+       DO jsl = 2,nslm-1
+          tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
+               + dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
+       ENDDO
+       tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
+    ENDIF
+
+    !! 2. In case of over-saturation we put the water where it is possible by smoothing
+
+    ! 2.1 smoothing from top to bottom
+    DO jsl = 1, nslm-2
+       DO ji=1, kjpindex
+          excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
+          mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) + excess * &
+               &  (dz(jsl)+dz(jsl+1))/(dz(jsl+1)+dz(jsl+2))
+       ENDDO
+    ENDDO
+
+    jsl = nslm-1
+    DO ji=1, kjpindex
+       excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
+       mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
+       mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) + excess * &
+            &  (dz(jsl)+dz(jsl+1))/dz(jsl+1)
+    ENDDO
+
+    jsl = nslm
+    DO ji=1, kjpindex
+       excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
+       mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
+       mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) + excess * &
+            &  dz(jsl)/(dz(jsl-1)+dz(jsl))
+    ENDDO
+
+    ! 2.2 smoothing from bottom to top, leading  to keep most of the excess in the soil column
+    DO jsl = nslm-1,2,-1
+       DO ji=1, kjpindex
+          excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
+          mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) + excess * &
+               &  (dz(jsl)+dz(jsl+1))/(dz(jsl-1)+dz(jsl))
+       ENDDO
+    ENDDO
+
+    !! 3. The excess is transformed into surface runoff, with conversion from m3/m3 to kg/m2
+
+    DO ji=1, kjpindex
+       excess = mask_soiltile(ji,ins) * MAX(mc(ji,1,ins)-mcs(njsc(ji)),zero)
+       mc(ji,1,ins) = mc(ji,1,ins) - excess ! then mc(1)=mcs
+       rudr_corr(ji,ins) = rudr_corr(ji,ins) + excess * dz(2) / deux 
+       is_over_mcs(ji) = .FALSE.
+    ENDDO
+
+    !! 4. For water conservation checks, we calculate the total SM at the beginning of the routine,
+    !!    and export the difference with the flux
+
+    IF (check_cwrr) THEN
+       tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
+       DO jsl = 2,nslm-1
+          tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
+               + dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
+       ENDDO
+       tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
+       ! Normally, tcmf=tmci-rudr_corr
+       check(:,ins) = tmcf(:)-(tmci(:)-rudr_corr(:,ins))
+    ENDIF
+    
+  END SUBROUTINE hydrol_soil_smooth_over_mcs
+
+ !! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_smooth_over_mcs2
+!!
+!>\BRIEF        : Modifies the soil moisture profile to avoid over-saturation values, 
+!!                by putting the excess in ru_ns
+!!                Thus, no point remain where such "excess" values remain (is_over_mcs becomes useless) 
+!!
+!! DESCRIPTION  :
+!! The "excesses" over-saturation are corrected, by directly discarding the excess as rudr_corr,
+!! to be added to ru_ns or dr_nsrunoff (via rudr_corr).
+!! Therefore, there is no more smoothing, and this helps preventing the saturation of too many layers,
+!! which leads to numerical errors with tridiag.
+!! 1. We calculate the total SM at the beginning of the routine
+!! 2. In case of over-saturation, we directly eliminate the excess via rudr_corr
+!!    The calculation of the adjustement flux needs to account for nodes n-1 and n+1.
+!! 3. For water conservation checks, we calculate the total SM at the beginning of the routine,
+!!    and export the difference with the flux   
+!!
+!! RECENT CHANGE(S) : 2016 by A. Ducharne
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_smooth_over_mcs2
+
+  SUBROUTINE hydrol_soil_smooth_over_mcs2(kjpindex, ins, njsc, is_over_mcs, rudr_corr, check)
+
+    !- arguments
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                           :: kjpindex        !! Domain size
+    INTEGER(i_std), INTENT(in)                           :: ins             !! Soiltile index (1-nstm, unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: njsc            !! Index of the dominant soil textural class in grid cell 
+                                                                            !! (1-nscm, unitless)
+    
+    !! 0.2 Output variables
+
+    LOGICAL, DIMENSION(kjpindex), INTENT(out)            :: is_over_mcs     !! Flag diagnosing over saturated soil moisture  
+    REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out)   :: check           !! delta SM - flux
+    
+    !! 0.3 Modified variables   
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(inout):: rudr_corr         !! Surface runoff produced to correct excess (mm/dtstep)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                        :: ji,jsl
+    REAL(r_std), DIMENSION(kjpindex,nslm) :: excess
+    REAL(r_std), DIMENSION(kjpindex)      :: tmci    !! total SM at beginning of routine
+    REAL(r_std), DIMENSION(kjpindex)      :: tmcf    !! total SM at end of routine
+
+!_ ================================================================================================================================       
+    !-
+
+    !! 1. We calculate the total SM at the beginning of the routine
+    IF (check_cwrr) THEN
+       tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
+       DO jsl = 2,nslm-1
+          tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
+               + dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
+       ENDDO
+       tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
+    ENDIF  
+
+    !! 2. In case of over-saturation, we don't do any smoothing,
+    !! but directly eliminate the excess as runoff (via rudr_corr)
+    !    we correct the calculation of the adjustement flux, which needs to account for nodes n-1 and n+1  
+    !    for the calculation to remain simple and accurate, we directly drain all the oversaturated mc,
+    !    without transfering to lower layers        
+
+    !! 2.1 thresholding from top to bottom, with excess defined along jsl
+    DO jsl = 1, nslm
+       DO ji=1, kjpindex
+          excess(ji,jsl) = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero) ! >=0
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess(ji,jsl) ! here mc either does not change or decreases
+       ENDDO
+    ENDDO
+
+    !! 2.2 To ensure conservation, this needs to be balanced by additional drainage (in kg/m2/dt)                        
+    DO ji = 1, kjpindex
+       rudr_corr(ji,ins) = dz(2) * ( trois*excess(ji,1) + excess(ji,2) )/huit ! top layer = initialisation  
+    ENDDO
+    DO jsl = 2,nslm-1 ! intermediate layers      
+       DO ji = 1, kjpindex
+          rudr_corr(ji,ins) = rudr_corr(ji,ins) + dz(jsl) &
+               & * (trois*excess(ji,jsl)+excess(ji,jsl-1))/huit &
+               & + dz(jsl+1) * (trois*excess(ji,jsl)+excess(ji,jsl+1))/huit
+       ENDDO
+    ENDDO
+    DO ji = 1, kjpindex
+       rudr_corr(ji,ins) = rudr_corr(ji,ins) + dz(nslm) &    ! bottom layer 
+            & * (trois * excess(ji,nslm) + excess(ji,nslm-1))/huit
+       is_over_mcs(ji) = .FALSE. 
+    END DO
+
+    !! 3. For water conservation checks, we calculate the total SM at the beginning of the routine,
+    !!    and export the difference with the flux
+
+    IF (check_cwrr) THEN
+       tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
+       DO jsl = 2,nslm-1
+          tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
+               + dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
+       ENDDO
+       tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
+       ! Normally, tcmf=tmci-rudr_corr
+       check(:,ins) = tmcf(:)-(tmci(:)-rudr_corr(:,ins))
+    ENDIF
+    
+  END SUBROUTINE hydrol_soil_smooth_over_mcs2
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_diag_soil_flux
+!!
+!>\BRIEF        : This subroutine diagnoses the vertical liquid water fluxes between the 
+!!                different soil layers, based on each layer water budget. It also checks the
+!!                corresponding water conservation (during redistribution).
+!!
+!! DESCRIPTION  :
+!! 1. Initialize qflux from the bottom, with dr_ns
+!! 2. Between layer nslm and nslm-1, by means of water budget knowing mc changes and flux at the lowest interface
+!! 3. We go up, and deduct qflux(1:nslm-2), still by means of water budget
+!! 4. Water balance verification: pursuing upward water budget, the flux at the surface should equal -flux_top  
+!!
+!! RECENT CHANGE(S) : 2016 by A. Ducharne to fit hydrol_soil
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_diag_soil_flux
+
+  SUBROUTINE hydrol_diag_soil_flux(kjpindex,ins,mclint,flux_top)
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex        !! Domain size
+    INTEGER(i_std), INTENT(in)                         :: ins             !! index of soil type
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT(in) :: mclint          !! mc values at the beginning of the time step
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)      :: flux_top        !! Exfiltration (bare soil evaporation minus infiltration)
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION (kjpindex)                  :: check_temp      !! Diagnosed flux at soil surface, should equal -flux_top
+    INTEGER(i_std)                                     :: jsl,ji
+
+    !_ ================================================================================================================================
+
+    !- Compute the diffusion flux at every level from bottom to top (using mcl,mclint, and sink values)
+    DO ji = 1, kjpindex
+
+       !! 1. Initialize qflux_ns from the bottom, with dr_ns
+       jsl = nslm
+       qflux_ns(ji,jsl,ins) = dr_ns(ji,ins)
+       !! 2. Between layer nslm and nslm-1, by means of water budget 
+       !!    knowing mc changes and flux at the lowest interface
+       !     qflux_ns is downward
+       jsl = nslm-1
+       qflux_ns(ji,jsl,ins) = qflux_ns(ji,jsl+1,ins) & 
+            &  + (mcl(ji,jsl,ins)-mclint(ji,jsl) &
+            &  + trois*mcl(ji,jsl+1,ins) - trois*mclint(ji,jsl+1)) &
+            &  * (dz(jsl+1)/huit) &
+            &  + rootsink(ji,jsl+1,ins) 
+    ENDDO
+
+    !! 3. We go up, and deduct qflux_ns(1:nslm-2), still by means of water budget
+    ! Here, qflux_ns(ji,1,ins) is the downward flux between the top soil layer and the 2nd one
+    DO jsl = nslm-2,1,-1
+       DO ji = 1, kjpindex
+          qflux_ns(ji,jsl,ins) = qflux_ns(ji,jsl+1,ins) & 
+               &  + (mcl(ji,jsl,ins)-mclint(ji,jsl) &
+               &  + trois*mcl(ji,jsl+1,ins) - trois*mclint(ji,jsl+1)) &
+               &  * (dz(jsl+1)/huit) &
+               &  + rootsink(ji,jsl+1,ins) &
+               &  + (dz(jsl+2)/huit) &
+               &  * (trois*mcl(ji,jsl+1,ins) - trois*mclint(ji,jsl+1) &
+               &  + mcl(ji,jsl+2,ins)-mclint(ji,jsl+2)) 
+       END DO
+    ENDDO
+    
+    !! 4. Water balance verification: pursuing upward water budget, the flux at the surface (check_temp) 
+    !! should equal -flux_top
+    DO ji = 1, kjpindex
+
+       check_temp(ji) =  qflux_ns(ji,1,ins) + (dz(2)/huit) &
+            &  * (trois* (mcl(ji,1,ins)-mclint(ji,1)) + (mcl(ji,2,ins)-mclint(ji,2))) &
+            &  + rootsink(ji,1,ins)    
+       ! flux_top is positive when upward, while check_temp is positive when downward
+       check_top_ns(ji,ins) = flux_top(ji)+check_temp(ji)
+
+       IF (ABS(check_top_ns(ji,ins))/dt_sechiba .GT. min_sechiba) THEN
+          ! Diagnosed (check_temp) and imposed (flux_top) differ by more than 1.e-8 mm/s 
+          WRITE(numout,*) 'Problem in the water balance, qflux_ns computation, surface fluxes', flux_top(ji),check_temp(ji)
+          WRITE(numout,*) 'Diagnosed and imposed fluxes differ by more than 1.e-8 mm/s: ', check_top_ns(ji,ins)
+          WRITE(numout,*) 'ji', ji, 'jsl',jsl,'ins',ins
+          WRITE(numout,*) 'mclint', mclint(ji,:)
+          WRITE(numout,*) 'mcl', mcl(ji,:,ins)
+          WRITE (numout,*) 'rootsink', rootsink(ji,1,ins)
+          CALL ipslerr_p(1, 'hydrol_diag_soil_flux', 'NOTE:',&
+               & 'Problem in the water balance, qflux_ns computation','')
+       ENDIF
+    ENDDO
+
+  END SUBROUTINE hydrol_diag_soil_flux
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_tridiag
+!!
+!>\BRIEF        This subroutine solves a set of linear equations which has a tridiagonal coefficient matrix. 
+!!
+!! DESCRIPTION  : It is only applied in the grid-cells where resolv(ji)=TRUE
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : mcl (global module variable)
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_tridiag 
+
+  SUBROUTINE hydrol_soil_tridiag(kjpindex,ins)
+
+    !- arguments
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex        !! Domain size
+    INTEGER(i_std), INTENT(in)                         :: ins             !! number of soil type
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ji,jsl
+    REAL(r_std), DIMENSION(kjpindex)                   :: bet
+    REAL(r_std), DIMENSION(kjpindex,nslm)              :: gam
+
+!_ ================================================================================================================================
+    DO ji = 1, kjpindex
+
+       IF (resolv(ji)) THEN
+          bet(ji) = tmat(ji,1,2)
+          mcl(ji,1,ins) = rhs(ji,1)/bet(ji)
+       ENDIF
+    ENDDO
+
+    DO jsl = 2,nslm
+       DO ji = 1, kjpindex
+          
+          IF (resolv(ji)) THEN
+
+             gam(ji,jsl) = tmat(ji,jsl-1,3)/bet(ji)
+             bet(ji) = tmat(ji,jsl,2) - tmat(ji,jsl,1)*gam(ji,jsl)
+             mcl(ji,jsl,ins) = (rhs(ji,jsl)-tmat(ji,jsl,1)*mcl(ji,jsl-1,ins))/bet(ji)
+          ENDIF
+
+       ENDDO
+    ENDDO
+
+    DO ji = 1, kjpindex
+       IF (resolv(ji)) THEN
+          DO jsl = nslm-1,1,-1
+             mcl(ji,jsl,ins) = mcl(ji,jsl,ins) - gam(ji,jsl+1)*mcl(ji,jsl+1,ins)
+          ENDDO
+       ENDIF
+    ENDDO
+
+  END SUBROUTINE hydrol_soil_tridiag
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_coef
+!!
+!>\BRIEF        Computes coef for the linearised hydraulic conductivity 
+!! k_lin=a_lin mc_lin+b_lin and the linearised diffusivity d_lin. 
+!!
+!! DESCRIPTION  :
+!! First, we identify the interval i in which the current value of mc is located.
+!! Then, we give the values of the linearized parameters to compute 
+!! conductivity and diffusivity as K=a*mc+b and d.
+!!
+!! RECENT CHANGE(S) : Addition of the dependence to profil_froz_hydro_ns 
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_coef
+ 
+  SUBROUTINE hydrol_soil_coef(kjpindex,ins,njsc)
+
+    IMPLICIT NONE
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                        :: kjpindex         !! Domain size
+    INTEGER(i_std), INTENT(in)                        :: ins              !! Index of soil type
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)  :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                    :: jsl,ji,i
+    REAL(r_std)                                       :: mc_ratio
+    REAL(r_std)                                       :: mc_used    !! Used liquid water content
+    REAL(r_std)                                       :: x,m
+    
+!_ ================================================================================================================================
+
+    IF (ok_freeze_cwrr) THEN
+    
+       ! Calculation of liquid and frozen saturation degrees with respect to residual
+       ! x=liquid saturation degree/residual=(mcl-mcr)/(mcs-mcr)
+       ! 1-x=frozen saturation degree/residual=(mcf-mcr)/(mcs-mcr) (=profil_froz_hydro)
+       
+       DO jsl=1,nslm
+          DO ji=1,kjpindex
+             
+             x = 1._r_std - profil_froz_hydro_ns(ji, jsl,ins)
+             
+             ! mc_used is used in the calculation of hydrological properties
+             ! It corresponds to a liquid mc, but the expression is different from mcl in hydrol_soil,
+             ! to ensure that we get the a, b, d of the first bin when mcl<mcr
+             mc_used = mcr(njsc(ji))+x*MAX((mc(ji,jsl, ins)-mcr(njsc(ji))),zero) 
+             !
+             ! calcul de k based on mc_liq
+             !
+             i= MAX(imin, MIN(imax-1, INT(imin +(imax-imin)*(mc_used-mcr(njsc(ji)))/(mcs(njsc(ji))-mcr(njsc(ji))))))
+             a(ji,jsl) = a_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
+             b(ji,jsl) = b_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
+             d(ji,jsl) = d_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm^2/d
+             k(ji,jsl) = MAX(k_lin(imin+1,jsl,njsc(ji)), &
+                  a_lin(i,jsl,njsc(ji)) * mc_used + b_lin(i,jsl,njsc(ji))) ! in mm/d
+          ENDDO ! loop on grid
+       ENDDO
+             
+    ELSE
+
+       ! .NOT. ok_freeze_cwrr
+       DO jsl=1,nslm
+          DO ji=1,kjpindex 
+             
+             ! it is impossible to consider a mc<mcr for the binning
+             mc_ratio = MAX(mc(ji,jsl,ins)-mcr(njsc(ji)), zero)/(mcs(njsc(ji))-mcr(njsc(ji)))
+             
+             i= MAX(MIN(INT((imax-imin)*mc_ratio)+imin , imax-1), imin)
+             a(ji,jsl) = a_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
+             b(ji,jsl) = b_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
+             d(ji,jsl) = d_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm^2/d
+             k(ji,jsl) = kfact_root(ji,jsl,ins) * MAX(k_lin(imin+1,jsl,njsc(ji)), &
+                  a_lin(i,jsl,njsc(ji)) * mc(ji,jsl,ins) + b_lin(i,jsl,njsc(ji)))  ! in mm/d
+          END DO 
+       END DO
+    ENDIF
+    
+  END SUBROUTINE hydrol_soil_coef
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_froz
+!!
+!>\BRIEF        Computes profil_froz_hydro_ns, the fraction of frozen water in the soil layers. 
+!!
+!! DESCRIPTION  :
+!!
+!! RECENT CHANGE(S) : Created by A. Ducharne in 2016.
+!!
+!! MAIN OUTPUT VARIABLE(S) : profil_froz_hydro_ns
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_froz
+ 
+  SUBROUTINE hydrol_soil_froz(kjpindex,ins,njsc)
+
+    IMPLICIT NONE
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                        :: kjpindex         !! Domain size
+    INTEGER(i_std), INTENT(in)                        :: ins              !! Index of soil type
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)  :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                    :: jsl,ji,i
+    REAL(r_std)                                       :: x,m
+    REAL(r_std)                                       :: denom
+    REAL(r_std),DIMENSION (kjpindex)                  :: froz_frac_moy
+    REAL(r_std),DIMENSION (kjpindex)                  :: smtot_moy
+    REAL(r_std),DIMENSION (kjpindex,nslm)             :: mc_ns  
+  
+!_ ================================================================================================================================
+
+!    ONLY FOR THE (ok_freeze_cwrr) CASE
+    
+       ! Calculation of liquid and frozen saturation degrees above residual moisture
+       !   x=liquid saturation degree/residual=(mcl-mcr)/(mcs-mcr)
+       !   1-x=frozen saturation degree/residual=(mcf-mcr)/(mcs-mcr) (=profil_froz_hydro)
+       ! It's important for the good work of the water diffusion scheme (tridiag) that the total
+       ! liquid water also includes mcr, so mcl > 0 even when x=0
+       
+       DO jsl=1,nslm
+          DO ji=1,kjpindex
+             ! Van Genuchten parameter for thermodynamical calculation
+             m = 1. -1./nvan(njsc(ji))
+           
+             IF ((.NOT. ok_thermodynamical_freezing).OR.(mc(ji,jsl, ins).LT.(mcr(njsc(ji))+min_sechiba))) THEN
+                ! Linear soil freezing or soil moisture below residual
+                IF (temp_hydro(ji, jsl).GE.(ZeroCelsius+fr_dT/2.)) THEN
+                   x=1._r_std
+                ELSE IF ( (temp_hydro(ji,jsl) .GE. (ZeroCelsius-fr_dT/2.)) .AND. &
+                     (temp_hydro(ji,jsl) .LT. (ZeroCelsius+fr_dT/2.)) ) THEN 
+                   x=(temp_hydro(ji, jsl)-(ZeroCelsius-fr_dT/2.))/fr_dT
+                ELSE 
+                   x=0._r_std
+                ENDIF
+             ELSE IF (ok_thermodynamical_freezing) THEN
+                ! Thermodynamical soil freezing
+                IF (temp_hydro(ji, jsl).GE.(ZeroCelsius+fr_dT/2.)) THEN
+                   x=1._r_std
+                ELSE IF ( (temp_hydro(ji,jsl) .GE. (ZeroCelsius-fr_dT/2.)) .AND. &
+                     (temp_hydro(ji,jsl) .LT. (ZeroCelsius+fr_dT/2.)) ) THEN
+                   ! Factor 2.2 from the PhD of Isabelle Gouttevin
+                   x=MIN(((mcs(njsc(ji))-mcr(njsc(ji))) &
+                        *((2.2*1000.*avan(njsc(ji))*(ZeroCelsius+fr_dT/2.-temp_hydro(ji, jsl)) &
+                        *lhf/ZeroCelsius/10.)**nvan(njsc(ji))+1.)**(-m)) / &
+                        (mc(ji,jsl, ins)-mcr(njsc(ji))),1._r_std)                
+                ELSE
+                   x=0._r_std 
+                ENDIF
+             ENDIF
+             
+             profil_froz_hydro_ns(ji,jsl,ins) = 1._r_std-x
+    
+             mc_ns(ji,jsl)=mc(ji,jsl,ins)/mcs(njsc(ji))
+         
+          ENDDO ! loop on grid
+       ENDDO
+
+       ! Apply correction on the frozen fraction
+       froz_frac_moy(:)=zero
+       denom=zero
+       DO jsl=1,nslm
+          froz_frac_moy(:)=froz_frac_moy(:)+dh(jsl)*profil_froz_hydro_ns(:,jsl,ins)
+          denom=denom+dh(jsl)
+       ENDDO
+       froz_frac_moy(:)=froz_frac_moy(:)/denom
+       
+       smtot_moy(:)=zero 
+       denom=zero 
+       DO jsl=1,nslm-1 
+          smtot_moy(:)=smtot_moy(:)+dh(jsl)*mc_ns(:,jsl) 
+          denom=denom+dh(jsl) 
+       ENDDO 
+       smtot_moy(:)=smtot_moy(:)/denom
+      
+       DO jsl=1,nslm
+          profil_froz_hydro_ns(:,jsl,ins)=MIN(profil_froz_hydro_ns(:,jsl,ins)* &
+                                              (froz_frac_moy(:)**froz_frac_corr)* &
+                                              (smtot_moy(:)**smtot_corr), max_froz_hydro)
+       ENDDO
+    
+     END SUBROUTINE hydrol_soil_froz
+     
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_setup
+!!
+!>\BRIEF        This subroutine computes the matrix coef.  
+!!
+!! DESCRIPTION  : None 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : matrix coef
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_soil_setup(kjpindex,ins)
+
+
+    IMPLICIT NONE
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                        :: kjpindex          !! Domain size
+    INTEGER(i_std), INTENT(in)                        :: ins               !! index of soil type
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std) :: jsl,ji
+    REAL(r_std)                        :: temp3, temp4
+
+!_ ================================================================================================================================
+    !-we compute tridiag matrix coefficients (LEFT and RIGHT) 
+    ! of the system to solve [LEFT]*mc_{t+1}=[RIGHT]*mc{t}+[add terms]: 
+    ! e(nslm),f(nslm),g1(nslm) for the [left] vector
+    ! and ep(nslm),fp(nslm),gp(nslm) for the [right] vector
+
+    ! w_time=1 (in constantes_soil) indicates implicit computation for diffusion 
+    temp3 = w_time*(dt_sechiba/one_day)/deux
+    temp4 = (un-w_time)*(dt_sechiba/one_day)/deux
+
+    ! Passage to arithmetic means for layer averages also in this subroutine : Aurelien 11/05/10
+
+    !- coefficient for first layer
+    DO ji = 1, kjpindex
+       e(ji,1) = zero
+       f(ji,1) = trois * dz(2)/huit  + temp3 &
+            & * ((d(ji,1)+d(ji,2))/(dz(2))+a(ji,1))
+       g1(ji,1) = dz(2)/(huit)       - temp3 &
+            & * ((d(ji,1)+d(ji,2))/(dz(2))-a(ji,2))
+       ep(ji,1) = zero
+       fp(ji,1) = trois * dz(2)/huit - temp4 &
+            & * ((d(ji,1)+d(ji,2))/(dz(2))+a(ji,1))
+       gp(ji,1) = dz(2)/(huit)       + temp4 &
+            & * ((d(ji,1)+d(ji,2))/(dz(2))-a(ji,2))
+    ENDDO
+
+    !- coefficient for medium layers
+
+    DO jsl = 2, nslm-1
+       DO ji = 1, kjpindex
+          e(ji,jsl) = dz(jsl)/(huit)                        - temp3 &
+               & * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl))+a(ji,jsl-1))
+
+          f(ji,jsl) = trois * (dz(jsl)+dz(jsl+1))/huit  + temp3 &
+               & * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl)) + &
+               & (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1)) )
+
+          g1(ji,jsl) = dz(jsl+1)/(huit)                     - temp3 &
+               & * ((d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1))-a(ji,jsl+1))
+
+          ep(ji,jsl) = dz(jsl)/(huit)                       + temp4 &
+               & * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl))+a(ji,jsl-1))
+
+          fp(ji,jsl) = trois * (dz(jsl)+dz(jsl+1))/huit - temp4 &
+               & * ( (d(ji,jsl)+d(ji,jsl-1))/(dz(jsl)) + &
+               & (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1)) )
+
+          gp(ji,jsl) = dz(jsl+1)/(huit)                     + temp4 &
+               & *((d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1))-a(ji,jsl+1))
+       ENDDO
+    ENDDO
+
+    !- coefficient for last layer
+    DO ji = 1, kjpindex
+       e(ji,nslm) = dz(nslm)/(huit)        - temp3 &
+            & * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm))+a(ji,nslm-1))
+       f(ji,nslm) = trois * dz(nslm)/huit  + temp3 &
+            & * ((d(ji,nslm)+d(ji,nslm-1)) / (dz(nslm)) &
+            & -a(ji,nslm)*(un-deux*free_drain_coef(ji,ins)))
+       g1(ji,nslm) = zero
+       ep(ji,nslm) = dz(nslm)/(huit)       + temp4 &
+            & * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm))+a(ji,nslm-1))
+       fp(ji,nslm) = trois * dz(nslm)/huit - temp4 &
+            & * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm)) &
+            & -a(ji,nslm)*(un-deux*free_drain_coef(ji,ins)))
+       gp(ji,nslm) = zero
+    ENDDO
+
+  END SUBROUTINE hydrol_soil_setup
+
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_split_soil
+!!
+!>\BRIEF        Splits 2d variables into 3d variables, per soiltile (_ns suffix), at the beginning of hydrol
+!!              At this stage, the forcing fluxes to hydrol are transformed from grid-cell averages 
+!!              to mean fluxes over vegtot=sum(soiltile)  
+!!
+!! DESCRIPTION  :
+!! 1. Split 2d variables into 3d variables, per soiltile
+!! 1.1 Throughfall
+!! 1.2 Bare soil evaporation
+!! 1.2.1 vevapnu_old
+!! 1.2.2 ae_ns new
+!! 1.3 transpiration
+!! 1.4 root sink
+!! 2. Verification: Check if the deconvolution is correct and conserves the fluxes
+!! 2.1 precisol 
+!! 2.2 ae_ns and evapnu
+!! 2.3 transpiration
+!! 2.4 root sink
+!!
+!! RECENT CHANGE(S) : 2016 by A. Ducharne to match the simplification of hydrol_soil
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_split_soil
+
+  SUBROUTINE hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel, evap_bare_lim, tot_bare_soil, e_frac)
+    ! 
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                        :: kjpindex
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in)                :: veget_max      !! max Vegetation map 
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)               :: soiltile       !! Fraction of each soiltile within vegtot (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)                    :: vevapnu        !! Bare soil evaporation
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)                :: transpir       !! Transpiration
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)                :: humrel         !! Relative humidity
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)                     :: evap_bare_lim  !!   
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)                     :: tot_bare_soil  !! Total evaporating bare soil fraction 
+    REAL(r_std), DIMENSION (kjpindex,nvm,nbdl,nstm), OPTIONAL, INTENT(in) :: e_frac         !! Relative humidity per layer
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                :: ji, jv, jsl, jst
+    REAL(r_std), DIMENSION (kjpindex)             :: vevapnu_old
+    REAL(r_std), DIMENSION (kjpindex)             :: tmp_check1
+    REAL(r_std), DIMENSION (kjpindex)             :: tmp_check2
+    REAL(r_std), DIMENSION (kjpindex,nstm)        :: tmp_check3
+
+!_ ================================================================================================================================
+    
+    !! 1. Split 2d variables into 3d variables, per soiltile
+    
+    ! Reminders:
+    !  corr_veg_soil(:,nvm,nstm) = PFT fraction per soiltile in each grid-cell
+    !      corr_veg_soil(ji,jv,jst)=veget_max(ji,jv)/soiltile(ji,jst) 
+    !  soiltile(:,nstm) = fraction of vegtot covered by each soiltile (0-1, unitless) 
+    !  vegtot(:) = total fraction of grid-cell covered by PFTs (fraction with bare soil + vegetation)
+    !  veget_max(:,nvm) = PFT fractions of vegtot+frac_nobio 
+    !  veget(:,nvm) =  fractions (of vegtot+frac_nobio) covered by vegetation in each PFT 
+    !       BUT veget(:,1)=veget_max(:,1) 
+    !  frac_bare(:,nvm) = fraction (of veget_max) with bare soil in each PFT
+    !  tot_bare_soil(:) = fraction of grid mesh covered by all bare soil (=SUM(frac_bare*veget_max))
+    !  frac_bare_ns(:,nstm) = evaporating bare soil fraction (of vegtot) per soiltile (defined in hydrol_vegupd)
+    
+    !! 1.1 Throughfall
+    ! Transformation from precisol (flux from PFT jv in m2 of grid-mesh)
+    ! to  precisol_ns (flux from contributing PFTs with another unit, in m2 of soiltile)
+    precisol_ns(:,:)=zero
+    DO jv=1,nvm
+       DO ji=1,kjpindex
+          jst=pref_soil_veg(jv)
+          IF((veget_max(ji,jv).GT.min_sechiba) .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT. min_sechiba)) THEN
+             precisol_ns(ji,jst) = precisol_ns(ji,jst) + &
+                     precisol(ji,jv) / (soiltile(ji,jst)*vegtot(ji))                
+          ENDIF
+       END DO
+    END DO
+    
+    !! 1.2 Bare soil evaporation
+    !! 1.2.1 vevapnu_old
+! AD16*** vevapnu_old ne sert que pour le split suivant de vevapnu (issu de enerbil) en ae_ns pour hydrol_soil
+!           mais il ne semble y avoir aucune bonne raison de contraindre ae_ns en fonction de vevapnu_old
+!    vevapnu_old(:)=zero
+!    DO jst=1,nstm
+!       DO ji=1,kjpindex
+!          IF ( vegtot(ji) .GT. min_sechiba) THEN
+!             vevapnu_old(ji)=vevapnu_old(ji)+ &
+!                  & ae_ns(ji,jst)*soiltile(ji,jst)*vegtot(ji)
+!          ENDIF
+!       END DO
+!    END DO
+    
+    !! 1.2.2 ae_ns new
+! AD16*** les lignes ci-dessous sont excessivement compliquees et ne garantissent pas que ae_ns = 0 si evap_bare_lim=0 
+!           c'est notamment le cas pour les 3emes et 6emes conditions
+!    DO jst=1,nstm
+!       DO ji=1,kjpindex
+!          IF (vevapnu_old(ji).GT.min_sechiba) THEN   
+!             IF(evap_bare_lim(ji).GT.min_sechiba) THEN       
+!                ae_ns(ji,jst) = vevapnu(ji) * evap_bare_lim_ns(ji,jst)/evap_bare_lim(ji) 
+!             ELSE
+!                IF(vevapnu_old(ji).GT.min_sechiba) THEN  
+!                   ae_ns(ji,jst)=ae_ns(ji,jst) * vevapnu(ji)/vevapnu_old(ji) ! 3Ãšme condition
+!                ELSE
+!                   ae_ns(ji,jst)=zero
+!                ENDIF
+!             ENDIF
+!          ELSEIF(frac_bare_ns(ji,jst).GT.min_sechiba) THEN
+!             IF(evap_bare_lim(ji).GT.min_sechiba) THEN  
+!                ae_ns(ji,jst) = vevapnu(ji) * evap_bare_lim_ns(ji,jst)/evap_bare_lim(ji)
+!             ELSE
+!                IF(tot_bare_soil(ji).GT.min_sechiba) THEN  
+!                   ae_ns(ji,jst) = vevapnu(ji) * frac_bare_ns(ji,jst)/tot_bare_soil(ji) ! 6Ãšme condition
+!                ELSE
+!                   ae_ns(ji,jst) = zero
+!                ENDIF
+!             ENDIF
+!          ENDIF
+!       END DO
+!    END DO
+! ADNV27072016: we believe the following block should be used (tests needed before committ, since AD16*** had pb with it)    
+!!$    ! given the definition of evap_bare_lim, it leads to sum(ae_ns(ji,jst)*soiltile(ji,jst)*vegtot(ji))=vevapnu(ji)
+    ae_ns(:,:)=zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          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) = zero
+          ENDIF
+       ENDDO
+    ENDDO
+    
+    !! 1.3 transpiration
+    ! Transformation from transpir (flux from PFT jv in m2 of grid-mesh)
+    ! to tr_ns (flux from contributing PFTs with another unit, in m2 of soiltile)
+    ! To do next: simplify the use of humrelv(ji,jv,jst) /humrel(ji,jv), since both are equal
+    tr_ns(:,:)=zero
+    DO jv=1,nvm
+       jst=pref_soil_veg(jv)
+       DO ji=1,kjpindex
+          IF ((humrel(ji,jv).GT.min_sechiba) .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT.min_sechiba))THEN 
+             tr_ns(ji,jst)= tr_ns(ji,jst) &
+                  + transpir(ji,jv) * (humrelv(ji,jv,jst) / humrel(ji,jv)) &
+                  / (soiltile(ji,jst)*vegtot(ji))
+                     
+             ENDIF
+       END DO
+    END DO
+
+    !! 1.4 root sink
+    ! Transformation from transpir (flux from PFT jv in m2 of grid-mesh)
+    ! to root_sink (flux from contributing PFTs and soil layer with another unit, in m2 of soiltile)
+    rootsink(:,:,:)=zero
+    IF(ok_hydrol_arch)THEN
+       DO jv = 1,nvm
+          jst=pref_soil_veg(jv)  ! OBS jst = 1,nstm
+          DO jsl=1,nslm
+             DO ji=1,kjpindex
+                IF (humrel(ji,jv).GT.min_sechiba .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT. min_sechiba)) THEN 
+                   rootsink(ji,jsl,jst) = rootsink(ji,jsl,jst) &
+                         + (transpir(ji,jv)*e_frac(ji,jv,jsl,jst)) &
+                        / (soiltile(ji,jst)*vegtot(ji)) 
+                END IF
+             END DO
+          END DO
+       END DO
+
+    ELSE ! IF(ok_hydrol_arch)
+
+       DO jv=1,nvm
+          jst=pref_soil_veg(jv)
+          DO jsl=1,nslm
+             DO ji=1,kjpindex
+                IF ((humrel(ji,jv).GT.min_sechiba) .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT.min_sechiba)) THEN 
+                   rootsink(ji,jsl,jst) = rootsink(ji,jsl,jst) &
+                           + transpir(ji,jv) * (us(ji,jv,jst,jsl) / humrel(ji,jv)) &
+                           / (soiltile(ji,jst)*vegtot(ji))                     
+                      ! rootsink(ji,1,jst)=0 as us(ji,jv,jst,1)=0
+                END IF
+             END DO
+          END DO
+       END DO
+    ENDIF
+
+
+  END SUBROUTINE hydrol_split_soil
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_diag_soil
+!!
+!>\BRIEF        Calculates diagnostic variables at the grid-cell scale
+!!
+!! DESCRIPTION  :
+!! - 1. Apply mask_soiltile
+!! - 2. Sum 3d variables in 2d variables with fraction of vegetation per soil type
+!!
+!! RECENT CHANGE(S) : 2016 by A. Ducharne for the claculation of shumdiag_perma
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_diag_soil
+
+  SUBROUTINE hydrol_diag_soil (kjpindex, veget_max, soiltile, njsc, runoff, drainage, &
+       & evapot, vevapnu, returnflow, reinfiltration, irrigation, &
+       & shumdiag,shumdiag_perma, k_litt, litterhumdiag, humrel, vegstress, drysoil_frac, tot_melt)
+    ! 
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: veget_max       !! Max. vegetation type
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: njsc            !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltile        !! Fraction of each soil tile within vegtot (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evapot          !! 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: returnflow      !! Water returning to the deep reservoir
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: reinfiltration  !! Water returning to the top of the soil
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: irrigation      !! Water from irrigation
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: tot_melt        !!
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: drysoil_frac    !! Function of litter wetness
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: runoff          !! complete runoff
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: drainage        !! Drainage
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out)      :: shumdiag        !! relative soil moisture
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out)      :: shumdiag_perma  !! Percent of porosity filled with water (mc/mcs) used for the thermal computations
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: k_litt          !! litter cond.
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: litterhumdiag   !! litter humidity
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: humrel          !! Relative humidity
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out)      :: vegstress       !! Veg. moisture stress (only for vegetation growth)
+ 
+    !! 0.3 Modified variables 
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapnu         !!
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jv, jsl, jst, i, jd
+    REAL(r_std), DIMENSION (kjpindex)                        :: mask_vegtot
+    REAL(r_std)                                              :: k_tmp, tmc_litter_ratio
+
+!_ ================================================================================================================================
+    !
+    ! Put the prognostics variables of soil to zero if soiltype is zero
+
+    !! 1. Apply mask_soiltile
+    
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+
+             ae_ns(ji,jst) = ae_ns(ji,jst) * mask_soiltile(ji,jst)
+             dr_ns(ji,jst) = dr_ns(ji,jst) * mask_soiltile(ji,jst)
+             ru_ns(ji,jst) = ru_ns(ji,jst) * mask_soiltile(ji,jst)
+             tmc(ji,jst) =  tmc(ji,jst) * mask_soiltile(ji,jst)
+
+             DO jv=1,nvm
+                humrelv(ji,jv,jst) = humrelv(ji,jv,jst) * mask_soiltile(ji,jst)
+                DO jsl=1,nslm
+                   us(ji,jv,jst,jsl) = us(ji,jv,jst,jsl)  * mask_soiltile(ji,jst)
+                END DO
+             END DO
+
+             DO jsl=1,nslm          
+                mc(ji,jsl,jst) = mc(ji,jsl,jst)  * mask_soiltile(ji,jst)
+             END DO
+
+       END DO
+    END DO
+
+    runoff(:) = zero
+    drainage(:) = zero
+    humtot(:) = zero
+    shumdiag(:,:)= zero
+    shumdiag_perma(:,:)=zero
+    k_litt(:) = zero
+    litterhumdiag(:) = zero
+    tmc_litt_dry_mea(:) = zero
+    tmc_litt_wet_mea(:) = zero
+    tmc_litt_mea(:) = zero
+    humrel(:,:) = zero
+    vegstress(:,:) = zero
+    IF (ok_freeze_cwrr) THEN
+       profil_froz_hydro(:,:)=zero ! initialisation for the mean of profil_froz_hydro_ns
+    ENDIF
+    
+    !! 2. Sum 3d variables in 2d variables with fraction of vegetation per soil type
+
+    DO ji = 1, kjpindex
+       mask_vegtot(ji) = 0
+       IF(vegtot(ji) .GT. min_sechiba) THEN
+          mask_vegtot(ji) = 1
+       ENDIF
+    END DO
+    
+    DO ji = 1, kjpindex 
+       ! Here we weight ae_ns by the fraction of bare evaporating soil. 
+       ! This is given by frac_bare_ns, taking into account bare soil under vegetation
+       ae_ns(ji,:) = mask_vegtot(ji) * ae_ns(ji,:) * frac_bare_ns(ji,:)
+    END DO
+
+    ! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
+    DO jst = 1, nstm
+       DO ji = 1, kjpindex 
+          drainage(ji) = mask_vegtot(ji) * (drainage(ji) + vegtot(ji)*soiltile(ji,jst) * dr_ns(ji,jst))
+          runoff(ji) = mask_vegtot(ji) *  (runoff(ji) +   vegtot(ji)*soiltile(ji,jst) * ru_ns(ji,jst)) &
+               &   + (1 - mask_vegtot(ji)) * (tot_melt(ji) + irrigation(ji) + returnflow(ji) + reinfiltration(ji))
+          humtot(ji) = mask_vegtot(ji) * (humtot(ji) + vegtot(ji)*soiltile(ji,jst) * tmc(ji,jst)) 
+          IF (ok_freeze_cwrr) THEN 
+             !  profil_froz_hydro_ns comes from hydrol_soil, to remain the same as in the prognotic loop
+             profil_froz_hydro(ji,:)=mask_vegtot(ji) * &
+                  (profil_froz_hydro(ji,:) + vegtot(ji)*soiltile(ji,jst) * profil_froz_hydro_ns(ji,:, jst))
+          ENDIF
+       END DO
+    END DO
+
+    ! we add the excess of snow sublimation to vevapnu
+    ! - because vevapsno is modified in hydrol_snow if subsinksoil
+    ! - it is multiplied by vegtot because it is devided by 1-tot_frac_nobio at creation in hydrol_snow
+
+    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)
+                vegstress(ji,jv)= MAX(vegstress(ji,jv),zero)
+             ENDIF
+          END DO
+       END DO
+    END DO
+
+    DO jst=1,nstm
+       DO jv=1,nvm
+          DO ji=1,kjpindex
+             humrel(ji,jv)=humrel(ji,jv)+humrelv(ji,jv,jst)
+             humrel(ji,jv)=MAX(humrel(ji,jv),zero)
+          END DO
+       END DO
+    END DO
+
+    !! Litter... the goal is to calculate drysoil_frac, to calculate the albedo in condveg
+    ! In condveg, drysoil_frac serve to calculate the albedo of drysoil, excluding the nobio contribution which is further added
+    ! In conclusion, we calculate drysoil_frac based on moisture averages restricted to the soiltile (no multiplication by vegtot)
+    !! k_litt is calculated here as a grid-cell average (for consistency with drainage)
+    !! litterhumdiag, like shumdiag, is averaged over the soiltiles for transmission to stomate
+    DO jst=1,nstm       
+       DO ji=1,kjpindex
+          ! We compute here a mean k for the 'litter' used for reinfiltration from floodplains of ponds        
+          IF ( tmc_litter(ji,jst) < tmc_litter_res(ji,jst)) THEN
+             i = imin
+          ELSE
+             tmc_litter_ratio = (tmc_litter(ji,jst)-tmc_litter_res(ji,jst)) / &
+                  & (tmc_litter_sat(ji,jst)-tmc_litter_res(ji,jst))
+             i= MAX(MIN(INT((imax-imin)*tmc_litter_ratio)+imin, imax-1), imin)
+          ENDIF       
+          k_tmp = MAX(k_lin(i,1,njsc(ji))*ks(njsc(ji)), zero)
+          k_litt(ji) = k_litt(ji) + vegtot(ji)*soiltile(ji,jst) * SQRT(k_tmp) ! grid-cell average
+       ENDDO      
+       DO ji=1,kjpindex
+          litterhumdiag(ji) = litterhumdiag(ji) + &
+               & soil_wet_litter(ji,jst) * soiltile(ji,jst)
+
+          tmc_litt_wet_mea(ji) =  tmc_litt_wet_mea(ji) + & 
+               & tmc_litter_awet(ji,jst)* soiltile(ji,jst)
+
+          tmc_litt_dry_mea(ji) = tmc_litt_dry_mea(ji) + &
+               & tmc_litter_adry(ji,jst) * soiltile(ji,jst) 
+
+          tmc_litt_mea(ji) = tmc_litt_mea(ji) + &
+               & tmc_litter(ji,jst) * soiltile(ji,jst) 
+       ENDDO
+    ENDDO
+    
+    DO ji=1,kjpindex
+       IF ( tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji) > zero ) THEN
+          drysoil_frac(ji) = un + MAX( MIN( (tmc_litt_dry_mea(ji) - tmc_litt_mea(ji)) / &
+               & (tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji)), zero), - un)
+       ELSE
+          drysoil_frac(ji) = zero
+       ENDIF
+    END DO
+    
+    ! Calculate soilmoist, as a function of total water content (mc)
+    ! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
+    soilmoist(:,:) = zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+             soilmoist(ji,1) = soilmoist(ji,1) + soiltile(ji,jst) * &
+                  dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+             DO jsl = 2,nslm-1
+                soilmoist(ji,jsl) = soilmoist(ji,jsl) + soiltile(ji,jst) * &
+                     ( dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                     + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit )
+             END DO
+             soilmoist(ji,nslm) = soilmoist(ji,nslm) + soiltile(ji,jst) * &
+                  dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+       END DO
+    END DO
+    DO ji=1,kjpindex
+       soilmoist(ji,:) = soilmoist(ji,:) * vegtot(ji) ! conversion to grid-cell average
+    ENDDO
+    
+    ! Shumdiag: we start from soil_wet, change the range over which the relative moisture is calculated,
+    ! convert from hydrol to diag soil layers, then do a spatial average,
+    ! excluding the nobio fraction on which stomate doesn't act
+    DO jst=1,nstm      
+       DO jd=1,nbdl
+          DO ji=1,kjpindex
+             DO jsl=1,nslm   
+                shumdiag(ji,jd) = shumdiag(ji,jd) + soil_wet(ji,jsl,jst) * &
+                     soiltile(ji,jst) * frac_hydro_diag(jsl,jd) * &
+                     ((mcs(njsc(ji))-mcw(njsc(ji)))/(mcf(njsc(ji))-mcw(njsc(ji))))
+               ENDDO
+             shumdiag(ji,jd) = MAX(MIN(shumdiag(ji,jd), un), zero) 
+          ENDDO
+       ENDDO
+    ENDDO
+    
+    ! Shumdiag_perma is based on soilmoist / moisture at saturation in the layer
+    ! Her we start from grid averages by hydrol soil layer and transform it to the diag levels
+    ! We keep a grid-cell average, like for all variables transmitted to ok_freeze
+    DO jd=1,nbdl
+       DO ji=1,kjpindex
+          DO jsl=1,nslm              
+             shumdiag_perma(ji,jd) = soilmoist(ji,jsl)*frac_hydro_diag(jsl,jd) &
+                  /(dh(jsl)*mcs(njsc(ji)))
+          ENDDO
+          shumdiag_perma(ji,jd) = MAX(MIN(shumdiag_perma(ji,jd), un), zero) 
+       ENDDO
+    ENDDO
+    
+  END SUBROUTINE hydrol_diag_soil  
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_alma 
+!!
+!>\BRIEF        This routine computes the changes in soil moisture and interception storage for the ALMA outputs.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_alma
+
+  SUBROUTINE hydrol_alma (kjpindex, index, lstep_init, qsintveg, snow, snow_nobio, soilwet)
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                        :: kjpindex     !! Domain size
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index        !! Indeces of the points on the map
+    LOGICAL, INTENT (in)                               :: lstep_init   !! At which time is this routine called ?
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintveg     !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: snow         !! Snow water equivalent
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio !! Water balance on ice, lakes, .. [Kg/m^2]
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: soilwet     !! Soil wetness
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std) :: ji
+    REAL(r_std) :: watveg
+
+!_ ================================================================================================================================
+    !
+    !
+    IF ( lstep_init ) THEN
+       ! Initialize variables if they were not found in the restart file
+
+       DO ji = 1, kjpindex
+          watveg = SUM(qsintveg(ji,:))
+          tot_watveg_beg(ji) = watveg
+          tot_watsoil_beg(ji) = humtot(ji)
+          snow_beg(ji)        = snow(ji) + SUM(snow_nobio(ji,:))
+       ENDDO
+
+       RETURN
+
+    ENDIF
+    !
+    ! Calculate the values for the end of the time step
+    !
+    DO ji = 1, kjpindex
+       watveg = SUM(qsintveg(ji,:)) ! average within the mesh
+       tot_watveg_end(ji) = watveg
+       tot_watsoil_end(ji) = humtot(ji) ! average within the mesh
+       snow_end(ji) = snow(ji)+ SUM(snow_nobio(ji,:)) ! average within the mesh
+
+       delintercept(ji) = tot_watveg_end(ji) - tot_watveg_beg(ji) ! average within the mesh
+       delsoilmoist(ji) = tot_watsoil_end(ji) - tot_watsoil_beg(ji)
+       delswe(ji)       = snow_end(ji) - snow_beg(ji) ! average within the mesh
+    ENDDO
+    !
+    !
+    ! Transfer the total water amount at the end of the current timestep top the begining of the next one.
+    !
+    tot_watveg_beg = tot_watveg_end
+    tot_watsoil_beg = tot_watsoil_end
+    snow_beg(:) = snow_end(:)
+    !
+    DO ji = 1,kjpindex
+       IF ( mx_eau_var(ji) > 0 ) THEN
+          soilwet(ji) = tot_watsoil_end(ji) / mx_eau_var(ji)
+       ELSE
+          soilwet(ji) = zero
+       ENDIF
+    ENDDO
+    !
+  END SUBROUTINE hydrol_alma
+  !
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_calculate_temp_hydro
+!!
+!>\BRIEF         Calculate the temperature at hydrological levels  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+
+  SUBROUTINE hydrol_calculate_temp_hydro(kjpindex, stempdiag, snow,snowdz)
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                             :: kjpindex 
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)     :: stempdiag
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: snow
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in)    :: snowdz
+
+
+    !! 0.2 Local variables
+    
+    INTEGER jh, jd, ji
+    REAL(r_std) :: snow_h
+    REAL(r_std)  :: lev_diag, prev_diag, lev_prog, prev_prog
+    REAL(r_std), DIMENSION(nslm,nbdl) :: intfactt
+    
+    
+    DO ji=1,kjpindex
+       !The snow pack is above the surface soil in the new snow model.
+       snow_h=0
+       
+       intfactt(:,:)=0.
+       prev_diag = snow_h
+       DO jh = 1, nslm
+          IF (jh.EQ.1) THEN
+             lev_diag = zz(2)/1000./2.+snow_h
+          ELSEIF (jh.EQ.nslm) THEN
+             lev_diag = zz(nslm)/1000.+snow_h
+             
+          ELSE
+             lev_diag = zz(jh)/1000. &
+                  & +(zz(jh+1)-zz(jh))/1000./2.+snow_h
+             
+          ENDIF
+          prev_prog = 0.0
+          DO jd = 1, nbdl
+             lev_prog = diaglev(jd)
+             IF ((lev_diag.GT.diaglev(nbdl).AND. &
+                  & prev_diag.LT.diaglev(nbdl)-min_sechiba)) THEN
+                lev_diag=diaglev(nbdl)          
+             ENDIF
+             intfactt(jh,jd) = MAX(MIN(lev_diag,lev_prog)-MAX(prev_diag, prev_prog),&
+                  & 0.0)/(lev_diag-prev_diag)
+             prev_prog = lev_prog
+          ENDDO
+          IF (lev_diag.GT.diaglev(nbdl).AND. &
+               & prev_diag.GE.diaglev(nbdl)-min_sechiba) intfactt(jh,nbdl)=1.
+          prev_diag = lev_diag
+       ENDDO
+    ENDDO
+    
+    temp_hydro(:,:)=0.
+    DO jd= 1, nbdl
+       DO jh= 1, nslm
+          DO ji = 1, kjpindex
+             temp_hydro(ji,jh) = temp_hydro(ji,jh) + stempdiag(ji,jd)*intfactt(jh,jd)
+          ENDDO
+       ENDDO
+    ENDDO
+    
+  END SUBROUTINE hydrol_calculate_temp_hydro
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_calculate_frac_hydro_diag
+!!
+!>\BRIEF         Caluculate frac_hydro_diag for interpolation between hydrological and diagnostic axes
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_calculate_frac_hydro_diag
+
+    !! 0.1 Local variables
+
+    INTEGER(i_std) :: jd, jh
+    REAL(r_std)    :: prev_hydro, next_hydro, prev_diag, next_diag
+    
+
+    frac_hydro_diag(:,:)=0.
+    prev_diag = 0.0
+    
+    DO jd = 1, nbdl 
+       
+       next_diag = diaglev(jd)
+       prev_hydro = 0.0
+       DO jh = 1, nslm
+          IF (jh.EQ.1) THEN
+             next_hydro = zz(2)/1000./2.
+          ELSEIF (jh.EQ.nslm) THEN
+             next_hydro = zz(nslm)/1000.
+          ELSE
+             next_hydro = zz(jh)/1000.+(zz(jh+1)-zz(jh))/1000./2.
+          ENDIF
+          frac_hydro_diag(jh,jd) = MAX(MIN(next_hydro, next_diag)-MAX(prev_hydro, prev_diag), 0.)/(next_diag - prev_diag)
+          prev_hydro=next_hydro
+       ENDDO
+       
+       prev_diag = next_diag
+    ENDDO
+
+  END SUBROUTINE hydrol_calculate_frac_hydro_diag
+
+  
+END MODULE hydrol
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/intersurf.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/intersurf.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/intersurf.f90	(revision 6412)
@@ -0,0 +1,1993 @@
+! ================================================================================================================================
+!  MODULE       : intersurf
+!
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF   Subroutines for interfacing between the driver dim2_driver and sechiba and between LMDZ and sechiba
+!!
+!!\n DESCRIPTION:    This module contains subroutines for the interfacing between ORCHIDEE and LMDZ and between the driver 
+!!                   dim2_driver and the reste of ORCHIDEE. Follwoing subroutines exists:
+!!
+!!              - intersurf_initialize_2d       : Intitialization and call to sechiba_initialize, called from dim2_driver 
+!!                                                before the first call to intersurf_main_2d.
+!!              - intersurf_main_2d             : Main subroutine will call sechiba_main, called from dim2_driver at each time-step
+!!              - init_intersurf                : Initialize grid information when coupling with LMDZ. This subroutine is called 
+!!                                                from LMDZ before call to intersurf_initialize_gathered
+!!              - intersurf_initialize_gathered : Intitialization and call to sechiba_initialize, called from LMDZ
+!!                                                before the first call to intersurf_main_2d.
+!!              - intersurf_main_gathered       : Main subroutine will call sechiba_main, called from LMDZ at each time-step
+!!              - intsurf_time                  : Initialize and update time information, called in the initialization phase 
+!!                                                and at each time step from the different intersurf subroutines. 
+!!
+!! RECENT CHANGE(S): 
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+MODULE intersurf
+
+  USE IOIPSL
+  USE xios_orchidee
+  USE ioipsl_para 
+  USE defprec
+  USE sechiba
+  USE constantes
+  USE constantes_soil
+  USE control
+  USE pft_parameters
+  USE mod_orchidee_para
+  USE solar
+  USE grid
+  USE Orch_Write_field_p
+  USE ioipslctrl, ONLY : ioipslctrl_history, ioipslctrl_restini, ok_histsync, max_hist_level, dw
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: Init_intersurf, intersurf_main, intersurf_main_2d, intersurf_main_gathered, intsurf_time
+  PUBLIC :: intersurf_initialize_2d, intersurf_initialize_gathered, intersurf_clear
+
+
+  ! Interface called from LMDZ in older verisons
+  INTERFACE intersurf_main
+    MODULE PROCEDURE intersurf_main_gathered
+  END INTERFACE
+
+  LOGICAL, SAVE                                      :: lstep_init_intersurf=.TRUE.!! Initialisation has to be done one time
+!$OMP THREADPRIVATE(lstep_init_intersurf)
+!  INTEGER(i_std), SAVE                               :: printlev_loc            !! Write level to this module
+!!$OMP THREADPRIVATE(printlev_loc)
+  INTEGER(i_std), SAVE                               :: hist_id, rest_id        !! IDs for history and restart files
+!$OMP THREADPRIVATE(hist_id, rest_id)
+  INTEGER(i_std), SAVE                               :: hist2_id                !! ID for the second history files (Hi-frequency ?)
+!$OMP THREADPRIVATE(hist2_id)
+  INTEGER(i_std), SAVE                               :: hist_id_stom, hist_id_stom_IPCC, rest_id_stom !! Dito for STOMATE
+!$OMP THREADPRIVATE(hist_id_stom, hist_id_stom_IPCC, rest_id_stom)
+  INTEGER(i_std), SAVE                               :: itau_offset  !! This offset is used to phase the 
+                                                                     !! calendar of the GCM or the driver.
+!$OMP THREADPRIVATE(itau_offset)
+  REAL(r_std), SAVE                                  :: date0_shifted
+!$OMP THREADPRIVATE(date0_shifted)
+  REAL(r_std), SAVE :: julian0                       !! first day of this year
+!$OMP THREADPRIVATE(julian0)
+  LOGICAL, PARAMETER :: check_INPUTS = .false.       !! (very) long print of INPUTs in intersurf 
+  LOGICAL, SAVE                                      :: ok_q2m_t2m=.TRUE. !! Flag ok if the variables are present in the call in gcm.
+!$OMP THREADPRIVATE(ok_q2m_t2m)
+  LOGICAL, SAVE                                      :: fatmco2           !! Flag to force the value of atmospheric CO2 for vegetation.
+!$OMP THREADPRIVATE(fatmco2)
+  REAL(r_std), SAVE                                  :: atmco2            !! atmospheric CO2 
+!$OMP THREADPRIVATE(atmco2)
+  REAL(r_std), SAVE                                  :: coeff_rel         !!Coefficient for time filter on riverflow and coastalflow
+!$OMP THREADPRIVATE(coeff_rel)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE       :: riverflow_cpl0    !!Value from previous time step for riverflow
+!$OMP THREADPRIVATE(riverflow_cpl0)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE       :: coastalflow_cpl0  !!Value from previous time step for coastalflow
+!$OMP THREADPRIVATE(coastalflow_cpl0)
+  INTEGER(i_std), SAVE                               :: nb_fields_in=-1   !!  Number of fields to give to the GCM
+!$OMP THREADPRIVATE(nb_fields_in)  
+  INTEGER(i_std), SAVE                               :: nb_fields_out=-1  !!  Number of fields to get from the GCM
+!$OMP THREADPRIVATE(nb_fields_out)  
+
+  PUBLIC lstep_init_intersurf
+  
+CONTAINS
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    intersurf_initialize_2d
+!!
+!>\BRIEF	  Initialization and call to sechiba_initialize
+!!
+!! DESCRIPTION:	  Initialization of module variables, read options from parameter file, initialize output files and call to 
+!!                sechiba_initialize.
+!!
+!!                This subroutine is called from dim2_driver before the first call to intersurf_main_2d.
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE intersurf_initialize_2d (kjit, iim, jjm, kjpindex, kindex, xrdt, &
+       lrestart_read, lrestart_write, lon, lat, zcontfrac, zresolution, date0, &
+       zlev, u, v, qair, temp_air, epot_air, ccanopy, &
+       cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+       precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
+       vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
+       tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m, coszang)
+
+    IMPLICIT NONE
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT (in)                            :: kjit            !! Time step number
+    INTEGER(i_std),INTENT (in)                            :: iim, jjm        !! Dimension of input fields
+    INTEGER(i_std),INTENT (in)                            :: kjpindex        !! Number of continental points
+    REAL(r_std),INTENT (in)                               :: xrdt            !! Time step in seconds
+    LOGICAL, INTENT (in)                                 :: lrestart_read    !! Logical for _restart_ file to read
+    LOGICAL, INTENT (in)                                 :: lrestart_write   !! Logical for _restart_ file to write'
+    REAL(r_std), INTENT (in)                              :: date0           !! Date at which kjit = 0
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: kindex          !! Index for continental points
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: u             !! Lowest level wind speed
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: v             !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: zlev          !! Height of first layer
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: qair          !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: precip_rain   !! Rain precipitation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: precip_snow   !! Snow precipitation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: lwdown        !! Down-welling long-wave flux 
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: swnet         !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: swdown        !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: temp_air      !! Air temperature in Kelvin
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: epot_air      !! Air potential energy
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: ccanopy       !! CO2 concentration in the canopy
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: petAcoef      !! Coeficients A from the PBL resolution
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: peqAcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: petBcoef      !! Coeficients B from the PBL resolution
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: peqBcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: pb            !! Surface pressure
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: lon, lat      !! Geographical coordinates
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: zcontfrac     !! Fraction of continent in the grid
+    REAL(r_std),DIMENSION (iim,jjm,2), INTENT(in)           :: zresolution   !! resolution in x and y dimensions
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: coszang       !! Cosine of the solar zenith angle (unitless)
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: z0m            !! Surface roughness
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: coastalflow   !! Diffuse flow of water into the ocean (m^3/s)
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: riverflow     !! Largest rivers flowing into the ocean (m^3/s)
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: tsol_rad      !! Radiative surface temperature
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: vevapp        !! Total of evaporation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: temp_sol_new  !! New soil temperature
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: qsurf         !! Surface specific humidity
+    REAL(r_std),DIMENSION (iim,jjm,2), INTENT(out)          :: albedo        !! Albedo
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: fluxsens      !! Sensible chaleur flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: fluxlat       !! Latent chaleur flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: emis          !! Emissivity
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(inout)          :: cdrag         !! Cdrag
+
+    !! 0.4 Local variables
+    REAL(r_std),DIMENSION (kjpindex)                      :: zu            !! Work array to keep u
+    REAL(r_std),DIMENSION (kjpindex)                      :: zv            !! Work array to keep v
+    REAL(r_std),DIMENSION (kjpindex)                      :: zzlev         !! Work array to keep zlev
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqair         !! Work array to keep qair
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_rain  !! Work array to keep precip_rain
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_snow  !! Work array to keep precip_snow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zlwdown       !! Work array to keep lwdown
+    REAL(r_std),DIMENSION (kjpindex)                      :: zswnet        !! Work array to keep swnet
+    REAL(r_std),DIMENSION (kjpindex)                      :: zswdown       !! Work array to keep swdown
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_air     !! Work array to keep temp_air
+    REAL(r_std),DIMENSION (kjpindex)                      :: zepot_air     !! Work array to keep epot_air
+    REAL(r_std),DIMENSION (kjpindex)                      :: zccanopy      !! Work array to keep ccanopy
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpetAcoef     !! Work array to keep petAcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpeqAcoef     !! Work array to keep peqAcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpetBcoef     !! Work array to keep petBcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpeqBcoef     !! Work array to keep peqVcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcdrag        !! Work array to keep cdrag
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpb           !! Work array to keep pb
+    REAL(r_std),DIMENSION (kjpindex)                      :: zz0m, zz0h    !! Work array to keep zz0m, zz0h
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoastal      !! Work array to keep coastalflow (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex)                      :: zriver        !! Work array to keep riverflow (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad
+    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_sol_new !! Work array to keep temp_sol_new
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqsurf        !! Work array to keep qsurf
+    REAL(r_std),DIMENSION (kjpindex,2)                    :: zalbedo       !! Work array to keep albedo
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxsens     !! Work array to keep fluxsens
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxlat      !! Work array to keep fluxlat
+    REAL(r_std),DIMENSION (kjpindex)                      :: zemis         !! Work array to keep emis
+    INTEGER(i_std)                                       :: i, j, ik
+    INTEGER(i_std)                                       :: ier
+    INTEGER(i_std)                                       :: itau_sechiba
+    REAL(r_std)                                          :: zlev_mean
+    INTEGER                                              :: old_fileout   !! old Logical Int for std IO output
+
+
+    CALL ipslnlf_p(new_number=numout,old_number=old_fileout)
+    !
+    !  Configuration of SSL specific parameters
+    !
+    CALL control_initialize(xrdt)
+
+    CALL intsurf_time( kjit, date0)
+    
+    ! Initialize specific write level
+    !printlev_loc=get_printlev('instersurf')
+    
+    IF ( printlev_loc >=3 ) WRITE(numout,*) 'Initialisation of intersurf_main_2d'
+    OFF_LINE_MODE = .TRUE. 
+    
+    DO ik=1,kjpindex
+       
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+       
+       !- Create the internal coordinate table
+       !-
+       lalo(ik,1) = lat(i,j)
+       lalo(ik,2) = lon(i,j)
+       !
+       !- Store the fraction of the continents only once so that the user
+       !- does not change them afterwards.
+       !-
+       contfrac(ik) = zcontfrac(i,j)
+    ENDDO
+    CALL gather(contfrac,contfrac_g)
+    CALL gather(lalo,lalo_g)
+    CALL gather2D_mpi(lon,lon_g)
+    CALL gather2D_mpi(lat,lat_g)
+    CALL gather2D_mpi(zlev,zlev_g)
+    
+    CALL ioipslctrl_restini(kjit, date0, xrdt, rest_id, rest_id_stom, itau_offset, date0_shifted)
+   
+    itau_sechiba = kjit + itau_offset
+    
+    !!- Initialize module for output with XIOS
+    !
+    CALL xios_orchidee_init( MPI_COMM_ORCH,                &
+         date0,    year,    month,           day,          &
+         lon,      lat,     znt )
+    
+    !- Initialize IOIPSL sechiba output files
+    CALL ioipslctrl_history(iim, jjm, lon, lat,  kindex, kjpindex, itau_sechiba, date0_shifted, xrdt, hist_id, &
+         hist2_id, hist_id_stom, hist_id_stom_IPCC)
+ 
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'End of Initialisation of intersurf'
+    !
+    !  Shift the time step to phase the two models
+    !
+    itau_sechiba = kjit + itau_offset
+    
+    ! Update the calendar in xios by sending the new time step
+    ! Special case : the model is only in initialization phase and the current itau_sechiba is not a real time step. 
+    ! Therefor give itau_sechiba+1 to xios to have a correct time axis in output files. 
+    CALL xios_orchidee_update_calendar(itau_sechiba+1)
+    
+    CALL intsurf_time( itau_sechiba, date0_shifted )
+    !
+    ! 1. gather input fields from kindex array
+    !    Warning : I'm not sure this interface with one dimension array is the good one
+    !
+    DO ik=1, kjpindex
+      
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+       
+       zu(ik)           = u(i,j)
+       zv(ik)           = v(i,j)
+       zzlev(ik)        = zlev(i,j)
+       zqair(ik)        = qair(i,j)
+       zprecip_rain(ik) = precip_rain(i,j)*xrdt
+       zprecip_snow(ik) = precip_snow(i,j)*xrdt
+       zlwdown(ik)      = lwdown(i,j)
+       zswnet(ik)       = swnet(i,j)
+       zswdown(ik)      = swdown(i,j)
+       ztemp_air(ik)    = temp_air(i,j)
+       zepot_air(ik)    = epot_air(i,j)
+       zccanopy(ik)     = ccanopy(i,j)
+       zpetAcoef(ik)    = petAcoef(i,j)
+       zpeqAcoef(ik)    = peqAcoef(i,j)
+       zpetBcoef(ik)    = petBcoef(i,j)
+       zpeqBcoef(ik)    = peqBcoef(i,j)
+       zcdrag(ik)       = cdrag(i,j)
+       zpb(ik)          = pb(i,j)
+       
+    ENDDO
+    !
+    IF (check_INPUTS) THEN
+       WRITE(numout,*) "Intersurf_initialize_2D :"
+       WRITE(numout,*) "Time step number = ",kjit
+       WRITE(numout,*) "Dimension of input fields = ",iim, jjm
+       WRITE(numout,*) "Number of continental points = ",kjpindex
+       WRITE(numout,*) "Time step in seconds = ",xrdt
+       WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
+       WRITE(numout,*) "Date at which kjit = 0  =  ",date0
+       WRITE(numout,*) "Index for continental points = ",kindex
+       WRITE(numout,*) "Lowest level wind speed North = ",zu
+       WRITE(numout,*) "Lowest level wind speed East = ",zv
+       WRITE(numout,*) "Height of first layer = ",zzlev
+       WRITE(numout,*) "Lowest level specific humidity = ",zqair
+       WRITE(numout,*) "Rain precipitation = ",zprecip_rain
+       WRITE(numout,*) "Snow precipitation = ",zprecip_snow
+       WRITE(numout,*) "Down-welling long-wave flux = ",zlwdown
+       WRITE(numout,*) "Net surface short-wave flux = ",zswnet
+       WRITE(numout,*) "Downwelling surface short-wave flux = ",zswdown
+       WRITE(numout,*) "Air temperature in Kelvin = ",ztemp_air
+       WRITE(numout,*) "Air potential energy = ",zepot_air
+       WRITE(numout,*) "CO2 concentration in the canopy = ",zccanopy
+       WRITE(numout,*) "Coeficients A from the PBL resolution = ",zpetAcoef
+       WRITE(numout,*) "One for T and another for q = ",zpeqAcoef
+       WRITE(numout,*) "Coeficients B from the PBL resolution = ",zpetBcoef
+       WRITE(numout,*) "One for T and another for q = ",zpeqBcoef
+       WRITE(numout,*) "Cdrag = ",zcdrag
+       WRITE(numout,*) "Surface pressure = ",zpb
+       WRITE(numout,*) "Geographical coordinates lon = ", (/ ( lon(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /)
+       WRITE(numout,*) "Geographical coordinates lat = ", (/ ( lat(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /) 
+       WRITE(numout,*) "Fraction of continent in the grid = ",contfrac
+    ENDIF
+    !
+    ! 2. save the grid
+    !
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'Save the grid'
+    CALL histwrite_p(hist_id, 'LandPoints',  itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
+    CALL histwrite_p(hist_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+    IF ( ok_stomate ) THEN
+       CALL histwrite_p(hist_id_stom, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+       CALL histwrite_p(hist_id_stom_IPCC, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+    ENDIF
+    
+    CALL histwrite_p(hist_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+    IF ( is_omp_root .AND. hist_id > 0 ) THEN
+       ! Always syncronize output after initialization 
+       CALL histsync(hist_id)
+    END IF
+    
+    CALL histwrite_p(hist2_id, 'LandPoints',  itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
+    CALL histwrite_p(hist2_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+    CALL histwrite_p(hist2_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+    IF ( is_omp_root .AND. hist2_id > 0 ) THEN
+       ! Always syncronize output after initialization 
+       CALL histsync(hist2_id)
+    ENDIF
+    
+    !
+    ! 3. call sechiba for continental points only
+    !
+    IF ( printlev_loc >= 3 ) WRITE(numout,*) 'Calling sechiba_initialize'
+    
+    CALL sechiba_initialize( &
+         itau_sechiba, iim*jjm,      kjpindex,      kindex,                     &
+         lalo,         contfrac,     neighbours,    resolution,  zzlev,         &
+         zu,           zv,           zqair,         ztemp_air,   ztemp_air,     &
+         zpetAcoef,    zpeqAcoef,    zpetBcoef,     zpeqBcoef,                  &
+         zprecip_rain, zprecip_snow, zlwdown,       zswnet,      zswdown,       &
+         zpb,          rest_id,      hist_id,       hist2_id,                   &
+         rest_id_stom, hist_id_stom, hist_id_stom_IPCC,                         &
+         zcoastal,     zriver,       ztsol_rad,     zvevapp,     zqsurf,        &
+         zz0m,         zz0h,         zalbedo,      zfluxsens,     zfluxlat,     &
+         zemis,        znetco2,      zcarblu,      ztemp_sol_new, zcdrag,       &
+         coszang )
+    
+    IF ( printlev_loc >= 3 ) WRITE(numout,*) 'out of sechiba_initialize'
+    !
+    ! 5. scatter output fields
+    !
+    z0m(:,:)           = undef_sechiba
+    coastalflow(:,:)  = undef_sechiba
+    riverflow(:,:)    = undef_sechiba
+    tsol_rad(:,:)     = undef_sechiba
+    vevapp(:,:)       = undef_sechiba
+    temp_sol_new(:,:) = undef_sechiba 
+    qsurf(:,:)        = undef_sechiba 
+    albedo(:,:,:)     = undef_sechiba
+    fluxsens(:,:)     = undef_sechiba
+    fluxlat(:,:)      = undef_sechiba
+    emis(:,:)         = undef_sechiba 
+    cdrag(:,:)        = undef_sechiba 
+    
+    DO ik=1, kjpindex
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+       
+       z0m(i,j)           = zz0m(ik)
+       coastalflow(i,j)  = zcoastal(ik)
+       riverflow(i,j)    = zriver(ik)
+       tsol_rad(i,j)     = ztsol_rad(ik)
+       vevapp(i,j)       = zvevapp(ik)
+       temp_sol_new(i,j) = ztemp_sol_new(ik)
+       qsurf(i,j)        = zqsurf(ik)
+       albedo(i,j,1)     = zalbedo(ik,1)
+       albedo(i,j,2)     = zalbedo(ik,2)
+       fluxsens(i,j)     = zfluxsens(ik)
+       fluxlat(i,j)      = zfluxlat(ik)
+       emis(i,j)         = zemis(ik)
+       cdrag(i,j)        = zcdrag(ik)
+
+    ENDDO
+
+    !
+    ! 6. Transform the water fluxes into Kg/m^2s and m^3/s
+    !
+    DO ik=1, kjpindex
+    
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+
+       vevapp(i,j) = vevapp(i,j)/xrdt
+       coastalflow(i,j) = coastalflow(i,j)/xrdt
+       riverflow(i,j) = riverflow(i,j)/xrdt
+
+    ENDDO
+
+    IF (is_root_prc) CALL getin_dump
+
+    lstep_init_intersurf = .FALSE.
+    IF (printlev_loc >=3) WRITE (numout,*) ' intersurf_main done '
+    CALL ipslnlf_p(new_number=old_fileout)
+  END SUBROUTINE intersurf_initialize_2d
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    intersurf_main_2d
+!!
+!>\BRIEF	  Main subroutine to call ORCHIDEE from dim2_driver using variables on a 2d grid.
+!!
+!! DESCRIPTION:	  This subroutine is the main interface for ORCHIDEE when it is called from the offline driver dim2_driver.
+!!                The variables are all on the 2D grid including ocean points. intersurf_initialize_2d should be called before
+!!                this subroutine is called. This subroutine is called at each time step.
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE intersurf_main_2d (kjit, iim, jjm, kjpindex, kindex, xrdt, &
+       lrestart_read, lrestart_write, lon, lat, zcontfrac, zresolution, date0, &
+       zlev, u, v, qair, temp_air, epot_air, ccanopy, &
+       cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+       precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
+       vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
+       tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m, &
+       coszang)
+
+    IMPLICIT NONE
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT (in)                              :: kjit            !! Time step number
+    INTEGER(i_std),INTENT (in)                              :: iim, jjm        !! Dimension of input fields
+    INTEGER(i_std),INTENT (in)                              :: kjpindex        !! Number of continental points
+    REAL(r_std),INTENT (in)                                 :: xrdt            !! Time step in seconds
+    LOGICAL, INTENT (in)                                    :: lrestart_read   !! Logical for _restart_ file to read
+    LOGICAL, INTENT (in)                                    :: lrestart_write  !! Logical for _restart_ file to write'
+    REAL(r_std), INTENT (in)                                :: date0           !! Date at which kjit = 0
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)        :: kindex          !! Index for continental points
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: u             !! Lowest level wind speed
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: v             !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: zlev          !! Height of first layer
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: qair          !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: precip_rain   !! Rain precipitation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: precip_snow   !! Snow precipitation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: lwdown        !! Down-welling long-wave flux 
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: swnet         !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: swdown        !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: coszang       !! Cosine of the solar zenith angle (unitless)
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: temp_air      !! Air temperature in Kelvin
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: epot_air      !! Air potential energy
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: ccanopy       !! CO2 concentration in the canopy
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: petAcoef      !! Coeficients A from the PBL resolution
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: peqAcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: petBcoef      !! Coeficients B from the PBL resolution
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: peqBcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: pb            !! Surface pressure
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: lon, lat      !! Geographical coordinates
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: zcontfrac     !! Fraction of continent in the grid
+    REAL(r_std),DIMENSION (iim,jjm,2), INTENT(in)           :: zresolution   !! resolution in x and y dimensions
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: z0m            !! Surface roughness for momemtum
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: coastalflow   !! Diffuse flow of water into the ocean (m^3/s)
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: riverflow     !! Largest rivers flowing into the ocean (m^3/s)
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: tsol_rad      !! Radiative surface temperature
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: vevapp        !! Total of evaporation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: temp_sol_new  !! New soil temperature
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: qsurf         !! Surface specific humidity
+    REAL(r_std),DIMENSION (iim,jjm,2), INTENT(out)          :: albedo        !! Albedo
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: fluxsens      !! Sensible chaleur flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: fluxlat       !! Latent chaleur flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: emis          !! Emissivity
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(inout)          :: cdrag         !! Cdrag
+
+    !! 0.4 Local variables
+    REAL(r_std),DIMENSION (kjpindex)                      :: zu            !! Work array to keep u
+    REAL(r_std),DIMENSION (kjpindex)                      :: zv            !! Work array to keep v
+    REAL(r_std),DIMENSION (kjpindex)                      :: zzlev         !! Work array to keep zlev
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqair         !! Work array to keep qair
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_rain  !! Work array to keep precip_rain
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_snow  !! Work array to keep precip_snow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zlwdown       !! Work array to keep lwdown
+    REAL(r_std),DIMENSION (kjpindex)                      :: zswnet        !! Work array to keep swnet
+    REAL(r_std),DIMENSION (kjpindex)                      :: zswdown       !! Work array to keep swdown
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoszang      !! Work array to keep coszang
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_air     !! Work array to keep temp_air
+    REAL(r_std),DIMENSION (kjpindex)                      :: zepot_air     !! Work array to keep epot_air
+    REAL(r_std),DIMENSION (kjpindex)                      :: zccanopy      !! Work array to keep ccanopy
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpetAcoef     !! Work array to keep petAcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpeqAcoef     !! Work array to keep peqAcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpetBcoef     !! Work array to keep petBcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpeqBcoef     !! Work array to keep peqVcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcdrag        !! Work array to keep cdrag
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpb           !! Work array to keep pb
+    REAL(r_std),DIMENSION (kjpindex)                      :: zz0m, zz0h    !! Work array to keep zz0m, zz0h
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoastal      !! Work array to keep coastalflow (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex)                      :: zriver        !! Work array to keep riverflow (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad
+    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_sol_new !! Work array to keep temp_sol_new
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqsurf        !! Work array to keep qsurf
+    REAL(r_std),DIMENSION (kjpindex,2)                    :: zalbedo       !! Work array to keep albedo
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxsens     !! Work array to keep fluxsens
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxlat      !! Work array to keep fluxlat
+    REAL(r_std),DIMENSION (kjpindex)                      :: zemis         !! Work array to keep emis
+    INTEGER(i_std)                                        :: i, j, ik
+    INTEGER(i_std)                                        :: ier
+    INTEGER(i_std)                                        :: itau_sechiba
+    REAL(r_std)                                           :: zlev_mean
+    INTEGER                                               :: old_fileout   !! old Logical Int for std IO output
+
+    CALL ipslnlf_p(new_number=numout,old_number=old_fileout)
+
+    !
+    !  Shift the time step to phase the two models
+    !
+    itau_sechiba = kjit + itau_offset
+    !
+
+    ! Update the calendar in xios by sending the new time step
+    CALL xios_orchidee_update_calendar(itau_sechiba)
+    
+    CALL intsurf_time( itau_sechiba, date0_shifted )
+    !
+    ! 1. gather input fields from kindex array
+    !    Warning : I'm not sure this interface with one dimension array is the good one
+    !
+    DO ik=1, kjpindex
+      
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+       
+       zu(ik)           = u(i,j)
+       zv(ik)           = v(i,j)
+       zzlev(ik)        = zlev(i,j)
+       zqair(ik)        = qair(i,j)
+       zprecip_rain(ik) = precip_rain(i,j)*xrdt
+       zprecip_snow(ik) = precip_snow(i,j)*xrdt
+       zlwdown(ik)      = lwdown(i,j)
+       zswnet(ik)       = swnet(i,j)
+       zswdown(ik)      = swdown(i,j)
+       zcoszang(ik)     = coszang(i,j)
+       ztemp_air(ik)    = temp_air(i,j)
+       zepot_air(ik)    = epot_air(i,j)
+       zccanopy(ik)     = ccanopy(i,j)
+       zpetAcoef(ik)    = petAcoef(i,j)
+       zpeqAcoef(ik)    = peqAcoef(i,j)
+       zpetBcoef(ik)    = petBcoef(i,j)
+       zpeqBcoef(ik)    = peqBcoef(i,j)
+       zcdrag(ik)       = cdrag(i,j)
+       zpb(ik)          = pb(i,j)
+       
+    ENDDO
+    !
+    IF (check_INPUTS) THEN
+       WRITE(numout,*) "Intersurf_main_2D :"
+       WRITE(numout,*) "Time step number = ",kjit
+       WRITE(numout,*) "Dimension of input fields = ",iim, jjm
+       WRITE(numout,*) "Number of continental points = ",kjpindex
+       WRITE(numout,*) "Time step in seconds = ",xrdt
+       WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
+       WRITE(numout,*) "Date at which kjit = 0  =  ",date0
+       WRITE(numout,*) "Index for continental points = ",kindex
+       WRITE(numout,*) "Lowest level wind speed North = ",zu
+       WRITE(numout,*) "Lowest level wind speed East = ",zv
+       WRITE(numout,*) "Height of first layer = ",zzlev
+       WRITE(numout,*) "Lowest level specific humidity = ",zqair
+       WRITE(numout,*) "Rain precipitation = ",zprecip_rain
+       WRITE(numout,*) "Snow precipitation = ",zprecip_snow
+       WRITE(numout,*) "Down-welling long-wave flux = ",zlwdown
+       WRITE(numout,*) "Net surface short-wave flux = ",zswnet
+       WRITE(numout,*) "Downwelling surface short-wave flux = ",zswdown
+       WRITE(numout,*) "Air temperature in Kelvin = ",ztemp_air
+       WRITE(numout,*) "Air potential energy = ",zepot_air
+       WRITE(numout,*) "CO2 concentration in the canopy = ",zccanopy
+       WRITE(numout,*) "Coeficients A from the PBL resolution = ",zpetAcoef
+       WRITE(numout,*) "One for T and another for q = ",zpeqAcoef
+       WRITE(numout,*) "Coeficients B from the PBL resolution = ",zpetBcoef
+       WRITE(numout,*) "One for T and another for q = ",zpeqBcoef
+       WRITE(numout,*) "Cdrag = ",zcdrag
+       WRITE(numout,*) "Surface pressure = ",zpb
+       WRITE(numout,*) "Geographical coordinates lon = ", (/ ( lon(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /)
+       WRITE(numout,*) "Geographical coordinates lat = ", (/ ( lat(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /) 
+       WRITE(numout,*) "Fraction of continent in the grid = ",contfrac
+    ENDIF
+
+    !
+    ! 3. call sechiba for continental points only
+    !
+    IF ( printlev_loc >= 3 ) WRITE(numout,*) 'Calling sechiba_main'
+    
+    CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, &
+         lrestart_read, lrestart_write, &
+         lalo, contfrac, neighbours, resolution, &
+         zzlev, zu, zv, zqair, zqair, ztemp_air, ztemp_air, zepot_air, zccanopy, &
+         zcdrag, zpetAcoef, zpeqAcoef, zpetBcoef, zpeqBcoef, &
+         zprecip_rain ,zprecip_snow,  zlwdown, zswnet, zswdown, zcoszang, zpb, &
+         zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
+         ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0m, zz0h,&
+         rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC ) 
+    
+    IF ( printlev_loc >= 3 ) WRITE(numout,*) 'out of sechiba_main'
+
+    !
+    ! 5. scatter output fields
+    !
+    z0m(:,:)          = undef_sechiba
+    coastalflow(:,:)  = undef_sechiba
+    riverflow(:,:)    = undef_sechiba
+    tsol_rad(:,:)     = undef_sechiba
+    vevapp(:,:)       = undef_sechiba
+    temp_sol_new(:,:) = undef_sechiba 
+    qsurf(:,:)        = undef_sechiba 
+    albedo(:,:,:)     = undef_sechiba
+    fluxsens(:,:)     = undef_sechiba
+    fluxlat(:,:)      = undef_sechiba
+    emis(:,:)         = undef_sechiba 
+    cdrag(:,:)        = undef_sechiba 
+    !
+    DO ik=1, kjpindex
+      
+    
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+
+       z0m(i,j)           = zz0m(ik)
+       coastalflow(i,j)  = zcoastal(ik)
+       riverflow(i,j)    = zriver(ik)
+       tsol_rad(i,j)     = ztsol_rad(ik)
+       vevapp(i,j)       = zvevapp(ik)
+       temp_sol_new(i,j) = ztemp_sol_new(ik)
+       qsurf(i,j)        = zqsurf(ik)
+       albedo(i,j,1)     = zalbedo(ik,1)
+       albedo(i,j,2)     = zalbedo(ik,2)
+       fluxsens(i,j)     = zfluxsens(ik)
+       fluxlat(i,j)      = zfluxlat(ik)
+       emis(i,j)         = zemis(ik)
+       cdrag(i,j)        = zcdrag(ik)
+
+    ENDDO
+
+    CALL xios_orchidee_send_field("LandPoints" ,(/ ( REAL(ik), ik=1,kjpindex ) /))
+    CALL xios_orchidee_send_field("Areas", area)
+    CALL xios_orchidee_send_field("Contfrac",contfrac)
+    CALL xios_orchidee_send_field("evap",zvevapp*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("coastalflow",zcoastal/dt_sechiba)
+    CALL xios_orchidee_send_field("riverflow",zriver/dt_sechiba)
+    CALL xios_orchidee_send_field("temp_sol_C",ztemp_sol_new-ZeroCelsius)
+    CALL xios_orchidee_send_field("temp_sol_K",ztemp_sol_new)
+    CALL xios_orchidee_send_field("fluxsens",zfluxsens)
+    CALL xios_orchidee_send_field("fluxlat",zfluxlat)
+    CALL xios_orchidee_send_field("tair",ztemp_air)
+    CALL xios_orchidee_send_field("qair",zqair)
+    CALL xios_orchidee_send_field("swnet",zswnet)
+    CALL xios_orchidee_send_field("swdown",zswdown)
+    ! zpb in hPa, output in Pa
+    CALL xios_orchidee_send_field("Psurf",zpb*100.)
+    
+    IF ( .NOT. almaoutput ) THEN
+       !
+       !  scattered during the writing
+       ! 
+       CALL histwrite_p (hist_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'fluxlat',  itau_sechiba, zfluxlat, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'swnet',    itau_sechiba, zswnet, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'swdown',   itau_sechiba, zswdown, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'tair',     itau_sechiba, ztemp_air, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'qair',     itau_sechiba, zqair, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'q2m',     itau_sechiba, zqair, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 't2m',     itau_sechiba, ztemp_air, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'fluxlat',  itau_sechiba, zfluxlat, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'swnet',    itau_sechiba, zswnet, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'swdown',   itau_sechiba, zswdown, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'tair',     itau_sechiba, ztemp_air, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'qair',     itau_sechiba, zqair, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'q2m',     itau_sechiba, zqair, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 't2m',     itau_sechiba, ztemp_air, kjpindex, kindex)
+    ELSE
+       CALL histwrite_p (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'SWnet',    itau_sechiba, zswnet, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'Tair', itau_sechiba, ztemp_air, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'Qair', itau_sechiba, zqair, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'SWnet',    itau_sechiba, zswnet, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+    ENDIF
+    !
+    IF ( is_omp_root ) THEN
+       IF ( (dw .EQ. xrdt) .AND. hist_id > 0 ) THEN
+          ! Syncronize output but only if flag ok_histsync is set to true
+          IF (ok_histsync) CALL histsync(hist_id)
+       ENDIF
+    END IF
+
+    !
+    ! 6. Transform the water fluxes into Kg/m^2s and m^3/s
+    !
+    DO ik=1, kjpindex
+       
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+       
+       vevapp(i,j) = vevapp(i,j)/xrdt
+       coastalflow(i,j) = coastalflow(i,j)/xrdt
+       riverflow(i,j) = riverflow(i,j)/xrdt
+       
+    ENDDO
+    
+    IF (printlev_loc >=3) WRITE (numout,*) ' intersurf_main done '
+
+    CALL ipslnlf_p(new_number=old_fileout)
+
+  END SUBROUTINE intersurf_main_2d
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    init_intersurf
+!!
+!>\BRIEF	  Initialize grid information
+!!
+!! DESCRIPTION:	  This subroutine is called from LMDZ before first call to intersurf_main_gathered or 
+!!                intersurf_initialize_gathered
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE init_intersurf(nbp_l_lon,nbp_l_lat,kjpindex,kindex,orch_offset,orch_omp_size,orch_omp_rank,COMM)
+
+    USE mod_orchidee_para
+    USE timer
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN)  :: nbp_l_lon
+    INTEGER,INTENT(IN)  :: nbp_l_lat
+    INTEGER,INTENT(IN)  :: kjpindex
+    INTEGER,INTENT(IN)  :: kindex(:)
+    INTEGER,INTENT(IN)  :: orch_offset
+    INTEGER,INTENT(IN)  :: COMM
+    INTEGER,INTENT(IN)  :: orch_omp_size
+    INTEGER,INTENT(IN)  :: orch_omp_rank
+
+    INTEGER,DIMENSION(kjpindex)  :: kindex_offset
+
+    IF (orch_omp_rank==0) THEN
+      CALL Init_timer
+      CALL start_timer(timer_mpi)
+      CALL grid_set_glo(nbp_l_lon,nbp_l_lat)
+    ENDIF
+    CALL barrier2_omp()    
+    CALL init_orchidee_data_para(kjpindex,kindex,orch_offset,orch_omp_size,orch_omp_rank,COMM)
+    CALL Set_stdout_file('out_orchidee')
+    
+    IF (is_omp_root) CALL grid_allocate_glo(4)
+    CALL barrier2_omp()
+    CALL init_ioipsl_para
+          
+    kindex_offset(:)=kindex(:)+offset
+    CALL gather(kindex_offset,index_g)
+    CALL bcast(index_g)  
+
+    WRITE(numout,*) "kjpindex = ",kjpindex
+    WRITE(numout,*) "offset for OMP = ",offset_omp
+    WRITE(numout,*) "Index num local for continental points = ",kindex
+    WRITE(numout,*) "Index num global for continental points = ",kindex_offset
+    IF (is_omp_root) THEN
+       WRITE(numout,*) "ROOT OMP, Index global MPI : ",kindex_mpi(:)
+    ENDIF
+    IF (is_root_prc) THEN
+       WRITE(numout,*) "ROOT global, Index global : ",index_g(:)
+    ENDIF
+
+    ! Allocation of grid variables  
+    CALL grid_init ( kjpindex, 4, "RegLonLat", "2DGrid" ) 
+
+    
+  END SUBROUTINE init_intersurf
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    intersurf_initialize_gathered
+!!
+!>\BRIEF	  Initialization and call to sechiba_initialize
+!!
+!! DESCRIPTION:	  Initialization of module variables, read options from parameter file, initialize output files and call to 
+!!                sechiba_initialize.
+!!
+!!                This subroutine can be called directly from GCM(LMDZ). If it is not called before the first call to 
+!!                intersurf_main_gathered, then it will be done from there. This possibility is done to keep backward 
+!!                compatibility with LMDZ. 
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE intersurf_initialize_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
+       lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
+       zlev,  u, v, qair, temp_air, epot_air, &
+       cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+       precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
+       vevapp, fluxsens, fluxlat, coastalflow_cpl, riverflow_cpl, &
+       tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m, lon_scat_g, lat_scat_g, q2m, t2m, z0h, &
+       field_out_names, fields_out, field_in_names, fields_in)
+
+    USE mod_orchidee_para
+    IMPLICIT NONE
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input 
+    INTEGER(i_std),INTENT (in)                             :: kjit           !! Time step number
+    INTEGER(i_std),INTENT (in)                             :: iim_glo        !! Dimension of global fields
+    INTEGER(i_std),INTENT (in)                             :: jjm_glo        !! Dimension of global fields
+    INTEGER(i_std),INTENT (in)                             :: kjpindex       !! Number of continental points
+    REAL(r_std),INTENT (in)                                :: xrdt           !! Time step in seconds
+    LOGICAL, INTENT (in)                                   :: lrestart_read  !! Logical for _restart_ file to read
+    LOGICAL, INTENT (in)                                   :: lrestart_write !! Logical for _restart_ file to write'
+    REAL(r_std), INTENT (in)                               :: date0          !! Date at which kjit = 0
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)       :: kindex         !! Index for continental points
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: u              !! Lowest level wind speed
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: v              !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: zlev           !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: qair           !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: precip_rain    !! Rain precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: precip_snow    !! Snow precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: lwdown         !! Down-welling long-wave flux 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: swnet          !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: swdown         !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: temp_air       !! Air temperature in Kelvin
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: epot_air       !! Air potential energy
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: petAcoef       !! Coeficients A from the PBL resolution
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: peqAcoef       !! One for T and another for q
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: petBcoef       !! Coeficients B from the PBL resolution
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: peqBcoef       !! One for T and another for q
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: pb             !! Surface pressure
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)         :: latlon         !! Geographical coordinates
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: zcontfrac      !! Fraction of continent
+    INTEGER(i_std),DIMENSION (kjpindex,NbNeighb), INTENT(in):: zneighbours   !! neighbours
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)         :: zresolution    !! size of the grid box
+    REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN)    :: lon_scat_g     !! The scattered values for longitude 
+    REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN)    :: lat_scat_g     !! The scattered values for latitudes
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: z0m            !! Surface roughness (momentum)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: coastalflow_cpl!! Diffuse flow of water into the ocean (m^3/s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: riverflow_cpl  !! Largest rivers flowing into the ocean (m^3/s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: tsol_rad       !! Radiative surface temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: vevapp         !! Total of evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: temp_sol_new   !! New soil temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: qsurf          !! Surface specific humidity
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(out)        :: albedo         !! Albedo
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: fluxsens       !! Sensible chaleur flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: fluxlat        !! Latent chaleur flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: emis           !! Emissivity
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT(inout)        :: cdrag          !! Cdrag
+
+    !! 0.4 Optional input and output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL :: q2m            !! Surface specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL :: t2m            !! Surface air temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out),OPTIONAL :: z0h             !! Surface roughness (heat)
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN)    :: field_in_names !! Names for deposit variables to be transported
+                                                                             !! from chemistry model by GCM to ORCHIDEE
+    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN)       :: fields_in      !! Fields for deposit variables to be transported 
+                                                                             !! from chemistry model by GCM to ORCHIDEE
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN)    :: field_out_names!! Names for emission variables to be transported 
+                                                                             !! to chemistry model by GCM from ORCHIDEE
+    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(OUT)      :: fields_out     !! Fields for emission variables to be transported
+                                                                             !! to chemistry model by GCM from ORCHIDEE
+
+
+    !! 0.5 Local variables
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_rain  !! Work array to keep precip_rain
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_snow  !! Work array to keep precip_snow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zz0m          !! Work array to keep zz0m
+    REAL(r_std),DIMENSION (kjpindex)                      :: zz0h          !! Work array to keep zz0h
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcdrag        !! Work array for surface drag
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoastal      !! Work array to keep coastal flow (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex)                      :: zriver        !! Work array to keep river out flow (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad
+    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_sol_new !! Work array to keep temp_sol_new
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqsurf        !! Work array to keep qsurf
+    REAL(r_std),DIMENSION (kjpindex,2)                    :: zalbedo       !! Work array to keep albedo
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxsens     !! Work array to keep fluxsens
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxlat      !! Work array to keep fluxlat
+    REAL(r_std),DIMENSION (kjpindex)                      :: zemis         !! Work array to keep emis
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoszang      !! Work array to keep coszang
+    REAL(r_std),DIMENSION (kjpindex)                      :: q2m_loc       !! Work array for q2m or qair
+    REAL(r_std),DIMENSION (kjpindex)                      :: t2m_loc       !! Work array for t2m or temp_air
+    REAL(r_std),DIMENSION (:,:),ALLOCATABLE               :: lon_scat      !! The scattered values for longitude 
+    REAL(r_std),DIMENSION (:,:),ALLOCATABLE               :: lat_scat      !! The scattered values for latitude
+    INTEGER(i_std)                                        :: i, j, ik
+    INTEGER(i_std)                                        :: ier
+    INTEGER(i_std)                                        :: itau_sechiba
+    REAL(r_std)                                           :: mx, zlev_mean
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)              :: tmp_lon, tmp_lat, tmp_lev
+    INTEGER                                               :: old_fileout   !! old Logical Int for std IO output
+    REAL,ALLOCATABLE,DIMENSION(:,:)                       :: lalo_mpi
+    REAL,ALLOCATABLE,DIMENSION(:)                         :: zlev_glo1D
+    REAL(r_std),DIMENSION (kjpindex)                      :: landpoints    !! Land point vector
+    REAL(r_std)                                           :: tau_outflow   !! Number of days for temoral filter on river- and coastalflow
+    
+    
+
+    CALL ipslnlf_p(new_number=numout, old_number=old_fileout)
+    !
+    !  Configuration of SSL specific parameters
+    !
+    CALL control_initialize(xrdt)
+
+    ! Initialize specific write level
+    !printlev_loc=get_printlev('instersurf')
+
+    IF ( printlev_loc>=1 ) WRITE(numout,*) 'Entering intersurf_initialize_gathered'
+
+    ! Set the variable ok_q2m_t2m=true if q2m and t2m are present in the call from the gcm. 
+    ! If one of the variables are not present in this subroutine, set ok_q2m_t2m=.FALSE.
+    ! Otherwise do not change the current value. Note that the current value for ok_q2m_t2m comes 
+    ! either from default initialization (true) or from intersurf_main_gathered.
+    IF (.NOT. PRESENT(q2m) .OR. .NOT. PRESENT(t2m)) THEN
+       ok_q2m_t2m=.FALSE.
+    END IF
+    
+    IF (ok_q2m_t2m) THEN
+       t2m_loc=t2m
+       q2m_loc=q2m
+    ELSE
+       t2m_loc=temp_air
+       q2m_loc=qair
+    END IF
+
+    CALL intsurf_time( kjit, date0 )
+    
+    
+    CALL ioget_calendar (one_year, one_day)
+    
+    IF (is_omp_root) THEN
+       ALLOCATE(lon_scat(iim_g,jj_nb))
+       ALLOCATE(lat_scat(iim_g,jj_nb))
+    ELSE
+       ALLOCATE(lon_scat(1,1))
+       ALLOCATE(lat_scat(1,1))
+    ENDIF
+    
+    CALL init_WriteField_p
+    
+    !
+    !  Create the internal coordinate table
+    !
+    lalo(:,:) = latlon(:,:)
+    CALL gather(lalo,lalo_g)
+    !
+    !-
+    !- Store variable to help describe the grid
+    !- once the points are gathered.
+    !-
+    neighbours(:,:) = zneighbours(:,:)
+    CALL gather(neighbours,neighbours_g)
+    !
+    resolution(:,:) = zresolution(:,:)
+    CALL gather(resolution,resolution_g)
+    !
+    area(:) = resolution(:,1)*resolution(:,2)
+    CALL gather(area,area_g)
+    !
+    !- Store the fraction of the continents only once so that the user
+    !- does not change them afterwards.
+    !
+    contfrac(:) = zcontfrac(:)
+    CALL gather(contfrac,contfrac_g)
+    !
+    !
+    !  Create the internal coordinate table
+    !
+    IF ( (.NOT.ALLOCATED(tmp_lon))) THEN
+       ALLOCATE(tmp_lon(iim_g,jj_nb))
+    ENDIF
+    IF ( (.NOT.ALLOCATED(tmp_lat))) THEN
+       ALLOCATE(tmp_lat(iim_g,jj_nb))
+    ENDIF
+    IF ( (.NOT.ALLOCATED(tmp_lev))) THEN
+       ALLOCATE(tmp_lev(iim_g,jj_nb))
+    ENDIF
+    !
+    !  Either we have the scattered coordinates as arguments or
+    !  we have to do the work here.
+    !
+    IF (is_omp_root) THEN
+       lon_scat(:,:)=zero
+       lat_scat(:,:)=zero 
+       CALL scatter2D_mpi(lon_scat_g,lon_scat)
+       CALL scatter2D_mpi(lat_scat_g,lat_scat)
+       lon_scat(:,1)=lon_scat(:,2)
+       lon_scat(:,jj_nb)=lon_scat(:,2)
+       lat_scat(:,1)=lat_scat(iim_g,1)
+       lat_scat(:,jj_nb)=lat_scat(1,jj_nb)
+       
+       tmp_lon(:,:) = lon_scat(:,:)
+       tmp_lat(:,:) = lat_scat(:,:)
+       
+       IF (is_mpi_root) THEN
+          lon_g(:,:) = lon_scat_g(:,:)
+          lat_g(:,:) = lat_scat_g(:,:)
+       ENDIF
+    ENDIF
+    !
+    
+    !ANNE ici possibilite de calculer la grille du modele ? (lignes 965 ??
+    
+    
+    !ANNE calcul zlev, conserve la version de Martial
+    IF (is_root_prc) ALLOCATE(zlev_glo1D(nbp_glo))
+    CALL gather(zlev,zlev_glo1D)
+    
+    IF (is_root_prc) THEN
+       DO ik=1, nbp_glo
+          j = INT( (index_g(ik)-1) / iim_g ) + 1
+          i = index_g(ik) - (j-1) * iim_g
+          zlev_g(i,j) = zlev_glo1D(ik)
+       ENDDO
+    ENDIF
+
+    !Config Key  = FORCE_CO2_VEG
+    !Config Desc = Flag to force the value of atmospheric CO2 for vegetation.
+    !Config If   = Only in coupled mode
+    !Config Def  = FALSE
+    !Config Help = If this flag is set to true, the ATM_CO2 parameter is used
+    !Config        to prescribe the atmospheric CO2.
+    !Config        This Flag is only use in couple mode.
+    !Config Units = [FLAG]
+    fatmco2=.FALSE.
+    CALL getin_p('FORCE_CO2_VEG',fatmco2)
+    !
+    ! Next flag is only use in couple mode with a gcm in intersurf.
+    ! In forced mode, it has already been read and set in driver.
+    IF ( fatmco2 ) THEN
+       !Config Key  = ATM_CO2
+       !Config IF   = FORCE_CO2_VEG (only in coupled mode)
+       !Config Desc = Value for atm CO2 
+       !Config Def  = 350.
+       !Config Help = Value to prescribe the atm CO2.
+       !Config        For pre-industrial simulations, the value is 286.2 .
+       !Config        348. for 1990 year.
+       !Config Units = [ppm]
+       atmco2=350.
+       CALL getin_p('ATM_CO2',atmco2)
+       WRITE(numout,*) 'atmco2 ',atmco2
+    ENDIF
+    
+    CALL ioipslctrl_restini(kjit, date0, xrdt, rest_id, rest_id_stom, itau_offset, date0_shifted)
+    itau_sechiba = kjit + itau_offset
+    
+    !!- Initialize module for output with XIOS
+    !
+    CALL xios_orchidee_init( MPI_COMM_ORCH,               &
+         date0,    year,    month,          day,          &
+         tmp_lon,  tmp_lat, znt )
+    
+    !- Initialize IOIPSL sechiba output files
+    CALL ioipslctrl_history(iim_g, jj_nb, tmp_lon, tmp_lat,  kindex, kjpindex, itau_sechiba, &
+         date0_shifted, xrdt, hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC)
+    
+    CALL bcast_omp(hist_id)
+    CALL bcast_omp(hist2_id)
+    CALL bcast_omp(hist_id_stom)
+    CALL bcast_omp(hist_id_stom_IPCC)
+    
+    ! Count number of extra output fields to the GCM if it is not already done. 
+    IF (nb_fields_out == -1) THEN
+       ! nb_fields_out is not yet calculated. Do it now.  
+       ! This means that the call is done directly from GCM.
+       IF (PRESENT(field_out_names)) THEN
+          nb_fields_out=SIZE(field_out_names)
+       ELSE
+          nb_fields_out=0
+       ENDIF
+    END IF
+
+    ! Count number of extra input fields to the GCM if it is not already done. 
+    IF (nb_fields_in == -1) THEN
+       ! nb_fields_in is not yet calculated. Do it now.  
+       ! This means that the call is done directly from GCM.
+       IF (PRESENT(field_in_names)) THEN
+          nb_fields_in=SIZE(field_in_names)
+       ELSE
+          nb_fields_in=0
+       ENDIF
+    END IF
+
+
+    !
+    !! Change to be in the orchidee context for XIOS
+    !
+    CALL xios_orchidee_change_context("orchidee")
+    
+    !
+    !  Shift the time step to phase the two models
+    !
+    itau_sechiba = kjit + itau_offset
+    
+    ! Update the calendar in xios by sending the new time step
+    ! Special case : the model is only in initialization phase and the current itau_sechiba is not a real time step. 
+    ! Therefor give itau_sechiba+1 to xios to have a correct time axis in output files. 
+    CALL xios_orchidee_update_calendar(itau_sechiba+1)
+    
+    CALL intsurf_time( itau_sechiba, date0_shifted )
+    
+    !
+    ! 1. Just change the units of some input fields
+    !
+    DO ik=1, kjpindex
+       
+       zprecip_rain(ik) = precip_rain(ik)*xrdt
+       zprecip_snow(ik) = precip_snow(ik)*xrdt
+       zcdrag(ik)       = cdrag(ik)
+       
+    ENDDO
+ 
+    ! Fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE.
+    ! There are currently no fields to be transported into ORCHIDEE in this way
+    DO i = 1, nb_fields_in
+       WRITE(numout,*) i," Champ = ",TRIM(field_in_names(i)) 
+       SELECT CASE(TRIM(field_in_names(i)))
+       CASE DEFAULT 
+          CALL ipslerr_p (3,'intsurf_gathered', &
+               'You ask in GCM an unknown field '//TRIM(field_in_names(i))//&
+               ' to give to ORCHIDEE for this specific version.',&
+               'This model won''t be able to continue.', &
+               '(check your tracer parameters in GCM)')
+       END SELECT
+    ENDDO
+
+    !
+    ! 3. save the grid
+    !
+    landpoints(:)=(/ ( REAL(ik), ik=1,kjpindex ) /)
+    CALL histwrite_p(hist_id, 'LandPoints',  itau_sechiba+1, landpoints, kjpindex, kindex)
+    CALL histwrite_p(hist_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+    IF ( ok_stomate ) THEN
+       CALL histwrite_p(hist_id_stom, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+       IF ( hist_id_stom_ipcc > 0 ) &
+            CALL histwrite_p(hist_id_stom_IPCC, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+    ENDIF
+    CALL histwrite_p(hist_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+    
+    ! Syncronize output but only if flag ok_histsync is set to true       
+    IF (ok_histsync) THEN
+       IF (is_omp_root .AND. hist_id > 0) THEN
+          CALL histsync(hist_id)
+       END IF
+    END IF
+    
+    IF ( hist2_id > 0 ) THEN
+       CALL histwrite_p(hist2_id, 'LandPoints',  itau_sechiba+1, landpoints, kjpindex, kindex)
+       CALL histwrite_p(hist2_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+       CALL histwrite_p(hist2_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+       
+       ! Syncronize output but only if flag ok_histsync is set to true
+       IF (ok_histsync .AND. is_omp_root) THEN
+          CALL histsync(hist2_id)
+       ENDIF
+    ENDIF
+    !
+    
+    !
+    ! 4. call sechiba for continental points only
+    !
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'Calling sechiba_initialize'
+
+    CALL sechiba_initialize( &
+         itau_sechiba, iim_g*jj_nb,  kjpindex,      kindex,                     &
+         lalo,         contfrac,     neighbours,    resolution,  zlev,          &
+         u,            v,            qair,          t2m_loc,     temp_air,      &
+         petAcoef,     peqAcoef,     petBcoef,      peqBcoef,                   &
+         zprecip_rain, zprecip_snow, lwdown,        swnet,       swdown,        &
+         pb,           rest_id,      hist_id,       hist2_id,                   &
+         rest_id_stom, hist_id_stom, hist_id_stom_IPCC,                         &
+         zcoastal,     zriver,       ztsol_rad,     zvevapp,     zqsurf,        &
+         zz0m,          zz0h,        zalbedo,      zfluxsens,     zfluxlat,    zemis,         &
+         znetco2,      zcarblu,      ztemp_sol_new, zcdrag, zcoszang)
+    
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'Out of sechiba_initialize'
+
+    !
+    ! 6. scatter output fields
+    !
+    DO ik=1, kjpindex
+       z0m(ik)          = zz0m(ik)
+       tsol_rad(ik)     = ztsol_rad(ik)
+       vevapp(ik)       = zvevapp(ik)/xrdt ! Transform into kg/m^2/s
+       temp_sol_new(ik) = ztemp_sol_new(ik)
+       qsurf(ik)        = zqsurf(ik)
+       albedo(ik,1)     = zalbedo(ik,1)
+       albedo(ik,2)     = zalbedo(ik,2)
+       fluxsens(ik)     = zfluxsens(ik)
+       fluxlat(ik)      = zfluxlat(ik)
+       emis(ik)         = zemis(ik)
+       cdrag(ik)        = zcdrag(ik)
+    ENDDO
+    ! z0h is a optional output variable. Check first if it is present in the call from LMDZ.
+    IF ( PRESENT(z0h) ) z0h(:) = zz0h(:)
+
+    !Config Key  = TAU_OUTFLOW
+    !Config Desc = Number of days over which the coastal- and riverflow will be
+    !distributed
+    !Config If   = Only in coupled mode
+    !Config Def  = 0
+    !Config Help = The default value 0 makes the distribution instanteneous
+    !Config Units = [days]
+    tau_outflow = 0
+    CALL getin_p('TAU_OUTFLOW',tau_outflow)
+    IF (tau_outflow <=xrdt/one_day) THEN
+       coeff_rel = 1.0
+    ELSE
+       coeff_rel = (1.0 - exp(-xrdt/(tau_outflow*one_day)))
+    END IF
+    IF (printlev_loc >=2)  WRITE(numout,*),'tau_outflow, coeff_rel = ', tau_outflow, coeff_rel
+
+    ! Allocate and read riverflow_cpl0 from restart file. Initialize to 0 if the
+    ! variable was not found in the restart file.
+    ALLOCATE(riverflow_cpl0(kjpindex), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialize_gathered', 'Error in allocation of riverflow_cpl0','','')
+    CALL restget_p (rest_id, 'riverflow_cpl0', nbp_glo, 1, 1, kjit, .TRUE., riverflow_cpl0, "gather", nbp_glo, index_g)
+    IF ( ALL(riverflow_cpl0(:) == val_exp) ) riverflow_cpl0(:)=0
+
+    ! Allocate and read coastalflow_cpl0 from restart file. Initialize to 0 if
+    ! the variable was not found in the restart file.
+    ALLOCATE(coastalflow_cpl0(kjpindex), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialize_gathered', 'Error inallocation of coastalflow_cpl0','','')
+    CALL restget_p (rest_id, 'coastalflow_cpl0', nbp_glo, 1, 1, kjit, .TRUE., coastalflow_cpl0, "gather", nbp_glo, index_g)
+    IF ( ALL(coastalflow_cpl0(:) == val_exp) ) coastalflow_cpl0(:)=0
+
+    ! Do not applay the filter now in initialization phase. 
+    ! These variables will never be used anyway in the initialization phase. 
+    ! Transform into m^3/s
+    riverflow_cpl = zriver/xrdt
+    coastalflow_cpl = zcoastal/xrdt
+
+    
+    ! Fields for emission variables : to be transport by GCM to chemistry model.
+    DO i = 1, nb_fields_out
+       SELECT CASE(TRIM(field_out_names(i)))
+       CASE("fCO2_land") 
+          fields_out(:,i)=znetco2(:)
+       CASE("fCO2_land_use")
+          fields_out(:,i)=zcarblu(:)
+       CASE DEFAULT 
+          CALL ipslerr_p (3,'intsurf_gathered', &
+               'You ask from GCM an unknown field '//TRIM(field_out_names(i))//&
+               ' to ORCHIDEE for this specific version.',&
+               'This model won''t be able to continue.', &
+               '(check your tracer parameters in GCM)')
+       END SELECT
+    END  DO
+
+    IF(is_root_prc) CALL getin_dump
+    lstep_init_intersurf = .FALSE.
+    
+    CALL ipslnlf_p(new_number=old_fileout)
+    !
+    !! Change back to be in the LMDZ context for XIOS
+    !
+    CALL xios_orchidee_change_context("LMDZ")
+
+  END SUBROUTINE intersurf_initialize_gathered
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    intersurf_main_gathered
+!!
+!>\BRIEF	  Main subroutine to call ORCHIDEE from the gcm (LMDZ) using variables on a 1D grid with only land points.
+!!
+!! DESCRIPTION:	  This subroutine is the main interface for ORCHIDEE when it is called from the gcm (LMDZ).
+!!                The variables are all gathered before entering this subroutine on the 1D grid with only landpoints.
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE intersurf_main_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
+       lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
+       zlev,  u, v, qair, temp_air, epot_air, ccanopy, &
+       cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+       precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
+       vevapp, fluxsens, fluxlat, coastalflow_cpl, riverflow_cpl, &
+       tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m,lon_scat_g, lat_scat_g, q2m, t2m, z0h,&
+       field_out_names, fields_out, field_in_names, fields_in, &
+       coszang)  
+
+    USE mod_orchidee_para
+    IMPLICIT NONE
+
+    !! 0. Variable and parameter declaratiot/
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT (in)                            :: kjit            !! Time step number
+    INTEGER(i_std),INTENT (in)                            :: iim_glo         !! Dimension of global fields
+    INTEGER(i_std),INTENT (in)                            :: jjm_glo         !! Dimension of global fields
+    INTEGER(i_std),INTENT (in)                            :: kjpindex        !! Number of continental points
+    REAL(r_std),INTENT (in)                               :: xrdt            !! Time step in seconds
+    LOGICAL, INTENT (in)                                  :: lrestart_read   !! Logical for _restart_ file to read
+    LOGICAL, INTENT (in)                                  :: lrestart_write  !! Logical for _restart_ file to write'
+    REAL(r_std), INTENT (in)                              :: date0           !! Date at which kjit = 0
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: kindex          !! Index for continental points
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: u               !! Lowest level wind speed
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: v               !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: zlev            !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: qair            !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: precip_rain     !! Rain precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: precip_snow     !! Snow precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: lwdown          !! Down-welling long-wave flux 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: swnet           !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: swdown          !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: temp_air        !! Air temperature in Kelvin
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: epot_air        !! Air potential energy
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: ccanopy         !! CO2 concentration in the canopy
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: petAcoef        !! Coeficients A from the PBL resolution
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: peqAcoef        !! One for T and another for q
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: petBcoef        !! Coeficients B from the PBL resolution
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: peqBcoef        !! One for T and another for q
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: pb              !! Surface pressure
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)        :: latlon          !! Geographical coordinates
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: zcontfrac       !! Fraction of continent
+    INTEGER(i_std),DIMENSION (kjpindex,NbNeighb), INTENT(in):: zneighbours     !! neighbours
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)        :: zresolution     !! size of the grid box
+    REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN)   :: lon_scat_g      !! The scattered values for longitude 
+    REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN)   :: lat_scat_g      !! The scattered values for latitude
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: z0m             !! Surface roughness for momentum
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: coastalflow_cpl !! Diffuse flow of water into the ocean (m^3/s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: riverflow_cpl   !! Largest rivers flowing into the ocean (m^3/s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: tsol_rad        !! Radiative surface temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: vevapp          !! Total of evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: temp_sol_new    !! New soil temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: qsurf           !! Surface specific humidity
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(out)       :: albedo          !! Albedo
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: fluxsens        !! Sensible chaleur flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: fluxlat         !! Latent chaleur flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: emis            !! Emissivity
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT(inout)       :: cdrag           !! Cdrag
+
+    !! 0.4 Optional input and output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL:: q2m             !! Surface specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL:: t2m             !! Surface air temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out),OPTIONAL:: z0h             !! Surface roughness for heat
+    REAL(r_std), DIMENSION(kjpindex), OPTIONAL, INTENT(in):: coszang         !! Cosine of the solar zenith angle (unitless)
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN)   :: field_in_names  !! Names for deposit variables to be transported
+                                                                             !! from chemistry model by GCM to ORCHIDEE
+    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN)      :: fields_in       !! Fields for deposit variables to be transported 
+                                                                             !! from chemistry model by GCM to ORCHIDEE
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN)   :: field_out_names !! Names for emission variables to be transported 
+                                                                             !! to chemistry model by GCM from ORCHIDEE
+    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(OUT)     :: fields_out      !! Fields for emission variables to be transported
+                                                                             !! to chemistry model by GCM from ORCHIDEE
+
+    !! 0.5 Local variables
+    REAL(r_std),DIMENSION (kjpindex)                      :: zccanopy      !! Work array to keep ccanopy
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_rain  !! Work array to keep precip_rain
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_snow  !! Work array to keep precip_snow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zz0m, zz0h    !! Work array to keep zz0m, zz0h
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcdrag        !! Work array for surface drag
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoastal      !! Work array to keep coastal flow (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex)                      :: zriver        !! Work array to keep river out flow (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad
+    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_sol_new !! Work array to keep temp_sol_new
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqsurf        !! Work array to keep qsurf
+    REAL(r_std),DIMENSION (kjpindex,2)                    :: zalbedo       !! Work array to keep albedo
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxsens     !! Work array to keep fluxsens
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxlat      !! Work array to keep fluxlat
+    REAL(r_std),DIMENSION (kjpindex)                      :: zemis         !! Work array to keep emis
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoszang      !! Work array to keep coszang
+    REAL(r_std),DIMENSION (kjpindex)                      :: q2m_loc       !! Work array for q2m or qair
+    REAL(r_std),DIMENSION (kjpindex)                      :: t2m_loc       !! Work array for t2m or temp_air
+    REAL(r_std),DIMENSION (:,:),ALLOCATABLE               :: lon_scat      !! The scattered values for longitude 
+    REAL(r_std),DIMENSION (:,:),ALLOCATABLE               :: lat_scat      !! The scattered values for latitude
+    INTEGER(i_std)                                        :: i, j, ik
+    INTEGER(i_std)                                        :: ier
+    INTEGER(i_std)                                        :: itau_sechiba
+    REAL(r_std)                                           :: mx, zlev_mean
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)              :: tmp_lon, tmp_lat, tmp_lev
+    INTEGER                                               :: old_fileout   !! old Logical Int for std IO output
+    REAL,ALLOCATABLE,DIMENSION(:,:)                       :: lalo_mpi
+    REAL,ALLOCATABLE,DIMENSION(:)                         :: zlev_glo1D
+    REAL(r_std),DIMENSION (kjpindex)                      :: landpoints    !! Local landpoints vector
+    
+
+    CALL ipslnlf_p(new_number=numout, old_number=old_fileout)
+    
+    IF (lstep_init_intersurf) THEN
+       ! Test if q2m and t2m are present
+       IF (PRESENT(q2m) .AND. PRESENT(t2m)) THEN
+          ok_q2m_t2m=.TRUE.
+       ELSE
+          ok_q2m_t2m=.FALSE.
+       ENDIF
+
+       ! Test if field_out_names and field_in_names are present and if so, count 
+       ! the number of extra fields to exchange.
+       IF (PRESENT(field_out_names)) THEN
+          nb_fields_out=SIZE(field_out_names)
+       ELSE
+          nb_fields_out=0
+       ENDIF
+
+       IF (PRESENT(field_in_names)) THEN
+          nb_fields_in=SIZE(field_in_names)
+       ELSE
+          nb_fields_in=0
+       ENDIF
+    
+       CALL intersurf_initialize_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
+            lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
+            zlev,  u, v, qair, temp_air, epot_air, &
+            cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+            precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
+            vevapp, fluxsens, fluxlat, coastalflow_cpl, riverflow_cpl, &
+            tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m,lon_scat_g, lat_scat_g, q2m, t2m, zz0h,&
+            field_out_names, fields_out, field_in_names, fields_in )  
+
+       ! z0h is a optional output variable. Check first if it is present in the call from LMDZ.
+       IF ( PRESENT(z0h) ) z0h(:) = zz0h(:)
+       ! Return from subroutine intersurf_main_gathered
+       RETURN
+    END IF
+
+    !
+    !! Change to be in the orchidee context for XIOS
+    !
+    CALL xios_orchidee_change_context("orchidee")
+    
+    !
+    !  Shift the time step to phase the two models
+    !
+    itau_sechiba = kjit + itau_offset
+    
+    ! Update the calendar in xios by sending the new time step
+    CALL xios_orchidee_update_calendar(itau_sechiba)
+    
+    CALL intsurf_time( itau_sechiba, date0_shifted )
+
+    ! Test LMDz inputs
+    IF (check_INPUTS) THEN
+       IF ( sec <= 7200 ) THEN
+          WRITE(numout,*) "sec = ",sec
+          CALL WriteFieldI_p("Wu",u)
+          WRITE(numout,*) "Lowest level wind speed :",u
+          CALL WriteFieldI_p("Wv",v)
+          WRITE(numout,*) "Lowest level wind speed  :",v
+          CALL WriteFieldI_p("Wzlev",zlev)
+          WRITE(numout,*) "Height of first layer :",zlev
+          CALL WriteFieldI_p("Wqair",qair)
+          WRITE(numout,*) "Lowest level specific humidity :",qair
+          CALL WriteFieldI_p("Wprecip_rain",precip_rain)
+          WRITE(numout,*) "Rain precipitation :",precip_rain
+          CALL WriteFieldI_p("Wprecip_snow",precip_snow)
+          WRITE(numout,*) "Snow precipitation :",precip_snow
+          CALL WriteFieldI_p("Wlwdown",lwdown)
+          WRITE(numout,*) "Down-welling long-wave flux  :",lwdown
+          CALL WriteFieldI_p("Wswnet",swnet)
+          WRITE(numout,*) "Net surface short-wave flux :",swnet
+          CALL WriteFieldI_p("Wswdown",swdown)
+          WRITE(numout,*) "Downwelling surface short-wave flux :",swdown
+          CALL WriteFieldI_p("Wtemp_air",temp_air)
+          WRITE(numout,*) "Air temperature in Kelvin :",temp_air
+          CALL WriteFieldI_p("Wepot_air",epot_air)
+          WRITE(numout,*) "Air potential energy :",epot_air
+          CALL WriteFieldI_p("Wccanopy",ccanopy)
+          WRITE(numout,*) "CO2 concentration in the canopy :",ccanopy
+          CALL WriteFieldI_p("WpetAcoef",petAcoef)
+          WRITE(numout,*) "Coeficients A from the PBL resolution :",petAcoef
+          CALL WriteFieldI_p("WpeqAcoef",peqAcoef)
+          WRITE(numout,*) "One for T and another for q :",peqAcoef
+          CALL WriteFieldI_p("WpetBcoef",petBcoef)
+          WRITE(numout,*) "Coeficients B from the PBL resolution :",petBcoef
+          CALL WriteFieldI_p("WpeqBcoef",peqBcoef)
+          WRITE(numout,*) "One for T and another for q :",peqBcoef
+          CALL WriteFieldI_p("Wcdrag",cdrag)
+          WRITE(numout,*) "Cdrag :",cdrag
+          CALL WriteFieldI_p("Wpb",pb)
+          WRITE(numout,*) "Surface pressure :",pb
+          CALL WriteFieldI_p("Wzcontfrac",zcontfrac)
+          WRITE(numout,*) "Fraction of continent :",zcontfrac
+          IF ( ok_q2m_t2m) THEN
+             CALL WriteFieldI_p("Wq2m",q2m)
+             WRITE(numout,*) "Surface specific humidity :",q2m
+             CALL WriteFieldI_p("Wt2m",t2m)
+             WRITE(numout,*) "Surface air temperature :",t2m
+          ENDIF
+       ENDIF
+    ENDIF
+
+    !
+    ! 1. Just change the units of some input fields
+    !
+    DO ik=1, kjpindex
+       
+       zprecip_rain(ik) = precip_rain(ik)*xrdt
+       zprecip_snow(ik) = precip_snow(ik)*xrdt
+       zcdrag(ik)       = cdrag(ik)
+       
+    ENDDO
+
+    !>> VOC in coupled mode 
+    IF ( PRESENT(coszang) )  THEN 
+       zcoszang(:) = coszang(:)
+    ELSE
+       zcoszang(:) = zero
+    ENDIF
+ 
+    IF (check_INPUTS) THEN
+       WRITE(numout,*) "Intersurf_main_gathered :"
+       WRITE(numout,*) "Time step number = ",kjit
+       WRITE(numout,*) "Dimension of input fields for local mpi process = ",iim_g, jj_nb
+       WRITE(numout,*) "Number of continental points = ",kjpindex
+       WRITE(numout,*) "Time step in seconds = ",xrdt
+       WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
+       WRITE(numout,*) "Date at which kjit = 0  =  ",date0
+       WRITE(numout,*) "offset for OMP = ",offset_omp
+       WRITE(numout,*) "Index for continental points = ",kindex
+       IF (is_omp_root) THEN
+          WRITE(numout,*) "ROOT OMP, Index global MPI : ",kindex_mpi(:)
+       ENDIF
+       IF (is_root_prc) THEN
+          WRITE(numout,*) "ROOT global, Index global : ",index_g(:)
+       ENDIF
+       WRITE(numout,*) "Lowest level wind speed North = ",u
+       WRITE(numout,*) "Lowest level wind speed East = ",v
+       WRITE(numout,*) "Height of first layer = ",zlev
+       WRITE(numout,*) "Lowest level specific humidity = ",qair
+       WRITE(numout,*) "Rain precipitation = ",zprecip_rain
+       WRITE(numout,*) "Snow precipitation = ",zprecip_snow
+       WRITE(numout,*) "Down-welling long-wave flux = ",lwdown
+       WRITE(numout,*) "Net surface short-wave flux = ",swnet
+       WRITE(numout,*) "Downwelling surface short-wave flux = ",swdown
+       WRITE(numout,*) "Air temperature in Kelvin = ",temp_air
+       WRITE(numout,*) "Air potential energy = ",epot_air
+       WRITE(numout,*) "CO2 concentration in the canopy = ",ccanopy
+       WRITE(numout,*) "Coeficients A from the PBL resolution = ",petAcoef
+       WRITE(numout,*) "One for T and another for q = ",peqAcoef
+       WRITE(numout,*) "Coeficients B from the PBL resolution = ",petBcoef
+       WRITE(numout,*) "One for T and another for q = ",peqBcoef
+       WRITE(numout,*) "Cdrag = ",zcdrag
+       WRITE(numout,*) "Surface pressure = ",pb
+       WRITE(numout,*) "Geographical land coordinates lon = ", lalo(:,2)
+       WRITE(numout,*) "Geographical land coordinates lat = ", lalo(:,1)
+       WRITE(numout,*) "Fraction of continent in the grid = ",zcontfrac
+    ENDIF
+
+
+    ! Fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE.
+    DO i = 1, nb_fields_in
+       WRITE(numout,*) i," Champ = ",TRIM(field_in_names(i)) 
+       SELECT CASE(TRIM(field_in_names(i)))
+       CASE DEFAULT 
+          CALL ipslerr_p (3,'intsurf_gathered', &
+               'You ask in GCM an unknown field '//TRIM(field_in_names(i))//&
+               ' to give to ORCHIDEE for this specific version.',&
+               'This model won''t be able to continue.', &
+               '(check your tracer parameters in GCM)')
+       END SELECT
+    ENDDO
+
+    !
+    ! 2. modification of co2
+    !
+    IF ( fatmco2 ) THEN
+       zccanopy(:) = atmco2
+       WRITE (numout,*) 'Modification of the ccanopy value. CO2 = ',atmco2
+    ELSE
+       zccanopy(:) = ccanopy(:)
+    ENDIF
+
+    !
+    ! 4. call sechiba for continental points only
+    !
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'Calling sechiba'
+   
+
+    IF (ok_q2m_t2m) THEN
+       t2m_loc=t2m
+       q2m_loc=q2m
+    ELSE
+       t2m_loc=temp_air
+       q2m_loc=qair
+    END IF
+
+    CALL sechiba_main (itau_sechiba, iim_g*jj_nb, kjpindex, kindex, &
+         lrestart_read, lrestart_write, &
+         lalo, contfrac, neighbours, resolution, &
+         zlev, u, v, qair, q2m_loc, t2m_loc, temp_air, epot_air, zccanopy, &
+         zcdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+         zprecip_rain ,zprecip_snow,  lwdown, swnet, swdown, zcoszang, pb, &
+         zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
+         ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0m, zz0h, &
+         rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC ) 
+
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'out of SECHIBA'
+
+    !
+    ! 6. scatter output fields
+    !
+    DO ik=1, kjpindex
+       z0m(ik)          = zz0m(ik)
+       tsol_rad(ik)     = ztsol_rad(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)
+
+       ! Transform the water fluxes into Kg/m^2/s
+       vevapp(ik)       = zvevapp(ik)/xrdt
+
+    ENDDO
+
+    ! Applay time filter to distribut the river- and coastalflow over a longer time period.
+    ! When coeff_rel=1(default case when tau_outflow=0), the distribution is instanteneous. 
+    ! Use TAU_OUTFLOW in run.def to set the number of days of distribution.
+    ! The water fluxes zriver and zcoastal coming from sechiba are at the same
+    ! time transfromed from m^3/dt_sechiba into m^3/s by dividing with the sechiba time step
+    ! (xrdt).
+    riverflow_cpl = coeff_rel*zriver/xrdt + (1.-coeff_rel)*riverflow_cpl0
+    riverflow_cpl0 = riverflow_cpl
+
+    coastalflow_cpl = coeff_rel*zcoastal/xrdt + (1.-coeff_rel)*coastalflow_cpl0
+    coastalflow_cpl0 = coastalflow_cpl
+
+
+    ! z0h is a optional output variable. Check first if it is present in the call from LMDZ.
+    IF ( PRESENT(z0h) ) z0h(:) = zz0h(:)
+       
+    CALL xios_orchidee_send_field("LandPoints" ,(/ ( REAL(ik), ik=1,kjpindex ) /))
+    CALL xios_orchidee_send_field("Areas", area)
+    CALL xios_orchidee_send_field("Contfrac",contfrac)
+    CALL xios_orchidee_send_field("evap",zvevapp*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("coastalflow_cpl",coastalflow_cpl)
+    CALL xios_orchidee_send_field("riverflow_cpl",riverflow_cpl)
+    CALL xios_orchidee_send_field("temp_sol_C",ztemp_sol_new-ZeroCelsius)
+    CALL xios_orchidee_send_field("temp_sol_K",ztemp_sol_new)
+    CALL xios_orchidee_send_field("fluxsens",zfluxsens)
+    CALL xios_orchidee_send_field("fluxlat",zfluxlat)
+    CALL xios_orchidee_send_field("tair",temp_air)
+    CALL xios_orchidee_send_field("qair",qair)
+    CALL xios_orchidee_send_field("swnet",swnet)
+    CALL xios_orchidee_send_field("swdown",swdown)
+    ! pb in hPa, output in Pa
+    CALL xios_orchidee_send_field("Psurf",pb*100.)
+
+ 
+    IF (ok_q2m_t2m) THEN
+       CALL xios_orchidee_send_field("t2m",t2m)
+       CALL xios_orchidee_send_field("q2m",q2m)
+    ELSE
+       CALL xios_orchidee_send_field("t2m",temp_air)
+       CALL xios_orchidee_send_field("q2m",qair)
+    ENDIF
+    
+    IF ( .NOT. almaoutput ) THEN
+       !
+       !  scattered during the writing
+       !           
+       CALL histwrite_p (hist_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
+       ! 
+       CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+       
+       CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'fluxlat',  itau_sechiba, zfluxlat,  kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'swnet',    itau_sechiba, swnet,    kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'swdown',   itau_sechiba, swdown,   kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'tair',     itau_sechiba, temp_air, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'qair',     itau_sechiba, qair, kjpindex, kindex)
+       IF (ok_q2m_t2m) THEN
+          CALL histwrite_p (hist_id, 't2m',      itau_sechiba, t2m, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'q2m',      itau_sechiba, q2m, kjpindex, kindex)
+       ELSE
+          CALL histwrite_p (hist_id, 't2m',      itau_sechiba, temp_air, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'q2m',      itau_sechiba, qair, kjpindex, kindex)
+       ENDIF
+       !
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p (hist2_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
+          ! 
+          CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, temp_sol_new, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, temp_sol_new, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, temp_sol_new, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'fluxlat',  itau_sechiba, zfluxlat,  kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'swnet',    itau_sechiba, swnet,    kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'swdown',   itau_sechiba, swdown,   kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'tair',     itau_sechiba, temp_air, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'qair',     itau_sechiba, qair, kjpindex, kindex)
+          IF (ok_q2m_t2m) THEN
+             CALL histwrite_p (hist2_id, 't2m',      itau_sechiba, t2m, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'q2m',      itau_sechiba, q2m, kjpindex, kindex)
+          ELSE
+             CALL histwrite_p (hist2_id, 't2m',      itau_sechiba, temp_air, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'q2m',      itau_sechiba, qair, kjpindex, kindex)
+          ENDIF
+       ENDIF
+    ELSE
+       CALL histwrite_p (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'SWnet',    itau_sechiba, swnet, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'RadT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+       !
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'SWnet',    itau_sechiba, swnet, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+       ENDIF
+    ENDIF
+    
+    ! Syncronize output but only if flag ok_histsync is set to true
+    IF (ok_histsync .AND. is_omp_root) THEN
+       IF ( (dw .EQ. xrdt) .AND. hist_id > 0 ) THEN
+          CALL histsync(hist_id)
+       ENDIF
+    ENDIF
+    
+    ! Fields for emission variables : to be transport by GCM to chemistry model.
+    DO i = 1, nb_fields_out
+       SELECT CASE(TRIM(field_out_names(i)))
+       CASE("fCO2_land") 
+          fields_out(:,i)=znetco2(:)
+       CASE("fCO2_land_use")
+          fields_out(:,i)=zcarblu(:)
+       CASE DEFAULT 
+          CALL ipslerr_p (3,'intsurf_gathered', &
+            &          'You ask from GCM an unknown field '//TRIM(field_out_names(i))//&
+            &          ' to ORCHIDEE for this specific version.',&
+            &          'This model won''t be able to continue.', &
+            &          '(check your tracer parameters in GCM)')
+       END SELECT
+    ENDDO
+
+    IF (printlev_loc >=3) WRITE (numout,*) ' intersurf_main done '
+
+!Test ORCHIDEE Outputs
+    IF (check_INPUTS) THEN
+       IF ( sec <= 7200 ) THEN
+          CALL WriteFieldI_p("Wcdrag",cdrag)
+          WRITE(numout,*) "Cdrag :",cdrag
+          CALL WriteFieldI_p("Wz0m",z0m)
+          WRITE(numout,*) "Surface roughness :",z0m
+          CALL WriteFieldI_p("Wcoastalflow",coastalflow_cpl)
+          WRITE(numout,*) "Diffuse flow of water into the ocean (m^3/s) :",coastalflow_cpl
+          CALL WriteFieldI_p("Wriverflow",riverflow_cpl)
+          WRITE(numout,*) "Largest rivers flowing into the ocean (m^3/s) :",riverflow_cpl
+          CALL WriteFieldI_p("Wtsol_rad",tsol_rad)
+          WRITE(numout,*) "Radiative surface temperature :",tsol_rad
+          CALL WriteFieldI_p("Wvevapp",vevapp)
+          WRITE(numout,*) "Total of evaporation :",vevapp
+          CALL WriteFieldI_p("Wtemp_sol_new",temp_sol_new)
+          WRITE(numout,*) "New soil temperature :",temp_sol_new
+          CALL WriteFieldI_p("Wqsurf",qsurf)
+          WRITE(numout,*) "Surface specific humidity :",qsurf
+          CALL WriteFieldI_p("Walbedo_nir",albedo(:,1))
+          WRITE(numout,*) "Albedo nir:",albedo(:,1)
+          CALL WriteFieldI_p("Walbedo_vis",albedo(:,2))
+          WRITE(numout,*) "Albedo vir :",albedo(:,2)
+          CALL WriteFieldI_p("Wfluxsens",fluxsens)
+          WRITE(numout,*) "Sensible chaleur flux :",fluxsens
+          CALL WriteFieldI_p("Wfluxlat",fluxlat)
+          WRITE(numout,*) "Latent chaleur flux :",fluxlat
+          CALL WriteFieldI_p("Wemis",emis)
+          WRITE(numout,*) "Emissivity :",emis
+       ENDIF
+    ENDIF
+
+    ! Write variables to restart file
+    IF (lrestart_write) THEN
+       CALL restput_p (rest_id, 'riverflow_cpl0', nbp_glo, 1, 1, kjit, riverflow_cpl0, 'scatter',  nbp_glo, index_g)
+       CALL restput_p (rest_id, 'coastalflow_cpl0', nbp_glo, 1, 1, kjit, coastalflow_cpl0, 'scatter',  nbp_glo, index_g)
+    END IF
+
+    !
+    CALL ipslnlf_p(new_number=old_fileout)
+    !        
+
+    !
+    !! Finalize the XIOS orchidee context if it is the last call
+    !
+    IF (lrestart_write) THEN
+       CALL xios_orchidee_context_finalize
+    END IF
+    !
+    !! Change back to be in the LMDZ context for XIOS
+    !
+    CALL xios_orchidee_change_context("LMDZ")
+
+    
+  END SUBROUTINE intersurf_main_gathered
+
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    intsurf_time
+!!
+!>\BRIEF	  Initalize and update time information
+!!
+!! DESCRIPTION:	  Initialize and update time information. This subroutine is called in the initialization phase and at each 
+!!                time step from the different intersurf subroutines. 
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE intsurf_time(istp, date0)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std), INTENT(in)                  :: istp      !! Time step of the restart file
+    REAL(r_std), INTENT(in)                     :: date0     !! The date at which itau = 0
+
+    IF (lstep_init_intersurf) THEN
+       CALL ioget_calendar(calendar_str)
+       CALL ioget_calendar(one_year, one_day)
+       CALL tlen2itau('1Y',dt_sechiba,date0,year_length)
+       IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN  
+          year_spread=un
+       ELSE
+          year_spread = one_year/365.2425
+       ENDIF
+
+       IF (printlev_loc >=3) THEN
+          write(numout,*) "calendar_str =",calendar_str
+          write(numout,*) "one_year=",one_year,", one_day=",one_day
+          write(numout,*) "dt_sechiba=",dt_sechiba,", date0=",date0,", year_length=",year_length,", year_spread=",year_spread
+       ENDIF
+    ENDIF
+
+    IF ( printlev_loc >=4 ) WRITE(numout,*) "---" 
+    ! Dans diffuco (ie date0 == date0_shift !!) 
+
+    IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN  
+       !
+       ! Get Julian date
+       in_julian = itau2date(istp, date0, dt_sechiba)
+
+       ! Real date
+       CALL ju2ymds (in_julian, year, month, day, sec)
+!!$       jur=zero
+!!$       julian_diff = in_julian
+!!$       month_len = ioget_mon_len (year,month)
+!!$       IF ( printlev_loc >=4 ) THEN
+!!$          write(numout,*) "in_julian, jur, julian_diff=",in_julian, jur, julian_diff
+!!$          write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+!!$       ENDIF
+
+       ! julian number for january, the first.
+       CALL ymds2ju (year,1,1,zero, julian0)
+       julian_diff = in_julian-julian0
+       ! real number of seconds
+!       sec = (julian_diff-REAL(INT(julian_diff)))*one_day
+       sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day)
+       month_len = ioget_mon_len (year,month)
+       IF ( printlev_loc >=4 ) THEN
+          write(numout,*) "2 in_julian, julian0, julian_diff=",in_julian, julian0, julian_diff
+          write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+       ENDIF
+    ELSE 
+!!$       in_julian = itau2date(istp-1, zero, dt)
+!!$       CALL ju2ymds (in_julian, year, month, day, sec)
+!!$       jur=zero
+!!$       julian_diff = in_julian
+!!$       month_len = ioget_mon_len (year,month)
+!!$       IF (printlev_loc >=4) THEN
+!!$          write(numout,*) "in_julian=",in_julian, jur, julian_diff
+!!$          write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+!!$       ENDIF
+!!$
+!!$
+!!$       CALL ymds2ju (year,1,1,zero, jur)
+!!$       julian_diff = in_julian-jur
+!!$       CALL ju2ymds (julian_diff, year, month, day, sec)
+!!$!       sec = (julian_diff-REAL(INT(julian_diff)))*one_day
+!!$       sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day)
+!!$       month_len = ioget_mon_len (year,month)
+!!$       IF (printlev_loc >=4) THEN
+!!$          write(numout,*) "2 in_julian, jur, julian_diff=",in_julian, jur, julian_diff
+!!$          write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+!!$       ENDIF
+
+!MM
+!PB date0 = celui de Soenke (Ã  tester avec un autre date0)
+!       in_julian = itau2date(istp, 153116., dt)
+       in_julian = itau2date(istp, date0, dt_sechiba)
+       CALL itau2ymds(istp, dt_sechiba, year, month, day, sec)
+       CALL ymds2ju (year,1,1,zero, julian0)
+       julian_diff = in_julian - julian0
+       month_len = ioget_mon_len (year,month)
+       IF (printlev_loc >=4) THEN
+          write(numout,*) "in_julian=",in_julian, julian0, julian_diff
+          write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+       ENDIF
+    ENDIF
+
+  END SUBROUTINE intsurf_time
+
+!! ================================================================================================================================
+!! SUBROUTINE   : intersurf_clear
+!!
+!>\BRIEF         Clear intersurf module and underlaying modules
+!!
+!! DESCRIPTION  :  Deallocate memory and reset initialization variables to there original values. 
+!!                 Call the clearing for sechiba module.
+!!
+!_ ================================================================================================================================
+  SUBROUTINE intersurf_clear
+    CALL sechiba_clear
+  END SUBROUTINE intersurf_clear
+
+END MODULE intersurf
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/ioipslctrl.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/ioipslctrl.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/ioipslctrl.f90	(revision 6412)
@@ -0,0 +1,4360 @@
+! ================================================================================================================================
+!  MODULE       : ioipslctrl
+!
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF          This module contains subroutine for initialisation of IOIPSL history files and restart files
+!!
+!!\n DESCRIPTION: This module contains subroutine for initialisation of IOIPSL history files and restart files. The subroutines
+!!                ioipslctrl_history, ioipslctrl_histstom, ioipslctrl_histstomipcc, ioipslctrl_restini where previously stored in
+!!                intersurf module. 
+!!
+!! RECENT CHANGE(S): 
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/trunk/ORCHIDEE/src_sechiba/ioipslctrl.f90 $
+!! $Date: 2015-02-19 18:42:48 +0100 (jeu. 19 fÃ©vr. 2015) $
+!! $Revision: 2548 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE ioipslctrl
+
+  USE IOIPSL
+  USE ioipsl_para 
+  USE defprec
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE grid 
+
+  IMPLICIT NONE
+
+
+  LOGICAL, SAVE                    :: ok_histsync             !! Flag activate syncronization of IOIPSL output
+  !$OMP THREADPRIVATE(ok_histsync)
+   REAL(r_std), SAVE               :: dw                      !! Frequency of history write (sec.)
+!$OMP THREADPRIVATE(dw)
+  INTEGER(i_std),PARAMETER         :: max_hist_level = 11     !! 
+
+  PRIVATE
+  PUBLIC :: ioipslctrl_history, ioipslctrl_histstom, ioipslctrl_histstomipcc, ioipslctrl_restini
+  PUBLIC :: dw, max_hist_level, ok_histsync
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE    : ioipslctrl_history
+!!
+!>\BRIEF	 This subroutine initialize the IOIPSL output files
+!! 
+!! DESCRIPTION   : This subroutine initialize the IOIPSL output files sechiab_history.nc and sechiba_out_2.nc. It also calls the
+!!                 the subroutines ioipslctrl_histstom and ioipslctrl_histstomipcc for initialization of the IOIPSL stomate output files.
+!!                 This subroutine was previously called intsurf_history and located in module intersurf.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE ioipslctrl_history(iim, jjm, lon, lat, kindex, kjpindex, istp_old, date0, dt, hist_id, hist2_id, &
+       hist_id_stom, hist_id_stom_IPCC)
+    
+    USE mod_orchidee_para
+    !   
+    !  This subroutine initialized the history files for the land-surface scheme
+    !
+    IMPLICIT NONE
+    
+    INTEGER(i_std), INTENT(in)                  :: iim, jjm  !! Size in x and y of the data to be handeled
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat  !! Longitude and latitude of the data points
+    INTEGER(i_std),INTENT (in)                            :: kjpindex
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: kindex
+    
+    INTEGER(i_std), INTENT(in)                  :: istp_old  !! Time step counter
+    REAL(r_std), INTENT(in)                     :: date0     !! Julian day at which istp=0
+    REAL(r_std), INTENT(in)                     :: dt        !! Time step of the counter in seconds
+
+    INTEGER(i_std), INTENT(out)                 :: hist_id   !! History file identification for SECHIBA
+    INTEGER(i_std), INTENT(out)                 :: hist2_id  !! History file 2 identification for SECHIBA
+    !! History file identification for STOMATE and IPCC
+    INTEGER(i_std), INTENT(out)                 :: hist_id_stom, hist_id_stom_IPCC 
+    !
+    !  LOCAL
+    !
+    CHARACTER(LEN=80) :: histname,histname2                    !! Name of history files for SECHIBA
+    CHARACTER(LEN=80) :: stom_histname, stom_ipcc_histname     !! Name of history files for STOMATE
+    LOGICAL           :: ok_histfile2                 !! Flag to switch on histfile 2 for SECHIBA
+    REAL(r_std)       :: dw2                          !! frequency of history write (sec.)
+    CHARACTER(LEN=30)   :: flux_op                    !! Operations to be performed on fluxes
+    CHARACTER(LEN=40)   :: flux_insec, flux_scinsec   !! Operation in seconds
+    INTEGER(i_std)     :: hist_level, hist2_level     !! history output level (default is 10 => maximum output)
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: &
+         & ave, avecels, avescatter, fluxop, &
+         & fluxop_scinsec, tmincels, tmaxcels, once, &
+         & tmax, sumscatter                          !! The various operation to be performed
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: &
+         & ave2, avecels2, avescatter2, fluxop2, &
+         & fluxop_scinsec2, tmincels2, tmaxcels2, once2, sumscatter2  !! The various operation to be performed
+    CHARACTER(LEN=80) :: global_attribute              !! for writing attributes in the output files
+    INTEGER(i_std)     :: i, jst,ilev
+    ! SECHIBA AXIS
+    INTEGER(i_std)     :: hori_id                      !! ID of the default horizontal longitude and latitude map.
+    INTEGER(i_std)     :: vegax_id, laiax_id, solax_id, soltax_id, nobioax_id !! ID's for two vertical coordinates
+    INTEGER(i_std)     :: soildiagax_id                !! ID for diagnostic soil levels
+    INTEGER(i_std)     :: solayax_id                   !! ID for the vertical axis of the CWRR hydrology 
+    INTEGER(i_std)     :: hori_id2                      !! ID of the default horizontal longitude and latitude map.
+    INTEGER(i_std)     :: vegax_id2, laiax_id2, solax_id2, soltax_id2, nobioax_id2, albax_id2 !! ID's for two vertical coordinates
+    INTEGER(i_std)     :: solayax_id2                   !! ID for the vertical axis of the CWRR hydrology 
+    INTEGER(i_std)     :: snowax_id                     !! ID for snow level axis
+
+    ! STOMATE AXIS
+    INTEGER(i_std)     :: hist_PFTaxis_id
+    INTEGER(i_std)     :: canx_tot_stom_id             !! ID for canopy levels
+    ! 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
+    INTEGER(i_std)     :: hist_pool_s_axis_id
+    INTEGER(i_std)     :: hist_pool_m_axis_id
+    INTEGER(i_std)     :: hist_pool_l_axis_id
+    INTEGER(i_std)     :: hist_pool_ss_axis_id
+    INTEGER(i_std)     :: hist_pool_mm_axis_id
+    INTEGER(i_std)     :: hist_pool_ll_axis_id
+    ! STOMATE IPCC AXIS
+    INTEGER(i_std)     :: hist_IPCC_PFTaxis_id
+    !
+    INTEGER(i_std)                         :: ier
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lon_rect, lat_rect
+    !
+    REAL(r_std),DIMENSION(nvm)   :: veg
+    REAL(r_std),DIMENSION(nlevels_tot+1)   :: indlai
+    REAL(r_std),DIMENSION(nstm)  :: soltyp
+    REAL(r_std),DIMENSION(nnobio):: nobiotyp
+    REAL(r_std),DIMENSION(2)     :: albtyp
+    REAL(r_std),DIMENSION(nslm)  :: solay
+    REAL(r_std),DIMENSION(nsnow) :: snowlev           !! Layers for snow axis
+    !
+    CHARACTER(LEN=80)           :: var_name           !! To store variables names
+    !
+    ! STOMATE history file
+    REAL(r_std)                  :: hist_days_stom     !!- GK time step in days for this history file
+    REAL(r_std)                  :: hist_dt_stom       !!- GK time step in seconds for this history file
+    REAL(r_std)                  :: dt_stomate_loc     !!  for test : time step of slow processes and STOMATE
+    REAL(r_std),DIMENSION(nvm)   :: hist_PFTaxis       !!- GK An axis we need for the history files
+! 
+    REAL(r_std),DIMENSION(10)    :: hist_pool_10axis     !! Deforestation axis
+    REAL(r_std),DIMENSION(100)   :: hist_pool_100axis     !! Deforestation axis
+    REAL(r_std),DIMENSION(11)    :: hist_pool_11axis     !! Deforestation axis
+    REAL(r_std),DIMENSION(101)   :: hist_pool_101axis     !! Deforestation axis
+! From the MERGE, maybe a cleaning in these deforestation axis would be a good
+! idea, do we need them all?- AL
+    REAL(r_std), DIMENSION(nshort)      :: hist_pool_s_axis   !!Deforestation axis
+    REAL(r_std), DIMENSION(nmedium)     :: hist_pool_m_axis   !!Deforestation axis
+    REAL(r_std), DIMENSION(nlong)       :: hist_pool_l_axis   !!Deforestation axis
+    REAL(r_std), DIMENSION(nshort+1)    :: hist_pool_ss_axis  !!Deforestation axis
+    REAL(r_std), DIMENSION(nmedium+1)   :: hist_pool_mm_axis  !!Deforestation axis
+    REAL(r_std), DIMENSION(nlong+1)     :: hist_pool_ll_axis  !!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
+!
+    REAL(r_std), DIMENSION(nlevels_tot)          :: z_levels_tot       !! Adummy array to label canopy levels
+
+    !
+    !=====================================================================
+    !- 3.0 Setting up the history files
+    !=====================================================================
+    !- 3.1 SECHIBA
+    !=====================================================================
+    !Config Key   = ALMA_OUTPUT
+    !Config Desc  = Should the output follow the ALMA convention
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = If this logical flag is set to true the model
+    !Config         will output all its data according to the ALMA 
+    !Config         convention. It is the recommended way to write
+    !Config         data out of ORCHIDEE.
+    !Config Units = [FLAG]
+    CALL getin_p('ALMA_OUTPUT', almaoutput)    
+    WRITE(numout,*) 'ALMA_OUTPUT', almaoutput
+    !-
+    !Config Key   = OUTPUT_FILE
+    !Config Desc  = Name of file in which the output is going to be written
+    !Config If    = OK_SECHIBA
+    !Config Def   = sechiba_history.nc
+    !Config Help  = This file is going to be created by the model
+    !Config         and will contain the output from the model.
+    !Config         This file is a truly COADS compliant netCDF file.
+    !Config         It will be generated by the hist software from
+    !Config         the IOIPSL package.
+    !Config Units = [FILE]
+    !-
+    histname='sechiba_history.nc'
+    CALL getin_p('OUTPUT_FILE', histname)
+    WRITE(numout,*) 'OUTPUT_FILE', histname
+    !-
+    !Config Key   = WRITE_STEP
+    !Config Desc  = Frequency in seconds for sechiba_history.nc file with IOIPSL
+    !Config If    = OK_SECHIBA, NOT XIOS_ORCHIDEE_OK
+    !Config Def   = one_day
+    !Config Help  = This variables gives the frequency in the output
+    !Config         file sechiba_history.nc if using IOIPSL.
+    !Config         This variable is not read if XIOS is activated.
+    !Config Units = [seconds]
+    !-
+    dw = one_day
+    IF (xios_orchidee_ok) THEN
+      dw=0
+      IF (printlev>=3) WRITE(numout,*) 'All IOIPSL output are deactivated because this run uses XIOS'
+    ELSE
+      CALL getin_p('WRITE_STEP', dw)
+      IF ( dw == 0 ) WRITE(numout,*) 'sechiba_history file will not be created'
+    END IF
+    !
+    veg(1:nvm)   = (/ (REAL(i,r_std),i=1,nvm) /)
+    indlai(1:nlevels_tot+1) = (/ (REAL(i,r_std),i=1,nlevels_tot+1) /)
+    soltyp(1:nstm) = (/ (REAL(i,r_std),i=1,nstm) /)
+    nobiotyp(1:nnobio) = (/ (REAL(i,r_std),i=1,nnobio) /)
+    albtyp(1:2) = (/ (REAL(i,r_std),i=1,2) /)
+    solay(1:nslm) = (/ (REAL(i,r_std),i=1,nslm) /)
+    snowlev =  (/ (REAL(i,r_std),i=1,nsnow) /)
+
+    !
+    !- We need to flux averaging operation as when the data is written
+    !- from within SECHIBA a scatter is needed. In the driver on the other
+    !- hand the data is 2D and can be written is it is.
+    !-
+    WRITE(flux_op,'("ave(scatter(X*",F8.1,"))")') one_day/dt
+    ! WRITE(flux_op,'("(ave(scatter(X))*",F8.1,")")') one_day/dt
+!    WRITE(flux_sc,'("ave(X*",F8.1,")")') one_day/dt
+!    WRITE(flux_insec,'("ave(X*",F8.6,")")') un/dt
+!    WRITE(flux_insec,'("ave(X*",F12.10,")")') un/dt
+    WRITE(flux_scinsec,'("ave(scatter(X*",F12.10,"))")') un/dt
+    WRITE(numout,*) 'flux_op=',flux_op,' one_day/dt=', one_day/dt, ' dt=',dt,' dw=', dw
+    !-
+    !Config Key   = SECHIBA_HISTLEVEL
+    !Config Desc  = SECHIBA history output level (0..10)
+    !Config If    = OK_SECHIBA and HF
+    !Config Def   = 5
+    !Config Help  = Chooses the list of variables in the history file. 
+    !Config         Values between 0: nothing is written; 10: everything is 
+    !Config         written are available More details can be found on the web under documentation.
+    !Config Units = [-]
+    !-
+    hist_level = 5
+    CALL getin_p('SECHIBA_HISTLEVEL', hist_level)
+    !-
+    WRITE(numout,*) 'SECHIBA history level: ',hist_level
+    IF ( (hist_level > max_hist_level).OR.(hist_level < 0) ) THEN
+       STOP 'This history level is not allowed'
+    ENDIF
+    !-
+    !- define operations as a function of history level.
+    !- Above hist_level, operation='never'
+    !-
+    ave(1:max_hist_level) = 'ave(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       ave(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    sumscatter(1:max_hist_level) = 't_sum(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       sumscatter(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+    avecels(1:max_hist_level) = 'ave(cels(scatter(X)))'
+    IF (hist_level < max_hist_level) THEN
+       avecels(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+    avescatter(1:max_hist_level) = 'ave(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       avescatter(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    tmincels(1:max_hist_level) = 't_min(cels(scatter(X)))'
+    IF (hist_level < max_hist_level) THEN
+       tmincels(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    tmaxcels(1:max_hist_level) = 't_max(cels(scatter(X)))'
+    IF (hist_level < max_hist_level) THEN
+       tmaxcels(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+    fluxop(1:max_hist_level) = flux_op
+    IF (hist_level < max_hist_level) THEN
+       fluxop(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+    fluxop_scinsec(1:max_hist_level) = flux_scinsec
+    IF (hist_level < max_hist_level) THEN
+       fluxop_scinsec(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    once(1:max_hist_level) = 'once(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       once(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    tmax(1:max_hist_level) = 't_max(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       tmax(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+
+    !- Initialize sechiba_history output file
+    !- 
+    IF ( dw == 0 ) THEN
+       ! sechiba_history file will not be created.
+       hist_id = -1
+
+    ELSE
+       ! sechiba_history file will be created
+       ! If running in parallel (mpi_size>1), test if there are at least 2 latitude bands(jj_nb) for current MPI 
+       ! process. The model can work with 1 latitude band but the rebuild
+       ! fails. Therefore exit if this is the case.  
+       IF ( jj_nb < 2 .AND. mpi_size > 1) THEN 
+          CALL ipslerr_p(3,"ioipslctrl_history", &
+             "The current MPI process has jj_nb=1 (1 band of latitude) but", & 
+             "the IOIPSL rebuild tool can not work if jj_nb is less than 2 per MPI process.", & 
+             "Change to a lower number of MPI processors or make the region bigger in latitudes.")
+       END IF
+
+       !- Calculation necessary for initialization of sechiba_history file
+       !- Check if we have by any change a rectilinear grid. This would allow us to 
+       !- simplify the output files.
+    IF (is_omp_root) THEN
+       !
+       IF ( GridType == "RegLonLat" ) THEN
+          ALLOCATE(lon_rect(iim),stat=ier)
+          IF (ier .NE. 0) THEN
+             WRITE (numout,*) ' error in lon_rect allocation. We stop. We need iim words = ',iim
+             STOP 'intersurf_history'
+          ENDIF
+          ALLOCATE(lat_rect(jjm),stat=ier)
+          IF (ier .NE. 0) THEN
+             WRITE (numout,*) ' error in lat_rect allocation. We stop. We need jjm words = ',jjm
+             STOP 'intersurf_history'
+          ENDIF
+          lon_rect(:) = lon(:,1)
+          lat_rect(:) = lat(1,:)
+       ENDIF
+       !-
+       !-
+       !-
+       ! Initialize sechiba_history file
+       IF ( .NOT. almaoutput ) THEN
+          !- 
+          IF ( GridType == "RegLonLat" ) THEN
+#ifdef CPP_PARA
+             CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id,orch_domain_id)
+#else
+             CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id)
+#endif
+             WRITE(numout,*)  'HISTBEG --->',istp_old,date0,dt,dw,hist_id
+          ELSE
+#ifdef CPP_PARA
+             CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id,domain_id=orch_domain_id)
+#else
+             CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id)
+#endif
+          ENDIF
+          !-
+          CALL histvert(hist_id, 'veget', 'Vegetation types', '1', &
+               &    nvm,   veg, vegax_id)
+          CALL histvert(hist_id, 'laiax', 'Nb LAI', '1', &
+               &    nlevels_tot+1,   indlai, laiax_id)
+          CALL histvert(hist_id, 'solth', 'Soil levels',      'm', &
+               &    ngrnd, znt, 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)
+          CALL histvert(hist_id, 'solay', 'Hydrol soil levels',      'm', &
+               &    nslm, diaglev(1:nslm), solayax_id)
+          CALL histvert(hist_id, 'soildiag', 'Diagnostic soil levels', 'm', &
+               &    nbdl, diaglev(1:nbdl), soildiagax_id)
+          CALL histvert(hist_id, 'snowlev', 'Snow levels',      'm', &
+               &    nsnow, snowlev, snowax_id)
+
+          !-
+          !- SECHIBA_HISTLEVEL = 1
+          !-
+          CALL histdef(hist_id, 'evap', 'Evaporation', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
+          CALL histdef(hist_id, 'coastalflow', 'Diffuse coastal flow', 'm^3/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'riverflow', 'River flow to the oceans', 'm^3/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw) 
+          CALL histdef(hist_id, 'temp_sol', 'Surface Temperature', 'C', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avecels(1), dt,dw)
+          CALL histdef(hist_id, 'rain', 'Rainfall', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
+          CALL histdef(hist_id, 'snowf', 'Snowfall', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
+          CALL histdef(hist_id, 'netrad', 'Net radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'lai', 'Leaf Area Index', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'LAImean', 'Leaf Area Index', '1', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'reinf_slope', 'Slope index for each grid box', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, once(1),  dt,dw)
+          CALL histdef(hist_id, 'soilindex', 'Soil index', '1', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, once(1),  dt,dw)
+          !
+          IF ( river_routing ) THEN
+             CALL histdef(hist_id, 'basinmap', 'Aproximate map of the river basins', ' ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw) 
+             CALL histdef(hist_id, 'nbrivers', 'Number or rivers in the outflow grid box', ' ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)  
+          ENDIF
+          !-
+          !- SECHIBA_HISTLEVEL = 2
+          !-
+          CALL histdef(hist_id, 'subli', 'Sublimation', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+          CALL histdef(hist_id, 'evapnu', 'Bare soil evaporation', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+          CALL histdef(hist_id, 'runoff', 'Surface runoff', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+          CALL histdef(hist_id, 'drainage', 'Deep drainage', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+          IF ( river_routing ) THEN
+             CALL histdef(hist_id, 'riversret', 'Return from endorheic rivers', 'mm/d', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+             CALL histdef(hist_id, 'hydrographs', 'Hydrographs of gridbox outflow', 'm^3/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(2), dt,dw)
+          ENDIF
+          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)
+
+          CALL histdef(hist_id, 'tair', 'Air Temperature', 'K',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'qair', 'Air humidity', 'g/g',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'q2m', '2m Air humidity', 'g/g',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 't2m', '2m Air Temperature', 'K',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'alb_vis', 'Albedo visible', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'alb_nir', 'Albedo near infrared', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'soilalb_vis', 'Soil Albedo visible', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'soilalb_nir', 'Soil Albedo near infrared', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'vegalb_vis', 'Vegetation Albedo visible', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'vegalb_nir', 'Vegetation Albedo near infrared', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'z0m', 'Surface roughness for momentum', 'm',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'z0h', 'Surface roughness for heat', '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)
+          CALL histdef(hist_id, 'transpir_supply', 'supply of water for transpiration', 'mm/dt', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(2), dt,dw)
+!!$          CALL histdef(hist_id, 'transpir_supply', 'virtuel supply of water for Transpiration', 'mm/dt', &
+!!$               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(2), dt,dw)
+
+          CALL histdef(hist_id, 'sinang', 'sinang', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'alb_vis_pft', 'alb_vis_pft', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'scatter', 'scatter', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+
+
+          !-
+          !- SECHIBA_HISTLEVEL = 3
+          !-
+          CALL histdef(hist_id, 'tsol_max', 'Maximum Surface Temperature',&
+               & 'C', iim,jjm, hori_id, 1,1,1, -99, 32, tmaxcels(3), dt,dw)
+          CALL histdef(hist_id, 'tsol_min', 'Minimum Surface Temperature',&
+               & 'C', iim,jjm, hori_id, 1,1,1, -99, 32, tmincels(3), dt,dw)
+          CALL histdef(hist_id, 'fluxsens', 'Sensible Heat Flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(3), dt,dw)
+          CALL histdef(hist_id, 'fluxlat', 'Latent Heat Flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(3), dt,dw)
+          CALL histdef(hist_id, 'snow', 'Snow mass', 'kg/m^2', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'snowage', 'Snow age', '?', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'snownobio', 'Snow on other surfaces', 'kg/m^2', &
+               & iim,jjm, hori_id, nnobio,1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'snownobioage', 'Snow age on other surfaces', 'd', &
+               & iim,jjm, hori_id, nnobio,1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'vegetfrac', 'Fraction of vegetation', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'tot_bare_soil', "Total Bare Soil Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'nobiofrac', 'Fraction of other surface types', '1', &
+               & iim,jjm, hori_id, nnobio, 1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
+          IF ( do_floodplains ) THEN
+             CALL histdef(hist_id, 'flood_frac', 'Flooded fraction', '1', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(3), dt,dw)
+             CALL histdef(hist_id, 'reinfiltration', 'Reinfiltration from floodplains', 'mm/d', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(3), dt,dw)
+          ENDIF
+
+          DO jst=1,nstm
+             
+             ! var_name= "mc_1" ... "mc_3"
+             WRITE (var_name,"('moistc_',i1)") jst
+             CALL histdef(hist_id, var_name, 'Soil Moisture profile for soil type', 'm3/m3', &
+                  & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(3),  dt,dw)
+             
+             ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+             WRITE (var_name,"('vegetsoil_',i1)") jst
+             CALL histdef(hist_id, var_name, 'Fraction of vegetation on soil types', '%', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3),  dt,dw)
+             
+             ! var_name= "kfact_root_1" ... "kfact_root_3"
+             WRITE (var_name,"('kfactroot_',i1)") jst
+             CALL histdef(hist_id, var_name, 'Root fraction profile for soil type', '%', &
+                  & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(3), dt,dw)
+             
+          ENDDO
+
+          IF (ok_freeze_cwrr) THEN
+             CALL histdef(hist_id, 'profil_froz_hydro', 'Frozen fraction for each hydrological soil layer', '-', &
+                  & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1),  dt,dw)
+             DO jst=1,nstm
+                WRITE (var_name,"('profil_froz_hydro_',i1)") jst
+                CALL histdef(hist_id, trim(var_name), 'Frozen fraction for each hydrological soil layer and soiltile', '-', &
+                     & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1),  dt,dw)
+             ENDDO
+             CALL histdef(hist_id, 'temp_hydro', 'Soil temperature interpolated on hydrological layers', 'K', &
+                  & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1), dt,dw)
+             CALL histdef(hist_id, 'kk_moy', 'Mean hydrological conductivity', 'mm/d', &
+                  & iim,jjm,hori_id, nslm,1,nslm, solayax_id, 32, avescatter(1),  dt,dw)
+          END IF
+             
+          CALL histdef(hist_id, 'ptn_beg', 'Soil temperature from previous time step', 'K', &
+               & iim,jjm,hori_id, ngrnd,1,ngrnd, solax_id, 32, avescatter(1),  dt,dw)
+          
+          IF ( ok_freeze_thermix ) THEN
+             CALL histdef(hist_id, 'pcappa_supp', 'Additional heat capacity due to soil freezing for each soil layer', 'J/K', &
+                  iim,jjm,hori_id, ngrnd,1,ngrnd, solax_id, 32, avescatter(1),  dt,dw)
+          END IF
+          
+          CALL histdef(hist_id, 'shum_ngrnd_perma', 'Saturation degree on the thermal axes', '-', &
+               & iim,jjm,hori_id,ngrnd,1,ngrnd, solax_id, 32, avescatter(1),  dt,dw)
+          CALL histdef(hist_id, 'shumdiag_perma', 'Saturation degree of the soil', '-', &
+               & iim,jjm,hori_id,nbdl,1,nbdl, soildiagax_id, 32, avescatter(1),  dt,dw)
+          !
+          CALL histdef(hist_id, 'frac_bare', 'Bare soil fraction for each tile', '-', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'soiltile', 'Fraction of soil tiles', '%', &
+               & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, once(3),  dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 4
+          !-
+          CALL histdef(hist_id, 'humtot', 'Total Soil Moisture', 'Kg/m^2', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
+          CALL histdef(hist_id, 'humtot_soil', 'Soil Moisture for soil type', 'Kg/m^2', &
+               & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, avescatter(4), dt,dw)
+          CALL histdef(hist_id, 'njsc', 'Soil class used for hydrology', '-', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, once(4), dt,dw)
+          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)
+          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)
+          IF ( ok_c13 ) THEN
+              CALL histdef(hist_id, 'delta_c13_assim', 'C13 conc. in delta not.', 'per mil', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, sumscatter(4), dt,dw)
+              CALL histdef(hist_id, 'leaf_ci_out', 'Ci', 'ppm', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
+              CALL histdef(hist_id, 'c13_daily', ' accumul. C13 conc. in delta not.', 'per mil', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
+              CALL histdef(hist_id, 'gpp_day', 'counting gpp', 'time step', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)    
+          ENDIF
+
+
+
+          IF ( ok_stomate ) THEN
+             CALL histdef(hist_id, 'nee', 'Net Ecosystem Exchange', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt, dw)
+             CALL histdef(hist_id, 'lab_fac', 'Labile Fraction', 'unitless', &   
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt, dw)
+          ENDIF
+          CALL histdef(hist_id, 'precisol', 'Throughfall', 'mm/d',  &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(4), dt,dw)
+          CALL histdef(hist_id, 'drysoil_frac', 'Fraction of visibly dry soil', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(4), dt,dw)
+          CALL histdef(hist_id, 'evapot', 'Potential evaporation', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(4), dt,dw)
+          CALL histdef(hist_id, 'evapot_corr', 'Potential evaporation', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(4), dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 5
+          !-
+          CALL histdef(hist_id, 'swnet', 'Net solar radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(5), dt,dw)
+          CALL histdef(hist_id, 'swdown', 'Incident solar radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(5), dt,dw)
+          CALL histdef(hist_id, 'lwdown', 'Absorbed downward longwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
+          CALL histdef(hist_id, 'lwnet', 'Net surface longwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 6
+          !-
+          CALL histdef(hist_id, 'ptn', 'Deep ground temperature', 'K', &
+               & iim,jjm, hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(6),  dt,dw)
+          CALL histdef(hist_id, 'snowmelt', 'snow melt', 'kg/m2', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(6), dt,dw)
+          CALL histdef(hist_id, 'frac_snow_veg', 'snow fraction on vegeted area','-', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(6), dt,dw)
+          CALL histdef(hist_id, 'frac_snow_nobio', 'snow fraction on non-vegeted area', '-', &
+               & iim,jjm, hori_id, nnobio, 1,nnobio, nobioax_id, 32, avescatter(6), dt,dw)
+          CALL histdef(hist_id, 'pgflux', 'extra energy used for melting top snow layer', '-', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(6), dt,dw)
+
+          CALL histdef(hist_id, 'grndflux', 'ground heat flux', 'W/m2', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(6), dt,dw)
+          CALL histdef(hist_id, 'sfcfrz', 'surface frozen fraction', '-', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(6), dt,dw)
+          CALL histdef(hist_id, 'snowrho', 'Snow density profile', 'kg/m3', & 
+               & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6), dt,dw)
+          CALL histdef(hist_id, 'snowtemp','Snow temperature profile','K', &
+               & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6),dt,dw)
+          CALL histdef(hist_id, 'snowdz','Snow depth profile','m', &
+               & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6),dt,dw)
+          CALL histdef(hist_id, 'snowliq','Snow liquid content profile','m', &
+               & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6),dt,dw)
+          CALL histdef(hist_id, 'snowgrain','Snow grain profile','m', &
+               & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6),dt,dw)
+          CALL histdef(hist_id, 'snowheat','Snow Heat profile','J/m2', &
+               & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6),dt,dw)
+          CALL histdef(hist_id, 'radsink','Solar Radiation profile','W/m2', &
+               & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6),dt,dw)
+
+          CALL histdef(hist_id, 'Qg', 'Ground heat flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+
+          IF (ok_freeze_thermix) THEN
+             CALL histdef(hist_id, 'profil_froz', 'Frozen fraction of the soil', '-', &
+                  & iim,jjm, hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(6),  dt,dw)
+          END IF
+          CALL histdef(hist_id, 'pkappa', 'Soil thermal conductivity', 'W/m/K', &
+               & iim,jjm,hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(1),  dt,dw)
+          CALL histdef(hist_id, 'pcapa', 'Apparent heat capacity', 'J/m3/K', &
+               & iim,jjm,hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(1),  dt,dw)
+
+          !-
+          !- SECHIBA_HISTLEVEL = 7
+          !-
+          IF ( river_routing ) THEN
+             CALL histdef(hist_id, 'fastr', 'Fast flow reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
+             CALL histdef(hist_id, 'slowr', 'Slow flow reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
+             CALL histdef(hist_id, 'streamr', 'Stream flow reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
+             CALL histdef(hist_id, 'lakevol', 'Volume in lake reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
+             
+             !-
+             !- SECHIBA_HISTLEVEL = 8
+             !-
+             CALL histdef(hist_id, 'pondr', 'Ponds reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+             CALL histdef(hist_id, 'swampmap', 'Map of swamps', 'm^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(8), dt,dw)
+             !
+             IF ( do_irrigation ) THEN
+                CALL histdef(hist_id, 'irrigation', 'Net irrigation', 'mm/d', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(8), dt,dw)
+                CALL histdef(hist_id, 'netirrig', 'Net irrigation requirement', 'mm/d', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(8), dt,dw)
+                CALL histdef(hist_id, 'irrigmap', 'Map of irrigated surfaces', 'm^2', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, once(8), dt,dw)
+             ENDIF
+             IF ( do_floodplains ) THEN
+                CALL histdef(hist_id, 'floodmap', 'Map of floodplains', 'm^2', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, once(8), dt,dw)
+                CALL histdef(hist_id, 'floodh', 'Floodplains height', 'mm', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+                CALL histdef(hist_id, 'floodr', 'Floodplains reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+                CALL histdef(hist_id, 'floodout', 'Flow out of floodplains', 'mm/d', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(8), dt,dw)
+                CALL histdef(hist_id, 'evapflo', 'Floodplains evaporation', 'mm/d', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(8), dt,dw)
+             ENDIF
+             !
+          ENDIF
+
+          CALL histdef(hist_id, 'k_litt', 'Litter cond', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+
+          CALL histdef(hist_id, 'beta', 'Beta Function', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'raero', 'Aerodynamic resistance', 's/m',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'cdrag', 'Drag coefficient for LE and SH', '?',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'Wind', 'Wind speed', 'm/s',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'qsatt' , 'Surface saturated humidity', 'g/g', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'vbeta1', 'Beta for sublimation', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'vbeta4', 'Beta for bare soil', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'vbeta5', 'Beta for floodplains', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'gsmean', 'mean stomatal conductance', 'mol/m2/s', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'humrel', 'Soil moisture stress', '-',  &
+               & iim,jjm, hori_id, nvm,1,nvm, vegax_id, 32, avescatter(8), dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 9
+          !-
+          !-
+          !- SECHIBA_HISTLEVEL = 10
+          !-
+          CALL histdef(hist_id, 'cimean', 'Stomatal CO2 concentation', 'mmole/m2/s', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'cim', 'cim', 'ppm', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'leafci', 'leaf ci', 'ppm', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'gs', 'gs', 'mol m-2 s-1', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'assimi', 'assimi', 'mol m-2 s-1', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'Rd', 'Rd', 'mol m-2 s-1', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'Cc', 'Cc', 'ppm', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'limitphoto', 'limitphoto', '-', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'Vc', 'Vc', 'mol m-2 s-1', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'Vj', 'Vj', 'mol e- m-2 s-1', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'gm', 'gm', 'mol m-2 s-1', & 
+               & iim, jjm, hori_id, 1, 1, 1, -99, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'gammastar', 'gammastar', 'ppm', & 
+               & iim, jjm, hori_id, 1, 1, 1, -99, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'Kmo', 'Kmo', 'ppm', & 
+               & iim, jjm, hori_id, 1, 1, 1, -99, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'Kmc', 'Kmc', 'ppm', & 
+               & iim, jjm, hori_id, 1, 1, 1, -99, 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,'vbeta2','Beta for Interception loss','mm/d', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'qsintmax', 'Maximum Interception capacity', 'Kg/m^2', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+
+          !- SECHIBA_HISTLEVEL = 11
+          !-
+
+          CALL histdef(hist_id, 'mrsos', "Moisture in Upper 0.1 m of Soil Column", "kg m-2", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'mrso', "Total Soil Moisture Content", "kg m-2", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'mrros', "Surface Runoff", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+          
+          CALL histdef(hist_id, 'mrro', "Total Runoff", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+
+          CALL histdef(hist_id, 'prveg', "Precipitation onto Canopy", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+
+
+          CALL histdef(hist_id, 'evspsblveg', "Evaporation from Canopy", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+          
+          CALL histdef(hist_id, 'evspsblsoi', "Water Evaporation from Soil", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+          
+          CALL histdef(hist_id, 'tran', "Transpiration", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+          
+          CALL histdef(hist_id, 'treeFrac', "Tree Cover Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'grassFrac', "Natural Grass Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'cropFrac', "Crop Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'baresoilFrac', "Bare Soil Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'residualFrac', &
+               & "Fraction of Grid Cell that is Land but Neither Vegetation-Covered nor Bare Soil", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          IF ( ok_bvoc ) THEN
+             CALL histdef(hist_id, 'PAR', 'PAR', 'umol phot/m^2/s',  &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+             IF ( ok_radcanopy ) THEN
+                CALL histdef(hist_id, 'PARsun', 'Sunlit Leaf PAR', 'umol phot/m^2/s', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'PARsh', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'laisun', 'Sunlit Leaf Area Index', '1', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'laish', 'Shaded Leaf Area Index', '1', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'Fdf', 'Fdf', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                IF ( ok_multilayer ) then 
+                   CALL histdef(hist_id, 'PARsuntab', 'Sunlit Leaf PAR', 'umol phot/m^2/s', &
+                        & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(11), dt,dw)
+                   CALL histdef(hist_id, 'PARshtab', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                        & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(11), dt,dw)
+                ENDIF
+                CALL histdef(hist_id, 'coszang', 'coszang', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'PARdf', 'PARdf', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'PARdr', 'PARdr', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'Trans', 'Trans', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+             END IF
+             
+             CALL histdef(hist_id, 'flx_fertil_no', 'flx_fertil_no', 'ngN/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'CRF', 'CRF', '1', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_co2_bbg_year', 'flx_co2_bbg_year', 'kgC/m^2/yr ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(11), dt,dw)  
+             CALL histdef(hist_id, 'N_qt_WRICE_year', 'N_qt_WRICE_year', 'kgN/yr ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(11), dt,dw)  
+             CALL histdef(hist_id, 'N_qt_OTHER_year', 'N_qt_OTHER_year', 'kgN/yr ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(11), dt,dw)  
+             CALL histdef(hist_id, 'flx_iso', 'flx_iso', 'kgC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_mono', 'flx_mono', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_apinen', 'flx_apinen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_bpinen', 'flx_bpinen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_limonen', 'flx_limonen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_myrcen', 'flx_myrcen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_sabinen', 'flx_sabinen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_camphen', 'flx_camphen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_3caren', 'flx_3caren', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_tbocimen', 'flx_tbocimen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_othermono', 'flx_othermono', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_sesquiter', 'flx_sesquiter', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_ORVOC', 'flx_ORVOC', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_MBO', 'flx_MBO', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_methanol', 'flx_methanol', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_acetone', 'flx_acetone', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_acetal', 'flx_acetal', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_formal', 'flx_formal', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_acetic', 'flx_acetic', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_formic', 'flx_formic', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_no_soil', 'flx_no_soil', 'ngN/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_no', 'flx_no', 'ngN/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'fco2', 'fco2', '-', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          ENDIF
+
+       ELSE 
+          !-
+          !- This is the ALMA convention output now
+          !-
+          !- 
+          IF ( GridType == "RegLonLat" ) 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, 'laiax', 'Nb LAI', 'm', & 
+               &   nlevels_tot+1, indlai, laiax_id)
+          CALL histvert(hist_id, 'solth', 'Soil levels',      'm', &
+               &    ngrnd, znt, 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)
+          CALL histvert(hist_id, 'solay', 'Hydrol soil levels',      'm', &
+               &    nslm, diaglev(1:nslm), solayax_id)
+          !-
+          !-  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)
+          CALL histdef(hist_id, 'lai', 'Leaf Area Index', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(1), dt,dw)
+          !-
+          !- Forcing variables
+          !-
+          CALL histdef(hist_id, 'SinAng', 'Net shortwave radiation', '-',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(9), dt,dw)
+          CALL histdef(hist_id, 'LWdown', 'Downward longwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(9), dt,dw)
+          CALL histdef(hist_id, 'SWdown', 'Downward shortwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(9), dt,dw)
+          CALL histdef(hist_id, 'Tair', 'Near surface air temperature at forcing level', 'K',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'Qair', 'Near surface specific humidity at forcing level', 'g/g',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'SurfP', 'Surface Pressure', 'hPa',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(9), dt,dw)
+          CALL histdef(hist_id, 'Windu', 'Eastward wind', 'm/s',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(9), dt,dw)
+          CALL histdef(hist_id, 'Windv', 'Northward wind', 'm/s',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(9), 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, avescatter(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, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'Qle', 'Latent heat flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(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, '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, 'Qrec', 'Recharge', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'Qsm', 'Snowmelt', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'DelSoilMoist', 'Change in soil moisture', 'kg/m^2',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
+          CALL histdef(hist_id, 'DelSurfStor', 'Change in Surface Water Storage','kg/m^2',&
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
+          CALL histdef(hist_id, 'DelIntercept', 'Change in interception storage', 'kg/m^2',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
+          CALL histdef(hist_id, 'DelSWE', 'Change in Snow Water Equivalent', 'kg/m^2',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
+          IF ( do_irrigation ) THEN
+             CALL histdef(hist_id, 'Qirrig', 'Irrigation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'Qirrig_req', 'Irrigation requirement', 'kg/m^2/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          ENDIF
+          !-
+          !- Surface state
+          !-
+          CALL histdef(hist_id, 'AvgSurfT', 'Average surface temperature', 'K', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'PotSurfT', 'Potential (Unstressed) surface temperature', 'K', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'RadT', 'Surface radiative temperature', 'K', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(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, 'SurfStor', 'Surface Water Storage','kg/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SWE', 'Snow Water Equivalent', 'kg/m^2', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'InterceptVeg', 'Intercepted Water on Canopy', 'Kg/m^2', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(1), dt,dw)
+          !!-
+          !-  Sub-surface state
+          !- 
+          CALL histdef(hist_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2',  &
+               & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1), dt,dw)
+
+          IF (ok_freeze_cwrr) THEN
+             CALL histdef(hist_id, 'profil_froz_hydro', 'Frozen fraction for each hydrological soil layer', '-', &
+                  & iim,jjm, hori_id, nslm, 1, nslm,solayax_id, 32, avescatter(1),  dt,dw)
+             DO jst=1,nstm
+                WRITE (var_name,"('profil_froz_hydro_',i1)") jst
+                CALL histdef(hist_id, trim(var_name), 'Frozen fraction for each hydrological soil layer and soiltile', '-', &
+                     & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1),  dt,dw)
+             ENDDO
+             
+             CALL histdef(hist_id, 'temp_hydro', 'Soil temperature interpolated on hydrological layers', 'K', &
+                  & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1), dt,dw)
+             CALL histdef(hist_id, 'kk_moy', 'Mean hydrological conductivity', 'mm/d', &
+                  & iim,jjm,hori_id, nslm,1,nslm, solayax_id, 32, avescatter(1),  dt,dw)
+          ENDIF
+          CALL histdef(hist_id, 'SoilWet', 'Total soil wetness', '-',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SoilTemp', 'Soil temperature profile', 'K', &
+               & iim,jjm, hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(1),  dt,dw)
+          !- 
+          !-  Evaporation components
+          !-
+          CALL histdef(hist_id, 'PotEvap', 'Potential evapotranspiration', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'PotEvapOld', 'Potential evapotranspiration old method', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'ECanop', 'Interception evaporation', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'TVeg', 'Transpiration', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'ESoil', 'Bare soil evaporation', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'EWater', 'Open water evaporation', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'RootMoist','Root zone soil water', 'kg/m^2',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SubSnow','Snow sublimation','kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'ACond', 'Aerodynamic conductance', 'm/s',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          IF ( do_floodplains ) THEN
+             CALL histdef(hist_id, 'Qflood', 'Floodplain Evaporation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          ENDIF
+          !-
+          !- Surface turbulence
+          !-
+          CALL histdef(hist_id, 'Z0m', 'Roughness height for momentum', 'm',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'Z0h', 'Roughness height for heat', 'm',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'EffectHeight', 'Effective displacement height (h-d)', 'm',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          !-
+          !-
+          !-  Cold Season Processes
+          !-
+          CALL histdef(hist_id, 'SnowFrac', 'Snow cover fraction', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SAlbedo', 'Snow albedo', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          !-
+          !- Hydrologic variables
+          !-
+          IF ( river_routing ) THEN
+             CALL histdef(hist_id, 'slowr', 'Slow flow reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+             CALL histdef(hist_id, 'fastr', 'Fast flow reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+             CALL histdef(hist_id, 'streamr', 'Stream flow reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+             CALL histdef(hist_id, 'lakevol', 'Volume in lake reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+             CALL histdef(hist_id, 'pondr', 'Ponds reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+             !-
+             !-
+             !-
+             CALL histdef(hist_id, 'SwampMap', 'Map of swamp areas', 'm^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
+             CALL histdef(hist_id, 'Dis', 'Simulated River Discharge', 'm^3/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(2), dt,dw)
+             CALL histdef(hist_id, 'CoastalFlow', 'Diffuse coastal flow', 'm^3/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(2), 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(2), dt,dw)
+             IF ( do_irrigation ) THEN
+                CALL histdef(hist_id, 'IrrigationMap', 'Map of irrigated areas', 'm^2', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
+             ENDIF
+             !
+             !
+             IF ( do_floodplains ) THEN
+                CALL histdef(hist_id, 'FloodplainsMap', 'Map of flooded areas', 'm^2', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
+                CALL histdef(hist_id, 'FloodFrac', 'Floodplain Fraction', '-', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+             ENDIF
+          ENDIF
+          !-
+          CALL histdef(hist_id, 'humrel', 'Soil moisture stress', '-',  &
+               & iim,jjm, hori_id, nvm,1,nvm, vegax_id, 32, avescatter(8), dt,dw)
+          !-
+          !-  The carbon budget
+          !-
+          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, '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)
+          CALL histdef(hist_id, 'gsmean', 'mean stomatal conductance', 'mol/m2/s', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'cim', 'cim', 'ppm', & 
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'leafci', 'leaf Ci', 'ppm', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'gs', 'gs', 'mol m-2 s-1', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'assimi', 'assimi', 'mol m-2 s-1', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'Rd', 'Rd', 'mol m-2 s-1', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'Cc', 'Cc', 'ppm', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'limitphoto', 'limitphoto', '-', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'Vc', 'Vc', 'mol m-2 s-1', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'Vj', 'Vj', 'mol e- m-2 s-1', & 
+               & iim,jjm, hori_id, nlevels_tot+1, 1, nlevels_tot+1, laiax_id, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'gm', 'gm', 'mol m-2 s-1', & 
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'gammastar', 'gammastar', 'ppm', & 
+               & iim, jjm, hori_id, 1, 1, 1, -99, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'Kmo', 'Kmo', 'ppm', & 
+               & iim, jjm, hori_id, 1, 1, 1, -99, 32, avescatter(10), dt,dw) 
+          CALL histdef(hist_id, 'Kmc', 'Kmc', 'ppm', & 
+               & iim, jjm, hori_id, 1, 1, 1, -99, 32, avescatter(10), dt,dw)
+          IF ( ok_stomate ) THEN
+             CALL histdef(hist_id, 'NEE', 'Net Ecosystem Exchange', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+          ENDIF
+          !
+      ENDIF
+       !-
+       !- Forcing and grid information
+       !-
+       CALL histdef(hist_id, 'LandPoints', 'Land Points', '1', &
+            & iim,jjm, hori_id, 1,1,1, -99, 32, once(10), dt,dw)  
+       CALL histdef(hist_id, 'Areas', 'Mesh areas', 'm2', &
+            & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt, dw)
+       CALL histdef(hist_id, 'Contfrac', 'Continental fraction', '1', &
+            & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt, dw)
+       !-
+       ! Write the names of the pfts in the history files
+       global_attribute="PFT_name"
+       DO i=1,nvm
+          WRITE(global_attribute(9:10),"(I2.2)") i
+          CALL histglobal_attr(hist_id, global_attribute, PFT_name(i))
+       ENDDO
+       !-
+       CALL histend(hist_id)
+    ENDIF ! IF (is_omp_root)
+ 
+    END IF !IF ( dw == 0 )
+    !
+    !
+    ! Second SECHIBA hist file
+    !
+    !-
+    !Config Key   = SECHIBA_HISTFILE2
+    !Config Desc  = Flag to switch on histfile 2 for SECHIBA (hi-frequency ?)
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = This Flag switch on the second SECHIBA writing for hi (or low) 
+    !Config         frequency writing. This second output is optional and not written
+    !Config         by default.
+    !Config Units = [FLAG]
+    !-
+    ok_histfile2=.FALSE.
+    CALL getin_p('SECHIBA_HISTFILE2', ok_histfile2)
+    WRITE(numout,*) 'SECHIBA_HISTFILE2 ', ok_histfile2
+    !
+    !-
+    !Config Key   = WRITE_STEP2
+    !Config Desc  = Frequency in seconds at which to WRITE output
+    !Config If    = SECHIBA_HISTFILE2
+    !Config Def   = 1800.0
+    !Config Help  = This variables gives the frequency the output 2 of
+    !Config         the model should be written into the netCDF file.
+    !Config         It does not affect the frequency at which the
+    !Config         operations such as averaging are done.
+    !Config         That is IF the coding of the calls to histdef
+    !Config         are correct !
+    !Config Units = [seconds]
+    !-
+    dw2 = 1800.0
+    CALL getin_p('WRITE_STEP2', dw2)
+    
+    ! Deactivate sechiba_histfile2 if the frequency is set to zero
+    IF ( dw2 == 0 ) THEN
+       ok_histfile2=.FALSE.
+       WRITE(numout,*) 'WRITE_STEP2 was set to zero and therfore SECHIBA_HISTFILE2 is deactivated.'
+    ELSE IF ( hist_id < 0 ) THEN
+       ! Deactivate all history files if sechiba_history file is deactivated
+       ok_histfile2=.FALSE.
+       WRITE(numout,*) 'SECHIBA_HISTFILE2 will not be created because sechiba_history file is deactivated.'
+    END IF
+
+    hist2_id = -1
+    !
+    IF (ok_histfile2) THEN
+       !-
+       !Config Key   = SECHIBA_OUTPUT_FILE2
+       !Config Desc  = Name of file in which the output number 2 is going to be written
+       !Config If    = SECHIBA_HISTFILE2
+       !Config Def   = sechiba_out_2.nc
+       !Config Help  = This file is going to be created by the model
+       !Config         and will contain the output 2 from the model.
+       !Config Units = [FILE]
+       !-
+       histname2='sechiba_out_2.nc'
+       CALL getin_p('SECHIBA_OUTPUT_FILE2', histname2)
+       WRITE(numout,*) 'SECHIBA_OUTPUT_FILE2 ', histname2
+       !-
+       !Config Key   = SECHIBA_HISTLEVEL2
+       !Config Desc  = SECHIBA history 2 output level (0..10)
+       !Config If    = SECHIBA_HISTFILE2
+       !Config Def   = 1
+       !Config Help  = Chooses the list of variables in the history file. 
+       !Config         Values between 0: nothing is written; 10: everything is 
+       !Config         written are available More details can be found on the web under documentation.
+       !Config         web under documentation.
+       !Config         First level contains all ORCHIDEE outputs.
+       !Config Units = [-] 
+       !-
+       hist2_level = 1
+       CALL getin_p('SECHIBA_HISTLEVEL2', hist2_level)
+       !-
+       WRITE(numout,*) 'SECHIBA history level 2 : ',hist2_level
+       IF ( (hist2_level > max_hist_level).OR.(hist2_level < 0) ) THEN
+          STOP 'This history level 2 is not allowed'
+       ENDIF
+       !
+       !-
+       !- define operations as a function of history level.
+       !- Above hist2_level, operation='never'
+       !-
+       ave2(1:max_hist_level) = 'ave(scatter(X))'
+       IF (hist2_level < max_hist_level) THEN
+          ave2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       sumscatter2(1:max_hist_level) = 't_sum(scatter(X))'
+       IF (hist2_level < max_hist_level) THEN
+          sumscatter2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       avecels2(1:max_hist_level) = 'ave(cels(scatter(X)))'
+       IF (hist2_level < max_hist_level) THEN
+          avecels2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       avescatter2(1:max_hist_level) = 'ave(scatter(X))'
+       IF (hist2_level < max_hist_level) THEN
+          avescatter2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       tmincels2(1:max_hist_level) = 't_min(cels(scatter(X)))'
+       IF (hist2_level < max_hist_level) THEN
+          tmincels2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       tmaxcels2(1:max_hist_level) = 't_max(cels(scatter(X)))'
+       IF (hist2_level < max_hist_level) THEN
+          tmaxcels2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       fluxop2(1:max_hist_level) = flux_op
+       IF (hist2_level < max_hist_level) THEN
+          fluxop2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       fluxop_scinsec2(1:max_hist_level) = flux_scinsec
+       IF (hist2_level < max_hist_level) THEN
+          fluxop_scinsec2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       once2(1:max_hist_level) = 'once(scatter(X))'
+       IF (hist2_level < max_hist_level) THEN
+          once2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       ! 
+       IF (is_omp_root) THEN
+          IF ( .NOT. almaoutput ) THEN
+             !- 
+             IF ( GridType == "RegLonLat" ) THEN
+#ifdef CPP_PARA
+                CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id,orch_domain_id)
+#else
+                CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id)
+#endif
+                WRITE(numout,*)  'HISTBEG2 --->',istp_old,date0,dt,dw2,hist2_id
+             ELSE
+#ifdef CPP_PARA
+                CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id,domain_id=orch_domain_id)
+#else
+                CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id)
+#endif
+             ENDIF
+             !-
+             CALL histvert(hist2_id, 'veget', 'Vegetation types', '1', &
+                  &    nvm,   veg, vegax_id2)
+             CALL histvert(hist2_id, 'laiax', 'Nb LAI', '1', &
+                  &    nlevels_tot+1,   indlai, laiax_id2)
+             CALL histvert(hist2_id, 'solth', 'Soil levels',      'm', &
+                  &    ngrnd, znt, 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)
+             CALL histvert(hist2_id, 'solay', 'Hydrol soil levels',      'm', &
+                  &    nslm, solay, solayax_id2)
+
+             !-
+             !- SECHIBA_HISTLEVEL2 = 1
+             !-
+             CALL histdef(hist2_id, 'ptn', 'Deep ground temperature', 'K', &
+                  & iim,jjm, hori_id2, ngrnd, 1, ngrnd, solax_id2, 32, avescatter2(2),  dt, dw2)  
+
+             CALL histdef(hist2_id, 'mrsos', "Moisture in Upper 0.1 m of Soil Column", "kg m-2", &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(2), dt,dw2)            
+
+             CALL histdef(hist2_id, 'mrso', "Total Soil Moisture Content", "kg m-2", &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(11), dt,dw2)
+             
+             CALL histdef(hist2_id, 'mrros', "Surface Runoff", "kg m-2 s-1", &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(11), dt,dw2)
+
+             CALL histdef(hist2_id, 'mrro', "Total Runoff", "kg m-2 s-1", &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(2), dt,dw2)      
+
+             !-
+             !- SECHIBA_HISTLEVEL2 = 2
+             !-
+             CALL histdef(hist2_id, 'cdrag', 'Drag coefficient for LE and SH', '?',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt, dw2)
+             CALL histdef(hist2_id, 'soilalb_vis', 'Soil Albedo visible', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+             CALL histdef(hist2_id, 'soilalb_nir', 'Soil Albedo near infrared', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+             CALL histdef(hist2_id, 'vegalb_vis', 'Vegetation Albedo visible', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+             CALL histdef(hist2_id, 'vegalb_nir', 'Vegetation Albedo near infrared', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+             CALL histdef(hist2_id, 'z0m', 'Surface roughness for momentum', 'm',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt, dw2)
+             CALL histdef(hist2_id, 'z0h', 'Surface roughness for heat', 'm',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt, dw2)
+             CALL histdef(hist2_id, 'coastalflow', 'Diffuse coastal flow', 'm^3/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(2), dt, dw2)
+             CALL histdef(hist2_id, 'riverflow', 'River flow to the oceans', 'm^3/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(2), dt, dw2) 
+             CALL histdef(hist2_id, 'tsol_rad', 'Radiative surface temperature', 'C', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avecels2(2), dt, dw2)
+             IF ( do_floodplains ) THEN
+                CALL histdef(hist2_id, 'floodout', 'Flow out of floodplains', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt,dw2)
+                CALL histdef(hist2_id, 'vevapflo', 'Floodplains evaporation', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt, dw2)
+                CALL histdef(hist2_id, 'flood_frac', 'Flooded fraction', '1', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+                CALL histdef(hist2_id, 'reinfiltration', 'Reinfiltration from floodplains', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt,dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'vevapnu', 'Bare soil evaporation', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt, dw2)
+             CALL histdef(hist2_id, 'temp_sol', 'New Surface Temperature', 'C', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avecels2(2), dt, dw2)
+             CALL histdef(hist2_id, 'qsurf', 'Near surface specific humidity', 'g/g',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
+             CALL histdef(hist2_id, 'albedo', 'Albedo', '1', &
+                  & iim,jjm, hori_id2, 2,1,2, albax_id2, 32, avescatter2(2), dt, dw2)
+             CALL histdef(hist2_id, 'fluxsens', 'Sensible Heat Flux', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
+             CALL histdef(hist2_id, 'fluxlat', 'Latent Heat Flux', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
+             CALL histdef(hist2_id, 'emis', 'Surface emissivity', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
+             CALL histdef(hist2_id, 'transpir_supply', 'supply of water for transpiration', 'mm/dt', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(2), dt,dw)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 3
+             !-
+             CALL histdef(hist2_id, 'evap', 'Evaporation', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
+             CALL histdef(hist2_id, 'rain', 'Rainfall', 'mm/d',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
+             CALL histdef(hist2_id, 'snowf', 'Snowfall', 'mm/d',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
+             CALL histdef(hist2_id, 'netrad', 'Net radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(3), dt, dw2)
+             CALL histdef(hist2_id, 'lai', 'Leaf Area Index', '1', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(3), dt, dw2)
+             IF ( river_routing ) THEN
+                CALL histdef(hist2_id, 'basinmap', 'Aproximate map of the river basins', ' ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(3), dt, dw2) 
+                CALL histdef(hist2_id, 'nbrivers', 'Number or rivers in the outflow grid box', ' ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(3), dt, dw2)  
+             ENDIF
+
+             !-
+             !- SECHIBA_HISTLEVEL2 = 4
+             !-
+             CALL histdef(hist2_id, 'subli', 'Sublimation', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
+             CALL histdef(hist2_id, 'runoff', 'Surface runoff', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
+             CALL histdef(hist2_id, 'drainage', 'Deep drainage', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
+             IF ( river_routing ) THEN
+                CALL histdef(hist2_id, 'riversret', 'Return from endorheic rivers', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
+                CALL histdef(hist2_id, 'hydrographs', 'Hydrographs of gridbox outflow', 'm^3/s', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(4), dt, dw2)
+             ENDIF
+
+             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)
+
+             !
+             CALL histdef(hist2_id, 'tair', 'Air Temperature', 'K',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 'qair', 'Air humidity', 'g/g',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 'q2m', '2m Air humidity', 'g/g',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 't2m', '2m Air Temperature', 'K',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+            CALL histdef(hist2_id, 'alb_vis', 'Albedo visible', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 'alb_nir', 'Albedo near infrared', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 'roughheight', 'Effective roughness height', 'm',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(4), dt, dw2)
+             CALL histdef(hist2_id, 'transpir', 'Transpiration', 'mm/d', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(4), dt, dw2)
+             CALL histdef(hist2_id, 'inter', 'Interception loss', 'mm/d', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(4), dt, dw2)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 5
+             !-
+             CALL histdef(hist2_id, 'tsol_max', 'Maximum Surface Temperature',&
+                  & 'C', iim,jjm, hori_id2, 1,1,1, -99, 32, tmaxcels2(5), dt, dw2)
+             CALL histdef(hist2_id, 'tsol_min', 'Minimum Surface Temperature',&
+                  & 'C', iim,jjm, hori_id2, 1,1,1, -99, 32, tmincels2(5), dt, dw2)
+             CALL histdef(hist2_id, 'snow', 'Snow mass', 'kg/m^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'snowage', 'Snow age', '?', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'snownobio', 'Snow on other surfaces', 'kg/m^2', &
+                  & iim,jjm, hori_id2, nnobio,1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'snownobioage', 'Snow age on other surfaces', 'd', &
+                  & iim,jjm, hori_id2, nnobio,1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'vegetfrac', 'Fraction of vegetation', '1', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'nobiofrac', 'Fraction of other surface types', '1', &
+                  & iim,jjm, hori_id2, nnobio, 1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
+
+             DO jst=1,nstm
+                   
+                ! var_name= "mc_1" ... "mc_3"
+                WRITE (var_name,"('moistc_',i1)") jst
+                CALL histdef(hist2_id, var_name, 'Soil Moisture profile for soil type', 'm3/m3', &
+                     & iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(5), dt, dw2)
+                
+                ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+                WRITE (var_name,"('vegetsoil_',i1)") jst
+                CALL histdef(hist2_id, var_name, 'Fraction of vegetation on soil types', '%', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
+                
+                ! var_name= "kfact_root_1" ... "kfact_root_3"
+                WRITE (var_name,"('kfactroot_',i1)") jst
+                CALL histdef(hist2_id, var_name, 'Root fraction profile for soil type', '%', &
+                     & iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(5), dt,dw2)
+             ENDDO
+             
+          
+             !-
+             !- SECHIBA_HISTLEVEL2 = 6
+             !-
+             CALL histdef(hist2_id, 'humtot', 'Total Soil Moisture', 'Kg/m^2', &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
+             CALL histdef(hist2_id, 'humtot_soil', 'Soil Moisture for soil type', 'Kg/m^2', &
+                  & iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, avescatter2(6), dt, dw2)
+
+             CALL histdef(hist2_id, '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)
+             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)
+
+             IF ( ok_stomate ) THEN
+                CALL histdef(hist2_id, 'nee', 'Net Ecosystem Exchange', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt,dw2)
+                CALL histdef(hist2_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt,dw2)
+                CALL histdef(hist2_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt,dw2)
+                CALL histdef(hist2_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt, dw2)
+                CALL histdef(hist2_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt, dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'precisol', 'Throughfall', 'mm/d',  &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(6), dt, dw2)
+             CALL histdef(hist2_id, 'drysoil_frac', 'Fraction of visibly dry soil', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(6), dt, dw2)
+             CALL histdef(hist2_id, 'evapot', 'Potential evaporation', 'mm/d',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(6), dt, dw2)
+             CALL histdef(hist2_id, 'evapot_corr', 'Potential evaporation', 'mm/d',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(6), dt, dw2)
+             CALL histdef(hist2_id, 'snowmelt', 'snow melt', 'kg/m2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(6), dt, dw2)
+
+             !-
+             !- SECHIBA_HISTLEVEL2 = 7
+             !-
+             CALL histdef(hist2_id, 'swnet', 'Net solar radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(7), dt, dw2)
+             CALL histdef(hist2_id, 'swdown', 'Incident solar radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(7), dt, dw2)
+             CALL histdef(hist2_id, 'lwdown', 'Absorbed downward longwave radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'lwnet', 'Net surface longwave radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 8
+             !-
+             IF ( river_routing ) THEN
+                CALL histdef(hist2_id, 'fastr', 'Fast flow reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
+                CALL histdef(hist2_id, 'slowr', 'Slow flow reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
+                CALL histdef(hist2_id, 'streamr', 'Stream flow reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
+                CALL histdef(hist2_id, 'floodr', 'Floodplains reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt,dw2)
+                CALL histdef(hist2_id, 'floodh', 'Floodplains height', 'mm', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt,dw2)
+                CALL histdef(hist2_id, 'pondr', 'Ponds reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt,dw2)
+                CALL histdef(hist2_id, 'lakevol', 'Volume in lake reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
+                IF ( do_irrigation ) THEN
+                   CALL histdef(hist2_id, 'irrigation', 'Net irrigation', 'mm/d', &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(8), dt, dw2)
+                   CALL histdef(hist2_id, 'netirrig', 'Net irrigation requirement', 'mm/d', &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(8), dt, dw2)
+                   CALL histdef(hist2_id, 'irrigmap', 'Map of irrigated areas', 'm^2', &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(8), dt, dw2)
+                ENDIF
+                CALL histdef(hist2_id, 'floodmap', 'Map of floodplains', 'm^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(8), dt,dw2)
+                CALL histdef(hist2_id, 'swampmap', 'Map of swamps', 'm^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(8), dt,dw2)
+             ENDIF
+             !-
+             !- SECHIBA_HISTLEVEL2 = 9
+             !-
+             CALL histdef(hist2_id, 'beta', 'Beta Function', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'raero', 'Aerodynamic resistance', 's/m',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'Wind', 'Wind speed', 'm/s',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'qsatt' , 'Surface saturated humidity', 'g/g', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'vbeta1', 'Beta for sublimation', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'vbeta4', 'Beta for bare soil', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'gsmean', 'mean stomatal conductance', 'umol/m2/s', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'vbeta5', 'Beta for floodplains', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'reinf_slope', 'Slope index for each grid box', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(9),  dt,dw2)
+             CALL histdef(hist2_id, 'soilindex', 'Soil index', '1', &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, once2(9),  dt,dw2)
+
+             CALL histdef(hist2_id, 'humrel', 'Soil moisture stress', '-',  &
+                  & iim,jjm, hori_id2, nvm,1,nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 10
+             !-
+             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,'vbeta2','Beta for Interception loss','mm/d', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
+             CALL histdef(hist2_id, 'qsintmax', 'Maximum Interception capacity', 'Kg/m^2', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
+             
+             IF ( ok_bvoc ) THEN
+                CALL histdef(hist2_id, 'PAR', 'PAR', 'umol phot/m^2/s',  &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                IF ( ok_radcanopy ) THEN
+                   CALL histdef(hist2_id, 'PARsun', 'Sunlit Leaf PAR', 'umol phot/m^2/s', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'PARsh', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'laisun', 'Sunlit Leaf Area Index', '1', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'laish', 'Shaded Leaf Area Index', '1', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'Fdf', 'Fdf', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   IF ( ok_multilayer ) then 
+                      CALL histdef(hist2_id, 'PARsuntab', 'Sunlit Leaf PAR', 'umol phot/m^2/s', &
+                           & iim,jjm, hori_id2, nlevels_tot+1, 1, nlevels_tot+1, laiax_id2, 32, avescatter2(10), dt,dw2)
+                      CALL histdef(hist2_id, 'PARshtab', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                           & iim,jjm, hori_id2, nlevels_tot+1, 1, nlevels_tot+1, laiax_id2, 32, avescatter2(10), dt,dw2)
+                   ENDIF
+                   CALL histdef(hist2_id, 'coszang', 'coszang', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'PARdf', 'PARdf', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'PARdr', 'PARdr', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'Trans', 'Trans', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                END IF
+                
+                CALL histdef(hist2_id, 'flx_fertil_no', 'flx_fertil_no', 'ngN/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'CRF', 'CRF', '1', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_co2_bbg_year', 'flx_co2_bbg_year', 'kgC/m^2/yr ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(10), dt,dw2)  
+                CALL histdef(hist2_id, 'N_qt_WRICE_year', 'N_qt_WRICE_year', 'kgN/yr ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(10), dt,dw2)  
+                CALL histdef(hist2_id, 'N_qt_OTHER_year', 'N_qt_OTHER_year', 'kgN/yr ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(10), dt,dw2)  
+                CALL histdef(hist2_id, 'flx_iso', 'flx_iso', 'kgC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_mono', 'flx_mono', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_apinen', 'flx_apinen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_bpinen', 'flx_bpinen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_limonen', 'flx_limonen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_myrcen', 'flx_myrcen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_sabinen', 'flx_sabinen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_camphen', 'flx_camphen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_3caren', 'flx_3caren', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_tbocimen', 'flx_tbocimen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_othermono', 'flx_othermono', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_sesquiter', 'flx_sesquiter', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_ORVOC', 'flx_ORVOC', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_MBO', 'flx_MBO', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_methanol', 'flx_methanol', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_acetone', 'flx_acetone', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(1), dt,dw2)   !! LDF TEST modificato a 1... !!
+                CALL histdef(hist2_id, 'flx_acetal', 'flx_acetal', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(1), dt,dw2)   !! LDF TEST modificato a 1... !!
+                CALL histdef(hist2_id, 'flx_formal', 'flx_formal', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_acetic', 'flx_acetic', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_formic', 'flx_formic', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_no_soil', 'flx_no_soil', 'ngN/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_no', 'flx_no', 'ngN/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+             ENDIF
+         ELSE 
+             !-
+             !- This is the ALMA convention output now
+             !-
+             !- 
+             IF ( GridType == "RegLonLat" ) 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, znt, 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, 'solay', 'Hydrol soil levels',      'm', &
+                  &    nslm, diaglev(1:nslm), solayax_id2)
+             !-
+             !-  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, avescatter2(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, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qle', 'Latent heat flux', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(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, 'Qv', 'Energy of sublimation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'DelSurfHeat', 'Change in surface layer heat', 'J/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, sumscatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'DelColdCont', 'Change in snow surface layer cold content', 'J/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, sumscatter2(7), dt, dw2)
+             !-
+             !- General water balance
+             !-
+             CALL histdef(hist2_id, 'Snowf', 'Snowfall rate', 'kg/m^2/s',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Rainf', 'Rainfall rate', 'kg/m^2/s',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Evap', 'Total Evapotranspiration', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qs', 'Surface runoff', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qsb', 'Sub-surface runoff', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qsm', 'Snowmelt', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'DelSoilMoist', 'Change in soil moisture', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'DelSurfStor', 'Change in Surface Water Storage','kg/m^2',&
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(7), dt,dw2)
+             CALL histdef(hist2_id, 'DelIntercept', 'Change in interception storage', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'DelSWE', 'Change in interception storage Snow Water Equivalent', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(7), dt, dw2)
+             !-
+             !- Surface state
+             !-
+             CALL histdef(hist2_id, 'AvgSurfT', 'Average surface temperature', 'K', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'RadT', 'Surface radiative temperature', 'K', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'Albedo', 'Albedo', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'SurfStor', 'Surface Water Storage','kg/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'SWE', 'Snow Water Equivalent', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter2(1), dt,dw2)
+             !!-
+             !-  Sub-surface state
+             !- 
+             CALL histdef(hist2_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'SoilWet', 'Total soil wetness', '-',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'SoilTemp', 'Soil temperature profile', 'K', &
+                  & iim,jjm, hori_id2, ngrnd, 1, ngrnd, solax_id2, 32, avescatter2(7), dt, dw2)
+             !- 
+             !-  Evaporation components
+             !-
+             CALL histdef(hist2_id, 'PotEvap', 'Potential evapotranspiration', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'ECanop', 'Interception evaporation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(5), dt, dw2)
+             CALL histdef(hist2_id, 'TVeg', 'Transpiration', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(5), dt, dw2)
+             CALL histdef(hist2_id, 'ESoil', 'Bare soil evaporation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(5), dt, dw2)
+             CALL histdef(hist2_id, 'RootMoist','Root zone soil water', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'SubSnow','Snow sublimation','kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'ACond', 'Aerodynamic conductance', 'm/s',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
+             !-
+             !-
+             !-  Cold Season Processes
+             !-
+             CALL histdef(hist2_id, 'SnowFrac', 'Snow cover fraction', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'SAlbedo', 'Snow albedo', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             !-
+             !- Hydrologic variables
+             !-
+             IF ( river_routing ) THEN
+                !
+                IF (do_floodplains) THEN
+                   CALL histdef(hist2_id, 'EWater', 'Open water evaporation', 'kg/m^2/s', &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(5), dt, dw2)
+                   CALL histdef(hist2_id, 'FloodFrac', 'Floodplain Fraction', '-', &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt,dw2)
+                ENDIF
+                !
+                CALL histdef(hist2_id, 'IrrigationMap', 'Map of irrigated areas', 'm^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
+                CALL histdef(hist2_id, 'FloodplainsMap', 'Map of flooded areas', 'm^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt,dw2)
+                CALL histdef(hist2_id, 'SwampMap', 'Map of swamp areas', 'm^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt,dw2)
+                CALL histdef(hist2_id, 'Dis', 'Simulated River Discharge', 'm^3/s', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt,dw2)
+             ENDIF
+             !-
+             !-
+             !-
+             CALL histdef(hist2_id, 'humrel', 'Soil moisture stress', '-',  &
+                  & iim,jjm, hori_id2, nvm,1,nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
+             !-
+             !-  The carbon budget
+             !-
+             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)
+             IF ( ok_stomate ) THEN
+                CALL histdef(hist2_id, 'NEE', 'Net Ecosystem Exchange', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
+                CALL histdef(hist2_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
+                CALL histdef(hist2_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
+                CALL histdef(hist2_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
+                CALL histdef(hist2_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
+             ENDIF
+             !
+          ENDIF
+          !-
+          CALL histdef(hist2_id, 'LandPoints', 'Land Points', '1', &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(10), dt, dw2)  
+          CALL histdef(hist2_id, 'Areas', 'Mesh areas', 'm2', &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
+          CALL histdef(hist2_id, 'Contfrac', 'Continental fraction', '1', &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
+          !-
+          ! Write the names of the pfts in the high frequency sechiba history files
+          global_attribute="PFT_name"
+          DO i=1,nvm
+             WRITE(global_attribute(9:10),"(I2.2)") i
+             CALL histglobal_attr(hist2_id, global_attribute, PFT_name(i))
+          ENDDO
+          !-
+          CALL histend(hist2_id)
+      ENDIF
+  ENDIF
+
+    !-
+    !=====================================================================
+    !- 3.2 STOMATE's history file
+    !=====================================================================
+    IF ( ok_stomate ) THEN
+       !-
+       ! STOMATE IS ACTIVATED
+       !-
+       !Config Key   = STOMATE_OUTPUT_FILE
+       !Config Desc  = Name of file in which STOMATE's output is going to be written
+       !Config If    = OK_STOMATE
+       !Config Def   = stomate_history.nc
+       !Config Help  = This file is going to be created by the model
+       !Config         and will contain the output from the model.
+       !Config         This file is a truly COADS compliant netCDF file.
+       !Config         It will be generated by the hist software from
+       !Config         the IOIPSL package.
+       !Config Units = [FILE]
+       !-
+       stom_histname='stomate_history.nc'
+       CALL getin_p('STOMATE_OUTPUT_FILE', stom_histname)       
+       WRITE(numout,*) 'STOMATE_OUTPUT_FILE', TRIM(stom_histname)
+       !-
+       !Config Key   = STOMATE_HIST_DT
+       !Config Desc  = STOMATE history time step
+       !Config If    = OK_STOMATE
+       !Config Def   = 10.
+       !Config Help  = Time step of the STOMATE history file
+       !Config Units = [days]
+       !-
+       hist_days_stom = 10.
+       CALL getin_p('STOMATE_HIST_DT', hist_days_stom)       
+
+       IF ( hist_id < 0 ) THEN
+          ! Deactivate all history files if sechiba_history file is deactivated
+          hist_dt_stom=0
+          WRITE(numout,*) 'STOMATE history file will not be created because sechiba_history file is deactivated.'
+       ELSE IF ( hist_days_stom == moins_un ) THEN
+          hist_dt_stom = moins_un
+          WRITE(numout,*) 'output frequency for STOMATE history file (d): one month.'
+       ELSE IF ( hist_days_stom == 0 ) THEN
+          ! Deactivate this file
+          hist_dt_stom=0
+          WRITE(numout,*) 'STOMATE history file will not be created'
+       ELSE
+          hist_dt_stom = NINT( hist_days_stom ) * one_day
+          WRITE(numout,*) 'output frequency for STOMATE history file (d): ', &
+               hist_dt_stom/one_day
+       ENDIF
+
+       ! test consistency between STOMATE_HIST_DT and DT_STOMATE parameters
+       dt_stomate_loc = one_day
+       CALL getin_p('DT_STOMATE', dt_stomate_loc)
+       IF ( hist_days_stom /= moins_un .AND. hist_dt_stom/=0) THEN
+          IF (dt_stomate_loc > hist_dt_stom) THEN
+             WRITE(numout,*) "DT_STOMATE = ",dt_stomate_loc,"  , STOMATE_HIST_DT = ",hist_dt_stom
+             CALL ipslerr_p (3,'ioipslctrl_history', &
+                  &          'Problem with DT_STOMATE > STOMATE_HIST_DT','', &
+                  &          '(must be less or equal)')
+          ENDIF
+       ENDIF
+       !-
+       !- Initialize stomate_history file
+       IF ( hist_dt_stom == 0 ) THEN
+          ! Case hist_dt_stom=0 : No creation of stomate_history.nc file
+          ! Nothing will be done.
+          hist_id_stom=-1
+       ELSE
+          ! Initialise stomate_history file
+       IF (is_omp_root) THEN
+          IF ( GridType == "RegLonLat" ) 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)
+
+          !
+          ! Product use
+          !
+          !- define Pool_short axis
+          hist_pool_s_axis = (/ ( REAL(i,r_std), i=1,nshort ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P_S', 'Short lived pool', &
+               & '1', nshort, hist_pool_s_axis, hist_pool_s_axis_id)
+
+          !- define Pool_medium axis
+          hist_pool_m_axis = (/ ( REAL(i,r_std), i=1,nmedium ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P_M', 'Medium lived pool', &
+               & '1', nmedium, hist_pool_m_axis, hist_pool_m_axis_id)
+
+          !- define Pool_long axis
+          hist_pool_l_axis = (/ ( REAL(i,r_std), i=1,nlong ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P_L', 'Long lived pool', &
+               & '1', nlong, hist_pool_l_axis, hist_pool_l_axis_id)
+
+          !- define Pool_ss axis
+          hist_pool_ss_axis = (/ ( REAL(i,r_std), i=1,nshort+1 ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P_SS', 'short lived pool years + 1', &
+               & '1', nshort+1, hist_pool_ss_axis, hist_pool_ss_axis_id)
+
+          !- define Pool_mm axis
+          hist_pool_mm_axis = (/ ( REAL(i,r_std), i=1,nmedium+1 ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P_MM', 'medium lived pool years + 1', &
+               & '1', nmedium+1, hist_pool_mm_axis, hist_pool_mm_axis_id)
+
+          !- define Pool_ll axis
+          hist_pool_ll_axis = (/ ( REAL(i,r_std), i=1,nlong+1 ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P_LL', 'long lived pool  years + 1', &
+               & '1', nlong+1, hist_pool_ll_axis, hist_pool_ll_axis_id)
+
+          !
+          ! Canopy discretisation
+          !
+          IF(printlev>=4) WRITE(numout,*) 'just before the new lines',nlevels_tot
+          ! For the number of canopy levels including all those used in
+          ! photosynthesis.
+          ! Notice we cannot use the real heights here, since they can change
+          ! every day
+          ! as the canopy develops.
+          DO ilev=1,nlevels_tot
+             z_levels_tot(ilev)=REAL(ilev,r_std)
+          ENDDO
+          IF(printlev>=4) WRITE(numout,*) 'in between the new lines',z_levels_tot
+          CALL histvert(hist_id_stom, 'canleveltot', 'Total canopy levels', '-',&
+               &    nlevels_tot,  z_levels_tot, canx_tot_stom_id)
+          IF(printlev>=4) WRITE(numout,*) 'right after the new lines',canx_tot_stom_id
+
+       ENDIF
+       !- define STOMATE history file
+       CALL ioipslctrl_histstom (hist_id_stom, nvm, iim, jjm, &
+            & dt, hist_dt_stom, hori_id, hist_PFTaxis_id, &
+            & hist_pool_10axis_id, hist_pool_100axis_id, &
+            & hist_pool_11axis_id, hist_pool_101axis_id, &
+            & hist_pool_s_axis_id, hist_pool_m_axis_id, &
+            & hist_pool_l_axis_id, hist_pool_ss_axis_id, &
+            & hist_pool_mm_axis_id, hist_pool_ll_axis_id, &
+            & canx_tot_stom_id)
+       
+       !- Write the names of the pfts in the stomate history files 
+       IF (is_omp_root) THEN
+          global_attribute="PFT_name"
+          DO i=1,nvm
+             WRITE(global_attribute(9:10),"(I2.2)") i
+             CALL histglobal_attr(hist_id_stom, global_attribute, PFT_name(i))
+          ENDDO
+
+       !- end definition
+          CALL histend(hist_id_stom)
+       ENDIF
+    END IF ! IF ( hist_dt_stom == 0 )
+
+       !-
+       !-
+       !-
+       ! STOMATE IPCC OUTPUTS IS ACTIVATED
+       !-
+       !Config Key   = STOMATE_IPCC_OUTPUT_FILE
+       !Config Desc  = Name of file in which STOMATE's output is going to be written
+       !Config If    = OK_STOMATE
+       !Config Def   = stomate_ipcc_history.nc
+       !Config Help  = This file is going to be created by the model
+       !Config         and will contain the output from the model.
+       !Config         This file is a truly COADS compliant netCDF file.
+       !Config         It will be generated by the hist software from
+       !Config         the IOIPSL package.
+       !Config Units = [FILE]
+       !-
+       stom_ipcc_histname='stomate_ipcc_history.nc'
+       CALL getin_p('STOMATE_IPCC_OUTPUT_FILE', stom_ipcc_histname)       
+       WRITE(numout,*) 'STOMATE_IPCC_OUTPUT_FILE', TRIM(stom_ipcc_histname)
+       !-
+       !Config Key   = STOMATE_IPCC_HIST_DT
+       !Config Desc  = STOMATE IPCC history time step
+       !Config If    = OK_STOMATE
+       !Config Def   = 0.
+       !Config Help  = Time step of the STOMATE IPCC history file
+       !Config Units = [days]
+       !-
+       hist_days_stom_ipcc = zero
+       CALL getin_p('STOMATE_IPCC_HIST_DT', hist_days_stom_ipcc)       
+       IF ( hist_days_stom_ipcc == moins_un ) THEN
+          hist_dt_stom_ipcc = moins_un
+          WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): one month.'
+       ELSE
+          hist_dt_stom_ipcc = NINT( hist_days_stom_ipcc ) * one_day
+          WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): ', &
+            hist_dt_stom_ipcc/one_day
+       ENDIF
+       
+       IF ( hist_dt_stom_ipcc /= 0 .AND. hist_id < 0 ) THEN
+          ! sechiba_history file is not created therefore STOMATE IPCC history file will be deactivated
+          hist_dt_stom_ipcc=0
+          hist_days_stom_ipcc=0
+          WRITE(numout,*) 'STOMATE IPCC history file is not created.'
+       END IF
+
+       ! test consistency between STOMATE_IPCC_HIST_DT and DT_STOMATE parameters
+       dt_stomate_loc = one_day
+       CALL getin_p('DT_STOMATE', dt_stomate_loc)
+       IF ( hist_days_stom_ipcc > zero ) THEN
+          IF (dt_stomate_loc > hist_dt_stom_ipcc) THEN
+             WRITE(numout,*) "DT_STOMATE = ",dt_stomate_loc,"  , STOMATE_IPCC_HIST_DT = ",hist_dt_stom_ipcc
+             CALL ipslerr_p (3,'ioipslctrl_history', &
+                  &          'Problem with DT_STOMATE > STOMATE_IPCC_HIST_DT','', &
+                  &          '(must be less or equal)')
+          ENDIF
+       ENDIF
+
+       !Config Key   = OK_HISTSYNC
+       !Config Desc  = Syncronize and write IOIPSL output files at each time step
+       !Config If    = 
+       !Config Def   = FALSE
+       !Config Help  = Setting this flag to true might affect run performance. Only use it for debug perpose.
+       !Config Units = [FLAG]
+       ok_histsync=.FALSE.
+       CALL getin_p('OK_HISTSYNC', ok_histsync)       
+
+
+
+       IF ( hist_dt_stom_ipcc == 0 ) THEN
+          hist_id_stom_ipcc = -1
+       ELSE
+          !-
+          !- initialize
+          IF (is_omp_root) THEN
+             IF ( GridType == "RegLonLat" ) THEN
+#ifdef CPP_PARA
+                CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
+#else
+                CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id, hist_id_stom_ipcc)
+#endif
+             ELSE
+#ifdef CPP_PARA
+                CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
+#else
+                CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id, hist_id_stom_ipcc)
+#endif
+             ENDIF
+             !- declare this axis
+             CALL histvert (hist_id_stom_IPCC, 'PFT', 'Plant functional type', &
+                  & '1', nvm, hist_PFTaxis, hist_IPCC_PFTaxis_id)
+             
+             !- define STOMATE history file
+             CALL ioipslctrl_histstomipcc (hist_id_stom_IPCC, nvm, iim, jjm, &
+                  & dt, hist_dt_stom_ipcc, hori_id, hist_IPCC_PFTaxis_id)
+             
+             !- Write the names of the pfts in the stomate history files 
+             global_attribute="PFT_name"
+             DO i=1,nvm
+                WRITE(global_attribute(9:10),"(I2.2)") i
+                CALL histglobal_attr(hist_id_stom_IPCC, global_attribute, PFT_name(i))
+             ENDDO
+
+             !- end definition
+             CALL histend(hist_id_stom_IPCC)
+          ENDIF
+      ENDIF
+   ENDIF
+
+
+  END SUBROUTINE ioipslctrl_history
+
+!! ================================================================================================================================
+!! SUBROUTINE    : ioipslctrl_histstom
+!!
+!>\BRIEF	 This subroutine initialize the IOIPSL stomate output file
+!! 
+!! DESCRIPTION   : This subroutine initialize the IOIPSL output file stomate_history.nc(default name).
+!!                 This subroutine was previously named stom_define_history and where located in module intersurf.
+!! RECENT CHANGE(S): None
+!!
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE ioipslctrl_histstom( &
+       hist_id_stom, nvm, iim, jjm, dt, &
+       hist_dt, hist_hori_id, hist_PFTaxis_id, &
+       hist_pool_10axis_id, hist_pool_100axis_id, &
+       hist_pool_11axis_id, hist_pool_101axis_id, &
+       hist_pool_s_axis_id, hist_pool_m_axis_id, &
+       hist_pool_l_axis_id, hist_pool_ss_axis_id, &
+       hist_pool_mm_axis_id, hist_pool_ll_axis_id, &
+       canx_tot_stom_id)
+    ! deforestation axis added as arguments
+
+    !---------------------------------------------------------------------
+    !- Tell ioipsl which variables are to be written
+    !- and on which grid they are defined
+    !---------------------------------------------------------------------
+    IMPLICIT NONE
+    !-
+    !- Input
+    !-
+    !- File id
+    INTEGER(i_std),INTENT(in) :: hist_id_stom
+    !- number of PFTs
+    INTEGER(i_std),INTENT(in) :: nvm
+    !- Domain size
+    INTEGER(i_std),INTENT(in) :: iim, jjm
+    !- Time step of STOMATE (seconds)
+    REAL(r_std),INTENT(in)    :: dt
+    !- Time step of history file (s)
+    REAL(r_std),INTENT(in)    :: hist_dt
+    !- id horizontal grid
+    INTEGER(i_std),INTENT(in) :: hist_hori_id
+    !- id of PFT axis
+    INTEGER(i_std),INTENT(in) :: hist_PFTaxis_id
+    !- id of Deforestation axis
+    INTEGER(i_std),INTENT(in) :: hist_pool_10axis_id,hist_pool_100axis_id
+    INTEGER(i_std),INTENT(in) :: hist_pool_11axis_id,hist_pool_101axis_id
+    !- id of Deforestation axis
+    INTEGER(i_std),INTENT(in) :: hist_pool_s_axis_id     !!id of Deforestation axis
+    INTEGER(i_std),INTENT(in) :: hist_pool_m_axis_id     !!id of Deforestation axis
+    INTEGER(i_std),INTENT(in) :: hist_pool_l_axis_id
+    INTEGER(i_std),INTENT(in) :: hist_pool_ss_axis_id    !!id of Deforestation axis
+    INTEGER(i_std),INTENT(in) :: hist_pool_mm_axis_id    !!id of Deforestation axis
+    INTEGER(i_std),INTENT(in) :: hist_pool_ll_axis_id    !!id of Deforestation axis
+
+    INTEGER(i_std),INTENT(in) :: canx_tot_stom_id
+
+    !-
+    !- 1 local
+    !-
+    !- string suffix indicating element 
+    CHARACTER(LEN=2), DIMENSION(nelements)      :: element_str        
+    !- index for nelements  
+    INTEGER(i_std) :: l 
+    !- 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, t_max, once
+    CHARACTER(LEN=80)                           :: var_name           !! Tostore variables names
+    INTEGER(i_std)                              :: ivm, icir, iyear
+
+    !---------------------------------------------------------------------
+    !=====================================================================
+    !- 1 history level
+    !=====================================================================
+    !- 1.1 define history levelx
+    !=====================================================================
+    !Config Key   = STOMATE_HISTLEVEL
+    !Config Desc  = STOMATE history output level (0..10)
+    !Config If    = OK_STOMATE
+    !Config Def   = 10
+    !Config Help  = 0: nothing is written; 10: everything is written
+    !Config Units = [-]
+    !-
+    hist_level = 10
+    CALL getin_p('STOMATE_HISTLEVEL', hist_level)
+    !-
+    WRITE(numout,*) 'STOMATE history level: ',hist_level
+    IF ( (hist_level > max_hist_level).OR.(hist_level < 0) ) THEN
+       STOP 'This history level is not allowed'
+    ENDIF
+    !=====================================================================
+    !- 1.2 define operations according to output level
+    !=====================================================================
+    ave(1:hist_level) =  'ave(scatter(X))'
+    ave(hist_level+1:max_hist_level) =  'never'
+
+    t_max(1:hist_level) =  't_max(scatter(X))'
+    t_max(hist_level+1:max_hist_level) =  'never' 
+
+    once(1:max_hist_level) = 'once(scatter(X))'
+    once(hist_level+1:max_hist_level) = 'never'
+    !=====================================================================
+    !- 2 surface fields (2d)
+    !- 3 PFT: 3rd dimension
+    !=====================================================================
+
+
+    ! structural litter above ground
+    IF (is_omp_root) THEN
+       DO l=1,nelements 
+          IF     (l == icarbon) THEN 
+             element_str(l) = '_c' 
+          ELSEIF (l == initrogen) THEN 
+             element_str(l) = '_n' 
+          ELSE 
+             STOP 'Define element_str' 
+          ENDIF
+          CALL histdef (hist_id_stom, &
+               &               TRIM("LITTER_STR_AB       ")//TRIM(element_str(l)), &
+               &               TRIM("structural litter above ground                    "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("metabolic litter above ground                     "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("structural litter below ground                    "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("metabolic litter below ground                     "), &
+               &               TRIM("gC(orN)/m^2/pft          "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+          
+          ! Woody litter above ground
+          CALL histdef (hist_id_stom, &
+               &               TRIM("LITTER_WOD_AB")//TRIM(element_str(l)), &
+               &               TRIM("Woody litter above ground"), &
+               &               TRIM("gC(orN)/m^2/pft"), iim, jjm, hist_hori_id, &
+               &               nvm, 1, nvm, hist_PFTaxis_id, 32, ave(5), dt, hist_dt)
+          
+          ! Woody litter below ground
+          CALL histdef (hist_id_stom, &
+               &               TRIM("LITTER_WOD_BE ")//TRIM(element_str(l)), &
+               &               TRIM("Woody litter below ground "), &
+               &               TRIM("gC(orN)/m^2/pft"), 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("SOIL_ACTIVE       ")//TRIM(element_str(l)), &
+               &               TRIM("active soil C or N in ground                      "), &
+               &               TRIM("gC(orN)/m^2/pft          "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+          
+          ! surface soil carbon in ground                 
+          CALL histdef (hist_id_stom, &
+               &               TRIM("SOIL_SURF       ")//TRIM(element_str(l)), &
+               &               TRIM("surface soil C or N in ground                      "), &
+               &               TRIM("gC(orN)/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("SOIL_SLOW         ")//TRIM(element_str(l)), &
+               &               TRIM("slow soil C or N in ground                        "), &
+               &               TRIM("gC(orN)/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("SOIL_PASSIVE      ")//TRIM(element_str(l)), &
+               &               TRIM("passive soil C or N in ground                     "), &
+               &               TRIM("gC(orN)/m^2/pft          "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+   
+          ! total living biomass
+          CALL histdef (hist_id_stom, &
+               &               TRIM("TOTAL_M             ")//TRIM(element_str(l)), &
+               &               TRIM("Total living biomass                              "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Leaf mass                                         "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Sap mass above ground                             "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Sap mass below ground                             "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Heartwood mass above ground                       "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Heartwood mass below ground                       "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Root mass                                         "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Fruit mass                                        "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Carbohydrate reserve mass                         "), &
+               &               TRIM("gC(orN)/m^2              "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          ! Labile reserve mass                         
+          CALL histdef (hist_id_stom, &
+               &               TRIM("LABILE_M           ")//TRIM(element_str(l)), &
+               &               TRIM("Labile reserve mass                         "), &
+               &               TRIM("gC(orN)/m^2              "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          
+!!$          ! Labile fraction
+!!$          CALL histdef (hist_id_stom, &
+!!$               &               TRIM("LAB_FAC             ")//TRIM(element_str(l)), &
+!!$               &               TRIM("Labile fraction                             "), &
+!!$               &               TRIM("unitless                 "), 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(element_str(l)), &
+               &               TRIM("total turnover rate                               "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Leaf turnover                                     "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Sap turnover above                                "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Root turnover                                     "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Fruit turnover                                    "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("total conversion of biomass to litter             "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Leaf death                                        "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Sap death above ground                            "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Sap death below ground                            "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Heartwood death above ground                      "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Heartwood death below ground                      "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Root death                                        "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Fruit death                                       "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("Carbohydrate reserve death                        "), &
+               &               TRIM("gC(orN)/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+   
+          ! Labile reserve death                        
+          CALL histdef (hist_id_stom, &
+               &               TRIM("LABILE_BM_LITTER   ")//TRIM(element_str(l)), &
+               &               TRIM("Labile reserve death                        "), &
+               &               TRIM("gC(orN)/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+   
+          ! biomass allocated to leaves                       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("BM_ALLOC_LEAF       ")//TRIM(element_str(l)), &
+               &               TRIM("biomass allocated to leaves                       "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("biomass allocated to sapwood above ground         "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("biomass allocated to sapwood below ground         "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("biomass allocated to roots                        "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("biomass allocated to fruits                       "), &
+               &               TRIM("gC(orN)/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(element_str(l)), &
+               &               TRIM("biomass allocated to carbohydrate reserve         "), &
+               &               TRIM("gC(orN)/m**2/pft/dt          "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+          
+          ! biomass allocated to the labile pool        
+          CALL histdef (hist_id_stom, &
+               &               TRIM("BM_ALLOC_LABILE       ")//TRIM(element_str(l)), &
+               &               TRIM("biomass allocated to the labile reserve           "), &
+               &               TRIM("gC(orN)/m**2/pft/dt          "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+          ! short-lived wood product pool                         
+          CALL histdef (hist_id_stom, &
+               &               TRIM("PROD_S")//TRIM(element_str(l)), &
+               &               TRIM("short-lived wood product pool"), &
+               &               TRIM("-                   "), iim,jjm,hist_hori_id, &
+               &               nshort+1,1,nshort+1, hist_pool_ss_axis_id,32,ave(1), dt, hist_dt)
+
+          ! medium-lived wood product pool                         
+          CALL histdef (hist_id_stom, &
+               &               TRIM("PROD_M")//TRIM(element_str(l)), &
+               &               TRIM("medium-lived wood product pool"), &
+               &               TRIM("-                   "), iim,jjm,hist_hori_id, &
+               &               nmedium+1,1,nmedium+1, hist_pool_mm_axis_id,32,ave(1), dt, hist_dt)
+
+          ! long lived wood product pool                        
+          CALL histdef (hist_id_stom, &
+               &               TRIM("PROD_L")//TRIM(element_str(l)), &
+               &               TRIM("long-lived wood product pool"), &
+               &               TRIM("-                  "), iim,jjm,hist_hori_id, &
+               &               nlong+1,1,nlong+1, hist_pool_ll_axis_id,32,ave(1), dt, hist_dt)
+
+          !  annual flux from the medium-lived wood product pool    
+          CALL histdef (hist_id_stom, &
+               &               TRIM("FLUX_S")//TRIM(element_str(l)), &
+               &               TRIM("annual flux for short-lived wood product pool     "), &
+               &               TRIM("-                  "), iim,jjm,hist_hori_id, &
+               &               nshort,1,nshort, hist_pool_s_axis_id,32, ave(5),dt, hist_dt)
+
+          !  annual flux from the medium-lived wood product pool    
+          CALL histdef (hist_id_stom, &
+               &               TRIM("FLUX_M")//TRIM(element_str(l)), &
+               &               TRIM("annual flux for medium-lived wood product pool    "), &
+               &               TRIM("-                   "), iim,jjm,hist_hori_id, &
+               &               nmedium,1,nmedium, hist_pool_m_axis_id,32,ave(5), dt, hist_dt)
+
+          ! annual flux for each 100 year wood product pool   
+          CALL histdef (hist_id_stom, &
+               &               TRIM("FLUX_L")//TRIM(element_str(l)), &
+               &               TRIM("annual flux for the long-lived wood product pool  "), &
+               &               TRIM("-                   "), iim,jjm,hist_hori_id, &
+               &               nlong,1,nlong, hist_pool_l_axis_id,32, ave(5),dt, hist_dt)
+          ! annual release right after deforestation          
+          CALL histdef (hist_id_stom, &
+               &               TRIM("FLUX_PROD_S")//TRIM(element_str(l)), &
+               &               TRIM("annual release right after deforestation"), &
+               &               TRIM("-                   "), 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("FLUX_PROD_M")//TRIM(element_str(l)), &
+               &               TRIM("annual release from all medium wood product pools"), &
+               &               TRIM("-                   "), 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("FLUX_PROD_L")//TRIM(element_str(l)), &
+               &               TRIM("annual release from all long wood productpools"), &
+               &               TRIM("-                  "), iim,jjm,hist_hori_id, &
+               &               1,1,1, -99,32, ave(5), dt, hist_dt)
+           
+          ! mass balance closure in stomate.f90               
+          CALL histdef (hist_id_stom, &
+               &               TRIM("MB_CLOSURE")//TRIM(element_str(l)), &
+               &               TRIM("Daily mass balacne closure in stomate"), &
+               &               TRIM("-                  "), iim, jjm,hist_hori_id,&
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+
+       ENDDO
+
+       ! residual of C-allocation (stomate_growth_fun_all.f90)
+       CALL histdef (hist_id_stom, &
+            &               TRIM("RESIDUAL"), &
+            &               TRIM("Daily residual for ordinary allocation"), &
+            &               TRIM("gC/m**2/pft/dt               "), 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)
+       
+       ! Seasonal nitrogen stress                           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("NSTRESS_SEASON      "), &
+            &               TRIM("Seasonal nitrogen stress                          "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+        
+       ! Seasonal water stress                           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MOIAVAIL_SEASON    "), &
+            &               TRIM("Seasonal water stress                             "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+        
+
+       ! Long term 2 m temperature                           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("T2M_LONGTERM        "), &
+            &               TRIM("Longterm 2 m temperature                          "), &
+            &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(9), dt, hist_dt)
+       
+       ! Monthly 2 m temperature                           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("T2M_MONTH           "), &
+            &               TRIM("Monthly 2 m temperature                           "), &
+            &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+       ! Weekly 2 m temperature                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("T2M_WEEK            "), &
+            &               TRIM("Weekly 2 m temperature                            "), &
+            &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+       ! heterotr. resp. from ground                  
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HET_RESP            "), &
+            &               TRIM("heterotr. resp. from ground                       "), &
+            &               TRIM("gC/m^2 tot/pft/day  "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+       
+       ! Fire fraction on ground
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FIREFRAC            "), &
+            &               TRIM("Fire fraction on ground                           "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Fire index on ground                      
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FIREINDEX           "), &
+            &               TRIM("Fire index on ground                              "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+       
+       ! Litter humidity                                   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTERHUM           "), &
+            &               TRIM("Litter humidity                                   "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+       
+       ! CO2 flux                                  
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CO2FLUX             "), &
+            &               TRIM("CO2 flux                                          "), &
+            &               TRIM("gC/m^2/pft/mth      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Output CO2 flux from fire                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CO2_FIRE            "), &
+            &               TRIM("Output CO2 flux from fire                         "), &
+            &               TRIM("gC/day/m^2/pft      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+       
+       ! CO2 taken from atmosphere for initiate growth     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CO2_TAKEN           "), &
+            &               TRIM("CO2 taken from atmosphere for initiate growth     "), &
+            &               TRIM("gC/day/m^2/pft      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       IF (ok_dgvm) THEN
+          ! total co2 flux (sum over 13 PFTs). when DGVM is activated, the previous
+          ! SUM(CO2FLUX*veget_max) is wrong. We should look at this variable.
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCO2FLUX            "), &
+               &               TRIM("total CO2flux of 13 PFTs (after adjustment)       "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+          
+          ! should be the same with tCO2FLUX
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCO2FLUX_OLD        "), &
+               &               TRIM("total CO2flux of 13 PFTs(multiply by veget_max_old"), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(10), dt, hist_dt)
+          
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tGPP                 "), &
+               &               TRIM("total GPP of 13 PFTs (after adjustment)           "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tRESP_GROWTH         "), &
+               &               TRIM("total resp growth of 13 PFTs (after adjustment)   "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+          
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tRESP_MAINT          "), &
+               &               TRIM("total resp maint  of 13 PFTs (after adjustment)   "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tRESP_HETERO         "), &
+               &               TRIM("total resp hetero of 13 PFTs (after adjustment)   "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCARBON              "), &
+               &               TRIM("total carbon of 13 PFTs (after adjustment)        "), &
+               &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+          
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tBIOMASS             "), &
+               &               TRIM("total biomass of 13 PFTs (after adjustment)       "), &
+               &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tLITTER              "), &
+               &               TRIM("total litter of 13 PFTs (after adjustment)        "), &
+               &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tSOILC               "), &
+               &               TRIM("total soil carbon of 13 PFTs (after adjustment)   "), &
+               &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCO2_TAKEN           "), &
+               &               TRIM("total co2_to_bm 13 PFTs (after adjustment)        "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(10), dt, hist_dt)
+          
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCO2_FIRE            "), &
+               &               TRIM("total co2_fire 13 PFTs (after adjustment)         "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(10), dt, hist_dt)
+       END IF
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FPC_MAX             "), &
+            &               TRIM("foliage projective cover                          "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MAXFPC_LASTYEAR     "), &
+            &               TRIM("foliage projective cover of last year             "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+
+       ! "seasonal" 2 m temperature                           
+       CALL histdef (hist_id_stom, &
+         &               TRIM("TSEASON             "), &
+         &               TRIM("Seasonal 2 m temperature                             "), &
+         &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(10), dt, hist_dt)
+
+       ! how many days after onset                           
+       CALL histdef (hist_id_stom, &
+         &               TRIM("TMIN_SPRING_TIME    "), &
+         &               TRIM("how many days after onset                            "), &
+         &               TRIM("days                "), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+
+       !                           
+       CALL histdef (hist_id_stom, &
+         &               TRIM("ONSET_DATE          "), &
+         &               TRIM("onset date                                           "), &
+         &               TRIM("day                 "), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+
+      ! Growth and phenological status of the plant
+       CALL histdef (hist_id_stom, &
+            &               TRIM("PLANT_STATUS        "), &
+            &               TRIM("Growth and phenological status of thevegetation   "), &
+            &               TRIM("See constantes_var  "), iim,jjm, hist_hori_id,&
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Leaf Area Index                                   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LAI                 "), &
+            &               TRIM("Leaf Area Index                                   "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+       
+       ! Maximum vegetation fraction (LAI -> infinity)     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("VEGET_COV_MAX           "), &
+            &               TRIM("Maximum vegetation fraction (excl. no bio fraction)"), &
+            &               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(2), 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)
+
+
+       ! 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(2), dt, hist_dt)
+
+       ! diameter
+       CALL histdef (hist_id_stom, &
+            &               TRIM("DIAMETER            "), &
+            &               TRIM("quadratic mean diameter"), &
+            &               TRIM("m                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), 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)
+       ! Water stress in allocation
+       CALL histdef (hist_id_stom, &
+               &            TRIM("WSTRESS_SEASON     "), &
+               &            TRIM("water stress used in allocation"), &
+               &            TRIM("-                  "), iim, jjm, hist_hori_id,&
+               &            nvm,1,nvm, hist_PFTaxis_id, 32, ave(1), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+               &            TRIM("WSTRESS_MONTH     "), &
+               &            TRIM("water stress used in allocation"), &
+               &            TRIM("-                  "), iim, jjm, hist_hori_id,&
+               &            nvm,1,nvm, hist_PFTaxis_id, 32, ave(1), 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)
+
+       ! Maximum rate of carboxylation                     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("VCMAX_NEW            "), &
+            &               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)
+
+       ! NOx emission during biomass burning
+       CALL histdef (hist_id_stom, &
+            &               TRIM("NOX_FIRE_EMISSION           "), &
+            &               TRIM("NOx emission during biomass burning                 "), &
+            &               TRIM("gN/m2/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)
+
+
+       ! 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("SENESCENCE       "), &
+            &               TRIM("Is senescent                   "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       CALL histdef (hist_id_stom, &
+            &               TRIM("PFTPRESENT          "), &
+            &               TRIM("PFT exists                                        "), &
+            &               TRIM("d                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GDD_MIDWINTER       "), &
+            &               TRIM("Growing degree days, since midwinter              "), &
+            &               TRIM("degK                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GDD_M5_DORMANCE     "), &
+            &               TRIM("Growing degree days, since dormance               "), &
+            &               TRIM("degK                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("NCD_DORMANCE        "), &
+            &               TRIM("Number of chilling days, since leaves were lost   "), &
+            &               TRIM("d                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ALLOW_INITPHENO     "), &
+            &               TRIM("Allow to declare beginning of the growing season  "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BEGIN_LEAVES        "), &
+            &               TRIM("Signal to start putting leaves on                 "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+
+       ! Radiation use efficieny but defined as GPP/radiation
+       CALL histdef (hist_id_stom, &
+            &               TRIM("RUE_LONGTERM        "), &
+            &               TRIM("Longterm radiation use efficieny                  "), &
+            &               TRIM(" gC m-2 day-1       "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! Sapwood to leaf allocation factor
+       CALL histdef (hist_id_stom, &
+            &               TRIM("KF                 "), &
+            &               TRIM("Sapwood to leaf allocation factor                 "), &
+            &               TRIM("-                  "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! Fraction of labile pool that is active
+       CALL histdef (hist_id_stom, &
+               &            TRIM("LAB_FAC              "), &
+               &            TRIM("Labile fraction                                   "), &
+               &            TRIM("unitless            "), iim,jjm, hist_hori_id, &
+               &            nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ! Basal area
+       CALL histdef (hist_id_stom, &
+               &            TRIM("BA                 "), &
+               &            TRIM("Basal area of stand                               "), &
+               &            TRIM("m^2/ha             "), iim, jjm, hist_hori_id, &
+               &            nvm,1,nvm, hist_PFTaxis_id, 32, ave(1), dt, hist_dt)
+
+       ! on-site wood volume or standing volume
+       CALL histdef (hist_id_stom, &
+               &            TRIM("WOOD_VOL           "), &
+               &            TRIM("Standing wood volume                              "), &
+               &            TRIM("m^3/m^2             "), iim, jjm, hist_hori_id, &
+               &            nvm,1,nvm, hist_PFTaxis_id, 32, ave(1), dt, hist_dt)
+       ! Basal area per diameter class
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CCBA               "), &
+            &               TRIM("Basal area of a trees in a circ class                       "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! Change in basal area per diameter class
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CCDELTABA          "), &
+            &               TRIM("Change in basal area of a trees in a circ class             "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+               &            TRIM("K_LATOSA_ADAPT     "), &
+               &            TRIM("Allocation factor adapted for wstress             "), &
+               &            TRIM("m                  "), iim, jjm, hist_hori_id, &
+               &            nvm,1,nvm, hist_PFTaxis_id, 32, ave(1), dt, hist_dt)
+
+       ! stand age
+       CALL histdef (hist_id_stom, &
+            &               TRIM("AGE_STAND "), &
+            &               TRIM("Age of stand "), &
+            &               TRIM("years "), iim, jjm, hist_hori_id, &
+            &               nvm, 1, nvm, hist_PFTaxis_id, 32, ave(1), dt,hist_dt)
+
+       ! Harvest components
+       !+++CHECK+++
+       ! The function t_max is no longer known
+       ! Find an alternative
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HARVEST_POOL_C       "), &
+            &               TRIM("carbon contained in harvest pool                  "), &
+            &               TRIM("g C                  "), iim,jjm, hist_hori_id, &
+!!$            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+            &               nvm,1,nvm, hist_PFTaxis_id,32, t_max(1), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HARVEST_POOL_N       "), &
+            &               TRIM("nitrogen contained in harvest pool                  "), &
+            &               TRIM("g N                  "), iim,jjm, hist_hori_id, &
+!!$            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+            &               nvm,1,nvm, hist_PFTaxis_id,32, t_max(1), dt, hist_dt)
+       !+++++++++++
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MAI       "), &
+            &               TRIM("Mean annual increment "), &
+            &               TRIM("m^3/m^2/year "), iim, jjm, hist_hori_id, &
+            &               nvm, 1, nvm, hist_PFTaxis_id, 32, ave(10), dt,hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("PAI       "), &
+            &               TRIM("Period annual increment "), &
+            &               TRIM("m^3/m^2/year "), iim, jjm, hist_hori_id, &
+            &               nvm, 1, nvm, hist_PFTaxis_id, 32, ave(10), dt,hist_dt)
+       !+++CHECK+++
+       ! The function once(10) did no longer work
+       ! used ave(10) as an alternative
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ROTATION_N "), &
+            &               TRIM("Rotation number "), &
+            &               TRIM("- "), iim, jjm, hist_hori_id, &
+            &               nvm, 1, nvm, hist_PFTaxis_id, 32, ave(10), dt,hist_dt)
+       !+++++++++++
+
+       ! Relative density - used in forest management
+       CALL histdef (hist_id_stom, &
+            &               TRIM("RDI                 "), &
+            &               TRIM("Relative density index"), &
+            &               TRIM("-"), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("RDI_TARGET_UPPER    "), &
+            &               TRIM("Upper limit of RDI  "), &
+            &               TRIM("-"), iim,jjm, hist_hori_id,&
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("RDI_TARGET_LOWER    "), &
+            &               TRIM("Lower limit of RDI  "), &
+            &               TRIM("-"), iim,jjm,hist_hori_id,&
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LAST_CUT "), &
+            &               TRIM("Number of years since last human intervention"), &
+            &               TRIM("years "), iim, jjm, hist_hori_id, &
+            &               nvm, 1, nvm, hist_PFTaxis_id, 32, ave(10), dt,hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HARVEST_TYPE         "), &
+            &               TRIM("Management type"), &
+            &               TRIM("scale defined in constantes"), iim,jjm,hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HARVEST_CUT         "), &
+            &               TRIM("Harvest type of cutting"), &
+            &               TRIM("scale defined in constantes"), iim,jjm,hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HARVEST_AREA        "), &
+            &               TRIM("Harvest area"), &
+            &               TRIM("m^2                 "), iim,jjm, hist_hori_id,&
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Dynamic diameter threshold for allocation scheme
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SIGMA              "), &
+            &               TRIM("Circumference threshold for individual growth"), &
+            &               TRIM("m                  "), iim, jjm, hist_hori_id,&
+            &               nvm, 1, nvm, hist_PFTaxis_id,32, ave(3), dt,hist_dt)
+
+       ! Dynamic allocation variable
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GAMMA              "), &
+            &               TRIM("Slope for individual growth"), &
+            &               TRIM("-                  "), iim, jjm, hist_hori_id,&
+            &               nvm, 1, nvm, hist_PFTaxis_id, 32, ave(3), dt,hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FOREST_MANAGED "), &
+            &               TRIM("Forest management flag "), &
+            &               TRIM("- "), iim, jjm, hist_hori_id, &
+            &               nvm, 1, nvm, hist_PFTaxis_id, 32, ave(2), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTER_RAKE_FRAC "), &
+            &               TRIM("Relative amount of the litter removed from forests "), &
+            &               TRIM("- "), iim, jjm, hist_hori_id, &
+            &               nvm, 1, nvm, hist_PFTaxis_id, 32, ave(2), dt, hist_dt)
+
+       DO icir=1,ncirc
+
+          ! trees per diameter class
+          WRITE (var_name,"('CCN_',i3.3)") icir
+          CALL histdef (hist_id_stom, &
+               var_name, &
+               TRIM("Number of trees in a circ class                             "), &
+               TRIM("-                   "), iim,jjm, hist_hori_id, &
+               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+          ! Basal area per diameter class
+          WRITE (var_name,"('CCBA_',i3.3)") icir
+          CALL histdef (hist_id_stom, &
+               var_name, &
+               TRIM("Basal area of a trees in a circ class                       "), &
+               TRIM("-                   "), iim,jjm, hist_hori_id, &
+               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+          ! Change in basal area per diameter class
+          WRITE (var_name,"('CCDELTABA_',i3.3)") icir
+          CALL histdef (hist_id_stom, &
+               var_name, &
+               TRIM("Change in basal area of a trees in a circ class             "), &
+               TRIM("-                   "), iim,jjm, hist_hori_id, &
+               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          ! Radius increment per diameter class
+          WRITE (var_name,"('CCTRW_',i3.3)") icir
+          CALL histdef (hist_id_stom, &
+               var_name, &
+               TRIM("Change in radius of trunk in a circ class"), &
+               TRIM("-                   "), iim,jjm, hist_hori_id, &
+               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)   
+          ! Height of trees per diameter class
+          WRITE (var_name,"('CCH_',i3.3)") icir
+          CALL histdef (hist_id_stom, &
+               var_name, &
+               TRIM("Height of trees in a circ class"), &
+               TRIM("-                   "), iim,jjm, hist_hori_id, &
+               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ENDDO
+
+       ! Leaf Area Index per level 
+       ! I want to write this out as a function of canopy level
+       ! and not PFT, since it will make for easier plotting
+       DO ivm=1,nvm
+
+          WRITE(var_name,'(A,I3.3)') 'LAI_PER_LEVEL_',ivm
+          CALL histdef (hist_id_stom, &
+               &               TRIM(var_name), &
+               &               TRIM("Leaf Area Index per level"), &
+               &               TRIM("m^2 m^{-2}       "), iim,jjm, hist_hori_id,&
+               &               nlevels_tot,1,nlevels_tot, canx_tot_stom_id, 32,ave(2), &
+               &               dt, hist_dt)
+
+          WRITE(var_name,'(A,I3.3)') 'CLEVEL_HEIGHT_',ivm
+          CALL histdef (hist_id_stom, &
+               &               TRIM(var_name), &
+               &               TRIM("Physical height of each canopy level abovethe soil "), &
+               &               TRIM("m                "), iim,jjm, hist_hori_id,&
+               &               nlevels_tot,1,nlevels_tot, canx_tot_stom_id, 32,ave(2), &
+               &               dt, hist_dt)
+
+       ENDDO
+        
+       IF(ok_windthrow) THEN
+       !++++++++++++++++++++++++++++++++++++
+       ! YC put the following variable here for windthrow module
+       !++++++++++++++++++++++++++++++++++++
+
+       ! Critical Wind Speed CWS per diameter class
+       DO icir = 1, ncirc
+
+           ! CWS of further area
+           WRITE (var_name,"('CWS_FURTHER_',i3.3)") icir
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Critial wind speed of further area in a circ class               "), &
+                TRIM("m/s                   "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+           ! CWS of closer area 
+           WRITE (var_name,"('CWS_CLOSER_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Critial wind speed of closer area in a circ class               "), &
+                TRIM("m/s                   "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+ 
+           ! CWS of closer area for stem breakage 
+           WRITE (var_name,"('CWS_CLOSER_BK_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Critial wind speed for stem break of closer area in a circ class               "), &
+                TRIM("m/s                   "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+ 
+           ! CWS of closer area for overturning
+           WRITE (var_name,"('CWS_CLOSER_OV_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Critial wind speed for overturning of closer area in a circ class               "), &
+                TRIM("m/s                   "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+ 
+           ! CWS of further  area for stem breakage 
+           WRITE (var_name,"('CWS_FURTHER_BK_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Critial wind speed for stem break of further area in a circ class               "), &
+                TRIM("m/s                   "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+ 
+           ! CWS of further area for overturning
+           WRITE (var_name,"('CWS_FURTHER_OV_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Critial wind speed for overturning of further area in a circ class               "), &
+                TRIM("m/s                   "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+ 
+           ! CWS of closer area for stem breakage at tree top
+           WRITE (var_name,"('CWS_TOP_CLO_BK_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Critial wind speed at tree top for stem break of closer area in a circ class     "), &
+                TRIM("m/s                   "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+ 
+           ! CWS of closer area for overturning at tree top 
+           WRITE (var_name,"('CWS_TOP_CLO_OV_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Critial wind speed at tree top for overturning of closer area in a circ class    "), &
+                TRIM("m/s                   "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+ 
+           ! CWS of further  area for stem breakage at tree top
+           WRITE (var_name,"('CWS_TOP_FUR_BK_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Critial wind speed at tree top for stem break of further area in a circ class    "), &
+                TRIM("m/s                   "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+ 
+           ! CWS of further area for overturning at tree top 
+           WRITE (var_name,"('CWS_TOP_FUR_OV_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Critial wind speed at tree top for overturning of further area in a circ class   "), &
+                TRIM("m/s                   "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+      
+           ! Stand spacing and tree height ratio
+           WRITE (var_name,"('D_H_RATIO_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Stand spacing and tree height ratio               "), &
+                TRIM("-                   "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          
+           ! MEAN HEIGHT in a diameter class
+           WRITE (var_name,"('MEAN_HEIGHT_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Mean tree height in a diameter class            "), &
+                TRIM("m                   "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+           ! MEAN DBH in a diameter class
+           WRITE (var_name,"('MEAN_DBH_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Mean DBH in a diameter class               "), &
+                TRIM("m                   "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+           ! Density of virtual individuals     
+           WRITE (var_name,"('V_IND_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Density of virtual individuals in a diameter class      "), &
+                TRIM("1/ m^2              "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+           ! Gustiness for closer area      
+           WRITE (var_name,"('G_CLOSER_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Gustiness for closer area in a diameter class      "), &
+                TRIM("-              "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+           ! Gustiness for further area      
+           WRITE (var_name,"('G_FURTHER_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Gustiness for further area in a diameter class      "), &
+                TRIM("-              "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+         
+           ! Stem mass       
+           WRITE (var_name,"('STEM_MASS_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("Stem mass of the tree in a diameter class      "), &
+                TRIM("Kg/ tree             "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+          ! roughness length
+           WRITE (var_name,"('WIND_Z0_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("roughness length for windfall module calculation "), &
+                TRIM("m             "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+
+          ! displacement height 
+           WRITE (var_name,"('WIND_D_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("displacement height for windfall module calculation "), &
+                TRIM("m             "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+ 
+          ! canopy depth
+           WRITE (var_name,"('CANOPY_DEPTH_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("canopy depth in windfall module equals crown diameter "), &
+                TRIM("m             "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+ 
+          ! tree heights from edge
+           WRITE (var_name,"('TREE_H_EDGE_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("distance of forest edge divide to tree height "), &
+                TRIM("unitless      "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+ 
+          ! mean gap factor 
+           WRITE (var_name,"('MEAN_GAP_F_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("mean gap factor calculated by windfall module  "), &
+                TRIM("unitless             "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+   
+          ! gap size 
+           WRITE (var_name,"('GAP_SIZE_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("gap size calculated based on previous five year harvest area  "), &
+                TRIM("m             "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+         ! edge factor 
+           WRITE (var_name,"('EDGE_FACTOR_',i3.3)") icir 
+           CALL histdef (hist_id_stom, &
+                var_name, &
+                TRIM("edge factor for the gustiness calculation in the forest edge"), &
+                TRIM("unitless             "), iim,jjm, hist_hori_id, &
+                nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+         
+          ! maximum overturning moment 
+            WRITE (var_name,"('MAX_OV_MOMENT_',i3.3)") icir 
+            CALL histdef (hist_id_stom, &
+                 var_name, &
+                 TRIM("maximum overturning moment"), &
+                 TRIM("N-m                 "), iim,jjm, hist_hori_id, &
+                 nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+         
+          ! maximum breakage moment 
+            WRITE (var_name,"('MAX_BK_MOMENT_',i3.3)") icir 
+            CALL histdef (hist_id_stom, &
+                 var_name, &
+                 TRIM("maximum breakage moment"), &
+                 TRIM("N-M             "), iim,jjm, hist_hori_id, &
+                 nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+         END DO
+         
+         ! Harvest area in previous five years  
+         DO iyear= 1,wind_years
+            WRITE(var_name,"('HARVEST_5Y_',i3.3)") iyear 
+            CALL histdef (hist_id_stom, &
+                & var_name, &
+                & TRIM("Harvest area in previous nth year "), &
+                & TRIM("m^2                 "), iim,jjm,hist_hori_id, &
+                & nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt,hist_dt)
+         ENDDO 
+
+          ! Daily Maximum Wind Speed
+          CALL histdef (hist_id_stom, &
+               'DAILY_MAX_WIND',&
+               TRIM("Daily maximum wind speed               "), &
+               TRIM("m/s                   "), iim,jjm, hist_hori_id, &
+               1,1,1,-99,32, ave(1), dt, hist_dt)
+       ENDIF
+
+      
+       IF(ok_ncycle) THEN
+          CALL histdef (hist_id_stom, &
+               &               TRIM("N_UPTAKE_NH4        "), &
+               &               TRIM("plant nitrogen uptake                             "), &
+               &               TRIM("gNH4-N/m**2/day         "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          ! nitrogen uptake of the plant
+          CALL histdef (hist_id_stom, &
+               &               TRIM("N_UPTAKE_NO3        "), &
+               &               TRIM("plant nitrogen uptake                             "), &
+               &               TRIM("gNO3-N/m**2/day     "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          ! nitrogen mineralisation rate in the field
+          CALL histdef (hist_id_stom, &
+               &               TRIM("N_MINERALISATION    "), &
+               &               TRIM("nitrogen mineralised                              "), &
+               &               TRIM("gNH4-N/m**2/day     "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          ! inorganic nitrogen in the soil
+          CALL histdef (hist_id_stom, &
+               &               TRIM("SOIL_NH4            "), &
+               &               TRIM("soil ammonium concentration                       "), &
+               &               TRIM("gNH4-N/m**2         "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+               &               TRIM("SOIL_NO3            "), &
+               &               TRIM("soil nitrate concentration                        "), &
+               &               TRIM("gNO3-N/m**2         "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+               &               TRIM("SOIL_NOX            "), &
+               &               TRIM("soil NOx concentration                            "), &
+               &               TRIM("gNOx-N/m**2         "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+               &               TRIM("SOIL_N2O            "), &
+               &               TRIM("soil nitrous oxide concentration                  "), &
+               &               TRIM("gN2O-N/m**2         "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+               &               TRIM("SOIL_N2             "), &
+               &               TRIM("soil dinitrogen concentration                     "), &
+               &               TRIM("gN2-N/m**2          "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+          ! oxigen concentration in the soil 
+          CALL histdef (hist_id_stom, &
+               &               TRIM("SOIL_P_OX           "), &
+               &               TRIM("soil oxigen concentration (hPa)                   "), &
+               &               TRIM("hPaO2               "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(8), dt, hist_dt)
+          ! bacterial population in the soil 
+          CALL histdef (hist_id_stom, &
+               &               TRIM("BACT                "), &
+               &               TRIM("soil bacterial population                   "), &
+               &               TRIM("gC/m**2               "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(8), dt, hist_dt)
+          ! nitrogen emissions
+          CALL histdef (hist_id_stom, &
+               &               TRIM("NH3_EMISSION        "), &
+               &               TRIM("ammonia emitted to atmosphere                     "), &
+               &               TRIM("gNH3-N/m**2/day     "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+               &               TRIM("NOX_EMISSION        "), &
+               &               TRIM("nitric oxides emitted to the atmosphere           "), &
+               &               TRIM("gNOx-N/m**2/day     "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+               &               TRIM("N2O_EMISSION        "), &
+               &               TRIM("nitrous oxide emitted to the atmosphere           "), &
+               &               TRIM("gN2O-N/m**2/day     "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+               &               TRIM("N2_EMISSION         "), &
+               &               TRIM("nitrogen emitted to the atmosphere                "), &
+               &               TRIM("gN2-N/m**2/day      "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          ! leaching
+          CALL histdef (hist_id_stom, &
+               &               TRIM("NH4_LEACHING        "), &
+               &               TRIM("ammonium leached below root zone                  "), &
+               &               TRIM("gNH4-N/m**2/day     "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+               &               TRIM("NO3_LEACHING        "), &
+               &               TRIM("nitrate leached below root zone                   "), &
+               &               TRIM("gNO3-N/m**2/day     "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+   !       CALL histdef (hist_id_stom, &
+   !            &               TRIM("DOC_LEACHING        "), &
+   !            &               TRIM("dissolved organic carbon leached                  "), &
+   !            &               TRIM("gC/m**2/day         "), iim,jjm, hist_hori_id, &
+   !            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+   !       CALL histdef (hist_id_stom, &
+   !            &               TRIM("DON_LEACHING        "), &
+   !            &               TRIM("dissolved organic nitrogen leached                "), &
+   !            &               TRIM("gN/m**2/day         "), iim,jjm, hist_hori_id, &
+   !            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+               &               TRIM("NITRIFICATION      "), &
+               &               TRIM("oxidation of NH4                                  "), &
+               &               TRIM("gN/m**2/day         "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+               &               TRIM("DENITRIFICATION    "), &
+               &               TRIM("reduction of NO3                                  "), &
+               &               TRIM("gN/m**2/day         "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+               &               TRIM("NHX_DEPOSITION       "), &
+               &               TRIM("nitrogen added from deposition of NHx      "), &
+               &               TRIM("gN/m**2/day         "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(2), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+               &               TRIM("NOX_DEPOSITION       "), &
+               &               TRIM("nitrogen added from deposition of NOX      "), &
+               &               TRIM("gN/m**2/day         "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(2), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+           &               TRIM("BNF                "), &
+           &               TRIM("nitrogen added from biological N fixatio n        "), &
+           &               TRIM("gN/m**2/day         "), iim,jjm, hist_hori_id, &
+           &               1,1,1, -99,32, ave(2), dt, hist_dt)
+          CALL histdef (hist_id_stom, &
+               &               TRIM("N_FERTILISER       "), &
+               &               TRIM("nitrogen added from nitrogen fertiliser appl.     "), &
+               &               TRIM("gN/m**2/day         "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(2), dt, hist_dt)
+   
+
+          CALL histdef (hist_id_stom, &
+               &               TRIM("N_TAKEN       "), &
+               &               TRIM("nitrogen that comes virtually in the ecosystem    "), &
+               &               TRIM("gN/day/m^2/pft     "), iim,jjm, hist_hori_id, &
+               &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+          
+       ENDIF
+    ENDIF
+
+  END SUBROUTINE ioipslctrl_histstom
+
+!! ================================================================================================================================
+!! SUBROUTINE    : ioipslctrl_histstomipcc
+!!
+!>\BRIEF	 This subroutine initialize the IOIPSL stomate second output file (ipcc file)
+!! 
+!! DESCRIPTION   : This subroutine initialize the IOIPSL stomate second output file named stomate_ipcc_history.nc(default name).
+!!                 This subroutine was previously called stom_IPCC_define_history and located in module intersurf.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE ioipslctrl_histstomipcc( &
+       hist_id_stom_IPCC, nvm, iim, jjm, dt, &
+       hist_dt, hist_hori_id, hist_PFTaxis_id)
+    ! deforestation axis added as arguments
+
+    !---------------------------------------------------------------------
+    !- Tell ioipsl which variables are to be written
+    !- and on which grid they are defined
+    !---------------------------------------------------------------------
+    IMPLICIT NONE
+    !-
+    !- Input
+    !-
+    !- File id
+    INTEGER(i_std),INTENT(in) :: hist_id_stom_IPCC
+    !- number of PFTs
+    INTEGER(i_std),INTENT(in) :: nvm
+    !- Domain size
+    INTEGER(i_std),INTENT(in) :: iim, jjm
+    !- Time step of STOMATE (seconds)
+    REAL(r_std),INTENT(in)    :: dt
+    !- Time step of history file (s)
+    REAL(r_std),INTENT(in)    :: hist_dt
+    !- id horizontal grid
+    INTEGER(i_std),INTENT(in) :: hist_hori_id
+    !- id of PFT axis
+    INTEGER(i_std),INTENT(in) :: hist_PFTaxis_id
+    !-
+    !- 1 local
+    !-
+    !- Character strings to define operations for histdef
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: ave
+
+    !=====================================================================
+    !- 1 define operations
+    !=====================================================================
+    ave(1) =  'ave(scatter(X))'
+    !=====================================================================
+    !- 2 surface fields (2d)
+    !=====================================================================
+    ! Carbon in Vegetation
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cVeg"), &
+         &               TRIM("Carbon in Vegetation"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Litter Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cLitter"), &
+         &               TRIM("Carbon in Litter Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Soil Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cSoil"), &
+         &               TRIM("Carbon in Soil Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Products of Land Use Change
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cProduct"), &
+         &               TRIM("Carbon in Products of Land Use Change"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon Mass Variation
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cMassVariation"), &
+         &               TRIM("Terrestrial Carbon Mass Variation"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Leaf Area Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("lai"), &
+         &               TRIM("Leaf Area Fraction"), &
+         &               TRIM("1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Gross Primary Production
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("gpp"), &
+         &               TRIM("Gross Primary Production"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Autotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("ra"), &
+         &               TRIM("Autotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Net Primary Production
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("npp"), &
+         &               TRIM("Net Primary Production"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Heterotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("rh"), &
+         &               TRIM("Heterotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Emission from Fire
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fFire"), &
+         &               TRIM("CO2 Emission from Fire"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux to Atmosphere from Crop Harvesting
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fHarvest"), &
+         &               TRIM("CO2 Flux to Atmosphere from Crop Harvesting"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux to Atmosphere from Land Use Change
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fLuc"), &
+         &               TRIM("CO2 Flux to Atmosphere from Land Use Change"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Net Biospheric Production
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nbp"), &
+         &               TRIM("Net Biospheric Production"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Total Carbon Flux from Vegetation to Litter
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fVegLitter"), &
+         &               TRIM("Total Carbon Flux from Vegetation to Litter"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Total Carbon Flux from Litter to Soil
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fLitterSoil"), &
+         &               TRIM("Total Carbon Flux from Litter to Soil"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! Carbon in Leaves
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cLeaf"), &
+         &               TRIM("Carbon in Leaves"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Wood
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cWood"), &
+         &               TRIM("Carbon in Wood"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Roots
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cRoot"), &
+         &               TRIM("Carbon in Roots"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Other Living Compartments
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cMisc"), &
+         &               TRIM("Carbon in Other Living Compartments"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! Carbon in Above-Ground Litter
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cLitterAbove"), &
+         &               TRIM("Carbon in Above-Ground Litter"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Below-Ground Litter
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cLitterBelow"), &
+         &               TRIM("Carbon in Below-Ground Litter"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Fast Soil Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cSoilFast"), &
+         &               TRIM("Carbon in Fast Soil Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Medium Soil Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cSoilMedium"), &
+         &               TRIM("Carbon in Medium Soil Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Slow Soil Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cSoilSlow"), &
+         &               TRIM("Carbon in Slow Soil Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    !- 3 PFT: 3rd dimension
+    ! Fractional Land Cover of PFT
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("landCoverFrac"), &
+         &               TRIM("Fractional Land Cover of PFT"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+
+    ! Total Primary Deciduous Tree Cover Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("treeFracPrimDec"), &
+         &               TRIM("Total Primary Deciduous Tree Cover Fraction"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! Total Primary Evergreen Tree Cover Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("treeFracPrimEver"), &
+         &               TRIM("Total Primary Evergreen Tree Cover Fraction"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! Total C3 PFT Cover Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("c3PftFrac"), &
+         &               TRIM("Total C3 PFT Cover Fraction"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Total C4 PFT Cover Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("c4PftFrac"), &
+         &               TRIM("Total C4 PFT Cover Fraction"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Growth Autotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("rGrowth"), &
+         &               TRIM("Growth Autotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Maintenance Autotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("rMaint"), &
+         &               TRIM("Maintenance Autotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux from Atmosphere due to NPP Allocation to Leaf
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nppLeaf"), &
+         &               TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Leaf"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux from Atmosphere due to NPP Allocation to Wood
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nppWood"), &
+         &               TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Wood"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux from Atmosphere due to NPP Allocation to Root
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nppRoot"), &
+         &               TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Root"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity on Land.
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nep"), &
+         &               TRIM("Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity."), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    CALL histdef(hist_id_stom_IPCC, 'RESOLUTION_X', 'E-W resolution', 'm', &
+         & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+    CALL histdef(hist_id_stom_IPCC, 'RESOLUTION_Y', 'N-S resolution', 'm', &
+         & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+    CALL histdef(hist_id_stom_IPCC, 'CONTFRAC', 'Continental fraction', '1', &
+         & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+    CALL histdef(hist_id_stom_IPCC, 'Areas', 'Mesh areas', 'm2', &
+         & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+
+  END SUBROUTINE ioipslctrl_histstomipcc
+
+!! ================================================================================================================================
+!! SUBROUTINE    : ioipslctrl_restini
+!!
+!>\BRIEF	 This subroutine initialize the restart files in ORCHDIEE. 
+!! 
+!! DESCRIPTION   : This subroutine initialize restart files in ORCHIDEE. IOIPSL is used for manipulating the restart files. 
+!!                 This subroutine was previously called intsurf_restart and located in module intersurf.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE ioipslctrl_restini(istp, date0, dt, rest_id, rest_id_stom, itau_offset, date0_shifted)
+
+    USE mod_orchidee_para
+    !
+    !  This subroutine initialized the restart file for the land-surface scheme
+    !
+    IMPLICIT NONE
+    !
+    INTEGER(i_std), INTENT(in)                  :: istp      !! Time step of the restart file
+    REAL(r_std)                                 :: date0     !! The date at which itau = 0
+    REAL(r_std)                                 :: dt        !! Time step
+    INTEGER(i_std), INTENT(out)                 :: rest_id, rest_id_stom   !! ID of the restart file
+    INTEGER(i_std), INTENT(out)                 :: itau_offset
+    REAL(r_std), INTENT(out)                    :: date0_shifted
+
+
+    !  LOCAL
+    !
+    REAL(r_std)                 :: dt_rest, date0_rest
+    INTEGER(i_std)              :: itau_dep
+    INTEGER(i_std),PARAMETER    :: llm=1
+    REAL(r_std), DIMENSION(llm) :: lev
+    LOGICAL, PARAMETER          :: overwrite_time=.TRUE. !! Always override the date from the restart files for SECHIBA and STOMATE. 
+                                                         !! The date is taken from the gcm or from the driver restart file. 
+    REAL(r_std)                 :: in_julian, rest_julian
+    INTEGER(i_std)              :: yy, mm, dd
+    REAL(r_std)                 :: ss
+    !
+    !Config Key   = SECHIBA_restart_in
+    !Config Desc  = Name of restart to READ for initial conditions
+    !Config If    = OK_SECHIBA 
+    !Config Def   = NONE
+    !Config Help  = This is the name of the file which will be opened
+    !Config         to extract the initial values of all prognostic
+    !Config         values of the model. This has to be a netCDF file.
+    !Config         Not truly COADS compliant. NONE will mean that
+    !Config         no restart file is to be expected.
+    !Config Units = [FILE]
+!-
+    CALL getin_p('SECHIBA_restart_in',restname_in)
+    WRITE(numout,*) 'INPUT RESTART_FILE', restname_in
+    !-
+    !Config Key   = SECHIBA_rest_out
+    !Config Desc  = Name of restart files to be created by SECHIBA
+    !Config If    = OK_SECHIBA
+    !Config Def   = sechiba_rest_out.nc
+    !Config Help  = This variable give the name for
+    !Config         the restart files. The restart software within
+    !Config         IOIPSL will add .nc if needed.
+    !Config Units = [FILE]
+    !
+    CALL getin_p('SECHIBA_rest_out', restname_out)
+ 
+    lev(:) = zero
+    itau_dep = istp
+    in_julian = itau2date(istp, date0, dt)
+    date0_rest = date0
+    dt_rest = dt
+    !
+    IF (is_root_prc) THEN
+       CALL restini( restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
+            &  restname_out, itau_dep, date0_rest, dt_rest, rest_id, overwrite_time)
+    ELSE
+       rest_id=0
+    ENDIF
+    CALL bcast (itau_dep)
+    CALL bcast (date0_rest)
+    CALL bcast (dt_rest)
+    !
+    !  itau_dep of SECHIBA is phased with the GCM if needed
+    !
+    rest_julian = itau2date(itau_dep, date0_rest, dt_rest)
+    !
+    IF ( ABS( in_julian - rest_julian) .GT. dt/one_day .AND. .NOT. OFF_LINE_MODE ) THEN
+       WRITE(numout,*) 'The SECHIBA restart is not for the same timestep as the GCM,'
+       WRITE(numout,*) 'the two are synchronized. The land-surface conditions can not impose'
+       WRITE(numout,*) 'the chronology of the simulation.'
+       WRITE(numout,*) 'Time step of the GCM :', istp, 'Julian day : ', in_julian
+       CALL ju2ymds(in_julian, yy, mm, dd, ss)
+       WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
+       WRITE(numout,*) 'Time step of SECHIBA :', itau_dep, 'Julian day : ', rest_julian
+       CALL ju2ymds(rest_julian, yy, mm, dd, ss)
+       WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
+       
+       itau_offset = itau_dep - istp
+       date0_shifted = date0 - itau_offset*dt/one_day
+       
+       WRITE(numout,*) 'The new starting date is :', date0_shifted
+       CALL ju2ymds(date0_shifted, yy, mm, dd, ss)
+       WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
+    ELSE
+       itau_offset = 0
+       date0_shifted = date0
+    ENDIF
+    !
+!!!    CALL ioconf_startdate(date0_shifted)
+    !
+    !=====================================================================
+    !- 1.5 Restart file for STOMATE
+    !=====================================================================
+    IF ( ok_stomate ) THEN 
+       !-
+       ! STOMATE IS ACTIVATED
+       !-
+       !Config Key   = STOMATE_RESTART_FILEIN
+       !Config Desc  = Name of restart to READ for initial conditions of STOMATE
+       !Config If    = STOMATE_OK_STOMATE
+       !Config Def   = NONE
+       !Config Help  = This is the name of the file which will be opened
+       !Config         to extract the initial values of all prognostic
+       !Config         values of STOMATE.
+       !Config Units = [FILE]
+       !-
+       CALL getin_p('STOMATE_RESTART_FILEIN',stom_restname_in)
+       WRITE(numout,*) 'STOMATE INPUT RESTART_FILE', stom_restname_in
+       !-
+       !Config Key   = STOMATE_RESTART_FILEOUT
+       !Config Desc  = Name of restart files to be created by STOMATE
+       !Config If    = STOMATE_OK_STOMATE
+       !Config Def   = stomate_rest_out.nc
+       !Config Help  = This is the name of the file which will be opened
+       !Config         to write the final values of all prognostic values
+       !Config         of STOMATE.
+       !Config Units = [FILE]
+       !-
+       CALL getin_p('STOMATE_RESTART_FILEOUT', stom_restname_out)
+       WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE', stom_restname_out
+       !-
+
+       IF (is_root_prc) THEN
+         CALL restini (stom_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
+            &  stom_restname_out, itau_dep, date0_rest, dt_rest, rest_id_stom, overwrite_time)
+       ELSE
+         rest_id_stom=0
+       ENDIF
+       CALL bcast (itau_dep)
+       CALL bcast (date0_rest)
+       CALL bcast (dt_rest)
+       !-
+    ENDIF
+
+  END SUBROUTINE ioipslctrl_restini
+
+END MODULE ioipslctrl
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/qsat_moisture.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/qsat_moisture.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/qsat_moisture.f90	(revision 6412)
@@ -0,0 +1,1214 @@
+! =================================================================================================================================
+! MODULE 	: qsat_moisture
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         "qsat_moisture" module contains public tools functions like qsat, dev_qsat.   
+!!
+!!\n DESCRIPTION: This module is the result of the splitting of constantes_veg.\n
+!!                As the subroutines qsatcalc, dev_qsatcalc are used only by enerbil and diffuco, they are part of SECHIBA 
+!!                component. 
+!!
+!! REFERENCE(S)	: 
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE qsat_moisture
+
+  USE defprec
+  USE constantes
+  USE IOIPSL
+  USE constantes_soil 
+
+  IMPLICIT NONE
+  PRIVATE
+  PUBLIC qsatcalc, dev_qsatcalc
+  PUBLIC snow3lhold_2d,  snow3lhold_1d,  snow3lhold_0d
+  PUBLIC snow3lheat_2d,  snow3lheat_1d
+  PUBLIC snow3lscap_2d,  snow3lscap_1d
+  PUBLIC snow3ltemp_2d,  snow3ltemp_1d
+  PUBLIC snow3lgrain_2d, snow3lgrain_1d, snow3lgrain_0d
+  PUBLIC snow3lliq_2d,   snow3lliq_1d
+
+
+  LOGICAL,SAVE :: l_qsat_first=.TRUE.                !! First call to qsat subroutines and functions (true/false)
+!$OMP THREADPRIVATE(l_qsat_first)
+
+
+  INTEGER(i_std),PARAMETER :: max_temp=370           !! Maximum temperature for saturated humidity (K) and also used as 
+                                                     !! the size of local array to keep saturated humidity (unitless)
+
+  INTEGER(i_std),PARAMETER :: min_temp=100           !! Minimum temperature for saturated humidity (K)
+
+  REAL(r_std),DIMENSION(max_temp),SAVE :: qsfrict    !! Array to keep water vapor pressure at saturation for each temperature level 
+                                                     !! (hPa)
+!$OMP THREADPRIVATE(qsfrict)
+
+  CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: qsatcalc
+!! 
+!>\BRIEF          This routine calculates the saturated humidity using the pressure
+!!                and the temperature for all pixels. 
+!!
+!! DESCRIPTION : This routine interpolates qsat between temperatures by the following formula :
+!!               \latexonly
+!!               \input{qsatcalc.tex}
+!!               \endlatexonly
+!!               \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S) : qsat_out
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+    SUBROUTINE qsatcalc (kjpindex,temp_in,pres_in,qsat_out)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration
+      
+      !! 0.1 Input variables
+      
+      INTEGER(i_std),INTENT(in) :: kjpindex                   !! Domain size (unitless)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: temp_in  !! Temperature in degre Kelvin (K)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: pres_in  !! Pressure (hPa)
+      
+      !! 0.2 Output variables 
+      
+      REAL(r_std),DIMENSION(kjpindex),INTENT(out) :: qsat_out !! Saturated humidity at the surface (kg of water/kg of air)
+      
+      !! 0.4 Local variables
+      
+      INTEGER(i_std), DIMENSION(kjpindex) :: jt               !! Temporary array stocking the truncated temperatures in Kelvin 
+                                                              !!(converted into integers)
+      INTEGER(i_std)                      :: ji               !! indices (unitless)
+      REAL(r_std),DIMENSION(kjpindex)     :: zz_a, zz_b, zz_f !! Temporary variables
+      INTEGER(i_std)                      :: nbad             !! Number of points where the temperature is too high or too low
+      INTEGER(i_std),DIMENSION(1)         :: lo               !! Temporary vector to mark the position of the highest temperature
+                                                              !! or the lowest temperature over all the pixels in jt (unitless)
+!_ ================================================================================================================================
+
+      !-
+      !! 1.Initialize qsfrict array if needed
+      !-
+      IF (l_qsat_first) THEN
+         !-
+         CALL qsfrict_init
+         l_qsat_first = .FALSE.
+         !-
+      ENDIF !(l_qsat_first)
+      
+      !-
+      !! 2. Computes qsat interpolation into two successive temperature
+      !-
+      jt = INT(temp_in(:))
+       
+      !! 2.1 Diagnostic pixels where the temperature is too high 
+      nbad = COUNT(jt(:) >= max_temp-1)
+      
+      !! When running with the 10 layer multi-layer energy budget, problems
+      ! aries here in qsatcalc. This can result in NaN that propergates through
+      ! to other variable. Therefore, instead of just giving a warning, when the
+      ! temperature is incorrect in qsatcal, we will now let the model crash. The
+      ! problems we have with mleb and qsatcalc is most likely caused by the
+      ! fact that we are not running with tall trees (it should run fine with
+      ! tall trees). Thus, once we activate the mleb 10 layer agian, we need to
+      ! look into this matter (ASL).  
+      IF (nbad > 0) THEN
+         WRITE(numout,*) ' qsatcalc: temperature too high at ', &
+              &    nbad, ' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'qsatcalc','diffuco', '', &
+                 &                     'temperature incorect.') ! Warning message
+         ELSE
+            lo = MAXLOC(temp_in(:))
+            WRITE(numout,*) &
+                 &     'Maximum temperature ( ',MAXVAL(temp_in),') found at ',lo(1)
+            WHERE (jt(:) >= max_temp-1)   jt(:) = max_temp-1
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF ! (nbad > 0)
+ 
+      
+      !! 2.2 Diagnostic pixels where the temperature is too low
+      nbad = COUNT(jt(:) <= min_temp)
+      
+      IF (nbad > 0) THEN
+         WRITE(numout,*) ' qsatcalc: temperature too low at ', &
+              &    nbad, ' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'qsatcalc','diffuco', '', &
+                 &                   'temperature incorect.') ! Warning message
+         ELSE
+            lo = MINLOC(temp_in(:))
+            WRITE(numout,*) &
+                 &     'Minimum temperature ( ',MINVAL(temp_in),') found at ',lo(1)
+            WHERE (jt(:) <= min_temp)   jt(:) = min_temp
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF! (nbad > 0)
+ 
+      !! 2.3 Temporary variables needed for interpolation
+      DO ji = 1, kjpindex ! Loop over # pixels
+         
+         zz_f(ji) = temp_in(ji)-FLOAT(jt(ji))
+         zz_a(ji) = qsfrict(jt(ji))
+         zz_b(ji) = qsfrict(jt(ji)+1)
+         
+      ENDDO ! Loop over # pixels
+      
+      !-
+      !! 3. Interpolation between these two values
+      !-
+      DO ji = 1, kjpindex ! Loop over # pixels
+         
+         qsat_out(ji) = ((zz_b(ji)-zz_a(ji))*zz_f(ji)+zz_a(ji))/pres_in(ji)
+         
+      ENDDO  ! Loop over # pixels
+
+
+    END SUBROUTINE qsatcalc
+ 
+!! ================================================================================================================================
+!! FUNCTION 	: [DISPENSABLE] qsat_old
+!!
+!>\BRIEF         This function computes deviation the saturated humidity with the pressure
+!! and the temperature for a scalar. 
+!!
+!! DESCRIPTION : This routine is obsolete : replaced by the subroutine qsatcalc. \n
+!!               qsat is interpolated by : \n
+!!               \latexonly
+!!               \input{qsat.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): None\n
+!!
+!! RETURN VALUE : qsat_result
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================    
+
+    FUNCTION qsat_old (temp_in,pres_in) RESULT (qsat_result)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration
+
+      !! 0.1 Input variables
+
+      REAL(r_std),INTENT(in) :: temp_in   !! Temperature (K)
+      REAL(r_std),INTENT(in) :: pres_in   !! Pressure    (hPa)
+
+      !! 0.2 Result
+      
+      REAL(r_std) :: qsat_result          !! Saturated humidity calculated at the surface (kg/kg)
+      
+      !! 0.4 Local variables
+      
+      INTEGER(i_std)   :: jt              !! Temporary scalar stocking the truncated temperature in Kelvin 
+                                          !! (converted into integer)
+      REAL(r_std)      :: zz_a,zz_b,zz_f  !! Temporary scalar variables      
+ 
+!_ ================================================================================================================================
+
+      !-
+      !! 1.Initialize qsfrict array if needed
+      !-
+      IF (l_qsat_first) THEN
+         !-
+         CALL qsfrict_init
+         l_qsat_first = .FALSE.
+         !-
+      ENDIF
+
+      !-
+      !! 2. Computes qsat interpolation into two successive temperatures
+      !-
+      jt = INT(temp_in)
+
+      !! 2.1 Is the temperature too high ?
+      IF (jt >= max_temp-1) THEN
+         WRITE(numout,*) &
+              &   ' We stop. temperature too BIG : ',temp_in, &
+              &   ' approximation for : ',jt
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(2,'qsat','', '',&
+                 &                   'temperature incorect.') ! Warning message
+         ELSE
+            qsat_result = 999999.
+            RETURN
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(jt >= max_temp-1)
+
+      !! 2.2 Is the temperature too low ?
+      IF (jt <= min_temp ) THEN
+         WRITE(numout,*) &
+              &   ' We stop. temperature too SMALL : ',temp_in, &
+              &   ' approximation for : ',jt
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(2,'qsat','', '',&
+                 &                   'temperature incorect.')
+         ELSE
+            qsat_result = -999999.
+            RETURN
+         ENDIF!(.NOT.diag_qsat)
+         !-
+      ENDIF !(jt <= min_temp )
+
+      !! 2.3 Temporary variables needed for interpolation
+      zz_f = temp_in-FLOAT(jt)
+      zz_a = qsfrict(jt)
+      zz_b = qsfrict(jt+1)
+
+      !! 3. Interpolates between these two values
+
+      qsat_result = ((zz_b-zz_a)*zz_f+zz_a)/pres_in
+
+
+    END FUNCTION qsat_old
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: dev_qsatcalc
+!!
+!>\BRIEF         This routine calculates the deviation of the saturated humidity qsat.
+!!
+!! DESCRIPTION : The deviation of qsat is calculated by :
+!!               \latexonly
+!!               \input{dev_qsatcalc.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S) : dev_qsat_out
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART	: None
+!!
+!! FLOWCHART    :
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_moigdd.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================ 
+
+    SUBROUTINE dev_qsatcalc (kjpindex,temp_in,pres_in,dev_qsat_out)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration
+      
+      !! 0.1 Input variables
+
+      INTEGER(i_std),INTENT(in)                   :: kjpindex       !! Domain size (unitless)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: temp_in        !! Temperature (K)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: pres_in        !! Pressure (hPa)
+
+
+      !! 0.2 Output variables 
+      
+      REAL(r_std),DIMENSION(kjpindex),INTENT(out) :: dev_qsat_out   !! Result (??units??) 
+
+      
+      !! 0.4 Local variables
+      
+      INTEGER(i_std),DIMENSION(kjpindex) :: jt                      !! Temporary array stocking the truncated temperatures
+                                                                    !! in Kelvin (converted into integers) 
+      INTEGER(i_std)                     :: ji                      !! Indice (unitless)
+      REAL(r_std),DIMENSION(kjpindex)    :: zz_a, zz_b, zz_c, zz_f  !! Temporary vector variables
+      INTEGER(i_std)                     :: nbad                    !! Number of points where the temperature is too high or too low
+
+!_ ================================================================================================================================
+
+      !-
+      !! 1.Initialize qsfrict array if needed
+      !-
+      IF (l_qsat_first) THEN
+         !-
+         CALL qsfrict_init
+         l_qsat_first = .FALSE.
+         !-
+      ENDIF
+
+      !-
+      !! 2. Compute qsat interpolation into two successive temperature
+      !-
+      jt = INT(temp_in(:)+undemi)
+      
+      !! 2.1 Pixels where the temperature is too high 
+      nbad = COUNT( jt(:) >= max_temp-1 )
+      
+      IF (nbad > 0) THEN
+         WRITE(numout,*) &
+              &   ' dev_qsatcalc: temperature too high at ',nbad,' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'dev_qsatcalc','', '', &
+                 &                   'temperature incorect.') ! Fatal error
+         ELSE
+            WHERE (jt(:) >= max_temp-1)   jt(:) = max_temp-1
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(nbad > 0)
+      
+      !! 2.2 Pixels where the temperature is too low
+      nbad = COUNT( jt(:) <= min_temp )
+      
+      IF (nbad > 0) THEN
+         WRITE(numout,*) &
+              &   ' dev_qsatcalc: temperature too low at ',nbad,' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'dev_qsatcalc', '', '',&
+                 &                   'temperature incorect.') ! Fatal error
+         ELSE
+            WHERE (jt(:) <= min_temp)   jt(:) = min_temp
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(nbad > 0)
+
+      !! 2.3 Temporary variables needed for interpolation
+      DO ji=1,kjpindex  ! Loop over # pixels
+         
+         zz_f(ji) = temp_in(ji)+undemi-FLOAT(jt(ji))
+         zz_a(ji) = qsfrict(jt(ji)-1)
+         zz_b(ji) = qsfrict(jt(ji))
+         zz_c(ji) = qsfrict(jt(ji)+1)
+         
+      ENDDO ! Loop over # pixels
+      
+      !-
+      !! 3. Interpolates between these two values
+      !-
+      DO ji = 1, kjpindex ! Loop over # pixels
+         
+         dev_qsat_out(ji) = &
+              &   ((zz_c(ji)-deux*zz_b(ji)+zz_a(ji))*(zz_f(ji)-un) + &
+              &                         zz_c(ji)-zz_b(ji))/pres_in(ji)
+         
+      ENDDO ! Loop over # pixels
+
+
+    END SUBROUTINE dev_qsatcalc
+
+!! ================================================================================================================================
+!! FUNCTION 	: [DISPENSABLE] dev_qsat_old
+!!
+!>\BRIEF         This function computes deviation of qsat. 
+!!
+!! DESCRIPTION : The deviation of qsat is calculated by :
+!!               \latexonly
+!!               \input{dev_qsat.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : dev_qsat_result
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+    FUNCTION dev_qsat_old (temp_in,pres_in) RESULT (dev_qsat_result)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration 
+   
+      !! 0.1 Input variables
+
+      REAL(r_std),INTENT(in)  :: pres_in          !! Pressure (hPa)
+      REAL(r_std),INTENT(in)  :: temp_in          !! Temperture (K)
+      
+      !! 0.2 Result
+
+      REAL(r_std) :: dev_qsat_result              !! (??units??) !!
+      
+      !! 0.4 Local variables
+
+      INTEGER(i_std)  :: jt                       !! Index (unitless)
+      REAL(r_std)     :: zz_a, zz_b, zz_c, zz_f   !! Temporary scalars   
+
+!_ ================================================================================================================================
+ 
+      !-
+      !! 1.Initialize qsfrict array if needed
+      !-
+      IF (l_qsat_first) THEN
+         !-
+         CALL qsfrict_init
+         l_qsat_first = .FALSE.
+         !-
+      ENDIF
+
+      !-
+      !! 2. computes qsat deviation interpolation
+      !!    into two successive temperature
+      !-
+      jt = INT(temp_in+undemi)
+
+      !! 2.1 Is the temperature too high ?
+      IF (jt >= max_temp-1) THEN
+         !-
+         WRITE(numout,*) &
+              &   ' We stop. temperature too HIGH : ',temp_in, &
+              &   ' approximation for : ',jt
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'dev_qsat','', '',&
+                 &                   'temperature incorect.') ! Fatal error
+         ELSE
+            dev_qsat_result = 999999.
+            RETURN
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(jt >= max_temp-1)
+      !-
+      !! 2.2 Is the temperature too low ?
+      IF (jt <= min_temp ) THEN
+         WRITE(numout,*) &
+              &   ' We stop. temperature too LOW : ',temp_in, &
+              &   ' approximation for : ',jt
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'dev_qsat','', '',&
+                 &                    'temperature incorect.')
+         ELSE
+            dev_qsat_result = -999999.
+            RETURN
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(jt <= min_temp )
+
+      !! 2.3  Temporary variables for interpolation
+      zz_f = temp_in+undemi-FLOAT(jt)
+      zz_a = qsfrict(jt-1)
+      zz_b = qsfrict(jt)
+      zz_c = qsfrict(jt+1)
+
+      !-
+      !! 3. Interpolate
+      !-
+      dev_qsat_result=((zz_c-deux*zz_b+zz_a)*(zz_f-un)+zz_c-zz_b)/pres_in
+
+    END FUNCTION dev_qsat_old
+ 
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: qsfrict_init
+!!
+!>\BRIEF         The qsfrict_init routine initialises qsfrict array to store 
+!!               precalculated values for qsat by using Goff-Gratch equations.  
+!!
+!! DESCRIPTION : This routine calculates the specific humidity qsat as a function of temperature in 
+!!               Kelvin by using the modified Goff-Gratch equations(1946): \n
+!!               \latexonly
+!!               \input{goff_gratch.tex}
+!!               \endlatexonly
+!!               qsfrict is initialized by the following formulas : \n
+!!               \latexonly
+!!               \input{qsfrict_init.tex}
+!!               \endlatexonly
+!!               These values are used by the subroutines qsatcalc, dev_qsat. \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::qsfrict
+!!
+!! REFERENCE(S)	:
+!! - Algorithme d'un ensemble de paramÃ©trisation physique (1998), 
+!! Note de Laurent Li dÃ©crivant les paramÃ©trisations physiques incluses dans le modÃšle (pdf),
+!! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques 
+!! - Goff, J. A., and S. Gratch (1946) Low-pressure properties of water from â160 to 212 Â°F, in Transactions of the
+!! American Society of Heating and Ventilating Engineers, pp 95â122, presented at the 52nd annual meeting of the
+!! American Society of Heating and Ventilating Engineers, New York, 1946.
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+    SUBROUTINE qsfrict_init
+      
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration
+      
+      !! 0.4 Local variables
+
+      INTEGER(i_std) :: ji                             !! Indice(unitless)
+      REAL(r_std)    :: zrapp,zcorr,ztemperature,zqsat !! Temporary vector variables      
+
+!_ ================================================================================================================================
+
+      !! 1. Initialisation
+      zrapp = msmlr_h2o/msmlr_air
+      zcorr = 0.00320991_r_std
+      
+      !! 2. Computes saturated humidity one time and store in qsfrict local array
+      DO ji=100,max_temp ! Loop over size(qsfrict) : each position of qsfrict matches a temperature 
+         
+         ztemperature = FLOAT(ji)
+         !-
+         IF (ztemperature < 273._r_std) THEN 
+           zqsat = zrapp*10.0_r_std**(2.07023_r_std-zcorr*ztemperature &
+                 &             -2484.896/ztemperature+3.56654*LOG10(ztemperature)) ! Equilibrium water vapor - solid
+         ELSE 
+            zqsat = zrapp*10.0**(23.8319-2948.964/ztemperature & 
+                 &              -5.028*LOG10(ztemperature) &
+                 &              -29810.16*EXP(-0.0699382*ztemperature) &
+                 &              +25.21935*EXP(-2999.924/ztemperature)) ! Equilibrium water vapor - liquid
+         ENDIF !(ztemperature < 273._r_std)
+         !-
+         qsfrict (ji) = zqsat
+         
+      ENDDO ! Loop over size(qsfrict) 
+
+      !! 3. Set to zero the non-computed values
+      qsfrict(1:100) = zero 
+      !-
+      IF (printlev>=3) WRITE (numout,*) ' qsfrict_init done'
+
+
+    END SUBROUTINE qsfrict_init
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lhold_2d
+!!
+!>\BRIEF         Calculate the maximum liquid water holding capacity of
+!!               snow layer(s)
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: PWHOLDMAX
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+    
+  FUNCTION snow3lhold_2d(PSNOWRHO,PSNOWDZ) RESULT(PWHOLDMAX)
+    
+    !! 0.1 Input variables
+    REAL(r_std), DIMENSION(:,:), INTENT(IN)                   :: PSNOWDZ    !! Snow depth
+    REAL(r_std), DIMENSION(:,:), INTENT(IN)                   :: PSNOWRHO   !! Snow density 
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PWHOLDMAX  !! Maximum Water holding capacity
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZHOLDMAXR, ZSNOWRHO
+
+
+    ! Evaluate capacity using upper density limit:
+    ZSNOWRHO(:,:) = MIN(xrhosmax, PSNOWRHO(:,:))
+
+    ! Maximum ratio of liquid to SWE:
+    ZHOLDMAXR(:,:) = xwsnowholdmax1 + (xwsnowholdmax2-xwsnowholdmax1)*                  &
+         MAX(0.,xsnowrhohold-ZSNOWRHO(:,:))/xsnowrhohold
+
+    ! Maximum liquid water holding capacity of the snow (m):
+    PWHOLDMAX(:,:) = ZHOLDMAXR(:,:)*PSNOWDZ(:,:)*ZSNOWRHO(:,:)/ph2o
+    WHERE(ZSNOWRHO(:,:) .GE. xrhosmax) PWHOLDMAX(:,:) = 0.0
+
+  END FUNCTION snow3lhold_2d
+
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lhold_1d
+!!
+!>\BRIEF         Calculate the maximum liquid water holding capacity of
+!!               snow layer(s)
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  
+  FUNCTION snow3lhold_1d(PSNOWRHO,PSNOWDZ) RESULT(PWHOLDMAX)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:), INTENT(IN)                     :: PSNOWDZ        !! Snow depth
+    REAL, DIMENSION(:), INTENT(IN)                     :: PSNOWRHO       !! Snow density
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                    :: PWHOLDMAX      !! Maximum Water holding capacity
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                    :: ZHOLDMAXR, ZSNOWRHO
+
+
+    ! Evaluate capacity using upper density limit:
+    ZSNOWRHO(:) = MIN(xrhosmax, PSNOWRHO(:))
+
+    ! Maximum ratio of liquid to SWE:
+    ZHOLDMAXR(:) = xwsnowholdmax1 + (xwsnowholdmax2-xwsnowholdmax1)*                  &
+         MAX(0.,xsnowrhohold-ZSNOWRHO(:))/xsnowrhohold
+
+    ! Maximum liquid water holding capacity of the snow (m):
+    PWHOLDMAX(:) = ZHOLDMAXR(:)*PSNOWDZ(:)*ZSNOWRHO(:)/ph2o
+
+    WHERE(ZSNOWRHO(:) .GE. xrhosmax) PWHOLDMAX(:)=0.0
+
+  END FUNCTION snow3lhold_1d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lhold_0d
+!!
+!>\BRIEF         Calculate the maximum liquid water holding capacity of
+!!               snow layer(s)
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  
+  FUNCTION snow3lhold_0d(PSNOWRHO,PSNOWDZ) RESULT(PWHOLDMAX)
+
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(IN)                     :: PSNOWRHO   !!
+    !!  Snow density
+    REAL(r_std), INTENT(IN)                     :: PSNOWDZ    !!
+    !!  Snow depth
+
+    !! 0.2 Output variables
+    REAL(r_std)                                 :: PWHOLDMAX  !!
+    !!  Maximum water holding capacity
+
+    !! 0.3 Modified variables 
+
+    !! 0.4 Local variables
+    REAL(r_std)                    :: ZHOLDMAXR, ZSNOWRHO
+
+
+    ! Evaluate capacity using upper density limit:
+    ZSNOWRHO = MIN(xrhosmax, PSNOWRHO)
+
+    ! Maximum ratio of liquid to SWE:
+    ZHOLDMAXR = xwsnowholdmax1 + (xwsnowholdmax2-xwsnowholdmax1)*&
+         & MAX(0.,xsnowrhohold-ZSNOWRHO)/xsnowrhohold
+
+    ! Maximum liquid water holding capacity of the snow (m):
+    PWHOLDMAX = ZHOLDMAXR*PSNOWDZ*ZSNOWRHO/ph2o
+
+    IF (ZSNOWRHO .GE. xrhosmax) PWHOLDMAX = 0.0
+
+  END FUNCTION snow3lhold_0d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lheat_2d
+!!
+!>\BRIEF         Compute snow heat content (J m-2) from snow mass and liquid
+!!               water content and temperature.
+!!               snow layer(s)
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  
+  FUNCTION snow3lheat_2d(PSNOWLIQ,PSNOWRHO,PSNOWDZ,PSNOWTEMP) RESULT(PSNOWHEAT)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWRHO  !! layer density           (kg m-3)
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWDZ   !! layer thickness         (m)
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWLIQ  !! liquid water content    (m)
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWTEMP !! layer temperature       (K)
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PSNOWHEAT !! heat content (enthalpy) (J m-2)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSCAP     !! snow heat capacity (J K-1 m-3)
+
+    ZSCAP(:,:)     = snow3lscap_2d(PSNOWRHO)
+
+    ! snow heat content (heat required to melt the snowpack) or enthalpy (J m-2)
+    PSNOWHEAT(:,:) = PSNOWDZ(:,:)*( ZSCAP(:,:)*(PSNOWTEMP(:,:)-tp_00)        &
+         - chalfu0*PSNOWRHO(:,:) ) + chalfu0*ph2o*PSNOWLIQ(:,:)
+
+  END FUNCTION snow3lheat_2d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lheat_1d
+!!
+!>\BRIEF         Compute snow heat content (J m-2) from snow mass and liquid
+!!               water content and temperature.
+!!               snow layer(s)
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  
+  FUNCTION snow3lheat_1d(PSNOWLIQ,PSNOWRHO,PSNOWDZ,PSNOWTEMP) RESULT(PSNOWHEAT)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWRHO  !! layer density           (kg m-3)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWDZ   !! layer thickness         (m)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWLIQ  !! liquid water content    (m)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWTEMP !! layer temperature       (K)
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: PSNOWHEAT !! heat content (enthalpy) (J m-2)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: ZSCAP     !! snow heat capacity (J K-1 m-3)
+
+
+    ZSCAP(:)     = snow3lscap_1d(PSNOWRHO)
+
+    ! snow heat content (heat required to melt the snowpack) or enthalpy (J m-2)
+    PSNOWHEAT(:) = PSNOWDZ(:)*( ZSCAP(:)*(PSNOWTEMP(:)-tp_00)                 &
+         -chalfu0*PSNOWRHO(:) ) + chalfu0*ph2o*PSNOWLIQ(:)
+
+  END FUNCTION snow3lheat_1d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lscap_2d
+!!
+!>\BRIEF         Calculate the heat capacity of a snow layer.
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : The method of Verseghy (1991), Int. J. Climat., 11, 111-133.
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lscap_2d(PSNOWRHO) RESULT(PSCAP)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWRHO    !! Snow density
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PSCAP       !! Heat capacity (J K-1 m-3)
+
+    PSCAP(:,:) = PSNOWRHO(:,:)*xci    
+
+  END FUNCTION snow3lscap_2d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lscap_1d
+!!
+!>\BRIEF         Calculate the heat capacity of a snow layer.
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : The method of Verseghy (1991), Int. J. Climat., 11, 111-133.
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lscap_1d(PSNOWRHO) RESULT(PSCAP)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWRHO    !! Snow density
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: PSCAP       !! Heat capacity (J K-1 m-3)
+
+    PSCAP(:) = PSNOWRHO(:)*xci     
+
+  END FUNCTION snow3lscap_1d
+
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3ltemp_2d
+!!
+!>\BRIEF         Diagnose snow temperature (K) from heat content (J m-2)
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3ltemp_2d(PSNOWHEAT,PSNOWRHO,PSNOWDZ) RESULT(PSNOWTEMP)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWRHO  !! layer density     (kg m-3)
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWDZ   !! layer thickness   (m)
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWHEAT !! heat content      (J m-2)
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PSNOWTEMP !! layer temperature (K)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSCAP     !! snow heat capacity (J K-1 m-3)
+
+    ZSCAP(:,:)     = snow3lscap_2d(PSNOWRHO)
+
+    PSNOWTEMP(:,:) = tp_00 + ( ((PSNOWHEAT(:,:)/PSNOWDZ(:,:))                   &
+         + chalfu0*PSNOWRHO(:,:))/ZSCAP(:,:) )
+
+    PSNOWTEMP(:,:) = MIN(tp_00, PSNOWTEMP(:,:))
+
+  END FUNCTION snow3ltemp_2d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3ltemp_1d
+!!
+!>\BRIEF         Diagnose snow temperature (K) from heat content (J m-2)
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3ltemp_1d(PSNOWHEAT,PSNOWRHO,PSNOWDZ) RESULT(PSNOWTEMP)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWRHO  !! layer density     (kg m-3)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWDZ   !! layer thickness   (m)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWHEAT !! heat content      (J m-2)
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: PSNOWTEMP !! layer temperature (K)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: ZSCAP     !! snow heat capacity (J K-1 m-3)
+
+    ZSCAP(:)     = snow3lscap_1d(PSNOWRHO)
+
+    PSNOWTEMP(:) = tp_00 + ( ((PSNOWHEAT(:)/PSNOWDZ(:))                   &
+         + chalfu0*PSNOWRHO(:))/ZSCAP(:) )
+
+    PSNOWTEMP(:) = MIN(tp_00, PSNOWTEMP(:))
+    WHERE(PSNOWTEMP(:) .LE. 100) PSNOWTEMP(:) = tp_00
+
+  END FUNCTION snow3ltemp_1d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lgrain_2d
+!!
+!>\BRIEF         Calculate the grain size (m) for initialization
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : Loth and Graf 1993 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lgrain_2d(PSNOWRHO) RESULT(PDSGRAIN)
+
+    !! 0.1 Input variables
+    REAL(r_std), DIMENSION(:,:), INTENT(IN)                   :: PSNOWRHO                   !! Snow density
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PDSGRAIN                   !! Snow grain size
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), PARAMETER                                    :: ZSNOWRAD_AGRAIN = 1.6e-4   !! (m)
+    REAL(r_std), PARAMETER                                    :: ZSNOWRAD_BGRAIN = 1.1e-13  !! (m13/kg4)
+    REAL(r_std), PARAMETER                                    :: ZDSGRAIN_MAX    = 2.796e-3 !! (m)
+
+    ! grain size in m:
+
+    PDSGRAIN(:,:) = ZSNOWRAD_AGRAIN + ZSNOWRAD_BGRAIN*(PSNOWRHO(:,:)**4)
+    PDSGRAIN(:,:) = MIN(ZDSGRAIN_MAX, PDSGRAIN(:,:))
+
+  END FUNCTION snow3lgrain_2d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lgrain_1d
+!!
+!>\BRIEF         Calculate the grain size (m) for initialization
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : Loth and Graf 1993 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lgrain_1d(PSNOWRHO) RESULT(PDSGRAIN)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:), INTENT(IN)  :: PSNOWRHO                        !! Snow density
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO)) :: PDSGRAIN                        !! Snow grain size
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, PARAMETER                       :: ZSNOWRAD_AGRAIN = 1.6e-4  !! (m)
+    REAL, PARAMETER                       :: ZSNOWRAD_BGRAIN = 1.1e-13 !! (m13/kg4)
+    REAL, PARAMETER                       :: ZDSGRAIN_MAX    = 2.796e-3!! (m)
+
+    ! grain size in m:
+
+    PDSGRAIN(:) = ZSNOWRAD_AGRAIN + ZSNOWRAD_BGRAIN*(PSNOWRHO(:)**4)
+    PDSGRAIN(:) = MIN(ZDSGRAIN_MAX, PDSGRAIN(:))
+
+  END FUNCTION snow3lgrain_1d
+
+!================================================================================================================================
+!! FUNCTION   : snow3lgrain_0d
+!!
+!>\BRIEF         Calculate the grain size (m) for initialization
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : Loth and Graf 1993 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lgrain_0d(PSNOWRHO) RESULT(PDSGRAIN)
+
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(IN)               :: PSNOWRHO                  !! Snow density
+
+    !! 0.2 Output variables
+    REAL(r_std)                           :: PDSGRAIN                  !! Snow grain size
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, PARAMETER                       :: ZSNOWRAD_AGRAIN = 1.6e-4  !! (m)
+    REAL, PARAMETER                       :: ZSNOWRAD_BGRAIN = 1.1e-13 !! (m13/kg4)
+    REAL, PARAMETER                       :: ZDSGRAIN_MAX    = 2.796e-3!! (m)
+
+    ! grain size in m:
+
+    PDSGRAIN = ZSNOWRAD_AGRAIN + ZSNOWRAD_BGRAIN*(PSNOWRHO**4)
+    PDSGRAIN = MIN(ZDSGRAIN_MAX, PDSGRAIN)
+
+  END FUNCTION snow3lgrain_0d
+
+!================================================================================================================================
+!! FUNCTION   : snow3lliq_2d
+!!
+!>\BRIEF         Diagnose snow liquid water content from temperature (K) and
+!!               heat content  (J m-2)
+!!
+!! DESCRIPTION : Diagnose snow liquid water content from temperature (K)
+!!               and heat content (J m-2). Note, need to evaluate SNOWTEMP from
+!!               SNOW3LTEMP before calling this function (i.e. using same
+!!               heat content, mass and diagnosed temperature). 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lliq_2d(PSNOWHEAT,PSNOWRHO,PSNOWDZ,PSNOWTEMP)&
+       & RESULT(PSNOWLIQ)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWRHO &
+         & !! layer density        (kg m-3)
+         REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWDZ  &
+         & !! layer thickness      (m)
+         REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWHEAT&
+         & !! heat content         (J m-2)
+         REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWTEMP&
+         & !! layer temperature    (K)
+         
+                                !! 0.2 Output variables
+         REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PSNOWLIQ &
+         & ! liquid water content (m)
+         
+                                !! 0.3 Modified variables
+         
+                                !! 0.4 Local variables
+         REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSCAP    &
+         & !! snow heat capacity (J K-1 m-3)
+         
+         ZSCAP(:,:)     = snow3lscap_2d(PSNOWRHO)
+
+    ! The result of the full heat balance equation: if the sum
+    !  equals zero,
+    ! then no liquid. If an imbalance occurs, this represents
+    !  liquid water content.
+
+    PSNOWLIQ(:,:)  = ( ((tp_00-PSNOWTEMP(:,:))*ZSCAP(:,:) + chalfu0&
+         &*PSNOWRHO(:,:))*PSNOWDZ(:,:) + PSNOWHEAT(:,:) ) /(chalfu0&
+         &*ph2o)
+
+    ! just a numerical check:
+
+    PSNOWLIQ(:,:)  = MAX(0.0, PSNOWLIQ(:,:))
+
+  END FUNCTION snow3lliq_2d
+
+!================================================================================================================================
+!! FUNCTION   : snow3lliq_1d
+!!
+!>\BRIEF         Diagnose snow liquid water content from temperature (K) and
+!!               heat content  (J m-2)
+!!
+!! DESCRIPTION : Diagnose snow liquid water content from temperature (K)
+!!               and heat content (J m-2). Note, need to evaluate SNOWTEMP from
+!!               SNOW3LTEMP before calling this function (i.e. using same
+!!               heat content, mass and diagnosed temperature). 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lliq_1d(PSNOWHEAT,PSNOWRHO,PSNOWDZ,PSNOWTEMP) RESULT(PSNOWLIQ)
+    
+    !! 0.1 Input variables
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWRHO  !! layer density        (kg m-3)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWDZ   !! layer thickness      (m)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWHEAT !! heat content         (J m-2)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWTEMP !! layer temperature    (K)
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: PSNOWLIQ  !! liquid water content (m)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: ZSCAP     !! snow heat capacity (J K-1 m-3)
+
+    ZSCAP(:)     = snow3lscap_1d(PSNOWRHO)
+
+    ! The result of the full heat balance equation: if the sum equals zero,
+    ! then no liquid. If an imbalance occurs, this represents liquid water content.
+    !
+    PSNOWLIQ(:)  = ( ((tp_00-PSNOWTEMP(:))*ZSCAP(:) +                      &
+         chalfu0*PSNOWRHO(:))*PSNOWDZ(:) + PSNOWHEAT(:) )    &
+         /(chalfu0*ph2o)
+
+    ! just a numerical check:
+
+    PSNOWLIQ(:)  = MAX(0.0, PSNOWLIQ(:))
+
+  END FUNCTION snow3lliq_1d
+  
+END MODULE qsat_moisture
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/routing.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/routing.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/routing.f90	(revision 6412)
@@ -0,0 +1,8177 @@
+! =================================================================================================================================
+! MODULE       : routing
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       This module routes the water over the continents into the oceans and computes the water
+!!             stored in floodplains or taken for irrigation.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+! 
+!
+! Histoire Salee
+!---------------
+! La douce riviere
+! Sortant de son lit
+! S'est jetee ma chere
+! dans les bras mais oui
+! du beau fleuve
+!
+! L'eau coule sous les ponts
+! Et puis les flots s'emeuvent
+! - N'etes vous pas au courant ?
+! Il parait que la riviere 
+! Va devenir mer
+!                       Roland Bacri
+!
+
+
+MODULE routing
+
+  USE ioipsl   
+  USE xios_orchidee
+  USE ioipsl_para 
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE sechiba_io_p
+  USE interpol_help
+  USE grid
+  USE mod_orchidee_para
+
+
+  IMPLICIT NONE
+  PRIVATE
+  PUBLIC :: routing_main, routing_initialize, routing_finalize, routing_clear
+
+!! PARAMETERS
+  INTEGER(i_std), PARAMETER                                  :: nbasmax=5                   !! The maximum number of basins we wish to have per grid box (truncation of the model) (unitless)
+  INTEGER(i_std), SAVE                                       :: nbvmax                      !! The maximum number of basins we can handle at any time during the generation of the maps (unitless)
+!$OMP THREADPRIVATE(nbvmax)
+  REAL(r_std), SAVE                                          :: fast_tcst   = 3.0           !! Property of the fast reservoir, (day/m)
+!$OMP THREADPRIVATE(fast_tcst)
+  REAL(r_std), SAVE                                          :: slow_tcst   = 25.0          !! Property of the slow reservoir, (day/m)
+!$OMP THREADPRIVATE(slow_tcst)
+  REAL(r_std), SAVE                                          :: stream_tcst  = 0.24         !! Property of the stream reservoir, (day/m)
+!$OMP THREADPRIVATE(stream_tcst)
+  REAL(r_std), SAVE                                          :: flood_tcst  = 4.0           !! Property of the floodplains reservoir, (day/m)
+!$OMP THREADPRIVATE(flood_tcst)
+  REAL(r_std), SAVE                                          :: swamp_cst   = 0.2           !! Fraction of the river transport that flows to the swamps (unitless;0-1)
+!$OMP THREADPRIVATE(swamp_cst)
+  !
+  !  Relation between volume and fraction of floodplains
+  !
+  REAL(r_std), SAVE                                          :: beta = 2.0                  !! Parameter to fix the shape of the floodplain (>1 for convex edges, <1 for concave edges) (unitless)
+!$OMP THREADPRIVATE(beta)
+  REAL(r_std), SAVE                                          :: betap = 0.5                 !! Ratio of the basin surface intercepted by ponds and the maximum surface of ponds (unitless;0-1)
+!$OMP THREADPRIVATE(betap)
+  REAL(r_std), SAVE                                          :: floodcri = 2000.0           !! Potential height for which all the basin is flooded (mm)
+!$OMP THREADPRIVATE(floodcri)
+  !
+  !  Relation between maximum surface of ponds and basin surface, and drainage (mm/j) to the slow_res
+  !
+  REAL(r_std), PARAMETER                                     :: pond_bas = 50.0             !! [DISPENSABLE] - not used
+  REAL(r_std), SAVE                                          :: pondcri = 2000.0            !! Potential height for which all the basin is a pond (mm)
+!$OMP THREADPRIVATE(pondcri)
+  !
+  REAL(r_std), PARAMETER                                     :: maxevap_lake = 7.5/86400.   !! Maximum evaporation rate from lakes (kg/m^2/s)
+  !
+  REAL(r_std),SAVE                                           :: dt_routing                  !! Routing time step (s)
+!$OMP THREADPRIVATE(dt_routing)
+  !
+  INTEGER(i_std), SAVE                                       :: diagunit = 87               !! Diagnostic file unit (unitless)
+!$OMP THREADPRIVATE(diagunit)
+  !
+  ! Logicals to control model configuration
+  !
+  LOGICAL, SAVE                                              :: dofloodinfilt = .FALSE.     !! Logical to choose if floodplains infiltration is activated or not (true/false)
+!$OMP THREADPRIVATE(dofloodinfilt)
+  LOGICAL, SAVE                                              :: doswamps = .FALSE.          !! Logical to choose if swamps are activated or not (true/false)
+!$OMP THREADPRIVATE(doswamps)
+  LOGICAL, SAVE                                              :: doponds = .FALSE.           !! Logical to choose if ponds are activated or not (true/false)
+!$OMP THREADPRIVATE(doponds)
+  !
+  ! The variables describing the basins and their routing, need to be in the restart file.
+  !
+  INTEGER(i_std), SAVE                                       :: num_largest                 !! Number of largest river basins which should be treated as independently as rivers
+                                                                                            !! (not flow into ocean as diffusion coastal flow) (unitless)
+!$OMP THREADPRIVATE(num_largest)
+  REAL(r_std), SAVE                                          :: time_counter                !! Time counter (s)
+!$OMP THREADPRIVATE(time_counter)
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: routing_area_loc            !! Surface of basin (m^2)
+!$OMP THREADPRIVATE(routing_area_loc)
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: topo_resid_loc              !! Topographic index of the retention time (m)
+!$OMP THREADPRIVATE(topo_resid_loc)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_togrid_loc            !! Grid into which the basin flows (unitless)
+!$OMP THREADPRIVATE(route_togrid_loc)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_tobasin_loc           !! Basin in to which the water goes (unitless)
+!$OMP THREADPRIVATE(route_tobasin_loc)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_nbintobas_loc         !! Number of basin into current one (unitless)
+!$OMP THREADPRIVATE(route_nbintobas_loc)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: global_basinid_loc          !! ID of basin (unitless)
+!$OMP THREADPRIVATE(global_basinid_loc)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: hydrodiag_loc               !! Variable to diagnose the hydrographs
+!$OMP THREADPRIVATE(hydrodiag_loc)
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:)       :: hydroupbasin_loc            !! The area upstream of the gauging station (m^2)
+!$OMP THREADPRIVATE(hydroupbasin_loc)
+  !
+  ! parallelism
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: routing_area_glo            !! Surface of basin (m^2)
+!$OMP THREADPRIVATE(routing_area_glo)
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: topo_resid_glo              !! Topographic index of the retention time (m)
+!$OMP THREADPRIVATE(topo_resid_glo)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_togrid_glo            !! Grid into which the basin flows (unitless)
+!$OMP THREADPRIVATE(route_togrid_glo)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_tobasin_glo           !! Basin in to which the water goes (unitless)
+!$OMP THREADPRIVATE(route_tobasin_glo)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_nbintobas_glo         !! Number of basin into current one (unitless)
+!$OMP THREADPRIVATE(route_nbintobas_glo)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: global_basinid_glo          !! ID of basin (unitless)
+!$OMP THREADPRIVATE(global_basinid_glo)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: hydrodiag_glo               !! Variable to diagnose the hydrographs
+!$OMP THREADPRIVATE(hydrodiag_glo)
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:)       :: hydroupbasin_glo            !! The area upstream of the gauging station (m^2)
+!$OMP THREADPRIVATE(hydroupbasin_glo)
+  !
+  REAL(r_std), SAVE, POINTER, DIMENSION(:,:)                 :: routing_area                !! Surface of basin (m^2)
+!$OMP THREADPRIVATE(routing_area)
+  REAL(r_std), SAVE, POINTER, DIMENSION(:,:)                 :: topo_resid                  !! Topographic index of the retention time (m)
+!$OMP THREADPRIVATE(topo_resid)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)              :: route_togrid                !! Grid into which the basin flows (unitless)
+!$OMP THREADPRIVATE(route_togrid)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)              :: route_tobasin               !! Basin in to which the water goes (unitless)
+!$OMP THREADPRIVATE(route_tobasin)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)              :: route_nbintobas             !! Number of basin into current one (unitless)
+!$OMP THREADPRIVATE(route_nbintobas)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)              :: global_basinid              !! ID of basin (unitless)
+!$OMP THREADPRIVATE(global_basinid)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)              :: hydrodiag                   !! Variable to diagnose the hydrographs
+!$OMP THREADPRIVATE(hydrodiag)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: slowflow_diag               !! Diagnostic slow flow hydrographs (kg/dt)
+!$OMP THREADPRIVATE(slowflow_diag)  
+  REAL(r_std), SAVE, POINTER, DIMENSION(:)                   :: hydroupbasin                !! The area upstream of the gauging station (m^2)
+!$OMP THREADPRIVATE(hydroupbasin)
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: irrigated                   !! Area equipped for irrigation in each grid box (m^2)
+!$OMP THREADPRIVATE(irrigated)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: floodplains                 !! Maximal surface which can be inundated in each grid box (m^2)
+!$OMP THREADPRIVATE(floodplains)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: swamp                       !! Maximal surface of swamps in each grid box (m^2)
+!$OMP THREADPRIVATE(swamp)
+  !
+  ! The reservoirs, also to be put into the restart file.
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: fast_reservoir              !! Water amount in the fast reservoir (kg)
+!$OMP THREADPRIVATE(fast_reservoir)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: slow_reservoir              !! Water amount in the slow reservoir (kg)
+!$OMP THREADPRIVATE(slow_reservoir)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: stream_reservoir            !! Water amount in the stream reservoir (kg)
+!$OMP THREADPRIVATE(stream_reservoir)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: flood_reservoir             !! Water amount in the floodplains reservoir (kg)
+!$OMP THREADPRIVATE(flood_reservoir)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: lake_reservoir              !! Water amount in the lake reservoir (kg)
+!$OMP THREADPRIVATE(lake_reservoir)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: pond_reservoir              !! Water amount in the pond reservoir (kg)
+!$OMP THREADPRIVATE(pond_reservoir)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: flood_frac_bas              !! Flooded fraction per basin (unitless;0-1)
+!$OMP THREADPRIVATE(flood_frac_bas)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: pond_frac                   !! Pond fraction per grid box (unitless;0-1)
+!$OMP THREADPRIVATE(pond_frac)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: flood_height                !! Floodplain height (mm)
+!$OMP THREADPRIVATE(flood_height)
+  !
+  ! The accumulated fluxes.
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: floodout_mean               !! Accumulated flow out of floodplains (kg/m^2/dt)
+!$OMP THREADPRIVATE(floodout_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: runoff_mean                 !! Accumulated runoff (kg/m^2/dt)
+!$OMP THREADPRIVATE(runoff_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: drainage_mean               !! Accumulated drainage (kg/m^2/dt)
+!$OMP THREADPRIVATE(drainage_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: transpot_mean               !! Mean potential transpiration from the plants (kg/m^2/dt)
+!$OMP THREADPRIVATE(transpot_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: precip_mean                 !! Accumulated precipitation (kg/m^2/dt)
+!$OMP THREADPRIVATE(precip_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: humrel_mean                 !! Mean soil moisture stress, mean root extraction potential (unitless)
+!$OMP THREADPRIVATE(humrel_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: totnobio_mean               !! Mean last total fraction of no bio (unitless;0-1)
+!$OMP THREADPRIVATE(totnobio_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: vegtot_mean                 !! Mean potentially vegetated fraction (unitless;0-1)
+!$OMP THREADPRIVATE(vegtot_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: k_litt_mean                 !! Mean averaged conductivity for saturated infiltration in the 'litter' layer (kg/m^2/dt)
+!$OMP THREADPRIVATE(k_litt_mean)
+  !
+  ! The averaged outflow fluxes.
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: lakeinflow_mean              !! Mean lake inflow (kg/m^2/dt)
+!$OMP THREADPRIVATE(lakeinflow_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: returnflow_mean              !! Mean water flow from lakes and swamps which returns to the grid box.
+                                                                                             !! This water will go back into the hydrol module to allow re-evaporation (kg/m^2/dt)
+!$OMP THREADPRIVATE(returnflow_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: reinfiltration_mean          !! Mean water flow which returns to the grid box (kg/m^2/dt)
+!$OMP THREADPRIVATE(reinfiltration_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: irrigation_mean              !! Mean irrigation flux.
+                                                                                             !! This is the water taken from the reservoirs and beeing put into the upper layers of the soil (kg/m^2/dt)
+!$OMP THREADPRIVATE(irrigation_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: riverflow_mean               !! Mean Outflow of the major rivers.
+                                                                                             !! The flux will be located on the continental grid but this should be a coastal point (kg/dt)
+!$OMP THREADPRIVATE(riverflow_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: coastalflow_mean             !! Mean outflow on coastal points by small basins.
+                                                                                             !! This is the water which flows in a disperse way into the ocean (kg/dt)
+!$OMP THREADPRIVATE(coastalflow_mean)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: floodtemp                    !! Temperature to decide if floodplains work (K)
+!$OMP THREADPRIVATE(floodtemp)
+  INTEGER(i_std), SAVE                                       :: floodtemp_lev                !! Temperature level to decide if floodplains work (K)
+!$OMP THREADPRIVATE(floodtemp_lev)
+  !
+  ! Diagnostic variables ... well sort of !
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: irrig_netereq                !! Irrigation requirement (water requirements by the crop for its optimal growth (kg/m^2/dt)
+!$OMP THREADPRIVATE(irrig_netereq)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: hydrographs                  !! Hydrographs at the outflow of the grid box for major basins (kg/dt)
+!$OMP THREADPRIVATE(hydrographs)
+  !
+  ! Diagnostics for the various reservoirs we use (Kg/m^2)
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: fast_diag                    !! Diagnostic for the fast reservoir (kg/m^2)
+!$OMP THREADPRIVATE(fast_diag)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: slow_diag                    !! Diagnostic for the slow reservoir (kg/m^2)
+!$OMP THREADPRIVATE(slow_diag)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: stream_diag                  !! Diagnostic for the stream reservoir (kg/m^2)
+!$OMP THREADPRIVATE(stream_diag)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: flood_diag                   !! Diagnostic for the floodplain reservoir (kg/m^2)
+!$OMP THREADPRIVATE(flood_diag)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: pond_diag                    !! Diagnostic for the pond reservoir (kg/m^2)
+!$OMP THREADPRIVATE(pond_diag)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: lake_diag                    !! Diagnostic for the lake reservoir (kg/m^2)
+!$OMP THREADPRIVATE(lake_diag)
+
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: mask_coast                   !! Mask with coastal gridcells on local grid(1/0)
+!$OMP THREADPRIVATE(mask_coast)
+  REAL(r_std), SAVE                                          :: max_lake_reservoir           !! Maximum limit of water in lake_reservoir [kg/m2]
+  !$OMP THREADPRIVATE(max_lake_reservoir)
+  INTEGER(i_std), SAVE                                       :: nb_coast_gridcells           !! Number of gridcells which can receive coastalflow
+
+
+CONTAINS
+  !!  =============================================================================================================================
+  !! SUBROUTINE:         routing_initialize
+  !!
+  !>\BRIEF	         Initialize the routing module
+  !!
+  !! DESCRIPTION:        Initialize the routing module. Read from restart file or read the routing.nc file to initialize the
+  !!                     routing scheme. 
+  !!
+  !! RECENT CHANGE(S)
+  !!
+  !! REFERENCE(S)
+  !! 
+  !! FLOWCHART   
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE routing_initialize( kjit,       nbpt,           index,                 &
+                                rest_id,     hist_id,        hist2_id,   lalo,      &
+                                neighbours,  resolution,     contfrac,   stempdiag, &
+                                returnflow,  reinfiltration, irrigation, riverflow, &
+                                coastalflow, flood_frac,     flood_res )
+       
+    IMPLICIT NONE
+    
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)     :: kjit                 !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)     :: nbpt                 !! Domain size (unitless)
+    INTEGER(i_std), INTENT(in)     :: index(nbpt)          !! Indices of the points on the map (unitless)
+    INTEGER(i_std),INTENT(in)      :: rest_id              !! Restart file identifier (unitless)
+    INTEGER(i_std),INTENT(in)      :: hist_id              !! Access to history file (unitless)
+    INTEGER(i_std),INTENT(in)      :: hist2_id             !! Access to history file 2 (unitless)
+    REAL(r_std), INTENT(in)        :: lalo(nbpt,2)         !! Vector of latitude and longitudes (beware of the order !)
+
+    INTEGER(i_std), INTENT(in)     :: neighbours(nbpt,NbNeighb) !! Vector of neighbours for each grid point 
+                                                           !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) (unitless)
+    REAL(r_std), INTENT(in)        :: resolution(nbpt,2)   !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)        :: contfrac(nbpt)       !! Fraction of land in each grid box (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: stempdiag(nbpt,nbdl) !! Diagnostic soil temperature profile
+
+    !! 0.2 Output variables
+    REAL(r_std), INTENT(out)       :: returnflow(nbpt)     !! The water flow from lakes and swamps which returns to the grid box.
+                                                           !! This water will go back into the hydrol module to allow re-evaporation (kg/m^2/dt)
+    REAL(r_std), INTENT(out)       :: reinfiltration(nbpt) !! Water flow from ponds and floodplains which returns to the grid box (kg/m^2/dt)
+    REAL(r_std), INTENT(out)       :: irrigation(nbpt)     !! Irrigation flux. This is the water taken from the reservoirs and beeing put into the upper layers of the soil (kg/m^2/dt)
+    REAL(r_std), INTENT(out)       :: riverflow(nbpt)      !! Outflow of the major rivers. The flux will be located on the continental grid but this should be a coastal point (kg/dt)
+
+    REAL(r_std), INTENT(out)       :: coastalflow(nbpt)    !! Outflow on coastal points by small basins. This is the water which flows in a disperse way into the ocean (kg/dt)
+    REAL(r_std), INTENT(out)       :: flood_frac(nbpt)     !! Flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), INTENT(out)       :: flood_res(nbpt)      !! Diagnostic of water amount in the floodplains reservoir (kg)
+    
+    !! 0.3 Local variables
+    REAL(r_std), DIMENSION(nbp_glo):: mask_coast_glo       !! Mask with coastal gridcells on global grid (1/0)
+    LOGICAL                        :: init_irrig           !! Logical to initialize the irrigation (true/false)
+    LOGICAL                        :: init_flood           !! Logical to initialize the floodplains (true/false)
+    LOGICAL                        :: init_swamp           !! Logical to initialize the swamps (true/false)
+    INTEGER                        :: ig, ib, rtg, rtb     !! Index
+    INTEGER                        :: ier                  !! Error handeling
+!_ ================================================================================================================================
+
+    !
+    ! do initialisation
+    !
+    nbvmax = 440
+    ! Here we will allocate the memory and get the fixed fields from the restart file.
+    ! If the info is not found then we will compute the routing map.
+    !
+
+    CALL routing_init (kjit, nbpt, index, returnflow, reinfiltration, irrigation, &
+         riverflow, coastalflow, flood_frac, flood_res, stempdiag, rest_id)
+
+    routing_area => routing_area_loc  
+    topo_resid => topo_resid_loc
+    route_togrid => route_togrid_loc
+    route_tobasin => route_tobasin_loc
+    global_basinid => global_basinid_loc
+    hydrodiag => hydrodiag_loc
+    
+    ! This routine computes the routing map if the route_togrid_glo is undefined. This means that the
+    ! map has not been initialized during the restart process..
+    !
+    !! Reads in the map of the basins and flow directions to construct the catchments of each grid box
+    !
+    IF ( COUNT(route_togrid_glo .GE. undef_int) .GT. 0 ) THEN
+       CALL routing_basins_p(nbpt, lalo, neighbours, resolution, contfrac)
+    ENDIF
+
+    !! Create a mask containing all possible coastal gridcells and count total number of coastal gridcells
+    IF (is_root_prc) THEN
+       mask_coast_glo(:)=0
+       DO ib=1,nbasmax
+          DO ig=1,nbp_glo
+             rtg = route_togrid_glo(ig,ib)
+             rtb = route_tobasin_glo(ig,ib)
+             ! Coastal gridcells are stored in nbasmax+2
+             IF (rtb == nbasmax+2) THEN
+                mask_coast_glo(rtg) = 1
+             END IF
+          END DO
+       END DO
+       nb_coast_gridcells=SUM(mask_coast_glo)
+       IF (printlev>=3) WRITE(numout,*) 'Number of coastal gridcells = ', nb_coast_gridcells
+    ENDIF
+    CALL bcast(nb_coast_gridcells)
+
+    ALLOCATE(mask_coast(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_inititalize','Pb in allocate for mask_coast','','')
+    CALL scatter(mask_coast_glo, mask_coast)
+    CALL xios_orchidee_send_field("mask_coast",mask_coast)
+
+
+    !
+    ! Do we have what we need if we want to do irrigation
+    !! Initialisation of flags for irrigated land, flood plains and swamps
+    !
+    init_irrig = .FALSE.
+    IF ( do_irrigation ) THEN 
+       IF (COUNT(irrigated .GE. undef_sechiba-1) > 0) init_irrig = .TRUE.
+    END IF
+    
+    init_flood = .FALSE.
+    IF ( do_floodplains ) THEN
+       IF (COUNT(floodplains .GE. undef_sechiba-1) > 0) init_flood = .TRUE.
+    END IF
+    
+    init_swamp = .FALSE.
+    IF ( doswamps ) THEN
+       IF (COUNT(swamp .GE. undef_sechiba-1) > 0 ) init_swamp = .TRUE.
+    END IF
+       
+    !! If we have irrigated land, flood plains or swamps then we need to interpolate the 0.5 degree
+    !! base data set to the resolution of the model.
+    
+    IF ( init_irrig .OR. init_flood .OR. init_swamp ) THEN
+       CALL routing_irrigmap(nbpt, index, lalo, neighbours, resolution, &
+            contfrac, init_irrig, irrigated, init_flood, floodplains, init_swamp, swamp, hist_id, hist2_id)
+    ENDIF
+    
+    IF ( do_irrigation ) THEN 
+       CALL xios_orchidee_send_field("irrigmap",irrigated)
+       
+       WRITE(numout,*) 'Verification : range of irrigated : ', MINVAL(irrigated), MAXVAL(irrigated) 
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite_p(hist_id, 'irrigmap', 1, irrigated, nbpt, index)
+       ELSE
+          CALL histwrite_p(hist_id, 'IrrigationMap', 1, irrigated, nbpt, index)
+       ENDIF
+       IF ( hist2_id > 0 ) THEN
+          IF ( .NOT. almaoutput ) THEN
+             CALL histwrite_p(hist2_id, 'irrigmap', 1, irrigated, nbpt, index)
+          ELSE
+             CALL histwrite_p(hist2_id, 'IrrigationMap', 1, irrigated, nbpt, index)
+          ENDIF
+       ENDIF
+    ENDIF
+    
+    IF ( do_floodplains ) THEN
+       CALL xios_orchidee_send_field("floodmap",floodplains)
+       
+       WRITE(numout,*) 'Verification : range of floodplains : ', MINVAL(floodplains), MAXVAL(floodplains) 
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite_p(hist_id, 'floodmap', 1, floodplains, nbpt, index)
+       ELSE
+          CALL histwrite_p(hist_id, 'FloodplainsMap', 1, floodplains, nbpt, index)
+       ENDIF
+       IF ( hist2_id > 0 ) THEN
+          IF ( .NOT. almaoutput ) THEN
+             CALL histwrite_p(hist2_id, 'floodmap', 1, floodplains, nbpt, index)
+          ELSE
+             CALL histwrite_p(hist2_id, 'FloodplainsMap', 1, floodplains, nbpt, index)
+          ENDIF
+       ENDIF
+    ENDIF
+    
+    IF ( doswamps ) THEN
+       CALL xios_orchidee_send_field("swampmap",swamp)
+       
+       WRITE(numout,*) 'Verification : range of swamp : ', MINVAL(swamp), MAXVAL(swamp) 
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite_p(hist_id, 'swampmap', 1, swamp, nbpt, index)
+       ELSE
+          CALL histwrite_p(hist_id, 'SwampMap', 1, swamp, nbpt, index)
+       ENDIF
+       IF ( hist2_id > 0 ) THEN
+          IF ( .NOT. almaoutput ) THEN
+             CALL histwrite_p(hist2_id, 'swampmap', 1, swamp, nbpt, index)
+          ELSE
+             CALL histwrite_p(hist2_id, 'SwampMap', 1, swamp, nbpt, index)
+          ENDIF
+       ENDIF
+    ENDIF
+    
+    !! This routine gives a diagnostic of the basins used.
+    CALL routing_diagnostic_p(nbpt, index, lalo, resolution, contfrac, hist_id, hist2_id)
+    
+  END SUBROUTINE routing_initialize
+
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_main 
+!!
+!>\BRIEF          This module routes the water over the continents (runoff and
+!!                drainage produced by the hydrol module) into the oceans. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags):
+!! The routing scheme (Polcher, 2003) carries the water from the runoff and drainage simulated by SECHIBA
+!! to the ocean through reservoirs, with some delay. The routing scheme is based on
+!! a parametrization of the water flow on a global scale (Miller et al., 1994; Hagemann
+!! and Dumenil, 1998). Given the global map of the main watersheds (Oki et al., 1999;
+!! Fekete et al., 1999; Vorosmarty et al., 2000) which delineates the boundaries of subbasins
+!! and gives the eight possible directions of water flow within the pixel, the surface
+!! runoff and the deep drainage are routed to the ocean. The time-step of the routing is one day.
+!! The scheme also diagnoses how much water is retained in the foodplains and thus return to soil
+!! moisture or is taken out of the rivers for irrigation. \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!! The result of the routing are 3 fluxes :
+!! - riverflow   : The water which flows out from the major rivers. The flux will be located
+!!                 on the continental grid but this should be a coastal point.
+!! - coastalflow : This is the water which flows in a disperse way into the ocean. Essentially these
+!!                 are the outflows from all of the small rivers.
+!! - returnflow  : This is the water which flows into a land-point - typically rivers which end in
+!!                 the desert. This water will go back into the hydrol module to allow re-evaporation.
+!! - irrigation  : This is water taken from the reservoir and is being put into the upper 
+!!                 layers of the soil.
+!! The two first fluxes are in kg/dt and the last two fluxes are in kg/(m^2dt).\n
+!!
+!! REFERENCE(S) :
+!! - Miller JR, Russell GL, Caliri G (1994)
+!!   Continental-scale river flow in climate models.
+!!   J. Clim., 7:914-928
+!! - Hagemann S and Dumenil L. (1998)
+!!   A parametrization of the lateral waterflow for the global scale.
+!!   Clim. Dyn., 14:17-31
+!! - Oki, T., T. Nishimura, and P. Dirmeyer (1999)
+!!   Assessment of annual runoff from land surface models using total runoff integrating pathways (TRIP)
+!!   J. Meteorol. Soc. Jpn., 77, 235-255
+!! - Fekete BM, Charles V, Grabs W (2000)
+!!   Global, composite runoff fields based on observed river discharge and simulated water balances.
+!!   Technical report, UNH/GRDC, Global Runoff Data Centre, Koblenz
+!! - Vorosmarty, C., B. Fekete, B. Meybeck, and R. Lammers (2000)
+!!   Global system of rivers: Its role in organizing continental land mass and defining land-to-ocean linkages
+!!   Global Biogeochem. Cycles, 14, 599-621
+!! - Vivant, A-C. (?? 2002)
+!!   DÃ©veloppement du schÃ©ma de routage et des plaines d'inondation, MSc Thesis, Paris VI University
+!! - J. Polcher (2003)
+!!   Les processus de surface a l'echelle globale et leurs interactions avec l'atmosphere
+!!   Habilitation a diriger les recherches, Paris VI University, 67pp.
+!!
+!! FLOWCHART    :
+!! \latexonly 
+!! \includegraphics[scale=0.75]{routing_main_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_main(kjit, nbpt, index, &
+       & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, floodout, runoff, &
+       & drainage, transpot, precip_rain, humrel, k_litt, flood_frac, flood_res, &
+       & stempdiag, reinf_slope, returnflow, reinfiltration, irrigation, riverflow, coastalflow, rest_id, hist_id, hist2_id)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)     :: kjit                 !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)     :: nbpt                 !! Domain size (unitless)
+    INTEGER(i_std),INTENT(in)      :: rest_id              !! Restart file identifier (unitless)
+    INTEGER(i_std),INTENT(in)      :: hist_id              !! Access to history file (unitless)
+    INTEGER(i_std),INTENT(in)      :: hist2_id             !! Access to history file 2 (unitless)
+    INTEGER(i_std), INTENT(in)     :: index(nbpt)          !! Indices of the points on the map (unitless)
+    REAL(r_std), INTENT(in)        :: lalo(nbpt,2)         !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)     :: neighbours(nbpt,NbNeighb)   !! Vector of neighbours for each grid point (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) (unitless)
+    REAL(r_std), INTENT(in)        :: resolution(nbpt,2)   !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)        :: contfrac(nbpt)       !! Fraction of land in each grid box (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: totfrac_nobio(nbpt)  !! Total fraction of no-vegetation (continental ice, lakes ...) (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: veget_max(nbpt,nvm)  !! Maximal fraction of vegetation (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: floodout(nbpt)       !! Grid-point flow out of floodplains (kg/m^2/dt)
+    REAL(r_std), INTENT(in)        :: runoff(nbpt)         !! Grid-point runoff (kg/m^2/dt)
+    REAL(r_std), INTENT(in)        :: drainage(nbpt)       !! Grid-point drainage (kg/m^2/dt)
+    REAL(r_std), INTENT(in)        :: transpot(nbpt,nvm)   !! Potential transpiration of the vegetation (kg/m^2/dt)
+    REAL(r_std), INTENT(in)        :: precip_rain(nbpt)    !! Rainfall (kg/m^2/dt)
+    REAL(r_std), INTENT(in)        :: k_litt(nbpt)         !! Averaged conductivity for saturated infiltration in the 'litter' layer (kg/m^2/dt)
+    REAL(r_std), INTENT(in)        :: humrel(nbpt,nvm)     !! Soil moisture stress, root extraction potential (unitless)
+    REAL(r_std), INTENT(in)        :: stempdiag(nbpt,nbdl) !! Diagnostic soil temperature profile
+    REAL(r_std), INTENT(in)        :: reinf_slope(nbpt)    !! Coefficient which determines the reinfiltration ratio in the grid box due to flat areas (unitless;0-1)
+
+    !! 0.2 Output variables
+    REAL(r_std), INTENT(out)       :: returnflow(nbpt)     !! The water flow from lakes and swamps which returns to the grid box.
+                                                           !! This water will go back into the hydrol module to allow re-evaporation (kg/m^2/dt)
+    REAL(r_std), INTENT(out)       :: reinfiltration(nbpt) !! Water flow from ponds and floodplains which returns to the grid box (kg/m^2/dt)
+    REAL(r_std), INTENT(out)       :: irrigation(nbpt)     !! Irrigation flux. This is the water taken from the reservoirs and beeing put into the upper layers of the soil (kg/m^2/dt)
+    REAL(r_std), INTENT(out)       :: riverflow(nbpt)      !! Outflow of the major rivers. The flux will be located on the continental grid but this should be a coastal point (kg/dt)
+    REAL(r_std), INTENT(out)       :: coastalflow(nbpt)    !! Outflow on coastal points by small basins. This is the water which flows in a disperse way into the ocean (kg/dt)
+    REAL(r_std), INTENT(out)       :: flood_frac(nbpt)     !! Flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), INTENT(out)       :: flood_res(nbpt)      !! Diagnostic of water amount in the floodplains reservoir (kg)
+
+    !! 0.3 Local variables
+    CHARACTER(LEN=30)              :: var_name             !! To store variables names for I/O (unitless)
+    REAL(r_std), DIMENSION(1)      :: tmp_day              !! 
+    REAL(r_std), DIMENSION(nbpt)   :: return_lakes         !! Water from lakes flowing back into soil moisture (kg/m^2/dt)
+
+    INTEGER(i_std)                 :: ig, jv               !! Indices (unitless)
+    REAL(r_std), DIMENSION(nbpt)   :: tot_vegfrac_nowoody  !! Total fraction occupied by grass (0-1,unitless)
+
+    REAL(r_std), DIMENSION(nbpt)   :: fast_diag_old        !! Reservoir in the beginning of the time step
+    REAL(r_std), DIMENSION(nbpt)   :: slow_diag_old        !! Reservoir in the beginning of the time step
+    REAL(r_std), DIMENSION(nbpt)   :: stream_diag_old      !! Reservoir in the beginning of the time step
+    REAL(r_std), DIMENSION(nbpt)   :: lake_diag_old        !! Reservoir in the beginning of the time step
+    REAL(r_std), DIMENSION(nbpt)   :: pond_diag_old        !! Reservoir in the beginning of the time step
+    REAL(r_std), DIMENSION(nbpt)   :: flood_diag_old       !! Reservoir in the beginning of the time step
+
+    !! For water budget check in the three routing reservoirs (positive if input > output)
+    !! Net fluxes averaged over each grid cell in kg/m^2/dt
+    REAL(r_std), DIMENSION(nbpt)   :: netflow_stream_diag  !! Input - Output flow to stream reservoir
+    REAL(r_std), DIMENSION(nbpt)   :: netflow_fast_diag    !! Input - Output flow to fast reservoir
+    REAL(r_std), DIMENSION(nbpt)   :: netflow_slow_diag    !! Input - Output flow to slow reservoir
+
+
+!_ ================================================================================================================================
+
+    ! Save reservoirs in beginning of time step to calculate the water budget
+    fast_diag_old   = fast_diag
+    slow_diag_old   = slow_diag
+    stream_diag_old = stream_diag
+    lake_diag_old   = lake_diag
+    pond_diag_old   = pond_diag
+    flood_diag_old  = flood_diag
+
+    !
+    !! Computes the variables averaged between routing time steps and which will be used in subsequent calculations
+    !
+    floodout_mean(:) = floodout_mean(:) + floodout(:)
+    runoff_mean(:) = runoff_mean(:) + runoff(:)
+    drainage_mean(:) = drainage_mean(:) + drainage(:)
+    floodtemp(:) = stempdiag(:,floodtemp_lev)
+    precip_mean(:) =  precip_mean(:) + precip_rain(:)
+    !
+    !! Computes the total fraction occupied by the grasses and the crops for each grid cell
+    tot_vegfrac_nowoody(:) = zero
+    DO jv  = 1, nvm
+       IF ( (jv /= ibare_sechiba) .AND. .NOT.(is_tree(jv)) ) THEN
+          tot_vegfrac_nowoody(:) = tot_vegfrac_nowoody(:) + veget_max(:,jv) 
+       END IF
+    END DO
+
+    DO ig = 1, nbpt
+       IF ( tot_vegfrac_nowoody(ig) .GT. min_sechiba ) THEN
+          DO jv = 1,nvm
+             IF ( (jv /= ibare_sechiba) .AND. .NOT.(is_tree(jv)) ) THEN
+                transpot_mean(ig) = transpot_mean(ig) + transpot(ig,jv) * veget_max(ig,jv)/tot_vegfrac_nowoody(ig)  
+             END IF
+          END DO
+       ELSE
+          IF (MAXVAL(veget_max(ig,2:nvm)) .GT. min_sechiba) THEN
+             DO jv = 2, nvm
+                transpot_mean(ig) = transpot_mean(ig) + transpot(ig,jv) * veget_max(ig,jv)/ SUM(veget_max(ig,2:nvm))
+             ENDDO
+          ENDIF
+       ENDIF
+    ENDDO
+
+    !
+    ! Averaged variables (i.e. *dt_sechiba/dt_routing). This accounts for the difference between the shorter
+    ! timestep dt_sechiba of other parts of the model and the long dt_routing timestep (set to one day at present)
+    !
+    totnobio_mean(:) = totnobio_mean(:) + totfrac_nobio(:)*dt_sechiba/dt_routing
+    k_litt_mean(:) = k_litt_mean(:) + k_litt(:)*dt_sechiba/dt_routing
+    !
+    ! Only potentially vegetated surfaces are taken into account. At the start of
+    ! the growing seasons we will give more weight to these areas.
+    !
+    DO jv=2,nvm
+       DO ig=1,nbpt
+          humrel_mean(ig) = humrel_mean(ig) + humrel(ig,jv)*veget_max(ig,jv)*dt_sechiba/dt_routing
+          vegtot_mean(ig) = vegtot_mean(ig) + veget_max(ig,jv)*dt_sechiba/dt_routing
+       ENDDO
+    ENDDO
+    !
+    time_counter = time_counter + dt_sechiba 
+    !
+    ! If the time has come we do the routing.
+    !
+    IF ( NINT(time_counter) .GE. NINT(dt_routing) ) THEN 
+       !
+       !! Computes the transport of water in the various reservoirs
+       !
+       CALL routing_flow(nbpt, dt_routing, lalo, floodout_mean, runoff_mean, drainage_mean, &
+            & vegtot_mean, totnobio_mean, transpot_mean, precip_mean, humrel_mean, k_litt_mean, floodtemp, reinf_slope, &
+            & lakeinflow_mean, returnflow_mean, reinfiltration_mean, irrigation_mean, riverflow_mean, &
+            & coastalflow_mean, hydrographs, slowflow_diag, flood_frac, flood_res, &
+            & netflow_stream_diag, netflow_fast_diag, netflow_slow_diag)
+       !
+       !! Responsible for storing the water in lakes
+       !
+       CALL routing_lake(nbpt, dt_routing, lakeinflow_mean, humrel_mean, return_lakes)
+       !
+       returnflow_mean(:) = returnflow_mean(:) + return_lakes(:)
+       !
+       time_counter = zero
+       !
+       floodout_mean(:) = zero
+       runoff_mean(:) = zero
+       drainage_mean(:) = zero
+       transpot_mean(:) = zero
+       precip_mean(:) = zero
+       !
+       humrel_mean(:) = zero
+       totnobio_mean(:) = zero
+       k_litt_mean(:) = zero
+       vegtot_mean(:) = zero
+
+       ! Change the units of the routing fluxes from kg/dt_routing into kg/dt_sechiba
+       hydrographs(:) = hydrographs(:)/dt_routing*dt_sechiba
+       slowflow_diag(:) = slowflow_diag(:)/dt_routing*dt_sechiba
+
+       ! Change the units of the routing fluxes from kg/m^2/dt_routing into kg/m^2/dt_sechiba
+       returnflow_mean(:) = returnflow_mean(:)/dt_routing*dt_sechiba
+       reinfiltration_mean(:) = reinfiltration_mean(:)/dt_routing*dt_sechiba
+       irrigation_mean(:) = irrigation_mean(:)/dt_routing*dt_sechiba
+       irrig_netereq(:) = irrig_netereq(:)/dt_routing*dt_sechiba
+       
+       ! Change units as above but at the same time transform the kg/dt_routing to m^3/dt_sechiba
+       riverflow_mean(:) = riverflow_mean(:)/dt_routing*dt_sechiba/mille
+       coastalflow_mean(:) = coastalflow_mean(:)/dt_routing*dt_sechiba/mille
+
+       ! Water budget residu of the three routing reservoirs (in kg/m^2/s)
+       ! Note that these diagnostics are done using local variables only calculated 
+       ! during the time steps when the routing is calculated
+       CALL xios_orchidee_send_field("wbr_stream",(stream_diag - stream_diag_old - netflow_stream_diag)/dt_routing)
+       CALL xios_orchidee_send_field("wbr_fast",  (fast_diag   - fast_diag_old - netflow_fast_diag)/dt_routing)
+       CALL xios_orchidee_send_field("wbr_slow",  (slow_diag   - slow_diag_old - netflow_slow_diag)/dt_routing)
+       CALL xios_orchidee_send_field("wbr_lake",  (lake_diag   - lake_diag_old - &
+                                                   lakeinflow_mean + return_lakes)/dt_routing)
+    ENDIF
+
+    !
+    ! Return the fraction of routed water for this time step.
+    !
+    returnflow(:) = returnflow_mean(:)
+    reinfiltration(:) = reinfiltration_mean(:)
+    irrigation(:) = irrigation_mean(:)
+    riverflow(:) = riverflow_mean(:)
+    coastalflow(:) = coastalflow_mean(:)
+
+    !
+    ! Write diagnostics
+    !
+    ! Water storage in reservoirs [kg/m^2]
+    CALL xios_orchidee_send_field("fastr",fast_diag)
+    CALL xios_orchidee_send_field("slowr",slow_diag)
+    CALL xios_orchidee_send_field("streamr",stream_diag)
+    CALL xios_orchidee_send_field("laker",lake_diag)
+    CALL xios_orchidee_send_field("pondr",pond_diag)
+    CALL xios_orchidee_send_field("floodh",flood_height)
+    CALL xios_orchidee_send_field("floodr",flood_diag)
+
+    ! Difference between the end and the beginning of the routing time step
+    CALL xios_orchidee_send_field("delfastr",   fast_diag   - fast_diag_old)
+    CALL xios_orchidee_send_field("delslowr",   slow_diag   - slow_diag_old)
+    CALL xios_orchidee_send_field("delstreamr", stream_diag - stream_diag_old)
+    CALL xios_orchidee_send_field("dellaker",   lake_diag   - lake_diag_old)
+    CALL xios_orchidee_send_field("delpondr",   pond_diag   - pond_diag_old)
+    CALL xios_orchidee_send_field("delfloodr",  flood_diag  - flood_diag_old)
+
+    ! Water fluxes converted from kg/m^2/dt_sechiba into kg/m^2/s   
+    CALL xios_orchidee_send_field("irrigation",irrigation/dt_sechiba)  
+    CALL xios_orchidee_send_field("netirrig",irrig_netereq/dt_sechiba)  
+    CALL xios_orchidee_send_field("riversret",returnflow/dt_sechiba)  
+    CALL xios_orchidee_send_field("reinfiltration",reinfiltration/dt_sechiba)  
+
+    ! Transform from kg/dt_sechiba into m^3/s  
+    CALL xios_orchidee_send_field("hydrographs",hydrographs/mille/dt_sechiba)  
+    ! previous id name: Qb
+    CALL xios_orchidee_send_field("slowflow",slowflow_diag/mille/dt_sechiba)   
+    CALL xios_orchidee_send_field("coastalflow",coastalflow/dt_sechiba)  
+    CALL xios_orchidee_send_field("riverflow",riverflow/dt_sechiba) 
+
+    IF ( .NOT. almaoutput ) THEN
+       !
+       CALL histwrite_p(hist_id, 'riversret', kjit, returnflow, nbpt, index)
+       IF (do_floodplains .OR. doponds) THEN
+          CALL histwrite_p(hist_id, 'reinfiltration', kjit, reinfiltration, nbpt, index)
+       ENDIF
+       CALL histwrite_p(hist_id, 'hydrographs', kjit, hydrographs/mille, nbpt, index)
+       !
+       CALL histwrite_p(hist_id, 'fastr', kjit, fast_diag, nbpt, index)
+       CALL histwrite_p(hist_id, 'slowr', kjit, slow_diag, nbpt, index)
+       CALL histwrite_p(hist_id, 'streamr', kjit, stream_diag, nbpt, index)
+       IF ( do_floodplains ) THEN
+          CALL histwrite_p(hist_id, 'floodr', kjit, flood_diag, nbpt, index)
+          CALL histwrite_p(hist_id, 'floodh', kjit, flood_height, nbpt, index)
+       ENDIF
+       CALL histwrite_p(hist_id, 'pondr', kjit, pond_diag, nbpt, index)
+       CALL histwrite_p(hist_id, 'lakevol', kjit, lake_diag, nbpt, index)
+       !
+       IF ( do_irrigation ) THEN
+          CALL histwrite_p(hist_id, 'irrigation', kjit, irrigation, nbpt, index)
+          CALL histwrite_p(hist_id, 'returnflow', kjit, returnflow, nbpt, index)
+          CALL histwrite_p(hist_id, 'netirrig', kjit, irrig_netereq, nbpt, index)
+       ENDIF
+       !
+    ELSE
+       CALL histwrite_p(hist_id, 'SurfStor', kjit, flood_diag+pond_diag+lake_diag, nbpt, index)
+       CALL histwrite_p(hist_id, 'Dis', kjit, hydrographs/mille, nbpt, index)
+       !
+       CALL histwrite_p(hist_id, 'slowr', kjit, slow_diag, nbpt, index)
+       CALL histwrite_p(hist_id, 'fastr', kjit, fast_diag, nbpt, index)
+       CALL histwrite_p(hist_id, 'streamr', kjit, stream_diag, nbpt, index)
+       CALL histwrite_p(hist_id, 'lakevol', kjit, lake_diag, nbpt, index)
+       CALL histwrite_p(hist_id, 'pondr', kjit, pond_diag, nbpt, index)
+       !
+       IF ( do_irrigation ) THEN
+          CALL histwrite_p(hist_id, 'Qirrig', kjit, irrigation, nbpt, index)
+          CALL histwrite_p(hist_id, 'Qirrig_req', kjit, irrig_netereq, nbpt, index)
+       ENDIF
+       !
+    ENDIF
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          !
+          CALL histwrite_p(hist2_id, 'riversret', kjit, returnflow, nbpt, index)
+          IF (do_floodplains .OR. doponds) THEN
+             CALL histwrite_p(hist2_id, 'reinfiltration', kjit, reinfiltration, nbpt, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'hydrographs', kjit, hydrographs/mille, nbpt, index)
+          !
+          CALL histwrite_p(hist2_id, 'fastr', kjit, fast_diag, nbpt, index)
+          CALL histwrite_p(hist2_id, 'slowr', kjit, slow_diag, nbpt, index)
+          IF ( do_floodplains ) THEN
+             CALL histwrite_p(hist2_id, 'floodr', kjit, flood_diag, nbpt, index)
+             CALL histwrite_p(hist2_id, 'floodh', kjit, flood_height, nbpt, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'pondr', kjit, pond_diag, nbpt, index)
+          CALL histwrite_p(hist2_id, 'streamr', kjit, stream_diag, nbpt, index)
+          CALL histwrite_p(hist2_id, 'lakevol', kjit, lake_diag, nbpt, index)
+          !
+          IF ( do_irrigation ) THEN
+             CALL histwrite_p(hist2_id, 'irrigation', kjit, irrigation, nbpt, index)
+             CALL histwrite_p(hist2_id, 'returnflow', kjit, returnflow, nbpt, index)
+             CALL histwrite_p(hist2_id, 'netirrig', kjit, irrig_netereq, nbpt, index)
+          ENDIF
+          !
+       ELSE
+          !
+          CALL histwrite_p(hist2_id, 'SurfStor', kjit, flood_diag+pond_diag+lake_diag, nbpt, index)
+          CALL histwrite_p(hist2_id, 'Dis', kjit, hydrographs/mille, nbpt, index)
+          !
+       ENDIF
+    ENDIF
+    !
+    !
+  END SUBROUTINE routing_main
+  
+  !!  =============================================================================================================================
+  !! SUBROUTINE:         routing_finalize
+  !!
+  !>\BRIEF	         Write to restart file
+  !!
+  !! DESCRIPTION:        Write module variables to restart file
+  !!
+  !! RECENT CHANGE(S)
+  !!
+  !! REFERENCE(S)
+  !! 
+  !! FLOWCHART   
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE routing_finalize( kjit, nbpt, rest_id, flood_frac, flood_res )
+    
+    IMPLICIT NONE
+    
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)     :: kjit                 !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)     :: nbpt                 !! Domain size (unitless)
+    INTEGER(i_std),INTENT(in)      :: rest_id              !! Restart file identifier (unitless)
+    REAL(r_std), INTENT(in)        :: flood_frac(nbpt)     !! Flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: flood_res(nbpt)      !! Diagnostic of water amount in the floodplains reservoir (kg)
+    
+    !! 0.2 Local variables
+    REAL(r_std), DIMENSION(1)      :: tmp_day              
+
+!_ ================================================================================================================================
+    
+    !
+    ! Write restart variables
+    !
+    tmp_day(1) = time_counter
+    IF (is_root_prc) CALL restput (rest_id, 'routingcounter', 1, 1, 1, kjit, tmp_day)
+
+    CALL restput_p (rest_id, 'routingarea', nbp_glo, nbasmax, 1, kjit, routing_area, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'routetogrid', nbp_glo, nbasmax, 1, kjit, REAL(route_togrid,r_std), 'scatter', &
+         nbp_glo, index_g)
+    CALL restput_p (rest_id, 'routetobasin', nbp_glo, nbasmax, 1, kjit, REAL(route_tobasin,r_std), 'scatter', &
+         nbp_glo, index_g)
+    CALL restput_p (rest_id, 'basinid', nbp_glo, nbasmax, 1, kjit, REAL(global_basinid,r_std), 'scatter', &
+         nbp_glo, index_g)
+    CALL restput_p (rest_id, 'topoindex', nbp_glo, nbasmax, 1, kjit, topo_resid, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'fastres', nbp_glo, nbasmax, 1, kjit, fast_reservoir, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'slowres', nbp_glo, nbasmax, 1, kjit, slow_reservoir, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'streamres', nbp_glo, nbasmax, 1, kjit, stream_reservoir, 'scatter',nbp_glo,index_g)
+    CALL restput_p (rest_id, 'floodres', nbp_glo, nbasmax, 1, kjit, flood_reservoir, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'floodh', nbp_glo, 1, 1, kjit, flood_height, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'flood_frac_bas', nbp_glo, nbasmax, 1, kjit, flood_frac_bas, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'pond_frac', nbp_glo, 1, 1, kjit, pond_frac, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'flood_frac', nbp_glo, 1, 1, kjit, flood_frac, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'flood_res', nbp_glo, 1, 1, kjit, flood_res, 'scatter', nbp_glo, index_g)
+
+    CALL restput_p (rest_id, 'lakeres', nbp_glo, 1, 1, kjit, lake_reservoir, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'pondres', nbp_glo, 1, 1, kjit, pond_reservoir, 'scatter',  nbp_glo, index_g)
+
+    CALL restput_p (rest_id, 'lakeinflow', nbp_glo, 1, 1, kjit, lakeinflow_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'returnflow', nbp_glo, 1, 1, kjit, returnflow_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'reinfiltration', nbp_glo, 1, 1, kjit, reinfiltration_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'riverflow', nbp_glo, 1, 1, kjit, riverflow_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'coastalflow', nbp_glo, 1, 1, kjit, coastalflow_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'hydrographs', nbp_glo, 1, 1, kjit, hydrographs, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'slowflow_diag', nbp_glo, 1, 1, kjit, slowflow_diag, 'scatter',  nbp_glo, index_g)
+    !
+    ! Keep track of the accumulated variables
+    !
+    CALL restput_p (rest_id, 'floodout_route', nbp_glo, 1, 1, kjit, floodout_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'runoff_route', nbp_glo, 1, 1, kjit, runoff_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'drainage_route', nbp_glo, 1, 1, kjit, drainage_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'transpot_route', nbp_glo, 1, 1, kjit, transpot_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'precip_route', nbp_glo, 1, 1, kjit, precip_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'humrel_route', nbp_glo, 1, 1, kjit, humrel_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'totnobio_route', nbp_glo, 1, 1, kjit, totnobio_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'k_litt_route', nbp_glo, 1, 1, kjit, k_litt_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'vegtot_route', nbp_glo, 1, 1, kjit, vegtot_mean, 'scatter',  nbp_glo, index_g)
+
+    IF ( do_irrigation ) THEN
+       CALL restput_p (rest_id, 'irrigated', nbp_glo, 1, 1, kjit, irrigated, 'scatter',  nbp_glo, index_g)
+       CALL restput_p (rest_id, 'irrigation', nbp_glo, 1, 1, kjit, irrigation_mean, 'scatter',  nbp_glo, index_g)
+    ENDIF
+
+    IF ( do_floodplains ) THEN
+       CALL restput_p (rest_id, 'floodplains', nbp_glo, 1, 1, kjit, floodplains, 'scatter',  nbp_glo, index_g)
+    ENDIF
+    IF ( doswamps ) THEN
+       CALL restput_p (rest_id, 'swamp', nbp_glo, 1, 1, kjit, swamp, 'scatter',  nbp_glo, index_g)
+    ENDIF
+  
+  END SUBROUTINE routing_finalize
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_init
+!!
+!>\BRIEF         This subroutine allocates the memory and get the fixed fields from the restart file.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_init(kjit, nbpt, index, returnflow, reinfiltration, irrigation, &
+       &                  riverflow, coastalflow, flood_frac, flood_res, stempdiag, rest_id)
+    !
+    IMPLICIT NONE
+    !
+    ! interface description
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                   :: kjit           !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)                   :: nbpt           !! Domain size (unitless)
+    INTEGER(i_std), DIMENSION (nbpt), INTENT(in) :: index          !! Indices of the points on the map (unitless)
+    REAL(r_std), DIMENSION(nbpt,nbdl),INTENT(in) :: stempdiag      !! Temperature profile in soil
+    INTEGER(i_std), INTENT(in)                   :: rest_id        !! Restart file identifier (unitless)
+    !
+!! OUTPUT VARIABLES
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)    :: returnflow     !! The water flow from lakes and swamps which returns into the grid box.
+                                                                   !! This water will go back into the hydrol module to allow re-evaporation (kg/m^2/dt)
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)    :: reinfiltration !! Water flow from ponds and floodplains which returns to the grid box (kg/m^2/dt)
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)    :: irrigation     !! Irrigation flux. This is the water taken from the reservoirs and beeing put into the upper layers of the soil.(kg/m^2/dt)
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)    :: riverflow      !! Outflow of the major rivers. The flux will be located on the continental grid but this should be a coastal point (kg/dt)
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)    :: coastalflow    !! Outflow on coastal points by small basins. This is the water which flows in a disperse way into the ocean (kg/dt)
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)    :: flood_frac     !! Flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)    :: flood_res      !! Diagnostic of water amount in the floodplains reservoir (kg)
+    !
+!! LOCAL VARIABLES
+    CHARACTER(LEN=80)                            :: var_name       !! To store variables names for I/O (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: tmp_real_g     !! A temporary real array for the integers
+    REAL(r_std), DIMENSION(1)                    :: tmp_day        !!
+    REAL(r_std)                                  :: ratio          !! Diagnostic ratio to check that dt_routing is a multiple of dt_sechiba (unitless)
+    REAL(r_std)                                  :: totarea        !! Total area of basin (m^2)
+    INTEGER(i_std)                               :: ier, ig, ib, ipn(1) !! Indices (unitless)
+
+!_ ================================================================================================================================
+    !
+    !
+    ! These variables will require the configuration infrastructure
+    !
+    !Config Key   = DT_ROUTING 
+    !Config If    = RIVER_ROUTING
+    !Config Desc  = Time step of the routing scheme
+    !Config Def   = one_day
+    !Config Help  = This values gives the time step in seconds of the routing scheme. 
+    !Config         It should be multiple of the main time step of ORCHIDEE. One day
+    !Config         is a good value.
+    !Config Units = [seconds]
+    !
+    dt_routing = one_day
+    CALL getin_p('DT_ROUTING', dt_routing)
+    !
+    !Config Key   = ROUTING_RIVERS
+    !Config If    = RIVER_ROUTING
+    !Config Desc  = Number of rivers 
+    !Config Def   = 50
+    !Config Help  = This parameter chooses the number of largest river basins
+    !Config         which should be treated as independently as rivers and not
+    !Config         flow into the oceans as diffusion coastal flow.
+    !Config Units = [-]
+    num_largest = 50
+    CALL getin_p('ROUTING_RIVERS', num_largest)
+    !
+    !Config Key   = DO_FLOODINFILT
+    !Config Desc  = Should floodplains reinfiltrate into the soil 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the flood plains reinfiltration 
+    !Config         into the soil moisture. It then can go 
+    !Config         back to the slow and fast reservoirs
+    !Config Units = [FLAG]
+    !
+    dofloodinfilt = .FALSE.
+    CALL getin_p('DO_FLOODINFILT', dofloodinfilt)
+    !
+    !Config Key   = DO_SWAMPS
+    !Config Desc  = Should we include swamp parameterization 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the swamps and return 
+    !Config         the water into the bottom of the soil. It then can go 
+    !Config         back to the atmopshere. This tried to simulate 
+    !Config         internal deltas of rivers.
+    !Config Units = [FLAG]
+    !
+    doswamps = .FALSE.
+    CALL getin_p('DO_SWAMPS', doswamps)
+    !
+    !Config Key   = DO_PONDS
+    !Config Desc  = Should we include ponds 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the ponds and return 
+    !Config         the water into the soil moisture. It then can go 
+    !Config         back to the atmopshere. This tried to simulate 
+    !Config         little ponds especially in West Africa.
+    !Config Units = [FLAG]
+    !
+    doponds = .FALSE.
+    CALL getin_p('DO_PONDS', doponds)
+
+    !Config Key   = SLOW_TCST
+    !Config Desc  = Time constant for the slow reservoir 
+    !Config If    = RIVER_ROUTING 
+    !Config Def   = 25.0
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         time constant (in days) of the slow reservoir
+    !Config         in order to get better river flows for 
+    !Config         particular regions.
+    !Config Units = [days]
+    !
+!> A value for property of each reservoir (in day/m) is given to compute a time constant (in day)
+!> for each reservoir (product of tcst and topo_resid).
+!> The value of tcst has been calibrated for the three reservoirs over the Senegal river basin only,
+!> during the 1 degree NCEP Corrected by Cru (NCC) resolution simulations (Ngo-Duc et al., 2005, Ngo-Duc et al., 2006) and
+!> generalized for all the basins of the world. The "slow reservoir" and the "fast reservoir"
+!> have the highest value in order to simulate the groundwater. 
+!> The "stream reservoir", which represents all the water of the stream, has the lowest value.
+!> Those figures are the same for all the basins of the world.
+!> The value of slow_tcst is equal to fast_tcst when CWRR is activated.
+!> This assumption should be re-discussed.
+    !
+    CALL getin_p('SLOW_TCST', slow_tcst)
+    !
+    !Config Key   = FAST_TCST
+    !Config Desc  = Time constant for the fast reservoir 
+    !Config If    = RIVER_ROUTING 
+    !Config Def   = 3.0
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         time constant (in days) of the fast reservoir
+    !Config         in order to get better river flows for 
+    !Config         particular regions.
+    !Config Units = [days]
+    CALL getin_p('FAST_TCST', fast_tcst)
+    !
+    !Config Key   = STREAM_TCST
+    !Config Desc  = Time constant for the stream reservoir 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 0.24
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         time constant (in days) of the stream reservoir
+    !Config         in order to get better river flows for 
+    !Config         particular regions.
+    !Config Units = [days]
+    CALL getin_p('STREAM_TCST', stream_tcst)
+    !
+    !Config Key   = FLOOD_TCST
+    !Config Desc  = Time constant for the flood reservoir 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 4.0
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         time constant (in days) of the flood reservoir
+    !Config         in order to get better river flows for 
+    !Config         particular regions.
+    !Config Units = [days]
+    CALL getin_p('FLOOD_TCST', flood_tcst)
+    !
+    !Config Key   = SWAMP_CST
+    !Config Desc  = Fraction of the river that flows back to swamps 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 0.2
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         fraction of the river transport
+    !Config         that flows to swamps
+    !Config Units = [-]
+    CALL getin_p('SWAMP_CST', swamp_cst)
+    !
+    !Config Key   = FLOOD_BETA
+    !Config Desc  = Parameter to fix the shape of the floodplain  
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 2.0
+    !Config Help  = Parameter to fix the shape of the floodplain
+    !Config         (>1 for convex edges, <1 for concave edges)
+    !Config Units = [-] 
+    CALL getin_p("FLOOD_BETA", beta)
+    !
+    !Config Key   = POND_BETAP
+    !Config Desc  = Ratio of the basin surface intercepted by ponds and the maximum surface of ponds
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 0.5
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p("POND_BETAP", betap)    
+    !
+    !Config Key   = FLOOD_CRI
+    !Config Desc  = Potential height for which all the basin is flooded
+    !Config If    = DO_FLOODPLAINS or DO_PONDS
+    !Config Def   = 2000.
+    !Config Help  = 
+    !Config Units = [mm] 
+    CALL getin_p("FLOOD_CRI", floodcri)
+    !
+    !Config Key   = POND_CRI
+    !Config Desc  = Potential height for which all the basin is a pond
+    !Config If    = DO_FLOODPLAINS or DO_PONDS
+    !Config Def   = 2000.
+    !Config Help  = 
+    !Config Units = [mm] 
+    CALL getin_p("POND_CRI", pondcri)
+
+    !Config Key   = MAX_LAKE_RESERVOIR
+    !Config Desc  = Maximum limit of water in lake_reservoir
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 7000
+    !Config Help  = 
+    !Config Units = [kg/m2(routing area)] 
+    max_lake_reservoir = 7000
+    CALL getin_p("MAX_LAKE_RESERVOIR", max_lake_reservoir)
+
+    !
+    !
+    ! In order to simplify the time cascade check that dt_routing
+    ! is a multiple of dt_sechiba
+    !
+    ratio = dt_routing/dt_sechiba
+    IF ( ABS(NINT(ratio) - ratio) .GT. 10*EPSILON(ratio)) THEN
+       WRITE(numout,*) 'WARNING -- WARNING -- WARNING -- WARNING'
+       WRITE(numout,*) "The chosen time step for the routing is not a multiple of the"
+       WRITE(numout,*) "main time step of the model. We will change dt_routing so that"
+       WRITE(numout,*) "this condition os fulfilled"
+       dt_routing = NINT(ratio) * dt_sechiba
+       WRITE(numout,*) 'THE NEW DT_ROUTING IS : ', dt_routing
+    ENDIF
+    !
+    IF ( dt_routing .LT. dt_sechiba) THEN
+       WRITE(numout,*) 'WARNING -- WARNING -- WARNING -- WARNING'
+       WRITE(numout,*) 'The routing timestep can not be smaller than the one'
+       WRITE(numout,*) 'of the model. We reset its value to the model''s timestep.'
+       WRITE(numout,*) 'The old DT_ROUTING is : ', dt_routing
+       dt_routing = dt_sechiba
+       WRITE(numout,*) 'THE NEW DT_ROUTING IS : ', dt_routing
+    ENDIF
+    !
+    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
+          ! The variable was not found in restart file, initialize to zero
+          time_counter = zero
+       ELSE
+          ! Take the value from restart file
+          time_counter = tmp_day(1) 
+       ENDIF
+    ENDIF
+    CALL bcast(time_counter)
+    
+    ALLOCATE (routing_area_loc(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for routing_area_loc','','')
+
+    ALLOCATE (routing_area_glo(nbp_glo,nbasmax))
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for routing_area_glo','','')
+    var_name = 'routingarea'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Area of basin')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., routing_area_glo, "gather", nbp_glo, index_g)
+    ENDIF
+    CALL scatter(routing_area_glo,routing_area_loc)
+    routing_area=>routing_area_loc
+
+    ALLOCATE (tmp_real_g(nbp_glo,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for tmp_real_g','','')
+
+    ALLOCATE (route_togrid_loc(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for route_togrid_loc','','')
+    ALLOCATE (route_togrid_glo(nbp_glo,nbasmax), stat=ier)      ! used in global in routing_flow
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for route_togrid_glo','','')
+
+    IF (is_root_prc) THEN
+       var_name = 'routetogrid'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','Grid into which the basin flows')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., tmp_real_g, "gather", nbp_glo, index_g)
+       route_togrid_glo(:,:) = undef_int
+       WHERE ( tmp_real_g .LT. val_exp )
+          route_togrid_glo = NINT(tmp_real_g)
+    ENDWHERE
+    ENDIF
+    CALL bcast(route_togrid_glo)                      ! used in global in routing_flow
+    CALL scatter(route_togrid_glo,route_togrid_loc)
+    route_togrid=>route_togrid_loc
+    !
+    ALLOCATE (route_tobasin_loc(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for route_tobasin_loc','','')
+
+    ALLOCATE (route_tobasin_glo(nbp_glo,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for route_tobasin_glo','','')
+
+    IF (is_root_prc) THEN
+       var_name = 'routetobasin'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','Basin in to which the water goes')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., tmp_real_g, "gather", nbp_glo, index_g)
+       route_tobasin_glo = undef_int
+       WHERE ( tmp_real_g .LT. val_exp )
+         route_tobasin_glo = NINT(tmp_real_g)
+      ENDWHERE
+    ENDIF
+    CALL scatter(route_tobasin_glo,route_tobasin_loc)
+    route_tobasin=>route_tobasin_loc
+    !
+    ! nbintobasin
+    !
+    ALLOCATE (route_nbintobas_loc(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for route_nbintobas_loc','','')
+    ALLOCATE (route_nbintobas_glo(nbp_glo,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for route_nbintobas_glo','','')
+
+    IF (is_root_prc) THEN
+       var_name = 'routenbintobas'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','Number of basin into current one')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., tmp_real_g, "gather", nbp_glo, index_g)
+       route_nbintobas_glo = undef_int
+       WHERE ( tmp_real_g .LT. val_exp )
+         route_nbintobas_glo = NINT(tmp_real_g)
+      ENDWHERE
+    ENDIF
+    CALL scatter(route_nbintobas_glo,route_nbintobas_loc)
+    route_nbintobas=>route_nbintobas_loc
+    !
+    ALLOCATE (global_basinid_loc(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for global_basinid_loc','','')
+    ALLOCATE (global_basinid_glo(nbp_glo,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for global_basinid_glo','','')
+
+    IF (is_root_prc) THEN
+       var_name = 'basinid'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','ID of basin')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., tmp_real_g, "gather", nbp_glo, index_g)
+       global_basinid_glo = undef_int
+       WHERE ( tmp_real_g .LT. val_exp )
+          global_basinid_glo = NINT(tmp_real_g)
+       ENDWHERE
+    ENDIF
+    CALL scatter(global_basinid_glo,global_basinid_loc)
+    global_basinid=>global_basinid_loc
+    !
+    ALLOCATE (topo_resid_loc(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for topo_resid_loc','','')
+    ALLOCATE (topo_resid_glo(nbp_glo,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for topo_resid_glo','','')
+
+    IF (is_root_prc) THEN
+       var_name = 'topoindex'
+       CALL ioconf_setatt('UNITS', 'm')
+       CALL ioconf_setatt('LONG_NAME','Topographic index of the residence time')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., topo_resid_glo, "gather", nbp_glo, index_g)
+    ENDIF
+    CALL scatter(topo_resid_glo,topo_resid_loc)
+    topo_resid=>topo_resid_loc
+
+    ALLOCATE (fast_reservoir(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for fast_reservoir','','')
+    var_name = 'fastres'
+    CALL ioconf_setatt_p('UNITS', 'Kg')
+    CALL ioconf_setatt_p('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), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for slow_reservoir','','')
+    var_name = 'slowres'
+    CALL ioconf_setatt_p('UNITS', 'Kg')
+    CALL ioconf_setatt_p('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), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for stream_reservoir','','')
+    var_name = 'streamres'
+    CALL ioconf_setatt_p('UNITS', 'Kg')
+    CALL ioconf_setatt_p('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 (flood_reservoir(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for flood_reservoir','','')
+    var_name = 'floodres'
+    CALL ioconf_setatt_p('UNITS', 'Kg')
+    CALL ioconf_setatt_p('LONG_NAME','Water in the flood reservoir')
+    CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., flood_reservoir, "gather", nbp_glo, index_g)
+    CALL setvar_p (flood_reservoir, val_exp, 'NO_KEYWORD', zero)
+
+    ALLOCATE (flood_frac_bas(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for flood_frac_bas','','')
+    var_name = 'flood_frac_bas'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Flooded fraction per basin')
+    CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., flood_frac_bas, "gather", nbp_glo, index_g)
+    CALL setvar_p (flood_frac_bas, val_exp, 'NO_KEYWORD', zero)
+
+    ALLOCATE (flood_height(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for flood_height','','')
+    var_name = 'floodh'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., flood_height, "gather", nbp_glo, index_g)
+    CALL setvar_p (flood_height, val_exp, 'NO_KEYWORD', zero)
+    
+    ALLOCATE (pond_frac(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for pond_frac','','')
+    var_name = 'pond_frac'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Pond fraction per grid box')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., pond_frac, "gather", nbp_glo, index_g)
+    CALL setvar_p (pond_frac, val_exp, 'NO_KEYWORD', zero)
+    
+    var_name = 'flood_frac'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Flooded fraction per grid box')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., flood_frac, "gather", nbp_glo, index_g)
+    CALL setvar_p (flood_frac, val_exp, 'NO_KEYWORD', zero)
+    
+    var_name = 'flood_res'
+    CALL ioconf_setatt_p('UNITS','mm')
+    CALL ioconf_setatt_p('LONG_NAME','Flooded quantity (estimation)')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., flood_res, "gather", nbp_glo, index_g)
+    CALL setvar_p (flood_res, val_exp, 'NO_KEYWORD', zero)
+!    flood_res = zero
+    
+    ALLOCATE (lake_reservoir(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for lake_reservoir','','')
+    var_name = 'lakeres'
+    CALL ioconf_setatt_p('UNITS', 'Kg')
+    CALL ioconf_setatt_p('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)
+    
+    ALLOCATE (pond_reservoir(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for pond_reservoir','','')
+    var_name = 'pondres'
+    CALL ioconf_setatt_p('UNITS', 'Kg')
+    CALL ioconf_setatt_p('LONG_NAME','Water in the pond reservoir')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., pond_reservoir, "gather", nbp_glo, index_g)
+    CALL setvar_p (pond_reservoir, val_exp, 'NO_KEYWORD', zero)
+    !
+    ! Map of irrigated areas
+    !
+    IF ( do_irrigation ) THEN
+       ALLOCATE (irrigated(nbpt), stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for irrigated','','')
+       var_name = 'irrigated'
+       CALL ioconf_setatt_p('UNITS', 'm^2')
+       CALL ioconf_setatt_p('LONG_NAME','Surface of irrigated area')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., irrigated, "gather", nbp_glo, index_g)
+       CALL setvar_p (irrigated, val_exp, 'NO_KEYWORD', undef_sechiba)
+    ENDIF
+    
+    IF ( do_floodplains ) THEN
+       ALLOCATE (floodplains(nbpt), stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for floodplains','','')
+       var_name = 'floodplains'
+       CALL ioconf_setatt_p('UNITS', 'm^2')
+       CALL ioconf_setatt_p('LONG_NAME','Surface which can be flooded')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., floodplains, "gather", nbp_glo, index_g)
+       CALL setvar_p (floodplains, val_exp, 'NO_KEYWORD', undef_sechiba)
+    ENDIF
+    IF ( doswamps ) THEN
+       ALLOCATE (swamp(nbpt), stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for swamp','','')
+       var_name = 'swamp'
+       CALL ioconf_setatt_p('UNITS', 'm^2')
+       CALL ioconf_setatt_p('LONG_NAME','Surface which can become swamp')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., swamp, "gather", nbp_glo, index_g)
+       CALL setvar_p (swamp, val_exp, 'NO_KEYWORD', undef_sechiba)
+    ENDIF
+    !
+    ! Put into the restart file the fluxes so that they can be regenerated at restart.
+    !
+    ALLOCATE (lakeinflow_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for lakeinflow_mean','','')
+    var_name = 'lakeinflow'
+    CALL ioconf_setatt_p('UNITS', 'Kg/dt')
+    CALL ioconf_setatt_p('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), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for returnflow_mean','','')
+    var_name = 'returnflow'
+    CALL ioconf_setatt_p('UNITS', 'Kg/m^2/dt')
+    CALL ioconf_setatt_p('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 (reinfiltration_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for reinfiltration_mean','','')
+    var_name = 'reinfiltration'
+    CALL ioconf_setatt_p('UNITS', 'Kg/m^2/dt')
+    CALL ioconf_setatt_p('LONG_NAME','Top return flux')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., reinfiltration_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (reinfiltration_mean, val_exp, 'NO_KEYWORD', zero)
+    reinfiltration(:) = reinfiltration_mean(:)
+    
+    ALLOCATE (irrigation_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for irrigation_mean','','')
+    ALLOCATE (irrig_netereq(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for irrig_netereq','','')
+    irrig_netereq(:) = zero
+    
+    IF ( do_irrigation ) THEN
+       var_name = 'irrigation'
+       CALL ioconf_setatt_p('UNITS', 'Kg/dt')
+       CALL ioconf_setatt_p('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), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for riverflow_mean','','')
+    var_name = 'riverflow'
+    CALL ioconf_setatt_p('UNITS', 'Kg/dt')
+    CALL ioconf_setatt_p('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), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for coastalflow_mean','','')
+    var_name = 'coastalflow'
+    CALL ioconf_setatt_p('UNITS', 'Kg/dt')
+    CALL ioconf_setatt_p('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), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for floodtemp','','')
+    floodtemp(:) = stempdiag(:,floodtemp_lev)
+    
+    ALLOCATE(hydrographs(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for hydrographs','','')
+    var_name = 'hydrographs'
+    CALL ioconf_setatt_p('UNITS', 'kg/dt_sechiba')
+    CALL ioconf_setatt_p('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)
+ 
+    ALLOCATE(slowflow_diag(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for slowflow_diag','','')
+    var_name = 'slowflow_diag'
+    CALL ioconf_setatt_p('UNITS', 'kg/dt_sechiba')
+    CALL ioconf_setatt_p('LONG_NAME','Slowflow hydrograph at outlow of grid')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE.,slowflow_diag, "gather", nbp_glo, index_g)
+    CALL setvar_p (slowflow_diag, val_exp, 'NO_KEYWORD', zero)
+
+    !
+    ! The diagnostic variables, they are initialized from the above restart variables.
+    !
+    ALLOCATE(fast_diag(nbpt), slow_diag(nbpt), stream_diag(nbpt), flood_diag(nbpt), &
+         & pond_diag(nbpt), lake_diag(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for fast_diag,..','','')
+    
+    fast_diag(:) = zero
+    slow_diag(:) = zero
+    stream_diag(:) = zero
+    flood_diag(:) = zero
+    pond_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)
+          flood_diag(ig) = flood_diag(ig) + flood_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
+       flood_diag(ig) = flood_diag(ig)/totarea
+       !
+       ! This is the volume of the lake scaled to the entire grid.
+       ! It would be better to scale it to the size of the lake
+       ! but this information is not yet available.
+       !
+       lake_diag(ig) = lake_reservoir(ig)/totarea
+       !
+    ENDDO
+    !
+    ! Get from the restart the fluxes we accumulated.
+    !
+    ALLOCATE (floodout_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for floodout_mean','','')
+    var_name = 'floodout_route'
+    CALL ioconf_setatt_p('UNITS', 'Kg')
+    CALL ioconf_setatt_p('LONG_NAME','Accumulated flow out of floodplains for routing')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., floodout_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (floodout_mean, val_exp, 'NO_KEYWORD', zero)
+    
+    ALLOCATE (runoff_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for runoff_mean','','')
+    var_name = 'runoff_route'
+    CALL ioconf_setatt_p('UNITS', 'Kg')
+    CALL ioconf_setatt_p('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), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for drainage_mean','','')
+    var_name = 'drainage_route'
+    CALL ioconf_setatt_p('UNITS', 'Kg')
+    CALL ioconf_setatt_p('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(transpot_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for transpot_mean','','')
+    var_name = 'transpot_route'
+    CALL ioconf_setatt_p('UNITS', 'Kg/m^2')
+    CALL ioconf_setatt_p('LONG_NAME','Accumulated potential transpiration for routing/irrigation')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., transpot_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (transpot_mean, val_exp, 'NO_KEYWORD', zero)
+
+    ALLOCATE(precip_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for precip_mean','','')
+    var_name = 'precip_route'
+    CALL ioconf_setatt_p('UNITS', 'Kg/m^2')
+    CALL ioconf_setatt_p('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), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for humrel_mean','','')
+    var_name = 'humrel_route'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Mean humrel for irrigation')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., humrel_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (humrel_mean, val_exp, 'NO_KEYWORD', un)
+    
+    ALLOCATE(k_litt_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for k_litt_mean','','')
+    var_name = 'k_litt_route'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Mean cond. for litter')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., k_litt_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (k_litt_mean, val_exp, 'NO_KEYWORD', zero)
+    
+    ALLOCATE(totnobio_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for totnobio_mean','','')
+    var_name = 'totnobio_route'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Last Total fraction of no bio for irrigation')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., totnobio_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (totnobio_mean, val_exp, 'NO_KEYWORD', zero)
+    
+    ALLOCATE(vegtot_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for vegtot_mean','','')
+    var_name = 'vegtot_route'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('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 /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for hydrodiag_glo','','')
+    hydrodiag=>hydrodiag_loc
+
+    ALLOCATE(hydroupbasin_loc(nbpt),hydroupbasin_glo(nbp_glo), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for hydroupbasin_glo','','')
+    hydroupbasin=>hydroupbasin_loc
+
+  END SUBROUTINE routing_init
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_clear
+!!
+!>\BRIEF        : This subroutine deallocates the block memory previously allocated.
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_clear()
+  
+    IF (ALLOCATED(routing_area_loc)) DEALLOCATE(routing_area_loc)
+    IF (ALLOCATED(route_togrid_loc)) DEALLOCATE(route_togrid_loc)
+    IF (ALLOCATED(route_tobasin_loc)) DEALLOCATE(route_tobasin_loc)
+    IF (ALLOCATED(route_nbintobas_loc)) DEALLOCATE(route_nbintobas_loc)
+    IF (ALLOCATED(global_basinid_loc)) DEALLOCATE(global_basinid_loc)
+    IF (ALLOCATED(topo_resid_loc)) DEALLOCATE(topo_resid_loc)
+    IF (ALLOCATED(routing_area_glo)) DEALLOCATE(routing_area_glo)
+    IF (ALLOCATED(route_togrid_glo)) DEALLOCATE(route_togrid_glo)
+    IF (ALLOCATED(route_tobasin_glo)) DEALLOCATE(route_tobasin_glo)
+    IF (ALLOCATED(route_nbintobas_glo)) DEALLOCATE(route_nbintobas_glo)
+    IF (ALLOCATED(global_basinid_glo)) DEALLOCATE(global_basinid_glo)
+    IF (ALLOCATED(topo_resid_glo)) DEALLOCATE(topo_resid_glo)
+    IF (ALLOCATED(fast_reservoir)) DEALLOCATE(fast_reservoir)
+    IF (ALLOCATED(slow_reservoir)) DEALLOCATE(slow_reservoir)
+    IF (ALLOCATED(stream_reservoir)) DEALLOCATE(stream_reservoir)
+    IF (ALLOCATED(flood_reservoir)) DEALLOCATE(flood_reservoir)
+    IF (ALLOCATED(flood_frac_bas)) DEALLOCATE(flood_frac_bas)
+    IF (ALLOCATED(flood_height)) DEALLOCATE(flood_height)
+    IF (ALLOCATED(pond_frac)) DEALLOCATE(pond_frac)
+    IF (ALLOCATED(lake_reservoir)) DEALLOCATE(lake_reservoir)
+    IF (ALLOCATED(pond_reservoir)) DEALLOCATE(pond_reservoir)
+    IF (ALLOCATED(returnflow_mean)) DEALLOCATE(returnflow_mean)
+    IF (ALLOCATED(reinfiltration_mean)) DEALLOCATE(reinfiltration_mean)
+    IF (ALLOCATED(riverflow_mean)) DEALLOCATE(riverflow_mean)
+    IF (ALLOCATED(coastalflow_mean)) DEALLOCATE(coastalflow_mean)
+    IF (ALLOCATED(lakeinflow_mean)) DEALLOCATE(lakeinflow_mean)
+    IF (ALLOCATED(runoff_mean)) DEALLOCATE(runoff_mean)
+    IF (ALLOCATED(floodout_mean)) DEALLOCATE(floodout_mean)
+    IF (ALLOCATED(drainage_mean)) DEALLOCATE(drainage_mean)
+    IF (ALLOCATED(transpot_mean)) DEALLOCATE(transpot_mean)
+    IF (ALLOCATED(precip_mean)) DEALLOCATE(precip_mean)
+    IF (ALLOCATED(humrel_mean)) DEALLOCATE(humrel_mean)
+    IF (ALLOCATED(k_litt_mean)) DEALLOCATE(k_litt_mean)
+    IF (ALLOCATED(totnobio_mean)) DEALLOCATE(totnobio_mean)
+    IF (ALLOCATED(vegtot_mean)) DEALLOCATE(vegtot_mean)
+    IF (ALLOCATED(floodtemp)) DEALLOCATE(floodtemp)
+    IF (ALLOCATED(hydrodiag_loc)) DEALLOCATE(hydrodiag_loc)
+    IF (ALLOCATED(hydrodiag_glo)) DEALLOCATE(hydrodiag_glo)
+    IF (ALLOCATED(hydroupbasin_loc)) DEALLOCATE(hydroupbasin_loc)    
+    IF (ALLOCATED(hydroupbasin_glo)) DEALLOCATE(hydroupbasin_glo)
+    IF (ALLOCATED(hydrographs)) DEALLOCATE(hydrographs)
+    IF (ALLOCATED(slowflow_diag)) DEALLOCATE(slowflow_diag)
+    IF (ALLOCATED(irrigation_mean)) DEALLOCATE(irrigation_mean)
+    IF (ALLOCATED(irrigated)) DEALLOCATE(irrigated)
+    IF (ALLOCATED(floodplains)) DEALLOCATE(floodplains)
+    IF (ALLOCATED(swamp)) DEALLOCATE(swamp)
+    IF (ALLOCATED(fast_diag)) DEALLOCATE(fast_diag)
+    IF (ALLOCATED(slow_diag)) DEALLOCATE(slow_diag)
+    IF (ALLOCATED(stream_diag)) DEALLOCATE(stream_diag)
+    IF (ALLOCATED(flood_diag)) DEALLOCATE(flood_diag)
+    IF (ALLOCATED(pond_diag)) DEALLOCATE(pond_diag)
+    IF (ALLOCATED(lake_diag)) DEALLOCATE(lake_diag)
+
+  END SUBROUTINE routing_clear
+  !
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_flow
+!!
+!>\BRIEF         This subroutine computes the transport of water in the various reservoirs
+!!                (including ponds and floodplains) and the water withdrawals from the reservoirs for irrigation.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!! This will first compute the amount of water which flows out of each of the 3 reservoirs using the assumption of an 
+!! exponential decrease of water in the reservoir (see Hagemann S and Dumenil L. (1998)). Then we compute the fluxes 
+!! for floodplains and ponds. All this will then be used in order to update each of the basins : taking water out of 
+!! the up-stream basin and adding it to the down-stream one.
+!! As this step happens globaly we have to stop the parallel processing in order to exchange the information. Once 
+!! all reservoirs are updated we deal with irrigation. The final step is to compute diagnostic fluxes. Among them
+!! the hydrographs of the largest rivers we have chosen to monitor.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): lakeinflow, returnflow, reinfiltration, irrigation, riverflow, coastalflow, hydrographs, flood_frac, flood_res
+!!
+!! REFERENCES   :
+!! - Ngo-Duc, T., K. Laval, G. Ramillien, J. Polcher, and A. Cazenave (2007)
+!!   Validation of the land water storage simulated by Organising Carbon and Hydrology in Dynamic Ecosystems (ORCHIDEE) with Gravity Recovery and Climate Experiment (GRACE) data.
+!!   Water Resour. Res., 43, W04427, doi:10.1029/2006WR004941.
+!! * Irrigation:
+!! - de Rosnay, P., J. Polcher, K. Laval, and M. Sabre (2003)
+!!   Integrated parameterization of irrigation in the land surface model ORCHIDEE. Validation over Indian Peninsula.
+!!   Geophys. Res. Lett., 30(19), 1986, doi:10.1029/2003GL018024.
+!! - A.C. Vivant (2003)
+!!   Les plaines d'inondations et l'irrigation dans ORCHIDEE, impacts de leur prise en compte.
+!!   , , 51pp.
+!! - N. Culson (2004)
+!!   Impact de l'irrigation sur le cycle de l'eau
+!!   Master thesis, Paris VI University, 55pp.
+!! - X.-T. Nguyen-Vinh (2005)
+!!   Analyse de l'impact de l'irrigation en Amerique du Nord - plaine du Mississippi - sur la climatologie regionale
+!!   Master thesis, Paris VI University, 33pp.
+!! - M. Guimberteau (2006)
+!!   Analyse et modifications proposees de la modelisation de l'irrigation dans un modele de surface.
+!!   Master thesis, Paris VI University, 46pp.
+!! - Guimberteau M. (2010)
+!!   Modelisation de l'hydrologie continentale et influences de l'irrigation sur le cycle de l'eau.
+!!   Ph.D. thesis, Paris VI University, 195pp.
+!! - Guimberteau M., Laval K., Perrier A. and Polcher J. (2011).
+!!   Global effect of irrigation and its impact on the onset of the Indian summer monsoon.
+!!   In press, Climate Dynamics, doi: 10.1007/s00382-011-1252-5.
+!! * Floodplains:
+!! - A.C. Vivant (2002)
+!!   L'ecoulement lateral de l'eau sur les surfaces continentales. Prise en compte des plaines d'inondations dans ORCHIDEE.
+!!   Master thesis, Paris VI University, 46pp.
+!! - A.C. Vivant (2003)
+!!   Les plaines d'inondations et l'irrigation dans ORCHIDEE, impacts de leur prise en compte.
+!!   , , 51pp.
+!! - T. d'Orgeval (2006)
+!!   Impact du changement climatique sur le cycle de l'eau en Afrique de l'Ouest: modelisation et incertitudes.
+!!   Ph.D. thesis, Paris VI University, 188pp.
+!! - T. d'Orgeval, J. Polcher, and P. de Rosnay (2008)
+!!   Sensitivity of the West African hydrological cycle in ORCHIDEE to infiltration processes.
+!!   Hydrol. Earth Syst. Sci., 12, 1387-1401
+!! - M. Guimberteau, G. Drapeau, J. Ronchail, B. Sultan, J. Polcher, J.-M. Martinez, C. Prigent, J.-L. Guyot, G. Cochonneau,
+!!   J. C. Espinoza, N. Filizola, P. Fraizy, W. Lavado, E. De Oliveira, R. Pombosa, L. Noriega, and P. Vauchel (2011)
+!!   Discharge simulation in the sub-basins of the Amazon using ORCHIDEE forced by new datasets.
+!!   Hydrol. Earth Syst. Sci. Discuss., 8, 11171-11232, doi:10.5194/hessd-8-11171-2011
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_flow(nbpt, dt_routing, lalo, floodout, runoff, drainage, &
+       &                  vegtot, totnobio, transpot_mean, precip, humrel, k_litt, floodtemp, reinf_slope, &
+       &                  lakeinflow, returnflow, reinfiltration, irrigation, riverflow, &
+       &                  coastalflow, hydrographs, slowflow_diag, flood_frac, flood_res, &
+                          netflow_stream_diag, netflow_fast_diag, netflow_slow_diag)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                   :: nbpt                      !! Domain size (unitless)
+    REAL(r_std), INTENT (in)                     :: dt_routing                !! Routing time step (s)
+    REAL(r_std), INTENT(in)                      :: lalo(nbpt,2)              !! Vector of latitude and longitudes
+    REAL(r_std), INTENT(in)                      :: runoff(nbpt)              !! Grid-point runoff (kg/m^2/dt)
+    REAL(r_std), INTENT(in)                      :: floodout(nbpt)            !! Grid-point flow out of floodplains (kg/m^2/dt)
+    REAL(r_std), INTENT(in)                      :: drainage(nbpt)            !! Grid-point drainage (kg/m^2/dt)
+    REAL(r_std), INTENT(in)                      :: vegtot(nbpt)              !! Potentially vegetated fraction (unitless;0-1)
+    REAL(r_std), INTENT(in)                      :: totnobio(nbpt)            !! Other areas which can not have vegetation
+    REAL(r_std), INTENT(in)                      :: transpot_mean(nbpt)       !! Mean potential transpiration of the vegetation (kg/m^2/dt)
+    REAL(r_std), INTENT(in)                      :: precip(nbpt)              !! Rainfall (kg/m^2/dt)
+    REAL(r_std), INTENT(in)                      :: humrel(nbpt)              !! Soil moisture stress, root extraction potential (unitless)
+    REAL(r_std), INTENT(in)                      :: k_litt(nbpt)              !! Averaged conductivity for saturated infiltration in the 'litter' layer (kg/m^2/dt)
+    REAL(r_std), INTENT(in)                      :: floodtemp(nbpt)           !! Temperature to decide if floodplains work (K)
+    REAL(r_std), INTENT(in)                      :: reinf_slope(nbpt)         !! Coefficient which determines the reinfiltration ratio in the grid box due to flat areas (unitless;0-1)
+    REAL(r_std), INTENT(out)                     :: lakeinflow(nbpt)          !! Water inflow to the lakes (kg/dt)
+    !
+!! OUTPUT VARIABLES
+    REAL(r_std), INTENT(out)                     :: returnflow(nbpt)          !! The water flow from lakes and swamps which returns into the grid box.
+                                                                              !! This water will go back into the hydrol module to allow re-evaporation (kg/m^2/dt_routing)
+    REAL(r_std), INTENT(out)                     :: reinfiltration(nbpt)      !! Water flow from ponds and floodplains which returns to the grid box (kg/m^2/dt)
+    REAL(r_std), INTENT(out)                     :: irrigation(nbpt)          !! Irrigation flux. This is the water taken from the reservoirs and beeing put into the upper layers of the soil (kg/m^2/dt_routing)
+    REAL(r_std), INTENT(out)                     :: riverflow(nbpt)           !! Outflow of the major rivers. The flux will be located on the continental grid but this should be a coastal point (kg/dt_routing)
+    REAL(r_std), INTENT(out)                     :: coastalflow(nbpt)         !! Outflow on coastal points by small basins. This is the water which flows in a disperse way into the ocean (kg/dt_routing)
+    REAL(r_std), INTENT(out)                     :: hydrographs(nbpt)         !! Hydrographs at the outflow of the grid box for major basins (kg/dt)
+    REAL(r_std), INTENT(out)                     :: slowflow_diag(nbpt)       !! Hydrographs of slow_flow = routed slow_flow for major basins (kg/dt)
+    REAL(r_std), INTENT(out)                     :: flood_frac(nbpt)          !! Flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), INTENT(out)                     :: flood_res(nbpt)           !! Diagnostic of water amount in the floodplains reservoir (kg)
+
+    REAL(r_std), INTENT(out)                     :: netflow_stream_diag(nbpt) !! Input - Output flow to stream reservoir
+    REAL(r_std), INTENT(out)                     :: netflow_fast_diag(nbpt)   !! Input - Output flow to fast reservoir
+    REAL(r_std), INTENT(out)                     :: netflow_slow_diag(nbpt)   !! Input - Output flow to slow reservoir
+    !
+!! LOCAL VARIABLES
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: fast_flow                 !! Outflow from the fast reservoir (kg/dt)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: slow_flow                 !! Outflow from the slow reservoir (kg/dt)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: stream_flow               !! Outflow from the stream reservoir (kg/dt)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: flood_flow                !! Outflow from the floodplain reservoir (kg/dt)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: pond_inflow               !! Inflow to the pond reservoir (kg/dt)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: pond_drainage             !! Drainage from pond (kg/m^2/dt)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: flood_drainage            !! Drainage from floodplains (kg/m^2/dt)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: return_swamp              !! Inflow to the swamp (kg/dt)
+    !
+    ! Irrigation per basin
+    !
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: irrig_needs               !! Total irrigation requirement (water requirements by the crop for its optimal growth) (kg)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: irrig_actual              !! Possible irrigation according to the water availability in the reservoirs (kg)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: irrig_deficit             !! Amount of water missing for irrigation (kg)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: irrig_adduct              !! Amount of water carried over from other basins for irrigation (kg)
+    !
+    REAL(r_std), DIMENSION(nbpt, 0:nbasmax+3)    :: transport                 !! Water transport between basins (kg/dt)
+    REAL(r_std), DIMENSION(nbp_glo, 0:nbasmax+3) :: transport_glo             !! Water transport between basins (kg/dt)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: floods                    !! Water flow in to the floodplains (kg/dt)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: potflood                  !! Potential inflow to the swamps (kg/dt)
+    REAL(r_std), DIMENSION(nbpt)                 :: tobeflooded               !! Maximal surface which can be inundated in each grid box (m^2)
+    REAL(r_std), DIMENSION(nbpt)                 :: totarea                   !! Total area of basin (m^2)
+    REAL(r_std), DIMENSION(nbpt)                 :: totflood                  !! Total amount of water in the floodplains reservoir (kg)
+    REAL(r_std), DIMENSION(nbasmax)              :: pond_excessflow           !! 
+    REAL(r_std)                                  :: flow                      !! Outflow computation for the reservoirs (kg/dt)
+    REAL(r_std)                                  :: floodindex                !! Fraction of grid box area inundated (unitless;0-1)
+    REAL(r_std)                                  :: pondex                    !! 
+    REAL(r_std)                                  :: flood_frac_pot            !! Total fraction of the grid box which is flooded at optimum repartition (unitless;0-1)
+    REAL(r_std)                                  :: stream_tot                !! Total water amount in the stream reservoirs (kg)
+    REAL(r_std)                                  :: adduction                 !! Importation of water from a stream reservoir of a neighboring grid box (kg)
+    REAL(r_std), DIMENSION(nbp_glo)              :: lake_overflow_g           !! Removed water from lake reservoir on global grid (kg/gridcell/dt_routing)
+    REAL(r_std), DIMENSION(nbpt)                 :: lake_overflow             !! Removed water from lake reservoir on local grid (kg/gridcell/dt_routing)
+    REAL(r_std), DIMENSION(nbpt)                 :: lake_overflow_coast       !! lake_overflow distributed on coast gridcells, only diag(kg/gridcell/dt_routing)
+    REAL(r_std)                                  :: total_lake_overflow       !! Sum of lake_overflow over full grid (kg)
+    REAL(r_std), DIMENSION(8,nbasmax)            :: streams_around            !! Stream reservoirs of the neighboring grid boxes (kg)
+    INTEGER(i_std), DIMENSION(8)                 :: igrd                      !! 
+    INTEGER(i_std), DIMENSION(2)                 :: ff                        !! 
+    INTEGER(i_std), DIMENSION(1)                 :: fi                        !! 
+    INTEGER(i_std)                               :: ig, ib, ib2, ig2          !! Indices (unitless)
+    INTEGER(i_std)                               :: rtg, rtb, in              !! Indices (unitless)
+    INTEGER(i_std)                               :: ier                       !! Error handling 
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: fast_flow_g               !! Outflow from the fast reservoir (kg/dt)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: slow_flow_g               !! Outflow from the slow reservoir (kg/dt)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: stream_flow_g             !! Outflow from the stream reservoir (kg/dt)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: irrig_deficit_glo         !! Amount of water missing for irrigation (kg)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: stream_reservoir_glo      !! Water amount in the stream reservoir (kg)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: irrig_adduct_glo          !! Amount of water carried over from other basins for irrigation (kg)
+
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: netflow_stream            !! Input - Output flow to stream reservoir
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: netflow_fast              !! Input - Output flow to fast reservoir
+    REAL(r_std), DIMENSION(nbpt, nbasmax)        :: netflow_slow              !! Input - Output flow to slow reservoir
+
+
+    !! PARAMETERS
+    LOGICAL, PARAMETER                           :: check_reservoir = .FALSE. !! Logical to choose if we write informations when a negative amount of water is occurring in a reservoir (true/false)
+!_ ================================================================================================================================
+    !
+    transport(:,:) = zero
+    transport_glo(:,:) = zero
+    irrig_netereq(:) = zero
+    irrig_needs(:,:) = zero
+    irrig_actual(:,:) = zero
+    irrig_deficit(:,:) = zero
+    irrig_adduct(:,:) = zero
+    totarea(:) = zero
+    totflood(:) = zero
+    !
+    ! Compute all the fluxes
+    !
+    DO ib=1,nbasmax
+       DO ig=1,nbpt
+          !
+          totarea(ig) = totarea(ig) + routing_area(ig,ib)
+          totflood(ig) = totflood(ig) + flood_reservoir(ig,ib)
+       ENDDO
+    ENDDO
+          !
+!> The outflow fluxes from the three reservoirs are computed. 
+!> The outflow of volume of water Vi into the reservoir i is assumed to be linearly related to its volume.
+!> The water travel simulated by the routing scheme is dependent on the water retention index topo_resid
+!> given by a 0.5 degree resolution map for each pixel performed from a simplification of Manning's formula
+!> (Dingman, 1994; Ducharne et al., 2003).
+!> The resulting product of tcst (in day/m) and topo_resid (in m) represents the time constant (day)
+!> which is an e-folding time, the time necessary for the water amount
+!> in the stream reservoir to decrease by a factor e. Hence, it gives an order of
+!> magnitude of the travel time through this reservoir between
+!> the sub-basin considered and its downstream neighbor.
+
+    DO ib=1,nbasmax
+       DO ig=1,nbpt
+          IF ( route_tobasin(ig,ib) .GT. 0 ) THEN
+             !
+             ! Each of the fluxes is limited by the water in the reservoir and a small margin 
+             ! (min_reservoir) to avoid rounding errors.
+             !
+             flow = MIN(fast_reservoir(ig,ib)/((topo_resid(ig,ib)/1000.)*fast_tcst*one_day/dt_routing),&
+                  & fast_reservoir(ig,ib)-min_sechiba)
+             fast_flow(ig,ib) = MAX(flow, zero)
+
+             flow = MIN(slow_reservoir(ig,ib)/((topo_resid(ig,ib)/1000.)*slow_tcst*one_day/dt_routing),&
+                  & slow_reservoir(ig,ib)-min_sechiba)
+             slow_flow(ig,ib) = MAX(flow, zero)
+
+             flow = MIN(stream_reservoir(ig,ib)/((topo_resid(ig,ib)/1000.)*stream_tcst* & 
+                  & MAX(un-SQRT(flood_frac_bas(ig,ib)),min_sechiba)*one_day/dt_routing),&
+                  & stream_reservoir(ig,ib)-min_sechiba)
+             stream_flow(ig,ib) = MAX(flow, zero)
+             !
+          ELSE
+             fast_flow(ig,ib) = zero
+             slow_flow(ig,ib) = zero
+             stream_flow(ig,ib) = zero
+          ENDIF
+       ENDDO
+    ENDDO
+    !-
+    !- Compute the fluxes out of the floodplains and ponds if they exist.
+    !-
+    IF (do_floodplains .OR. doponds) THEN
+       DO ig=1,nbpt
+          IF (flood_frac(ig) .GT. min_sechiba) THEN
+             !
+             flow = MIN(floodout(ig)*totarea(ig)*pond_frac(ig)/flood_frac(ig), pond_reservoir(ig)+totflood(ig))
+             pondex = MAX(flow - pond_reservoir(ig), zero)
+             pond_reservoir(ig) = pond_reservoir(ig) - (flow - pondex) 
+             !
+             ! If demand was over reservoir size, we will take it out from floodplains
+             !
+             pond_excessflow(:) = zero
+             DO ib=1,nbasmax
+                pond_excessflow(ib) = MIN(pondex*flood_frac_bas(ig,ib)/(flood_frac(ig)-pond_frac(ig)),&
+                     &                    flood_reservoir(ig,ib))
+                pondex = pondex - pond_excessflow(ib)
+             ENDDO
+             !
+             IF ( pondex .GT. min_sechiba) THEN
+                WRITE(numout,*) "Unable to redistribute the excess pond outflow over the water available in the floodplain."
+                WRITE(numout,*) "Pondex = ", pondex
+                WRITE(numout,*) "pond_excessflow(:) = ", pond_excessflow(:)
+             ENDIF
+             !
+             DO ib=1,nbasmax
+                !
+                flow = floodout(ig)*routing_area(ig,ib)*flood_frac_bas(ig,ib)/flood_frac(ig) + pond_excessflow(ib)
+                !
+                flood_reservoir(ig,ib) = flood_reservoir(ig,ib) - flow
+                !
+                !
+                IF (flood_reservoir(ig,ib) .LT. min_sechiba) THEN
+                   flood_reservoir(ig,ib) = zero
+                ENDIF
+                IF (pond_reservoir(ig) .LT. min_sechiba) THEN
+                   pond_reservoir(ig) = zero
+                ENDIF
+             ENDDO
+          ENDIF
+       ENDDO
+    ENDIF
+
+    !-
+    !- Computing the drainage and outflow from floodplains
+!> Drainage from floodplains is depending on a averaged conductivity (k_litt) 
+!> for saturated infiltration in the 'litter' layer. Flood_drainage will be
+!> a component of the total reinfiltration that leaves the routing scheme.
+    !-
+    IF (do_floodplains) THEN
+       IF (dofloodinfilt) THEN
+          DO ib=1,nbasmax
+             DO ig=1,nbpt
+                flood_drainage(ig,ib) = MAX(zero, MIN(flood_reservoir(ig,ib), &
+                     & flood_frac(ig)*routing_area(ig,ib)*k_litt(ig)*dt_routing/one_day))
+                flood_reservoir(ig,ib) = flood_reservoir(ig,ib) - flood_drainage(ig,ib)
+             ENDDO
+          ENDDO
+       ELSE
+          DO ib=1,nbasmax
+             DO ig=1,nbpt
+                flood_drainage(ig,ib) = zero 
+             ENDDO
+          ENDDO
+       ENDIF
+!> Outflow from floodplains is computed depending a delay. This delay is characterized by a time constant
+!> function of the surface of the floodplains and the product of topo_resid and flood_tcst. flood_tcst
+!> has been calibrated through observations in the Niger Inner Delta (D'Orgeval, 2006).
+!
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             IF ( route_tobasin(ig,ib) .GT. 0 ) THEN
+                IF (flood_frac_bas(ig,ib) .GT. min_sechiba) THEN
+                   flow = MIN(flood_reservoir(ig,ib)  &
+                        & /((topo_resid(ig,ib)/1000.)*flood_tcst* &
+                        & flood_frac_bas(ig,ib)*one_day/dt_routing),&
+                        & flood_reservoir(ig,ib))
+                ELSE
+                   flow = zero
+                ENDIF
+                flood_flow(ig,ib) = flow
+             ELSE
+                flood_flow(ig,ib) = zero
+             ENDIF
+          ENDDO
+       ENDDO
+    ELSE
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             flood_drainage(ig,ib) = zero
+             flood_flow(ig,ib) = zero
+             flood_reservoir(ig,ib) = zero
+          ENDDO
+       ENDDO
+    ENDIF
+
+    !-
+    !- Computing drainage and inflow for ponds
+!> Drainage from ponds is computed in the same way than for floodplains.
+!> Reinfiltrated fraction from the runoff (i.e. the outflow from the fast reservoir)
+!> is the inflow of the pond reservoir.
+    !-
+    IF (doponds) THEN
+       ! If used, the slope coef is not used in hydrol for water2infilt
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             pond_inflow(ig,ib) = fast_flow(ig,ib) * reinf_slope(ig)
+             pond_drainage(ig,ib) = MIN(pond_reservoir(ig)*routing_area(ig,ib)/totarea(ig), &
+                  & pond_frac(ig)*routing_area(ig,ib)*k_litt(ig)*dt_routing/one_day)
+             fast_flow(ig,ib) = fast_flow(ig,ib) - pond_inflow(ig,ib) 
+          ENDDO
+       ENDDO
+    ELSE
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             pond_inflow(ig,ib) = zero
+             pond_drainage(ig,ib) = zero
+             pond_reservoir(ig) = zero
+          ENDDO
+       ENDDO
+    ENDIF
+
+!ym cette methode conserve les erreurs d'arrondie
+!ym mais n'est pas la plus efficace
+
+    !-
+    !- Compute the transport from one basin to another
+    !-
+
+    IF (is_root_prc)  THEN
+       ALLOCATE( fast_flow_g(nbp_glo, nbasmax), slow_flow_g(nbp_glo, nbasmax), &
+            stream_flow_g(nbp_glo, nbasmax), stat=ier)
+    ELSE
+       ALLOCATE( fast_flow_g(1,1), slow_flow_g(1,1), &
+            stream_flow_g(1, 1), stat=ier)
+    ENDIF
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_flow','Pb in allocate for fast_flow_g','','')
+       
+    CALL gather(fast_flow,fast_flow_g)
+    CALL gather(slow_flow,slow_flow_g)
+    CALL gather(stream_flow,stream_flow_g)
+
+    IF (is_root_prc) THEN
+       DO ib=1,nbasmax
+          DO ig=1,nbp_glo
+             !
+             rtg = route_togrid_glo(ig,ib)
+             rtb = route_tobasin_glo(ig,ib)
+             transport_glo(rtg,rtb) = transport_glo(rtg,rtb) + fast_flow_g(ig,ib) + slow_flow_g(ig,ib) + &
+                  & stream_flow_g(ig,ib)
+             !
+          ENDDO
+       ENDDO
+    ENDIF
+
+    DEALLOCATE( fast_flow_g, slow_flow_g, stream_flow_g )
+   
+    CALL scatter(transport_glo,transport)
+
+    !-
+    !- Do the floodings - First initialize
+    !-
+    return_swamp(:,:)=zero
+    floods(:,:)=zero
+    !-
+!> Over swamp areas, a fraction of water (return_swamp) is withdrawn from the river depending on the
+!> parameter swamp_cst.
+!> It will be transferred into soil moisture and thus does not return directly to the river.
+    !
+    !- 1. Swamps: Take out water from the river to put it to the swamps
+    !-
+    !
+    IF ( doswamps ) THEN
+       tobeflooded(:) = swamp(:)
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             potflood(ig,ib) = transport(ig,ib) 
+             !
+             IF ( tobeflooded(ig) > 0. .AND. potflood(ig,ib) > 0. .AND. floodtemp(ig) > tp_00 ) THEN
+                !
+                IF (routing_area(ig,ib) > tobeflooded(ig)) THEN
+                   floodindex = tobeflooded(ig) / routing_area(ig,ib)
+                ELSE
+                   floodindex = 1.0
+                ENDIF
+                return_swamp(ig,ib) = swamp_cst * potflood(ig,ib) * floodindex
+                !
+                tobeflooded(ig) = tobeflooded(ig) - routing_area(ig,ib) 
+                !
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDIF
+    !-
+    !- 2. Floodplains: Update the reservoir with the flux computed above.
+    !-
+    IF ( do_floodplains ) THEN
+       DO ig=1,nbpt
+          IF (floodplains(ig) .GT. min_sechiba .AND. floodtemp(ig) .GT. tp_00) THEN
+             DO ib=1,nbasmax
+                floods(ig,ib) = transport(ig,ib) - return_swamp(ig,ib) 
+             ENDDO
+          ENDIF
+       ENDDO
+    ENDIF
+    !
+    ! Update all reservoirs
+!> The slow and deep reservoir (slow_reservoir) collect the deep drainage whereas the
+!> fast_reservoir collects the computed surface runoff. Both discharge into a third reservoir
+!> (stream_reservoir) of the next sub-basin downstream.
+!> Water from the floodplains reservoir (flood_reservoir) flows also into the stream_reservoir of the next sub-basin downstream.
+!> Water that flows into the pond_reservoir is withdrawn from the fast_reservoir.
+    !
+    DO ig=1,nbpt
+       DO ib=1,nbasmax
+          !
+          fast_reservoir(ig,ib) =  fast_reservoir(ig,ib) + runoff(ig)*routing_area(ig,ib) - &
+               & fast_flow(ig,ib) - pond_inflow(ig,ib)
+          !
+          slow_reservoir(ig,ib) = slow_reservoir(ig,ib) + drainage(ig)*routing_area(ig,ib) - &
+               & slow_flow(ig,ib)
+          !
+          stream_reservoir(ig,ib) = stream_reservoir(ig,ib) + flood_flow(ig,ib) + transport(ig,ib) - &
+               & stream_flow(ig,ib) - return_swamp(ig,ib) - floods(ig,ib)
+          !
+          flood_reservoir(ig,ib) = flood_reservoir(ig,ib) + floods(ig,ib) - &
+               & flood_flow(ig,ib) 
+          !
+          pond_reservoir(ig) = pond_reservoir(ig) + pond_inflow(ig,ib) - pond_drainage(ig,ib)
+          !
+          IF ( flood_reservoir(ig,ib) .LT. zero ) THEN
+             IF ( check_reservoir ) THEN
+                WRITE(numout,*) "WARNING : negative flood reservoir at :", ig, ib, ". Problem is being corrected."
+                WRITE(numout,*) "flood_reservoir, floods, flood_flow : ", flood_reservoir(ig,ib), floods(ig,ib), &
+                     & flood_flow(ig,ib) 
+             ENDIF
+             stream_reservoir(ig,ib) = stream_reservoir(ig,ib) + flood_reservoir(ig,ib)
+             flood_reservoir(ig,ib) = zero
+          ENDIF
+          !
+          IF ( stream_reservoir(ig,ib) .LT. zero ) THEN
+             IF ( check_reservoir ) THEN
+                WRITE(numout,*) "WARNING : negative stream reservoir at :", ig, ib, ". Problem is being corrected."
+                WRITE(numout,*) "stream_reservoir, flood_flow, transport : ", stream_reservoir(ig,ib), flood_flow(ig,ib), &
+                     &  transport(ig,ib)
+                WRITE(numout,*) "stream_flow, return_swamp, floods :", stream_flow(ig,ib), return_swamp(ig,ib), floods(ig,ib)
+             ENDIF
+             fast_reservoir(ig,ib) =  fast_reservoir(ig,ib) + stream_reservoir(ig,ib)
+             stream_reservoir(ig,ib) = zero
+          ENDIF
+          !
+          IF ( fast_reservoir(ig,ib) .LT. zero ) THEN
+             IF ( check_reservoir ) THEN
+                WRITE(numout,*) "WARNING : negative fast reservoir at :", ig, ib, ". Problem is being corrected."
+                WRITE(numout,*) "fast_reservoir, runoff, fast_flow, ponf_inflow  : ", fast_reservoir(ig,ib), &
+                     &runoff(ig), fast_flow(ig,ib), pond_inflow(ig,ib)
+             ENDIF
+             slow_reservoir(ig,ib) =  slow_reservoir(ig,ib) + fast_reservoir(ig,ib)
+             fast_reservoir(ig,ib) = zero
+          ENDIF
+
+          IF ( slow_reservoir(ig,ib) .LT. - min_sechiba ) THEN
+             WRITE(numout,*) 'WARNING : There is a negative reservoir at :', ig, ib,lalo(ig,:)
+             WRITE(numout,*) 'WARNING : slowr, slow_flow, drainage', &
+                  & slow_reservoir(ig,ib), slow_flow(ig,ib), drainage(ig)
+             WRITE(numout,*) 'WARNING : pondr, pond_inflow, pond_drainage', &
+                  & pond_reservoir(ig), pond_inflow(ig,ib), pond_drainage(ig,ib)
+             CALL ipslerr_p(2, 'routing_flow', 'WARNING negative slow_reservoir.','','')
+          ENDIF
+
+       ENDDO
+    ENDDO
+
+
+    totflood(:) = zero
+    DO ig=1,nbpt
+       DO ib=1,nbasmax
+          totflood(ig) = totflood(ig) + flood_reservoir(ig,ib)
+       ENDDO
+    ENDDO
+
+    !-
+    !- Computes the fraction of floodplains and ponds according to their volume
+    !-
+    IF (do_floodplains .OR. doponds) THEN
+       flood_frac(:) = zero
+       flood_height(:) = zero
+       flood_frac_bas(:,:) = zero
+       DO ig=1, nbpt
+          IF (totflood(ig) .GT. min_sechiba) THEN
+             ! We first compute the total fraction of the grid box which is flooded at optimum repartition
+             flood_frac_pot = (totflood(ig) / (totarea(ig)*floodcri/(beta+un)))**(beta/(beta+un))
+             flood_frac(ig) = MIN(floodplains(ig) / totarea(ig), flood_frac_pot)
+             ! Then we diagnose the fraction for each basin with the size of its flood_reservoir 
+             ! (flood_frac_bas may be > 1)
+             DO ib=1,nbasmax
+                IF (routing_area(ig,ib) .GT. min_sechiba) THEN
+                   flood_frac_bas(ig,ib) = flood_frac(ig) * &
+                        & (flood_reservoir(ig,ib) / totflood(ig)) / (routing_area(ig,ib) / totarea(ig))
+                ENDIF
+             ENDDO
+             ! We diagnose the maximum height of floodplain
+             flood_height(ig) = (beta/(beta+1))*floodcri*(flood_frac(ig))**(un/beta) + totflood(ig)/(totarea(ig)*flood_frac(ig)) 
+             ! And finally add the pond surface
+             pond_frac(ig) = MIN(un-flood_frac(ig), ((betap+1)*pond_reservoir(ig) / (pondcri*totarea(ig)))**(betap/(betap+1)) ) 
+             flood_frac(ig) = flood_frac(ig) + pond_frac(ig)
+             !
+          ENDIF
+       ENDDO
+    ELSE
+       flood_frac(:) = zero
+       flood_height(:) = zero
+       flood_frac_bas(:,:) = zero
+    ENDIF
+
+    !-
+    !- Compute the total reinfiltration and returnflow to the grid box
+!> A term of returnflow is computed including the water from the swamps that does not return directly to the river
+!> but will be put into soil moisture (see hydrol module).
+!> A term of reinfiltration is computed including the water that reinfiltrated from the ponds and floodplains areas.
+!> It will be put into soil moisture (see hydrol module).
+    !-
+    IF (do_floodplains .OR. doswamps .OR. doponds) THEN
+       returnflow(:) = zero
+       reinfiltration(:) = zero
+       !
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             returnflow(ig) =  returnflow(ig) + return_swamp(ig,ib)
+             reinfiltration(ig) =  reinfiltration(ig) + pond_drainage(ig,ib) + flood_drainage(ig,ib) 
+          ENDDO
+       ENDDO
+       !
+       DO ig=1,nbpt
+          returnflow(ig) = returnflow(ig)/totarea(ig)
+          reinfiltration(ig) = reinfiltration(ig)/totarea(ig)
+       ENDDO
+    ELSE
+       returnflow(:) = zero
+       reinfiltration(:) = zero
+    ENDIF
+
+    !
+    ! Compute the net irrigation requirement from Univ of Kassel
+    !
+    ! This is a very low priority process and thus only applies if
+    ! there is some water left in the reservoirs after all other things.
+    !
+!> The computation of the irrigation is performed here.
+!> * First step
+!> In a first time, the water requirements (irrig_netereq) by the crops for their optimal growth are calculated
+!> over each irrigated fraction (irrigated(ig)/totarea(ig)). It is the difference
+!> between the maximal water loss by the crops (transpot_mean) and the net water amount kept by the soil
+!> (precipitation and reinfiltration). Transpot_mean is computed in the routines enerbil and diffuco. It
+!> is derived from the effective transpiration parametrization under stress-free conditions, called potential transpiration.
+!> Crop_coef was used by a previous parametrization of irrigation in the code. Here, its value is equal to one.
+!> The crop coefficient was constant in space and time to represent a mean resistance of the vegetation to the potential evaporation.
+!> Now, the term crop_coef*Epot is substituted by transpot_mean (see Guimberteau et al., 2011).
+!> * Second step
+!> We compute irrigation needs in order to supply Irrig_netereq. Water for irrigation (irrig_actual) is withdrawn
+!> from the reservoirs. The amount of water is withdrawn in priority from the stream reservoir.
+!> If the irrigation requirement is higher than the water availability of the reservoir, water is withdrawn
+!> from the fast reservoir or, in the extreme case, from the slow reservoir.
+!> * Third step
+!> We compute a deficit in water for irrigation. If it is positive, irrigation (depending on water availibility in the reservoirs)
+!> has not supplied the crops requirements.
+!
+    IF ( do_irrigation ) THEN
+       DO ig=1,nbpt
+          !
+          IF ((vegtot(ig) .GT. min_sechiba) .AND. (humrel(ig) .LT. un-min_sechiba) .AND. &
+               & (runoff(ig) .LT. min_sechiba) ) THEN
+             
+             irrig_netereq(ig) = (irrigated(ig) / totarea(ig) ) * MAX(zero, transpot_mean(ig) - &
+                  & (precip(ig)+reinfiltration(ig)) )
+             
+          ENDIF
+          !
+          DO ib=1,nbasmax
+             IF ( routing_area(ig,ib) .GT. 0 ) THEN
+             
+                irrig_needs(ig,ib) = irrig_netereq(ig) * routing_area(ig,ib)
+
+                irrig_actual(ig,ib) = MIN(irrig_needs(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)-irrig_actual(ig,ib))))
+
+                fast_reservoir(ig,ib) = MAX( zero, &
+                     &  fast_reservoir(ig,ib) + MIN(zero, stream_reservoir(ig,ib)-irrig_actual(ig,ib)))
+
+                stream_reservoir(ig,ib) = MAX(zero, stream_reservoir(ig,ib)-irrig_actual(ig,ib) )
+
+                irrig_deficit(ig,ib) = irrig_needs(ig,ib)-irrig_actual(ig,ib)
+
+             ENDIF
+          ENDDO
+          !
+          ! Check if we cannot find the missing water in another basin of the same grid (stream reservoir only).
+          ! If we find that then we create some adduction from that subbasin to the one where we need it for
+          ! irrigation.
+          !
+!> If crops water requirements have not been supplied (irrig_deficit>0), we check if we cannot find the missing water
+!> in another basin of the same grid. If there is water in the stream reservoir of this subbasin, we create some adduction
+!> from that subbasin to the one where we need it for irrigation.
+!> 
+          DO ib=1,nbasmax
+
+             stream_tot = SUM(stream_reservoir(ig,:))
+
+             DO WHILE ( irrig_deficit(ig,ib) > min_sechiba .AND. stream_tot > min_sechiba)
+                
+                fi = MAXLOC(stream_reservoir(ig,:))
+                ib2 = fi(1)
+
+                irrig_adduct(ig,ib) = MIN(irrig_deficit(ig,ib), stream_reservoir(ig,ib2))
+                stream_reservoir(ig,ib2) = stream_reservoir(ig,ib2)-irrig_adduct(ig,ib)
+                irrig_deficit(ig,ib) = irrig_deficit(ig,ib)-irrig_adduct(ig,ib)
+             
+                stream_tot = SUM(stream_reservoir(ig,:))
+                
+             ENDDO
+             
+          ENDDO
+          !
+       ENDDO
+       !
+       ! If we are at higher resolution we might need to look at neighboring grid boxes to find the streams
+       ! which can feed irrigation
+!
+!> At higher resolution (grid box smaller than 100x100km), we can import water from neighboring grid boxes
+!> to the one where we need it for irrigation.
+       !
+       IF (is_root_prc) THEN
+          ALLOCATE(irrig_deficit_glo(nbp_glo, nbasmax), stream_reservoir_glo(nbp_glo, nbasmax), &
+               &        irrig_adduct_glo(nbp_glo, nbasmax), stat=ier)
+       ELSE
+          ALLOCATE(irrig_deficit_glo(0, 0), stream_reservoir_glo(0, 0), &
+               &        irrig_adduct_glo(0, 0), stat=ier)
+       ENDIF
+       IF (ier /= 0) CALL ipslerr_p(3,'routing_flow','Pb in allocate for irrig_deficit_glo, stream_reservoir_glo,...','','')
+
+       CALL gather(irrig_deficit, irrig_deficit_glo)
+       CALL gather(stream_reservoir,  stream_reservoir_glo)
+       CALL gather(irrig_adduct, irrig_adduct_glo)
+
+       IF (is_root_prc) THEN
+          !
+          DO ig=1,nbp_glo
+             ! Only work if the grid box is smaller than 100x100km. Else the piplines we build
+             ! here would be too long to be reasonable.
+             IF ( resolution_g(ig,1) < 100000. .AND. resolution_g(ig,2) < 100000. ) THEN
+                DO ib=1,nbasmax
+                   !
+                   IF ( irrig_deficit_glo(ig,ib)  > min_sechiba ) THEN
+                      !
+                      streams_around(:,:) = zero
+                      !
+                      DO in=1,NbNeighb
+                         ig2 = neighbours_g(ig,in)
+                         IF (ig2 .GT. 0 ) THEN
+                            streams_around(in,:) = stream_reservoir_glo(ig2,:)
+                            igrd(in) = ig2
+                         ENDIF
+                      ENDDO
+                      !
+                      IF ( MAXVAL(streams_around) .GT. zero ) THEN
+                         !
+                         ff=MAXLOC(streams_around)
+                         ig2=igrd(ff(1))
+                         ib2=ff(2)
+                         !
+                         IF ( routing_area_glo(ig2,ib2) .GT. 0 .AND. stream_reservoir_glo(ig2,ib2) > zero ) THEN
+                            adduction = MIN(irrig_deficit_glo(ig,ib), stream_reservoir_glo(ig2,ib2))
+                            stream_reservoir_glo(ig2,ib2) = stream_reservoir_glo(ig2,ib2) - adduction
+                            irrig_deficit_glo(ig,ib) = irrig_deficit_glo(ig,ib) - adduction
+                            irrig_adduct_glo(ig,ib) = irrig_adduct_glo(ig,ib) + adduction
+                         ENDIF
+                         !
+                      ENDIF
+                      !
+                   ENDIF
+                   !
+                ENDDO
+             ENDIF
+          ENDDO
+          !
+       ENDIF
+       !
+
+       CALL scatter(irrig_deficit_glo, irrig_deficit)
+       CALL scatter(stream_reservoir_glo,  stream_reservoir)
+       CALL scatter(irrig_adduct_glo, irrig_adduct)
+
+       DEALLOCATE(irrig_deficit_glo, stream_reservoir_glo, irrig_adduct_glo)
+
+    ENDIF
+
+    !! Calculate the net water flow to each routing reservoir (in kg/dt)
+    !! to further diagnose the corresponding water budget residu
+    !! in routing_main
+
+    netflow_fast_diag(:) = zero
+    netflow_slow_diag(:) = zero
+    netflow_stream_diag(:) = zero
+
+    DO ib=1,nbasmax
+       DO ig=1,nbpt
+          netflow_fast_diag(ig) = netflow_fast_diag(ig) + runoff(ig)*routing_area(ig,ib) &
+               - fast_flow(ig,ib) - pond_inflow(ig,ib)
+          netflow_slow_diag(ig) = netflow_slow_diag(ig) + drainage(ig)*routing_area(ig,ib) &
+               - slow_flow(ig,ib)
+          netflow_stream_diag(ig) = netflow_stream_diag(ig) + flood_flow(ig,ib) + transport(ig,ib) &
+               - stream_flow(ig,ib) - return_swamp(ig,ib) - floods(ig,ib)
+       ENDDO
+    ENDDO
+
+    !! Grid cell averaging
+    DO ig=1,nbpt
+       netflow_fast_diag(ig) = netflow_fast_diag(ig)/totarea(ig)
+       netflow_slow_diag(ig) = netflow_slow_diag(ig)/totarea(ig)
+       netflow_stream_diag(ig) = netflow_stream_diag(ig)/totarea(ig)
+    ENDDO
+
+    !
+    !
+    ! Compute the fluxes which leave the routing scheme
+    !
+    ! Lakeinflow is in Kg/dt
+    ! returnflow is in Kg/m^2/dt
+    !
+    hydrographs(:) = zero
+    slowflow_diag(:) = zero
+    fast_diag(:) = zero
+    slow_diag(:) = zero
+    stream_diag(:) = zero
+    flood_diag(:) =  zero
+    pond_diag(:) =  zero
+    irrigation(:) = zero
+    !
+    !
+    DO ib=1,nbasmax
+       !
+       DO ig=1,nbpt
+          IF (hydrodiag(ig,ib) > 0 ) THEN
+             hydrographs(ig) = hydrographs(ig) + fast_flow(ig,ib) + slow_flow(ig,ib) + & 
+                  &  stream_flow(ig,ib) 
+             slowflow_diag(ig) = slowflow_diag(ig) + slow_flow(ig,ib)
+          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)
+          flood_diag(ig) = flood_diag(ig) + flood_reservoir(ig,ib)
+          irrigation (ig) = irrigation (ig) + irrig_actual(ig,ib) + irrig_adduct(ig,ib)
+       ENDDO
+    ENDDO
+    !
+    DO ig=1,nbpt
+       fast_diag(ig) = fast_diag(ig)/totarea(ig)
+       slow_diag(ig) = slow_diag(ig)/totarea(ig)
+       stream_diag(ig) = stream_diag(ig)/totarea(ig)
+       flood_diag(ig) = flood_diag(ig)/totarea(ig)
+       pond_diag(ig) = pond_reservoir(ig)/totarea(ig)
+       !
+       irrigation(ig) = irrigation(ig)/totarea(ig)
+       !
+       ! The three output types for the routing : endoheric basins,, rivers and 
+       ! diffuse coastal flow.
+       !
+       lakeinflow(ig) = transport(ig,nbasmax+1)
+       coastalflow(ig) = transport(ig,nbasmax+2)
+       riverflow(ig) = transport(ig,nbasmax+3)
+       !
+    ENDDO
+    !
+    flood_res = flood_diag + pond_diag
+    
+
+    !! Remove water from lake reservoir if it exceeds the maximum limit and distribute it 
+    !! uniformly over all possible the coastflow gridcells
+    
+    ! Calculate lake_overflow and remove it from lake_reservoir
+    DO ig=1,nbpt
+       lake_overflow(ig) = MAX(0., lake_reservoir(ig) - max_lake_reservoir*totarea(ig))
+       lake_reservoir(ig) = lake_reservoir(ig) - lake_overflow(ig)
+    END DO
+    ! Transform lake_overflow from kg/grid-cell/dt_routing into kg/m^2/s
+    CALL xios_orchidee_send_field("lake_overflow",lake_overflow/totarea(:)/dt_routing)
+
+
+    ! Calculate the sum of the lake_overflow and distribute it uniformly over all gridboxes
+    CALL gather(lake_overflow,lake_overflow_g)
+    IF (is_root_prc) THEN
+       total_lake_overflow=SUM(lake_overflow_g)
+    END IF
+    CALL bcast(total_lake_overflow)
+
+    ! Distribute the lake_overflow uniformly over all coastal gridcells
+    ! lake_overflow_coast is only calculated to be used as diagnostics if needed
+    DO ig=1,nbpt
+       coastalflow(ig) = coastalflow(ig) + total_lake_overflow/nb_coast_gridcells * mask_coast(ig)
+       lake_overflow_coast(ig) = total_lake_overflow/nb_coast_gridcells * mask_coast(ig)
+    END DO
+    ! Transform from kg/grid-cell/dt_routing into m^3/grid-cell/s to match 
+    ! output unit of coastalflow  
+    CALL xios_orchidee_send_field("lake_overflow_coast",lake_overflow_coast/mille/dt_routing) 
+
+  END SUBROUTINE routing_flow
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_lake
+!!
+!>\BRIEF        : This subroutine stores water in lakes so that it does not cycle through the runoff.
+!!                For the moment it only works for endoheric lakes but I can be extended in the future.
+!!
+!! DESCRIPTION (definitions, functional, design, flags): The return flow to the soil moisture reservoir
+!! is based on a maximum lake evaporation rate (maxevap_lake). \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_lake(nbpt, dt_routing, lakeinflow, humrel, return_lakes)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in) :: nbpt               !! Domain size (unitless)
+    REAL(r_std), INTENT (in)   :: dt_routing         !! Routing time step (s)
+    REAL(r_std), INTENT(out)    :: lakeinflow(nbpt)   !! Water inflow to the lakes (kg/dt)
+    REAL(r_std), INTENT(in)    :: humrel(nbpt)       !! Soil moisture stress, root extraction potential (unitless)
+    !
+!! OUTPUT VARIABLES
+    REAL(r_std), INTENT(out)   :: return_lakes(nbpt) !! Water from lakes flowing back into soil moisture (kg/m^2/dt)
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)             :: ig                 !! Indices (unitless)
+    REAL(r_std)                :: refill             !!
+    REAL(r_std)                :: total_area         !! Sum of all the surfaces of the basins (m^2)
+
+!_ ================================================================================================================================
+    !
+    !
+    DO ig=1,nbpt
+       !
+       total_area = SUM(routing_area(ig,:))
+       !
+       lake_reservoir(ig) = lake_reservoir(ig) + lakeinflow(ig)
+       
+       IF ( doswamps ) THEN
+          ! Calculate a return flow that will be extracted from the lake reservoir and reinserted in the soil in hydrol
+          ! Uptake in Kg/dt
+          refill = MAX(zero, maxevap_lake * (un - humrel(ig)) * dt_routing * total_area)
+          return_lakes(ig) = MIN(refill, lake_reservoir(ig))
+          lake_reservoir(ig) = lake_reservoir(ig) - return_lakes(ig)
+          ! Return in Kg/m^2/dt
+          return_lakes(ig) = return_lakes(ig)/total_area
+       ELSE
+          return_lakes(ig) = zero
+       ENDIF
+
+       ! This is the volume of the lake scaled to the entire grid.
+       ! It would be better to scale it to the size of the lake
+       ! but this information is not yet available.
+       lake_diag(ig) = lake_reservoir(ig)/total_area
+
+       lakeinflow(ig) = lakeinflow(ig)/total_area
+
+    ENDDO
+    !
+  END SUBROUTINE routing_lake
+  !
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_diagnostic_p
+!!
+!>\BRIEF         This parallelized subroutine gives a diagnostic of the basins used
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_diagnostic_p(nbpt, index, lalo, resolution, contfrac, hist_id, hist2_id)
+    !
+    IMPLICIT NONE
+    
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)      :: nbpt               !! Domain size (unitless)
+    INTEGER(i_std), INTENT(in)      :: index(nbpt)        !! Indices of the points on the map (unitless)
+    REAL(r_std), INTENT(in)         :: lalo(nbpt,2)       !! Vector of latitude and longitudes (beware of the order !)
+    REAL(r_std), INTENT(in)         :: resolution(nbpt,2) !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)         :: contfrac(nbpt)     !! Fraction of land in each grid box (unitless;0-1)
+    INTEGER(i_std),INTENT (in)      :: hist_id            !! Access to history file (unitless)
+    INTEGER(i_std),INTENT (in)      :: hist2_id           !! Access to history file 2 (unitless)
+    !
+!! LOCAL VARIABLES
+    REAL(r_std), DIMENSION(nbpt)    :: nbrivers           !! Number of rivers in the grid (unitless)
+    REAL(r_std), DIMENSION(nbpt)    :: basinmap           !! Map of basins (unitless)
+    REAL(r_std), DIMENSION(nbp_glo) :: nbrivers_g         !! Number of rivers in the grid (unitless)
+    REAL(r_std), DIMENSION(nbp_glo) :: basinmap_g         !! Map of basins (unitless)
+
+!_ ================================================================================================================================
+    routing_area => routing_area_glo  
+    topo_resid => topo_resid_glo
+    route_togrid => route_togrid_glo
+    route_tobasin => route_tobasin_glo
+    route_nbintobas => route_nbintobas_glo
+    global_basinid => global_basinid_glo
+    hydrodiag=>hydrodiag_glo
+    hydroupbasin=>hydroupbasin_glo
+    
+    IF (is_root_prc) CALL routing_diagnostic(nbp_glo, index_g, lalo_g, resolution_g, contfrac_g, nbrivers_g,basinmap_g)
+
+    routing_area => routing_area_loc  
+    topo_resid => topo_resid_loc
+    route_togrid => route_togrid_loc
+    route_tobasin => route_tobasin_loc
+    route_nbintobas => route_nbintobas_loc
+    global_basinid => global_basinid_loc
+    hydrodiag=>hydrodiag_loc
+    hydroupbasin=>hydroupbasin_loc
+    
+    CALL scatter(nbrivers_g,nbrivers)
+    CALL scatter(basinmap_g,basinmap)
+    CALL scatter(hydrodiag_glo,hydrodiag_loc)
+    CALL scatter(hydroupbasin_glo,hydroupbasin_loc)
+       
+    CALL xios_orchidee_send_field("basinmap",basinmap)
+    CALL xios_orchidee_send_field("nbrivers",nbrivers)
+
+    IF ( .NOT. almaoutput ) THEN
+       CALL histwrite_p(hist_id, 'basinmap', 1, basinmap, nbpt, index)
+       CALL histwrite_p(hist_id, 'nbrivers', 1, nbrivers, nbpt, index)
+    ELSE
+    ENDIF
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite_p(hist2_id, 'basinmap', 1, basinmap, nbpt, index)
+          CALL histwrite_p(hist2_id, 'nbrivers', 1, nbrivers, nbpt, index)
+       ELSE
+       ENDIF
+    ENDIF
+    
+        
+  END SUBROUTINE routing_diagnostic_p
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_diagnostic
+!!
+!>\BRIEF         This non-parallelized subroutine gives a diagnostic of the basins used. This produces some information 
+!!               on the rivers which are being diagnosed.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : As not all rivers can be monitored in the model, we will only
+!! archive num_largest rivers. In this routine we will diagnose the num_largest largest rivers and print to the standard
+!! output the names of these basins and their area. The list of names of these largest rivers are taken from a list coded in the 
+!! routine routing_names. As this standard output is not sufficient, we will also write it to a netCDF file with the routine 
+!! routing_diagncfile. It is important to keep for diagnostic the fraction of the largest basins in each grid box and keep information
+!! how they are linked one to the other.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): No output variables.
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_diagnostic(nbpt, l_index, lalo, resolution, contfrac, nbrivers, basinmap)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                   :: nbpt                !! Domain size  (unitless)
+    INTEGER(i_std), INTENT(in)                   :: l_index(nbpt)       !! Indices of the points on the map (unitless)
+    REAL(r_std), INTENT(in)                      :: lalo(nbpt,2)        !! Vector of latitude and longitudes (beware of the order !) 
+    REAL(r_std), INTENT(in)                      :: resolution(nbpt,2)  !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)                      :: contfrac(nbpt)      !! Fraction of land in each grid box (unitless;0-1)
+    !
+!! OUTPUT VARIABLES
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)    :: nbrivers            !! Number of rivers in the grid (unitless)
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)    :: basinmap            !! Map of basins (unitless)
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std), DIMENSION(nbpt,nbasmax)      :: outids              !! IDs of river to which this basin contributes (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: pts                 !! List the points belonging to the basin (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: ptbas               !! List the basin number for this point (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: outpt               !! Outflow point for each basin (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)    :: nb_pts              !! Number of points in the basin (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: totarea             !! Total area of basin (m^2)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: tmparea             !! 
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)    :: topids              !! The IDs of the first num_largest basins (unitless)
+    CHARACTER(LEN=25), ALLOCATABLE, DIMENSION(:) :: basin_names         !! Names of the rivers (unitless)
+    CHARACTER(LEN=25)                            :: name_str            !!
+    !
+    LOGICAL                                      :: river_file          !! Choose to write a description of the rivers (true/false)
+    CHARACTER(LEN=80)                            :: river_file_name     !! Filename in which we write the description of the rivers (unitless)
+    !
+    CHARACTER(LEN=25), ALLOCATABLE, DIMENSION(:)  :: sorted_names       !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: streams_nb         !! Number of streams in basin (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: streams_avehops    !! Average number of hops in streams (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: streams_minhops    !! Minimum number of hops in streams (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: streams_maxhops    !! Minimum number of hops in streams (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)        :: streams_resid      !! Average residence time
+    !
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lbasin_area        !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lbasin_uparea      !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: lrivercode         !!
+    !
+    INTEGER(i_std)                                :: ig, ib, og, ob, ign, ibn, ff(1), ic, icc, nb_small, idbas, slen, ii !! Indices (unitless)
+    INTEGER(i_std)                                :: ier                !! Error handling
+    CHARACTER(LEN=1)                              :: nn                 !!
+    INTEGER(i_std)                                :: name_found         !!
+    !
+    REAL(r_std)                                   :: averesid           !!
+    REAL(r_std), DIMENSION(nbasmax)               :: tmpbas             !!
+    REAL(r_std), DIMENSION(nbpt,nbasmax)          :: areaupbasin        !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: sortedrivs         !!
+    !
+    ! Variables for the river coding
+    !
+    INTEGER(i_std)                               :: longest_river       !!
+    INTEGER(i_std)                               :: nbmax               !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: allstreams          !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: upstreamchange      !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)    :: tstreams, tslen, tpts, tptbas, tcode !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: tuparea             !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: tupstreamchange     !!
+    !
+    LOGICAL                                      :: err_nbpt_grid_basin !! (true/false)
+    LOGICAL                                      :: err_basin_number    !! (true/false)
+
+!_ ================================================================================================================================
+    !
+    !
+    ALLOCATE(pts(num_largest, nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for pts','','')
+
+    ALLOCATE(ptbas(num_largest, nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for ptbas','','')
+
+    ALLOCATE(outpt(num_largest, 2), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for outpt','','')
+
+    ALLOCATE(nb_pts(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for nb_pts','','')
+
+    ALLOCATE(totarea(num_largest), tmparea(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for totarea','','')
+
+    ALLOCATE(topids(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for topids','','')
+
+    ALLOCATE(sortedrivs(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for sortedrivs','','')
+
+    ALLOCATE(sorted_names(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for sorted_names','','')
+
+    ALLOCATE(streams_nb(num_largest), streams_avehops(num_largest), streams_minhops(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for streams_nb','','')
+
+    ALLOCATE(streams_maxhops(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for streams_maxhops','','')
+
+    ALLOCATE(streams_resid(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for streams_resid','','')
+    
+    ALLOCATE(lbasin_area(num_largest,nbpt), lbasin_uparea(num_largest,nbpt), lrivercode(num_largest,nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for lbasin_area','','')
+    
+    IF ( .NOT. is_root_prc) THEN
+       WRITE(numout,*) "routing_diagnostic is not suitable for running in parallel"
+       WRITE(numout,*) "We are here on a non root processor. is_root_prc = ", is_root_prc
+       WRITE(numout,*) "STOP from routing_diagnostic"
+       CALL ipslerr_p(3,'routing_diagnostic','This routine is not suitable for running in parallel','','')
+    ENDIF
+    
+    
+    !Config Key   = RIVER_DESC
+    !Config Desc  = Writes out a description of the rivers
+    !Config If    = RIVER_ROUTING
+    !Config Def   = n
+    !Config Help  = This flag allows to write out a file containing the list of 
+    !Config         rivers which are beeing simulated. It provides location of outflow
+    !Config         drainage area, name and ID.
+    !Config Units = [FLAG]
+    !
+    river_file=.FALSE.
+    CALL getin('RIVER_DESC', river_file)
+    !
+    !Config Key   = RIVER_DESC_FILE
+    !Config Desc  = Filename in which we write the description of the rivers. If suffix is ".nc" a netCDF file is created
+    !Config If    = RIVER_DESC
+    !Config Def   = river_desc.nc
+    !Config Help  = File name where we will write the information. If the suffix is ".nc" a netCDF file is generated. Else
+    !Config         a simple text file will contain some information. The netCDF file is valuable for post-processing the
+    !               data as it will contain the fraction of the large basins in each grid box.
+    !Config Units = [FILE]
+    !
+    river_file_name="river_desc.nc"
+    CALL getin('RIVER_DESC_FILE', river_file_name)
+    !
+    !
+    ! First we get the list of all river outflow points
+    ! We work under the assumption that we only have num_largest basins finishing with
+    ! nbasmax+3. This is checked in routing_truncate.
+    !
+    nb_small = 1
+    outpt(:,:) = -1
+    ic = 0
+    DO ig=1,nbpt
+       DO ib=1,nbasmax
+          ign = route_togrid(ig, ib)
+          ibn = route_tobasin(ig, ib)
+          IF ( ibn .EQ. nbasmax+3) THEN
+             ic = ic + 1
+             outpt(ic,1) = ig
+             outpt(ic,2) = ib
+             !
+             ! Get the largest id of the basins we call a river. This is
+             ! to extract the names of all rivers.
+             !
+             IF ( global_basinid(ig,ib) > nb_small ) THEN
+                nb_small = global_basinid(ig,ib)
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    
+    nb_small = MIN(nb_small, 349)
+    
+    ALLOCATE(basin_names(nb_small), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for basins_names','','')
+
+    CALL routing_names(nb_small, basin_names)
+    !
+    ! Go through all points and basins to see if they outflow as a river and store the
+    ! information needed in the various arrays.
+    !
+    nb_pts(:) = 0
+    totarea(:) = zero
+    hydrodiag(:,:) = 0
+    areaupbasin(:,:) = zero
+    outids(:,:) = -1
+    ob = -1
+    og = -1
+    lbasin_area(:,:) = zero
+    lbasin_uparea(:,:) = zero
+    longest_river = 0
+    !
+    err_nbpt_grid_basin = .FALSE.
+    loopgridbasin : DO ig=1,nbpt
+       !
+       DO ib=1,nbasmax
+          IF ( routing_area(ig,ib) .GT. zero ) THEN
+             ic = 0
+             ign = ig
+             ibn = ib
+             ! Locate outflow point
+             DO WHILE (ibn .GT. 0 .AND. ibn .LE. nbasmax .AND. ic .LT. nbasmax*nbpt)
+                ic = ic + 1
+                og = ign
+                ob = ibn
+                ign = route_togrid(og, ob)
+                ibn = route_tobasin(og, ob)
+                areaupbasin(og, ob) = areaupbasin(og, ob) + routing_area(ig,ib)
+             ENDDO
+             !
+             longest_river = MAX(longest_river, ic)
+             !
+             ! Now that we have an outflow check if it is one of the num_largest rivers. 
+             ! In this case we keeps the location so we diagnose it.
+             !
+             IF ( ibn .EQ. nbasmax + 3) THEN
+                DO icc = 1,num_largest
+                   IF ( outpt(icc,1) .EQ. og .AND. outpt(icc,2) .EQ. ob ) THEN
+                      !
+                      ! We only keep this point for our map if it is large enough.
+                      !
+                      nb_pts(icc) = nb_pts(icc) + 1
+                      !
+                      !
+                      IF ( nb_pts(icc) > nbpt ) THEN
+                         err_nbpt_grid_basin = .TRUE.
+                         EXIT loopgridbasin
+                      ENDIF
+                      !
+                      pts(icc, nb_pts(icc)) = ig
+                      ptbas(icc, nb_pts(icc)) = ib
+                      totarea(icc) = totarea(icc) + routing_area(ig,ib)
+                      !
+                      lbasin_area(icc,nb_pts(icc)) = routing_area(ig,ib)
+                      !
+                      ! ID of the river is taken from the last point before the outflow.
+                      topids(icc) = global_basinid(og,ob)
+                      outids(ig,ib) = global_basinid(og,ob)
+                      !
+                      ! On this gridbox and basin we will diagnose the hydrograph
+                      !
+                      hydrodiag(ig, ib) = 1
+                      !
+                   ENDIF
+                ENDDO
+             ENDIF
+          ENDIF
+          !
+       ENDDO
+       !
+    ENDDO loopgridbasin
+    !
+    IF ( err_nbpt_grid_basin ) THEN
+       WRITE(numout, *) "routing_diagnostic : The number of grid points in basin ", icc
+       WRITE(numout, *) "routing_diagnostic : is larger than anticiped. "
+       CALL ipslerr_p(3, 'routing_diagnostic', 'We are heading for a out of bounds in arrays pts, ptsbas and lbasin_area.',&
+                     & 'Increase the last dimension of these arrays.','')
+    ENDIF
+    !
+    ! Now we decide which points we will keep from the largest basins
+    !
+    ! Temporary fix
+    route_nbintobas(:,:) = 0
+    !
+    basinmap(:) = zero
+    DO ig=1,nbpt
+       !
+       ! Look for the dominant basin in this grid. This information only affects some
+       ! diagnostics : hydrographs and saved area upstream.
+       !
+       icc = 0
+       idbas = -1
+       !
+       DO ib=1,nbasmax
+          IF ( outids(ig,ib) > 0 ) THEN
+             IF ( COUNT(outids(ig,:) == outids(ig,ib)) > icc ) THEN
+                icc = COUNT(outids(ig,:) == outids(ig,ib))
+                idbas = outids(ig,ib)
+             ENDIF
+          ENDIF
+       ENDDO
+       !
+       ! If we have found a point from the large basins and decided which one
+       ! takes over this grid then we note it on the map.
+       ! Clean-up a little the hydrodiag array
+       !
+       IF ( idbas > 0 ) THEN
+          basinmap(ig) = REAL(idbas, r_std)
+       ENDIF
+       !
+       ! Now place the hydrograph diagnostic on the point closest to the
+       ! ocean.
+       !
+       tmpbas(:) = zero
+       DO ib=1,nbasmax
+          IF ( outids(ig,ib) .EQ. idbas) THEN
+             tmpbas(ib) = areaupbasin(ig,ib)
+          ENDIF
+       ENDDO
+       hydrodiag(ig,:) = 0
+       ff=MAXLOC(tmpbas)
+       hydrodiag(ig,ff(1)) = 1
+       hydroupbasin(ig) = areaupbasin(ig,ff(1))
+       !
+    ENDDO
+    !
+    !
+    !
+    tmparea(:) = totarea(:)
+    DO icc = 1, num_largest
+       ff = MAXLOC(tmparea)
+       sortedrivs(icc) = ff(1)
+       tmparea(ff(1)) = 0.0
+    ENDDO
+    !
+    ! Diagnose the complexity of the basins obtained and determine their code in the Pfafstetter system
+    !
+    nbmax=MAXVAL(nb_pts)
+    ALLOCATE(allstreams(nbmax, longest_river), upstreamchange(nbmax, longest_river), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for allstreams','','')
+
+    ALLOCATE(tstreams(longest_river), tupstreamchange(longest_river), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for tstreams','','')
+
+    ALLOCATE(tslen(nbmax), tpts(nbmax), tptbas(nbmax), tuparea(nbmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for tslen','','')
+
+    ALLOCATE(tcode(nbmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for tcode','','')
+
+    DO icc = 1, num_largest
+       !
+       ! Work through the largest basins
+       !
+       idbas = sortedrivs(icc)
+       !
+       streams_nb(idbas) = 0
+       streams_avehops(idbas) = 0
+       streams_minhops(idbas) = undef_int
+       streams_maxhops(idbas) = 0
+       streams_resid(idbas) = zero
+       tslen(:) = 0
+       !
+       allstreams(:,:) = 0
+       upstreamchange(:,:) = zero
+       !
+       DO ii=1,nb_pts(idbas)
+          !
+          ig = pts(idbas, ii)
+          ib = ptbas(idbas, ii)
+          !
+          lbasin_uparea(idbas,ii) = areaupbasin(ig,ib)
+          !
+          slen = 0
+          ign = ig
+          ibn = ib
+          og = ig
+          ob = ib
+          !
+          averesid = zero
+          tupstreamchange(:) = zero
+          ! go to outflow point to count the number of hops
+          DO WHILE (ibn .GT. 0 .AND. ibn .LE. nbasmax)
+             ! Store data
+             slen = slen + 1
+             tstreams(slen) = ign
+             tupstreamchange(slen) = areaupbasin(ign,ibn)-areaupbasin(og,ob)
+             ! Move to next point
+             og = ign
+             ob = ibn
+             ign = route_togrid(og, ob)
+             ibn = route_tobasin(og, ob)
+             averesid = averesid + topo_resid(og, ob)**2
+          ENDDO
+          !
+          allstreams(ii,1:slen) = tstreams(slen:1:-1)
+          upstreamchange(ii,1:slen) = tupstreamchange(slen:1:-1)
+          tslen(ii) = slen
+          !
+          ! Save diagnostics
+          !
+          streams_nb(idbas) = streams_nb(idbas) + 1
+          streams_avehops(idbas) = streams_avehops(idbas) + slen
+          streams_resid(idbas) = streams_resid(idbas) + SQRT(averesid)
+          IF ( slen < streams_minhops(idbas) ) THEN
+             streams_minhops(idbas) = slen
+          ENDIF
+          IF ( slen > streams_maxhops(idbas) ) THEN
+             streams_maxhops(idbas) = slen
+          ENDIF
+          !
+       ENDDO
+       ! build the average
+       IF ( streams_nb(idbas) > 0 ) THEN
+          streams_avehops(idbas) = streams_avehops(idbas)/streams_nb(idbas)
+          streams_resid(idbas) = streams_resid(idbas)/REAL(streams_nb(idbas), r_std)
+       ELSE
+          ! River without streams ... very rare but happens
+          streams_avehops(idbas) = zero
+          streams_resid(idbas) = zero
+          streams_maxhops(idbas) = zero
+          streams_minhops(idbas) = zero
+       ENDIF
+       !
+       !
+       ii=nb_pts(idbas)
+       tpts(:) = 0
+       tpts(1:ii) = pts(idbas,1:ii)
+       tptbas(:) = 0
+       tptbas(1:ii) = ptbas(idbas,1:ii)
+       tuparea(:) = 0
+       tuparea(1:ii) = lbasin_uparea(idbas,1:ii)
+       !
+       CALL routing_diagcode(ii, tpts, tptbas, tuparea, tslen, MAXVAL(tslen), allstreams, upstreamchange, tcode)  
+       !
+       lrivercode(idbas,:) = 0
+       lrivercode(idbas,1:ii) = tcode(1:ii)
+       !
+    ENDDO
+    !
+    ! Create the sorted list of names
+    !
+    err_basin_number = .FALSE.
+    DO icc = 1, num_largest
+       !
+       ib=sortedrivs(icc)
+       !
+       IF ( topids(ib) .GT. nb_small ) THEN
+          IF (topids(ib) <= 99 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I2.2)') topids(ib)
+          ELSE IF (topids(ib) <= 999 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I3.3)') topids(ib)
+          ELSE IF (topids(ib) <= 9999 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I4.4)') topids(ib)
+          ELSE IF (topids(ib) <= 99999 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I5.5)') topids(ib)
+          ELSE IF (topids(ib) <= 999999 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I6.6)') topids(ib)
+          ELSE
+             err_basin_number = .TRUE.
+             EXIT
+          ENDIF
+
+       ELSE
+          IF (topids(ib) <= -1 ) THEN 
+             WRITE(sorted_names(icc), '("Ne_",I2.2)') -1*topids(ib) 
+          ELSE 
+             IF (printlev >=6) WRITE(numout,*) ">>> nb_small, ib, topids :", nb_small, ib, topids(ib) 
+             sorted_names(icc) = basin_names(topids(ib)) 
+          ENDIF
+       ENDIF
+       !
+    ENDDO
+    !
+    IF ( err_basin_number ) THEN
+       CALL ipslerr_p(3, 'routing_diagnostic', 'We found a basin number larger than 999999.',&
+            & 'This is impossible. Please verify your configuration.','')
+    ENDIF
+    !
+    ! Check for doubles and rename if needed
+    !
+    DO icc = 1, num_largest
+       name_found=0
+       DO ic=1, num_largest
+          IF ( TRIM(sorted_names(icc)) == TRIM(sorted_names(ic)) ) THEN
+             name_found = name_found + 1
+          ENDIF
+       ENDDO
+       !
+       IF ( name_found > 1 ) THEN
+          DO ic=num_largest,1,-1
+             IF ( TRIM(sorted_names(icc)) == TRIM(sorted_names(ic)) ) THEN
+                IF ( name_found > 1 ) THEN
+                   WRITE(nn,'(I1)')  name_found
+                   sorted_names(ic) = TRIM(sorted_names(ic))//nn
+                   name_found = name_found - 1
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDIF
+       !
+    ENDDO
+    !
+    ! Print to stdout on ROOT_PROC the diagnostics for the largest basins we have found.
+    !
+    DO icc = 1, num_largest
+       !
+       IF ( nb_pts(sortedrivs(icc)) .GT. 2 ) THEN
+          name_str = sorted_names(icc)
+          WRITE(numout,'("Basin ID ", I5," ", A15, " Area [km^2] : ", F13.4, " Nb points : ", I4)')&
+               & topids(sortedrivs(icc)), name_str(1:15), totarea(sortedrivs(icc))/1.e6,  nb_pts(sortedrivs(icc))
+          ENDIF
+          !
+    ENDDO
+    !
+    ! Save some of the basin information into files.
+    !
+    IF ( river_file ) THEN
+
+       IF ( INDEX(river_file_name,".nc") > 1 ) THEN
+
+          CALL routing_diagncfile(river_file_name, nbpt, lalo, nb_pts, topids, sorted_names, sortedrivs, &
+               &                  pts, lbasin_area, lbasin_uparea, lrivercode, outpt, streams_nb, streams_avehops, &
+               &                  streams_minhops, streams_maxhops, streams_resid)
+
+       ELSE
+
+          OPEN(diagunit, FILE=river_file_name)
+          WRITE(diagunit,'(A)') "Basin ID, Area [km^2], Nb points, Lon and Lat of outflow"
+          WRITE(diagunit,'(A)') "Nb streams, total number of hops, min, ave and max number of hops per stream"
+          !
+          DO icc = 1, num_largest
+             !
+             IF ( nb_pts(sortedrivs(icc)) .GT. 2 ) THEN
+                !
+                name_str = sorted_names(icc)
+                !
+                WRITE(diagunit,'(I5,A25,F14.5,I5,2F9.2)') topids(sortedrivs(icc)), name_str(1:15), totarea(sortedrivs(icc))/1.e6, &
+                     &    nb_pts(sortedrivs(icc)), lalo(outpt(sortedrivs(icc),1),2), lalo(outpt(sortedrivs(icc),1),1)
+                WRITE(diagunit,'(5I9,F16.4)') streams_nb(sortedrivs(icc)), &
+                     & streams_avehops(sortedrivs(icc))*streams_nb(sortedrivs(icc)), &
+                     & streams_minhops(sortedrivs(icc)), &
+                     & streams_avehops(sortedrivs(icc)), &
+                     & streams_maxhops(sortedrivs(icc)), streams_resid(sortedrivs(icc))
+                !
+             ENDIF
+             !
+          ENDDO
+          !
+          CLOSE(diagunit)
+          !
+       ENDIF
+       !
+    ENDIF
+    !
+    !
+    nbrivers(:) = zero
+    DO ig=1,nbpt
+       nbrivers(ig) = COUNT(route_tobasin(ig,1:nbasmax) == nbasmax+3)
+    ENDDO
+    DO ig=1,nbpt
+       IF ( nbrivers(ig) > 1 ) THEN
+          WRITE(numout,*) 'Grid box ', ig, ' has ', NINT(nbrivers(ig)), ' outflow points.'
+          WRITE(numout,*) 'The rivers which flow into the ocean at this point are :'
+          DO icc=1,nbasmax
+             IF ( route_tobasin(ig,icc) == nbasmax+3) THEN
+                IF ( global_basinid(ig,icc) <= nb_small ) THEN
+                   WRITE(numout,*) 'ID = ',global_basinid(ig,icc), ' Name = ', basin_names(global_basinid(ig,icc))
+                ELSE
+                   WRITE(numout,*) 'ID = ',global_basinid(ig,icc), ' Problem ===== ID is larger than possible'
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDIF
+    ENDDO
+    !
+    WRITE(numout,*) 'Maximum topographic index :', MAXVAL(topo_resid)
+    ic = COUNT(topo_resid .GT. 0.)
+    WRITE(numout,*) 'Mean topographic index :', SUM(topo_resid, MASK=topo_resid .GT. zero)/ic
+    WRITE(numout,*) 'Minimum topographic index :', MINVAL(topo_resid, MASK=topo_resid .GT. zero)
+    !
+    DEALLOCATE(pts)
+    DEALLOCATE(outpt)
+    DEALLOCATE(nb_pts)
+    DEALLOCATE(totarea, tmparea)
+    DEALLOCATE(streams_nb, streams_avehops, streams_minhops, streams_maxhops)
+    !
+    DEALLOCATE(lbasin_area, lbasin_uparea, lrivercode)
+    !
+    DEALLOCATE(allstreams)
+    DEALLOCATE(tstreams)
+    DEALLOCATE(tslen, tpts, tptbas, tuparea)
+    DEALLOCATE(tcode)
+    !
+    WRITE(numout,*) 'Maximum topographic index :', MAXVAL(topo_resid)
+    ic = COUNT(topo_resid .GT. 0.)
+    WRITE(numout,*) 'Mean topographic index :', SUM(topo_resid, MASK=topo_resid .GT. 0.)/ic
+    WRITE(numout,*) 'Minimum topographic index :', MINVAL(topo_resid, MASK=topo_resid .GT. 0.)
+    !
+    !
+  END SUBROUTINE routing_diagnostic
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_diagcode
+!!
+!>\BRIEF       This subroutine determines the code in the Pfafstetter system for all points
+!!              within the given catchment.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): streamcode
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_diagcode(ip, tpts, tpbas, tuparea, tslen, ls, allstreams, upstreamchange, streamcode)  
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                   :: ip             !!
+    INTEGER(i_std), INTENT(in)                   :: ls             !!
+    INTEGER(i_std), DIMENSION(ip), INTENT(in)    :: tpts           !!
+    INTEGER(i_std), DIMENSION(ip), INTENT(in)    :: tpbas          !!
+    REAL(r_std), DIMENSION(ip), INTENT(in)       :: tuparea        !!
+    INTEGER(i_std), DIMENSION(ip), INTENT(in)    :: tslen          !!
+    INTEGER(i_std), DIMENSION(ip,ls), INTENT(in) :: allstreams     !!
+    REAL(r_std), DIMENSION(ip,ls), INTENT(in)    :: upstreamchange !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), DIMENSION(ip), INTENT(out)   :: streamcode     !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                               :: ilev, cntsubbas, ib, ic, i, it, ilevmax, imaxlen, nbzero !!
+    INTEGER(i_std)                               :: tstreamcode(ip)!!
+    INTEGER(i_std)                               :: indsubbas(ip)  !!
+    INTEGER(i_std)                               :: iw(ip)         !!
+    INTEGER(i_std)                               :: tdiff(ip)      !!
+    INTEGER(i_std)                               :: tmpjunc(4)     !!
+    INTEGER(i_std)                               :: junction(4)    !!
+    INTEGER(i_std)                               :: ff(1)          !!
+    INTEGER(i_std)                               :: ll             !!
+    REAL(r_std)                                  :: chguparea(ip)  !!
+    REAL(r_std)                                  :: largest        !!
+
+!_ ================================================================================================================================
+    !
+    streamcode(:) = 0
+    !
+    ! If we accept 4 grid boxes per coded basin then per level we need at least
+    ! 4*9=36 boxes.
+    !
+    ilevmax = 0
+    it = ip
+    DO WHILE (it >= 36)
+       ilevmax = ilevmax+1
+       it = it/9
+    ENDDO
+    !
+    DO ilev=1,ilevmax
+       !
+       ! Count number of sub-basins we already have
+       !
+       cntsubbas=0
+       tstreamcode(:) = streamcode(:)
+       DO WHILE ( COUNT(tstreamcode(:) >= 0) > 0 )
+         cntsubbas=cntsubbas+1
+         indsubbas(cntsubbas) = MAXVAL(tstreamcode(:))
+         WHERE ( tstreamcode(:) == indsubbas(cntsubbas) ) tstreamcode = -1
+       ENDDO
+       !
+       ! Go through all these basins in order to find the next Pfafstetter numbers
+       !
+       DO ib=1,cntsubbas
+          !
+          ! Get all the streams which have the current Pfadstetter number
+          !
+          it=0
+          DO ic=1,ip
+             IF ( streamcode(ic) == indsubbas(ib) ) THEN
+                it =it+1
+                iw(it)=ic 
+             ENDIF
+          ENDDO
+          !
+          ! Which is the longest stream in this basin ?
+          !
+          ff=MAXLOC(tslen(iw(1:it)))
+          imaxlen=iw(ff(1))
+          chguparea(:) = zero
+          chguparea(1:tslen(imaxlen)) = upstreamchange(imaxlen, 1:tslen(imaxlen))
+          !
+          IF ( COUNT(chguparea(1:tslen(imaxlen)) > 0) < 4 ) THEN
+             !
+             ! If this subbasin is too small we just set all points to zero
+             !
+             DO i=1,it
+                streamcode(iw(i)) = streamcode(iw(i))*10
+             ENDDO
+          ELSE
+             ! 
+             ! Else do the Pfafstetter numbering
+             ! 
+             !
+             ! Where do we have the 4 largest change in upstream area on this stream.
+             ! This must be the confluence of 2 rivers and thus a junction point.
+             !
+             largest=pi*R_Earth*R_Earth
+             DO i=1,4
+                ff = MAXLOC(chguparea(1:tslen(imaxlen)), MASK = chguparea(1:tslen(imaxlen)) < largest)
+                tmpjunc(i) = ff(1)
+                largest=chguparea(tmpjunc(i))
+             ENDDO
+             ! sort junctions to go from the outflow up-stream
+             ff(1)=0
+             DO i=1,4
+                junction(i) = MINVAL(tmpjunc, MASK=tmpjunc > ff(1))
+                ff(1) = junction(i)
+             ENDDO
+             !
+             ! Find all streams which are identical up to that junction and increase their code accordingly 
+             !
+             DO i=1,it
+                ll=MIN(tslen(imaxlen),tslen(iw(i)))
+                tdiff(1:ll) = allstreams(imaxlen,1:ll)-allstreams(iw(i),1:ll)
+                nbzero = COUNT(tdiff(1:ll) == 0)
+                IF (nbzero < junction(1) ) THEN
+                   ! Before first of the 4 largest basins
+                   streamcode(iw(i)) = streamcode(iw(i))*10+1
+                ELSE IF (nbzero == junction(1) ) THEN
+                   ! Stream part of the first largest basin
+                   streamcode(iw(i)) = streamcode(iw(i))*10+2
+                ELSE IF (nbzero < junction(2) ) THEN
+                   ! Between first and second stream
+                   streamcode(iw(i)) = streamcode(iw(i))*10+3
+                ELSE IF (nbzero == junction(2) ) THEN
+                   ! Stream part of the second basin
+                   streamcode(iw(i)) = streamcode(iw(i))*10+4
+                ELSE IF (nbzero < junction(3) ) THEN
+                   ! In between stream 2 and 3
+                   streamcode(iw(i)) = streamcode(iw(i))*10+5
+                ELSE IF (nbzero == junction(3) ) THEN
+                   ! Part of 3rd basin
+                   streamcode(iw(i)) = streamcode(iw(i))*10+6
+                ELSE IF (nbzero < junction(4) ) THEN
+                   ! In between 3 and 4th basins
+                   streamcode(iw(i)) = streamcode(iw(i))*10+7
+                ELSE IF (nbzero == junction(4) ) THEN
+                   ! Final of the 4 largest basins
+                   streamcode(iw(i)) = streamcode(iw(i))*10+8
+                ELSE
+                   ! The rest of the points and also the basin of the longest stream
+                   streamcode(iw(i)) = streamcode(iw(i))*10+9
+                ENDIF
+             ENDDO
+          ENDIF
+       ENDDO
+       !
+    ENDDO
+    !
+    !
+  END SUBROUTINE routing_diagcode
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_diagncfile
+!!
+!>\BRIEF         This subroutine creates a netCDF file containing all the informations
+!!                on the largest rivers which can be used for a refined analysis. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_diagncfile(river_file_name, nbpt, lalo, nb_pts, topids, sorted_names, sortedrivs, &
+       &       lbasin_index, lbasin_area, lbasin_uparea, lrivercode, outpt, streams_nb, streams_avehops, &
+       &       streams_minhops, streams_maxhops, streams_resid)
+    !
+    USE netcdf
+    !
+    IMPLICIT NONE
+    !
+    !
+!! INPUT VARIABLES
+    REAL(r_std), INTENT(in)                     :: lalo(nbpt,2)             !! Vector of latitude and longitudes (beware of the order !)
+
+!! LOCAL VARIABLES
+    CHARACTER(LEN=80)                           :: river_file_name          !! Filename in which we write the description of the rivers (1)
+    INTEGER(i_std)                              :: nbpt                     !! Domain size  (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: nb_pts                   !! Number of points in the basin (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: topids                   !! The IDs of the first num_largest basins (unitless)
+    CHARACTER(LEN=25), DIMENSION(num_largest)   :: sorted_names             !! Names of the basins to be put into the file (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: sortedrivs               !!
+    INTEGER(i_std), DIMENSION(num_largest,nbpt) :: lbasin_index             !!
+    REAL(r_std), DIMENSION(num_largest,nbpt)    :: lbasin_area              !!
+    REAL(r_std), DIMENSION(num_largest,nbpt)    :: lbasin_uparea            !!
+    INTEGER(i_std), DIMENSION(num_largest,nbpt) :: lrivercode               !!
+    !
+    INTEGER(i_std), DIMENSION(num_largest,2)    :: outpt                    !! Outflow point for each basin (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: streams_nb               !! Number of streams in basin (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: streams_avehops          !! Average number of hops in streams (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: streams_minhops          !! Minimum number of hops in streams (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: streams_maxhops          !! Minimum number of hops in streams (unitless)
+    REAL(r_std), DIMENSION(num_largest)         :: streams_resid            !! Average residence time
+    !
+    INTEGER(i_std)                              :: icc, fid, iret, ierr_tot, ib, ij, ik, i, j, lcc !! Indices (unitless)
+    INTEGER(i_std)                              :: nlonid, nlatid, varid, varid2, varid3
+    INTEGER(i_std)                              :: dims(2)                  !!
+    REAL(r_std)                                 :: lon_min, lon_max, lat_min, lat_max
+    CHARACTER(LEN=80)                           :: lon_name, lat_name, var_name, long_name, nc_name, att_str
+    CHARACTER(LEN=15)                           :: gridtype                 !!
+    !
+    REAL(r_std)                                 :: basinfrac(iim_g,jjm_g)   !!
+    REAL(r_std)                                 :: basinuparea(iim_g,jjm_g) !!
+    INTEGER(i_std)                              :: basincode(iim_g,jjm_g)   !!
+    !
+    LOGICAL                                     :: check=.FALSE.            !! (true/false)
+    !
+!! PARAMETERS
+    INTEGER(i_std),PARAMETER                    :: kind_r_diag=NF90_REAL8   !!
+    INTEGER(i_std),PARAMETER                    :: kind_i_diag=NF90_INT     !!
+
+!_ ================================================================================================================================
+    !
+    !
+    ! 1.0 Create the NETCDF file and store the coordinates.
+    !
+    ! This variable should be defined and computed in the module grid.f90.
+    ! Jan
+    gridtype="regular"
+    !
+    iret = NF90_CREATE(TRIM(river_file_name), NF90_CLOBBER, fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'routing_diagncfile', 'Could not create file :', &
+            & TRIM(river_file_name), '(Problem with disk place or filename ?)')
+    ENDIF
+    !
+    ! 1.1 Define dimensions
+    !
+    IF ( INDEX(gridtype, "regular") == 1 ) THEN
+       !
+       ! 1.1.1 regular grid
+       !
+       iret = NF90_DEF_DIM(fid, 'lon', iim_g, dims(1))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr_p (3,'routing_diagncfile', 'Dimension "x" can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       iret = NF90_DEF_DIM(fid, 'lat', jjm_g, dims(2))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr_p (3,'routing_diagncfile', 'Dimension "y" can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+    ELSE
+       !
+       ! 1.1.2 irregular grid
+       !
+       iret = NF90_DEF_DIM(fid, 'x', iim_g, dims(1))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr_p (3,'routing_diagncfile', 'Dimension "x" can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       
+       iret = NF90_DEF_DIM(fid, 'y', jjm_g, dims(2))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr_p (3,'routing_diagncfile', 'Dimension "y" can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+    ENDIF
+    !
+    !
+    ! 1.2 Define variables and attributes
+    !
+    IF ( INDEX(gridtype, "regular") == 1 ) THEN
+       !
+       ! 1.2.1 regular grid
+       !
+       lon_name = 'lon'
+       !
+       iret = NF90_DEF_VAR(fid, lon_name, kind_r_diag, dims(1), nlonid)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr_p (3,'routing_diagncfile', 'Variable '//lon_name//' can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+       lat_name = 'lat'
+       iret = NF90_DEF_VAR(fid, lat_name, kind_r_diag, dims(2), nlatid)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr_p (3,'routing_diagncfile', 'Variable '//lat_name//' can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+    ELSE
+       !
+       ! 1.2.2 irregular grid
+       !
+       lon_name = 'nav_lon'
+       !
+       iret = NF90_DEF_VAR(fid, lon_name, kind_r_diag, dims, nlonid)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr_p (3,'routing_diagncfile', 'Variable '//lon_name//' can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+       lat_name = 'nav_lat'
+       iret = NF90_DEF_VAR(fid, lat_name, kind_r_diag, dims, nlatid)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr_p (3,'routing_diagncfile', 'Variable '//lat_name//' can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+    ENDIF
+    !
+    ! 1.3 Add attributes to the coordinate variables
+    !
+    iret = NF90_PUT_ATT(fid, nlonid, 'units', "degrees_east") 
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'routing_diagncfile', 'Could not add attribut to variable '//lon_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    lon_min = -180.
+    lon_max = 180.
+    !
+    iret = NF90_PUT_ATT(fid, nlonid, 'valid_min', lon_min)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'routing_diagncfile', 'Could not add attribut to variable '//lon_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_ATT(fid, nlonid, 'valid_max', lon_max)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'routing_diagncfile', 'Could not add attribut to variable '//lon_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    iret = NF90_PUT_ATT(fid, nlonid, 'long_name', "Longitude")
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'routing_diagncfile', 'Could not add attribut to variable '//lon_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_ATT(fid, nlatid, 'units', "degrees_north")
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'routing_diagncfile', 'Could not add attribut to variable '//lat_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    lat_max = 90.
+    lat_min = -90.
+    !
+    iret = NF90_PUT_ATT(fid, nlatid, 'valid_min', lat_min)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'routing_diagncfile', 'Could not add attribut to variable '//lat_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_ATT(fid, nlatid, 'valid_max', lat_max)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'routing_diagncfile', 'Could not add attribut to variable '//lat_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_ATT(fid, nlatid, 'long_name', "Latitude")
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'routing_diagncfile', 'Could not add attribut to variable '//lat_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    iret = NF90_ENDDEF(fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'routing_diagncfile', 'Could not end definitions in the file : ', &
+ &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    !  1.4 Write coordinates
+    !
+    IF ( INDEX(gridtype, "regular") == 1 ) THEN
+       !
+       ! 1.4.1 regular grid
+       !
+       iret = NF90_PUT_VAR(fid, nlonid, lon_g(1:iim_g,1))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr_p (3,'routing_diagncfile', 'Could not put variable nav_lon  in the file : ', &
+               &          TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+       iret = NF90_PUT_VAR(fid, nlatid, lat_g(1,1:jjm_g))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr_p (3,'routing_diagncfile', 'Could not put variable nav_lat  in the file : ', &
+               &          TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+    ELSE
+       !
+       ! 1.4.2 irregular grid
+       !
+       iret = NF90_PUT_VAR(fid, nlonid, lon_g)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr_p (3,'routing_diagncfile', 'Could not put variable nav_lon  in the file : ', &
+               &          TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+       iret = NF90_PUT_VAR(fid, nlatid, lat_g)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr_p (3,'routing_diagncfile', 'Could not put variable nav_lat  in the file : ', &
+               &          TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+    ENDIF
+    !
+    ! 2.0 Go through all basins and wirte the information into the netCDF file.
+    !
+    DO icc = 1, num_largest
+       !
+       ! 2.1 Compute the fields to be saved in the file
+       !
+       ib=sortedrivs(icc)
+       !
+       !
+       IF ( nb_pts(ib) > 2 ) THEN
+          !
+          basinfrac(:,:) = zero
+          basinuparea(:,:) = zero
+          basincode(:,:) = zero
+          !
+          DO ij=1, nb_pts(ib)
+
+             ik=lbasin_index(ib,ij)
+
+             j = ((index_g(ik)-1)/iim_g) + 1
+             i = (index_g(ik)-(j-1)*iim_g)
+
+             basinfrac(i,j) = basinfrac(i,j) + lbasin_area(ib,ij)/(resolution_g(ik,1)*resolution_g(ik,2))
+             basinuparea(i,j) = MAX(basinuparea(i,j), lbasin_uparea(ib,ij))
+             basincode(i,j) = lrivercode(ib,ij)
+
+          ENDDO
+          !
+          DO i=1,iim_g
+             DO j=1,jjm_g
+                IF ( basinfrac(i,j) <= EPSILON(zero) ) THEN
+                   basinfrac(i,j) = undef_sechiba
+                   basinuparea(i,j)  = undef_sechiba
+                   basincode(i,j)  = undef_int
+                ELSE
+                   basinfrac(i,j) = MIN(basinfrac(i,j), un)
+                ENDIF 
+             ENDDO
+          ENDDO
+          !
+          ! 
+          ! 2.2 Define the variables in the netCDF file
+          !
+          iret = NF90_REDEF(fid)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr_p (3,'routing_diagncfile', &
+                  &          'Could not restart definitions in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! Create a name more suitable for a variable in a netCDF file
+          !
+          nc_name =  TRIM(sorted_names(icc))
+          ! Take out all character which could cause problems
+          lcc=LEN_TRIM(nc_name)
+          DO ij=1,lcc
+             IF ( nc_name(ij:ij) == " " ) nc_name(ij:ij) = "_"
+             IF ( nc_name(ij:ij) == "(" ) nc_name(ij:ij) = "_"
+             IF ( nc_name(ij:ij) == ")" ) nc_name(ij:ij) = "_"
+          ENDDO
+          ! reduce redundant "__"
+          DO ij=1,lcc
+             IF ( nc_name(ij:ij+1) == "__" ) nc_name(ij+1:)=nc_name(ij+2:lcc)
+          ENDDO
+          lcc=LEN_TRIM(nc_name)
+          IF ( nc_name(lcc:lcc) == "_" ) nc_name(lcc:lcc) = " "
+          !
+          !
+          ! 2.3 Fraction variable
+          !
+          IF (check) WRITE(numout,*) "Define Fraction variable and add attributes"
+          !
+          var_name =  TRIM(nc_name)//"_frac"
+          !
+          iret = NF90_DEF_VAR(fid, TRIM(var_name), kind_r_diag, dims, varid)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr_p (3,'routing_diagncfile', 'Variable '//TRIM(var_name)//' can not be defined for the file : ', &
+                  &         TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ierr_tot = 0
+          ! Units
+          iret = NF90_PUT_ATT(fid, varid, 'units', "-")
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(numout,*) 'Units',  iret
+             WRITE(numout,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          ! Long name
+          long_name = "Fraction of basin "//TRIM(sorted_names(icc))//" per grid box"
+          iret = NF90_PUT_ATT(fid, varid, 'long_name', long_name)
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(numout,*) 'Long_Name', long_name, iret
+             WRITE(numout,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          ! Missing value
+          iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(numout,*) 'Missing value', undef_sechiba, iret
+             WRITE(numout,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ib=sortedrivs(icc)
+          IF ( check ) WRITE(numout,*) "Doing basin ", icc," corrsdponding to index = ", ib, "num_largest : ", num_largest
+          !
+          ! Nb of grid points in basin
+          att_str='Nb_of_grid_points_in_basin'
+          iret = NF90_PUT_ATT(fid, varid, att_str, nb_pts(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(numout,*) 'Nb of grid points in basin', nb_pts(ib), iret
+             WRITE(numout,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Longitude of outflow point 
+          att_str='Longitude_of_outflow_point'
+          iret = NF90_PUT_ATT(fid, varid, att_str, lalo(outpt(ib,1),2))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(numout,*) 'Longitude of outflow point', lalo(outpt(ib,1),2), iret
+             WRITE(numout,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Latitide of outflow point
+          att_str='Latitude_of_outflow_point'
+          iret = NF90_PUT_ATT(fid, varid, att_str, lalo(outpt(ib,1),1))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(numout,*) 'Latitude of outflow point',  lalo(outpt(ib,1),1), iret
+             WRITE(numout,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Number of streams
+          att_str= 'Number_of_streams'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_nb(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(numout,*) 'Number of streams', streams_nb(ib), iret
+             WRITE(numout,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Total number of hops to go to the oceans
+          att_str='Total_number_of_hops_to_ocean'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_avehops(ib)*streams_nb(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(numout,*) 'Total number of hops to go to the oceans ', streams_avehops(ib)*streams_nb(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Minimum number of hops to go to the ocean for any stream
+          att_str='Minimum_number_of_hops_to_ocean_for_any_stream'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_minhops(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(numout,*) 'Minimum number of hops to go tp the ocean for any stream', streams_minhops(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Average number of hops to go to the ocean for any stream 
+          att_str='Average_number_of_hops_to_ocean_for_any_stream'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_avehops(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(numout,*) 'Average number of hops to go tp the ocean for any stream', streams_avehops(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Maximum number of hops to go to the ocean for any stream 
+          att_str='Maximum_number_of_hops_to_ocean_for_any_stream'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_maxhops(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(numout,*) 'Maximum number of hops to go tp the ocean for any stream', streams_maxhops(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Average residence time in the basin
+          att_str='Average_residence_time_in_basin'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_resid(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(numout,*) 'Average residence time in the basin', streams_resid(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          IF (ierr_tot > 0 ) THEN
+             CALL ipslerr_p (3,'routing_diagncfile', 'Could not add some attributes to variable '//var_name//' for the file :', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! 2.4 Upstream area variable variable
+          !
+          IF (check) WRITE(numout,*) "Define Upstream variable and add attributes"
+          !
+          ! Create a name more suitable for a variable in a netCDF file
+          !
+          var_name =  TRIM(nc_name)//"_upstream"
+          DO ij=1,LEN_TRIM(var_name)
+             IF ( var_name(ij:ij) == " " ) var_name(ij:ij) = "_"
+          ENDDO
+          !
+          iret = NF90_DEF_VAR(fid, TRIM(var_name), kind_r_diag, dims, varid2)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr_p (3,'routing_diagncfile', 'Variable '//TRIM(var_name)//' can not be defined for the file : ', &
+                  &         TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ierr_tot = 0
+          ! Units
+          iret = NF90_PUT_ATT(fid, varid2, 'units', "m^2")
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          ! Long name
+          long_name = "Upstream area of basin "//TRIM(sorted_names(icc))//" in the grid box"
+          iret = NF90_PUT_ATT(fid, varid2, 'long_name', long_name)
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          ! Missing value
+          iret = NF90_PUT_ATT(fid, varid2, 'missing_value', undef_sechiba)
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          !
+          IF (ierr_tot > 0 ) THEN
+             CALL ipslerr_p (3,'routing_diagncfile', 'Could not add some attributes to variable '//var_name//' for the file :', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! 2.5 Pfafstetter codes for basins
+          !
+          IF (check) WRITE(numout,*) "Define Pfafstetter codes variable and add attributes"
+          !
+          var_name =  TRIM(nc_name)//"_coding"
+          DO ij=1,LEN_TRIM(var_name)
+             IF ( var_name(ij:ij) == " " ) var_name(ij:ij) = "_"
+          ENDDO
+          !
+          iret = NF90_DEF_VAR(fid, TRIM(var_name), kind_i_diag, dims, varid3)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr_p (3,'routing_diagncfile', 'Variable '//TRIM(var_name)//' can not be defined for the file : ', &
+                  &         TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ierr_tot = 0
+          ! Units
+          iret = NF90_PUT_ATT(fid, varid3, 'units', "-")
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          ! Long name
+          long_name = "Pfafstetter codes of grid boxes in basin "//TRIM(sorted_names(icc))
+          iret = NF90_PUT_ATT(fid, varid3, 'long_name', long_name)
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          ! Missing value
+          iret = NF90_PUT_ATT(fid, varid3, 'missing_value', undef_int)
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          !
+          IF (ierr_tot > 0 ) THEN
+             CALL ipslerr_p (3,'routing_diagncfile', 'Could not add some attributes to variable '//var_name//' for the file :', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! 2.6 ENDDEF of netCDF file
+          !
+          IF (check) WRITE(numout,*) "END define"
+          !
+          iret = NF90_ENDDEF(fid)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr_p (3,'routing_diagncfile', &
+                  &          'Could not end definitions in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! 2.7 Write the data to the file
+          !
+          IF (check) WRITE(numout,*) "Put basinfrac"
+          iret = NF90_PUT_VAR(fid, varid, basinfrac)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr_p (3,'routing_diagncfile', 'Could not put variable basinfrac in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+
+          IF (check) WRITE(numout,*) "Put basinuparea"
+          iret = NF90_PUT_VAR(fid, varid2, basinuparea)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr_p (3,'routing_diagncfile', 'Could not put variable basinuparea in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+
+          IF (check) WRITE(numout,*) "Put basincode"
+          iret = NF90_PUT_VAR(fid, varid3, basincode)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr_p (3,'routing_diagfile', 'Could not put variable basincode in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+       ENDIF
+       !
+    ENDDO
+    !
+    IF (check) WRITE(numout,*) "Close file"
+    !
+    ! Close netCDF file and do some memory management.
+    !
+    iret = NF90_CLOSE(fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'routing_diagncfile', &
+            &          'Could not end definitions in the file : ', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    !
+  END SUBROUTINE routing_diagncfile
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_basins_p
+!!
+!>\BRIEF        This parallelized subroutine computes the routing map if needed. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_basins_p(nbpt, lalo, neighbours, resolution, contfrac)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in) :: nbpt               !! Domain size (unitless)
+    REAL(r_std), INTENT(in)    :: lalo(nbpt,2)       !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in) :: neighbours(nbpt,NbNeighb) !! Vector of neighbours for each grid point (1=North and then clockwise) (unitless)
+    REAL(r_std), INTENT(in)    :: resolution(nbpt,2) !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)    :: contfrac(nbpt)     !! Fraction of land in each grid box (unitless;0-1)
+
+!_ ================================================================================================================================
+
+!    INTEGER(i_std)    :: neighbours_tmp(nbpt,8)
+!    INTEGER(i_std) :: i,j
+    
+!    DO i=1,nbp_loc
+!      DO j=1,NbNeighb
+!	IF (neighbours(i,j)==-1) THEN
+!	  neighbours_tmp(i,j)=neighbours(i,j)
+!	ELSE
+!	  neighbours_tmp(i,j)=neighbours(i,j)+nbp_para_begin(mpi_rank)-1
+!	ENDIF  
+!      ENDDO
+!    ENDDO
+
+    routing_area => routing_area_glo  
+    topo_resid => topo_resid_glo
+    route_togrid => route_togrid_glo
+    route_tobasin => route_tobasin_glo
+    route_nbintobas => route_nbintobas_glo
+    global_basinid => global_basinid_glo
+ 
+    IF (is_root_prc) CALL routing_basins(nbp_glo,lalo_g, neighbours_g, resolution_g, contfrac_g)
+
+    routing_area => routing_area_loc  
+    topo_resid => topo_resid_loc
+    route_togrid => route_togrid_loc
+    route_tobasin => route_tobasin_loc
+    route_nbintobas => route_nbintobas_loc
+    global_basinid => global_basinid_loc
+
+    CALL scatter(routing_area_glo,routing_area_loc)
+    CALL scatter(topo_resid_glo,topo_resid_loc)
+    CALL scatter(route_togrid_glo,route_togrid_loc)
+    CALL scatter(route_tobasin_glo,route_tobasin_loc)
+    CALL scatter(route_nbintobas_glo,route_nbintobas_loc)
+    CALL scatter(global_basinid_glo,global_basinid_loc)
+    
+  END SUBROUTINE routing_basins_p
+  ! 
+ 
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_basins
+!!
+!>\BRIEF        This non-parallelized subroutine reads in the map of basins and flow direction to construct
+!!              the catchments of each grid box. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!! The work is done in a number of steps which are performed locally on the 
+!! GCM grid:
+!!  1) First we find the grid-points of the high resolution routing grid which are
+!!     within the coarser grid of the GCM.
+!!  2) When we have these grid points we decompose them into basins in the routine
+!!     routing_findbasins. A number of simplifications are done if needed.
+!!  3) In the routine routing_globalize we put the basin information of this grid
+!!     into the global fields.
+!! Then we work on the global grid to perform the following tasks :
+!!  1) We link up the basins of the various grid points and check the global consistency.
+!!  2) The area of each outflow point is computed.
+!!  3) The final step is to reduce the number of basins in order to fit into the truncation.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None, as the routine puts information into the global variables of the module.
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_basins(nbpt, lalo, neighbours, resolution, contfrac)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                    :: nbpt                  !! Domain size (unitless)
+    REAL(r_std), INTENT(in)                       :: lalo(nbpt,2)          !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)                    :: neighbours(nbpt,NbNeighb)!! Vector of neighbours for each grid point 
+                                                                           !! (1=North and then cloxkwise)
+    REAL(r_std), INTENT(in)                       :: resolution(nbpt,2)    !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)                       :: contfrac(nbpt)        !! Fraction of land in each grid box (unitless;0-1)
+    !
+!! LOCAL VARIABLES
+    CHARACTER(LEN=80)                             :: filename              !! Name of the netcdf file (unitless)
+    INTEGER(i_std)                                :: iml, jml, lml, tml, fid, ib, ip, jp, fopt !! Indices (unitless)
+    REAL(r_std)                                   :: lev(1), date, dt, coslat
+    INTEGER(i_std)                                :: itau(1)               !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: trip                  !! The trip field (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: basins                !! The basin field (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: topoindex             !! Topographic index of the residence time (m)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: hierarchy             !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lat_rel               !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lon_rel               !!
+    !
+    INTEGER(i_std)                                :: nbi, nbj              !! Number of point in x and y within the grid (unitless)
+    REAL(r_std)                                   :: min_topoind           !! The current minimum of topographic index (m)
+    REAL(r_std)                                   :: max_basins            !!
+    REAL(r_std)                                   :: invented_basins       !!
+    !
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: area_bx               !! Area of each small box in the grid box (m^2)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: hierarchy_bx          !! Level in the basin of the point
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lon_bx                !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lat_bx                !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: topoind_bx            !! Topographic index of the residence time for each of the smaller boxes (m)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: trip_bx               !! The trip field for each of the smaller boxes (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: basin_bx              !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: coast_pts             !! The coastal flow points (unitless)
+    !
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: basin_count           !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: basin_id              !!
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: basin_area            !!
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: basin_hierarchy       !!
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: basin_topoind         !! Topographic index of the residence time for a basin (m)
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: fetch_basin           !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: basin_flowdir         !! Water flow directions in the basin (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: outflow_grid          !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: outflow_basin         !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: inflow_number         !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: inflow_basin          !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: inflow_grid           !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: nbcoastal             !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: coastal_basin         !!
+    !
+    ! Interpolation help variables
+    !
+    INTEGER(i_std)                                :: nix, njx              !!
+    CHARACTER(LEN=30)                             :: callsign              !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)    :: resol_lu              !! Resolution
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: mask                  !! Mask to exclude some points (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: sub_area              !! Area on the fine grid (m^2)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sub_index             !! Indices of the points we need on the fine grid (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: sub_pts               !! Number of high resolution points on this grid (unitless)
+    INTEGER                                       :: ALLOC_ERR             !!
+    LOGICAL                                       :: ok_interpol = .FALSE. !! Flag for interpolation (true/false)
+    !
+    INTEGER(i_std)                                :: nb_basin              !! Number of sub-basins (unitless)
+    INTEGER(i_std)                                :: nwbas                 !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: basin_inbxid          !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: basin_sz              !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: basin_bxout           !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: basin_pts             !!
+    CHARACTER(LEN=7)                              :: fmt                   !!
+    LOGICAL                                       :: debug = .FALSE.       !! (true/false)
+    !
+    INTEGER(i_std), DIMENSION(2)                  :: diagbox = (/ 1, 2 /)  !!
+
+!_ ================================================================================================================================
+    !
+    !
+    IF ( .NOT. is_root_prc) THEN
+       WRITE(numout,*) "is_root_prc = ", is_root_prc
+       CALL ipslerr_p (3,'routing_basins', &
+            &          'routing_basins is not suitable for running in parallel', &
+            &          'We are here on a non root processor. ','(STOP from routing_basins)')
+    ENDIF
+    !
+    ! Test on diagbox and nbpt
+    !
+    IF (debug) THEN
+       IF (ANY(diagbox .GT. nbpt)) THEN 
+          WRITE(numout,*) "Debug diganostics : nbpt, diagbox", nbpt, diagbox
+          call ipslerr_p(3,'routing_basin', &
+               &      'Problem with diagbox in debug mode.', & 
+               &      'diagbox values can''t be greater than land points number.', &
+               &      '(decrease diagbox wrong value)')
+       ENDIF
+    ENDIF
+    !
+    !
+    !  Needs to be a configurable variable
+    !
+    !
+    !Config Key   = ROUTING_FILE
+    !Config Desc  = Name of file which contains the routing information
+    !Config If    = RIVER_ROUTING
+    !Config Def   = routing.nc
+    !Config Help  = The file provided here should alow the routing module to
+    !Config         read the high resolution grid of basins and the flow direction 
+    !Config         from one mesh to the other.
+    !Config Units = [FILE]
+    !
+    filename = 'routing.nc'
+    CALL getin('ROUTING_FILE',filename)
+    !
+    CALL flininfo(filename,iml, jml, lml, tml, fid)
+    CALL flinclo(fid)
+    !
+    ! soils_param.nc file is 1Â° soit texture file.
+    !
+    ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for lat_rel','','')
+
+    ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for lon_rel','','')
+
+    ALLOCATE (trip(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for trip','','')
+
+    ALLOCATE (basins(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basins','','')
+
+    ALLOCATE (topoindex(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for topoindex','','')
+
+    ALLOCATE (hierarchy(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for hierarchy','','')
+
+    !
+    CALL flinopen(filename, .FALSE., iml, jml, lml, lon_rel, lat_rel, lev, tml, itau, date, dt, fid)
+    !!
+    !! From the basin description data we will read the following variables :
+    !!
+    !! Trip : Provides the flow direction following the convention :
+    !! trip = 1 : flow = N
+    !! trip = 2 : flow = NE
+    !! trip = 3 : flow = E
+    !! trip = 4 : flow = SE
+    !! trip = 5 : flow = S
+    !! trip = 6 : flow = SW
+    !! trip = 7 : flow = W
+    !! trip = 8 : flow = NW
+    !! trip = 97 : return flow into the ground
+    !! trip = 98 : coastal flow (diffuse flow into the oceans)
+    !! trip = 99 : river flow into the oceans
+    !!
+    !! Basins : Provides a uniqe ID for each basin. These IDs are also used to get
+    !! the name of the basin from the table in routine routing_names.
+    !! 
+    !! Topoind :  is the topographic index for the retention time of the water in the
+    !! grid box. It has been computed with the following formula : 1000 x sqrt(d^3/Dz) 
+    !! where d is the distance of the river from the current grid box to the next one
+    !! as indicated by the variable trip.
+    !! Dz the hight difference between between the two grid boxes.
+    !! All these variables are in meters.
+    !! Furthermore  we have to limit the height difference to 5m in order to avoid any unpleasant
+    !! surprises. If dz < 5m then dz=5.
+    !!
+    !
+    CALL flinget(fid, 'trip', iml, jml, lml, tml, 1, 1, trip)
+    !
+    CALL flinget(fid, 'basins', iml, jml, lml, tml, 1, 1, basins)
+    !
+    CALL flinget(fid, 'topoind', iml, jml, lml, tml, 1, 1, topoindex)
+    !
+    CALL flinclo(fid)
+    !
+    min_topoind = MINVAL(topoindex, MASK=topoindex .LT. undef_sechiba-un)
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          IF ( trip(ip,jp) < 1.e10 .AND. topoindex(ip,jp) > 1.e10) THEN
+             WRITE(numout,*) 'trip exists but not topoind :'
+             WRITE(numout,*) 'ip, jp :', ip, jp
+             WRITE(numout,*) 'trip, topoind : ', trip(ip,jp), topoindex(ip,jp)
+             CALL ipslerr_p(3,'routing_basins','trip exists but not topoind','','')
+          ENDIF
+       ENDDO
+    ENDDO
+
+    ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for resol_lu','','')
+
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for mask','','')
+    !
+    ! Consider all points a priori
+    !
+    mask(:,:) = 0
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          ! Determine the land mask of the basin map read from the file ROUTING_FILE
+          !
+          IF ( trip(ip,jp) < 1.e10 ) THEN
+             mask(ip,jp) = 1
+          ENDIF
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )     
+          IF ( ip .EQ. 1 ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip,jp) ) * pi/180. * R_Earth * coslat
+          ELSEIF ( ip .EQ. iml ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip,jp) - lon_rel(ip-1,jp) ) * pi/180. * R_Earth * coslat
+          ELSE
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp) - lat_rel(ip,jp+1) ) * pi/180. * R_Earth
+          ELSEIF ( jp .EQ. jml ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp) ) * pi/180. * R_Earth
+          ELSE
+             resol_lu(ip,jp,2) =  ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp+1) )/2. * pi/180. * R_Earth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    ! The maximum number of points of the source map (basin description here) which can fit into
+    ! any grid point of the ORCHIDEE grid is stimated here.
+    ! Some margin is taken.
+    !
+    callsign = "routing_basins"
+    ok_interpol = .FALSE.
+    !  
+    nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
+    njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
+    nbvmax = nix*njx*2
+    !
+    ! We are on the root processor here as this routine is not in parallel. So no need to broadcast.
+    !
+    WRITE(numout,*) "Projection arrays for ",callsign," : "
+    WRITE(numout,*) "Routing : nbvmax = ", nbvmax
+
+
+    ALLOCATE (sub_area(nbpt,nbvmax), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for sub_area','','')
+    sub_area(:,:)=zero
+
+    ALLOCATE (sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for sub_index','','')
+    sub_index(:,:,:)=0
+
+    ALLOCATE (sub_pts(nbpt), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for sub_pts','','')
+    sub_pts(:)=0
+    !
+    ! routine aggregate will for each point of the ORCHIDEE grid determine which points
+    ! of the source grid (basin definitions here) fit in there and which fraction of
+    ! of the ORCHIDEE grid it represents.
+    !
+    CALL aggregate(nbpt, lalo, neighbours, resolution, contfrac, &
+         &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+         &                nbvmax, sub_index, sub_area, ok_interpol)
+    !
+    WHERE (sub_area < 0) sub_area=zero
+    !
+    ! Some verifications
+    !
+    DO ib=1,nbpt
+       sub_pts(ib) = COUNT(sub_area(ib,:) > zero)
+       DO fopt=1,sub_pts(ib)
+          IF (sub_area(ib, fopt) == 0 ) THEN
+             WRITE(numout,*) "Zero Area - Sub_area > 0 : ", ib, fopt
+             WRITE(numout,*) "Zero Area - lon : ",lalo(ib,2)
+             WRITE(numout,*) "Zero Area - lon_rel : ", lon_rel(sub_index(ib, fopt, 1),sub_index(ib, fopt, 2))
+             WRITE(numout,*) "Zero Area - lat : ",lalo(ib,1)
+             WRITE(numout,*) "Zero Area - lat_rel : ", lat_rel(sub_index(ib, fopt, 1),sub_index(ib, fopt, 2))
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Do some memory management.
+    !
+    nwbas = MAX(MAXVAL(sub_pts), NbNeighb+1)
+    !
+    ALLOCATE (area_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for area_bx','','')
+    ALLOCATE (hierarchy_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for hierarchy_bx','','')
+    ALLOCATE (lon_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for lon_bx','','')
+    ALLOCATE (lat_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for lat_bx','','')
+    ALLOCATE (topoind_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for topoind_bx','','')
+    ALLOCATE (trip_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for trip_bx','','')
+    ALLOCATE (basin_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_bx','','')
+    ALLOCATE (coast_pts(nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for coast_pts','','')
+    ALLOCATE (basin_inbxid(nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_inbxid','','')
+    ALLOCATE (basin_sz(nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_sz','','')
+    ALLOCATE (basin_pts(nbvmax,nbvmax,2), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_pts','','')
+    ALLOCATE (basin_bxout(nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_bxout','','')
+    ALLOCATE (basin_count(nbpt), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_count','','')
+    ALLOCATE (basin_area(nbpt,nwbas), basin_hierarchy(nbpt,nwbas), basin_topoind(nbpt,nwbas), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_area','','')
+    ALLOCATE (fetch_basin(nbpt,nwbas), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for fetch_basin','','')
+    ALLOCATE (basin_id(nbpt,nwbas),  basin_flowdir(nbpt,nwbas), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_id','','')
+    ALLOCATE (outflow_grid(nbpt,nwbas),outflow_basin(nbpt,nwbas), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for outflow_grid','','')
+    ALLOCATE (inflow_number(nbpt,nwbas), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for inflow_number','','')
+    ALLOCATE (inflow_basin(nbpt,nwbas,nbvmax), inflow_grid(nbpt,nwbas,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for inflow_basin','','')
+    ALLOCATE (nbcoastal(nbpt), coastal_basin(nbpt,nwbas), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for nbcoastal','','')
+    
+    !    Order all sub points in each grid_box and find the sub basins
+    !
+    !    before we start we set the maps to empty
+    !
+    basin_id(:,:) = undef_int
+    basin_count(:) = 0
+    hierarchy(:,:) = undef_sechiba
+    max_basins = MAXVAL(basins, MASK=basins .LT. 1.e10)
+    invented_basins = max_basins
+    nbcoastal(:) = 0
+    !
+    !! Finds,in each grid box, the distance to the outflow point ... this defines the order in which
+    !! the water will go through the sub-basins and grid boxes.
+    !
+    CALL routing_hierarchy(iml, jml, trip, topoindex, hierarchy)
+    !
+    !
+    DO ib =1, nbpt
+       !
+       !
+       !  extract the information for this grid box
+       !
+       !! Extracts from the global high resolution fields the data for the current grid box.
+       !
+       CALL routing_getgrid(nbpt, iml, jml, ib, sub_pts, sub_index, sub_area, max_basins, min_topoind, &
+            & lon_rel, lat_rel, lalo, resolution, contfrac, trip, basins, topoindex, hierarchy, &
+            & nbi, nbj, area_bx, trip_bx, basin_bx, topoind_bx, hierarchy_bx, lon_bx, lat_bx)
+       !
+       !! Finds the basins: returns the list of all points which are within the same basin of the grid box.
+       !
+       CALL routing_findbasins(nbi, nbj, trip_bx, basin_bx, hierarchy_bx, topoind_bx,&
+            & nb_basin, basin_inbxid, basin_sz, basin_bxout, basin_pts, coast_pts)
+       !
+       !  Deal with the case where nb_basin=0 for this grid box. In this case all goes into coastal flow.
+       !
+       IF ( debug .AND. (COUNT(diagbox .EQ. ib) .GT. 0) ) THEN
+          WRITE(numout,*) '===================== IB = :', ib
+          WRITE(numout,*) "sub_pts(ib) :", sub_pts(ib), "sub_area(ib,:) :",sub_area(ib,1:2)
+          WRITE(numout,*) 'LON LAT of GCM :', lalo(ib,2), lalo(ib,1)
+          WRITE(numout,*) 'Neighbor options :',  neighbours(ib,1:NbNeighb)
+          WRITE(numout,*) 'Resolution :', resolution(ib,1:2)
+          WRITE(fmt,"('(',I3,'I6)')") nbi
+          WRITE(numout,*) '-------------> trip ', trip_bx(1,1)
+          DO jp=1,nbj
+             WRITE(numout,fmt) trip_bx(1:nbi,jp)
+          ENDDO
+          WRITE(numout,*) '-------------> basin ',basin_bx(1,1)
+          DO jp=1,nbj
+             WRITE(numout,fmt) basin_bx(1:nbi,jp)
+          ENDDO
+          WRITE(numout,*) '-------------> hierarchy ',hierarchy_bx(1,1)
+          DO jp=1,nbj
+             WRITE(numout,fmt) INT(hierarchy_bx(1:nbi,jp)/1000.)
+          ENDDO
+          WRITE(numout,*) '-------------> topoindex ',topoind_bx(1,1)
+          DO jp=1,nbj
+             WRITE(numout,fmt) INT(topoind_bx(1:nbi,jp)/1000.)
+          ENDDO
+          !
+          WRITE(numout,*) '------------> The basins we retain'
+          DO jp=1,nb_basin
+             WRITE(numout,*) 'index, size, bxout, coast :', basin_inbxid(jp), basin_sz(jp),&
+                  & basin_bxout(jp), coast_pts(jp)
+          ENDDO
+          !
+       ENDIF
+       !
+       !! Puts the basins found for the current grid box in the context of the global map.
+       !
+       CALL routing_globalize(nbpt, ib, neighbours, area_bx, trip_bx, hierarchy_bx, topoind_bx, min_topoind,&
+            & nb_basin, basin_inbxid, basin_sz, basin_pts, basin_bxout, coast_pts, nwbas, basin_count,&
+            & basin_area, basin_hierarchy, basin_topoind, basin_id, basin_flowdir, outflow_grid,&
+            & nbcoastal, coastal_basin) 
+       !
+       !
+       IF ( debug .AND. (COUNT(diagbox .EQ. ib) .GT. 0) ) THEN
+          WRITE(numout,*) 'GLOBAL information after routing_globalize for grid ', ib
+          DO jp=1,basin_count(ib)
+             WRITE(numout,*) 'Basin ID : ', basin_id(ib, jp)
+             WRITE(numout,*) 'Basin flowdir :', basin_flowdir(ib, jp)
+             WRITE(numout,*) 'Basin hierarchy :', basin_hierarchy(ib, jp)
+             WRITE(numout,*) 'Basin topoindex :', basin_topoind(ib, jp)
+             WRITE(numout,*) 'Basin outflow grid :', outflow_grid(ib,jp)
+          ENDDO
+       ENDIF
+       !
+    ENDDO
+    !
+    !! Makes the connections between the bains and ensures global coherence.
+    !
+    CALL routing_linkup(nbpt, contfrac, neighbours, nwbas, basin_count, basin_area, basin_id, basin_flowdir, &
+         & basin_hierarchy, outflow_grid, outflow_basin, inflow_number, inflow_grid, inflow_basin, &
+         & nbcoastal, coastal_basin, invented_basins)
+    ! 
+    !
+    WRITE(numout,*) 'The maximum number of basins in any grid :', MAXVAL(basin_count)
+    !
+    IF ( debug ) THEN
+       DO ib=1,SIZE(diagbox)
+          IF ( diagbox(ib) .GT. 0 ) THEN
+             WRITE(numout,*) 'After routing_linkup information for grid ', diagbox(ib)
+             DO jp=1,basin_count(diagbox(ib))
+                WRITE(numout,*) 'Basin ID : ', basin_id(diagbox(ib), jp)
+                WRITE(numout,*) 'Basin outflow_grid :', outflow_grid(diagbox(ib), jp)
+                WRITE(numout,*) 'Basin outflow_basin:', outflow_basin(diagbox(ib), jp)
+                WRITE(numout,*) 'Basin hierarchy :', basin_hierarchy(diagbox(ib), jp)
+             ENDDO
+          ENDIF
+       ENDDO
+    ENDIF
+    !
+    !! Computes the fetch of each basin, upstream area in known.
+    !
+    CALL routing_fetch(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_id, outflow_grid, &
+         & outflow_basin, fetch_basin)
+    !
+    !
+    WRITE(numout,*) "Start reducing the number of basins per grid to meet the required truncation."
+    !
+    !! Reduces the number of basins per grid to the value chosen by the user.
+    !
+    CALL routing_truncate(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_topoind,&
+         & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+         & inflow_grid, inflow_basin)
+    !
+    DEALLOCATE (lat_rel)
+    DEALLOCATE (lon_rel)
+    !
+    DEALLOCATE (trip)
+    DEALLOCATE (basins)
+    DEALLOCATE (topoindex)
+    DEALLOCATE (hierarchy)
+    !
+    DEALLOCATE (sub_area)
+    DEALLOCATE (sub_index)
+    DEALLOCATE (sub_pts)
+    !
+    DEALLOCATE (mask)
+    DEALLOCATE (resol_lu)
+    !
+    DEALLOCATE (basin_count)
+    DEALLOCATE (basin_area, basin_hierarchy, basin_topoind, fetch_basin)
+    DEALLOCATE (basin_id,  basin_flowdir)
+    DEALLOCATE (outflow_grid,outflow_basin)
+    DEALLOCATE (inflow_number)
+    DEALLOCATE (inflow_basin, inflow_grid)
+    DEALLOCATE (nbcoastal, coastal_basin)
+
+  END SUBROUTINE routing_basins
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_getgrid
+!!
+!>\BRIEF         This subroutine extracts from the global high resolution fields
+!!               the data for the current grid box we are dealing with.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!! Convention for trip on the input :
+!! The trip field follows the following convention for the flow of the water :
+!! trip = 1 : flow = N
+!! trip = 2 : flow = NE
+!! trip = 3 : flow = E
+!! trip = 4 : flow = SE
+!! trip = 5 : flow = S
+!! trip = 6 : flow = SW
+!! trip = 7 : flow = W
+!! trip = 8 : flow = NW
+!! trip = 97 : return flow into the ground
+!! trip = 98 : coastal flow (diffuse flow into the oceans) These values are created here
+!! trip = 99 : river flow into the oceans
+!!
+!! On output, the grid boxes of the basin map which flow out of the GCM grid are identified
+!! by numbers larger than 100 :
+!! trip = 101 : flow = N out of the coarse grid
+!! trip = 102 : flow = NE out of the coarse grid
+!! trip = 103 : flow = E out of the coarse grid
+!! trip = 104 : flow = SE out of the coarse grid
+!! trip = 105 : flow = S out of the coarse grid
+!! trip = 106 : flow = SW out of the coarse grid
+!! trip = 107 : flow = W out of the coarse grid
+!! trip = 108 : flow = NW out of the coarse grid
+!! Inside the grid the convention remains the same as above (ie between 1 and 99).:\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_getgrid(nbpt, iml, jml, ib, sub_pts, sub_index, sub_area, max_basins, min_topoind, &
+       & lon_rel, lat_rel, lalo, resolution, contfrac, trip, basins, topoindex, hierarchy, &
+       & nbi, nbj, area_bx, trip_bx, basin_bx, topoind_bx, hierarchy_bx, lon_bx, lat_bx)
+    !
+    IMPLICIT NONE
+    !
+!!  INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)  :: nbpt                        !! Domain size (unitless)
+    INTEGER(i_std), INTENT(in)  :: iml                         !! X resolution of the high resolution grid
+    INTEGER(i_std), INTENT(in)  :: jml                         !! Y resolution of the high resolution grid
+    INTEGER(i_std), INTENT(in)  :: ib                          !! Current basin (unitless)
+    INTEGER(i_std), INTENT(in)  :: sub_pts(nbpt)               !! Number of high resolution points on this grid (unitless)
+    INTEGER(i_std), INTENT(in)  :: sub_index(nbpt,nbvmax,2)    !! Indices of the points we need on the fine grid (unitless)
+    REAL(r_std), INTENT(inout)  :: max_basins                  !! The current maximum of basins
+    REAL(r_std), INTENT(in)     :: min_topoind                 !! The current minimum of topographic index (m)
+    REAL(r_std), INTENT(in)     :: sub_area(nbpt,nbvmax)       !! Area on the fine grid (m^2)
+    REAL(r_std), INTENT(in)     :: lon_rel(iml,jml)            !!
+    REAL(r_std), INTENT(in)     :: lat_rel(iml,jml)            !! coordinates of the fine grid
+    REAL(r_std), INTENT(in)     :: lalo(nbpt,2)                !! Vector of latitude and longitudes (beware of the order !)
+    REAL(r_std), INTENT(in)     :: resolution(nbpt,2)          !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)     :: contfrac(nbpt)              !! Fraction of land in each grid box (unitless;0-1)
+    REAL(r_std), INTENT(inout)  :: trip(iml,jml)               !! The trip field (unitless)
+    REAL(r_std), INTENT(inout)  :: basins(iml,jml)             !! data on the fine grid
+    REAL(r_std), INTENT(inout)  :: topoindex(iml,jml)          !! Topographic index of the residence time (m)
+    REAL(r_std), INTENT(inout)  :: hierarchy(iml, jml)         !! data on the fine grid
+    !
+!!  OUTPUT VARIABLES
+    INTEGER(i_std), INTENT(out) :: nbi, nbj                    !! Number of point in x and y within the grid (unitless)
+    REAL(r_std), INTENT(out)    :: area_bx(nbvmax,nbvmax)      !! Area of each small box in the grid box (m^2)
+    REAL(r_std), INTENT(out)    :: hierarchy_bx(nbvmax,nbvmax) !! Level in the basin of the point
+    REAL(r_std), INTENT(out)    :: lon_bx(nbvmax,nbvmax)       !!
+    REAL(r_std), INTENT(out)    :: lat_bx(nbvmax,nbvmax)       !!
+    REAL(r_std), INTENT(out)    :: topoind_bx(nbvmax,nbvmax)   !! Topographic index of the residence time for each of the smaller boxes (m)
+    INTEGER(i_std), INTENT(out) :: trip_bx(nbvmax,nbvmax)      !! The trip field for each of the smaller boxes (unitless)
+    INTEGER(i_std), INTENT(out) :: basin_bx(nbvmax,nbvmax)     !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)              :: ip, jp, ll(1), iloc, jloc   !! Indices (unitless)
+    REAL(r_std)                 :: lonstr(nbvmax*nbvmax)       !!
+    REAL(r_std)                 :: latstr(nbvmax*nbvmax)       !!
+
+!_ ================================================================================================================================
+
+    !
+    ! Set everything to undef to locate easily empty points
+    !
+    trip_bx(:,:) = undef_int
+    basin_bx(:,:) = undef_int
+    topoind_bx(:,:) = undef_sechiba
+    area_bx(:,:) = undef_sechiba
+    hierarchy_bx(:,:) = undef_sechiba
+    !
+    IF ( sub_pts(ib) > 0 ) THEN
+       !
+       DO ip=1,sub_pts(ib)
+          lonstr(ip) = lon_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+          latstr(ip) = lat_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+       ENDDO
+       !
+       !  Get the size of the area and order the coordinates to go from North to South and West to East
+       !
+       CALL routing_sortcoord(sub_pts(ib), lonstr, 'WE', nbi)
+       CALL routing_sortcoord(sub_pts(ib), latstr, 'NS', nbj)
+       !
+       ! Transfer the data in such a way that (1,1) is the North Western corner and
+       ! (nbi, nbj) the South Eastern.
+       !
+       DO ip=1,sub_pts(ib)
+          ll = MINLOC(ABS(lonstr(1:nbi) - lon_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))))
+          iloc = ll(1)
+          ll = MINLOC(ABS(latstr(1:nbj) - lat_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))))
+          jloc = ll(1)
+          trip_bx(iloc, jloc) = NINT(trip(sub_index(ib, ip, 1), sub_index(ib, ip, 2)))
+          basin_bx(iloc, jloc) = NINT(basins(sub_index(ib, ip, 1), sub_index(ib, ip, 2)))
+          area_bx(iloc, jloc) = sub_area(ib, ip)
+          topoind_bx(iloc, jloc) = topoindex(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+          hierarchy_bx(iloc, jloc) = hierarchy(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+          lon_bx(iloc, jloc) = lon_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+          lat_bx(iloc, jloc) = lat_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+       ENDDO
+    ELSE
+       !
+       ! This is the case where the model invented a continental point
+       !
+       nbi = 1
+       nbj = 1
+       iloc = 1
+       jloc = 1
+       trip_bx(iloc, jloc) = 98
+       basin_bx(iloc, jloc) = NINT(max_basins + 1)
+       max_basins = max_basins + 1
+       area_bx(iloc, jloc) = resolution(ib,1)*resolution(ib,2)*contfrac(ib)
+       topoind_bx(iloc, jloc) = min_topoind
+       hierarchy_bx(iloc, jloc) =  min_topoind
+       lon_bx(iloc, jloc) = lalo(ib,2)
+       lat_bx(iloc, jloc) = lalo(ib,1)
+       !
+    ENDIF
+    !
+    ! Tag in trip all the outflow conditions. The table is thus :
+    ! trip = 100+n : Outflow into another grid box
+    ! trip = 99    : River outflow into the ocean
+    ! trip = 98    : This will be coastal flow (not organized as a basin)
+    ! trip = 97    : return flow into the soil (local)
+    !
+    DO jp=1,nbj
+       IF ( trip_bx(1,jp) .EQ. 8 .OR. trip_bx(1,jp) .EQ. 7 .OR. trip_bx(1,jp) .EQ. 6) THEN
+          trip_bx(1,jp) = trip_bx(1,jp) + 100
+       ENDIF
+       IF ( trip_bx(nbi,jp) .EQ. 2 .OR. trip_bx(nbi,jp) .EQ. 3 .OR. trip_bx(nbi,jp) .EQ. 4) THEN
+          trip_bx(nbi,jp) = trip_bx(nbi,jp) + 100
+       ENDIF
+    ENDDO
+    DO ip=1,nbi
+       IF ( trip_bx(ip,1) .EQ. 8 .OR. trip_bx(ip,1) .EQ. 1 .OR. trip_bx(ip,1) .EQ. 2) THEN
+          trip_bx(ip,1) = trip_bx(ip,1) + 100
+       ENDIF
+       IF ( trip_bx(ip,nbj) .EQ. 6 .OR. trip_bx(ip,nbj) .EQ. 5 .OR. trip_bx(ip,nbj) .EQ. 4) THEN
+          trip_bx(ip,nbj) = trip_bx(ip,nbj) + 100
+       ENDIF
+    ENDDO
+    !
+    !
+    !  We simplify the outflow. We only need the direction normal to the
+    !     box boundary and the 4 corners.
+    ! 
+    ! Northern border
+    IF ( trip_bx(1,1) .EQ. 102 ) trip_bx(1,1) = 101
+    IF ( trip_bx(nbi,1) .EQ. 108 ) trip_bx(nbi,1) = 101
+    DO ip=2,nbi-1
+       IF ( trip_bx(ip,1) .EQ. 108 .OR. trip_bx(ip,1) .EQ. 102 ) trip_bx(ip,1) = 101
+    ENDDO
+    ! Southern border
+    IF ( trip_bx(1,nbj) .EQ. 104 ) trip_bx(1,nbj) = 105
+    IF ( trip_bx(nbi,nbj) .EQ. 106 ) trip_bx(nbi,nbj) = 105
+    DO ip=2,nbi-1
+       IF ( trip_bx(ip,nbj) .EQ. 104 .OR. trip_bx(ip,nbj) .EQ. 106 ) trip_bx(ip,nbj) = 105
+    ENDDO
+    ! Eastern border
+    IF ( trip_bx(nbi,1) .EQ. 104) trip_bx(nbi,1) = 103
+    IF ( trip_bx(nbi,nbj) .EQ. 102) trip_bx(nbi,nbj) = 103
+    DO jp=2,nbj-1
+       IF ( trip_bx(nbi,jp) .EQ. 104 .OR. trip_bx(nbi,jp) .EQ. 102 ) trip_bx(nbi,jp) = 103
+    ENDDO
+    ! Western border
+    IF ( trip_bx(1,1) .EQ. 106) trip_bx(1,1) = 107
+    IF ( trip_bx(1,nbj) .EQ. 108) trip_bx(1,nbj) = 107
+    DO jp=2,nbj-1
+       IF ( trip_bx(1,jp) .EQ. 106 .OR. trip_bx(1,jp) .EQ. 108 ) trip_bx(1,jp) = 107
+    ENDDO       
+    !
+    !
+  END SUBROUTINE routing_getgrid
+!
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_sortcoord
+!!
+!>\BRIEF         This subroutines orders the coordinates to go from North to South and West to East.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_sortcoord(nb_in, coords, direction, nb_out)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)   :: nb_in             !!
+    REAL(r_std), INTENT(inout)   :: coords(nb_in)     !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), INTENT(out)  :: nb_out            !!
+    !
+!! LOCAL VARIABLES
+    CHARACTER(LEN=2)             :: direction         !!
+    INTEGER(i_std)               :: ipos              !!
+    REAL(r_std)                  :: coords_tmp(nb_in) !!
+    INTEGER(i_std), DIMENSION(1) :: ll                !!
+    INTEGER(i_std)               :: ind(nb_in)        !!
+
+!_ ================================================================================================================================
+    !
+    ipos = 1
+    nb_out = nb_in
+    !
+    ! Compress the coordinates array
+    !
+    DO WHILE ( ipos < nb_in )
+       IF ( coords(ipos+1) /= undef_sechiba) THEN
+         IF ( COUNT(coords(ipos:nb_out) == coords(ipos)) > 1 ) THEN
+            coords(ipos:nb_out-1) = coords(ipos+1:nb_out) 
+            coords(nb_out:nb_in) = undef_sechiba
+            nb_out = nb_out - 1
+         ELSE
+            ipos = ipos + 1
+         ENDIF
+      ELSE
+         EXIT
+      ENDIF
+    ENDDO
+    !
+    ! Sort it now
+    !
+    ! First we get ready and adjust for the periodicity in longitude
+    !
+    coords_tmp(:) = undef_sechiba
+    IF ( INDEX(direction, 'WE') == 1 .OR.  INDEX(direction, 'EW') == 1) THEN
+       IF ( MAXVAL(ABS(coords(1:nb_out))) .GT. 160 ) THEN
+          coords_tmp(1:nb_out) = MOD(coords(1:nb_out) + 360.0, 360.0)
+       ELSE
+          coords_tmp(1:nb_out) = coords(1:nb_out)
+       ENDIF
+    ELSE IF ( INDEX(direction, 'NS') == 1 .OR.  INDEX(direction, 'SN') == 1) THEN
+       coords_tmp(1:nb_out) = coords(1:nb_out)
+    ELSE
+       WRITE(numout,*) 'The chosen direction (', direction,') is not recognized'
+       CALL ipslerr_p(3,'routing_sortcoord','The chosen direction is not recognized','First section','')
+    ENDIF
+    !
+    ! Get it sorted out now
+    !
+    ipos = 1
+    !
+    IF ( INDEX(direction, 'WE') == 1 .OR. INDEX(direction, 'SN') == 1) THEN
+       DO WHILE (COUNT(ABS(coords_tmp(:)-undef_sechiba) > EPSILON(undef_sechiba)*10.) >= 1)
+          ll = MINLOC(coords_tmp(:), coords_tmp /= undef_sechiba)
+          ind(ipos) = ll(1) 
+          coords_tmp(ll(1)) = undef_sechiba
+          ipos = ipos + 1
+       ENDDO
+    ELSE IF ( INDEX(direction, 'EW') == 1 .OR. INDEX(direction, 'NS') == 1) THEN
+       DO WHILE (COUNT(ABS(coords_tmp(:)-undef_sechiba) > EPSILON(undef_sechiba)*10.) >= 1)
+          ll = MAXLOC(coords_tmp(:), coords_tmp /= undef_sechiba)
+          ind(ipos) = ll(1) 
+          coords_tmp(ll(1)) = undef_sechiba
+          ipos = ipos + 1
+       ENDDO
+    ELSE
+       WRITE(numout,*) 'The chosen direction (', direction,') is not recognized (second)'
+       CALL ipslerr_p(3,'routing_sortcoord','The chosen direction is not recognized','Second section','')
+    ENDIF
+    !
+    coords(1:nb_out) = coords(ind(1:nb_out))
+    IF (nb_out < nb_in) THEN
+       coords(nb_out+1:nb_in) = zero
+    ENDIF
+    !
+  END SUBROUTINE routing_sortcoord
+  !
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_findbasins
+!!
+!>\BRIEF         This subroutine finds the basins and does some clean up.
+!!               The aim is to return the list off all points which are within the
+!!               same basin of the grid box.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!!  We will also collect all points which directly flow into the ocean in one basin
+!!  Make sure that we do not have a basin with two outflows and other exceptions.
+!!  At this stage no effort is made to come down to the truncation of the model.
+!!
+!! Convention for trip    \n
+!! -------------------    \n
+!! Inside of the box :    \n
+!! trip = 1 : flow = N    \n
+!! trip = 2 : flow = NE    \n
+!! trip = 3 : flow = E    \n
+!! trip = 4 : flow = SE    \n
+!! trip = 5 : flow = S    \n
+!! trip = 6 : flow = SW    \n
+!! trip = 7 : flow = W    \n
+!! trip = 8 : flow = NW    \n
+!! trip = 97 : return flow into the ground    \n
+!! trip = 98 : coastal flow (diffuse flow into the oceans) These values are created here    \n
+!! trip = 99 : river flow into the oceans    \n
+!!
+!! Out flow from the grid :    \n
+!! trip = 101 : flow = N out of the coarse grid    \n
+!! trip = 102 : flow = NE out of the coarse grid    \n
+!! trip = 103 : flow = E out of the coarse grid    \n
+!! trip = 104 : flow = SE out of the coarse grid    \n
+!! trip = 105 : flow = S out of the coarse grid    \n
+!! trip = 106 : flow = SW out of the coarse grid    \n
+!! trip = 107 : flow = W out of the coarse grid    \n
+!! trip = 108 : flow = NW out of the coarse grid!    \n
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_findbasins(nbi, nbj, trip, basin, hierarchy, topoind, nb_basin, basin_inbxid, basin_sz,&
+       & basin_bxout, basin_pts, coast_pts)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)    :: nbi                          !! Number of point in x within the grid (unitless)
+    INTEGER(i_std), INTENT(in)    :: nbj                          !! Number of point in y within the grid (unitless)
+    REAL(r_std), INTENT(in)       :: hierarchy(:,:)               !!
+    REAL(r_std), INTENT(in)       :: topoind(:,:)                 !! Topographic index of the residence time (m)
+    !
+    !  Modified
+    INTEGER(i_std), INTENT(inout) :: trip(:,:)                    !! The trip field (unitless)
+    INTEGER(i_std), INTENT(inout) :: basin(:,:)                   !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), INTENT(out)   :: nb_basin                     !! Number of sub-basins (unitless)
+    INTEGER(i_std), INTENT(out)   :: basin_inbxid(nbvmax)         !!
+    INTEGER(i_std), INTENT(out)   :: basin_sz(nbvmax)             !!
+    INTEGER(i_std), INTENT(out)   :: basin_bxout(nbvmax)          !!
+    INTEGER(i_std), INTENT(out)   :: basin_pts(nbvmax, nbvmax, 2) !!
+    INTEGER(i_std), INTENT(out)   :: coast_pts(nbvmax)            !! The coastal flow points (unitless)
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                :: ibas, ilf, nbb, nb_in        !!
+    INTEGER(i_std)                :: bname(nbvmax)                !!
+    INTEGER(i_std)                :: sz(nbvmax)                   !!
+    INTEGER(i_std)                :: pts(nbvmax,nbvmax,2)         !!
+    INTEGER(i_std)                :: nbout(nbvmax)                !!
+    INTEGER(i_std)                :: new_nb                       !!
+    INTEGER(i_std)                :: new_bname(nbvmax)            !!
+    INTEGER(i_std)                :: new_sz(nbvmax)               !!
+    INTEGER(i_std)                :: new_pts(nbvmax,nbvmax,2)     !!
+    INTEGER(i_std)                :: itrans                       !!
+    INTEGER(i_std)                :: trans(nbvmax)                !!
+    INTEGER(i_std)                :: outdir(nbvmax)               !!
+    INTEGER(i_std)                :: tmpsz(nbvmax)                !!
+    INTEGER(i_std)                :: ip, jp, jpp(1), ipb          !!
+    INTEGER(i_std)                :: sortind(nbvmax)              !!
+    CHARACTER(LEN=7)              :: fmt                          !!
+
+!_ ================================================================================================================================
+    !
+    nbb = 0
+    ibas = -1
+    bname(:) = undef_int
+    sz(:) = 0
+    nbout(:) = 0
+    new_pts(:,:,:) = 0
+    !
+    ! 1.0 Find all basins within this grid box
+    !     Sort the variables per basin so that we can more easily
+    !     access data from the same basin (The variables are :
+    !     bname, sz, pts, nbout)
+    !
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( basin(ip,jp) .LT. undef_int) THEN
+             IF ( COUNT(basin(ip,jp) .EQ. bname(:)) .EQ. 0 ) THEN
+                nbb = nbb + 1
+                IF ( nbb .GT. nbvmax ) CALL ipslerr_p(3,'routing_findbasins','nbvmax too small','first section','')
+                bname(nbb) = basin(ip,jp)
+                sz(nbb) = 0
+             ENDIF
+             !
+             DO ilf=1,nbb
+                IF ( basin(ip,jp) .EQ. bname(ilf) ) THEN
+                   ibas = ilf
+                ENDIF
+             ENDDO
+             !
+             sz(ibas) = sz(ibas) + 1
+             IF ( sz(ibas) .GT. nbvmax ) CALL ipslerr_p(3,'routing_findbasins','nbvmax too small','second section','')
+             pts(ibas, sz(ibas), 1) = ip
+             pts(ibas, sz(ibas), 2) = jp
+             ! We deal only with outflow and leave flow back into the grid box for later.
+             IF ( trip(ip,jp) .GE. 97 ) THEN
+                nbout(ibas) = nbout(ibas) + 1
+             ENDIF
+             !
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    ! 2.0 All basins which have size 1 and flow to the ocean are put together.
+    !
+    itrans = 0
+    coast_pts(:) = undef_int
+    ! Get all the points we can collect
+    DO ip=1,nbb
+       IF ( sz(ip) .EQ. 1 .AND. trip(pts(ip,1,1),pts(ip,1,2)) .EQ. 99) THEN
+          itrans = itrans + 1
+          trans(itrans) = ip
+          trip(pts(ip,1,1),pts(ip,1,2)) = 98
+       ENDIF
+    ENDDO
+    ! put everything in the first basin
+    IF ( itrans .GT. 1) THEN
+       ipb = trans(1)
+       coast_pts(sz(ipb)) = bname(ipb)
+       bname(ipb) = -1
+       DO ip=2,itrans
+          sz(ipb) = sz(ipb) + 1
+          coast_pts(sz(ipb)) = bname(trans(ip))
+          sz(trans(ip)) = 0
+          pts(ipb, sz(ipb), 1) = pts(trans(ip), 1, 1) 
+          pts(ipb, sz(ipb), 2) = pts(trans(ip), 1, 2) 
+       ENDDO
+    ENDIF
+    !
+    ! 3.0 Make sure that we have only one outflow point in each basin
+    !
+    ! nbb is the number of basins on this grid box.
+    new_nb = 0
+    DO ip=1,nbb
+       ! We only do this for grid-points which have more than one outflow
+       IF ( sz(ip) .GT. 1 .AND. nbout(ip) .GT. 1) THEN
+          !
+          ! Pick up all points needed and store them in trans
+          !
+          itrans = 0
+          DO jp=1,sz(ip)
+             IF ( trip(pts(ip,jp,1),pts(ip,jp,2)) .GE. 97) THEN
+                itrans = itrans + 1
+                trans(itrans) = trip(pts(ip,jp,1),pts(ip,jp,2))
+             ENDIF
+          ENDDO
+          !
+          ! First issue : We have more than one point of the basin which flows into
+          ! the ocean. In this case we put everything into coastal flow. It will go into
+          ! a separate basin in the routing_globalize routine.
+          !
+          IF ( (COUNT(trans(1:itrans) .EQ. 99) + COUNT(trans(1:itrans) .EQ. 98)) .GT. 1) THEN
+             DO jp=1,sz(ip)
+                IF ( trip(pts(ip,jp,1),pts(ip,jp,2)) .EQ. 99 ) THEN
+                   trip(pts(ip,jp,1),pts(ip,jp,2)) = 98
+                   trans(itrans) = trip(pts(ip,jp,1),pts(ip,jp,2))
+                ENDIF
+             ENDDO
+          ENDIF
+          !
+          ! Second issue : We have redundant outflows at the boundaries. That is two small grid
+          ! boxes flowing into the same GCM grid box.
+          !
+          IF ( COUNT(trans(1:itrans) .GT. 100) .GE. 1) THEN
+             CALL routing_simplify(nbi, nbj, trip, basin, hierarchy, bname(ip))
+             itrans = 0
+             DO jp=1,sz(ip)
+                IF ( trip(pts(ip,jp,1),pts(ip,jp,2)) .GE. 9) THEN
+                   itrans = itrans + 1
+                   trans(itrans) = trip(pts(ip,jp,1),pts(ip,jp,2))
+                ENDIF
+             ENDDO
+          ENDIF
+          !
+          ! Third issue : we have more than one outflow from the boxes. This could be 
+          !             - flow into 2 or more neighboring GCM grids
+          !             - flow into a neighboring GCM grids and into the ocean or be a return flow (=97. =98, =99)
+          !             - flow into a neighboring GCM grids or ocean and back into the same GCM grid box
+          ! The only solution is to cut the basin up in as many parts.
+          !
+          IF ( COUNT(trans(1:itrans) .GE. 97) .GT. 1) THEN
+             !
+             nb_in =  new_nb
+             CALL routing_cutbasin(nbi, nbj, nbb, trip, basin, bname(ip), new_nb, new_bname, new_sz, new_pts)
+             !
+             ! If we have split the basin then we need to cancel the old one
+             !
+             IF ( nb_in .NE. new_nb) THEN
+                sz(ip) = 0
+             ENDIF
+             !
+          ENDIF
+          !
+       ENDIF
+    ENDDO
+    !
+    !  Add the new basins to the end of the list
+    !
+    If ( nbb+new_nb .LE. nbvmax) THEN
+       DO ip=1,new_nb
+          bname(nbb+ip) = new_bname(ip)
+          sz(nbb+ip) = new_sz(ip)
+          pts(nbb+ip,:,:) = new_pts(ip,:,:)
+       ENDDO
+       nbb = nbb+new_nb
+    ELSE
+       WRITE(numout,*) 'Increase nbvmax. It is too small to contain all the basins (routing_findbasins)'
+       CALL ipslerr_p(3,'routing_findbasins','Increase nbvmax.','It is too small to contain all the basins','')
+    ENDIF
+    !
+    ! Keep the output direction
+    !
+    DO ip=1,nbb
+       IF ( sz(ip) .GT. 0 ) THEN
+          trans(:) = 0
+          DO jp=1,sz(ip)
+             trans(jp) = trip(pts(ip,jp,1),pts(ip,jp,2))
+          ENDDO
+          outdir(ip) = MAXVAL(trans(1:sz(ip)))
+          IF ( outdir(ip) .GE. 97 ) THEN
+             outdir(ip) = outdir(ip) - 100
+          ELSE
+             WRITE(numout,*) 'Why are we here and can not find a trip larger than 96'
+             WRITE(numout,*) 'Does this mean that the basin does not have any outflow ', ip, bname(ip)
+             WRITE(fmt,"('(',I3,'I9)')") nbi
+             WRITE(numout,*) '-----------------------> trip'
+             DO jp=1,nbj
+                WRITE(numout,fmt) trip(1:nbi,jp)
+             ENDDO
+             WRITE(numout,*) '-----------------------> basin'
+             DO jp=1,nbj
+                WRITE(numout,fmt) basin(1:nbi,jp)
+             ENDDO
+             CALL ipslerr_p(3,'routing_findbasins','Probleme finding trip','','')
+          ENDIF
+       ENDIF
+    ENDDO
+    !
+    !
+    ! Sort the output by size of the various basins. 
+    !
+    nb_basin = COUNT(sz(1:nbb) .GT. 0)
+    tmpsz(:) = -1
+    tmpsz(1:nbb) = sz(1:nbb)
+    DO ip=1,nbb
+       jpp = MAXLOC(tmpsz(:))
+       IF ( sz(jpp(1)) .GT. 0) THEN
+          sortind(ip) = jpp(1)
+          tmpsz(jpp(1)) = -1
+       ENDIF
+    ENDDO
+    basin_inbxid(1:nb_basin) = bname(sortind(1:nb_basin))
+    basin_sz(1:nb_basin) = sz(sortind(1:nb_basin))
+    basin_pts(1:nb_basin,:,:) = pts(sortind(1:nb_basin),:,:)
+    basin_bxout(1:nb_basin) = outdir(sortind(1:nb_basin))
+    !
+    ! We can only check if we have at least as many outflows as basins
+    !
+    ip = COUNT(trip(1:nbi,1:nbj) .GE. 97 .AND. trip(1:nbi,1:nbj) .LT. undef_int)
+!!    ip = ip + COUNT(trip(1:nbi,1:nbj) .EQ. 97)
+!!    IF ( COUNT(trip(1:nbi,1:nbj) .EQ. 98) .GT. 0) ip = ip + 1
+    IF ( ip .LT. nb_basin ) THEN
+       WRITE(numout,*) 'We have less outflow points than basins :', ip
+       WRITE(fmt,"('(',I3,'I9)')") nbi
+       WRITE(numout,*) '-----------------------> trip'
+       DO jp=1,nbj
+          WRITE(numout,fmt) trip(1:nbi,jp)
+       ENDDO
+       WRITE(numout,*) '-----------------------> basin'
+       DO jp=1,nbj
+          WRITE(numout,fmt) basin(1:nbi,jp)
+       ENDDO
+       WRITE(numout,*) 'nb_basin :', nb_basin
+       WRITE(numout,*) 'Basin sized :', basin_sz(1:nb_basin)
+       CALL ipslerr_p(3,'routing_findbasins','Probleme less outflow points than basins','','')
+    ENDIF
+    
+  END SUBROUTINE routing_findbasins
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_simplify
+!!
+!>\BRIEF         This subroutine symplifies the routing out of each basin by taking 
+!!               out redundancies at the borders of the GCM box.
+!!               The aim is to have only one outflow point per basin and grid box.
+!!               But here we will not change the direction of the outflow.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_simplify(nbi, nbj, trip, basin, hierarchy, basin_inbxid)
+    !
+    IMPLICIT NONE
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                             :: nbi                        !! Number of point in x within the grid (unitless)
+    INTEGER(i_std)                             :: nbj                        !! Number of point in y within the grid (unitless)
+    INTEGER(i_std)                             :: trip(:,:)                  !! The trip field (unitless)
+    INTEGER(i_std)                             :: basin(:,:)                 !!
+    REAL(r_std)                                :: hierarchy(:,:)             !!
+    INTEGER(i_std)                             :: basin_inbxid               !!
+    !
+    INTEGER(i_std)                             :: ip, jp, nbout, basin_sz, iborder !!
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)   :: trip_tmp                   !! Temporary trip field which only contains the values for the basin on which we currently work (1)
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax,2) :: trip_flow                  !!
+    INTEGER(i_std), DIMENSION(nbvmax,2)        :: outflow                    !!
+    INTEGER(i_std), DIMENSION(nbvmax)          :: outsz                      !!
+    CHARACTER(LEN=7)                           :: fmt                        !!
+    !
+    INTEGER(i_std), DIMENSION(8,2)             :: inc                        !!
+    INTEGER(i_std)                             :: itodo, ill(1), icc, ismall, ibas, iip, jjp, ib, id !! Indices (unitless)
+    INTEGER(i_std), DIMENSION(nbvmax)          :: todopt                     !!
+!!$, todosz
+    REAL(r_std), DIMENSION(nbvmax)             :: todohi                     !!
+    LOGICAL                                    :: not_found, debug = .FALSE. !! (true/false)
+
+!_ ================================================================================================================================
+    !
+    !
+    !  The routing code (i=1, j=2)
+    !
+    inc(1,1) = 0
+    inc(1,2) = -1
+    inc(2,1) = 1
+    inc(2,2) = -1
+    inc(3,1) = 1
+    inc(3,2) = 0
+    inc(4,1) = 1
+    inc(4,2) = 1
+    inc(5,1) = 0
+    inc(5,2) = 1
+    inc(6,1) = -1
+    inc(6,2) = 1
+    inc(7,1) = -1
+    inc(7,2) = 0
+    inc(8,1) = -1
+    inc(8,2) = -1
+    !
+    !
+    !  Symplify the outflow conditions first. We are only interested in the
+    !  outflows which go to different GCM grid boxes.
+    !
+    IF ( debug ) THEN
+       WRITE(numout,*) '+++++++++++++++++++ BEFORE ANYTHING ++++++++++++++++++++'
+       WRITE(fmt,"('(',I3,'I6)')") nbi
+       DO jp=1,nbj
+          WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+       ENDDO
+    ENDIF
+    !
+    !  transfer the trips into an array which only contains the basin we are interested in
+    !
+    trip_tmp(:,:) = -1
+    basin_sz = 0
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( basin(ip,jp) .EQ. basin_inbxid) THEN
+             trip_tmp(ip,jp) = trip(ip,jp)
+             basin_sz = basin_sz + 1
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Determine for each point where it flows to
+    !
+    CALL routing_findrout(nbi, nbj, trip_tmp, basin_sz, basin_inbxid, nbout, outflow, trip_flow, outsz)
+    !
+    !
+    !
+    !
+    ! Over the width of a GCM grid box we can have many outflows but we are interested
+    ! in only one for each basin. Thus we wish to collect them all to form only one outflow
+    ! to the neighboring grid box.
+    !
+    DO iborder = 101,107,2
+       !
+       ! If we have more than one of these outflows then we need to merge the sub-basins
+       !
+       icc = COUNT(trip_tmp .EQ. iborder)-1
+       DO WHILE ( icc .GT. 0)
+          ! Pick out all the points we will have to do
+          itodo = 0
+          DO ip=1,nbout
+             IF (trip_tmp(outflow(ip,1),outflow(ip,2)) .EQ. iborder) THEN
+                itodo = itodo + 1
+                todopt(itodo) = ip
+!!$                todosz(itodo) = outsz(ip)
+                ! We take the hierarchy of the outflow point as we will try to
+                ! minimize if for the outflow of the entire basin.
+                todohi(itodo) = hierarchy(outflow(ip,1),outflow(ip,2))
+             ENDIF
+          ENDDO
+          !
+          ! We change the direction of the smallest basin.
+          !
+          ill=MAXLOC(todohi(1:itodo))
+          ismall = todopt(ill(1))
+          !
+          DO ip=1,nbi
+             DO jp=1,nbj
+                IF ( trip_flow(ip,jp,1) .EQ. outflow(ismall,1) .AND.&
+                     & trip_flow(ip,jp,2) .EQ. outflow(ismall,2) ) THEN
+                   ! Now that we have found a point of the smallest sub-basin we 
+                   ! look around for another sub-basin
+                   ib = 1
+                   not_found = .TRUE.
+                   DO WHILE ( not_found .AND. ib .LE. itodo ) 
+                      IF ( ib .NE. ill(1) ) THEN
+                         ibas = todopt(ib)
+                         DO id=1,8
+                            iip = ip + inc(id,1)
+                            jjp = jp + inc(id,2)
+                            ! Can we look at this points or is there any need to ?
+                            IF ( iip .GE. 1 .AND. iip .LE. nbi .AND. &
+                                 & jjp .GE. 1 .AND. jjp .LE. nbj .AND. not_found) THEN
+                               ! Is this point the one we look for ?
+                               IF ( trip_flow(iip,jjp,1) .EQ. outflow(ibas,1) .AND. &
+                                    & trip_flow(iip,jjp,2) .EQ. outflow(ibas,2)) THEN
+                                  trip_flow(ip,jp,1) = outflow(ibas,1)
+                                  trip_flow(ip,jp,2) = outflow(ibas,2)
+                                  trip_tmp(ip,jp) = id
+                                  ! This last line ensures that we do not come back to this point
+                                  ! and that in the end the outer while will stop
+                                  not_found = .FALSE.
+                               ENDIF
+                            ENDIF
+                         ENDDO
+                      ENDIF
+                      ib = ib + 1
+                   ENDDO
+                ENDIF
+             ENDDO
+          ENDDO
+          !
+          icc = icc - 1
+       ENDDO
+       !
+       !
+    ENDDO
+    !
+    IF ( debug ) THEN
+       WRITE(numout,*) '+++++++++++++++++++ AFTER +++++++++++++++++++++++++++++'
+       WRITE(fmt,"('(',I3,'I6)')") nbi
+       DO jp=1,nbj
+          WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+       ENDDO
+    ENDIF
+    !
+    !  Put trip_tmp back into trip
+    !
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( trip_tmp(ip,jp) .GT. 0) THEN
+             trip(ip,jp) = trip_tmp(ip,jp)
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE routing_simplify
+!
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_cutbasin
+!!
+!>\BRIEF        This subroutine cuts the original basin which has more than one outflow
+!!              into as many subbasins as outflow directions.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_cutbasin (nbi, nbj, nbbasins, trip, basin, basin_inbxid, nb, bname, sz, pts)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                 :: nbi, nbj             !! Number of point in x and y within the grid (unitless)
+    INTEGER(i_std), INTENT(in)                 :: nbbasins             !!
+    INTEGER(i_std), INTENT(in)                 :: basin_inbxid         !!
+    !
+    !  Modified
+    INTEGER(i_std), INTENT(inout)              :: trip(:,:)            !! The trip field (unitless)
+    INTEGER(i_std), INTENT(inout)              :: basin(:,:)           !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), INTENT(out)                :: nb                   !!
+    INTEGER(i_std), INTENT(out)                :: bname(nbvmax)        !!
+    INTEGER(i_std), INTENT(out)                :: sz(nbvmax)           !!
+    INTEGER(i_std), INTENT(out)                :: pts(nbvmax,nbvmax,2) !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                             :: ip, jp, iip, jjp, ib, ibb, id, nbout !! Indices (unitless)
+    INTEGER(i_std)                             :: basin_sz             !!
+    INTEGER(i_std)                             :: nb_in                !!
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)   :: trip_tmp             !! Temporary trip field which only contains the values for the basin on which we currently work (unitless)
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax,2) :: trip_flow            !!
+    INTEGER(i_std), DIMENSION(nbvmax,2)        :: outflow              !!
+    INTEGER(i_std), DIMENSION(nbvmax)          :: outsz                !!
+    CHARACTER(LEN=7)                           :: fmt                  !!
+    LOGICAL                                    :: not_found            !! (true/false)
+    LOGICAL                                    :: debug=.FALSE.        !! (true/false)
+    !
+    INTEGER(i_std), DIMENSION(8,2)             :: inc                  !!
+
+!_ ================================================================================================================================
+    !
+    !
+    !  The routing code (i=1, j=2)
+    !
+    inc(1,1) = 0
+    inc(1,2) = -1
+    inc(2,1) = 1
+    inc(2,2) = -1
+    inc(3,1) = 1
+    inc(3,2) = 0
+    inc(4,1) = 1
+    inc(4,2) = 1
+    inc(5,1) = 0
+    inc(5,2) = 1
+    inc(6,1) = -1
+    inc(6,2) = 1
+    inc(7,1) = -1
+    inc(7,2) = 0
+    inc(8,1) = -1
+    inc(8,2) = -1
+    !
+    ! Set up a temporary trip field which only contains the values
+    ! for the basin on which we currently work.
+    !
+    trip_tmp(:,:) = -1
+    basin_sz = 0
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( basin(ip,jp) .EQ. basin_inbxid) THEN
+             trip_tmp(ip,jp) = trip(ip,jp)
+             basin_sz = basin_sz + 1
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    CALL routing_findrout(nbi, nbj, trip_tmp, basin_sz, basin_inbxid, nbout, outflow, trip_flow, outsz)
+    ! 
+!    IF ( debug ) THEN
+!       DO ib = nb_in+1,nb
+!          DO ip=1,sz(ib)
+!             trip_tmp(pts(ib, ip, 1),pts(ib, ip, 2)) = ib*(-1)-900
+!          ENDDO
+!       ENDDO
+!       WRITE(fmt,"('(',I3,'I6)')") nbi
+!       WRITE(numout,*)  'BEFORE ------------> New basins '
+!       WRITE(numout,*) nb, ' sz :', sz(1:nb)
+!       DO jp=1,nbj
+!          WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+!       ENDDO
+!    ENDIF
+    !
+    !  Take out the small sub-basins. That is those which have only one grid box
+    !  This is only done if we need to save space in the number of basins. Else we
+    !  can take it easy and keep diverging sub-basins for the moment. 
+    !
+    IF ( nbbasins .GE. nbasmax ) THEN
+       DO ib=1,nbout
+          ! If the sub-basin is of size one and its larger neighbor is flowing into another
+          ! direction then we put them together.
+          IF ( outsz(ib) .EQ. 1 .AND. trip(outflow(ib,1), outflow(ib,2)) .GT. 99 ) THEN
+             !
+             not_found = .TRUE.
+             DO id=1,8
+                ip = outflow(ib,1)
+                jp = outflow(ib,2)
+                iip = ip + inc(id,1)
+                jjp = jp + inc(id,2)
+                ! Can we look at this points ?
+                IF ( iip .GE. 1 .AND. iip .LE. nbi .AND. &
+                     & jjp .GE. 1 .AND. jjp .LE. nbj .AND. not_found) THEN
+                   ! Did we find a direct neighbor which is an outflow point ?
+                   IF ( trip_tmp(iip,jjp) .GT. 100 ) THEN
+                      ! IF so direct the flow towards it and update the tables.
+                      not_found = .FALSE.
+                      trip(ip,jp) = id
+                      trip_tmp(ip,jp) = id
+                      outsz(ib) = 0
+                      ! update the table of this basin
+                      DO ibb=1,nbout
+                         IF ( iip .EQ. outflow(ibb,1) .AND. jjp .EQ. outflow(ibb,2) ) THEN
+                            outsz(ibb) = outsz(ibb)+1 
+                            trip_flow(ip,jp,1) = outflow(ibb,1)
+                            trip_flow(ip,jp,2) = outflow(ibb,2)
+                         ENDIF
+                      ENDDO
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDIF
+       ENDDO
+    ENDIF
+    !
+    !
+    !  Cut the basin if we have more than 1 left.
+    !
+    !
+    IF ( COUNT(outsz(1:nbout) .GT. 0) .GT. 1 ) THEN
+       !
+       nb_in = nb
+       !
+       DO ib = 1,nbout
+          IF ( outsz(ib) .GT. 0) THEN
+             nb = nb+1
+             IF ( nb .GT. nbvmax) THEN
+                WRITE(numout,*) 'nbvmax too small, increase it (routing_cutbasin)'
+             ENDIF
+             bname(nb) = basin_inbxid
+             sz(nb) = 0
+             DO ip=1,nbi
+                DO jp=1,nbj
+                   IF ( (trip_flow(ip,jp,1) + trip_flow(ip,jp,1)) .GT. 0 .AND. &
+                      & trip_flow(ip,jp,1) .EQ. outflow(ib,1) .AND. &
+                      & trip_flow(ip,jp,2) .EQ. outflow(ib,2) ) THEN
+                      sz(nb) = sz(nb) + 1
+                      pts(nb, sz(nb), 1) = ip
+                      pts(nb, sz(nb), 2) = jp
+                   ENDIF
+                ENDDO
+             ENDDO
+          ENDIF
+       ENDDO
+       ! A short verification 
+       IF ( SUM(sz(nb_in+1:nb)) .NE. basin_sz) THEN
+          WRITE(numout,*) 'Lost some points while spliting the basin'
+          WRITE(numout,*) 'nbout :', nbout
+          DO ib = nb_in+1,nb
+             WRITE(numout,*) 'ib, SZ :', ib, sz(ib)
+          ENDDO
+          WRITE(fmt,"('(',I3,'I6)')") nbi
+          WRITE(numout,*)  '-------------> trip '
+          DO jp=1,nbj
+             WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+          ENDDO
+          CALL ipslerr_p(3,'routing_cutbasin','Lost some points while spliting the basin','','')
+       ENDIF
+       
+       IF ( debug ) THEN
+          DO ib = nb_in+1,nb
+             DO ip=1,sz(ib)
+                trip_tmp(pts(ib, ip, 1),pts(ib, ip, 2)) = ib*(-1)-900
+             ENDDO
+          ENDDO
+          WRITE(fmt,"('(',I3,'I6)')") nbi
+          WRITE(numout,*)  'AFTER-------------> New basins '
+          WRITE(numout,*) nb, ' sz :', sz(1:nb)
+          DO jp=1,nbj
+             WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+          ENDDO
+          IF ( MAXVAl(trip_tmp(1:nbi,1:nbj)) .GT. 0) THEN
+             CALL ipslerr_p(3,'routing_cutbasin','Error in debug checking','','')
+          ENDIF
+       ENDIF
+    ENDIF
+    !
+  END SUBROUTINE routing_cutbasin
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_hierarchy
+!!
+!>\BRIEF        This subroutine finds, for each point, the distance to the outflow
+!!               point along the flowlines of the basin. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_hierarchy(iml, jml, trip, topoindex, hierarchy)
+    !
+    IMPLICIT NONE
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                  :: iml          !! X resolution of the high resolution grid
+    INTEGER(i_std)                  :: jml          !! Y resolution of the high resolution grid
+    REAL(r_std), DIMENSION(iml,jml) :: trip         !! The trip field (unitless)
+    REAL(r_std), DIMENSION(iml,jml) :: hierarchy    !!
+    REAL(r_std), DIMENSION(iml,jml) :: topoindex    !! Topographic index of the residence time (m)
+    !
+    INTEGER(i_std), DIMENSION(8,2)  :: inc          !!
+    INTEGER(i_std)                  :: ip, jp, ib, ntripi, ntripj, cnt, trp !!
+    REAL(r_std)                     :: topohier     !! The new value of topographically weighted hierarchy (m)
+    REAL(r_std)                     :: topohier_old !! The old value of topographically weighted hierarchy (m)
+    CHARACTER(LEN=7)                :: fmt          !!
+
+!_ ================================================================================================================================
+    !
+    !  The routing code (i=1, j=2)
+    !
+    inc(1,1) = 0
+    inc(1,2) = -1
+    inc(2,1) = 1
+    inc(2,2) = -1
+    inc(3,1) = 1
+    inc(3,2) = 0
+    inc(4,1) = 1
+    inc(4,2) = 1
+    inc(5,1) = 0
+    inc(5,2) = 1
+    inc(6,1) = -1
+    inc(6,2) = 1
+    inc(7,1) = -1
+    inc(7,2) = 0
+    inc(8,1) = -1
+    inc(8,2) = -1
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          IF ( trip(ip,jp) .LT. undef_sechiba ) THEN
+             ntripi = ip
+             ntripj = jp
+             trp = NINT(trip(ip,jp))
+             cnt = 1
+             ! Warn for extreme numbers
+             IF (  topoindex(ip,jp) .GT. 1.e10 ) THEN
+                WRITE(numout,*) 'We have a very large topographic index for point ', ip, jp
+                WRITE(numout,*) 'This can not be right :', topoindex(ip,jp)
+                CALL ipslerr_p(3,'routing_hierarchy','Too large topographic index','','')
+             ELSE
+                topohier = topoindex(ip,jp)
+             ENDIF
+             !
+             DO WHILE ( trp .GT. 0 .AND. trp .LT. 9 .AND. cnt .LT. iml*jml) 
+                cnt = cnt + 1
+                ntripi = ntripi + inc(trp,1)
+                IF ( ntripi .LT. 1) ntripi = iml
+                IF ( ntripi .GT. iml) ntripi = 1
+                ntripj = ntripj + inc(trp,2)
+                topohier_old = topohier
+                topohier = topohier + topoindex(ntripi, ntripj)
+                IF ( topohier_old .GT. topohier) THEN
+                   WRITE(numout,*) 'Big Problem, how comes we climb up a hill ?'
+                   WRITE(numout,*) 'The old value of topographicaly weighted hierarchy was : ', topohier_old
+                   WRITE(numout,*) 'The new one is :', topohier
+                   CALL ipslerr_p(3,'routing_hierarchy','Big Problem, how comes we climb up a hill ?','','')
+                ENDIF
+                trp = NINT(trip(ntripi, ntripj))
+             ENDDO
+             
+             IF ( cnt .EQ. iml*jml) THEN
+                WRITE(numout,*) 'We could not route point (routing_findrout) :', ip, jp
+                WRITE(numout,*) '-------------> trip '
+                WRITE(fmt,"('(',I3,'I6)')") iml
+                DO ib=1,jml
+                   WRITE(numout,fmt) trip(1:iml,ib)
+                ENDDO
+                CALL ipslerr_p(3,'routing_hierarchy','We could not route point','','')
+             ENDIF
+             
+             hierarchy(ip,jp) = topohier
+             
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    !
+  END SUBROUTINE routing_hierarchy
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_findrout
+!!
+!>\BRIEF        This subroutine simply computes the route to each outflow point
+!!              and returns the outflow point for each point in the basin.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_findrout(nbi, nbj, trip, basin_sz, basinid, nbout, outflow, trip_flow, outsz)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std)                                          :: nbi       !! Number of point in x within the grid (unitless)
+    INTEGER(i_std)                                          :: nbj       !! Number of point in y within the grid (unitless)
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)                :: trip      !! The trip field (unitless)
+    INTEGER(i_std)                                          :: basin_sz  !!
+    INTEGER(i_std)                                          :: basinid   !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), DIMENSION(nbvmax,2), INTENT(out)        :: outflow   !!
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax,2), INTENT(out) :: trip_flow !!
+    INTEGER(i_std), INTENT(out)                             :: nbout     !! 
+    INTEGER(i_std), DIMENSION(nbvmax), INTENT(out)          :: outsz     !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std), DIMENSION(8,2)                          :: inc       !!
+    INTEGER(i_std)                                          :: ip, jp, ib, cnt, trp, totsz !! Indices (unitless)
+    CHARACTER(LEN=7)                                        :: fmt       !!
+
+!_ ================================================================================================================================
+    !
+    !
+    !  The routing code (i=1, j=2)
+    !
+    inc(1,1) = 0
+    inc(1,2) = -1
+    inc(2,1) = 1
+    inc(2,2) = -1
+    inc(3,1) = 1
+    inc(3,2) = 0
+    inc(4,1) = 1
+    inc(4,2) = 1
+    inc(5,1) = 0
+    inc(5,2) = 1
+    inc(6,1) = -1
+    inc(6,2) = 1
+    inc(7,1) = -1
+    inc(7,2) = 0
+    inc(8,1) = -1
+    inc(8,2) = -1
+    !
+    !
+    !  Get the outflows and determine for each point to which outflow point it belong 
+    !
+    nbout = 0
+    trip_flow(:,:,:) = 0
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( trip(ip,jp) .GT. 9) THEN
+             nbout = nbout + 1
+             outflow(nbout,1) = ip
+             outflow(nbout,2) = jp
+          ENDIF 
+          IF ( trip(ip,jp) .GT. 0) THEN
+             trip_flow(ip,jp,1) = ip
+             trip_flow(ip,jp,2) = jp
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Follow the flow of the water
+    !
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( (trip_flow(ip,jp,1) + trip_flow(ip,jp,2)) .GT. 0) THEN
+             trp = trip(trip_flow(ip,jp,1), trip_flow(ip,jp,2))
+             cnt = 0
+             DO WHILE ( trp .GT. 0 .AND. trp .LT. 9 .AND. cnt .LT. nbi*nbj) 
+                cnt = cnt + 1
+                trip_flow(ip,jp,1) = trip_flow(ip,jp,1) + inc(trp,1)
+                trip_flow(ip,jp,2) = trip_flow(ip,jp,2) + inc(trp,2)
+                trp = trip(trip_flow(ip,jp,1), trip_flow(ip,jp,2))
+             ENDDO
+             IF ( cnt .EQ. nbi*nbj) THEN
+                WRITE(numout,*) 'We could not route point (routing_findrout) :', ip, jp
+                WRITE(numout,*) '-------------> trip '
+                WRITE(fmt,"('(',I3,'I6)')") nbi
+                DO ib=1,nbj
+                   WRITE(numout,fmt) trip(1:nbi,ib)
+                ENDDO
+                CALL ipslerr_p(3,'routing_findrout','We could not route point','','')
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    !  What is the size of the region behind each outflow point ?
+    !
+    totsz = 0
+    DO ip=1,nbout
+       outsz(ip) = COUNT(trip_flow(:,:,1) .EQ. outflow(ip,1) .AND. trip_flow(:,:,2) .EQ. outflow(ip,2))
+       totsz = totsz + outsz(ip)
+    ENDDO
+    IF ( basin_sz .NE. totsz) THEN
+       WRITE(numout,*) 'Water got lost while I tried to follow it '
+       WRITE(numout,*) basin_sz, totsz
+       WRITE(numout,*) 'Basin id :', basinid
+       DO ip=1,nbout
+          WRITE(numout,*) 'ip :', ip, ' outsz :', outsz(ip), ' outflow :', outflow(ip,1), outflow(ip,2)
+       ENDDO
+       WRITE(numout,*) '-------------> trip '
+       WRITE(fmt,"('(',I3,'I6)')") nbi
+       DO jp=1,nbj
+          WRITE(numout,fmt) trip(1:nbi,jp)
+       ENDDO
+       CALL ipslerr_p(3,'routing_findrout','Water got lost while I tried to follow it','','')
+    ENDIF
+    !
+  END SUBROUTINE routing_findrout
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_globalize
+!!
+!>\BRIEF        This subroutine puts the basins found for grid box in the global map.
+!!               Connection can only be made later when all information is together. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!! One of the outputs is basin_flowdir. Its convention is 1-8 for the directions from North to North
+!! West going through South. The negative values will be -3 for return flow, -2 for coastal flow
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_globalize(nbpt, ib, neighbours, area_bx, trip_bx, hierarchy_bx, topoind_bx, min_topoind,&
+       & nb_basin, basin_inbxid, basin_sz, basin_pts, basin_bxout, coast_pts, nwbas, basin_count,&
+       & basin_area, basin_hierarchy, basin_topoind, basin_id, basin_flowdir, outflow_grid,&
+       & nbcoastal, coastal_basin)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT (in)                :: nbpt                   !! Domain size (unitless)
+    INTEGER(i_std), INTENT (in)                :: ib                     !! Current basin (unitless)
+    INTEGER(i_std), INTENT(in)                 :: neighbours(nbpt,NbNeighb)!! Vector of neighbours for each grid point 
+                                                                         !! (1=North and then clockwise)
+!! LOCAL VARIABLES 
+    REAL(r_std), DIMENSION(nbvmax,nbvmax)      :: area_bx                !! Area of each small box in the grid box (m^2)
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)   :: trip_bx                !! The trip field for each of the smaller boxes (unitless)
+    REAL(r_std), DIMENSION(nbvmax,nbvmax)      :: hierarchy_bx           !! Level in the basin of the point
+    REAL(r_std), DIMENSION(nbvmax,nbvmax)      :: topoind_bx             !! Topographic index of the residence time for each of the smaller boxes (m)
+    REAL(r_std)                                :: min_topoind            !! The current minimum of topographic index (m)
+    INTEGER(i_std)                             :: nb_basin               !! Number of sub-basins (unitless)
+    INTEGER(i_std), DIMENSION(nbvmax)          :: basin_inbxid, basin_sz !! ID of basin, number of points in the basin
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax,2) :: basin_pts              !! Points in each basin
+    INTEGER(i_std), DIMENSION(nbvmax)          :: basin_bxout            !! outflow direction
+    INTEGER(i_std)                             :: coast_pts(nbvmax)      !! The coastal flow points (unitless)
+    ! global maps
+    INTEGER(i_std)                             :: nwbas                  !!
+    INTEGER(i_std), DIMENSION(nbpt)            :: basin_count            !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)      :: basin_id               !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)      :: basin_flowdir          !! Water flow directions in the basin (unitless)
+    REAL(r_std), DIMENSION(nbpt,nwbas)         :: basin_area             !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)         :: basin_hierarchy        !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)         :: basin_topoind          !! Topographic index of the residence time for a basin (m)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)      :: outflow_grid           !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt)            :: nbcoastal              !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)      :: coastal_basin          !!
+    !
+    INTEGER(i_std)                             :: ij, iz                 !! Indices (unitless)
+    CHARACTER(LEN=4)                           :: hierar_method = 'OUTP' !!
+
+!_ ================================================================================================================================
+    !
+    !
+    DO ij=1, nb_basin
+       !
+       ! Count the basins and keep their ID
+       !
+       basin_count(ib) = basin_count(ib)+1
+       if (basin_count(ib) > nwbas) then 
+          WRITE(numout,*) 'ib=',ib
+          call ipslerr_p(3,'routing_globalize', &
+               &      'Problem with basin_count : ', & 
+               &      'It is greater than number of allocated basin nwbas.', &
+               &      '(stop to count basins)')
+       endif 
+       basin_id(ib,basin_count(ib)) = basin_inbxid(ij)
+       !
+       ! Transfer the list of basins which flow into the ocean as coastal flow.
+       !
+       IF ( basin_id(ib,basin_count(ib)) .LT. 0) THEN
+          nbcoastal(ib) = basin_sz(ij)
+          coastal_basin(ib,1:nbcoastal(ib)) = coast_pts(1:nbcoastal(ib))
+       ENDIF
+       !
+       !
+       ! Compute the area of the basin
+       !
+       basin_area(ib,ij) = zero
+       basin_hierarchy(ib,ij) = zero
+       !
+       SELECT CASE (hierar_method)
+          !
+          CASE("MINI")
+             basin_hierarchy(ib,ij) = undef_sechiba
+          !
+       END SELECT
+       basin_topoind(ib,ij) = zero
+       !
+       DO iz=1,basin_sz(ij)
+          !
+          basin_area(ib,ij) = basin_area(ib,ij) + area_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+          basin_topoind(ib,ij) = basin_topoind(ib,ij) + topoind_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+          !
+          ! There are a number of ways to determine the hierarchy of the entire basin.
+          ! We allow for three here :
+          !     - Take the mean value
+          !     - Take the minimum value within the basin
+          !     - Take the value at the outflow point
+          ! Probably taking the value of the outflow point is the best solution.
+          !
+          SELECT CASE (hierar_method)
+             !
+             CASE("MEAN")
+                ! Mean hierarchy of the basin
+                basin_hierarchy(ib,ij) = basin_hierarchy(ib,ij) + &
+                     & hierarchy_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+             CASE("MINI")
+                ! The smallest value of the basin
+                IF ( hierarchy_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2)) .LT. basin_hierarchy(ib,ij)) THEN
+                   basin_hierarchy(ib,ij) = hierarchy_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+                ENDIF
+             CASE("OUTP")
+                ! Value at the outflow point
+                IF ( trip_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2)) .GT. 100 ) THEN
+                   basin_hierarchy(ib,ij) = hierarchy_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+                ENDIF
+             CASE DEFAULT
+                WRITE(numout,*) 'Unknown method for computing the hierarchy of the basin'
+                CALL ipslerr_p(3,'routing_globalize','Unknown method for computing the hierarchy of the basin','','')
+          END SELECT
+          !
+       ENDDO
+       !
+       basin_topoind(ib,ij) = basin_topoind(ib,ij)/REAL(basin_sz(ij),r_std)
+       !
+       SELECT CASE (hierar_method)
+          !
+          CASE("MEAN")
+             basin_hierarchy(ib,ij) = basin_hierarchy(ib,ij)/REAL(basin_sz(ij),r_std)
+          !
+       END SELECT
+       !
+       ! To make sure that it has the lowest number if this is an outflow point we reset  basin_hierarchy
+       !
+       IF (basin_bxout(ij) .LT. 0) THEN
+          basin_hierarchy(ib,ij) = min_topoind
+          basin_topoind(ib,ij) = min_topoind
+       ENDIF
+       !
+       !
+       ! Keep the outflow boxes and basin
+       !
+       basin_flowdir(ib,ij) = basin_bxout(ij)
+       IF (basin_bxout(ij) .GT. 0) THEN
+          outflow_grid(ib,ij) = neighbours(ib,basin_bxout(ij))
+       ELSE
+          outflow_grid(ib,ij) = basin_bxout(ij)
+       ENDIF
+       !
+       !
+    ENDDO
+    !
+
+    !
+  END SUBROUTINE routing_globalize
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_linkup
+!!
+!>\BRIEF         This subroutine makes the connections between the basins and ensure global coherence. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!! The convention for outflow_grid is :
+!! outflow_grid = -1 : River flow
+!! outflow_grid = -2 : Coastal flow
+!! outflow_grid = -3 : Return flow\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_linkup(nbpt, contfrac, neighbours, nwbas, basin_count, basin_area, basin_id, basin_flowdir, &
+       & basin_hierarchy, outflow_grid, outflow_basin, inflow_number, inflow_grid, inflow_basin, nbcoastal,&
+       & coastal_basin, invented_basins)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT (in)                    :: nbpt                  !! Domain size  (unitless)
+    REAL(r_std), DIMENSION(nbpt)                   :: contfrac
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), INTENT (in) :: neighbours            !!
+    REAL(r_std), INTENT(in)                        :: invented_basins       !!
+    !
+    INTEGER(i_std)                                 :: nwbas                 !!
+    INTEGER(i_std), DIMENSION(nbpt)                :: basin_count           !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: basin_id              !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: basin_flowdir         !! Water flow directions in the basin (unitless)
+    REAL(r_std), DIMENSION(nbpt,nwbas)             :: basin_area            !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)             :: basin_hierarchy       !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: outflow_grid          !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: outflow_basin         !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: inflow_number         !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nbvmax)   :: inflow_basin          !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nbvmax)   :: inflow_grid           !!
+    INTEGER(i_std), DIMENSION(nbpt)                :: nbcoastal             !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: coastal_basin         !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                                 :: sp, sb, sbl, inp, bid, outdm1, outdp1 !! Indices (unitless)
+    INTEGER(i_std)                                 :: dp1, dm1, dm1i, dp1i, bp1, bm1 !! Indices (unitless)
+    INTEGER(i_std)                                 :: dop, bop              !!
+    INTEGER(i_std)                                 :: fbas(nwbas), nbfbas   !!
+    REAL(r_std)                                    :: fbas_hierarchy(nwbas) !!
+    REAL(r_std)                                    :: angle
+    INTEGER(i_std)                                 :: ff(1)                 !!
+    !
+    ! ERRORS 
+    LOGICAL                                        :: error1, error2, error3, error4, error5 !! (true/false)
+    !
+!! PARAMETERS
+    LOGICAL, PARAMETER                             :: check = .TRUE.       !! (true/false)
+
+!_ ================================================================================================================================    
+    error1=.FALSE.
+    error2=.FALSE.
+    error3=.FALSE.
+    error4=.FALSE.
+    error5=.FALSE.
+
+    outflow_basin(:,:) = undef_int
+    inflow_number(:,:) = 0
+    !
+    DO sp=1,nbpt
+       DO sb=1,basin_count(sp)
+          !
+          inp = outflow_grid(sp,sb)
+          bid = basin_id(sp,sb)
+          !
+          ! We only work on this point if it does not flow into the ocean
+          ! At this point any of the outflows is designated by a negative values in
+          ! outflow_grid
+          !
+          IF ( inp .GT. 0 ) THEN
+             !
+             ! Now find the basin in the onflow point (inp)
+             !
+             nbfbas = 0
+             !
+             !
+             DO sbl=1,basin_count(inp)
+                !
+                ! Either it is a standard basin or one aggregated from ocean flow points.
+                ! If we flow into a another grid box we have to make sure that its hierarchy in the
+                ! basin is lower.
+                !
+                !
+                IF ( basin_id(inp,sbl) .GT. 0 ) THEN
+                   IF ( basin_id(inp,sbl) .EQ. bid .OR. basin_id(inp,sbl) .GT. invented_basins) THEN
+                      nbfbas =nbfbas + 1
+                      fbas(nbfbas) = sbl
+                      fbas_hierarchy(nbfbas) = basin_hierarchy(inp,sbl)
+                   ENDIF
+                ELSE
+                   IF ( COUNT(coastal_basin(inp,1:nbcoastal(inp)) .EQ. bid) .GT. 0 ) THEN
+                      nbfbas =nbfbas + 1
+                      fbas(nbfbas) = sbl
+                      fbas_hierarchy(nbfbas) = basin_hierarchy(inp,sbl)
+                   ENDIF
+                ENDIF
+                !
+             ENDDO
+             ! 
+             !  If we have more than one basin we will take the one which is lowest
+             !  in the hierarchy.
+             !
+             IF (nbfbas .GE. 1) THEN
+                ff = MINLOC(fbas_hierarchy(1:nbfbas))
+                sbl = fbas(ff(1))
+                !
+                bop = undef_int
+                IF ( basin_hierarchy(inp,sbl) .LE. basin_hierarchy(sp,sb) ) THEN
+                   IF ( basin_hierarchy(inp,sbl) .LT. 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, NbNeighb)+1
+             dp1 = neighbours(sp,dp1i)
+             dm1i = MOD(basin_flowdir(sp,sb)+7-1, NbNeighb)+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 :
+                         angle=MODULO(basin_flowdir(dp1,sbl)-basin_flowdir(sp,sb)+8,8)
+                         IF ( angle >= 4 ) angle = angle-8
+                         !
+                         IF ( ABS(angle) <= 1 ) 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 :
+                         angle=MODULO(basin_flowdir(dm1,sbl)-basin_flowdir(sp,sb)+8,8)
+                         IF ( angle >= 4 ) angle = angle-8
+                         !
+                         IF ( ABS(angle) <= 1 ) THEN
+                            bm1 = sbl
+                         ENDIF
+                      ENDIF
+                   ENDIF
+                ENDDO
+             ENDIF
+             !
+             !
+             ! First deal with the case on land.
+             !
+             ! For that we need to check if the water will be able to flow out of the grid dp1 or dm1 
+             ! and not return to our current grid. If it is the current grid
+             ! then we can not do anything with that neighbour. Thus we set the
+             ! value of outdm1 and outdp1 back to -1
+             !
+             outdp1 = undef_int
+             IF ( dp1 .GT. 0 .AND. bp1 .GT. 0 ) THEN
+                ! if the outflow is into the ocean then we put something less than undef_int in outdp1!
+                IF (basin_flowdir(dp1,bp1) .GT. 0) THEN
+                   outdp1 = neighbours(dp1,basin_flowdir(dp1,bp1))
+                   IF ( outdp1 .EQ. sp ) outdp1 = undef_int 
+                ELSE
+                   outdp1 = nbpt + 1
+                ENDIF
+             ENDIF
+             outdm1 = undef_int
+             IF ( dm1 .GT. 0 .AND. bm1 .GT. 0 ) THEN
+                IF (basin_flowdir(dm1,bm1) .GT. 0) THEN
+                   outdm1 = neighbours(dm1,basin_flowdir(dm1,bm1))
+                   IF ( outdm1 .EQ. sp )  outdm1 = undef_int
+                ELSE
+                   outdm1 = nbpt + 1
+                ENDIF
+             ENDIF
+             !
+             ! Now that we know our options we need go through them.
+             !
+             dop = undef_int
+             bop = undef_int
+             IF ( outdp1 .LT. undef_int .AND. outdm1 .LT. undef_int) THEN
+                ! 
+                ! In this case we let the current basin flow into the smaller one
+                !
+                IF ( basin_area(dp1,bp1) .LT.  basin_area(dm1,bm1) ) THEN
+                   dop = dp1
+                   bop = bp1
+                ELSE
+                   dop = dm1
+                   bop = bm1
+                ENDIF
+                !
+                !
+             ELSE IF (  outdp1 .LT. undef_int ) THEN
+                ! If only the first one is possible
+                dop = dp1
+                bop = bp1
+             ELSE IF ( outdm1 .LT. undef_int ) THEN
+                ! If only the second one is possible
+                dop = dm1
+                bop = bm1
+             ELSE
+                !
+                ! Now we are at the point where none of the neighboring points is suitable 
+                ! or we have a coastal point.
+                !
+                ! If there is an option to put the water into the ocean go for it.
+                !
+                IF ( outflow_grid(sp,sb) .LT. 0 .OR. dm1 .LT. 0 .OR. dp1 .LT. 0 ) THEN
+                   dop = -1
+                ELSE
+                   !
+                   ! If we are on a land point with only land neighbors but no one suitable to let the 
+                   ! water flow into we have to look for a solution in the current grid box.
+                   ! 
+                   !
+                   IF ( bp1 .LT. 0 .AND. bm1 .LT. 0 ) THEN
+                      !
+                      ! Do we have more than one basin with the same ID ?
+                      !
+                      IF ( COUNT(basin_id(sp,1:basin_count(sp)) .EQ. bid) .GE. 2) THEN
+                         !
+                         ! Now we can try the option of flowing into the basin of the same grid box.
+                         !
+                         DO sbl=1,basin_count(sp)
+                            IF (sbl .NE. sb .AND. basin_id(sp,sbl) .EQ. bid) THEN
+                               ! In case this basin has a lower hierarchy or flows into a totaly
+                               ! different direction we go for it.
+                               IF ( (basin_hierarchy(sp,sb) .GE. basin_hierarchy(sp,sbl)) .OR. &
+                                    & (basin_flowdir(sp,sbl) .LT. dm1i .AND.&
+                                    & basin_flowdir(sp,sbl) .GT. dp1i) ) THEN
+                                  dop = sp
+                                  bop = sbl
+                                  IF (check) THEN
+                                     IF (basin_hierarchy(sp,sb) .LT. basin_hierarchy(sp,sbl)) THEN
+                                        WRITE(numout,*) '>>>>>>> POINT CORRECTED against hierarchy :',&
+                                             & sp, sb, 'into', sbl
+                                     ENDIF
+                                  ENDIF
+                               ENDIF
+                               !
+                            ENDIF
+                         ENDDO
+                         !
+                      ENDIF
+                   ENDIF
+                ENDIF
+                !
+                IF ( dop .EQ. undef_int .AND. bop .EQ. undef_int ) THEN
+                   IF (check) THEN
+                      WRITE(numout,*) 'Why are we here with point ', sp, sb
+                      WRITE(numout,*) 'Coordinates : (lon,lat) = ', lalo_g(sp,2), lalo_g(sp,1)
+                      WRITE(numout,*) 'neighbours :', neighbours_g(sp,:)
+                      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_g(inp,2), lalo_g(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,*) '****************************'
+                      CALL FLUSH(numout)
+                   ENDIF
+                   IF ( contfrac(sp) > 0.01 ) THEN
+                      error2=.TRUE.
+                      EXIT
+                   ENDIF
+                ENDIF
+                !
+             ENDIF
+             !
+             ! Now that we know where we want the water to flow to we write the
+             ! the information in the right fields.
+             !
+             IF ( dop .GT. 0 .AND. dop .NE. undef_int ) THEN
+                outflow_grid(sp,sb) = dop
+                outflow_basin(sp,sb) = bop
+                inflow_number(dop,bop) =  inflow_number(dop,bop) + 1
+                IF ( inflow_number(dop,bop) .LE. nbvmax ) THEN
+                   inflow_grid(dop, bop, inflow_number(dop,bop)) = sp
+                   inflow_basin(dop, bop, inflow_number(dop,bop)) = sb
+                ELSE
+                   error3=.TRUE.
+                   EXIT
+                ENDIF
+                !
+             ELSE
+                outflow_grid(sp,sb) = -2
+                outflow_basin(sp,sb) = undef_int
+             ENDIF
+             !
+          ENDIF
+          !
+          !
+          ! If we still have not found anything then we have to check that there is not a basin
+          ! within the same grid box which has a lower hierarchy.
+          !
+          !
+          IF ( outflow_grid(sp,sb) .GT. 0 .AND. outflow_basin(sp,sb) .EQ. undef_int &
+               & .AND. basin_flowdir(sp,sb) .GT. 0) THEN
+             !
+             
+             IF (check) &
+                  WRITE(numout,*) 'There is no reason to here, this part of the code should be dead :', sp,sb
+             !
+             DO sbl=1,basin_count(sp)
+                !
+                ! Three conditions are needed to let the water flow into another basin of the
+                ! same grid :
+                ! - another basin than the current one
+                ! - same ID
+                ! - of lower hierarchy.
+                !
+                IF ( (sbl .NE. sb) .AND. (basin_id(sp,sbl) .EQ. bid)&
+                     & .AND. (basin_hierarchy(sp,sb) .GT. basin_hierarchy(sp,sbl)) ) THEN
+                   outflow_basin(sp,sb) = sbl
+                   inflow_number(sp,sbl) =  inflow_number(sp,sbl) + 1
+                   IF ( inflow_number(sp,sbl) .LE. nbvmax ) THEN
+                      IF ( sp .EQ. 42 .AND. sbl .EQ. 1) THEN
+                         IF (check) &
+                              WRITE(numout,*) 'ADD INFLOW (3):', sp, sb
+                      ENDIF
+                      inflow_grid(sp, sbl, inflow_number(sp,sbl)) = sp
+                      inflow_basin(sp, sbl, inflow_number(sp,sbl)) = sb
+                   ELSE
+                      error4=.TRUE.
+                      EXIT
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDIF
+          !
+          ! Ok that is it, we give up :-)
+          !
+          IF ( outflow_grid(sp,sb) .GT. 0 .AND. outflow_basin(sp,sb) .EQ. undef_int &
+               & .AND. basin_flowdir(sp,sb) .GT. 0) THEN
+             !
+             error5=.TRUE.
+             EXIT
+          ENDIF
+       ENDDO
+       !
+    ENDDO
+    IF (error1) THEN
+       WRITE(numout,*) " routing_linkup : bop .LT. undef_int",bop
+       CALL ipslerr_p(3,'routing_linkup', &
+            "bop .LT. undef_int",'Increase nbvmax','stop routing_linkup')
+    ENDIF
+    IF (error2) THEN
+       CALL ipslerr_p(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_p(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_p(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_p(3,'routing_linkup', &
+            "We could not find the basin into which we need to flow",'Try with check=.TRUE.','stop routing_linkup')
+    ENDIF
+    !
+    ! Check for each outflow basin that it exists
+    !
+    DO sp=1,nbpt
+       DO sb=1,basin_count(sp)
+          !
+          inp = outflow_grid(sp,sb)
+          sbl = outflow_basin(sp,sb)
+          IF ( inp .GE. 0 ) THEN
+             IF ( basin_count(inp) .LT. sbl ) THEN
+                WRITE(numout,*) 'point :', sp, ' basin :', sb
+                WRITE(numout,*) 'Flows into point :', inp, ' basin :', sbl
+                WRITE(numout,*) 'But it flows into now here as basin count = ', basin_count(inp)
+                CALL ipslerr_p(3,'routing_linkup','Problem with outflow','','')
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE routing_linkup
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_fetch
+!!
+!>\BRIEF        This subroutine computes the fetch of each basin. This means that for each basin we
+!!               will know how much area is upstream. It will help decide how to procede with the
+!!               the truncation later and allow to set correctly in outflow_grid the distinction
+!!               between coastal and river flow. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_fetch(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_id,&
+       & outflow_grid, outflow_basin, fetch_basin)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                           :: nbpt          !! Domain size  (unitless)
+    !
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in)           :: resolution    !! The size of each grid box in X and Y (m)
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)             :: contfrac      !! Fraction of land in each grid box (unitless;0-1)
+    !
+    INTEGER(i_std)                                       :: nwbas         !!
+    INTEGER(i_std), DIMENSION(nbpt), INTENT(in)          :: basin_count   !!
+    REAL(r_std), DIMENSION(nbpt,nwbas), INTENT(inout)    :: basin_area    !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas), INTENT(in)    :: basin_id      !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas), INTENT(inout) :: outflow_grid  !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas), INTENT(in)    :: outflow_basin !!
+!
+!! OUTPUT VARIABLES
+    REAL(r_std), DIMENSION(nbpt,nwbas), INTENT(out)      :: fetch_basin   !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                                        :: ib, ij, ff(1), it, itt, igrif, ibasf, nboutflow !! Indices (unitless)
+    REAL(r_std)                                           :: contarea     !!
+    REAL(r_std)                                           :: totbasins    !!
+    REAL(r_std), DIMENSION(nbpt*nbvmax)                   :: tmp_area     !!
+    INTEGER(i_std), DIMENSION(nbpt*nbvmax,2)              :: tmpindex     !!
+
+!_ ================================================================================================================================
+    !
+    !
+    ! Normalize the area of all basins
+    !
+    DO ib=1,nbpt
+       !
+       totbasins = SUM(basin_area(ib,1:basin_count(ib)))
+       contarea = resolution(ib,1)*resolution(ib,2)*contfrac(ib)
+       !
+       DO ij=1,basin_count(ib)
+          basin_area(ib,ij) = basin_area(ib,ij)/totbasins*contarea
+       ENDDO
+       !
+    ENDDO
+    WRITE(numout,*) 'Normalization done'
+    !
+    ! Compute the area upstream of each basin
+    !
+    fetch_basin(:,:) = zero
+    !
+    !
+    DO ib=1,nbpt
+       !
+       DO ij=1,basin_count(ib)
+          !
+          fetch_basin(ib, ij) = fetch_basin(ib, ij) + basin_area(ib,ij)
+          !
+          igrif = outflow_grid(ib,ij)
+          ibasf = outflow_basin(ib,ij)
+          !
+          itt = 0
+          DO WHILE (igrif .GT. 0)
+             fetch_basin(igrif,ibasf) =  fetch_basin(igrif,ibasf) + basin_area(ib, ij)
+             it = outflow_grid(igrif, ibasf)
+             ibasf = outflow_basin(igrif, ibasf)
+             igrif = it
+             itt = itt + 1
+             IF ( itt .GT. 500) THEN
+                WRITE(numout,&
+                     "('Grid ',I5, ' and basin ',I5, 'did not converge after iteration ',I5)") ib, ij, itt
+                WRITE(numout,*) 'Basin ID :', basin_id(igrif,ibasf)
+                WRITE(numout,&
+                     "('We are stuck with the flow into grid ',I5,' and basin ',I5)") igrif, ibasf
+                WRITE(numout,*) "Coordinates : ", lalo_g(igrif,2), lalo_g(igrif,1)
+                IF ( itt .GT. 510) THEN
+                   CALL ipslerr_p(3,'routing_fetch','Problem...','','')
+                ENDIF
+             ENDIF
+          ENDDO
+          !
+       ENDDO
+       !
+    ENDDO
+    !
+    WRITE(numout,*) 'The smallest FETCH :', MINVAL(fetch_basin)
+    WRITE(numout,*) 'The largest FETCH :', MAXVAL(fetch_basin)
+    !
+    ! Now we set for the 'num_largest' largest basins the outflow condition as stream flow 
+    ! (i.e. outflow_grid = -1) and all other outflow basins are set to coastal flow 
+    ! (i.e. outflow_grid = -2). The return flow is not touched.
+    !
+    nboutflow = 0
+    !
+    DO ib=1,nbpt
+       !
+       DO ij=1,basin_count(ib)
+          !
+          ! We do not need any more the river flow flag as we are going to reset it.
+          !
+          IF ( outflow_grid(ib,ij) .EQ. -1) THEN
+             outflow_grid(ib,ij) = -2
+          ENDIF
+          !
+          IF ( outflow_grid(ib,ij) .EQ. -2) THEN
+             !
+             nboutflow = nboutflow + 1
+             tmp_area(nboutflow) = fetch_basin(ib,ij)
+             tmpindex(nboutflow,1) = ib
+             tmpindex(nboutflow,2) = ij
+             !
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    DO ib=1, num_largest
+       ff = MAXLOC(tmp_area(1:nboutflow))
+       outflow_grid(tmpindex(ff(1),1), tmpindex(ff(1),2)) = -1
+       tmp_area(ff(1)) = zero
+    ENDDO
+    !
+  END SUBROUTINE routing_fetch
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_truncate
+!!
+!>\BRIEF         This subroutine reduces the number of basins per grid to the value chosen by the user.
+!!               It also computes the final field which will be used to route the water at the
+!!               requested truncation.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : 
+!! Truncate if needed and find the path closest to the high resolution data.
+!!
+!! The algorithm :
+!! 
+!! We only go through this procedure only as many times as there are basins to take out at most.
+!! This is important as it allows the simplifications to spread from one grid to the other.
+!! The for each step of the iteration and at each grid point we check the following options for 
+!! simplifying the pathways of water :
+!! 1) If the basin of a grid flows into another basin of the same grid. Kill the one which only
+!!    served as a transition
+!! 2) If in one grid box we have a number of basins which flow into the ocean as coastal flow. 
+!!    We kill the smallest one and put into the largest basin. There is no need to manage many 
+!!    basins going into the ocean as coastal flows. 
+!! 3) If we have streams run in parallel from one gird box to the others (that is these are 
+!!    different basins) we will put the smaller one in the larger one. This may hapen at any
+!!    level of the flow but in theory it should propagate downstream.
+!! 4) If we have two basins with the same ID but flow into different grid boxes we sacrifice
+!!    the smallest one and route it through the largest. 
+!!
+!! Obviously if any of the options find something then we skip the rest and take out the basin.:\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_truncate(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_topoind,&
+       & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+       & inflow_grid, inflow_basin)
+    !
+    IMPLICIT NONE
+    !
+!! PARAMETERS
+    INTEGER(i_std), PARAMETER                       :: pickmax = 200  !!
+
+!! INPUT VARIABLES
+    INTEGER(i_std)                                  :: nbpt           !! Domain size  (unitless)
+    !
+    REAL(r_std), DIMENSION(nbpt,2)                  :: resolution     !! The size of each grid box in X and Y (m)
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)        :: contfrac       !! Fraction of land in each grid box (unitless;0-1)
+    !
+    INTEGER(i_std)                                  :: nwbas          !!
+    INTEGER(i_std), DIMENSION(nbpt)                 :: basin_count    !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: basin_id       !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: basin_flowdir  !! Water flow directions in the basin (unitless)
+    REAL(r_std), DIMENSION(nbpt,nwbas)              :: basin_area     !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)              :: basin_topoind  !! Topographic index of the residence time for a basin (m)
+    REAL(r_std), DIMENSION(nbpt,nwbas)              :: fetch_basin    !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: outflow_grid   !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: outflow_basin  !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: inflow_number  !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nwbas)     :: inflow_basin   !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nwbas)     :: inflow_grid    !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                                  :: ib, ij, ibf, ijf, igrif, ibasf, cnt, pold, bold, ff(2) !! Indices (unitless)
+    INTEGER(i_std)                                  :: ii, kbas, sbas, ik, iter, ibt, obj !! Indices (unitless)
+    REAL(r_std), DIMENSION(nbpt,nbasmax)            :: floflo         !!
+    REAL(r_std), DIMENSION(nbpt)                    :: gridarea       !!
+    REAL(r_std), DIMENSION(nbpt)                    :: gridbasinarea  !!
+    REAL(r_std)                                     :: ratio          !!
+    INTEGER(i_std), DIMENSION(pickmax,2)            :: largest_basins !!
+    INTEGER(i_std), DIMENSION(pickmax)              :: tmp_ids        !!
+    INTEGER(i_std)                                  :: multbas        !!
+    INTEGER(i_std)                                  :: iml(1)         !! X resolution of the high resolution grid
+    INTEGER(i_std), DIMENSION(pickmax)              :: multbas_sz     !!
+    REAL(r_std), DIMENSION(pickmax)                 :: tmp_area       !!
+    INTEGER(i_std), DIMENSION(pickmax,pickmax)      :: multbas_list   !!
+    !
+    INTEGER(i_std)                                  :: nbtruncate     !!
+    INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:) :: indextrunc     !!
+!$OMP THREADPRIVATE(indextrunc)
+
+!_ ================================================================================================================================
+    !
+    !
+    IF ( .NOT. ALLOCATED(indextrunc)) THEN
+       ALLOCATE(indextrunc(nbpt))
+    ENDIF
+    !
+    ! We have to go through the grid as least as often as we have to reduce the number of basins
+    ! For good measure we add 3 more passages.
+    !
+    !
+    DO iter = 1, MAXVAL(basin_count) - nbasmax +3
+       !
+       ! Get the points over which we wish to truncate
+       !
+       nbtruncate = 0
+       DO ib = 1, nbpt
+          IF ( basin_count(ib) .GT. nbasmax ) THEN
+             nbtruncate = nbtruncate + 1
+             indextrunc(nbtruncate) = ib
+          ENDIF
+       ENDDO
+       !
+       ! Go through the basins which need to be truncated.       
+       !
+       DO ibt=1,nbtruncate
+          !
+          ib = indextrunc(ibt)
+          !
+          ! Check if we have basin which flows into a basin in the same grid
+          ! kbas = basin we will have to kill
+          ! sbas = basin which takes over kbas
+          !
+          kbas = 0
+          sbas = 0
+          !
+          ! 1) Can we find a basin which flows into a basin of the same grid ?
+          !
+          DO ij=1,basin_count(ib)
+             DO ii=1,basin_count(ib)
+                IF ( outflow_grid(ib,ii) .EQ. ib .AND. outflow_basin(ib, ii) .EQ. ij .AND. kbas*sbas .NE. 0) THEN
+                   kbas = ii
+                   sbas = ij
+                ENDIF
+             ENDDO
+          ENDDO
+          !
+          ! 2) Merge two basins which flow into the ocean as coastal or return flow 
+          ! (outflow_grid = -2 or -3). Well obviously only if we have more than 1 and 
+          ! have not found anything yet!
+          !
+          IF ( (COUNT(outflow_grid(ib,1:basin_count(ib)) .EQ. -2) .GT. 1 .OR.&
+               & COUNT(outflow_grid(ib,1:basin_count(ib)) .EQ. -3) .GT. 1) .AND.&
+               & kbas*sbas .EQ. 0) THEN
+             !
+             multbas = 0
+             multbas_sz(:) = 0
+             !
+             IF ( COUNT(outflow_grid(ib,1:basin_count(ib)) .EQ. -2) .GT. 1 ) THEN
+                obj = -2
+             ELSE
+                obj = -3
+             ENDIF
+             !
+             ! First we get the list of all basins which go out as coastal or return flow (obj)
+             !
+             DO ij=1,basin_count(ib)
+                IF ( outflow_grid(ib,ij) .EQ. obj ) THEN
+                   multbas = multbas + 1
+                   multbas_sz(multbas) = ij
+                   tmp_area(multbas) = fetch_basin(ib,ij)
+                ENDIF
+             ENDDO
+             !
+             ! Now the take the smallest to be transfered to the largest
+             !
+             iml = MAXLOC(tmp_area(1:multbas), MASK = tmp_area(1:multbas) .GT. zero)
+             sbas = multbas_sz(iml(1))
+             iml = MINLOC(tmp_area(1:multbas), MASK = tmp_area(1:multbas) .GT. zero)
+             kbas = multbas_sz(iml(1))
+             !
+          ENDIF
+          !
+          !   3) If we have basins flowing into the same grid but different basins then we put them 
+          !   together. Obviously we first work with the grid which has most streams running into it
+          !   and putting the smallest in the largests catchments.
+          !
+          IF ( kbas*sbas .EQ. 0) THEN
+             !
+             tmp_ids(1:basin_count(ib)) = outflow_grid(ib,1:basin_count(ib))
+             multbas = 0
+             multbas_sz(:) = 0
+             !
+             ! First obtain the list of basins which flow into the same basin
+             !
+             DO ij=1,basin_count(ib)
+                IF ( outflow_grid(ib,ij) .GT. 0 .AND.&
+                     & COUNT(tmp_ids(1:basin_count(ib)) .EQ. outflow_grid(ib,ij)) .GT. 1) THEN
+                   multbas = multbas + 1
+                   DO ii=1,basin_count(ib)
+                      IF ( tmp_ids(ii) .EQ. outflow_grid(ib,ij)) THEN
+                         multbas_sz(multbas) = multbas_sz(multbas) + 1
+                         multbas_list(multbas,multbas_sz(multbas)) = ii
+                         tmp_ids(ii) = -99
+                      ENDIF
+                   ENDDO
+                ELSE
+                   tmp_ids(ij) = -99
+                ENDIF
+             ENDDO
+             !
+             ! Did we come up with any basins to deal with this way ?
+             !
+             IF ( multbas .GT. 0 ) THEN
+                !
+                iml = MAXLOC(multbas_sz(1:multbas))
+                ik = iml(1)
+                !
+                ! Take the smallest and largest of these basins !
+                !
+                DO ii=1,multbas_sz(ik)
+                   tmp_area(ii) = fetch_basin(ib, multbas_list(ik,ii))
+                ENDDO
+                !
+                iml = MAXLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                sbas = multbas_list(ik,iml(1))
+                iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                kbas = multbas_list(ik,iml(1))
+                !
+             ENDIF
+             !
+          ENDIF
+          !
+          !   4) If we have twice the same basin we put them together even if they flow into different
+          !   directions. If one of them goes to the ocean it takes the advantage.
+          !
+          IF ( kbas*sbas .EQ. 0) THEN
+             !
+             tmp_ids(1:basin_count(ib)) = basin_id(ib,1:basin_count(ib))
+             multbas = 0
+             multbas_sz(:) = 0
+             !
+             ! First obtain the list of basins which have sub-basins in this grid box.
+             ! (these are identified by their IDs)
+             !
+             DO ij=1,basin_count(ib)
+                IF ( COUNT(tmp_ids(1:basin_count(ib)) .EQ. basin_id(ib,ij)) .GT. 1) THEN
+                   multbas = multbas + 1
+                   DO ii=1,basin_count(ib)
+                      IF ( tmp_ids(ii) .EQ. basin_id(ib,ij)) THEN
+                         multbas_sz(multbas) = multbas_sz(multbas) + 1
+                         multbas_list(multbas,multbas_sz(multbas)) = ii
+                         tmp_ids(ii) = -99
+                      ENDIF
+                   ENDDO
+                ELSE
+                   tmp_ids(ij) = -99
+                ENDIF
+             ENDDO
+             !
+             ! We are going to work on the basin with the largest number of sub-basins.
+             ! (IF we have a basin which has subbasins !)
+             !
+             IF ( multbas .GT. 0 ) THEN
+                !
+                iml = MAXLOC(multbas_sz(1:multbas))
+                ik = iml(1)
+                !
+                ! If one of the basins goes to the ocean then it is going to have the priority
+                !
+                tmp_area(:) = zero
+                IF ( COUNT(outflow_grid(ib,multbas_list(ik,1:multbas_sz(ik))) .LT. 0) .GT. 0) THEN
+                   DO ii=1,multbas_sz(ik)
+                      IF ( outflow_grid(ib,multbas_list(ik,ii)) .LT. 0 .AND. sbas .EQ. 0 ) THEN
+                         sbas = multbas_list(ik,ii)
+                      ELSE
+                         tmp_area(ii) = fetch_basin(ib, multbas_list(ik,ii))
+                      ENDIF
+                   ENDDO
+                   ! take the smallest of the subbasins
+                   iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                   kbas = multbas_list(ik,iml(1))
+                ELSE
+                   !
+                   ! Else we take simply the largest and smallest
+                   !
+                   DO ii=1,multbas_sz(ik)
+                      tmp_area(ii) = fetch_basin(ib, multbas_list(ik,ii))
+                   ENDDO
+                   iml = MAXLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                   sbas = multbas_list(ik,iml(1))
+                   iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                   kbas = multbas_list(ik,iml(1))
+                   !
+                ENDIF
+                !
+                !
+             ENDIF
+          ENDIF
+          !
+          !
+          !
+          ! Then we call routing_killbas to clean up the basins in this grid
+          !
+          IF ( kbas .GT. 0 .AND. sbas .GT. 0 ) THEN
+             CALL routing_killbas(nbpt, ib, kbas, sbas, nwbas, basin_count, basin_area, basin_topoind,&
+                  & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+                  & inflow_grid, inflow_basin)
+          ENDIF
+          !
+       ENDDO
+       !
+       !      
+    ENDDO
+    !
+    ! If there are any grids left with too many basins we need to take out the big hammer !
+    ! We will only do it if this represents less than 5% of all points.
+    !
+    IF ( COUNT(basin_count .GT. nbasmax) .GT. 0 ) THEN
+       !
+       !
+       IF ( COUNT(basin_count .GT. nbasmax)/nbpt*100 .GT. 5 ) THEN
+          WRITE(numout,*) 'We have ', COUNT(basin_count .GT. nbasmax)/nbpt*100, '% of all points which do not yet'
+          WRITE(numout,*) 'have the right trunctaction. That is too much to apply a brutal method'
+          DO ib = 1, nbpt
+             IF ( basin_count(ib) .GT. nbasmax ) THEN
+                !
+                WRITE(numout,*) 'We did not find a basin which could be supressed. We will'
+                WRITE(numout,*) 'not be able to reduce the truncation in grid ', ib
+                DO ij=1,basin_count(ib)
+                   WRITE(numout,*) 'grid, basin nb and id :', ib, ij, basin_id(ib,ij)
+                   WRITE(numout,*) 'Outflow grid and basin ->', outflow_grid(ib,ij), outflow_basin(ib, ij)
+                ENDDO
+             ENDIF
+          ENDDO
+          CALL ipslerr_p(3,'routing_truncate','No basin found which could be supressed.','','')
+       ELSE
+          !
+          !
+          DO ib = 1,nbpt
+             DO WHILE ( basin_count(ib) .GT. nbasmax )
+                !
+                WRITE(numout,*) 'HAMMER, ib, basin_count :', ib, basin_count(ib)
+                !
+                ! Here we simply put the smallest basins into the largest ones. It is really a brute force
+                ! method but it will only be applied if everything has failed.
+                !
+                DO ii = 1,basin_count(ib)
+                   tmp_area(ii) = fetch_basin(ib, ii)
+                ENDDO
+                !
+                iml = MAXLOC(tmp_area(1:basin_count(ib)), MASK = tmp_area(1:basin_count(ib)) .GT. 0.)
+                sbas =iml(1)
+                iml = MINLOC(tmp_area(1:basin_count(ib)), MASK = tmp_area(1:basin_count(ib)) .GT. 0.)
+                kbas = iml(1)
+                !
+                IF ( kbas .GT. 0 .AND. sbas .GT. 0 ) THEN
+                   CALL routing_killbas(nbpt, ib, kbas, sbas, nwbas, basin_count, basin_area, basin_topoind,&
+                        & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+                        & inflow_grid, inflow_basin)
+                ENDIF
+             ENDDO
+          ENDDO
+          !
+       ENDIF
+       !
+       !
+    ENDIF
+    !
+    ! Now that we have reached the right truncation (resolution) we will start
+    ! to produce the variables we will use to route the water.
+    !
+    DO ib=1,nbpt
+       !
+       ! For non existing basins the route_tobasin variable is put to zero. This will allow us
+       ! to pick up the number of basin afterwards.
+       !
+       route_togrid(ib,:) = ib
+       route_tobasin(ib,:) = 0
+       routing_area(ib,:) = zero
+       !
+    ENDDO
+    !
+    ! Transfer the info into the definitive variables
+    !
+    DO ib=1,nbpt
+       DO ij=1,basin_count(ib)
+          routing_area(ib,ij) = basin_area(ib,ij)
+          topo_resid(ib,ij) = basin_topoind(ib,ij)
+          global_basinid(ib,ij) = basin_id(ib,ij)
+          route_togrid(ib,ij) = outflow_grid(ib,ij)
+          route_tobasin(ib,ij) = outflow_basin(ib,ij)
+       ENDDO
+    ENDDO
+    !
+    !
+    ! Set the new convention for the outflow conditions
+    ! Now it is based in the outflow basin and the outflow grid will
+    ! be the same as the current.
+    ! returnflow to the grid : nbasmax + 1
+    ! coastal flow           : nbasmax + 2
+    ! river outflow          : nbasmax + 3
+    !
+    ! Here we put everything here in coastal flow. It is later where we will
+    ! put the largest basins into river outflow.
+    !
+    DO ib=1,nbpt
+       DO ij=1,basin_count(ib)
+          ! River flows
+          IF ( route_togrid(ib,ij) .EQ. -1 ) THEN
+             route_tobasin(ib,ij) = nbasmax + 2
+             route_togrid(ib,ij) = ib
+          ! Coastal flows
+          ELSE IF ( route_togrid(ib,ij) .EQ. -2 ) THEN
+             route_tobasin(ib,ij) = nbasmax + 2
+             route_togrid(ib,ij) = ib
+          ! Return flow
+          ELSE IF ( route_togrid(ib,ij) .EQ. -3 ) THEN
+             route_tobasin(ib,ij) = nbasmax + 1
+             route_togrid(ib,ij) = ib
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! A second check on the data. Just make sure that each basin flows somewhere.
+    !
+    DO ib=1,nbpt
+       DO ij=1,basin_count(ib)
+          ibf = route_togrid(ib,ij)
+          ijf = route_tobasin(ib,ij)
+          IF ( ijf .GT. basin_count(ibf) .AND.  ijf .LE. nbasmax) THEN
+             WRITE(numout,*) 'Second check'
+             WRITE(numout,*) 'point :', ib, ' basin :', ij
+             WRITE(numout,*) 'Flows into point :', ibf, ' basin :', ijf
+             WRITE(numout,*) 'But it flows into now here as basin count = ', basin_count(ibf)
+             CALL ipslerr_p(3,'routing_truncate','Problem with routing..','','')
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Verify areas of the continents
+    !
+    floflo(:,:) = zero
+    gridarea(:) = contfrac(:)*resolution(:,1)*resolution(:,2)
+    DO ib=1,nbpt
+       gridbasinarea(ib) = SUM(routing_area(ib,:))
+    ENDDO
+    !
+    DO ib=1,nbpt
+       DO ij=1,basin_count(ib)
+          cnt = 0
+          igrif = ib
+          ibasf = ij
+          DO WHILE (ibasf .LE. nbasmax .AND. cnt .LT. nbasmax*nbpt)
+             cnt = cnt + 1
+             pold = igrif
+             bold = ibasf
+             igrif = route_togrid(pold, bold)
+             ibasf = route_tobasin(pold, bold)
+             IF ( ibasf .GT. basin_count(igrif)  .AND.  ibasf .LE. nbasmax) THEN
+                WRITE(numout,*) 'We should not be here as the basin flows into the pampa'
+                WRITE(numout,*) 'Last correct point :', pold, bold
+                WRITE(numout,*) 'It pointed to in the new variables :', route_togrid(pold, bold),route_tobasin(pold, bold) 
+                WRITE(numout,*) 'The old variables gave :', outflow_grid(pold, bold), outflow_basin(pold, bold) 
+                WRITE(numout,*) 'Where we ended up :', igrif,ibasf
+                CALL ipslerr_p(3,'routing_truncate','Problem with routing..','','')
+             ENDIF
+          ENDDO
+          !
+          IF ( ibasf .GT. nbasmax ) THEN
+             floflo(igrif,bold) = floflo(igrif,bold) + routing_area(ib,ij)
+          ELSE
+             WRITE(numout,*) 'The flow did not end up in the ocean or in the grid cell.'
+             WRITE(numout,*) 'For grid ', ib, ' and basin ', ij
+             WRITE(numout,*) 'The last grid was ', igrif, ' and basin ', ibasf
+             CALL ipslerr_p(3,'routing_truncate','Problem with routing..','','')
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    DO ib=1,nbpt
+       IF ( gridbasinarea(ib) > zero ) THEN
+          ratio = gridarea(ib)/gridbasinarea(ib)
+          routing_area(ib,:) = routing_area(ib,:)*ratio
+       ELSE
+          WRITE(numout,*) 'gridbasinarea(ib) <= zero. We should stop here :', ib
+       ENDIF
+    ENDDO
+    !
+    WRITE(numout,*) 'Sum of area of all outflow areas :',SUM(routing_area)
+    WRITE(numout,*) 'Surface of all continents :', SUM(gridarea)
+    !
+    ! Redo the the distinction between river outflow and coastal flow. We can not
+    ! take into account the return flow points.
+    !
+    ibf = 0
+    DO ib=1, pickmax
+       ff = MAXLOC(floflo)
+       ! tdo - To take into account rivers that do not flow to the oceans 
+       IF ( route_tobasin(ff(1), ff(2)) .GT. nbasmax ) THEN
+!       IF ( route_tobasin(ff(1), ff(2)) .EQ. nbasmax + 2) THEN
+          ibf = ibf + 1
+          largest_basins(ibf,:) = ff(:)
+       ENDIF
+       floflo(ff(1), ff(2)) = zero
+    ENDDO
+    !
+    ! Put the largest basins into river flows.
+    !
+    IF ( ibf .LT.  num_largest) THEN
+       WRITE(numout,*) 'Not enough basins to choose the ',  num_largest, 'largest'
+       CALL ipslerr_p(3,'routing_truncate','Not enough basins','','')
+    ENDIF
+    !
+    !
+    !
+    DO ib=1, num_largest
+       route_tobasin(largest_basins(ib,1),largest_basins(ib,2)) = nbasmax + 3
+    ENDDO
+    !
+    WRITE(numout,*) 'NUMBER OF RIVERS :', COUNT(route_tobasin .GE. nbasmax + 3)
+    !
+  END SUBROUTINE  routing_truncate
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_killbas
+!!
+!>\BRIEF        The aim of this subroutine is to kill a basin (that is put into another larger one).
+!!              When we do this we need to be careful and change all associated variables.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_killbas(nbpt, ib, tokill, totakeover, nwbas, basin_count, basin_area, basin_topoind,&
+       & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+       & inflow_grid, inflow_basin)
+    !
+    !
+    IMPLICIT NONE
+    !
+    INTEGER(i_std)                              :: tokill        !!
+    INTEGER(i_std)                              :: totakeover    !!
+    INTEGER(i_std)                              :: nbpt          !! Domain size  (unitless)
+    INTEGER(i_std)                              :: ib            !! Current basin (unitless)
+    !
+    INTEGER(i_std)                              :: nwbas         !!
+    INTEGER(i_std), DIMENSION(nbpt)             :: basin_count   !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: basin_id      !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: basin_flowdir !! Water flow directions in the basin (unitless)
+    REAL(r_std), DIMENSION(nbpt,nwbas)          :: basin_area    !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)          :: basin_topoind !! Topographic index of the residence time for a basin (m)
+    REAL(r_std), DIMENSION(nbpt,nwbas)          :: fetch_basin   !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: outflow_grid  !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: outflow_basin !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: inflow_number !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nwbas) :: inflow_basin  !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nwbas) :: inflow_grid   !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                              :: inf, ibs, ing, inb, ibasf, igrif, it !! Indices (unitless)
+    LOGICAL                                     :: doshift       !! (true/false)
+
+!_ ================================================================================================================================
+    !
+    ! Update the information needed in the basin "totakeover"
+    ! For the moment only area
+    !
+    WRITE(numout,*) 'KILL BASIN :', ib, tokill, totakeover, basin_id(ib,tokill), basin_id(ib,totakeover)
+    !
+    !
+    basin_area(ib, totakeover) = basin_area(ib, totakeover) +  basin_area(ib, tokill)
+    basin_topoind(ib, totakeover) = (basin_topoind(ib, totakeover) + basin_topoind(ib, tokill))/2.0
+    !
+    ! Add the fetch of the basin will kill to the one which gets the water
+    !
+    fetch_basin(ib, totakeover) = fetch_basin(ib, totakeover) + fetch_basin(ib, tokill)
+    igrif = outflow_grid(ib,totakeover)
+    ibasf = outflow_basin(ib,totakeover)
+    !
+    inf = 0
+    DO WHILE (igrif .GT. 0)
+       fetch_basin(igrif,ibasf) =  fetch_basin(igrif,ibasf) + fetch_basin(ib, tokill) 
+       it = outflow_grid(igrif, ibasf)
+       ibasf = outflow_basin(igrif, ibasf)
+       igrif = it
+       inf = inf + 1
+    ENDDO
+    !
+    ! Take out the basin we have just rerouted from the fetch of the basins in which it used to flow.
+    !
+    igrif = outflow_grid(ib,tokill)
+    ibasf = outflow_basin(ib,tokill)
+    !
+    DO WHILE (igrif .GT. 0)
+       fetch_basin(igrif,ibasf) =  fetch_basin(igrif,ibasf) - fetch_basin(ib, tokill)
+       it = outflow_grid(igrif, ibasf)
+       ibasf = outflow_basin(igrif, ibasf)
+       igrif = it
+    ENDDO   
+    !
+    !  Redirect the flows which went into the basin to be killed before we change everything
+    !
+    DO inf = 1, inflow_number(ib, tokill)
+       outflow_basin(inflow_grid(ib, tokill, inf), inflow_basin(ib, tokill, inf)) = totakeover
+       inflow_number(ib, totakeover) = inflow_number(ib, totakeover) + 1
+       inflow_grid(ib, totakeover,  inflow_number(ib, totakeover)) = inflow_grid(ib, tokill, inf)
+       inflow_basin(ib, totakeover,  inflow_number(ib, totakeover)) = inflow_basin(ib, tokill, inf)
+    ENDDO
+    !
+    ! Take out the basin to be killed from the list of inflow basins of the downstream basin
+    ! (In case the basin does not flow into an ocean or lake)
+    !
+    IF ( outflow_grid(ib,tokill) .GT. 0) THEN
+       !
+       ing = outflow_grid(ib, tokill)
+       inb = outflow_basin(ib, tokill)
+       doshift = .FALSE.
+       !
+       DO inf = 1, inflow_number(ing, inb)
+          IF ( doshift ) THEN
+             inflow_grid(ing, inb, inf-1) = inflow_grid(ing, inb, inf)
+             inflow_basin(ing, inb, inf-1) = inflow_basin(ing, inb, inf)
+          ENDIF
+          IF ( inflow_grid(ing, inb, inf) .EQ. ib .AND. inflow_basin(ing, inb, inf) .EQ. tokill) THEN
+             doshift = .TRUE.
+          ENDIF
+       ENDDO
+       !
+       ! This is only to allow for the last check
+       !
+       inf = inflow_number(ing, inb)
+       IF ( inflow_grid(ing, inb, inf) .EQ. ib .AND. inflow_basin(ing, inb, inf) .EQ. tokill) THEN
+          doshift = .TRUE.
+       ENDIF
+       !
+       IF ( .NOT. doshift ) THEN
+          WRITE(numout,*) 'Strange we did not find the basin to kill in the downstream basin'
+          CALL ipslerr_p(3,'routing_killbas','Basin not found','','')
+       ENDIF
+       inflow_number(ing, inb) = inflow_number(ing, inb) - 1
+       
+    ENDIF
+    !
+    ! Now remove from the arrays the information of basin "tokill"
+    !
+    basin_id(ib, tokill:basin_count(ib)-1) = basin_id(ib, tokill+1:basin_count(ib))
+    basin_flowdir(ib, tokill:basin_count(ib)-1) = basin_flowdir(ib, tokill+1:basin_count(ib))
+    basin_area(ib, tokill:basin_count(ib)-1) = basin_area(ib, tokill+1:basin_count(ib))
+    basin_area(ib, basin_count(ib):nwbas) = zero
+    basin_topoind(ib, tokill:basin_count(ib)-1) = basin_topoind(ib, tokill+1:basin_count(ib))
+    basin_topoind(ib, basin_count(ib):nwbas) = zero
+    fetch_basin(ib, tokill:basin_count(ib)-1) = fetch_basin(ib, tokill+1:basin_count(ib))
+    fetch_basin(ib, basin_count(ib):nwbas) = zero
+    !
+    ! Before we remove the information from the outflow fields we have to correct the corresponding inflow fields
+    ! of the grids into which the flow goes
+    !
+    DO ibs = tokill+1,basin_count(ib)
+       ing = outflow_grid(ib, ibs)
+       inb = outflow_basin(ib, ibs)
+       IF ( ing .GT. 0 ) THEN
+          DO inf = 1, inflow_number(ing, inb)
+             IF ( inflow_grid(ing,inb,inf) .EQ. ib .AND. inflow_basin(ing,inb,inf) .EQ. ibs) THEN
+                inflow_basin(ing,inb,inf) = ibs - 1
+             ENDIF
+          ENDDO
+       ENDIF
+    ENDDO
+    outflow_grid(ib, tokill:basin_count(ib)-1) = outflow_grid(ib, tokill+1:basin_count(ib))
+    outflow_basin(ib, tokill:basin_count(ib)-1) = outflow_basin(ib, tokill+1:basin_count(ib))
+    !
+    ! Basins which moved down also need to redirect their incoming flows.
+    !
+    DO ibs=tokill+1, basin_count(ib)
+       DO inf = 1, inflow_number(ib, ibs)
+          outflow_basin(inflow_grid(ib, ibs, inf), inflow_basin(ib, ibs, inf)) = ibs-1
+       ENDDO
+    ENDDO
+    !
+    ! Shift the inflow basins
+    !
+    DO it = tokill+1,basin_count(ib)
+       inflow_grid(ib, it-1, 1:inflow_number(ib,it)) =  inflow_grid(ib, it, 1:inflow_number(ib,it))
+       inflow_basin(ib, it-1, 1:inflow_number(ib,it)) =  inflow_basin(ib, it, 1:inflow_number(ib,it))
+       inflow_number(ib,it-1) = inflow_number(ib,it)
+    ENDDO
+    !
+    basin_count(ib) = basin_count(ib) - 1
+    !
+  END SUBROUTINE routing_killbas 
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_names
+!!
+!>\BRIEF         This subroutine lists the name of the largest basins which are explicitly listed in the basin
+!!               description file used by ORCHIDEE.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_names(numlar, basin_names)
+    !
+    IMPLICIT NONE
+    !
+    ! Arguments
+    !
+    INTEGER(i_std), INTENT(in)             :: numlar              !!
+    CHARACTER(LEN=*), INTENT(inout)        :: basin_names(numlar) !! Name of the basins (unitless)
+!! PARAMETERS
+    INTEGER(i_std), PARAMETER              :: listleng=349        !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                         :: lenstr, i           !!
+    CHARACTER(LEN=60), DIMENSION(listleng) :: list_names          !!
+    CHARACTER(LEN=60)                      :: tmp_str             !!
+
+!_ ================================================================================================================================
+    !
+
+    lenstr = LEN(basin_names(1))
+    !
+    list_names(1) = "Amazon"
+    list_names(2) = "Nile"
+    list_names(3) = "Zaire"
+    list_names(4) = "Mississippi"
+    list_names(5) = "Amur"
+    list_names(6) = "Parana"
+    list_names(7) = "Yenisei"
+    list_names(8) = "Ob"
+    list_names(9) = "Lena"
+    list_names(10) = "Niger"
+    list_names(11) = "Zambezi"
+    list_names(12) = "Erg Iguidi (Sahara)"
+    list_names(13) = "Chang Jiang (Yangtze)"
+    list_names(14) = "Mackenzie"
+    list_names(15) = "Ganges"
+    list_names(16) = "Chari"
+    list_names(17) = "Volga"
+    list_names(18) = "St. Lawrence"
+    list_names(19) = "Indus"
+    list_names(20) = "Syr-Darya"
+    list_names(21) = "Nelson"
+    list_names(22) = "Orinoco"
+    list_names(23) = "Murray"
+    list_names(24) = "Great Artesian Basin"
+    list_names(25) = "Shatt el Arab"
+    list_names(26) = "Orange"
+    list_names(27) = "Huang He"
+    list_names(28) = "Yukon"
+    list_names(29) = "Senegal"
+    list_names(30) = "Chott Jerid"
+    list_names(31) = "Jubba"
+    list_names(32) = "Colorado (Ari)"
+    list_names(33) = "Rio Grande (US)"
+    list_names(34) = "Danube"
+    list_names(35) = "Mekong"
+    list_names(36) = "Tocantins"
+    list_names(37) = "Wadi al Farigh"
+    list_names(38) = "Tarim"
+    list_names(39) = "Columbia"
+    list_names(40) = "Komadugu Yobe (Tchad)"
+    list_names(41) = "Kolyma"
+    list_names(42) = "Sao Francisco"
+    list_names(43) = "Amu-Darya"
+    list_names(44) = "GHAASBasin51"
+    list_names(45) = "Dnepr"
+    list_names(46) = "GHAASBasin61"
+    list_names(47) = "Don"
+    list_names(48) = "Colorado (Arg)"
+    list_names(49) = "Limpopo"
+    list_names(50) = "GHAASBasin50"
+    list_names(51) = "Zhujiang"
+    list_names(52) = "Irrawaddy"
+    list_names(53) = "Volta"
+    list_names(54) = "GHAASBasin54"
+    list_names(55) = "Farah"
+    list_names(56) = "Khatanga"
+    list_names(57) = "Dvina"
+    list_names(58) = "Urugay"
+    list_names(59) = "Qarqan"
+    list_names(60) = "GHAASBasin75"
+    list_names(61) = "Parnaiba"
+    list_names(62) = "GHAASBasin73"
+    list_names(63) = "Indigirka"
+    list_names(64) = "Churchill (Hud)"
+    list_names(65) = "Godavari"
+    list_names(66) = "Pur - Taz"
+    list_names(67) = "Pechora"
+    list_names(68) = "Baker"
+    list_names(69) = "Ural"
+    list_names(70) = "Neva"
+    list_names(71) = "Liao"
+    list_names(72) = "Salween"
+    list_names(73) = "GHAASBasin73"
+    list_names(74) = "Jordan"
+    list_names(75) = "GHAASBasin78"
+    list_names(76) = "Magdalena"
+    list_names(77) = "Krishna"
+    list_names(78) = "Salado"
+    list_names(79) = "Fraser"
+    list_names(80) = "Hai Ho"
+    list_names(81) = "Huai"
+    list_names(82) = "Yana"
+    list_names(83) = "GHAASBasin95"
+    list_names(84) = "GHAASBasin105"
+    list_names(85) = "Kura"
+    list_names(86) = "Olenek"
+    list_names(87) = "Ogooue"
+    list_names(88) = "Taymyr"
+    list_names(89) = "Negro Arg"
+    list_names(90) = "Chubut"
+    list_names(91) = "GHAASBasin91"
+    list_names(92) = "GHAASBasin122"
+    list_names(93) = "GHAASBasin120"
+    list_names(94) = "Sacramento"
+    list_names(95) = "Fitzroy West"
+    list_names(96) = "Grande de Santiago"
+    list_names(97) = "Rufiji"
+    list_names(98) = "Wisla"
+    list_names(99) = "GHAASBasin47"
+    list_names(100) = "GHAASBasin127"
+    list_names(101) = "Hong"
+    list_names(102) = "GHAASBasin97"
+    list_names(103) = "Swan-Avon"
+    list_names(104) = "Rhine"
+    list_names(105) = "Cuanza"
+    list_names(106) = "GHAASBasin106"
+    list_names(107) = "GHAASBasin142"
+    list_names(108) = "Roviuna"
+    list_names(109) = "Essequibo"
+    list_names(110) = "Elbe"
+    list_names(111) = "Koksoak"
+    list_names(112) = "Chao Phraya"
+    list_names(113) = "Brahmani"
+    list_names(114) = "GHAASBasin165"
+    list_names(115) = "Pyasina"
+    list_names(116) = "Fitzroy East"
+    list_names(117) = "GHAASBasin173"
+    list_names(118) = "Albany"
+    list_names(119) = "Sanaga"
+    list_names(120) = "GHAASBasin120"
+    list_names(121) = "GHAASBasin178"
+    list_names(122) = "GHAASBasin148"
+    list_names(123) = "Brazos (Tex)"
+    list_names(124) = "GHAASBasin124"
+    list_names(125) = "Alabama"
+    list_names(126) = "GHAASBasin174"
+    list_names(127) = "GHAASBasin179"
+    list_names(128) = "Balsas"
+    list_names(129) = "GHAASBasin172"
+    list_names(130) = "Burdekin"
+    list_names(131) = "Colorado (Texas)"
+    list_names(132) = "GHAASBasin150"
+    list_names(133) = "Odra"
+    list_names(134) = "Loire"
+    list_names(135) = "GHAASBasin98"
+    list_names(136) = "Galana"
+    list_names(137) = "Kuskowin"
+    list_names(138) = "Moose"
+    list_names(139) = "Narmada"
+    list_names(140) = "GHAASBasin140"
+    list_names(141) = "GHAASBasin141"
+    list_names(142) = "Flinders"
+    list_names(143) = "Kizil Irmak"
+    list_names(144) = "GHAASBasin144"
+    list_names(145) = "Save"
+    list_names(146) = "Roper"
+    list_names(147) = "Churchill (Atlantic)"
+    list_names(148) = "GHAASBasin148"
+    list_names(149) = "Victoria"
+    list_names(150) = "Back"
+    list_names(151) = "Bandama"
+    list_names(152) = "Severn (Can)"
+    list_names(153) = "Po"
+    list_names(154) = "GHAASBasin154"
+    list_names(155) = "GHAASBasin155"
+    list_names(156) = "GHAASBasin156"
+    list_names(157) = "Rhone"
+    list_names(158) = "Tana (Ken)"
+    list_names(159) = "La Grande"
+    list_names(160) = "GHAASBasin160"
+    list_names(161) = "Cunene"
+    list_names(162) = "Douro"
+    list_names(163) = "GHAASBasin163"
+    list_names(164) = "Nemanus"
+    list_names(165) = "GHAASBasin165"
+    list_names(166) = "Anabar"
+    list_names(167) = "Hayes"
+    list_names(168) = "Mearim"
+    list_names(169) = "GHAASBasin169"
+    list_names(170) = "Panuco"
+    list_names(171) = "GHAASBasin171"
+    list_names(172) = "Doce"
+    list_names(173) = "Gasgoyne"
+    list_names(174) = "GHAASBasin174"
+    list_names(175) = "GHAASBasin175"
+    list_names(176) = "Ashburton"
+    list_names(177) = "GHAASBasin177"
+    list_names(178) = "Peel"
+    list_names(179) = "Daugava"
+    list_names(180) = "GHAASBasin180"
+    list_names(181) = "Ebro"
+    list_names(182) = "Comoe"
+    list_names(183) = "Jacui"
+    list_names(184) = "GHAASBasin184"
+    list_names(185) = "Kapuas"
+    list_names(186) = "GHAASBasin186"
+    list_names(187) = "Penzhina"
+    list_names(188) = "Cauweri"
+    list_names(189) = "GHAASBasin189"
+    list_names(190) = "Mamberamo"
+    list_names(191) = "Sepik"
+    list_names(192) = "GHAASBasin192"
+    list_names(193) = "Sassandra"
+    list_names(194) = "GHAASBasin194"
+    list_names(195) = "GHAASBasin195"
+    list_names(196) = "Nottaway"
+    list_names(197) = "Barito"
+    list_names(198) = "GHAASBasin198"
+    list_names(199) = "Seine"
+    list_names(200) = "Tejo"
+    list_names(201) = "GHAASBasin201"
+    list_names(202) = "Gambia"
+    list_names(203) = "Susquehanna"
+    list_names(204) = "Dnestr"
+    list_names(205) = "Murchinson"
+    list_names(206) = "Deseado"
+    list_names(207) = "Mitchell"
+    list_names(208) = "Mahakam"
+    list_names(209) = "GHAASBasin209"
+    list_names(210) = "Pangani"
+    list_names(211) = "GHAASBasin211"
+    list_names(212) = "GHAASBasin212"
+    list_names(213) = "GHAASBasin213"
+    list_names(214) = "GHAASBasin214"
+    list_names(215) = "GHAASBasin215"
+    list_names(216) = "Bug"
+    list_names(217) = "GHAASBasin217"
+    list_names(218) = "Usumacinta"
+    list_names(219) = "Jequitinhonha"
+    list_names(220) = "GHAASBasin220"
+    list_names(221) = "Corantijn"
+    list_names(222) = "Fuchun Jiang"
+    list_names(223) = "Copper"
+    list_names(224) = "Tapti"
+    list_names(225) = "Menjiang"
+    list_names(226) = "Karun"
+    list_names(227) = "Mezen"
+    list_names(228) = "Guadiana"
+    list_names(229) = "Maroni"
+    list_names(230) = "GHAASBasin230"
+    list_names(231) = "Uda"
+    list_names(232) = "GHAASBasin232"
+    list_names(233) = "Kuban"
+    list_names(234) = "Colville"
+    list_names(235) = "Thaane"
+    list_names(236) = "Alazeya"
+    list_names(237) = "Paraiba do Sul"
+    list_names(238) = "GHAASBasin238"
+    list_names(239) = "Fortesque"
+    list_names(240) = "GHAASBasin240"
+    list_names(241) = "GHAASBasin241"
+    list_names(242) = "Winisk"
+    list_names(243) = "GHAASBasin243"
+    list_names(244) = "GHAASBasin244"
+    list_names(245) = "Ikopa"
+    list_names(246) = "Gilbert"
+    list_names(247) = "Kouilou"
+    list_names(248) = "Fly"
+    list_names(249) = "GHAASBasin249"
+    list_names(250) = "GHAASBasin250"
+    list_names(251) = "GHAASBasin251"
+    list_names(252) = "Mangoky"
+    list_names(253) = "Damodar"
+    list_names(254) = "Onega"
+    list_names(255) = "Moulouya"
+    list_names(256) = "GHAASBasin256"
+    list_names(257) = "Ord"
+    list_names(258) = "GHAASBasin258"
+    list_names(259) = "GHAASBasin259"
+    list_names(260) = "GHAASBasin260"
+    list_names(261) = "GHAASBasin261"
+    list_names(262) = "Narva"
+    list_names(263) = "GHAASBasin263"
+    list_names(264) = "Seal"
+    list_names(265) = "Cheliff"
+    list_names(266) = "Garonne"
+    list_names(267) = "Rupert"
+    list_names(268) = "GHAASBasin268"
+    list_names(269) = "Brahmani"
+    list_names(270) = "Sakarya"
+    list_names(271) = "Gourits"
+    list_names(272) = "Sittang"
+    list_names(273) = "Rajang"
+    list_names(274) = "Evros"
+    list_names(275) = "Appalachicola"
+    list_names(276) = "Attawapiskat"
+    list_names(277) = "Lurio"
+    list_names(278) = "Daly"
+    list_names(279) = "Penner"
+    list_names(280) = "GHAASBasin280"
+    list_names(281) = "GHAASBasin281"
+    list_names(282) = "Guadalquivir"
+    list_names(283) = "Nadym"
+    list_names(284) = "GHAASBasin284"
+    list_names(285) = "Saint John"
+    list_names(286) = "GHAASBasin286"
+    list_names(287) = "Cross"
+    list_names(288) = "Omoloy"
+    list_names(289) = "Oueme"
+    list_names(290) = "GHAASBasin290"
+    list_names(291) = "Gota"
+    list_names(292) = "Nueces"
+    list_names(293) = "Stikine"
+    list_names(294) = "Yalu"
+    list_names(295) = "Arnaud"
+    list_names(296) = "GHAASBasin296"
+    list_names(297) = "Jequitinhonha"
+    list_names(298) = "Kamchatka"
+    list_names(299) = "GHAASBasin299"
+    list_names(300) = "Grijalva"
+    list_names(301) = "GHAASBasin301"
+    list_names(302) = "Kemijoki"
+    list_names(303) = "Olifants"
+    list_names(304) = "GHAASBasin304"
+    list_names(305) = "Tsiribihina"
+    list_names(306) = "Coppermine"
+    list_names(307) = "GHAASBasin307"
+    list_names(308) = "GHAASBasin308"
+    list_names(309) = "Kovda"
+    list_names(310) = "Trinity"
+    list_names(311) = "Glama"
+    list_names(312) = "GHAASBasin312"
+    list_names(313) = "Luan"
+    list_names(314) = "Leichhardt"
+    list_names(315) = "GHAASBasin315"
+    list_names(316) = "Gurupi"
+    list_names(317) = "GR Baleine"
+    list_names(318) = "Aux Feuilles"
+    list_names(319) = "GHAASBasin319"
+    list_names(320) = "Weser"
+    list_names(321) = "GHAASBasin321"
+    list_names(322) = "GHAASBasin322"
+    list_names(323) = "Yesil"
+    list_names(324) = "Incomati"
+    list_names(325) = "GHAASBasin325"
+    list_names(326) = "GHAASBasin326"
+    list_names(327) = "Pungoe"
+    list_names(328) = "GHAASBasin328"
+    list_names(329) = "Meuse"
+    list_names(330) = "Eastmain"
+    list_names(331) = "Araguari"
+    list_names(332) = "Hudson"
+    list_names(333) = "GHAASBasin333"
+    list_names(334) = "GHAASBasin334"
+    list_names(335) = "GHAASBasin335"
+    list_names(336) = "GHAASBasin336"
+    list_names(337) = "Kobuk"
+    list_names(338) = "Altamaha"
+    list_names(339) = "GHAASBasin339"
+    list_names(340) = "Mand"
+    list_names(341) = "Santee"
+    list_names(342) = "GHAASBasin342"
+    list_names(343) = "GHAASBasin343"
+    list_names(344) = "GHAASBasin344"
+    list_names(345) = "Hari"
+    list_names(346) = "GHAASBasin346"
+    list_names(347) = "Wami"
+    list_names(348) = "GHAASBasin348"
+    list_names(349) = "GHAASBasin349"
+    !
+    basin_names(:) = '    '
+    !
+    DO i=1,numlar
+       tmp_str = list_names(i)
+       basin_names(i) = tmp_str(1:MIN(lenstr,LEN_TRIM(tmp_str)))
+    ENDDO
+    !
+  END SUBROUTINE routing_names
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_irrigmap
+!!
+!>\BRIEF         This  subroutine interpolates the 0.5x0.5 degree based map of irrigated areas to the resolution of the model.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_irrigmap (nbpt, index, lalo, neighbours, resolution, contfrac, &
+       &                       init_irrig, irrigated, init_flood, floodplains, init_swamp, swamp, hist_id, hist2_id)
+    !
+    IMPLICIT NONE
+    !
+!! PARAMETERS
+    INTEGER(i_std), PARAMETER                      :: ilake = 1             !! Number of type of lakes area (unitless)
+    INTEGER(i_std), PARAMETER                      :: idam = 2              !! Number of type of dams area (unitless)
+    INTEGER(i_std), PARAMETER                      :: iflood = 3            !! Number of type of floodplains area (unitless)
+    INTEGER(i_std), PARAMETER                      :: iswamp = 4            !! Number of type of swamps area (unitless)
+    INTEGER(i_std), PARAMETER                      :: isal = 5              !! Number of type of salines area (unitless)
+    INTEGER(i_std), PARAMETER                      :: ipond = 6             !! Number of type of ponds area (unitless)
+    INTEGER(i_std), PARAMETER                      :: ntype = 6             !! Number of types of flooded surfaces (unitless)
+
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                     :: nbpt                  !! Domain size  (unitless)
+    INTEGER(i_std), INTENT(in)                     :: index(nbpt)           !! Index on the global map.
+    REAL(r_std), INTENT(in)                        :: lalo(nbpt,2)          !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)                     :: neighbours(nbpt,NbNeighb)!! Vector of neighbours for each grid point
+    REAL(r_std), INTENT(in)                        :: resolution(nbpt,2)    !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)                        :: contfrac(nbpt)        !! Fraction of land in each grid box (unitless;0-1)
+    INTEGER(i_std), INTENT(in)                     :: hist_id               !! Access to history file (unitless)
+    INTEGER(i_std), INTENT(in)                     :: hist2_id              !! Access to history file 2 (unitless)
+    LOGICAL, INTENT(in)                            :: init_irrig            !! Logical to initialize the irrigation (true/false)
+    LOGICAL, INTENT(in)                            :: init_flood            !! Logical to initialize the floodplains (true/false)
+    LOGICAL, INTENT(in)                            :: init_swamp            !! Logical to initialize the swamps (true/false)
+    !
+!! OUTPUT VARIABLES
+    REAL(r_std), INTENT(out)                       :: irrigated(:)          !! Irrigated surface in each grid box (m^2)
+    REAL(r_std), INTENT(out)                       :: floodplains(:)        !! Surface which can be inundated in each grid box (m^2)
+    REAL(r_std), INTENT(out)                       :: swamp(:)              !! Surface which can be swamp in each grid box (m^2)
+    !
+!! LOCAL VARIABLES
+    ! Interpolation variables
+    ! 
+    INTEGER(i_std)                                 :: nbpmax, nix, njx, fopt !!
+    CHARACTER(LEN=30)                              :: callsign              !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)     :: resol_lu              !! Resolution read on the map
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)    :: mask                  !! Mask to exclude some points (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: irrsub_area           !! Area on the fine grid (m^2)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: irrsub_index          !! Indices of the points we need on the fine grid (unitless)
+    INTEGER                                        :: ALLOC_ERR             !!
+    LOGICAL                                        :: ok_interpol = .FALSE. !! Flag for interpolation (true/false)
+    !
+    CHARACTER(LEN=80)                              :: filename              !! Name of the netcdf file (unitless)
+    INTEGER(i_std)                                 :: iml, jml, lml, tml, fid, ib, ip, jp, itype !! Indices (unitless)
+    REAL(r_std)                                    :: lev(1), date, dt, coslat !!
+    INTEGER(i_std)                                 :: itau(1)               !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: latrel                !! Latitude
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: lonrel                !! Longitude
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: irrigated_frac        !! Irrigated fraction of the grid box (unitless;0-1)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)     :: flood_fracmax         !! Maximal flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std)                                    :: area_irrig            !! Irrigated surface in the grid box (m^2)
+    REAL(r_std)                                    :: area_flood(ntype)     !! Flooded surface in the grid box (m^2)
+!!$    REAL(r_std)                                :: irrigmap(nbpt)
+!!$    REAL(r_std)                                :: floodmap(nbpt)
+!!$    REAL(r_std)                                :: swampmap(nbpt)
+
+!_ ================================================================================================================================
+
+    !
+    !Config Key   = IRRIGATION_FILE
+    !Config Desc  = Name of file which contains the map of irrigated areas
+    !Config Def   = floodplains.nc
+    !Config If    = DO_IRRIGATION OR DO_FLOODPLAINS
+    !Config Help  = The name of the file to be opened to read the field
+    !Config         with the area in m^2 of the area irrigated within each
+    !Config         0.5 0.5 deg grid box. The map currently used is the one
+    !Config         developed by the Center for Environmental Systems Research 
+    !Config         in Kassel (1995).
+    !Config Units = [FILE]
+    !
+    filename = 'floodplains.nc'
+    CALL getin_p('IRRIGATION_FILE',filename)
+    !
+    IF (is_root_prc) THEN
+       CALL flininfo(filename,iml, jml, lml, tml, fid)
+       CALL flinclo(fid)
+    ELSE
+       iml = 0
+       jml = 0
+       lml = 0
+       tml = 0
+    ENDIF
+    !
+    CALL bcast(iml)
+    CALL bcast(jml)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    !
+    !
+    !
+    ALLOCATE (latrel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for latrel','','')
+
+    ALLOCATE (lonrel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for lonrel','','')
+
+    ALLOCATE (irrigated_frac(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for irrigated_frac','','')
+
+    ALLOCATE (flood_fracmax(iml,jml,ntype), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for flood_fracmax','','')
+
+    IF (is_root_prc) CALL flinopen(filename, .FALSE., iml, jml, lml, lonrel, latrel, lev, tml, itau, date, dt, fid)
+
+    CALL bcast(lonrel)
+    CALL bcast(latrel)
+    !
+    IF (is_root_prc) CALL flinget(fid, 'irrig', iml, jml, lml, tml, 1, 1, irrigated_frac)
+    CALL bcast(irrigated_frac)
+    IF (is_root_prc) CALL flinget(fid, 'lake', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,ilake))
+    IF (is_root_prc) CALL flinget(fid, 'dam', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,idam))
+    IF (is_root_prc) CALL flinget(fid, 'flood', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,iflood))
+    IF (is_root_prc) CALL flinget(fid, 'swamp', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,iswamp))
+    IF (is_root_prc) CALL flinget(fid, 'saline', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,isal))
+    CALL bcast(flood_fracmax)
+    !
+    IF (is_root_prc) CALL 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
+          !
+          DO itype=1,ntype
+             IF ( flood_fracmax(ip,jp,itype) .LT. undef_sechiba-1.) THEN
+                flood_fracmax(ip,jp,itype) = flood_fracmax(ip,jp,itype)/100
+                IF ( flood_fracmax(ip,jp,itype) < 0.005 )  flood_fracmax(ip,jp,itype) = zero
+             ENDIF
+          ENDDO
+          !
+       ENDDO
+    ENDDO
+    !
+    WRITE(numout,*) 'lonrel : ', MAXVAL(lonrel), MINVAL(lonrel)
+    WRITE(numout,*) 'latrel : ', MAXVAL(latrel), MINVAL(latrel)
+    WRITE(numout,*) 'irrigated_frac : ', MINVAL(irrigated_frac, MASK=irrigated_frac .GT. 0), &
+         &                          MAXVAL(irrigated_frac, MASK=irrigated_frac .LT. undef_sechiba)
+    WRITE(numout,*) 'flood_fracmax : ', MINVAL(flood_fracmax, MASK=flood_fracmax .GT. 0), &
+         &                      MAXVAL(flood_fracmax, MASK=flood_fracmax .LT. undef_sechiba)
+    !
+    ! Consider all points a priori
+    !
+    ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for resol_lu','','')
+
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for mask','','')
+    mask(:,:) = 0
+
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          ! Exclude the points where we are close to the missing value.
+          !
+!MG This condition cannot be applied in floodplains/swamps configuration because
+!   the same mask would be used for the interpolation of irrigation, floodplains and swamps maps.
+!          IF ( irrigated_frac(ip,jp) < undef_sechiba ) THEN
+             mask(ip,jp) = 1
+!          ENDIF
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( latrel(ip,jp) * pi/180. ), mincos )     
+          IF ( ip .EQ. 1 ) THEN
+             resol_lu(ip,jp,1) = ABS( lonrel(ip+1,jp) - lonrel(ip,jp) ) * pi/180. * R_Earth * coslat
+          ELSEIF ( ip .EQ. iml ) THEN
+             resol_lu(ip,jp,1) = ABS( lonrel(ip,jp) - lonrel(ip-1,jp) ) * pi/180. * R_Earth * coslat
+          ELSE
+             resol_lu(ip,jp,1) = ABS( lonrel(ip+1,jp) - lonrel(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resol_lu(ip,jp,2) = ABS( latrel(ip,jp) - latrel(ip,jp+1) ) * pi/180. * R_Earth
+          ELSEIF ( jp .EQ. jml ) THEN
+             resol_lu(ip,jp,2) = ABS( latrel(ip,jp-1) - latrel(ip,jp) ) * pi/180. * R_Earth
+          ELSE
+             resol_lu(ip,jp,2) =  ABS( latrel(ip,jp-1) - latrel(ip,jp+1) )/2. * pi/180. * R_Earth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    callsign = 'Irrigation map'
+    ok_interpol = .FALSE.
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
+       njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
+       nbpmax = nix*njx*2
+       WRITE(numout,*) "Projection arrays for ",callsign," : "
+       WRITE(numout,*) "nbpmax = ",nbpmax, nix, njx
+    ENDIF
+    CALL bcast(nbpmax)
+
+    ALLOCATE(irrsub_index(nbpt, nbpmax, 2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for irrsub_index','','')
+    irrsub_index(:,:,:)=0
+
+    ALLOCATE(irrsub_area(nbpt, nbpmax), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for irrsub_area','','')
+    irrsub_area(:,:)=zero
+
+    CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+         &                iml, jml, lonrel, latrel, mask, callsign, &
+         &                nbpmax, irrsub_index, irrsub_area, ok_interpol)
+    !
+    !
+    WHERE (irrsub_area < 0) irrsub_area=zero
+    !  
+    ! Test here if not all sub_area are larger than 0 if so, then we need to increase nbpmax
+    !
+    DO ib=1,nbpt
+       !
+       area_irrig = 0.0
+       area_flood = 0.0
+       !
+       DO fopt=1,COUNT(irrsub_area(ib,:) > zero)
+          !
+          ip = irrsub_index(ib, fopt, 1)
+          jp = irrsub_index(ib, fopt, 2)
+          !
+          IF (irrigated_frac(ip,jp) .LT. undef_sechiba-1.) THEN
+             area_irrig = area_irrig + irrsub_area(ib,fopt)*irrigated_frac(ip,jp)
+          ENDIF
+          !
+          DO itype=1,ntype
+             IF (flood_fracmax(ip,jp,itype) .LT. undef_sechiba-1.) THEN
+                area_flood(itype) = area_flood(itype) + irrsub_area(ib,fopt)*flood_fracmax(ip,jp,itype)
+             ENDIF
+          ENDDO
+       ENDDO
+       !
+       ! Put the total irrigated and flooded areas in the output variables
+       !
+       IF ( init_irrig ) THEN
+          irrigated(ib) = MIN(area_irrig, resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+          IF ( irrigated(ib) < 0 ) THEN
+             WRITE(numout,*) 'We have a problem here : ', irrigated(ib) 
+             WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+             WRITE(numout,*) area_irrig
+             CALL ipslerr_p(3,'routing_irrigmap','Problem with irrigated...','','')
+          ENDIF
+!!$          ! Compute a diagnostic of the map.
+!!$          IF(contfrac(ib).GT.zero) THEN
+!!$             irrigmap (ib) = irrigated(ib) / ( resolution(ib,1)*resolution(ib,2)*contfrac(ib) )
+!!$          ELSE
+!!$             irrigmap (ib) = zero
+!!$          ENDIF
+          !
+       ENDIF
+       !
+       IF ( init_flood ) THEN
+          floodplains(ib) = MIN(area_flood(iflood)+area_flood(idam)+area_flood(isal), &
+               & resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+          IF ( floodplains(ib) < 0 ) THEN
+             WRITE(numout,*) 'We have a problem here : ', floodplains(ib) 
+             WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+             WRITE(numout,*) area_flood
+             CALL ipslerr_p(3,'routing_irrigmap','Problem with floodplains..','','')
+          ENDIF
+!!$          ! Compute a diagnostic of the map.
+!!$          IF(contfrac(ib).GT.zero) THEN
+!!$             floodmap(ib) = floodplains(ib) / ( resolution(ib,1)*resolution(ib,2)*contfrac(ib) )
+!!$          ELSE
+!!$             floodmap(ib) = 0.0
+!!$          ENDIF
+       ENDIF
+       !
+       IF ( init_swamp ) THEN
+          swamp(ib) = MIN(area_flood(iswamp), resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+          IF ( swamp(ib) < 0 ) THEN
+             WRITE(numout,*) 'We have a problem here : ', swamp(ib) 
+             WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+             WRITE(numout,*) area_flood
+             CALL ipslerr_p(3,'routing_irrigmap','Problem with swamp...','','')
+          ENDIF
+!!$          ! Compute a diagnostic of the map.
+!!$          IF(contfrac(ib).GT.zero) THEN
+!!$             swampmap(ib) = swamp(ib) / ( resolution(ib,1)*resolution(ib,2)*contfrac(ib) )
+!!$          ELSE
+!!$             swampmap(ib) = zero
+!!$          ENDIF
+       ENDIF
+       !
+       !
+    ENDDO
+    !
+    !
+    
+    IF ( init_irrig ) WRITE(numout,*) "Diagnostics irrigated :", MINVAL(irrigated), MAXVAL(irrigated)
+    IF ( init_flood ) WRITE(numout,*) "Diagnostics floodplains :", MINVAL(floodplains), MAXVAL(floodplains)
+    IF ( init_swamp ) WRITE(numout,*) "Diagnostics swamp :", MINVAL(swamp), MAXVAL(swamp)
+!
+! No compensation is done for overlapping floodplains, swamp and irrig. At least overlapping will not
+! happen between floodplains and swamp alone
+!    IF ( init_irrig .AND. init_flood ) THEN
+!       DO ib = 1, nbpt
+!          surp = (floodplains(ib)+swamp(ib)+irrigated(ib)) / (resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+!          IF ( surp .GT. un ) THEN
+!             floodplains(ib) = floodplains(ib) / surp
+!             swamp(ib) = swamp(ib) / surp
+!             irrigated(ib) = irrigated(ib) / surp
+!          ENDIF
+!       ENDDO
+!    ENDIF
+    !
+    DEALLOCATE (irrsub_area)
+    DEALLOCATE (irrsub_index)
+    !
+    DEALLOCATE (mask)
+    DEALLOCATE (resol_lu)
+    !
+    DEALLOCATE (lonrel)
+    DEALLOCATE (latrel)
+    !
+  END SUBROUTINE routing_irrigmap
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: routing_waterbal
+!!
+!>\BRIEF         This subroutine checks the water balance in the routing module.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_waterbal(nbpt, reinit, floodout, runoff, drainage, returnflow, &
+               & reinfiltration, irrigation, riverflow, coastalflow)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in) :: nbpt                 !! Domain size  (unitless)
+    LOGICAL, INTENT(in)        :: reinit               !! Controls behaviour (true/false)
+    REAL(r_std), INTENT(in)    :: floodout(nbpt)       !! Grid-point flow out of floodplains (kg/m^2/dt)
+    REAL(r_std), INTENT(in)    :: runoff(nbpt)         !! Grid-point runoff (kg/m^2/dt)
+    REAL(r_std), INTENT(in)    :: drainage(nbpt)       !! Grid-point drainage (kg/m^2/dt)
+    REAL(r_std), INTENT(in)    :: returnflow(nbpt)     !! The water flow from lakes and swamps which returns to the grid box.
+                                                       !! This water will go back into the hydrol module to allow re-evaporation (kg/m^2/dt)
+    REAL(r_std), INTENT(in)    :: reinfiltration(nbpt) !! Water flow from ponds and floodplains which returns to the grid box (kg/m^2/dt)
+    REAL(r_std), INTENT(in)    :: irrigation(nbpt)     !! Irrigation flux. This is the water taken from the reservoirs and beeing put into the upper layers of the soil (kg/m^2/dt)
+    REAL(r_std), INTENT(in)    :: riverflow(nbpt)      !! Outflow of the major rivers. The flux will be located on the continental grid but this should be a coastal point (kg/dt)
+    REAL(r_std), INTENT(in)    :: coastalflow(nbpt)    !! Outflow on coastal points by small basins. This is the water which flows in a disperse way into the ocean (kg/dt)
+    !
+    ! We sum-up all the water we have in the warious reservoirs
+    !
+    REAL(r_std), SAVE          :: totw_flood           !! Sum of all the water amount in the floodplains reservoirs (kg)
+!$OMP THREADPRIVATE(totw_flood)
+    REAL(r_std), SAVE          :: totw_stream          !! Sum of all the water amount in the stream reservoirs (kg)
+!$OMP THREADPRIVATE(totw_stream)
+    REAL(r_std), SAVE          :: totw_fast            !! Sum of all the water amount in the fast reservoirs (kg)
+!$OMP THREADPRIVATE(totw_fast)
+    REAL(r_std), SAVE          :: totw_slow            !! Sum of all the water amount in the slow reservoirs (kg)
+!$OMP THREADPRIVATE(totw_slow)
+    REAL(r_std), SAVE          :: totw_lake            !! Sum of all the water amount in the lake reservoirs (kg)
+!$OMP THREADPRIVATE(totw_lake)
+    REAL(r_std), SAVE          :: totw_pond            !! Sum of all the water amount in the pond reservoirs (kg)
+!$OMP THREADPRIVATE(totw_pond)
+    REAL(r_std), SAVE          :: totw_in              !! Sum of the water flow in to the routing scheme
+!$OMP THREADPRIVATE(totw_in)
+    REAL(r_std), SAVE          :: totw_out             !! Sum of the water flow out to the routing scheme
+!$OMP THREADPRIVATE(totw_out)
+    REAL(r_std), SAVE          :: totw_return          !! 
+!$OMP THREADPRIVATE(totw_return)
+    REAL(r_std), SAVE          :: totw_irrig           !! 
+!$OMP THREADPRIVATE(totw_irrig)
+    REAL(r_std), SAVE          :: totw_river           !! 
+!$OMP THREADPRIVATE(totw_river)
+    REAL(r_std), SAVE          :: totw_coastal         !! 
+!$OMP THREADPRIVATE(totw_coastal)
+    REAL(r_std)                :: totarea              !! Total area of basin (m^2)
+    REAL(r_std)                :: area                 !! Total area of routing (m^2)
+    INTEGER(i_std)             :: ig                   !! 
+    !
+    ! Just to make sure we do not get too large numbers !
+    !
+!! PARAMETERS
+    REAL(r_std), PARAMETER     :: scaling = 1.0E+6     !!
+    REAL(r_std), PARAMETER     :: allowed_err = 50.    !!
+
+!_ ================================================================================================================================
+    !
+    IF ( reinit ) THEN
+       !
+       totw_flood = zero
+       totw_stream = zero
+       totw_fast = zero
+       totw_slow = zero
+       totw_lake = zero
+       totw_pond = zero 
+       totw_in = zero
+       !
+       DO ig=1,nbpt
+          !
+          totarea = SUM(routing_area(ig,:))
+          !
+          totw_flood = totw_flood + SUM(flood_reservoir(ig,:)/scaling)
+          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_pond = totw_pond + pond_reservoir(ig)/scaling
+          !
+          totw_in = totw_in + (runoff(ig)*totarea + drainage(ig)*totarea - floodout(ig)*totarea)/scaling
+          !
+       ENDDO
+       !
+    ELSE
+       !
+       totw_out = zero
+       totw_return = zero
+       totw_irrig = zero
+       totw_river = zero
+       totw_coastal = zero
+       area = zero
+       !
+       DO ig=1,nbpt
+          !
+          totarea = SUM(routing_area(ig,:))
+          !
+          totw_flood = totw_flood - SUM(flood_reservoir(ig,:)/scaling)
+          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_pond = totw_pond - pond_reservoir(ig)/scaling
+          !
+          totw_return = totw_return + (reinfiltration(ig)+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_flood + totw_stream + totw_fast + totw_slow + totw_lake + totw_pond) - &
+            & (totw_out - totw_in)) > allowed_err ) THEN
+          WRITE(numout,*) 'WARNING : Water not conserved in routing. Limit at ', allowed_err, ' 10^6 kg'
+          WRITE(numout,*) '--Water-- change : flood stream fast ', totw_flood, totw_stream, totw_fast
+          WRITE(numout,*) '--Water-- change : slow, lake ', totw_slow, totw_lake
+          WRITE(numout,*) '--Water>>> change in the routing res. : ', totw_flood + totw_stream + totw_fast + totw_slow + totw_lake
+          WRITE(numout,*) '--Water input : ', totw_in
+          WRITE(numout,*) '--Water output : ', totw_out
+          WRITE(numout,*) '--Water output : return, irrig ', totw_return, totw_irrig
+          WRITE(numout,*) '--Water output : river, coastal ',totw_river, totw_coastal
+          WRITE(numout,*) '--Water>>> change by fluxes : ', totw_out - totw_in, ' Diff [mm/dt]: ',   &
+               & ((totw_flood + totw_stream + totw_fast + totw_slow + totw_lake) - (totw_out - totw_in))/area
+
+          ! Stop the model
+          CALL ipslerr_p(3, 'routing_waterbal', 'Water is not conserved in routing.','','')
+       ENDIF
+       !
+    ENDIF
+    !
+  END SUBROUTINE routing_waterbal
+  !
+  !
+END MODULE routing
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/sechiba.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/sechiba.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/sechiba.f90	(revision 6412)
@@ -0,0 +1,3179 @@
+!  ==============================================================================================================================\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,  hydrol_main,
+!! condveg_main and thermosoil_main. Note that sechiba_main
+!! calls slowproc_main and thus indirectly calculates the biogeochemical
+!! processes as well.
+!!
+!!\n DESCRIPTION  : :: shumdiag, :: litterhumdiag and :: stempdiag are not 
+!! saved in the restart file because at the first time step because they 
+!! are recalculated. However, they must be saved as they are in slowproc 
+!! which is called before the modules which calculate them.
+!! 
+!! RECENT CHANGE(S): None 
+!! 
+!! REFERENCE(S) : None
+!!   
+!! SVN     :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+ 
+MODULE sechiba
+ 
+  USE ioipsl
+  USE xios_orchidee
+  
+  ! modules used :
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE grid
+  USE structures
+  USE diffuco
+  USE condveg
+  USE enerbil
+  USE hydrol
+  USE sechiba_hydrol_arch
+  USE thermosoil
+  USE sechiba_io_p
+  USE slowproc
+  USE routing
+  USE ioipsl_para
+  USE chemistry
+  USE stomate_laieff
+  USE function_library,  ONLY : cc_to_lai 
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC sechiba_main, sechiba_initialize, sechiba_clear, &
+       sechiba_interface_orchidee_inca
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexveg       !! indexing array for the 3D fields of vegetation
+!$OMP THREADPRIVATE(indexveg)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexlai       !! indexing array for the 3D fields of vegetation
+!$OMP THREADPRIVATE(indexlai)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexnobio     !! indexing array for the 3D fields of other surfaces (ice,
+                                                                     !! lakes, ...)
+!$OMP THREADPRIVATE(indexnobio)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexsoil      !! indexing array for the 3D fields of soil types (kjpindex*nstm)
+!$OMP THREADPRIVATE(indexsoil)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexgrnd      !! indexing array for the 3D ground heat profiles (kjpindex*ngrnd)
+!$OMP THREADPRIVATE(indexgrnd)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexlayer     !! indexing array for the 3D fields of soil layers in CWRR (kjpindex*nslm)
+!$OMP THREADPRIVATE(indexlayer)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexnbdl      !! indexing array for the 3D fields of diagnostic soil layers (kjpindex*nbdl)
+!$OMP THREADPRIVATE(indexnbdl)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexalb       !! indexing array for the 2 fields of albedo
+!$OMP THREADPRIVATE(indexalb)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexsnow      !! indexing array for the 3D fields snow layers
+!$OMP THREADPRIVATE(indexsnow)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexcan       !! indexing array for the level fields of the canopy
+!$OMP THREADPRIVATE(indexcan)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: jnlevels_loc    !! (JR) number of vegetation levels (integer)
+!$OMP THREADPRIVATE(jnlevels_loc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: veget          !! Fraction of vegetation type (unitless, 0-1)       
+!$OMP THREADPRIVATE(veget)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: veget_max      !! Max. fraction of vegetation type (LAI -> infty, unitless)
+!$OMP THREADPRIVATE(veget_max)
+
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: height         !! Vegetation Height (m)
+!$OMP THREADPRIVATE(height)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: totfrac_nobio  !! Total fraction of continental ice+lakes+cities+...
+                                                                     !! (unitless, 0-1)
+!$OMP THREADPRIVATE(totfrac_nobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: floodout       !! Flow out of floodplains from hydrol
+!$OMP THREADPRIVATE(floodout)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: runoff         !! Surface runoff calculated by hydrol  
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(runoff)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: drainage       !! Deep drainage calculatedd by hydrol  
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(drainage)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: returnflow     !! Water flow from lakes and swamps which returns to 
+                                                                     !! the grid box @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(returnflow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: reinfiltration !! Routed water which returns into the soil
+!$OMP THREADPRIVATE(reinfiltration)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: irrigation     !! Irrigation flux taken from the routing reservoirs and 
+                                                                     !! being put into the upper layers of the soil 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(irrigation)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: emis           !! Surface emissivity (unitless)
+!$OMP THREADPRIVATE(emis)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: z0h           !! Surface roughness for heat (m)
+!$OMP THREADPRIVATE(z0h)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: z0m           !! Surface roughness for momentum (m)
+!$OMP THREADPRIVATE(z0m)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: z0_veg         !! Surface roughness of vegetated part (m) 
+!$OMP THREADPRIVATE(z0_veg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: roughheight    !! Effective height for roughness (m)
+!$OMP THREADPRIVATE(roughheight)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: reinf_slope    !! slope coefficient (reinfiltration) 
+!$OMP THREADPRIVATE(reinf_slope)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: shumdiag       !! Mean relative soil moisture in the different levels used 
+                                                                     !! by thermosoil.f90 (unitless, 0-1)
+!$OMP THREADPRIVATE(shumdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: shumdiag_perma !! Saturation degree of the soil 
+!$OMP THREADPRIVATE(shumdiag_perma)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: k_litt         !! litter cond.
+!$OMP THREADPRIVATE(k_litt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: litterhumdiag  !! Litter dryness factor (unitless, 0-1)
+!$OMP THREADPRIVATE(litterhumdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: stempdiag      !! Temperature which controls canopy evolution (K)
+!$OMP THREADPRIVATE(stempdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: qsintveg       !! Water on vegetation due to interception 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(qsintveg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta2         !! Interception resistance (unitless,0-1)
+!$OMP THREADPRIVATE(vbeta2)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta3         !! Vegetation resistance (unitless,0-1)
+!$OMP THREADPRIVATE(vbeta3)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta3pot      !! Potential vegetation resistance
+!$OMP THREADPRIVATE(vbeta3pot)
+!!$ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbetaco2       !! STOMATE:Vegetation resistance to CO2 (unitless,0-1)
+!!$!$OMP THREADPRIVATE(vbetaco2)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: gsmean         !! Mean stomatal conductance for CO2 (mol m-2 s-1)
+!$OMP THREADPRIVATE(gsmean)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: cimean         !! STOMATE: mean intercellular CO2 concentration (ppm)
+!$OMP THREADPRIVATE(cimean)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vevapwet       !! Interception loss over each PFT 
+                                                                     !! @tex $(kg m^{-2} days^{-1})$ @endtex
+!$OMP THREADPRIVATE(vevapwet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: transpir       !! Transpiration @tex $(kg m^{-2} days^{-1})$ @endtex
+!$OMP THREADPRIVATE(transpir)
+
+
+
+
+! hydraulic stress variables -------------------------------------
+
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: transpir_supply  !! Supply of water for transpiration @tex$$(mm dt^{-1})$ @endtex
+!$OMP THREADPRIVATE(transpir_supply)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vir_transpir_supply !! Supply of water for transpiration @tex$$(mm dt^{-1})$ @endtex
+!$OMP THREADPRIVATE(vir_transpir_supply)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: stressed      !! Adjusted ecosystem functioning. Takes the unit of the variable
+                                                                     !! used as a proxy for waterstress
+!$OMP THREADPRIVATE(stressed)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: unstressed    !! Initial ecosystem functioning after the first calculation and 
+                                                                     !! before any recalculations. Takes the unit of the variable used
+                                                                     !! as a proxy for unstressed.
+!$OMP THREADPRIVATE(unstressed)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_frac      !! Fraction of water transpired supplied by individual layers (no units)
+!$OMP THREADPRIVATE(e_frac)
+
+!$   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vir_transpir_mod !! potential transpiration (transpot) divided by veget_max
+!!$!$OMP THREADPRIVATE(vir_transpir_mod)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: transpir_mod      !! transpir divided by veget_max
+!$OMP THREADPRIVATE(transpir_mod)
+
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:, :, :)    :: transpir_column            !! Supply of water for transpiration 
+!$OMP THREADPRIVATE(transpir_column)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:, :, :)    :: transpir_supply_column     !! Supply of water for transpiration 
+!$OMP THREADPRIVATE(transpir_supply_column)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:, :, :)    :: transpir_mod_column        !! Supply of water for transpiration 
+!$OMP THREADPRIVATE(transpir_mod_column)
+
+
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: transpot      !! Potential transpiration (needed for irrigation)
+!$OMP THREADPRIVATE(transpot)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: qsintmax       !! Maximum amount of water in the canopy interception 
+                                                                     !! reservoir @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(qsintmax)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: rveget         !! Surface resistance for the vegetation 
+                                                                     !! @tex $(s m^{-1})$ @endtex
+!$OMP THREADPRIVATE(rveget)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: rstruct        !! Vegetation structural resistance
+!$OMP THREADPRIVATE(rstruct)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: warnings     !! Holds a count of how many warnings we run into
+                                                                     !! of different types.  It will get reset at the
+                                                                     !! end of each period since we don't wish to restart it.
+                                                                     !! Purely a technical diagnostic variable.
+!$OMP THREADPRIVATE(warnings)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: snow_nobio     !! Snow mass of non-vegetative surfaces 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(snow_nobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: snow_nobio_age !! Snow age on non-vegetative surfaces (days)
+!$OMP THREADPRIVATE(snow_nobio_age)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: frac_nobio     !! Fraction of non-vegetative surfaces (continental ice, 
+                                                                     !! lakes, ...) (unitless, 0-1)
+!$OMP THREADPRIVATE(frac_nobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: albedo         !! Surface albedo for visible and near-infrared 
+                                                                     !! (unitless, 0-1)
+!$OMP THREADPRIVATE(albedo)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: albedo_pft     !! Albedo (two stream radiation transfer model)
+                                                                     !! for visible and near-infrared range 
+                                                                     !! for each PFT (unitless)
+!$OMP THREADPRIVATE(albedo_pft)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:):: assim_param    !! vcmax, nue, and leaf N for photosynthesis  for photosynthesis
+!$OMP THREADPRIVATE(assim_param)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: lai            !! Surface foliaire
+!$OMP THREADPRIVATE(lai)
+  TYPE(laieff_type), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: laieff_fit   !! The parameters for fitting the effective
+                                                                     !! LAI function
+!$OMP THREADPRIVATE(laieff_fit)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: gpp            !! STOMATE: GPP. gC/m**2 of total area
+!$OMP THREADPRIVATE(gpp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)     :: temp_growth    !! Growth temperature (C) - Is equal to t2m_month 
+!$OMP THREADPRIVATE(temp_growth) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: humrel         !! Relative humidity
+!$OMP THREADPRIVATE(humrel)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vegstress      !! Vegetation moisture stress (only for vegetation growth)
+!$OMP THREADPRIVATE(vegstress)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:):: frac_age       !! Age efficacity from STOMATE for isoprene 
+!$OMP THREADPRIVATE(frac_age)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: soiltile       !! Fraction of each soil tile (0-1, unitless)
+!$OMP THREADPRIVATE(soiltile)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: njsc           !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+!$OMP THREADPRIVATE(njsc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta1         !! Snow resistance 
+!$OMP THREADPRIVATE(vbeta1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta4         !! Bare soil resistance
+!$OMP THREADPRIVATE(vbeta4)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta5         !! Floodplains resistance
+!$OMP THREADPRIVATE(vbeta5)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: soilcap        !!
+!$OMP THREADPRIVATE(soilcap)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: soilflx        !!
+!$OMP THREADPRIVATE(soilflx)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: temp_sol       !! Soil temperature
+!$OMP THREADPRIVATE(temp_sol)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: qsurf          !! near soil air moisture
+!$OMP THREADPRIVATE(qsurf)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: flood_res      !! flood reservoir estimate
+!$OMP THREADPRIVATE(flood_res)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: flood_frac     !! flooded fraction
+!$OMP THREADPRIVATE(flood_frac)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: snow           !! Snow mass [Kg/m^2]
+!$OMP THREADPRIVATE(snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: snow_age       !! Snow age
+!$OMP THREADPRIVATE(snow_age)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: drysoil_frac   !! Fraction of visibly (albedo) Dry soil (Between 0 and 1)
+!$OMP THREADPRIVATE(drysoil_frac)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: evap_bare_lim  !! Bare soil stress
+!$OMP THREADPRIVATE(evap_bare_lim)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::swc            !! Soil water content (a copy of mc) m3 m-3
+!$OMP THREADPRIVATE(swc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::ksave          !! Soil conductivity (copy of k mm/d)
+!$OMP THREADPRIVATE(ksave)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: co2_flux       !! CO2 flux (gC/m**2 of average ground/s)
+!$OMP THREADPRIVATE(co2_flux)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: evapot         !! Soil Potential Evaporation
+!$OMP THREADPRIVATE(evapot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: evapot_corr    !! Soil Potential Evaporation Correction (Milly 1992)
+!$OMP THREADPRIVATE(evapot_corr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vevapflo       !! Floodplains evaporation
+!$OMP THREADPRIVATE(vevapflo)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vevapsno       !! Snow evaporation
+!$OMP THREADPRIVATE(vevapsno)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vevapnu        !! Bare soil evaporation
+!$OMP THREADPRIVATE(vevapnu)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: tot_melt       !! Total melt
+!$OMP THREADPRIVATE(tot_melt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta          !! Resistance coefficient
+!$OMP THREADPRIVATE(vbeta)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: rau            !! Density
+!$OMP THREADPRIVATE(rau)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: deadleaf_cover !! Fraction of soil covered by dead leaves
+!$OMP THREADPRIVATE(deadleaf_cover)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: ptnlev1        !! 1st level Different levels soil temperature
+!$OMP THREADPRIVATE(ptnlev1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: mc_layh        !! Volumetric soil moisture for each layer in hydrol(liquid + ice) (m3/m3)
+!$OMP THREADPRIVATE(mc_layh)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: mcl_layh       !! Volumetric soil moisture for each layer in hydrol(liquid) (m3/m3)
+!$OMP THREADPRIVATE(mcl_layh)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: tmc_layh       !! Total soil moisture content for each layer in hydrol(liquid + ice) (mm)
+!$OMP THREADPRIVATE(tmc_layh)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::laieff_isotrop       !! Effective LAI
+!$OMP THREADPRIVATE(laieff_isotrop)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: Isotrop_Abs_Tot_p   !! Absorbed radiation per level for photosynthesis
+!$OMP THREADPRIVATE(Isotrop_Abs_Tot_p)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: Isotrop_Tran_Tot_p  !! Transmitted radiation per level for photosynthesis
+!$OMP THREADPRIVATE(Isotrop_Tran_Tot_p)
+
+! multi-layer variables --------------------------------
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: flux_rn_grid 
+!$OMP THREADPRIVATE(flux_rn_grid)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: flux_h_grid 
+!$OMP THREADPRIVATE(flux_h_grid)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: flux_le_grid
+!$OMP THREADPRIVATE(flux_le_grid)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: u_speed_grid 
+!$OMP THREADPRIVATE(u_speed_grid)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: t_a_next_grid
+!$OMP THREADPRIVATE(t_a_next_grid)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: q_a_next_grid 
+!$OMP THREADPRIVATE(q_a_next_grid)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: temp_atmos_pres_grid         !! Atmospheric temperature down the column (K) PRESENT STEP
+!$OMP THREADPRIVATE(temp_atmos_pres_grid)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: q_atmos_pres_grid            !! Atmospheric specific humididy down the column (kg/kg) PRESENT STEP
+!$OMP THREADPRIVATE(q_atmos_pres_grid)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: temp_leaf_pres_grid          !! Leaf temperature down the column (K) PRESENT STEP
+!$OMP THREADPRIVATE(temp_leaf_pres_grid)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)      :: u_speed                      !! Canopy wind speed profile
+!$OMP THREADPRIVATE(u_speed)
+ ! these following two quantities are never calculated explicitly, they always have values passed from
+ ! stomate...they need to be saved, though, since stomate is only called once a day
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: circ_class_biomass        !! Stem diameter @tex $(m)$ @endtex
+!$OMP THREADPRIVATE(circ_class_biomass)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: circ_class_n                 !! Number of trees within each circumference
+!$OMP THREADPRIVATE(circ_class_n)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)      :: nlevels_loc                  !! Additional energy to melt snow for snow ablation case (K)
+
+
+! energy budget/hydraulic stress variables -------------------
+
+  INTEGER, SAVE                                    :: mleb_count = 0               !! count how many times to run mleb_main
+!$OMP THREADPRIVATE(mleb_count)
+
+  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	                   !! Derivative of satured specific humidity at the old 
+                                                                                   !! temperature (kg (kg s)^{-1})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: netrad                       !! Net radiation (W m^{-2})
+
+! ------------------------------------------------------------
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: sum_veget_diff          !! The is the difference between the total
+                                                                              !! vegetation fraction in the new and old
+                                                                              !! land cover maps.  Useful for land cover
+                                                                              !! changes. [-]
+!$OMP THREADPRIVATE(sum_veget_diff)
+
+  
+                                 !! @tex $(gC m^{-2})$ @endtex
+                          
+REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:)      :: h_array_out       !! heights of tree levels from stomate           
+!$OMP THREADPRIVATE(h_array_out)
+
+REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:)      :: z_array_out       !! heights of tree levels from stomate           
+!$OMP THREADPRIVATE(z_array_out)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)           :: t2m_month_out     !! t2m longterm temperature from stomate           
+!$OMP THREADPRIVATE(t2m_month_out)
+
+! new allocatable variables added during merge
+
+ REAL(r_std),ALLOCATABLE, SAVE, DIMENSION (:, :, :)      :: profile_vbeta3
+!$OMP THREADPRIVATE(profile_vbeta3)
+
+ REAL(r_std),ALLOCATABLE, SAVE, DIMENSION (:, :, :)      :: profile_rveget
+!$OMP THREADPRIVATE(profile_rveget)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)         :: max_height_store     !! Same as z_array, but one less dimension.
+                                                                                 !! @tex $(m)$ @endte
+!$OMP THREADPRIVATE(max_height_store)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)         :: delta_c13_assim      !! C13 concentration in delta notation
+                                                                                 !! @tex $ permille $ @endtex (per thousand)   
+!$OMP THREADPRIVATE(delta_c13_assim)
+  
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)         :: leaf_ci_out          !! Ci Leaf internal CO2 concentration ()      
+!$OMP THREADPRIVATE(leaf_ci_out)
+ 
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)         :: gpp_day              !! Number of time steps when there is gpp
+!$OMP THREADPRIVATE(gpp_day)
+
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)        :: lai_per_level        !! The LAI per vertical level
+                                                                                 !! @tex $(m^2 / m^2)$ @endtex
+!$OMP THREADPRIVATE(lai_per_level)
+ REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)            :: frac_snow_pix        !! The fraction of the whole pixel covered
+                                                                                 !! by snow. This is computed from the above
+                                                                                 !! two. @tex $-$ @endtex
+!$OMP THREADPRIVATE(frac_snow_pix)
+
+
+  LOGICAL, SAVE                                    :: l_first_sechiba = .TRUE. !! Flag controlling the intialisation (true/false)
+!$OMP THREADPRIVATE(l_first_sechiba)
+
+  ! Variables related to snow processes calculations  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: frac_snow_veg   !! Snow cover fraction on vegetation (unitless)  
+!$OMP THREADPRIVATE(frac_snow_veg)  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: frac_snow_nobio !! Snow cover fraction on continental ice, lakes, etc (unitless)  
+!$OMP THREADPRIVATE(frac_snow_nobio) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: snowrho      !! snow density for each layer
+!$OMP THREADPRIVATE(snowrho)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: snowheat     !! snow heat content for each layer (J/m2)
+!$OMP THREADPRIVATE(snowheat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: snowgrain    !! snow grain size (m)
+!$OMP THREADPRIVATE(snowgrain)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: snowtemp     !! snow temperature profile (K)
+!$OMP THREADPRIVATE(snowtemp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: snowdz       !! snow layer thickness (m)
+!$OMP THREADPRIVATE(snowdz)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: gtemp        !! soil surface temperature
+!$OMP THREADPRIVATE(gtemp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: pgflux       !! net energy into snow pack
+!$OMP THREADPRIVATE(pgflux)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: cgrnd_snow   !! Integration coefficient for snow numerical scheme
+!$OMP THREADPRIVATE(cgrnd_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: dgrnd_snow   !! Integration coefficient for snow numerical scheme
+!$OMP THREADPRIVATE(dgrnd_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: lambda_snow  !! Coefficient of the linear extrapolation of surface temperature 
+                                                                  !! from the first and second snow layers
+!$OMP THREADPRIVATE(lambda_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: temp_sol_add !! Additional energy to melt snow for snow ablation case (K)
+!$OMP THREADPRIVATE(temp_sol_add)
+
+  !+++CHECK+++
+  ! Variables defined in CN-CAN but no longer present in CN
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)        :: osfcmelt         !! Indicate snow melting in each gridcell
+!$OMP THREADPRIVATE(osfcmelt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: snowflx         !! Snow flux (W m^{-2})
+!$OMP THREADPRIVATE(snowflx)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: snowcap         !! Snow calorific capacity (J K^{-1])
+!$OMP THREADPRIVATE(snowcap)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: cgrnd_soil      !! matrix coefficient for the computation of soil, from thermosoil
+!$OMP THREADPRIVATE(cgrnd_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: dgrnd_soil      !! matrix coefficient for the computation of soil, from thermosoil
+!$OMP THREADPRIVATE(dgrnd_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: zdz1_soil       !! numerical constant from thermosoil
+!$OMP THREADPRIVATE(zdz1_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: zdz2_soil       !! numerical constant from thermosoil
+!$OMP THREADPRIVATE(zdz2_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: albedo_undersnow !! albedo under the snowpack
+!$OMP THREADPRIVATE(albedo_undersnow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pkappa_snow     !! snow thermal conductivity
+!$OMP THREADPRIVATE(pkappa_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: gthick          !! soil surface layer thickness
+!$OMP THREADPRIVATE(gthick)
+
+ !+++++++++++
+
+CONTAINS
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    sechiba_initialize
+!!
+!>\BRIEF	  Initialize all prinicipal modules by calling their "_initialize" subroutines
+!!
+!! DESCRIPTION:	  Initialize all prinicipal modules by calling their "_initialize" subroutines
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE sechiba_initialize( &
+       kjit,         kjpij,        kjpindex,     index,                   &
+       lalo,         contfrac,     neighbours,   resolution, zlev,        &
+       u,            v,            qair,         t2m,        temp_air,    &
+       petAcoef,     peqAcoef,     petBcoef,     peqBcoef,                &
+       precip_rain,  precip_snow,  lwdown,       swnet,      swdown,      &
+       pb,           rest_id,      hist_id,      hist2_id,                &
+       rest_id_stom, hist_id_stom, hist_id_stom_IPCC,                     &
+       coastalflow,  riverflow,    tsol_rad,     vevapp,       qsurf_out, &
+       z0m_out,      z0h_out,      albedo,       fluxsens,     fluxlat,      emis_out,  &
+       netco2flux,   fco2_lu,      temp_sol_new, tq_cdrag, coszang)
+
+!! 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),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,NbNeighb), INTENT(in):: neighbours        !! Neighboring grid points if land!(unitless)
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)          :: resolution        !! Size in x and y of the grid (m)
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u                 !! Lowest level wind speed in direction u 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: v                 !! Lowest level wind speed in direction v 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: zlev              !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair              !! Lowest level specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: t2m               !! 2m air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_rain       !! Rain precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_snow       !! Snow precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown            !! Down-welling long-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet             !! Net surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swdown            !! Down-welling surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_air          !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petAcoef          !! Coefficients A for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqAcoef          !! Coefficients A for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petBcoef          !! Coefficients B for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqBcoef          !! Coefficients B for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb                !! Surface pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: coszang           !! cosine of solar zenith angle
+
+
+!! 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)           :: z0m_out           !! Surface roughness momentum (output diagnostic, m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: z0h_out           !! Surface roughness heat (output diagnostic, m)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out)         :: albedo            !! Surface albedo for visible and near-infrared
+                                                                                  !! (unitless, 0-1)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxsens          !! Sensible heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxlat           !! Latent heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: emis_out          !! Emissivity (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: netco2flux        !! Sum CO2 flux over PFTs 
+                                                                                  !! ??(gC m^{-2} s^{-1})??
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fco2_lu           !! Land Cover Change CO2 flux 
+                                                                                  !! ??(gC m^{-2} s^{-1})??
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: temp_sol_new      !! New ground temperature (K)
+
+!! 0.3 Modified
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: tq_cdrag          !! Surface drag coefficient (-) 
+
+!! 0.4 Local variables
+    INTEGER(i_std)                                           :: ji, jv, ilev      !! Index (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: histvar           !! Computations for history files (unitless)
+    CHARACTER(LEN=80)                                        :: var_name          !! To store variables names for I/O (unitless)
+    REAL(r_std),DIMENSION (kjpindex)                         :: epot_air          !! Air potential energy (??J)
+    REAL(r_std),DIMENSION(nlevels_tot)                       :: Collim_Abs_Tot    !! collimated total absorption for a given level
+    REAL(r_std),DIMENSION(nlevels_tot)                       :: Collim_Alb_Tot    !! Collimated (direct) total albedo for a given level
+    REAL(r_std), DIMENSION(nlevels_tot,kjpindex,nvm)         :: laieff_collim     !! Leaf Area Index Effective for direct light
+    INTEGER(i_std)                                           :: init_config       !! Identifer of the configuration used to 
+                                                                                  !! initialize stomate/or sechiba
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) ' sechiba kjpindex =',kjpindex
+
+    !! 1. Initialize variables on first call
+    
+    !! 1.2 Initialize most of sechiba's variables
+    CALL sechiba_init (kjit, kjpij, kjpindex, index, rest_id, lalo)
+    
+    !! 1.3 Initialize stomate's variables
+    CALL slowproc_initialize (kjit,          kjpij,        kjpindex,                          &
+                              rest_id,       rest_id_stom, hist_id_stom,   hist_id_stom_IPCC, &
+                              index,         indexveg,     lalo,           neighbours,        &
+                              resolution,    contfrac,     t2m,                               &
+                              soiltile,      reinf_slope,  deadleaf_cover, assim_param,       &
+                              frac_age,      height,       veget,             &
+                              frac_nobio,    njsc,         veget_max,      tot_bare_soil,     &       
+                              totfrac_nobio, qsintmax,     co2_flux,       fco2_lu,           &
+                              temp_growth,   circ_class_biomass,   &
+                              circ_class_n,  lai_per_level,laieff_fit,     h_array_out,       &
+                              z_array_out,   max_height_store)
+
+
+    netco2flux(:) = zero
+    DO jv = 2,nvm
+       netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv)
+    ENDDO
+
+    !! 1.4 Initialize diffusion coefficients
+    CALL diffuco_initialize (kjit,    kjpindex, index,                  &
+                             rest_id, lalo,     neighbours, resolution, &
+                             rstruct, tq_cdrag)
+    
+    !! 1.5 Initialize remaining variables of energy budget
+    CALL enerbil_initialize (kjit,     kjpindex,     index,    rest_id,  &
+                             qair,                                       &
+                             temp_sol, temp_sol_new, tsol_rad,           &
+                             evapot,   evapot_corr,  qsurf,    fluxsens, &
+                             fluxlat,  vevapp )
+
+    !! 1.5 Initialize remaining variables of the multi-layer energy budget
+    ! CALL mleb_main
+
+    IF (ok_mleb) THEN
+       CALL mleb_initialize
+
+    END IF ! (ok_mleb)
+
+    !! do we need to call enerbill here... it is called in enerbil_main, but we might needs these variables
+    !! for the multi-layer energy budget. Maybe we should put all this in the ok_mleb if statement? asla, MERGE
+    !! it crashes... investigate further
+    !!CALL enerbil_begin (kjpindex, temp_sol, lwdown, swnet, pb, psold, qsol_sat, pdqsold, netrad, emis)
+
+       ! ---------------------------------------------------------------------------------
+
+       ! Initialise some variables for the multilayer energy budget
+       ! The temperature and specific humidity column for the first time step must also
+       ! have an initial value
+       ! The leaf temperature profile for the first time step (for the multi-level energy budget) 
+       ! must have an initial value, which we also set to the temperature of air (just for this
+       ! initial step)
+       DO ji = 1, kjpindex
+          temp_atmos_pres_grid(ji,:) = temp_air(ji)
+          q_atmos_pres_grid(ji,:) = qair(ji)
+          temp_leaf_pres_grid(ji,:) = temp_air(ji)     
+       END DO ! i = 1, kjpindex
+
+       ! The sechiba_hydrol_arch requires initialisation for swc, the soil water content.
+       swc(:,:,:) = 0.0d0
+       ksave(:,:,:)=min_sechiba
+
+       ! The 'ok_impose_can_structure' flag activates the sections of code which directly
+       ! link the energy budget scheme to the the size and LAI profile of the canopy for
+       ! the respective PFT and age class that is calculated in stomate, for the albedo.
+       ! If 'ok_impose_can_structure' is TRUE, and jnlvls > 1, then the model takes LAI
+       ! profile information and canopy level heights from the run.def.
+       ! If 'ok_impose_can_structure' is FALSE, and jnlvls > 1, then the profile infomation
+       ! and canopy levels heights comes from the PGap-based processes for calculation of
+       ! stand profile information in stomate.
+       ! If jnlvls=1, then the code behaves as for the single layer model.
+       ! Should we put this into the mleb if statement as well?? asla, MERGE
+
+       IF (.NOT. ok_impose_can_structure) THEN   
+     
+		   ! for enerbil nextstep initialisation
+	   
+		   ! we have a problem in that z_array_out has a value of zero on the first call 
+		   !   of slowproc_main (above), so we define z_array_out with temporary values.
+
+		   u_speed(:) = 0.0d0		   
+		   z_array_out(:,:,:,:) = 0.0d0		   
+		   h_array_out = 0.0d0                   		   
+		   collim_abs_tot(:) = 0.0d0
+		   Collim_Alb_Tot(:) = 0.0d0
+
+           ! Read in the initial maximum canopy height
+           !Config Key   = MAX_HEIGHT_STORE
+           !Config Desc  = 
+           !Config If    = OK_NEW_ENERBIL_NEXTSTEP
+           !Config Def   = 0.0
+           !Config Help  = 
+           !Config Units = [-]
+		   max_height_store(:,:) = 20.0d0
+           CALL getin_p('MAX_HEIGHT_STORE', max_height_store(:,:))
+
+       
+           DO ilev = 1, nlevels_tot
+         
+               z_array_out(:,:,:,ilev) = (REAL(ilev)-1.0d0) * (max_height_store(1,1)/REAL(nlevels_tot))
+
+           END DO ! i = 1, nlevels_tot
+		           
+      END IF ! IF (ok_impose_can_structure) 
+
+
+    ! ---------------------------------------------------------------------------------
+
+
+    !! 1.7 Initialize remaining hydrological variables
+    CALL hydrol_initialize ( kjit,           kjpindex,  index,         rest_id,          &
+         njsc,           soiltile,  veget,         veget_max,        &
+         humrel,         vegstress, drysoil_frac,                    &
+         shumdiag_perma, qsintveg,                                   &
+         evap_bare_lim,  snow,      snow_age,      snow_nobio,       &
+         snow_nobio_age, snowrho,   snowtemp,      snowgrain,        &
+         snowdz,         snowheat,  &
+         mc_layh,    mcl_layh,  tmc_layh)
+    
+
+    !! 1.9 Initialize surface parameters (emissivity, albedo and roughness)
+    CALL condveg_initialize (kjit, kjpindex, index, rest_id, &
+         lalo, neighbours, resolution, contfrac, &
+         veget, veget_max, frac_nobio, totfrac_nobio, &
+         zlev, snow, snow_age, snow_nobio, snow_nobio_age, &
+         drysoil_frac, height, snowdz,snowrho, tot_bare_soil, &
+         temp_air, pb, u, v, &
+         circ_class_biomass, circ_class_n, &
+         emis, albedo, z0m, z0h, roughheight, &
+         frac_snow_veg,frac_snow_nobio, &
+         coszang, &!z0_veg, &
+         Isotrop_Abs_Tot_p, Isotrop_Tran_Tot_p, laieff_fit, albedo_pft, &
+         Collim_Abs_Tot, Collim_Alb_Tot, laieff_collim, laieff_isotrop)
+    
+    !! 1.10 Initialization of soil thermodynamics
+    
+    CALL thermosoil_initialize (kjit, kjpindex, rest_id,  &
+         temp_sol_new, snow,       shumdiag_perma,        &
+         soilcap,      soilflx,    stempdiag,             &
+         gtemp,               &
+         mc_layh,  mcl_layh,   tmc_layh,       njsc ,     &
+         frac_snow_veg,frac_snow_nobio,totfrac_nobio,     &
+         snowdz, snowrho, snowtemp, lambda_snow, cgrnd_snow, dgrnd_snow, pb)
+
+
+    !! 1.12 Initialize river routing
+    IF ( river_routing .AND. nbp_glo .GT. 1) THEN
+       !! 1.12.1 Initialize river routing
+       CALL routing_initialize( kjit,        kjpindex,       index,                 &
+            rest_id,     hist_id,        hist2_id,   lalo,      &
+            neighbours,  resolution,     contfrac,   stempdiag, &
+            returnflow,  reinfiltration, irrigation, riverflow, &
+            coastalflow, flood_frac,     flood_res )
+    ELSE
+       !! 1.12.2 No routing, set variables to zero
+       riverflow(:) = zero
+       coastalflow(:) = zero
+       returnflow(:) = zero
+       reinfiltration(:) = zero
+       irrigation(:) = zero
+       flood_frac(:) = zero
+       flood_res(:) = zero
+
+       CALL xios_orchidee_send_field("coastalflow",coastalflow/dt_sechiba)  
+       CALL xios_orchidee_send_field("riverflow",riverflow/dt_sechiba)  
+
+    ENDIF
+    
+    !! 1.13 Write internal variables to output fields
+    z0m_out(:) = z0m(:)
+    z0h_out(:) = z0h(:)
+    emis_out(:) = emis(:) 
+    qsurf_out(:) = qsurf(:)
+    
+    !+++CHECK+++
+    !! 1.14 Set lai
+    !! I am not sure we need this at all?? asla, MERGE
+    lai(:,ibare_sechiba) = zero
+    DO jv = 2, nvm
+       DO ji = 1, kjpindex
+          lai(ji,jv) = cc_to_lai(circ_class_biomass(ji,jv,:,ileaf,icarbon),circ_class_n(ji,jv,:),jv)
+       ENDDO
+    ENDDO
+    !+++++++++++
+    
+  END SUBROUTINE sechiba_initialize
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_main
+!!
+!>\BRIEF        Main routine for the sechiba module performing three functions:
+!! calculating temporal evolution of all variables and preparation of output and 
+!! restart files (during the last call only)
+!!
+!!\n DESCRIPTION : Main routine for the sechiba module. 
+!! One time step evolution consists of:
+!! - call sechiba_var_init to do some initialization,
+!! - call slowproc_main to do some daily calculations
+!! - call diffuco_main for diffusion coefficient calculation,
+!! - call enerbil_main for energy budget calculation,
+!! - call 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) 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, &
+       & ldrestart_read, ldrestart_write, &
+       & lalo, contfrac, neighbours, resolution,&
+       & zlev, u, v, qair, q2m, t2m, temp_air, epot_air, ccanopy, &
+       & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+       & precip_rain, precip_snow, lwdown, swnet, swdown, coszang, pb, &
+       & vevapp, fluxsens, fluxlat, coastalflow, riverflow, netco2flux, fco2_lu, &
+       & tsol_rad, temp_sol_new, qsurf_out, albedo, emis_out, z0m_out, z0h_out,&
+       & 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)
+    LOGICAL, INTENT(in)                                      :: ldrestart_read    !! Logical for _restart_ file to read 
+                                                                                  !! (true/false)
+    LOGICAL, INTENT(in)                                      :: ldrestart_write   !! Logical for _restart_ file to write 
+                                                                                  !! (true/false)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)          :: lalo              !! Geographic coordinates (latitude,longitude)
+                                                                                  !! for grid cells (degrees)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: contfrac          !! Fraction of continent in the grid 
+                                                                                  !! (unitless, 0-1)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: index             !! Indices of the pixels on the map. 
+                                                                                  !! Sechiba uses a reduced grid excluding oceans
+                                                                                  !! ::index contains the indices of the 
+                                                                                  !! terrestrial pixels only! (unitless)
+    INTEGER(i_std), DIMENSION(kjpindex,NbNeighb), INTENT(in) :: neighbours        !! Neighboring grid points if land!(unitless)
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)          :: resolution        !! Size in x and y of the grid (m)
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u                 !! Lowest level wind speed in direction u 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: v                 !! Lowest level wind speed in direction v 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: zlev              !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair              !! Lowest level specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q2m               !! 2m specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: t2m               !! 2m air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_rain       !! Rain precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_snow       !! Snow precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown            !! Down-welling long-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: coszang           !! Cosine of the solar zenith angle (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet             !! Net surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swdown            !! Down-welling surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_air          !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air          !! Air potential energy (??J)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: ccanopy           !! CO2 concentration in the canopy (ppm)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petAcoef          !! Coefficients A for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqAcoef          !! Coefficients A for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petBcoef          !! Coefficients B for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqBcoef          !! Coefficients B for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb                !! Surface pressure (hPa)
+
+
+!! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), 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)           :: z0m_out           !! Surface roughness momentum (output diagnostic, m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: z0h_out           !! Surface roughness heat (output diagnostic, m)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out)         :: albedo            !! Surface albedo for visible and near-infrared
+                                                                                  !! (unitless, 0-1)
+    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 (-) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: temp_sol_new      !! New ground temperature (K)
+
+!! 0.4 local variables
+
+    INTEGER(i_std)                                           :: ji, jv, ilevel    !! Index (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: histvar           !! Computations for history files (unitless)
+    CHARACTER(LEN=80)                                        :: var_name          !! To store variables names for I/O (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_treefrac      !! Total fraction occupied by trees (0-1, uniless) 
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_grassfrac     !! Total fraction occupied by grasses (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_cropfrac      !! Total fraction occcupied by crops (0-1, unitess)
+    REAL(r_std),DIMENSION (kjpindex,nvm)                     :: tmc_pft           !! Total soil water per PFT (mm/m2) 
+    REAL(r_std),DIMENSION (kjpindex,nvm)                     :: drainage_pft     !! Drainage per PFT (mm/m2)   
+    REAL(r_std),DIMENSION (kjpindex,nvm)                     :: swc_pft          !! Relative Soil water content [tmcr:tmcs] per pft (-)    
+    REAL(r_std), DIMENSION(kjpindex)                         :: grndflux          !! Net energy into soil (W/m2)
+    REAL(r_std), DIMENSION(kjpindex,nsnow)                   :: snowliq           !! Liquid water content (m)
+    REAL(r_std), DIMENSION(nlevels_tot,kjpindex,nvm)        :: laieff_collim      !! Leaf Area Index Effective for direct light
+    REAL(r_std),DIMENSION(nlevels_tot)                      :: Collim_Abs_Tot     !! Collimated total absorption for a given level
+    REAL(r_std),DIMENSION(nlevels_tot)                      :: Collim_Alb_Tot     !! Collimated (direct) total albedo for a given level
+
+REAL(r_std), SAVE                                       :: temp_surf_pres        !! temperature at surface for the present timestep (K)
+!$OMP THREADPRIVATE(temp_surf_pres)
+    REAL(r_std), SAVE                                       :: temp_surf_next        !! temperature at surface for the next timestep (K)
+!$OMP THREADPRIVATE(temp_surf_next)
+    INTEGER, SAVE                                           :: james_step_count      !! $OMP THREADPRIVATE(james_step_count)
+!$OMP THREADPRIVATE(james_step_count)
+    REAL(r_std),DIMENSION (kjpindex)                        :: netrad_out            !! Net radiation flux add by YC 20140313
+
+! (for the merge)
+
+   REAL(r_std), DIMENSION(kjpindex)                        :: vbeta2sum             ! sum of vbeta2 coefficients across all PFTs (-)
+   REAL(r_std), DIMENSION(kjpindex)                        :: vbeta3sum             ! sum of vbeta3 coefficients across all PFTs (-)
+   REAL(r_std),DIMENSION (kjpindex,nvm)                    :: vbeta23               !! Beta for fraction of wetted foliage that will
+                                                                                    !! transpire once intercepted water has evaporated (-)
+   REAL(r_std), DIMENSION (kjpindex,nvm,nlai)              :: leaf_ci               !! intercellular CO2 concentration (ppm)
+   REAL(r_std), DIMENSION (kjpindex,nvm,nlevels_tot)       :: gs_distribution
+   REAL(r_std), DIMENSION (kjpindex,nvm,nlevels_tot)       :: gs_diffuco_output
+   REAL(r_std), DIMENSION (kjpindex,nvm,nlevels_tot)       :: gstot_component
+   REAL(r_std), DIMENSION (kjpindex,nvm,nlevels_tot)       :: gstot_frac
+   REAL(r_std), DIMENSION (nlevels_tot)                    :: u_speed               !! canopy wind speed profile
+
+
+   REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)        :: profile_vbeta3
+   REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)        :: profile_rveget
+
+   REAL(r_std)                                             :: flux_ground_h            ! sensible heat flux at surface (W^{m^2})
+   REAL(r_std)                                             :: flux_ground_le           ! latent heat flux at surface (W^{m^2})
+
+   INTEGER                                                 :: ilev,ivm,ipts  
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) ' sechiba kjpindex =',kjpindex
+    !! Initialize local printlev
+    !printlev_loc=get_printlev('sechiba')
+
+    !! 1. Initialize variables at each time step
+    CALL sechiba_var_init (kjpindex, rau, pb, temp_air) 
+
+    !! 2. Compute diffusion coefficients
+    CALL diffuco_main (kjit, kjpindex, &
+         & index, indexveg, indexlai, u, v, &
+         & zlev, z0m, z0h, roughheight, temp_sol, temp_air, &
+         & temp_growth, rau, tq_cdrag, qsurf, qair, &
+         & q2m, t2m, pb, evap_bare_lim, &
+         & evapot, evapot_corr, snow, flood_frac, flood_res, &
+         & frac_nobio, snow_nobio, totfrac_nobio, swnet, swdown, &
+         & coszang, ccanopy, humrel, vegstress, veget, &
+         & veget_max, circ_class_biomass, circ_class_n, qsintveg, qsintmax, assim_param, &
+         & vbeta, vbeta1, vbeta2, vbeta3, &
+         & vbeta3pot, vbeta4, vbeta5, gsmean, rveget, &
+         & rstruct, cimean, gpp, lalo, neighbours, &
+         & resolution, ptnlev1, precip_rain, frac_age, tot_bare_soil, &
+         & frac_snow_veg, frac_snow_nobio, &
+         & hist_id, hist2_id, vbeta2sum, vbeta3sum, Isotrop_Abs_Tot_p, &
+         & Isotrop_Tran_Tot_p, lai_per_level, vbeta23, leaf_ci, &
+         & gs_distribution, gs_diffuco_output, gstot_component, gstot_frac,&
+         & warnings, u_speed, profile_vbeta3, profile_rveget, &
+         & delta_c13_assim, leaf_ci_out)
+
+    IF ( ok_c13 ) THEN 
+                 
+      ! When there is no photosynthesis, carbon isotopic values is not calulated.  
+      ! Because daily mean of carbon isotopic value in ORCHIDEE contained night values,  
+      ! to avoide biased daily mean value by zeros, daily mean of carbon isotopic  
+      ! discriminations should be calculated only when there is photosynthesis 
+      
+      gpp_day(:,:) = zero 
+      
+      DO ipts = 1,kjpindex 
+        DO jv = 1,nvm 
+          IF (gpp(ipts,jv) .LT. min_sechiba) THEN 
+            gpp_day(ipts,jv) = zero 
+      
+          ELSE 
+            gpp_day(ipts,jv) = gpp_day(ipts,jv) + 1 
+           
+          END IF 
+        END DO 
+      END DO 
+    END IF 
+
+  !  !! 3. Compute energy balance
+  IF (ok_mleb) THEN
+
+        IF (printlev_loc>=4)THEN
+           DO ivm = 1,nvm
+              WRITE(numout,*) 'laieff_isotrop sechiba_main  for ivm', &
+              ivm,'is', laieff_isotrop(:,:,ivm)
+           ENDDO
+        ENDIF
+
+
+        CALL sechiba_mleb_hs( &
+            kjit,         kjpij,        kjpindex,     index,                   &
+            lalo,         contfrac,     neighbours,   resolution, zlev,        &
+            u,            v,            qair,         t2m,        temp_air,    &
+            petAcoef,     peqAcoef,     petBcoef,     peqBcoef,                &
+            precip_rain,  precip_snow,  lwdown,       swnet,      swdown,      &
+            pb,           rest_id,      hist_id,      hist2_id,                &
+            rest_id_stom, hist_id_stom, hist_id_stom_IPCC,                     &
+            fluxsens,     fluxlat,      temp_sol_new, tsol_rad,   vevapp,      &
+            vbeta2sum,    vbeta3sum,    tq_cdrag,   ldrestart_read,            &
+            ldrestart_write, epot_air,  flux_ground_h, flux_ground_le,         & 
+            temp_surf_pres, temp_surf_next, coszang, q2m, ccanopy, vbeta23,    &
+            leaf_ci, gs_distribution,   gs_diffuco_output, gstot_component,    &
+            gstot_frac)
+   ELSE ! (ok_mleb)
+        CALL enerbil_main (kjit, kjpindex, &
+            & index, indexveg, zlev, lwdown, swnet, epot_air, temp_air, u, v, &
+            & petAcoef, petBcoef, &
+            & qair, peqAcoef, peqBcoef, pb, rau, vbeta, vbeta1, &
+            & vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, &
+            & emis, soilflx, soilcap, tq_cdrag, humrel, fluxsens, fluxlat, &
+            & vevapp, transpir, transpot, vevapnu, vevapwet, vevapsno, vevapflo, &
+            & temp_sol, tsol_rad, &
+            & temp_sol_new, qsurf, evapot, evapot_corr, rest_id, hist_id, hist2_id, &
+            & precip_rain,  pgflux, snowdz, temp_sol_add)
+
+  END IF ! (ok_mleb)
+
+  !! 4. Compute hydrology
+  !! 4.1 Water balance from CWRR module (11 soil layers)
+  CALL hydrol_main (kjit, kjpindex, &
+       & index, indexveg, indexsoil, indexlayer, indexnbdl, &
+       & temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, &
+       & vevapwet, veget, veget_max, njsc, &
+       & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, &
+       & snow_nobio, snow_nobio_age,  &
+       & tot_melt, transpir, precip_rain, precip_snow, returnflow, &
+       & reinfiltration, irrigation, &
+       & humrel, vegstress, drysoil_frac, evapot, evapot_corr, evap_bare_lim, &
+       & flood_frac, flood_res, &
+       & shumdiag,shumdiag_perma, k_litt, litterhumdiag, soilcap, soiltile, reinf_slope,&
+       & rest_id, hist_id, hist2_id,&
+       & stempdiag, &
+       & temp_air, pb, u, v, tq_cdrag, swnet, pgflux, &
+       & snowrho, snowtemp, snowgrain, snowdz, snowheat, snowliq, &
+       & grndflux, gtemp, tot_bare_soil, &
+       & lambda_snow, cgrnd_snow, dgrnd_snow, temp_sol_add, &
+       & mc_layh, mcl_layh, tmc_layh, tmc_pft, drainage_pft, swc_pft, swc, ksave, &
+       & e_frac)
+
+                
+    !! 6. Compute surface variables (emissivity, albedo and roughness)
+    CALL condveg_main (kjit, kjpindex, index, rest_id, hist_id, hist2_id, &
+         lalo, neighbours, resolution, contfrac, &
+         veget, veget_max, frac_nobio, totfrac_nobio, &
+         zlev, snow, snow_age, snow_nobio, snow_nobio_age, &
+         drysoil_frac, height, snowdz, snowrho, tot_bare_soil, &
+         temp_air, pb, u, v, &
+         circ_class_biomass, circ_class_n,&
+         emis, albedo, z0m, z0h, roughheight, &
+         frac_snow_veg, frac_snow_nobio, coszang, &! z0_veg, & ! fromthe MERGE
+         Isotrop_Abs_Tot_p, Isotrop_Tran_Tot_p, laieff_fit, albedo_pft, &
+         Collim_Abs_Tot, Collim_Alb_Tot, laieff_collim, laieff_isotrop)
+
+        IF (printlev_loc>=4)THEN
+           DO ivm = 1,nvm
+              WRITE(numout,*) 'laieff_isotrop after condveg_main in sechiba_main  for ivm', &
+              ivm,'is', laieff_isotrop(:,:,ivm)
+           ENDDO
+        ENDIF
+
+    !! 7. Compute soil thermodynamics
+    CALL thermosoil_main (kjit, kjpindex, &
+         index, indexgrnd, &
+         temp_sol_new, snow, soilcap, soilflx, &
+         shumdiag_perma, stempdiag, ptnlev1, rest_id, hist_id, hist2_id, &
+         snowdz,snowrho,snowtemp,gtemp,pb,&
+         mc_layh, mcl_layh, tmc_layh, njsc, frac_snow_veg, &
+         frac_snow_nobio, totfrac_nobio, temp_sol_add, &
+         lambda_snow, cgrnd_snow, dgrnd_snow)
+
+
+    !! 8. Compute river routing 
+    IF ( river_routing .AND. nbp_glo .GT. 1) THEN
+       !! 8.1 River routing
+       CALL routing_main (kjit, kjpindex, index, &
+            & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, floodout, runoff, &
+            & drainage, transpot, precip_rain, humrel, k_litt, flood_frac, flood_res, &
+            & stempdiag, reinf_slope, returnflow, reinfiltration, irrigation, riverflow, coastalflow, rest_id, hist_id, hist2_id)
+    ELSE
+       !! 8.2 No routing, set variables to zero
+       riverflow(:) = zero
+       coastalflow(:) = zero
+       returnflow(:) = zero
+       reinfiltration(:) = zero
+       irrigation(:) = zero
+       flood_frac(:) = zero
+       flood_res(:) = zero
+    ENDIF
+
+    !! 9. Compute slow processes (i.e. 'daily' and annual time step)
+    CALL slowproc_main (kjit, kjpij, kjpindex, &
+         index, indexveg, lalo, neighbours, &
+         resolution, contfrac, soiltile,  &
+         temp_air, temp_sol, stempdiag, vegstress, &
+         shumdiag, litterhumdiag, precip_rain, precip_snow, &
+         pb, gpp, tmc_pft, drainage_pft, swc_pft, &
+         deadleaf_cover, assim_param, frac_age, &
+         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, temp_growth, & 
+         tot_bare_soil, circ_class_biomass, circ_class_n, &
+         lai_per_level, max_height_store, laieff_fit, &
+         h_array_out, z_array_out, transpir, transpir_mod, &
+         transpir_supply, vir_transpir_supply, coszang, &
+         stressed, unstressed, isotrop_tran_tot_p, &
+         u, v)
+
+    !#481
+    !WRITE(numout,*) 'AHAAA: after slowproc_main veget_max', veget_max(:,1)
+
+    !! 9.2 Compute global CO2 flux
+    netco2flux(:) = zero
+    DO jv = 2,nvm
+       netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv)
+    ENDDO
+ 
+    !! 10. Update the temperature (temp_sol) with newly computed values
+    CALL sechiba_end (kjpindex, temp_sol_new, temp_sol)
+
+    !! 11. Write internal variables to output fields
+    z0m_out(:) = z0m(:)
+    z0h_out(:) = z0h(:)
+    emis_out(:) = emis(:)
+    qsurf_out(:) = qsurf(:)
+ 
+    !! 12. Write global variables to history files
+    sum_treefrac(:) = zero
+    sum_grassfrac(:) = zero
+    sum_cropfrac(:) = zero
+    DO jv = 2, nvm 
+       IF (is_tree(jv) .AND. natural(jv)) THEN
+          sum_treefrac(:) = sum_treefrac(:) + veget_max(:,jv)
+       ELSE IF ((.NOT. is_tree(jv))  .AND. natural(jv)) THEN
+          sum_grassfrac(:) = sum_grassfrac(:) + veget_max(:,jv)
+       ELSE 
+          sum_cropfrac = sum_cropfrac(:) + veget_max(:,jv)
+       ENDIF
+    ENDDO          
+
+    CALL xios_orchidee_send_field("evapnu",vevapnu*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("snow",snow)
+    CALL xios_orchidee_send_field("snowage",snow_age)
+    CALL xios_orchidee_send_field("snownobio",snow_nobio)
+    CALL xios_orchidee_send_field("snownobioage",snow_nobio_age)
+    CALL xios_orchidee_send_field("frac_snow", SUM(frac_snow_nobio,2)*totfrac_nobio+frac_snow_veg*(1-totfrac_nobio))
+    CALL xios_orchidee_send_field("frac_snow_veg", frac_snow_veg)
+    CALL xios_orchidee_send_field("frac_snow_nobio", frac_snow_nobio)
+    CALL xios_orchidee_send_field("pgflux",pgflux)
+    CALL xios_orchidee_send_field("reinf_slope",reinf_slope)
+    CALL xios_orchidee_send_field("njsc",REAL(njsc, r_std))
+    CALL xios_orchidee_send_field("vegetfrac",veget)
+    CALL xios_orchidee_send_field("maxvegetfrac",veget_max)
+    CALL xios_orchidee_send_field("nobiofrac",frac_nobio)
+    CALL xios_orchidee_send_field("soiltile",soiltile)
+    CALL xios_orchidee_send_field("rstruct",rstruct)
+    CALL xios_orchidee_send_field("gpp",gpp/dt_sechiba)
+    CALL xios_orchidee_send_field("nee",co2_flux/dt_sechiba)
+    CALL xios_orchidee_send_field("drysoil_frac",drysoil_frac)
+    CALL xios_orchidee_send_field("evapflo",vevapflo*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("evapflo_alma",vevapflo/dt_sechiba)
+    CALL xios_orchidee_send_field("k_litt",k_litt)
+    CALL xios_orchidee_send_field("beta",vbeta)
+    CALL xios_orchidee_send_field("vbeta1",vbeta1)
+    CALL xios_orchidee_send_field("vbeta2",vbeta2)
+    CALL xios_orchidee_send_field("vbeta3",vbeta3)
+    CALL xios_orchidee_send_field("vbeta4",vbeta4)
+    CALL xios_orchidee_send_field("vbeta5",vbeta5)
+    CALL xios_orchidee_send_field("gsmean",gsmean)
+    CALL xios_orchidee_send_field("cimean",cimean)
+    CALL xios_orchidee_send_field("rveget",rveget)
+ 
+    histvar(:)=SUM(vevapwet(:,:),dim=2)
+    CALL xios_orchidee_send_field("evspsblveg",histvar/dt_sechiba)
+    histvar(:)= vevapnu(:)+vevapsno(:)
+    CALL xios_orchidee_send_field("evspsblsoi",histvar/dt_sechiba)
+    histvar(:)=SUM(transpir(:,:),dim=2)
+    CALL xios_orchidee_send_field("tran",histvar/dt_sechiba)
+    histvar(:)= sum_treefrac(:)*100*contfrac(:)
+    CALL xios_orchidee_send_field("treeFrac",histvar)
+    histvar(:)= sum_grassfrac(:)*100*contfrac(:)
+    CALL xios_orchidee_send_field("grassFrac",histvar)
+    histvar(:)= sum_cropfrac(:)*100*contfrac(:)
+    CALL xios_orchidee_send_field("cropFrac",histvar)
+    histvar(:)=veget_max(:,1)*100*contfrac(:)
+    CALL xios_orchidee_send_field("baresoilFrac",histvar)
+    histvar(:)=SUM(frac_nobio(:,1:nnobio),dim=2)*100*contfrac(:)
+    CALL xios_orchidee_send_field("residualFrac",histvar)
+
+    CALL xios_orchidee_send_field("tsol_rad",tsol_rad-273.15)
+    CALL xios_orchidee_send_field("qsurf",qsurf)
+    CALL xios_orchidee_send_field("emis",emis)
+    CALL xios_orchidee_send_field("z0m",z0m)
+    CALL xios_orchidee_send_field("z0h",z0h)
+    CALL xios_orchidee_send_field("roughheight",roughheight)
+
+    ! calculate lai and laimean (pixel including no_bio)
+    lai(:,ibare_sechiba) = zero
+    histvar(:)=zero   
+    DO ji = 1, kjpindex
+       IF (SUM(veget_max(ji,:)) > zero) THEN
+         DO jv=2,nvm
+            lai(ji,jv) = cc_to_lai(circ_class_biomass(ji,jv,:,ileaf,icarbon),&
+                 circ_class_n(ji,jv,:),jv)
+            histvar(ji) = histvar(ji) + veget_max(ji,jv)*lai(ji,jv)/ &
+                 SUM(veget_max(ji,:))
+         END DO
+       END IF
+    END DO
+    CALL xios_orchidee_send_field("lai",lai)
+    CALL xios_orchidee_send_field("LAImean",histvar) 
+
+    CALL xios_orchidee_send_field("vevapsno",vevapsno/dt_sechiba) 
+    CALL xios_orchidee_send_field("vevapp",vevapp/dt_sechiba) 
+    CALL xios_orchidee_send_field("vevapnu",vevapnu*one_day/dt_sechiba) 
+    CALL xios_orchidee_send_field("vevapnu_alma",vevapnu/dt_sechiba) 
+    CALL xios_orchidee_send_field("transpir",transpir*one_day/dt_sechiba) 
+    CALL xios_orchidee_send_field("inter",vevapwet*one_day/dt_sechiba) 
+    histvar(:)=zero 
+    DO jv=1,nvm
+      histvar(:) = histvar(:) + vevapwet(:,jv)
+    ENDDO
+    CALL xios_orchidee_send_field("ECanop",histvar/dt_sechiba)
+    histvar(:)=zero
+    DO jv=1,nvm
+      histvar(:) = histvar(:) + transpir(:,jv)
+    ENDDO
+    CALL xios_orchidee_send_field("TVeg",histvar/dt_sechiba)
+    CALL xios_orchidee_send_field("ACond",tq_cdrag)
+
+    IF ( .NOT. almaoutput ) THEN
+       ! Write history file in IPSL-format
+       CALL histwrite_p(hist_id, 'beta', kjit, vbeta, kjpindex, index)
+       CALL histwrite_p(hist_id, 'z0m', kjit, z0m, kjpindex, index)
+       CALL histwrite_p(hist_id, 'z0h', kjit, z0h, kjpindex, index)
+       CALL histwrite_p(hist_id, 'roughheight', kjit, roughheight, kjpindex, index)
+       CALL histwrite_p(hist_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+
+       ! calculate lai and laimean (pixel including no_bio fraction)
+       lai(:,ibare_sechiba) = zero
+       histvar(:)=zero   
+       DO ji = 1, kjpindex
+          IF (SUM(veget_max(ji,:)) > zero) THEN
+             DO jv=2,nvm
+                lai(ji,jv) = cc_to_lai(circ_class_biomass(ji,jv,:,ileaf,icarbon),&
+                     circ_class_n(ji,jv,:),jv)
+                histvar(ji) = histvar(ji) + veget_max(ji,jv)*lai(ji,jv)/ &
+                     SUM(veget_max(ji,:))
+             END DO
+          END IF
+       END DO
+       CALL histwrite_p(hist_id, 'lai', kjit, lai, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'LAImean', kjit, histvar, kjpindex, index)
+
+       CALL histwrite_p(hist_id, 'subli', kjit, vevapsno, kjpindex, index)
+       CALL histwrite_p(hist_id, 'evapnu', kjit, vevapnu, kjpindex, index)
+       CALL histwrite_p(hist_id, 'transpir', kjit, transpir, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'inter', kjit, vevapwet, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'vbeta1', kjit, vbeta1, kjpindex, index)
+       CALL histwrite_p(hist_id, 'vbeta2', kjit, vbeta2, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'vbeta3', kjit, vbeta3, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'vbeta4', kjit, vbeta4, kjpindex, index)    
+       CALL histwrite_p(hist_id, 'vbeta5', kjit, vbeta5, kjpindex, index)    
+       CALL histwrite_p(hist_id, 'drysoil_frac', kjit, drysoil_frac, kjpindex, index)
+       CALL histwrite_p(hist_id, 'rveget', kjit, rveget, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'rstruct', kjit, rstruct, kjpindex*nvm, indexveg)
+
+       CALL histwrite_p(hist_id, 'snow', kjit, snow, kjpindex, index)
+       CALL histwrite_p(hist_id, 'snowage', kjit, snow_age, kjpindex, index)
+       CALL histwrite_p(hist_id, 'snownobio', kjit, snow_nobio, kjpindex*nnobio, indexnobio)
+       CALL histwrite_p(hist_id, 'snownobioage', kjit, snow_nobio_age, kjpindex*nnobio, indexnobio)
+
+       CALL histwrite_p(hist_id, 'grndflux', kjit, grndflux, kjpindex,index)
+       CALL histwrite_p(hist_id, 'snowtemp',kjit,snowtemp,kjpindex*nsnow,indexsnow)
+       CALL histwrite_p(hist_id, 'snowliq', kjit,snowliq,kjpindex*nsnow,indexsnow)
+       CALL histwrite_p(hist_id, 'snowdz', kjit,snowdz,kjpindex*nsnow,indexsnow)
+       CALL histwrite_p(hist_id, 'snowrho', kjit,snowrho,kjpindex*nsnow,indexsnow)
+       CALL histwrite_p(hist_id, 'snowgrain',kjit,snowgrain,kjpindex*nsnow,indexsnow)
+       CALL histwrite_p(hist_id, 'snowheat',kjit,snowheat,kjpindex*nsnow,indexsnow)
+       
+       CALL histwrite_p(hist_id,'frac_snow_veg',kjit,frac_snow_veg,kjpindex,index)
+       CALL histwrite_p(hist_id, 'frac_snow_nobio', kjit,frac_snow_nobio,kjpindex*nnobio, indexnobio)
+       CALL histwrite_p(hist_id, 'pgflux',kjit,pgflux,kjpindex,index)
+       CALL histwrite_p(hist_id, 'soiltile',  kjit, soiltile, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'soilindex',  kjit, REAL(njsc, r_std), kjpindex, index)
+       CALL histwrite_p(hist_id, 'reinf_slope',  kjit, reinf_slope, kjpindex, index)
+       CALL histwrite_p(hist_id, 'k_litt', kjit, k_litt, kjpindex, index)
+       
+       IF ( do_floodplains ) THEN
+          CALL histwrite_p(hist_id, 'evapflo', kjit, vevapflo, kjpindex, index)
+          CALL histwrite_p(hist_id, 'flood_frac', kjit, flood_frac, kjpindex, index)
+       ENDIF
+       CALL histwrite_p(hist_id, 'gsmean', kjit, gsmean, kjpindex*nvm, indexveg)    
+       CALL histwrite_p(hist_id, 'gpp', kjit, gpp, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'cimean', kjit, cimean, kjpindex*nvm, indexveg)    
+       IF ( ok_stomate ) THEN
+          CALL histwrite_p(hist_id, 'nee', kjit, co2_flux, kjpindex*nvm, indexveg)    
+       ENDIF
+       IF ( ok_c13 ) THEN 
+          CALL histwrite_p(hist_id, 'delta_c13_assim', kjit, delta_c13_assim, & 
+          kjpindex*nvm, indexveg) 
+          CALL histwrite_p(hist_id, 'leaf_ci_out', kjit, leaf_ci_out, kjpindex*nvm, & 
+          indexveg) 
+          CALL histwrite_p(hist_id, 'gpp_day', kjit, gpp_day, kjpindex*nvm, & 
+          indexveg)             
+       ENDIF
+
+       histvar(:)=SUM(vevapwet(:,:),dim=2)
+       CALL histwrite_p(hist_id, 'evspsblveg', kjit, histvar, kjpindex, index)
+
+       histvar(:)= vevapnu(:)+vevapsno(:)
+       CALL histwrite_p(hist_id, 'evspsblsoi', kjit, histvar, kjpindex, index)
+
+       histvar(:)=SUM(transpir(:,:),dim=2)
+       CALL histwrite_p(hist_id, 'tran', kjit, histvar, kjpindex, index)
+
+       histvar(:)= sum_treefrac(:)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'treeFrac', kjit, histvar, kjpindex, index) 
+
+       histvar(:)= sum_grassfrac(:)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'grassFrac', kjit, histvar, kjpindex, index) 
+
+       histvar(:)= sum_cropfrac(:)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'cropFrac', kjit, histvar, kjpindex, index)
+
+       histvar(:)=veget_max(:,1)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'baresoilFrac', kjit, histvar, kjpindex, index)
+
+       histvar(:)=SUM(frac_nobio(:,1:nnobio),dim=2)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'residualFrac', kjit, histvar, kjpindex, index)
+    ELSE
+       ! Write history file in ALMA format 
+       CALL histwrite_p(hist_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+   
+       ! calculate lai
+       lai(:,ibare_sechiba) = zero  
+       DO ji = 1, kjpindex
+          DO jv=2,nvm
+             lai(ji,jv) = cc_to_lai(circ_class_biomass(ji,jv,:,ileaf,icarbon),&
+                  circ_class_n(ji,jv,:),jv)
+          END DO
+       END DO
+       CALL histwrite_p(hist_id, 'lai', kjit, lai, kjpindex*nvm, indexveg)
+       
+       CALL histwrite_p(hist_id, 'ESoil', kjit, vevapnu, kjpindex, index)
+       CALL histwrite_p(hist_id, 'EWater', kjit, vevapflo, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SWE', kjit, snow, kjpindex, index)
+       histvar(:)=zero
+       DO jv=1,nvm
+          histvar(:) = histvar(:) + transpir(:,jv)
+       ENDDO
+       CALL histwrite_p(hist_id, 'TVeg', kjit, histvar, kjpindex, index)
+       histvar(:)=zero
+       DO jv=1,nvm
+          histvar(:) = histvar(:) + vevapwet(:,jv)
+       ENDDO
+       CALL histwrite_p(hist_id, 'ECanop', kjit, histvar, kjpindex, index)
+       CALL histwrite_p(hist_id, 'ACond', kjit, tq_cdrag, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SnowFrac', kjit, vbeta1, kjpindex, index)
+       !
+       CALL histwrite_p(hist_id, 'Z0m', kjit, z0m, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Z0h', kjit, z0h, kjpindex, index)
+       CALL histwrite_p(hist_id, 'EffectHeight', kjit, roughheight, kjpindex, index)
+       !
+       IF ( do_floodplains ) THEN
+          CALL histwrite_p(hist_id, 'Qflood', kjit, vevapflo, kjpindex, index)
+          CALL histwrite_p(hist_id, 'FloodFrac', kjit, flood_frac, kjpindex, index)
+       ENDIF
+       !
+       CALL histwrite_p(hist_id, 'gsmean', kjit, gsmean, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'cimean', kjit, cimean, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'GPP', kjit, gpp, kjpindex*nvm, indexveg)
+       
+       IF ( ok_stomate ) THEN
+             CALL histwrite_p(hist_id, 'NEE', kjit, co2_flux, kjpindex*nvm, indexveg)    
+       ENDIF
+    ENDIF ! almaoutput
+    
+    !! 13. Write additional output file with higher frequency
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          WRITE(numout,*)'vbeta, what is happening',vbeta
+          ! Write history file in IPSL-format
+          CALL histwrite_p(hist2_id, 'tsol_rad', kjit, tsol_rad, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'qsurf', kjit, qsurf, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'albedo', kjit, albedo, kjpindex*2, indexalb)
+          CALL histwrite_p(hist2_id, 'emis', kjit, emis, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'beta', kjit, vbeta, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'z0m', kjit, z0m, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'z0h', kjit, z0h, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'roughheight', kjit, roughheight, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+
+          ! calculate lai
+          lai(:,ibare_sechiba) = zero  
+          DO ji = 1, kjpindex
+             DO jv=2,nvm
+                lai(ji,jv) = cc_to_lai(circ_class_biomass(ji,jv,:,ileaf,icarbon),&
+                     circ_class_n(ji,jv,:),jv)
+             END DO
+          END DO
+          CALL histwrite_p(hist2_id, 'lai', kjit, lai, kjpindex*nvm, indexveg)
+          
+          CALL histwrite_p(hist2_id, 'subli', kjit, vevapsno, kjpindex, index)
+          IF ( do_floodplains ) THEN
+             CALL histwrite_p(hist2_id, 'vevapflo', kjit, vevapflo, kjpindex, index)
+             CALL histwrite_p(hist2_id, 'flood_frac', kjit, flood_frac, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'vevapnu', kjit, vevapnu, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'transpir', kjit, transpir, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'inter', kjit, vevapwet, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'vbeta1', kjit, vbeta1, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'vbeta2', kjit, vbeta2, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'vbeta3', kjit, vbeta3, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'vbeta4', kjit, vbeta4, kjpindex, index)    
+          CALL histwrite_p(hist2_id, 'vbeta5', kjit, vbeta5, kjpindex, index)    
+          CALL histwrite_p(hist2_id, 'drysoil_frac', kjit, drysoil_frac, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'rveget', kjit, rveget, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'rstruct', kjit, rstruct, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'snow', kjit, snow, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'snowage', kjit, snow_age, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'snownobio', kjit, snow_nobio, kjpindex*nnobio, indexnobio)
+          CALL histwrite_p(hist2_id, 'snownobioage', kjit, snow_nobio_age, kjpindex*nnobio, indexnobio)
+
+          CALL histwrite_p(hist2_id, 'soilindex',  kjit, REAL(njsc, r_std), kjpindex, index)
+          CALL histwrite_p(hist2_id, 'reinf_slope',  kjit, reinf_slope, kjpindex, index)
+          
+          IF (ok_hydrol_arch) THEN
+              CALL histwrite_p(hist2_id, 'transpir_supply', kjit,transpir_supply, kjpindex*nvm, indexveg)
+          ENDIF
+
+          CALL histwrite_p(hist2_id, 'gsmean', kjit, gsmean, kjpindex*nvm, indexveg)    
+          CALL histwrite_p(hist2_id, 'gpp', kjit, gpp, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'cimean', kjit, cimean, kjpindex*nvm, indexveg)    
+          
+          IF ( ok_stomate ) THEN
+             CALL histwrite_p(hist2_id, 'nee', kjit, co2_flux, kjpindex*nvm, indexveg)    
+          ENDIF
+       ELSE
+          ! Write history file in ALMA format
+          CALL histwrite_p(hist2_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+          CALL histwrite_p(hist2_id, 'ESoil', kjit, vevapnu, kjpindex, index)
+          IF ( do_floodplains ) THEN
+             CALL histwrite_p(hist2_id, 'EWater', kjit, vevapflo, kjpindex, index)
+             CALL histwrite_p(hist2_id, 'FloodFrac', kjit, flood_frac, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'SWE', kjit, snow, kjpindex, index)
+          histvar(:)=zero
+          DO jv=1,nvm
+             histvar(:) = histvar(:) + transpir(:,jv)
+          ENDDO
+          CALL histwrite_p(hist2_id, 'TVeg', kjit, histvar, kjpindex, index)
+          histvar(:)=zero
+          DO jv=1,nvm
+             histvar(:) = histvar(:) + vevapwet(:,jv)
+          ENDDO
+          CALL histwrite_p(hist2_id, 'ECanop', kjit, histvar, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'ACond', kjit, tq_cdrag, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SnowFrac', kjit, vbeta1, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'GPP', kjit, gpp, kjpindex*nvm, indexveg)
+          
+          IF ( ok_stomate ) THEN
+             CALL histwrite_p(hist2_id, 'NEE', kjit, co2_flux, kjpindex*nvm, indexveg)    
+          ENDIF
+       ENDIF ! almaoutput
+    ENDIF ! hist2_id
+
+    !#481
+    !WRITE(numout,*) 'AHAAA: before slowproc_change_frac veget_max', veget_max(:,1)
+
+    !! Change the vegetation fractions if a new map was read in slowproc. 
+    !  This is done after lcchange has been done in stomatelpj
+    IF (done_stomate_lcchange) THEN
+       CALL slowproc_change_frac(kjpindex, veget_max, veget, &
+            frac_nobio, totfrac_nobio, tot_bare_soil, soiltile, &
+            circ_class_biomass, circ_class_n, lai_per_level,&
+            z_array_out)
+       done_stomate_lcchange=.FALSE.
+    END IF
+
+    !#481
+    !WRITE(numout,*) 'AHAAA: before sechiba_finalize veget_max', veget_max(:,1)
+    
+    !! 14. If it is the last time step, write restart files
+    IF (ldrestart_write) THEN
+       CALL sechiba_finalize( &
+            kjit,     kjpij,  kjpindex, index,   rest_id, &
+            tq_cdrag, vevapp, fluxsens, fluxlat, tsol_rad, &
+            veget_max)
+    END IF
+
+  END SUBROUTINE sechiba_main
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    sechiba_mleb_hs
+!!
+!>\BRIEF:	      call the relevant modules for the multi-layer energy budget and hydraulic stress
+!!
+!! DESCRIPTION:	  call the relevant modules for the multi-layer energy budget and hydraulic stress
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE sechiba_mleb_hs( &
+       kjit,         kjpij,        kjpindex,     index,                   &
+       lalo,         contfrac,     neighbours,   resolution, zlev,        &
+       u,            v,            qair,         t2m,        temp_air,    &
+       petAcoef,     peqAcoef,     petBcoef,     peqBcoef,                &
+       precip_rain,  precip_snow,  lwdown,       swnet,      swdown,      &
+       pb,           rest_id,      hist_id,      hist2_id,                &
+       rest_id_stom, hist_id_stom, hist_id_stom_IPCC,                     &
+       fluxsens,     fluxlat,      temp_sol_new, tsol_rad,   vevapp,      &
+       vbeta2sum,    vbeta3sum,    tq_cdrag,     ldrestart_read,          &
+       ldrestart_write, epot_air,  flux_ground_h, flux_ground_le,         &
+       temp_surf_pres, temp_surf_next, sinang, q2m, ccanopy, vbeta23,     &
+       leaf_ci, gs_distribution, gs_diffuco_output, gstot_component,      &
+       gstot_frac)
+
+
+!! 0.1 Input variables    
+
+!! 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),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)
+
+    LOGICAL, INTENT(in)                                      :: ldrestart_read    !! Logical for _restart_ file to read 
+                                                                                  !! (true/false)
+    LOGICAL, INTENT(in)                                      :: ldrestart_write   !! Logical for _restart_ file to write 
+    INTEGER(i_std), DIMENSION (kjpindex,8), INTENT(in)       :: neighbours        !! Neighboring grid points if land!(unitless)
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)          :: resolution        !! Size in x and y of the grid (m)
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u                 !! Lowest level wind speed in direction u 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: v                 !! Lowest level wind speed in direction v 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: zlev              !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair              !! Lowest level specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: t2m               !! 2m air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_rain       !! Rain precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_snow       !! Snow precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown            !! Down-welling long-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet             !! Net surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swdown            !! Down-welling surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_air          !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petAcoef          !! Coefficients A for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqAcoef          !! Coefficients A for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petBcoef          !! Coefficients B for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqBcoef          !! Coefficients B for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb                !! Surface pressure (hPa)
+
+    REAL(r_std),DIMENSION (kjpindex)                         :: tq_cdrag          !! Surface drag coefficient (-) 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex 
+    REAL(r_std),DIMENSION (kjpindex)                         :: temp_sol_new      !! New ground temperature (K)
+
+    REAL(r_std),DIMENSION (kjpindex)                         :: tsol_rad          !! Radiative surface temperature 
+                                                                                  !! @tex $(W m^{-2})$ @endtex 
+
+    REAL(r_std), DIMENSION(kjpindex)                         :: vbeta2sum         !! sum of vbeta2 coefficients across all PFTs (-)
+    REAL(r_std), DIMENSION(kjpindex)                         :: vbeta3sum         !! sum of vbeta3 coefficients across all PFTs (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air          !! Air potential energy (??J)
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: sinang            !! Sine of the solar angle (unitless)
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q2m               !! 2m specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: ccanopy           !! CO2 concentration in the canopy (ppm)
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: vbeta23           !! Beta for fraction of wetted foliage that will
+                                                                                  !! transpire once intercepted water has evaporated (-)
+    REAL(r_std), DIMENSION (kjpindex,nvm,nlai), INTENT(in)   :: leaf_ci           !! intercellular CO2 concentration (ppm)
+
+    REAL(r_std), DIMENSION (kjpindex,nvm,nlevels_tot), INTENT(in)       :: gs_distribution
+    REAL(r_std), DIMENSION (kjpindex,nvm,nlevels_tot), INTENT(in)       :: gs_diffuco_output
+    REAL(r_std), DIMENSION (kjpindex,nvm,nlevels_tot), INTENT(in)       :: gstot_component
+    REAL(r_std), DIMENSION (kjpindex,nvm,nlevels_tot), INTENT(in)       :: gstot_frac
+
+    REAL(r_std)                                              :: flux_ground_h     !! sensible heat flux at surface (W^{m^2})
+    REAL(r_std)                                              :: flux_ground_le    !! latent heat flux at surface (W^{m^2})
+
+    REAL(r_std)                                              :: temp_surf_pres    !! temperature at surface for the present timestep (K)
+    REAL(r_std)                                              :: temp_surf_next    !! temperature at surface for the next timestep (K)
+    INTEGER(i_std)                                           :: james_step_count  !! james_step_count
+
+    REAL(r_std),DIMENSION (kjpindex)                         :: netrad_out        !! Net radiation flux add by YC 20140313
+
+!! 0.2 Output variables
+
+!! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: fluxsens          !! Sensible heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: fluxlat           !! Latent heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: vevapp            !! Total of evaporation 
+                                                                                  !! @tex $(kg m^{-2} days^{-1})$ @endtex
+
+!! 0.4 Local variables
+    ! variables introduced as a consequence of running enerbil twice (if needed, as a result of restriction of transpiration by
+    !    the supply term). If running for the second time, we should start with the same input variables as the first run
+    
+    INTEGER(i_std)                           :: ji, jv
+    REAL(r_std), DIMENSION (kjpindex)        :: evapot_save           !! Soil Potential Evaporation (mm day^{-1})
+    REAL(r_std), DIMENSION (kjpindex)        :: evapot_corr_save      !! Soil Potential Evaporation Correction (mm day^{-1})
+    REAL(r_std), DIMENSION (kjpindex)        :: temp_sol_save         !! Soil temperature (K)
+    REAL(r_std), DIMENSION (kjpindex)        :: qsurf_save            !! Surface specific humidity (kg kg^{-1})     
+    REAL(r_std), DIMENSION (kjpindex)        :: fluxsens_save         !! Sensible heat flux (W m^{-2})
+    REAL(r_std), DIMENSION (kjpindex)        :: fluxlat_save          !! Latent heat flux (W m^{-2})
+    REAL(r_std), DIMENSION (kjpindex)        :: tsol_rad_save         !! Tsol_rad (W m^{-2})
+    REAL(r_std), DIMENSION (kjpindex)        :: vevapp_save           !! Total of evaporation (mm day^{-1})
+    REAL(r_std), DIMENSION (kjpindex,nvm)    :: gpp_save              !! Assimilation ((gC m^{-2}), total area)     
+    REAL(r_std), DIMENSION (kjpindex)        :: temp_sol_new_save     !! New soil temperature (K)
+    REAL(r_std), DIMENSION (kjpindex)        :: vbeta2sum_save        !! sum of vbeta2 coefficients across all PFTs (-)
+    REAL(r_std), DIMENSION (kjpindex)        :: vbeta3sum_save        !! sum of vbeta3 coefficients across all PFTs (-)
+    REAL(r_std), DIMENSION (kjpindex,nvm)    :: vbeta3_save           !! Beta for Transpiration (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm)    :: vbeta3pot_save        !! Beta for Potential Transpiration
+    REAL(r_std), DIMENSION (kjpindex,nvm)    :: rveget_save           !! stomatal resistance of vegetation 
+    REAL(r_std), DIMENSION (kjpindex,nvm)    :: rstruct_save          !! structural resistance @tex ($s m^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nvm)    :: cimean_save           !! mean intercellular CO2 concentration
+    REAL(r_std), DIMENSION (kjpindex,nvm)    :: gsmean_save           !! mean stomatal conductance to CO2 (umol m-2 s-1)
+   ! REAL(r_std), DIMENSION (kjpindex,nvm)   :: gpp_save
+    REAL(r_std), DIMENSION (kjpindex)        :: qsol_sat_new_out      !! New saturated surface air moisture (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex)         :: qair_new
+    REAL(r_std),DIMENSION (kjpindex)         :: delta_temp_save
+    REAL(r_std), DIMENSION (kjpindex,nvm)    :: vbeta3_oldvalue
+    REAL(r_std), DIMENSION (kjpindex)        :: vbeta3_save_test
+    
+    REAL(r_std), DIMENSION (kjpindex,nvm)    :: transpir_init         !! Temperate storage variable for the transpiration before limited by transpiration supply  
+  !  REAL(r_std),DIMENSION(kjpindex,nvm,nlevels_tot)    :: z_array3      !! Same as z_array, but one less dimension.
+  !                                                                     !! @tex $(m)$ @endte
+
+    REAL(r_std), DIMENSION(nlevels_tot,kjpindex,nvm)        :: laieff_collim          !! (FROM STOMATE) Leaf Area Index Effective for direct light
+
+  !  REAL(r_std),DIMENSION(kjpindex,nvm,ncirc,nlevels_tot)   :: h_array_out             !! (FROM STOMATE) An output of h_array, to use in sechiba               
+  !  REAL(r_std),DIMENSION(kjpindex,nvm,ncirc,nlevels_tot)   :: z_array_out             !! (FROM STOMATE) An output of h_array, to use in sechiba                                                                           
+
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)        :: profile_vbeta3
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)        :: profile_rveget
+
+    REAL(r_std), DIMENSION(nlevels_tot, kjpindex, nvm)      :: transpir_supply_column   !! (SECHIBA TOP LEVEL) Supply of water for transpiration 
+ !  REAL(r_std), DIMENSION (kjpindex,nvm)                   :: max_height_store     
+
+    REAL(r_std),DIMENSION(nlevels_tot)                      :: Collim_Abs_Tot           !! (SECHIBA TOP LEVEL) collimated total absorption for a given level
+    REAL(r_std),DIMENSION(nlevels_tot)                      :: Collim_Alb_Tot           !! (SECHIBA TOP LEVEL) Collimated (direct) total albedo for a given level
+    REAL(r_std),DIMENSION(nlevels_tot)                      :: laieff_isotrop_pft       !! (FROM STOMATE) collimated total absorption for a given level
+    REAL(r_std),DIMENSION(nlevels_tot)                      :: laieff_collim_pft        !! (FROM STOMATE) Collimated (direct) total albedo for a given level
+
+    ! %%% begin variables for the enerbil and hydrol interface %%%%
+
+    LOGICAL                                                 :: hydrol_flag           !! flag that 'trips' the energy budget for each grid square 
+    LOGICAL, DIMENSION (kjpindex)                           :: hydrol_flag2          !! flag that 'trips' the energy budget for each grid square
+    LOGICAL, DIMENSION (kjpindex, nvm)                      :: hydrol_flag3          !! flag that 'trips' the energy budget for each grid square and PFT
+
+    LOGICAL, DIMENSION (kjpindex, nlevels_tot)              :: hydrol_flag2_column   !! flag that 'trips' the energy budget for each grid square, and canopy level
+    LOGICAL, DIMENSION (kjpindex, nvm, nlevels_tot)         :: hydrol_flag3_column   !! flag that 'trips' the energy budget for each grid square, canopy level and PFT
+
+
+    ! %%% end variables for the enerbil and hydrol interface %%%%
+
+! ==============================================================================================================================
+
+
+        ! we define here a set of flags, required to signal if we need to recalculate the
+        ! energy budget depending on the hydraulic stress being a limiting factor to the
+        ! latent heat flux.
+       
+        hydrol_flag = .FALSE.     ! trip flag per cycle (no dimension)
+        hydrol_flag2(:) = .FALSE.    ! trip flag per grid square
+        hydrol_flag3(:,:) = .FALSE.    ! trip flag per grid square and PFT
+       
+        ! ---------------------------------------------------------------------------------------------------
+        ! before first calling diffuco_trans_co2 again, store output values from the first call to diffuco
+   
+        vbeta3_save(:,:) = vbeta3(:,:)           !! Beta for Transpiration (unitless)
+        vbeta3pot_save(:,:) = vbeta3pot(:,:)     !! Beta for Potential Transpiration
+        rveget_save(:,:) = rveget(:,:)           !! stomatal resistance of vegetation 
+        rstruct_save(:,:) = rstruct(:,:)         !! structural resistance @tex ($s m^{-1}$) @endtex
+        cimean_save(:,:) = cimean(:,:)           ! mean intercellular CO2 concentration
+        gsmean_save(:,:) = gsmean(:,:)           ! mean stomatal conductance to CO2 (umol m-2 s-1)
+        gpp_save(:,:) = gpp(:,:)                 !! gross primary production
+        ! ---------------------------------------------------------------------------------------------------
+       
+        ! ---------------------------------------------------------------------------------------------------
+        ! before first call to enerbil, store initial values
+  
+        evapot_save(:) = evapot(:)                !! Soil Potential Evaporation (mm day^{-1})
+        evapot_corr_save(:) = evapot_corr(:)      !! Soil Potential Evaporation Correction (mm day^{-1})
+        qsurf_save(:) = qsurf(:)                  !! Surface specific humidity (kg kg^{-1})
+
+        fluxsens_save(:) = fluxsens(:)            !! Sensible heat flux (W m^{-2})
+        fluxlat_save(:) = fluxlat(:)              !! Latent heat flux (W m^{-2})
+
+        temp_sol_save(:) = temp_sol(:)            !! Soil temperature (K)
+        temp_sol_new_save(:) = temp_sol_new(:)    !! New soil temperature (K)
+        tsol_rad_save(:) = tsol_rad(:)            !! Tsol_rad (W m^{-2})
+        vevapp_save(:) = vevapp(:)                !! Total of evaporation (mm day^{-1})
+        gpp_save(:,:) = gpp(:,:)                  !! Assimilation ((gC m^{-2}), total area)
+        vbeta2sum_save(:) = vbeta2sum(:) 
+        vbeta3sum_save(:) = vbeta3sum(:)
+        ! ---------------------------------------------------------------------------------------------------
+
+        IF(printlev_loc>=4) WRITE(numout, *) '081116, in sechiba_mleb_hs epot_air',epot_air 
+        IF(printlev_loc>=3) WRITE(numout, *) '140616 about to call mleb_main'
+        CALL mleb_main (kjit, kjpindex, ldrestart_read, ldrestart_write, &
+             & index, indexveg, zlev, lwdown, swnet, swdown, epot_air, temp_air, &
+             & u, v, petAcoef, petBcoef, qair, peqAcoef, peqBcoef, pb, rau, &
+             & vbeta, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, &
+             & emis, soilflx, soilcap, tq_cdrag, humrel, &
+             & fluxsens, fluxlat, vevapp, transpir, transpot, vevapnu, vevapwet, &
+             & vevapsno, vevapflo, temp_sol, tsol_rad, temp_sol_new, qsurf, &
+             & evapot, evapot_corr, rest_id, hist_id, hist2_id, & 
+             & flux_ground_h, flux_ground_le, flux_h_grid, flux_le_grid, t_a_next_grid, &
+             & q_a_next_grid, temp_surf_next, temp_atmos_pres_grid, q_atmos_pres_grid, &
+             & ok_mleb_history_file, james_step_count, temp_leaf_pres_grid, temp_surf_pres, &
+             & transpir_supply, hydrol_flag, hydrol_flag2, hydrol_flag3, vbeta2sum, & 
+             & vbeta3sum, veget_max, qsol_sat_new_out, qair_new, delta_temp_save, &
+             & netrad_out, veget, Collim_Abs_Tot, Collim_Alb_Tot, laieff_isotrop, &
+             & h_array_out, z_array_out, transpir_supply_column, u_speed, &
+             & profile_vbeta3, profile_rveget, max_height_store, &
+             & u_speed_grid, flux_rn_grid, t2m_month_out) 
+
+        delta_temp_save = temp_surf_next - temp_sol
+        ! these are calculated in the first call to the mleb_main, but may be required if it is called again
+        fluxsens_save(:) = fluxsens(:)            !! Sensible heat flux (W m^{-2})
+        fluxlat_save(:) = fluxlat(:)              !! Latent heat flux (W m^{-2})
+
+       
+        !+++CHECK+++
+        ! Store the proxy for unstressed ecosystem functioning. This could be gpp, transpiration,
+        ! evaporation. They all differ conceptually and numerically but the idea is the same.
+        ! In the initial approach we tried to calculate the stress as a ratio of the initial 
+        ! transpiration over water supplied through the plant.  This approach resulted
+        ! in inconsistencies likely because the many feedbacks in the calculation of transpir. 
+        ! Similar issues were observed when using transport. For this reason it was decided to drop
+        ! this approach and use the ratio between the initial and adjusted gpp instead. After
+        ! all this ratio will be used in stomate to adjust the allocation.
+        ! Note that the feedback on gpp is calculated based on the ratio between ::transpir_supply 
+        ! and transpir at the half hourly time step. In stomate we use the ratio between stressed
+        ! and unstressed but at the daily time step. Night time values should be ignored in the
+        ! daily calculation. If night time values are considered to unstressed this will skew
+        ! the result.
+        unstressed(:,:) = gpp(:,:)
+        !+++++++++++
+        IF (ok_hydrol_arch) THEN
+
+           CALL hydrol_arch (kjpindex, circ_class_biomass, circ_class_n, temp_sol_new, &
+                temp_air, swc, transpir_supply, njsc, soiltile, &
+                ! vir_transpir_supply, veget, h_array_out, h_array_out, z_array_out3, &
+                vir_transpir_supply, veget, h_array_out, z_array_out, &
+                transpir_supply_column,ksave,e_frac)
+
+           ! transpir_supply is provided in mm per timestep (dt_sechiba)
+           transpir_init(:,:) = zero
+ 
+           DO ji = 1, kjpindex
+
+              !don't restrict gs during night
+              DO jv = 1, nvm
+                 IF (sinang(ji) .LT. min_sechiba) THEN
+                    ! Night time we will never recalculate the energy budget
+                    hydrol_flag2(ji) = .FALSE.
+                    hydrol_flag3(ji,jv) = .FALSE.
+                    transpir_init(ji, jv)= zero
+                 ELSE
+                   ! The ratio between ::transpir_supply and ::transpir is used to determine
+                    ! whether we will recalculate gpp, transpir, ... (thus enerbil). This
+                    ! is done every half hour. The waterstress that will be passed to stomate
+                    ! to adjust the allocation will be calculated at the daily time step.
+                    ! It is important NOT to include night time values in the daily mean
+                    ! because more southern sides have shorter days during the growing season
+                    ! the number of half hours with day light biases the waterstress if it 
+                    ! is assumed that there is no waterstress at night.
+
+                    IF (veget_max(ji,jv) .GT. zero .AND. &
+                         veget(ji,jv) .GT. zero) THEN  
+                        transpir_init(ji, jv)= (transpir(ji,jv)/veget_max(ji,jv)) 
+                       !comparing the transpiration in tree-stand scale   
+                       IF ( transpir_supply(ji,jv) .LT. transpir_init(ji,jv) ) THEN 
+                          IF(printlev_loc>=3) WRITE(numout,*) '091013 hydrol_flag2&3 set to TRUE, pft is: ', jv
+                          hydrol_flag2(ji) = .TRUE.
+                          hydrol_flag3(ji,jv) = .TRUE.
+                       ELSE
+                          IF(printlev_loc>=3) WRITE(numout,*) '091013 hydrol_flag2 set to FALSE, pft is: ', jv
+                       END IF
+                    ELSE
+                       ! There is no vegetation here, so we can skip it.
+                       ! the flag at the pixel level (::hydrol_flag2) should 
+                       ! not change its value.
+                       hydrol_flag3(ji,jv) = .FALSE.
+                       transpir_init(ji, jv)= zero
+                    ENDIF
+                    
+                    !---TEMP---
+                    IF((printlev_loc>=3) .AND. (jv.EQ.test_pft)) THEN
+                       WRITE(numout,*) 'YC transpir_init:',   transpir_init(ji, jv)
+                       WRITE(numout,*) 'transpir_supply, ',transpir_supply(ji,test_pft)
+                       IF (veget_max(ji,test_pft) .GT. zero) THEN  
+                          WRITE(numout,*) 'transpir modified, ', transpir(ji,test_pft)/veget_max(ji,test_pft) 
+                       ENDIF
+                    ENDIF
+                    !----------
+
+                 END IF
+
+              END DO ! jv = 1, nvm
+
+           END DO ! ji = 1, kjpindex
+           ! The energy budget is only calculated again, if the above conditions are satisfied 
+           ! for any of the grid squares, and the feedback of waterstress on stomatal 
+           ! closure (ok_gs_feedback) is activated
+           
+           DO ji = 1, kjpindex  ! grid point cycle
+
+              IF  (hydrol_flag2(ji)) THEN    ! this switch is 'tripped' if the above applies to any PFT at the
+                 ! grid point, as the whole energy budget for that grid point must
+                 ! then be recalculated, and mleb_main thus needs to be called
+                 ! again
+                 hydrol_flag = .TRUE.
+              ELSE
+                 ! move on to the next grid point in question
+              END IF
+              
+           END DO ! ji = 1, kjpindex
+        
+           ! If the feedback of water stress on stomatal closure is not
+           ! activated, then hydrol_flag is set to false, and no energy
+           ! re-calculations are conducted
+
+           IF (.NOT. ok_gs_feedback) hydrol_flag=.FALSE.
+
+           IF (hydrol_flag) THEN
+           
+              ! mleb_main should be called here again (to recalculate the energy budget because of
+              !     supply term constriction
+           
+              ! ---------------------------------------------------------------------------------------------------  
+              ! before 2nd call to enerbil, recall initial values (the ones un-changed from the first enerbil call)
+           
+              evapot(:) = evapot_save(:)                   !! Soil Potential Evaporation (mm day^{-1})
+              evapot_corr(:) = evapot_corr_save(:)         !! Soil Potential Evaporation Correction (mm day^{-1})
+              temp_sol(:) = temp_sol_save(:)               !! Soil temperature (K)
+              qsurf(:) = qsurf_save(:)                     !! Surface specific humidity (kg kg^{-1})
+              fluxsens(:) = fluxsens_save(:)               !! Sensible heat flux (W m^{-2})
+              fluxlat(:) = fluxlat_save(:)                 !! Latent heat flux (W m^{-2})
+              tsol_rad(:) = tsol_rad_save(:)               !! Tsol_rad (W m^{-2})
+              vevapp(:) = vevapp_save(:)                   !! Total of evaporation (mm day^{-1})
+              gpp(:,:) = gpp_save(:,:)                     !! Assimilation ((gC m^{-2}), total area)
+              temp_sol_new(:) = temp_sol_new_save(:)       !! New soil temperature (K)
+              vbeta2sum(:) = vbeta2sum_save(:) 
+              vbeta3sum(:) = vbeta3sum_save(:)   
+              ! ---------------------------------------------------------------------------------------------------
+              DO ji = 1, kjpindex  ! grid point cycle
+                 
+                 ! 201013 calculate new series of beta_v3
+                    vbeta3_oldvalue(:, :) = 0.0d0
+                 
+                    ! vbeta2sum(:) = zero
+                    IF (hydrol_flag2(ji)) THEN
+                       DO jv = 1, nvm
+                          IF (.NOT. hydrol_flag3(ji, jv)) THEN 
+                             ! this is for cases when the supply term is higher than the 
+                             !     transpiration) - i.e. the normal state of affairs
+                          ELSE
+                             vbeta3_oldvalue(ji, jv) = vbeta3(ji, jv)
+
+                             ! We calculate the vbeta3 based on the ::transpir_supply term for each grid and pft
+                             ! We should keep the spatial weighting fraction,::veget_max, for vebta3. Even the calculation
+                             ! of ::transpir_supply is in tree stand scale.   
+                             IF (veget_max(ji,jv) .GT. zero .AND. veget(ji,jv) .GT. zero) THEN        
+                                  vbeta3(ji,jv) = veget_max(ji, jv) * transpir_supply(ji,jv)  / &  
+                                       &  ( dt_sechiba * (1.0d0 - vbeta1(ji)) * (qsol_sat_new_out(ji) - qair_new(ji)) * &
+                                       &  ( rau(ji) * (MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))) * tq_cdrag(ji)))
+                             ELSE
+                                  ! No vegetation present for this condition, so vbeta3 is set equal to zero. 
+                                  vbeta3(ji,jv) = 0.0d0
+                             ENDIF
+ 
+                              IF ( ( vbeta3(ji, jv)/vbeta3_oldvalue(ji, jv) ) .gt. 1.0d0 ) THEN
+                                ! WRITE(numout,*) 'vbeta3 ratio is greater than 1!!'
+                              END IF
+                          END IF ! (hydrol_flag3(ji, jv) .eq. .FALSE.)
+                       ENDDO ! jv = 1, nvm
+                    ELSE
+                       ! do nothing
+                    END IF ! (hydrol_flag2(ji) .eq. .TRUE.)        
+              END DO ! ji = 1, kjpindex
+              
+              ! now to approximate the stomatatal conductance, where it is constrained by the supply term.
+              ! This calculation takes place over the whole canopy, for now.
+
+              ! To calculate the gs_effective (the effective stomatal conductance), first we need to calculate
+              !   a constrained vbeta3, and work back from there, using a tweaked version of diffuco_trans_co2
+
+              ! IF (ld_mleb_write) THEN
+                  ! write statements for error checking
+              !     WRITE(numout, *) 'before mleb_main'
+              ! END IF !(ld_mleb_write)
+
+              CALL mleb_main (kjit, kjpindex, ldrestart_read, ldrestart_write, &
+                   & index, indexveg, zlev, lwdown, swnet, swdown, epot_air, temp_air, &
+                   & u, v, petAcoef, petBcoef, qair, peqAcoef, peqBcoef, pb, rau, &
+                   & vbeta, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, &
+                   & emis, soilflx, soilcap, tq_cdrag, humrel, &
+                   & fluxsens, fluxlat, vevapp, transpir, transpot, vevapnu, vevapwet, &
+                   & vevapsno, vevapflo, temp_sol, tsol_rad, temp_sol_new, qsurf, &
+                   & evapot, evapot_corr, rest_id, hist_id, hist2_id, & 
+                   & flux_ground_h, flux_ground_le, flux_h_grid, flux_le_grid, t_a_next_grid, q_a_next_grid, & 
+                   & temp_surf_next, temp_atmos_pres_grid, q_atmos_pres_grid, &
+                   & ok_mleb_history_file, james_step_count, temp_leaf_pres_grid, temp_surf_pres, &
+                   & transpir_supply, hydrol_flag, hydrol_flag2, &
+                   & hydrol_flag3, vbeta2sum, vbeta3sum, veget_max, qsol_sat_new_out, qair_new, &
+                   & delta_temp_save, netrad_out, veget, Collim_Abs_Tot, Collim_Alb_Tot, &
+                   & laieff_isotrop, h_array_out, z_array_out, transpir_supply_column, &
+                   & u_speed, profile_vbeta3, profile_rveget, max_height_store, &
+                   & u_speed_grid, flux_rn_grid, t2m_month_out )
+              
+              ! we need to pass on the new vbeta3 to mleb_diffuco_trans_co2
+
+              CALL mleb_diffuco_trans_co2 (kjpindex, swdown, temp_sol, pb, qsurf, &
+                   & q2m, t2m, temp_growth, rau, u, v, tq_cdrag, vegstress, &
+                   & assim_param, ccanopy, veget_max, qsintveg, qsintmax, &
+                   & vbeta3, vbeta3pot, rveget, rstruct, cimean, gsmean, gpp, &
+                   & vbeta23, Isotrop_Abs_Tot_p, Isotrop_Tran_Tot_p, lai_per_level, &
+                   & leaf_ci, hydrol_flag2, hydrol_flag3, gs_distribution, gs_diffuco_output, &
+                   & ok_mleb_history_file, gstot_component, gstot_frac, warnings, veget, &
+                   & circ_class_biomass,circ_class_n, u_speed, profile_vbeta3, profile_rveget)
+ 
+              DO ji = 1, kjpindex
+
+                 DO  jv = 1, nvm
+
+                    IF (hydrol_flag3(ji,jv)) THEN
+
+                       ! do nothing (as the relevant values were calculated in mleb_diffuco_trans_co2)
+                       
+                    ELSE
+                       ! ------------------------------------------------------------------------------------------
+                       ! restore saved values for PFTs and grid squares not affected by water stress
+                       vbeta3(ji,jv) = vbeta3_save(ji,jv)        !! Beta for Transpiration (unitless)
+                       vbeta3pot(ji,jv) = vbeta3pot_save(ji,jv)  !! Beta for Potential Transpiration
+                       rveget(ji,jv) = rveget_save(ji,jv)        !! stomatal resistance of vegetation 
+                       rstruct(ji,jv) = rstruct_save(ji,jv)      !! structural resistance @tex ($s m^{-1}$) @endtex
+                       cimean(ji,jv) = cimean_save(ji,jv)        ! mean intercellular CO2 concentration
+                       gsmean(ji,jv) = gsmean_save(ji,jv)        ! mean stomatal conductance to CO2 (umol m-2 s-1)
+                       gpp(ji,jv) = gpp_save(ji,jv)              !! gross primary production
+                       ! ------------------------------------------------------------------------------------------
+
+                    END IF
+
+                 END DO ! jv = 1, nvm
+                 
+              END DO ! ji = 1, kjpindex
+
+           ELSE
+              ! do nothing
+           END IF ! (hydrol_flag .eq. .TRUE.) 
+
+           !+++CHECK+++
+           ! Store the proxy for stressed ecosystem functioning. This value is used in stomate
+           ! to calculate the waterstress used in allocation
+           stressed(:,:) = gpp(:,:)
+           !+++++++++++
+                
+        END IF   ! IF (ok_hydrol_arch) THEN
+
+        ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+        mleb_count = mleb_count + 1
+
+        !! 2.3.1 Write enerbil data to the history files.
+!!$        CALL enerbil_write (kjit, kjpindex, index, lwdown, ccanopy, temp_sol, &
+        CALL enerbil_write (kjit, kjpindex, index, lwdown, temp_sol, &
+            & temp_sol_new, evapot, evapot_corr, hist_id, hist2_id)
+
+
+    
+  END SUBROUTINE sechiba_mleb_hs
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    sechiba_finalize
+!!
+!>\BRIEF	  Finalize all modules by calling their "_finalize" subroutines.
+!!
+!! DESCRIPTION:	  Finalize all modules by calling their "_finalize" subroutines. These subroutines will write variables to 
+!!                restart file. 
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE sechiba_finalize( &
+       kjit,     kjpij,  kjpindex, index,   rest_id, &
+       tq_cdrag, vevapp, fluxsens, fluxlat, tsol_rad, &
+       veget_max)
+
+!! 0.1 Input variables    
+    INTEGER(i_std), INTENT(in)                               :: kjit              !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)                               :: kjpij             !! Total size of the un-compressed grid 
+                                                                                  !! (unitless)
+    INTEGER(i_std), INTENT(in)                               :: kjpindex          !! Domain size - terrestrial pixels only 
+                                                                                  !! (unitless)
+    INTEGER(i_std),INTENT (in)                               :: rest_id           !! _Restart_ file identifier (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: index             !! Indices of the pixels on the map. 
+                                                                                  !! Sechiba uses a reduced grid excluding oceans
+                                                                                  !! ::index contains the indices of the 
+                                                                                  !! terrestrial pixels only! (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: tsol_rad           !! Radiative surface temperature 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: vevapp             !! Total of evaporation 
+                                                                                  !! @tex $(kg m^{-2} days^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: fluxsens           !! Sensible heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: fluxlat            !! Latent heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: tq_cdrag           !! Surface drag coefficient (-)
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)       :: veget_max          !! Max. fraction of vegetation type (inc. no_bio fraction)
+
+
+!! 0.2 Local variables
+    INTEGER(i_std)                                          :: ji, jv		  !! Index (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                        :: histvar            !! Computations for history files (unitless)
+    CHARACTER(LEN=80)                                       :: var_name           !! To store variables names for I/O (unitless)
+
+! ==============================================================================================================================
+
+    !! Write restart file for the next simulation from SECHIBA and other modules
+    IF (printlev>=3) WRITE (numout,*) 'Write restart file'
+
+    !! 1. Call diffuco_finalize to write restart files
+    CALL diffuco_finalize (kjit, kjpindex, rest_id, rstruct )
+    
+    !! 2. Call energy budget to write restart files
+    CALL enerbil_finalize (kjit,   kjpindex,    rest_id,            &
+                           evapot, evapot_corr, temp_sol, tsol_rad, &
+                           qsurf,  fluxsens,    fluxlat,  vevapp )
+    
+    !! 3. Call hydrology to write restart files
+    !! 3.2 Call water balance from CWRR module (11 soil layers) to write restart file
+    CALL hydrol_finalize( kjit,           kjpindex, rest_id,  vegstress,  &
+         qsintveg,       humrel,   snow,     snow_age, snow_nobio, &
+         snow_nobio_age, snowrho,  snowtemp, snowdz,     &
+         snowheat,       snowgrain,    &
+         drysoil_frac, evap_bare_lim)
+    
+    !! 4. Call condveg to write surface variables to restart files
+    CALL condveg_finalize (kjit, kjpindex, rest_id, z0m, z0h, roughheight)
+    
+    !! 5. Call soil thermodynamic to write restart files
+    CALL thermosoil_finalize (kjit,    kjpindex, rest_id,   gtemp, &
+         soilcap, soilflx, lambda_snow, cgrnd_snow, dgrnd_snow)
+
+
+    !! 6. Add river routing to restart files  
+    IF ( river_routing .AND. nbp_glo .GT. 1) THEN
+       !! 6.1 Call river routing to write restart files 
+       CALL routing_finalize( kjit, kjpindex, rest_id, flood_frac, flood_res )
+    ELSE
+       !! 6.2 No routing, set variables to zero
+       reinfiltration(:) = zero
+       returnflow(:) = zero
+       irrigation(:) = zero
+       flood_frac(:) = zero
+       flood_res(:) = zero
+    ENDIF
+    
+    !#481
+    !WRITE(numout,*) 'AHAAA: before slowproc_finalize veget_max', veget_max(:,1)
+
+    !! 7. Call slowproc_main to add 'daily' and annual variables to restart file
+    CALL slowproc_finalize (kjit,      kjpindex,    rest_id,     index,      &
+                            njsc,      height,      veget,       frac_nobio, &
+                            veget_max, reinf_slope, assim_param, frac_age,   &
+                            circ_class_biomass, circ_class_n,  &
+                            lai_per_level, laieff_fit)
+    
+    IF (printlev>=3) WRITE (numout,*) 'sechiba_finalize done'
+    
+  END SUBROUTINE sechiba_finalize
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_init
+!!
+!>\BRIEF        Dynamic allocation of the variables, the dimensions of the 
+!! variables are determined by user-specified settings. 
+!! 
+!! DESCRIPTION  : The domain size (:: kjpindex) is used to allocate the correct
+!! dimensions to all variables in sechiba. Depending on the variable, its 
+!! dimensions are also determined by the number of PFT's (::nvm), number of 
+!! soil types (::nstm), number of non-vegetative surface types (::nnobio),
+!! number of soil levels (::ngrnd), number of soil layers in the hydrological 
+!! model (i.e. cwrr) (::nslm). Values for these variables are set in
+!! constantes_soil.f90 and constantes_veg.f90.\n
+!!
+!! Memory is allocated for all Sechiba variables and new indexing tables
+!! are build making use of both (::kjpij) and (::kjpindex). New indexing tables 
+!! are needed because a single pixel can contain several PFTs, soil types, etc.
+!! The new indexing tables have separate indices for the different
+!! PFTs, soil types, etc.\n
+!!
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUT VARIABLE(S): Strictly speaking the subroutine has no output 
+!! variables. However, the routine allocates memory and builds new indexing 
+!! variables for later use.
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================ 
+
+  SUBROUTINE sechiba_init (kjit, kjpij, kjpindex, index, rest_id, lalo)
+
+!! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT (in)                         :: kjit               !! Time step number (unitless)
+    INTEGER(i_std), INTENT (in)                         :: kjpij              !! Total size of the un-compressed grid (unitless)
+    INTEGER(i_std), INTENT (in)                         :: kjpindex           !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std), INTENT (in)                         :: rest_id            !! _Restart_ file identifier (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: index              !! Indeces of the points on the map (unitless)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)     :: lalo               !! Geographical coordinates (latitude,longitude) 
+                                                                              !! for pixels (degrees)
+!! 0.2 Output variables
+
+!! 0.3 Modified variables
+
+!! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ier                !! Check errors in memory allocation (unitless)
+    INTEGER(i_std)                                      :: ji,jv,ilevel,ipts  !! Indeces (unitless)
+!_ ==============================================================================================================================
+
+!! 1. Initialize variables 
+  
+    ! Debug
+    ! It is good to leave this in here.  It is only written out once,
+    ! it takes almost no time, and it's necessary for identifying a 
+    ! problem pixel.
+    DO ipts=1,kjpindex
+       WRITE(numout,'(A,I6,10F20.10)') 'pixel number to lat/lon: ',ipts,lalo(ipts,1:2)
+    ENDDO
+    !-
+  
+    ! Dynamic allocation with user-specified dimensions on first call
+    IF (l_first_sechiba) THEN 
+       l_first_sechiba=.FALSE.
+    ELSE 
+       CALL ipslerr_p(3,'sechiba_init',' l_first_sechiba false . we stop ','','')
+    ENDIF
+
+    !! Initialize local printlev
+    !printlev_loc=get_printlev('sechiba')
+    
+
+    !! 1.1 Initialize 3D vegetation indexation table
+    ALLOCATE (indexveg(kjpindex*nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexveg','','')
+
+    ALLOCATE (indexlai(kjpindex*(nlai+1)),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexlai','','')
+
+    ALLOCATE (indexsoil(kjpindex*nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexsoil','','')
+
+    ALLOCATE (indexnobio(kjpindex*nnobio),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexnobio','','')
+
+    ALLOCATE (indexgrnd(kjpindex*ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexgrnd','','')
+
+    ALLOCATE (indexsnow(kjpindex*nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexsnow','','')
+
+    ALLOCATE (indexlayer(kjpindex*nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexlayer','','')
+
+    ALLOCATE (indexnbdl(kjpindex*nbdl),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexnbdl','','')
+
+    ALLOCATE (indexalb(kjpindex*2),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexalb','','')
+
+    !! 1.2  Initialize 1D array allocation with restartable value
+    ALLOCATE (flood_res(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for flood_res','','')
+    flood_res(:) = undef_sechiba
+
+    ALLOCATE (flood_frac(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for kjpindex','','')
+    flood_frac(:) = undef_sechiba
+
+    ALLOCATE (snow(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snow','','')
+    snow(:) = undef_sechiba
+
+    ALLOCATE (snow_age(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snow_age','','')
+    snow_age(:) = undef_sechiba
+
+    ALLOCATE (drysoil_frac(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for drysoil_frac','','')
+
+    ALLOCATE (evap_bare_lim(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for evap_bare_lim','','')
+
+    ALLOCATE (evapot(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for evapot','','')
+    evapot(:) = undef_sechiba
+
+    ALLOCATE (evapot_corr(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for evapot_corr','','')
+
+    ALLOCATE (humrel(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for humrel','','')
+    humrel(:,:) = undef_sechiba
+
+    ALLOCATE (vegstress(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vegstress','','')
+    vegstress(:,:) = undef_sechiba
+
+    ALLOCATE (njsc(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for njsc','','')
+    njsc(:)= undef_int
+
+    ALLOCATE (soiltile(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for soiltile','','')
+
+    ALLOCATE (reinf_slope(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for reinf_slope','','')
+
+    ALLOCATE (vbeta1(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta1','','')
+
+    ALLOCATE (vbeta4(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta4','','')
+
+    ALLOCATE (vbeta5(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta5','','')
+
+    ALLOCATE (soilcap(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for soilcap','','')
+
+    ALLOCATE (soilflx(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for soilflx','','')
+
+    ALLOCATE (temp_sol(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for temp_sol','','')
+    temp_sol(:) = undef_sechiba
+
+    ALLOCATE (qsurf(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for qsurf','','')
+    qsurf(:) = undef_sechiba
+
+    !! 1.3 Initialize 2D array allocation with restartable value
+    ALLOCATE (qsintveg(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for qsintveg','','')
+    qsintveg(:,:) = undef_sechiba
+
+    ALLOCATE (vbeta2(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta2','','')
+
+    ALLOCATE (vbeta3(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta3','','')
+
+    ALLOCATE (vbeta3pot(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta3pot','','')
+
+    ALLOCATE (gsmean(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for gsmean','','')
+
+    ALLOCATE (cimean(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for cimean','','')
+
+    ALLOCATE (gpp(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for gpp','','')
+    gpp(:,:) = undef_sechiba
+ 
+    ALLOCATE (temp_growth(kjpindex),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for temp_growth','','')
+    temp_growth(:) = undef_sechiba 
+
+    ALLOCATE (veget(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for veget','','')
+    veget(:,:)=undef_sechiba
+
+    ALLOCATE (veget_max(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for veget_max','','')
+
+    ALLOCATE (tot_bare_soil(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for tot_bare_soil','','')
+
+    ALLOCATE (lai(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for lai','','')
+    lai(:,:)=undef_sechiba
+
+    ALLOCATE (laieff_fit(kjpindex,nvm,nlevels_tot),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for laieff_fit','','')
+    CALL laieff_type_init(kjpindex, nlevels_tot, laieff_fit)
+
+    ALLOCATE (frac_age(kjpindex,nvm,nleafages),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for frac_age','','')
+    frac_age(:,:,:)=undef_sechiba
+
+    ALLOCATE (height(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for height','','')
+    height(:,:)=undef_sechiba
+
+    ALLOCATE (frac_nobio(kjpindex,nnobio),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for frac_nobio','','')
+    frac_nobio(:,:) = undef_sechiba
+
+    ALLOCATE (albedo_pft(kjpindex,nvm,2),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for albedo_pft','','')
+
+    ALLOCATE (snow_nobio(kjpindex,nnobio),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snow_nobio','','')
+    snow_nobio(:,:) = undef_sechiba
+
+    ALLOCATE (snow_nobio_age(kjpindex,nnobio),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snow_nobio_age','','')
+    snow_nobio_age(:,:) = undef_sechiba
+
+    ALLOCATE (assim_param(kjpindex,nvm,npco2),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for assim_param','','')
+
+    !! 1.4 Initialize 1D array allocation 
+    ALLOCATE (vevapflo(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vevapflo','','')
+    vevapflo(:)=zero
+
+    ALLOCATE (vevapsno(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vevapsno','','')
+
+    ALLOCATE (vevapnu(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vevapnu','','')
+
+    ALLOCATE (totfrac_nobio(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for totfrac_nobio','','')
+
+    ALLOCATE (floodout(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for floodout','','')
+
+    ALLOCATE (runoff(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for runoff','','')
+
+    ALLOCATE (drainage(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for drainage','','')
+
+    ALLOCATE (returnflow(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for returnflow','','')
+    returnflow(:) = zero
+
+    ALLOCATE (reinfiltration(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for reinfiltration','','')
+    reinfiltration(:) = zero
+
+    ALLOCATE (irrigation(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for irrigation','','')
+    irrigation(:) = zero
+
+    ALLOCATE (z0h(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for z0h','','')
+
+    ALLOCATE (z0m(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for z0m','','')
+
+    ALLOCATE (roughheight(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for roughheight','','')
+
+    ALLOCATE (emis(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for emis','','')
+
+    ALLOCATE (tot_melt(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for tot_melt','','')
+
+    ALLOCATE (vbeta(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta','','')
+
+    ALLOCATE (rau(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for rau','','')
+
+    ALLOCATE (deadleaf_cover(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for deadleaf_cover','','')
+
+    ALLOCATE (stempdiag(kjpindex, nbdl),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for stempdiag','','')
+
+    ALLOCATE (co2_flux(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for co2_flux','','')
+    co2_flux(:,:)=zero
+
+    ALLOCATE (shumdiag(kjpindex,nbdl),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for shumdiag','','')
+    
+    ALLOCATE (shumdiag_perma(kjpindex,nbdl),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for shumdiag_perma','','')
+
+    ALLOCATE (litterhumdiag(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for litterhumdiag','','')
+
+    ALLOCATE (ptnlev1(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for ptnlev1','','')
+
+    ALLOCATE (k_litt(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for k_litt','','')
+
+    !! 1.5 Initialize 2D array allocation
+    ALLOCATE (vevapwet(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vevapwet','','')
+    vevapwet(:,:)=undef_sechiba
+
+    ALLOCATE (transpir(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for transpir','','')
+
+    ALLOCATE (transpot(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for transpot','','')
+
+    ALLOCATE (transpir_mod(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'sechiba_init','Pb in alloc for transpir_mod','','')
+    transpir_mod(:,:) = zero 
+
+
+    ALLOCATE (stressed(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'sechiba_init','Pb in alloc for stressed','','')
+    stressed(:,:) = zero
+
+    ALLOCATE (unstressed(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'sechiba_init','Pb in alloc for unstressed','','')
+    unstressed(:,:) = zero
+
+    ALLOCATE (transpir_supply(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'sechiba_init','Pb in alloc for transpir_supply','','')
+    transpir_supply(:,:) = zero
+
+    ALLOCATE (vir_transpir_supply(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'sechiba_init','Pb in alloc for vir_transpir_supply','','')
+    vir_transpir_supply(:,:) = zero
+
+    ALLOCATE (transpir_supply_column(nlevels_tot,kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'sechiba_init','Pb in alloc for transpir_supply_column','','')
+    transpir_supply_column(:,:,:) = zero
+
+    ALLOCATE (e_frac(kjpindex,nvm,nbdl,nstm),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'sechiba_init','Pb in alloc for e_frac','','')
+    e_frac(:,:,:,:) = zero
+
+    ALLOCATE (qsintmax(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for qsintmax','','')
+
+    ALLOCATE (rveget(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for rveget','','')
+
+    ALLOCATE (rstruct(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for rstruct','','')
+
+    ALLOCATE (pgflux(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for pgflux','','')
+    pgflux(:)= 0.0
+
+    ALLOCATE (cgrnd_snow(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for cgrnd_snow','','')
+    cgrnd_snow(:,:) = 0
+
+    ALLOCATE (dgrnd_snow(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for dgrnd_snow','','')
+    dgrnd_snow(:,:) = 0
+
+    ALLOCATE (lambda_snow(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for lambda_snow','','')
+    lambda_snow(:) = 0
+
+    ALLOCATE (temp_sol_add(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for temp_sol_add','','')
+
+    ALLOCATE (gtemp(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for gtemp','','')
+
+    ALLOCATE (frac_snow_veg(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for frac_snow_veg','','')
+    
+    ALLOCATE (frac_snow_nobio(kjpindex,nnobio),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for frac_snow_nobio','','')
+
+    ALLOCATE (snowrho(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snowrho','','')
+
+    ALLOCATE (snowheat(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snowheat','','')
+
+    ALLOCATE (snowgrain(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snowgrain','','')
+
+    ALLOCATE (snowtemp(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snowtemp','','')
+
+    ALLOCATE (snowdz(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snowdz','','')
+
+    ALLOCATE (mc_layh(kjpindex, nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for mc_layh','','')
+
+    ALLOCATE (mcl_layh(kjpindex, nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for mcl_layh','','')
+
+    ALLOCATE (tmc_layh(kjpindex, nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for tmc_layh','','')
+
+    ALLOCATE(max_height_store(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for max_height_store','','')
+
+    ALLOCATE (warnings(kjpindex,nvm,nwarns),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in warnings allocation. We stop. We need kjpindex x nvm x nwarns words = ',&
+            & kjpindex,' x ' ,nvm, ' x ',nwarns,' = ',kjpindex*nvm*nwarns
+      CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    END IF
+    ! We aren't restarting the warnings at the moment.
+    warnings(:,:,:)=zero
+
+    !! 1.5b Initialize 3D array allocation for albedo
+    ALLOCATE (Isotrop_Abs_Tot_p(kjpindex,nvm,nlevels_tot),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'sechiba_init', &
+         'Pb in alloc for Isotrop_Abs_Tot_p','','')
+    Isotrop_Abs_Tot_p(:,:,:)= zero
+
+    ALLOCATE (Isotrop_Tran_Tot_p(kjpindex,nvm,nlevels_tot),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'sechiba_init', &
+         'Pb in alloc for Isotrop_Tran_Tot_p','','')
+    Isotrop_Tran_Tot_p(:,:,:)= zero
+
+    ALLOCATE (laieff_isotrop(nlevels_tot,kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'sechiba_init', &
+         'Pb in alloc for laieff_isotrop','','')
+    laieff_isotrop(:,:,:)= zero
+
+
+    !! 1.6 Initialize indexing table for the vegetation fields. 
+    ! In SECHIBA we work on reduced grids but to store in the full 3D filed vegetation variable 
+    ! we need another index table : indexveg, indexsoil, indexnobio and indexgrnd
+    DO ji = 1, kjpindex
+       !
+       DO jv = 1, nlai+1
+          indexlai((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+       DO jv = 1, nvm
+          indexveg((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !      
+       DO jv = 1, nstm
+          indexsoil((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !      
+       DO jv = 1, nnobio
+          indexnobio((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+       DO jv = 1, ngrnd
+          indexgrnd((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+       DO jv = 1, nsnow
+          indexsnow((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij
+       ENDDO
+
+       DO jv = 1, nbdl
+          indexnbdl((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij
+       ENDDO
+
+       DO jv = 1, nslm
+          indexlayer((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+       DO jv = 1, 2
+          indexalb((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+    ENDDO
+
+    ! 1.7 now we create and initialize some plant variables that need to be passed
+    ! around sechiba and stomate (from the merge, there might be more to
+    ! put here)
+
+
+    ALLOCATE(nlevels_loc(kjpindex),stat=ier)
+    IF (ier .NE. 0) CALL ipslerr_p (3,'sechiba_init','Pb in alloc for nlevels_loc','','')
+    nlevels_loc(:) = val_exp
+
+    ALLOCATE (h_array_out(kjpindex,nvm,ncirc,nlevels_tot),STAT=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'sechiba_init','Pb in alloc for h_arrat_out','','')
+
+    ALLOCATE (z_array_out(kjpindex,nvm,ncirc,nlevels_tot),STAT=ier)
+    IF (ier.NE.0) CALL ipslerr_p (3,'sechiba_init','Pb in alloc for z_array_out','','')
+
+    ALLOCATE (profile_vbeta3(kjpindex,nvm,nlevels_tot),STAT=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in profile_vbeta3 allocation.'
+       WRITE (numout,*) 'We stop. We need kjpindex*nvm words =',kjpindex*nvm*nlevels_tot
+       STOP
+    END IF
+
+    ALLOCATE (profile_rveget(kjpindex,nvm,nlevels_tot),STAT=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in profile_rveget allocation.'
+       WRITE (numout,*) 'We stop. We need kjpindex*nvm words =',kjpindex*nvm*nlevels_tot
+       STOP
+    END IF
+
+        ALLOCATE (delta_c13_assim(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in delta_c13_assim allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+    delta_c13_assim(:,:)=undef_sechiba
+
+    ALLOCATE (leaf_ci_out(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in leaf_ci_out allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+    leaf_ci_out(:,:)=undef_sechiba
+
+    ALLOCATE (gpp_day(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in gpp_day allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+    gpp_day(:,:)=undef_sechiba
+
+    ALLOCATE(circ_class_n(kjpindex,nvm,ncirc),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for circ_class_n. We stop. We need kjpindex*nvm*ncirc words', &
+       &      kjpindex,nvm,ncirc
+      CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    ENDIF
+    circ_class_n(:,:,:) = val_exp
+
+    ALLOCATE(circ_class_biomass(kjpindex,nvm,ncirc,nparts,nelements),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for circ_class_biomass.'
+       WRITE(numout,*) 'We stop. We need kjpindex*nvm*nparts*ncirc*nelmements words', &
+       &      kjpindex,nvm,ncirc,nparts,nelements
+      CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    ENDIF
+    circ_class_biomass(:,:,:,:,:) = val_exp
+
+
+    !ALLOCATE(biomass(kjpindex,nvm,nparts,nelements),stat=ier)
+    !IF (ier .NE. 0) THEN
+    !   WRITE(numout,*) 'Memory allocation error for biomass.'
+    !   WRITE(numout,*) 'We stop. We need kjpindex*nvm*nparts*nelmements words',&
+    !   &      kjpindex,nvm,nparts,nelements
+    !  CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    !ENDIF
+    !biomass(:,:,:,:) = val_exp
+
+    !ALLOCATE(ind(kjpindex,nvm),stat=ier)
+    !IF (ier .NE. 0) THEN
+    !   WRITE(numout,*) 'Memory allocation error for biomass.'
+    !   WRITE(numout,*) 'We stop. We need kjpindex*nvm words', &
+    !   &      kjpindex,nvm
+    !  CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    !ENDIF
+    !ind(:,:) = val_exp
+
+    ALLOCATE(lai_per_level(kjpindex,nvm,nlevels_tot),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for lai_per_level. We stop. '//&
+            'We need kjpindex*nvm*nlevels_tot words', &
+       &      kjpindex,nvm,nlevels_tot
+      CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    ENDIF
+    lai_per_level(:,:,:)=val_exp
+
+   !multilayer allocations
+
+    ALLOCATE (u_speed(jnlvls),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in u_speed allocation. We stop. We need kjpindex words = ',jnlvls
+       CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    END IF
+
+    ALLOCATE (flux_rn_grid(kjpindex,jnlvls),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in flux_rn_grid allocation. We stop. We need kjpindex words = ',jnlvls
+        STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (flux_h_grid(kjpindex,jnlvls),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in flux_h_grid allocation. We stop. We need kjpindex words = ',jnlvls
+       CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    END IF
+
+    ALLOCATE (flux_le_grid(kjpindex,jnlvls),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in flux_le_grid allocation. We stop. We need kjpindex words = ',jnlvls
+       CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    END IF
+
+    ALLOCATE (u_speed_grid(kjpindex,jnlvls),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in u_speed_grid allocation. We stop. We need kjpindex words = ',jnlvls
+       CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    END IF
+
+    ALLOCATE (temp_atmos_pres_grid(kjpindex,jnlvls),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in temp_atmos_pres_grid allocation. We stop. We need kjpindex words = ',jnlvls
+       CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    END IF
+
+    ALLOCATE (q_atmos_pres_grid(kjpindex,jnlvls),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in q_atmos_pres_grid allocation. We stop. We need kjpindex words = ',jnlvls
+       CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    END IF
+
+    ALLOCATE (temp_leaf_pres_grid(kjpindex,jnlvls),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in temp_leaf_pres_grid allocation. We stop. We need kjpindex words = ',jnlvls
+       CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    END IF
+
+    ALLOCATE (t_a_next_grid(kjpindex,jnlvls),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in t_a_next_grid allocation. We stop. We need kjpindex words = ',jnlvls
+       CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    END IF
+
+    ALLOCATE (q_a_next_grid(kjpindex,jnlvls),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in q_a_next_grid allocation. We stop. We need kjpindex words = ',jnlvls
+       CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    END IF
+
+    ALLOCATE (swc(kjpindex,nslm,nstm))
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in swc allocation. We stop. We need kjpindex words = ',jnlvls
+       CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    END IF
+
+    ALLOCATE (ksave(kjpindex,nslm,nstm))
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in ksave allocation. We stop. We need kjpindexwords = ',jnlvls
+       CALL ipslerr_p (3,'sechiba','sechiba_init','','')
+    END IF
+
+    ALLOCATE (t2m_month_out(kjpindex),STAT=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in t2m_month_out allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP
+    END IF
+
+    ALLOCATE (psold(kjpindex),STAT=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in psold allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP
+    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
+    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
+    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
+    END IF
+
+
+
+
+!! 2. Read the default value that will be put into variable which are not in the restart file
+    CALL ioget_expval(val_exp)
+    
+    IF (printlev>=3) WRITE (numout,*) ' sechiba_init done '
+
+  END SUBROUTINE sechiba_init
+  
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_clear
+!!
+!>\BRIEF        Deallocate memory of sechiba's variables
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================ 
+
+  SUBROUTINE sechiba_clear()
+
+!! 1. Initialize first run
+
+    l_first_sechiba=.TRUE.
+
+!! 2. Deallocate dynamic variables of sechiba
+
+    IF ( ALLOCATED (indexveg)) DEALLOCATE (indexveg)
+    IF ( ALLOCATED (indexlai)) DEALLOCATE (indexlai)
+    IF ( ALLOCATED (indexsoil)) DEALLOCATE (indexsoil)
+    IF ( ALLOCATED (indexnobio)) DEALLOCATE (indexnobio)
+    IF ( ALLOCATED (indexsnow)) DEALLOCATE (indexsnow)
+    IF ( ALLOCATED (indexgrnd)) DEALLOCATE (indexgrnd)
+    IF ( ALLOCATED (indexlayer)) DEALLOCATE (indexlayer)
+    IF ( ALLOCATED (indexnbdl)) DEALLOCATE (indexnbdl)
+    IF ( ALLOCATED (indexalb)) DEALLOCATE (indexalb)
+    IF ( ALLOCATED (flood_res)) DEALLOCATE (flood_res)
+    IF ( ALLOCATED (flood_frac)) DEALLOCATE (flood_frac)
+    IF ( ALLOCATED (snow)) DEALLOCATE (snow)
+    IF ( ALLOCATED (snow_age)) DEALLOCATE (snow_age)
+    IF ( ALLOCATED (drysoil_frac)) DEALLOCATE (drysoil_frac)
+    IF ( ALLOCATED (evap_bare_lim)) DEALLOCATE (evap_bare_lim)
+    IF ( ALLOCATED (evapot)) DEALLOCATE (evapot)
+    IF ( ALLOCATED (evapot_corr)) DEALLOCATE (evapot_corr)
+    IF ( ALLOCATED (humrel)) DEALLOCATE (humrel)
+    IF ( ALLOCATED (vegstress)) DEALLOCATE (vegstress)
+    IF ( ALLOCATED (soiltile)) DEALLOCATE (soiltile)
+    IF ( ALLOCATED (njsc)) DEALLOCATE (njsc)
+    IF ( ALLOCATED (reinf_slope)) DEALLOCATE (reinf_slope)
+    IF ( ALLOCATED (vbeta1)) DEALLOCATE (vbeta1)
+    IF ( ALLOCATED (vbeta4)) DEALLOCATE (vbeta4)
+    IF ( ALLOCATED (vbeta5)) DEALLOCATE (vbeta5)
+    IF ( ALLOCATED (soilcap)) DEALLOCATE (soilcap)
+    IF ( ALLOCATED (soilflx)) DEALLOCATE (soilflx)
+    IF ( ALLOCATED (temp_sol)) DEALLOCATE (temp_sol)
+    IF ( ALLOCATED (qsurf)) DEALLOCATE (qsurf)
+    IF ( ALLOCATED (qsintveg)) DEALLOCATE (qsintveg)
+    IF ( ALLOCATED (vbeta2))  DEALLOCATE (vbeta2)
+    IF ( ALLOCATED (vbeta3)) DEALLOCATE (vbeta3)
+    IF ( ALLOCATED (vbeta3pot)) DEALLOCATE (vbeta3pot)
+    IF ( ALLOCATED (gsmean)) DEALLOCATE (gsmean)
+    IF ( ALLOCATED (cimean)) DEALLOCATE (cimean)
+    IF ( ALLOCATED (gpp)) DEALLOCATE (gpp)
+    IF ( ALLOCATED (temp_growth)) DEALLOCATE (temp_growth) 
+    IF ( ALLOCATED (veget)) DEALLOCATE (veget)
+    IF ( ALLOCATED (veget_max)) DEALLOCATE (veget_max)
+    IF ( ALLOCATED (tot_bare_soil)) DEALLOCATE (tot_bare_soil)
+    IF ( ALLOCATED (lai)) DEALLOCATE (lai)
+    IF ( ALLOCATED (frac_age)) DEALLOCATE (frac_age)
+    IF ( ALLOCATED (height)) DEALLOCATE (height)
+    IF ( ALLOCATED (roughheight)) DEALLOCATE (roughheight)
+    IF ( ALLOCATED (frac_nobio)) DEALLOCATE (frac_nobio)
+    IF ( ALLOCATED (snow_nobio)) DEALLOCATE (snow_nobio)
+    IF ( ALLOCATED (snow_nobio_age)) DEALLOCATE (snow_nobio_age)
+    IF ( ALLOCATED (assim_param)) DEALLOCATE (assim_param)
+    IF ( ALLOCATED (vevapflo)) DEALLOCATE (vevapflo)
+    IF ( ALLOCATED (vevapsno)) DEALLOCATE (vevapsno)
+    IF ( ALLOCATED (vevapnu)) DEALLOCATE (vevapnu)
+    IF ( ALLOCATED (totfrac_nobio)) DEALLOCATE (totfrac_nobio)
+    IF ( ALLOCATED (floodout)) DEALLOCATE (floodout)
+    IF ( ALLOCATED (runoff)) DEALLOCATE (runoff)
+    IF ( ALLOCATED (drainage)) DEALLOCATE (drainage)
+    IF ( ALLOCATED (reinfiltration)) DEALLOCATE (reinfiltration)
+    IF ( ALLOCATED (irrigation)) DEALLOCATE (irrigation)
+    IF ( ALLOCATED (tot_melt)) DEALLOCATE (tot_melt)
+    IF ( ALLOCATED (vbeta)) DEALLOCATE (vbeta)
+    IF ( ALLOCATED (rau)) DEALLOCATE (rau)
+    IF ( ALLOCATED (deadleaf_cover)) DEALLOCATE (deadleaf_cover)
+    IF ( ALLOCATED (stempdiag)) DEALLOCATE (stempdiag)
+    IF ( ALLOCATED (co2_flux)) DEALLOCATE (co2_flux)
+    IF ( ALLOCATED (shumdiag)) DEALLOCATE (shumdiag)
+    IF ( ALLOCATED (shumdiag_perma)) DEALLOCATE (shumdiag_perma)
+    IF ( ALLOCATED (litterhumdiag)) DEALLOCATE (litterhumdiag)
+    IF ( ALLOCATED (ptnlev1)) DEALLOCATE (ptnlev1)
+    IF ( ALLOCATED (k_litt)) DEALLOCATE (k_litt)
+    IF ( ALLOCATED (vevapwet)) DEALLOCATE (vevapwet)
+    IF ( ALLOCATED (transpir)) DEALLOCATE (transpir)
+    IF ( ALLOCATED (stressed)) DEALLOCATE (stressed)
+    IF ( ALLOCATED (unstressed)) DEALLOCATE (unstressed)
+    IF ( ALLOCATED (transpir_mod)) DEALLOCATE (transpir_mod)
+    IF ( ALLOCATED (transpir_supply)) DEALLOCATE (transpir_supply)
+    IF ( ALLOCATED (vir_transpir_supply)) DEALLOCATE (vir_transpir_supply)
+    IF ( ALLOCATED (e_frac)) DEALLOCATE (e_frac)
+    IF ( ALLOCATED (transpot)) DEALLOCATE (transpot)
+    IF ( ALLOCATED (qsintmax)) DEALLOCATE (qsintmax)
+    IF ( ALLOCATED (rveget)) DEALLOCATE (rveget)
+    IF ( ALLOCATED (rstruct)) DEALLOCATE (rstruct)
+    IF ( ALLOCATED (frac_snow_veg)) DEALLOCATE (frac_snow_veg)
+    IF ( ALLOCATED (frac_snow_nobio)) DEALLOCATE (frac_snow_nobio)
+    IF ( ALLOCATED (snowrho)) DEALLOCATE (snowrho)
+    IF ( ALLOCATED (snowgrain)) DEALLOCATE (snowgrain)
+    IF ( ALLOCATED (snowtemp)) DEALLOCATE (snowtemp)
+    IF ( ALLOCATED (snowdz)) DEALLOCATE (snowdz)
+    IF ( ALLOCATED (snowheat)) DEALLOCATE (snowheat)
+    IF ( ALLOCATED (cgrnd_snow)) DEALLOCATE (cgrnd_snow)
+    IF ( ALLOCATED (dgrnd_snow)) DEALLOCATE (dgrnd_snow)
+    IF ( ALLOCATED (lambda_snow)) DEALLOCATE(lambda_snow) 
+    IF ( ALLOCATED (gtemp)) DEALLOCATE (gtemp)
+    IF ( ALLOCATED (pgflux)) DEALLOCATE (pgflux)
+    IF ( ALLOCATED (mc_layh)) DEALLOCATE (mc_layh)
+    IF ( ALLOCATED (mcl_layh)) DEALLOCATE (mcl_layh)
+    IF ( ALLOCATED (tmc_layh)) DEALLOCATE (tmc_layh)
+   
+    ! (added for the MERGE)
+    IF ( ALLOCATED (albedo_pft)) DEALLOCATE(albedo_pft)
+    IF ( ALLOCATED (u_speed)) DEALLOCATE(u_speed)
+    IF ( ALLOCATED (warnings)) DEALLOCATE (warnings)
+    IF ( ALLOCATED (lai_per_level)) DEALLOCATE(lai_per_level)
+    IF ( ALLOCATED (laieff_fit)) DEALLOCATE(laieff_fit)
+    IF ( ALLOCATED (max_height_store)) DEALLOCATE(max_height_store)
+    IF ( ALLOCATED (h_array_out)) DEALLOCATE(h_array_out)
+    IF ( ALLOCATED (z_array_out)) DEALLOCATE(z_array_out)
+    IF ( ALLOCATED (Isotrop_Abs_Tot_p)) DEALLOCATE(Isotrop_Abs_Tot_p)
+    IF ( ALLOCATED (Isotrop_Tran_Tot_p)) DEALLOCATE(Isotrop_Tran_Tot_p)
+    IF ( ALLOCATED (laieff_isotrop)) DEALLOCATE(laieff_isotrop)
+    IF ( ALLOCATED (circ_class_biomass)) DEALLOCATE(circ_class_biomass)
+    IF ( ALLOCATED (circ_class_n)) DEALLOCATE(circ_class_n)
+
+    IF ( ALLOCATED (profile_vbeta3)) DEALLOCATE(profile_vbeta3)
+    IF ( ALLOCATED (profile_rveget)) DEALLOCATE(profile_rveget)
+    IF ( ALLOCATED (delta_c13_assim)) DEALLOCATE (delta_c13_assim)
+    IF ( ALLOCATED (leaf_ci_out)) DEALLOCATE (leaf_ci_out)
+
+    IF (ALLOCATED(swc)) DEALLOCATE(swc)
+    IF (ALLOCATED(ksave)) DEALLOCATE(ksave)
+
+!! 3. Clear all allocated memory
+
+    CALL pft_parameters_clear
+    CALL slowproc_clear 
+    CALL diffuco_clear 
+    CALL enerbil_clear  
+    CALL hydrol_clear 
+    CALL thermosoil_clear
+    CALL condveg_clear 
+    CALL routing_clear
+
+  END SUBROUTINE sechiba_clear
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_var_init
+!!
+!>\BRIEF        Calculate air density as a function of air temperature and 
+!! pressure for each terrestrial pixel.
+!! 
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUT VARIABLE(S): air density (::rau, kg m^{-3}).
+!! 
+!! REFERENCE(S)	: None
+!! 
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE sechiba_var_init (kjpindex, rau, pb, temp_air) 
+
+!! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                    :: kjpindex        !! Domain size - terrestrial pixels only (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: pb              !! Surface pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: temp_air        !! Air temperature (K)
+    
+!! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: rau             !! Air density @tex $(kg m^{-3})$ @endtex
+
+!! 0.3 Modified variables
+
+!! 0.4 Local variables
+
+    INTEGER(i_std)                                 :: ji              !! Indices (unitless)
+!_ ================================================================================================================================
+    
+!! 1. Calculate intial air density (::rau)
+   
+    DO ji = 1,kjpindex
+       rau(ji) = pa_par_hpa * pb(ji) / (cte_molr*temp_air(ji))
+    END DO
+
+    IF (printlev>=3) WRITE (numout,*) ' sechiba_var_init done '
+
+  END SUBROUTINE sechiba_var_init
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_end
+!!
+!>\BRIEF        Swap old for newly calculated soil temperature.
+!! 
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUT VARIABLE(S): soil temperature (::temp_sol; K)
+!! 
+!! REFERENCE(S)	: None
+!! 
+!! FLOWCHART    : None
+!! \n
+!! ================================================================================================================================ 
+
+  SUBROUTINE sechiba_end (kjpindex, temp_sol_new, temp_sol)
+                         
+
+!! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                       :: kjpindex           !! Domain size - terrestrial pixels only (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: temp_sol_new       !! New soil temperature (K)
+    
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)    :: temp_sol           !! Soil temperature (K)
+
+!_ ================================================================================================================================
+    
+!! 1. Swap temperature
+
+    temp_sol(:) = temp_sol_new(:)
+    
+    IF (printlev>=3) WRITE (numout,*) ' sechiba_end done '
+
+  END SUBROUTINE sechiba_end
+
+!! ===============================================================================================================================\n
+!! SUBROUTINE   : sechiba_interface_orchidee_inca
+!!
+!>\BRIEF        make the interface between surface and atmospheric chemistry
+!! 
+!! DESCRIPTION  : This subroutine is called from INCA, the atmospheric chemistry model. It is used to transfer variables from ORCHIDEE to INCA. 
+!!
+!! RECENT CHANGE(S): move from chemistry module to be more generic (feb - 2017)
+!! 
+!! MAIN OUTPUT VARIABLE(S): emission COV to be transport by orchidee to inca in fields_out array 
+!! 
+!! REFERENCE(S) : None
+!! 
+!! FLOWCHART    : None
+!! \n
+!!
+!! ================================================================================================================================ 
+  SUBROUTINE sechiba_interface_orchidee_inca( &
+       nvm_out, veget_max_out, veget_frac_out, lai_out, snow_out, &
+       field_out_names, fields_out, field_in_names, fields_in)
+
+
+    INTEGER, INTENT(out)                      :: nvm_out            !! Number of vegetation types
+    REAL(r_std), DIMENSION (:,:), INTENT(out) :: veget_max_out      !! Max. fraction of vegetation type (LAI -> infty)
+    REAL(r_std), DIMENSION (:,:), INTENT(out) :: veget_frac_out     !! Fraction of vegetation type (unitless, 0-1)  
+    REAL(r_std), DIMENSION (:,:), INTENT(out) :: lai_out            !! Surface foliere
+    REAL(r_std), DIMENSION (:)  , INTENT(out) :: snow_out           !! Snow mass [Kg/m^2]
+
+    !
+    ! Optional arguments
+    !
+    ! Names and fields for emission variables : to be transport by Orchidee to Inca
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_out_names
+    REAL(r_std),DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: fields_out
+    !
+    ! Names and fields for deposit variables : to be transport from chemistry model by INCA to ORCHIDEE.
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_in_names
+    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN)    :: fields_in
+
+
+    ! Variables always transmitted from sechiba to inca
+    nvm_out = nvm 
+    veget_max_out(:,:)  = veget_max(:,:) 
+    veget_frac_out(:,:) = veget(:,:) 
+    lai_out(:,:)  = lai(:,:) 
+    snow_out(:)  = snow(:) 
+
+    ! Call chemistry_flux_interface if at least one of variables field_out_names or
+    ! field_in_names is present in the argument list of sechiba_interface_orchidee_inca when called from inca.
+    IF (PRESENT(field_out_names) .AND. .NOT. PRESENT(field_in_names)) THEN 
+       CALL chemistry_flux_interface(field_out_names=field_out_names, fields_out=fields_out)
+    ELSE IF (.NOT. PRESENT(field_out_names) .AND. PRESENT(field_in_names)) THEN 
+       CALL chemistry_flux_interface(field_in_names=field_in_names, fields_in=fields_in)
+    ELSE IF (PRESENT(field_out_names) .AND. PRESENT(field_in_names)) THEN 
+       CALL chemistry_flux_interface(field_out_names=field_out_names, fields_out=fields_out, &
+            field_in_names=field_in_names, fields_in=fields_in)
+    ENDIF
+
+  END SUBROUTINE sechiba_interface_orchidee_inca
+
+END MODULE sechiba
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/sechiba_hydrol_arch.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/sechiba_hydrol_arch.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/sechiba_hydrol_arch.f90	(revision 6412)
@@ -0,0 +1,2972 @@
+!==================================================================================================================================
+!  MODULE 	: sechiba_hydrol_arch
+! 
+!  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 amount of water that is available for the leaves for transpiration,
+!        accounting for effects of hydraulic architecture following (Hickler et al. 2006)      
+!!
+!!\n DESCRIPTION  : (1) Calculate soil water potential from soil water content as calculated in hydrol.f90
+!!                  according to van Genuchten (1980). Soil water potential is weighted by the relative share of the
+!!                  of theroots in each layer.
+!!                  (2) Calculate pressure difference between leaves and soil (Whitehead 1998)
+!!                  (3) Calculate root (Weatherly 1998), sapwood (Magnani et al. 2000, Tyree et al. 1994,
+!!                  Sperry et al. 1998) and leave resistances (Sitch et al. 2003.
+!!                  (4) Calculate the supply of water for transpiration by the leaves using Darcy's law (Whitehead 1998)
+!! 
+!! RECENT CHANGE(S):(1) Soil to root resistance has been added to the calculations of the soil water potential weighted 
+!!                  by root density. The developed was made by Emilie Joetzjer based on 
+!!                  Williams et al., 2001 (tree physiology) and Duursma et al., 2012 (GMD).
+!! 
+!! REFERENCE(S) : None
+!!   
+!! SVN     :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-DOFOCO/ORCHIDEE/src_sechiba/sechiba.f90 $ 
+!! $Date: 2013-05-06 14:14:36 +0200 (Mon, 06 May 2013) $
+!! $Revision: 1295 $
+!! \n
+!_ ================================================================================================================================
+ 
+MODULE sechiba_hydrol_arch
+ 
+  USE ioipsl
+  USE xios_orchidee
+ 
+  ! modules used :
+  USE constantes
+  USE constantes_soil
+  USE constantes_soil_var
+  USE pft_parameters
+  USE ioipsl_para
+  USE function_library, ONLY: wood_to_height_eff, cc_to_lai, & 
+                              biomass_to_coupled_lai
+  USE qsat_moisture
+
+  IMPLICIT NONE
+
+  ! Private and public routines
+  PRIVATE
+  PUBLIC hydrol_arch, mleb_diffuco_trans_co2
+
+
+  LOGICAL, SAVE                               :: l_first_sechiba = .TRUE.      !! Flag controlling the intialisation (true/false)
+!$OMP THREADPRIVATE(l_first_sechiba)
+!  INTEGER(i_std), SAVE                        :: printlev_loc                  !! Local printlev in slowproc module
+!!$OMP THREADPRIVATE(printlev_loc)
+
+  ! Values depending on the soil type (and also map). The global variable from
+  ! FAO or USDA and read into these depending on the chosen map
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: nvan                !! VanGenuchten coeficients n (unitless) ! RK:
+!$OMP THREADPRIVATE(nvan)                                                 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: avan                !! Van Genuchten coeficients a!@tex!$(mm^{-1})$!@endtex
+!$OMP THREADPRIVATE(avan)                                                
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcr                 !! Residual volumetric water content !! !@tex !$(m^{3} !m^{-3})$!@endtex
+!$OMP THREADPRIVATE(mcr)                                                 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcs                 !! Saturated volumetric water content !@tex !$(m^{3} !m^{-3})$!@endtex
+!$OMP THREADPRIVATE(mcs)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_arch
+!!
+!>\BRIEF        Calculate the amount of water that is available for the leaves for transpiration,
+!               accounting for effects of hydraulic architecture following (Hickler et al. 2006)    
+!!
+!!\n DESCRIPTION : (1) Calculate soil water potential from soil water content as calculated in hydrol.f90 
+!!   according to van Genuchten (1980). Soil water potential is weighted by the relative share of the
+!!   roots in each layer.
+!!   (2) Calculate pressure difference between leaves and soil (Whitehead 1998)
+!!   (3) Calculate root (Weatherly 1998), sapwood (Magnani et al. 2000, Tyree et al. 1994, Sperry et al. 1998)
+!!   and leave resistances (Sitch et al. 2003).
+!!   (4) Calculate the supply of water for transpiration by the leaves using Darcy's law (Whitehead 1998)
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: transpir_supply   
+!!
+!! REFERENCE(S)	: +++COMPLETE+++
+!!                Hickler et al. 2006
+!!                van Genuchten (1980)
+!!                Whitehead 1998
+!!                Weatherly 1998
+!!                Magnani et al. 2000
+!!                Tyree et al. 1994
+!!                Sperry et al. 1998
+!!                Sitch et al. 2003
+!!
+!! FLOWCHART    : 
+!! 
+!_ ================================================================================================================================
+  SUBROUTINE hydrol_arch (kjpindex, circ_class_biomass, circ_class_n, temp_sol_new, &
+       temp_air, swc, transpir_supply, njsc, soiltile, &
+       vir_transpir_supply, veget, &
+       h_array_out3, z_array_out3, transpir_supply_column,ksave, e_frac) 
+
+
+    !! 0. Variable declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                      :: kjpindex            !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std), DIMENSION(:), INTENT (in)       :: njsc                !! Index of the dominant soil textural class 
+                                                                           !! in the grid cell used for hydrology 
+                                                                           !! (1-nscm, unitless)
+    REAL(r_std),DIMENSION (:), INTENT (in)          :: temp_sol_new        !! New ground temperature (K)
+    REAL(r_std),DIMENSION (:), INTENT (in)          :: temp_air            !! Air temperature (K)   
+    REAL(r_std),DIMENSION (:,:), INTENT (in)        :: soiltile            !! Fraction of each soiltile (-)
+    REAL(r_std),DIMENSION (:,:,:), INTENT (in)      :: swc                 !! Volumetric soil water content
+    REAL(r_std),DIMENSION (:,:,:), INTENT (in)      :: circ_class_n        !! number of trees within a circumference class (tree m-2)
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)   :: circ_class_biomass  !! Biomass components of the model tree  
+                                                                           !! within a circumference class
+                                                                           !! class @tex $(g C ind^{-1})$ @endtex  
+    REAL(r_std),DIMENSION (:,:), INTENT (in)        :: veget               !! Fraction of the vegetation that covers the soil
+                                                                           !! also project canopy cover - calculated by Pgap
+    REAL(r_std),DIMENSION (:,:,:), INTENT (in)      :: ksave               !! Hydraulic conductivity mm/d  
+    REAL(r_std),DIMENSION(:, :, :, :), INTENT (in)  :: h_array_out3        !! An output of h_array, to use in sechiba               
+    REAL(r_std),DIMENSION(:, :, :, :), INTENT (in)  :: z_array_out3        !! An output of z_array, to use in sechiba         
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(:,:), INTENT (out)       :: transpir_supply     !! Supply of water for transpiration 
+                                                                           !! @tex $(mm dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT (out)       :: vir_transpir_supply !! Supply of water for transpiration 
+                                                                           !! @tex $(mm dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(out)    :: e_frac              !! Fraction of water transpired supplied by individual layers (no units),
+                                                                           !! dimension(kjpindex,nvm,nbdl,nstm)   
+
+    !! 0.3 Modified variables
+
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                  :: ier                 !! Error handling
+    INTEGER(i_std)                                  :: ipts,ivm,icirc      !! indices
+    INTEGER(i_std)                                  :: ibdl,istm,jst       !! indices
+    INTEGER(i_std)                                  :: tmp_ncirc           !! indices
+    REAL(r_std)                                     :: R_root              !! Hydraulic resistance of the roots
+    REAL(r_std)                                     :: R_leaf              !! Hydraulic resistance of the leaves
+    REAL(r_std)                                     :: R_sap               !! Hydraulic resistance of sapwood 
+    REAL(r_std)                                     :: R_shoot             !! Hydraulic resistance of shoot corrected for temperature
+    REAL(r_std), DIMENSION(ncirc)                   :: height              !! Vegetation height per circ_class_biomass (m)
+    REAL(r_std), DIMENSION(kjpindex,nbdl,nstm)      :: psi_soil            !! Soil water potential per soil layer per soiltile higher 
+                                                                           !! than -5 MPa (threshold for hygroscopic water) (MPa)
+    REAL(r_std), DIMENSION(ncirc)                   :: circ_class_transpir_supply     !! @tex $(m^{3}s^{-1}tree^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                   :: vir_circ_class_transpir_supply !! @tex $(m^{3}s^{-1}tree^{-1})$ @endtex
+    REAL(r_std)                                     :: delta_P             !! Pressure difference between leaves and soil
+    REAL(r_std)                                     :: vir_delta_P         !! Virtual pressure difference between leaves and soil
+    REAL(r_std), DIMENSION(nbdl+1)                  :: z_soil              !! Variable to store depth of the different
+                                                                           !! soil layers (m)
+    REAL(r_std), DIMENSION(nvm)                     :: k_sap_cav           !! sapwood conductivity decreased by cavitation
+    REAL(r_std), DIMENSION(nbdl,nvm)                :: root_dens           !! root density per layer
+    REAL(r_std), DIMENSION(nvm)                     :: rpc                 !! scaling factor for integral
+    REAL(r_std), DIMENSION(kjpindex,nbdl,nstm)      :: psi_soiltile        !! soil water potentential per soil layer per soil tile 
+    REAL(r_std), DIMENSION (kjpindex,nbdl,nstm)     :: swc_adj             !! Volumetric soil water content, adjusted when it is lower 
+                                                                           !! than or equal to the residual soil water content
+    REAL(r_std), DIMENSION(kjpindex,nvm)            :: psi_soilroot        !! Sum of soil water potential in each soil layer weighted 
+                                                                           !! by the share of the roots in each layer (MPa)
+    REAL(r_std), DIMENSION(kjpindex,nvm)            :: vir_psi_soilroot    !! Virtual transpir supply to be used in land cover change
+                                                                           !! Sum of soil water potential in each soil layer weighted 
+                                                                           !! by the share of the roots in each layer (MPa)
+    INTEGER(i_std)                                  :: i                   !! counter
+    REAL(r_std), DIMENSION(nlevels_tot, ncirc)      :: cent_box            !! Height of the mid-point of each box in the column that is made up
+                                                                           !!    of the Pgap points
+    REAL(r_std), DIMENSION(nlevels_tot)             :: delta_P_column      !! Pressure difference between leaves and soil
+    REAL(r_std), DIMENSION(nlevels_tot)             :: vir_delta_P_column  !! Virtual pressure difference between leaves and soil
+    REAL(r_std), DIMENSION(nlevels_tot,ncirc)       :: circ_class_transpir_supply_column !! @tex $(m^{3}s^{-1}tree^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nlevels_tot,ncirc)       :: vir_circ_class_transpir_supply_column !! @tex $(m^{3}s^{-1}tree^{-1})$ @endtex
+
+    REAL(r_std), DIMENSION(nlevels_tot,kjpindex,nvm):: transpir_supply_column !! Supply of water for transpiration 
+                                                                                                         !! @tex $(mm dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nlevels_tot,kjpindex,nvm):: vir_transpir_supply_column !! Virtual supply of water for transpiration 
+                                                                                                         !! @tex $(mm dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nbdl,nstm)      :: e_max               !! Maximum amount of available water for transpiration per layer (mmol m2 s-1)
+    REAL(r_std), DIMENSION(kjpindex,nbdl,nstm)      :: res_soil            !! Soil ro root resistance  per layer
+    REAL(r_std), DIMENSION(kjpindex,nbdl,nstm)      :: ksaveUNIT           !! Hydraulic conductivity (from hydrol.90)
+
+    REAL(r_std), DIMENSION(nbdl)                    :: lr                  !! root length per unit of soil volume (m-2)
+    REAL(r_std), DIMENSION(nbdl)                    :: rs                  !! Mean distanceb etween roots (m) 
+
+    !_ =================================================================================================================================
+
+    !! Initialize local printlev
+    !printlev_loc=get_printlev('hydrolarch')
+
+    ! initialise some variables for the transpir_supply_column loop
+    i = 0
+    cent_box = 0.0d0
+    delta_P_column = 0.0d0
+    vir_delta_P_column = 0.0d0
+    circ_class_transpir_supply_column = 0.0d0
+    vir_circ_class_transpir_supply_column = 0.0d0
+    transpir_supply_column = 0.0d0
+    vir_transpir_supply_column = 0.0d0
+
+    ! To avoid that the plants will not experience water stress in the first 
+    ! day of the simulation. Transpir_supply is calculated before 
+    ! there is any biomass available.
+    transpir_supply(:,:) = val_exp
+    psi_soiltile(:,:,:) = -un
+    e_frac(:,:,:,:) = zero
+
+    ! Distinguish between the two soil map possibilities for these variables
+    ! First we need to make sure there are allocated.
+    
+    IF (.NOT. ALLOCATED(nvan)) THEN
+       ALLOCATE (nvan(nscm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_arch','Pb in allocate of variable nvan','','')
+    ENDIF
+   
+    IF (.NOT. ALLOCATED(avan)) THEN
+       ALLOCATE (avan(nscm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_arch','Pb in allocate of variable avan','','')
+    ENDIF
+       
+    IF (.NOT. ALLOCATED(mcr)) THEN
+       ALLOCATE (mcr(nscm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_arch','Pb in allocate of variable mcr','','')
+    ENDIF
+       
+    IF (.NOT. ALLOCATED(mcs)) THEN
+       ALLOCATE (mcs(nscm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_arch','Pb in allocate of variable mcs','','')
+    ENDIF
+
+    SELECTCASE (nscm)
+    CASE (3)
+       nvan(:) = nvan_fao(:)
+       avan(:) = avan_fao(:)
+       mcr(:) = mcr_fao(:)
+       mcs(:) = mcs_fao(:)
+    CASE (12)
+       nvan(:) = nvan_usda(:)
+       avan(:) = avan_usda(:)
+       mcr(:) = mcr_usda(:)
+       mcs(:) = mcs_usda(:)
+    CASE DEFAULT
+       WRITE (numout,*) 'Unsupported soil type classification. Choose between zobler and usda according to the map'
+       CALL ipslerr_p(3,'hydrol_init','Unsupported soil type classification. ',&
+            'Choose between zobler and usda according to the map','')
+    ENDSELECT 
+
+    !! 1. Calculate plant soil water potential
+
+    ! Soil water potential for each soiltile in each layer from 
+    ! soil water content according to Van Genuchten (1980)
+
+    DO ipts = 1,kjpindex  ! (loopref: ha1)
+
+       ! Debug
+       IF (printlev_loc>=4) THEN
+          WRITE(numout,*) 'soil texture',njsc
+          WRITE(numout,*) 'swc', swc(ipts,:,:)  
+          WRITE(numout,*)'soiltile',soiltile(ipts,:)
+       ENDIF
+       !-
+
+       !! 2.1 Calculate soil water potential
+       !  Swc calculated in hydrol.f90 cannot be lower than or equal 
+       !  to the residual soil water content for each soiltile.
+       DO ibdl = 1, nbdl  ! (loopref: ha2)
+
+          DO istm = 1,nstm ! (loopref: ha3)
+
+             IF (swc(ipts,ibdl,istm) .LE. mcr(njsc(ipts))) THEN
+
+                !+++CHECK+++
+                !Explain why you do this
+                swc_adj(ipts,ibdl,istm) = mcr(njsc(ipts)) + .00001
+                !+++++++++++
+
+             ELSE
+
+                swc_adj(ipts,ibdl,istm) = swc(ipts,ibdl,istm)
+
+                IF (l_first_sechiba) THEN
+                   swc_adj(ipts,ibdl,istm) = min_sechiba
+                ENDIF
+
+             ENDIF
+
+          ENDDO  ! istm = 1,nstm (loopref: ha3)
+
+          ! Soil water potential for each soiltile in each layer from 
+          ! soil water content according to Van Genuchten (1980). Convert 
+          ! unit avan from mm-1 to m-1. Convert units soil matric potential
+          ! from m to MPa by multiplying with cte_grav and rho_h2o. 
+          ! Soiltile = fraction of each soil column 
+          ! (three soil columns=bare soil, tree, grass)
+          DO istm = 1,nstm   ! (loopref: ha4)
+
+             IF (swc_adj(ipts,ibdl,istm) .GT. min_stomate .AND. &
+                  (swc_adj(ipts,ibdl,istm) - mcr(njsc(ipts))) .GT. min_stomate) THEN
+
+                psi_soiltile(ipts,ibdl,istm) = &
+                     - ( cte_grav * rho_h2o * kilo_to_unit * & 
+                     ( 1/(avan(njsc(ipts))*kilo_to_unit) ) * &
+                     ( ( (swc_adj(ipts,ibdl,istm) - mcr(njsc(ipts)) ) / &
+                     ( mcs(njsc(ipts)) - mcr(njsc(ipts)) ) ) ** &
+                     ( -1 / (1-1/nvan(njsc(ipts))) ) - 1) ** &
+                     (1/nvan(njsc(ipts)) ) ) / mega_to_unit
+
+             ELSE
+
+                psi_soiltile(ipts,ibdl,istm) = zero
+
+             ENDIF
+
+          ENDDO   ! DO istm = 1,nstm (loopref: ha4)
+
+          ! Threshold for soil water potential: it cannot be lower than the 
+          ! soil water potential for hygroscopic water (= -5 MPa, Larcher 2001)
+          psi_soil(ipts,ibdl,:) = MAX(psi_soiltile(ipts,ibdl,:),-5.)
+
+          ! Calculate soil water potential per layer by multiplying with 
+          ! the fraction of each soiltile
+          ! psi_soil(ipts,ibdl) = SUM(soiltile(ipts,:) * psi_soiltile(ipts,ibdl,:))
+
+       ENDDO  ! DO ibdl = 1, nbdl  ! (loopref: ha2)
+
+       ! following initialisation of swc
+       l_first_sechiba = .FALSE.
+
+       ! Debug
+       IF (printlev_loc>=4) THEN
+          WRITE(numout,*) 'psi_soiltile', psi_soiltile(ipts,:,:)
+          WRITE(numout,*) 'psi_soil', psi_soil
+       ENDIF
+       !-
+
+       !! 3. Calculate plant resistance
+
+       !! 3.1 Calculate root profile 
+       !  Weighting soil water potential with root profile
+       z_soil(1)= 0.
+       z_soil(2:nbdl+1) = diaglev(1:nbdl)
+
+       ! Scaling factor for integration
+       rpc(:) = un / ( un - EXP( -z_soil(nbdl+1) / humcste(:) ) )
+
+       ! Calculate root density per layer per pft
+       !+++CHECK+++
+       ! what is the root density for layer one ?
+       DO ibdl = 1, nbdl ! Loop over # soil layers (loopref: ha5)
+
+          root_dens(ibdl,:) = rpc(:) * &
+               ( EXP( -z_soil(ibdl)/humcste(:)) - &
+               EXP( -z_soil(ibdl+1)/humcste(:)) )
+
+       ENDDO ! Loop over # soil layers (loopref: ha5)
+       !++++++++++
+       !+++CHECK+++
+       ! check root_dens adds to 1 for each pft
+       IF(printlev_loc .ge. 4) THEN
+          DO ivm=2,nvm
+             WRITE(numout,*)'root_dens for PFT', ivm, SUM(root_dens(:,ivm))
+          ENDDO
+       ENDIF
+       !++++++++++
+
+       !! 3.2 Calculate plant resistance to water transport 
+       !  Calculate plant resistance to water transport according to following
+       !  the principle of an electric circuit. The code is largely based on
+       !  Hickler et al. 2006
+       DO ivm = 2,nvm ! (loopref: ha6)
+
+          !! Calculate PFT-specific characteristics
+          IF (is_tree(ivm)) THEN
+
+             ! Calculate for each circumference classes
+             tmp_ncirc = ncirc
+
+             ! Calculate the effective height (m) from biomass. The effective
+             ! value is used here because the water needs to be transported
+             ! through both the belowground and aboveground biomass. Using the 
+             ! height (thus not the effective height) would only account for the 
+             ! height due to the aboveground biomass.
+             height(:) = wood_to_height_eff(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+          ELSE ! is_tree(ivm)
+
+             ! There are no circumference classes for grasses
+             ! and crops. Biomasses are stored in first circumference
+             ! class
+             tmp_ncirc = 1
+
+             ! Calculate height (m) from biomass
+             height(1) = circ_class_biomass(ipts,ivm,1,ileaf,icarbon) * &
+                  sla(ivm) * lai_to_height(ivm)
+          ENDIF
+
+          !! 3.2.1 Calculate soil to root resistance
+          !  Calculate soil water potential weighted for root density
+          !  Note that the second soiltile in swc is for trees.
+          !  This implementation relies on a strong assumptions. First,
+          !  roots are assumed to follow a rigid distribution irrespective 
+          !  of how the water is distributed in the soil. So even if on 
+          !  average lots of water is available in deeper layer, the modeled 
+          !  plants will grow most roots in the top layers. A detailed description  
+          !  allows for an adjustment of the soil water potential (psi_soilroot)  
+          !  due to soil to root resistance. Psi_soil is weighted by the fraction of 
+          !  evapotranspiration supplied by each layer (E_frac), which depends on 
+          !  the soil to root resistance per layer (res_soil) accounting for 
+          !  different root propertie and hydraulic conductivity.         
+          jst = pref_soil_veg(ivm) 
+
+          ! We can only make these calculations if there is actual root
+          ! biomass. 
+          IF(SUM(circ_class_biomass(ipts,ivm,:,iroot,icarbon)) .GE. min_stomate ) THEN
+
+             DO ibdl = 1, nbdl
+
+                ! Calculate root length and mean distance between roots
+                lr(ibdl)=root_dens(ibdl,ivm)*deux* &
+                     SUM(circ_class_biomass(ipts,ivm,:,iroot,icarbon)*circ_class_n(ipts,ivm,:)) * srl(ivm) 
+                rs(ibdl)=(un/(pi*lr(ibdl)))**(undemi)
+
+                ! Convert units for the hydraulic conductivity from mm/d to m/s
+                ksaveUNIT(ipts,ibdl,jst)=ksave(ipts,ibdl,jst)*mm_m/(one_day)
+
+                ! The soil to root resistance in each layer is calcaulted before
+                ! the contribution from each layer to the evatransporation 
+                ! is determined    
+                res_soil(ipts,ibdl,jst)=(LOG(rs(ibdl)/r_froot(ivm)))/&
+                     (dlh(ibdl)*deux*pi*lr(ibdl)*(ksaveUNIT(ipts,ibdl,jst)/&
+                     (cte_grav*18E-5*1E-3)))
+                e_max(ipts,ibdl,jst)= (psi_soil(ipts,ibdl,jst)-psi_root(ivm))/&
+                     res_soil(ipts,ibdl,jst)
+
+                IF (e_max(ipts,ibdl,jst) .LT. min_sechiba) e_max(ipts,ibdl,jst) = zero
+
+             END DO
+
+             ! If there is a contribution to evatransporation, the fraction
+             ! coming from each layer is calculated followed by calculations 
+             ! of the weighted soil water potential (psi_soilroot). 
+             IF( SUM(e_max(ipts,:,jst)) .GT. min_sechiba) THEN
+
+                DO ibdl = 1, nbdl
+                   e_frac(ipts,ivm,ibdl,jst)=e_max(ipts,ibdl,jst)/SUM(e_max(ipts,:,jst))
+                ENDDO
+                psi_soilroot(ipts,ivm) = SUM( psi_soil(ipts,:,jst)*e_frac(ipts,ivm,:,jst))
+
+             ELSE
+
+                psi_soilroot(ipts,ivm)=-4
+
+             END IF
+
+             !DEBUG  
+             IF(printlev_loc .GE. 4) THEN
+                WRITE(numout,*)'hydrol_arch in biomass statement, ivm, jst',ivm, jst
+                WRITE(numout,*)'psi_soil', psi_soil(ipts,:,jst)
+                WRITE(numout,*)'lr',lr(:)
+                WRITE(numout,*)'rs', rs(:)
+                WRITE(numout,*)'ksaveUNIT', ksaveUNIT(ipts,:,jst)
+                WRITE(numout,*)'res_soil',res_soil(ipts,:,jst)
+                WRITE(numout,*)'e_max',e_max(ipts,:,jst)
+                WRITE(numout,*)'e_frac', e_frac(ipts,ivm,:,jst)
+                WRITE(numout,*)'psi_soilroot',psi_soilroot(ipts,ivm)
+             ENDIF
+
+          ELSE ! IF(biomass .gt. min_stomate) THEN
+
+             ! Only do the calculations for biomass  
+             e_frac(ipts,ivm,:,jst)= zero
+             psi_soilroot(ipts,ivm) = SUM(psi_soil(ipts,:,jst)*e_frac(ipts,ivm,:,jst))
+
+          ENDIF ! (biomass .GT. min_stomate) THEN  
+   
+
+          !! 3.2.2 Calculate general characteristics
+          !  Calculate soil water potential weighted for root density
+          !  Note that the second soiltile in swc is for trees. Calculate
+          !  for both the relevant soil water column i.e. tall vegetation
+          !  and a vertual soil water colum i.e. bare soil. The latter is
+          !  needed in land cover change because we may establish vegetation
+          !  on PFT1 and then need to know the water stress the plants will
+          !  experience on this new soil column.
+          !+++CHECK+++
+          !  should this be sum of soil water potential or the average? The
+          !  virtual_psi_soilroot may need to be revised once the water 
+          !  columns are getting merged in LCC. There are no plants so we 
+          !  should not account for the assumptions and thus not implement the
+          !  tuning factor. 
+          vir_psi_soilroot(ipts,ivm) = SUM(root_dens(:,ivm) * psi_soil(ipts,:,1))
+          !+++++++++++
+
+          !---TEMP---
+          IF (printlev_loc>=4 .AND. ivm .EQ. test_pft) THEN 
+             WRITE(numout,*) 'circ_class_biomass in hydrolic architecture,icirc', &
+                  circ_class_biomass(1,ivm,:,:,icarbon)
+             WRITE(numout,*) 'vegetation height, pft', height(:), ivm
+             WRITE(numout,*) 'z_soil',z_soil(1:nbdl+1)
+             WRITE(numout,*) 'rpc', ivm, rpc(ivm)
+!!$             WRITE(numout,*) 'psi_soilrootlayer',root_dens*psi_soil
+             WRITE(numout,*) 'psi_soilroot', psi_soilroot(:,test_pft)
+             WRITE(numout,*) 'vir_psi_soilroot', vir_psi_soilroot(:,test_pft)
+          ENDIF
+          !----------
+
+          !! 3.2.3 Calculate plant resistences
+          IF ( SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)) .GT. min_sechiba .AND. &
+               SUM(circ_class_biomass(ipts,ivm,:,iroot,icarbon)) .GT. min_sechiba ) THEN
+             
+             DO icirc = 1,tmp_ncirc  ! (loopref ha7)  
+
+                ! This ensures that the loop goes over all circ_classes for trees and only
+                ! the first circ_class for grasses and crops
+                IF (circ_class_biomass(ipts,ivm,icirc,ileaf,icarbon) .GT. min_sechiba .AND. &
+                     circ_class_biomass(ipts,ivm,icirc,iroot,icarbon) .GT. min_sechiba ) THEN 
+
+                   !! 3.2.3.1 Root resistance
+                   !  Root resistance is in the first order related to root mass 
+                   !  and expression was proposed by Weatherly, 1982). Convert
+                   !  units of circ_class_biomss i.e. gC/ind to kg/ind
+                   R_root = un / (k_root(ivm) * 2 * &
+                        circ_class_biomass(ipts,ivm,icirc,iroot,icarbon) &
+                        / kilo_to_unit)
+
+                   !! 3.2.3.2 Sapwood resistance
+                   !  Calculate k_sap_cav as a function of water stress following 
+                   !  Tyree et al. (1994) and Sperry et al. (1998)
+                   IF (is_tree(ivm)) THEN
+
+                      IF( (psi_soilroot(ipts,ivm) == zero) .AND. (psi_50(ivm) .LE. zero) )THEN
+
+                         ! This seems to cause a strange numerical issue, even though we should
+                         ! just be taking the exponential of zero (i.e., one).  
+                         k_sap_cav(ivm) = k_sap(ivm)
+
+                      ELSE
+                         !++++ TEMP +++++
+                         IF((psi_soilroot(ipts,ivm)/psi_50(ivm)) .LT. zero)THEN
+                            !++++++ CHECK +++++++++
+                            ! If this is true, we generally try to take this ratio to
+                            ! an odd power, which results in an imaginary number.  So
+                            ! we use this simple solution for the moment.
+                         !   WRITE(numout,*) 'psi_soilroot', psi_soilroot(ipts,ivm)
+                         !   WRITE(numout,*) 'ipts', ipts
+                         !   WRITE(numout,*) 'ivm', ivm
+                         !   CALL ipslerr_p (3,'sechiba_hydrol_arch', &
+                         !        'this quantity should never be negative', &
+                         !        'See the output file for more details.','')
+                            ! A temporary fix.  We cannot have the stop statement anymore,
+                            ! since capping psi_soilroot at 0.0 above results in many PFTs
+                            ! dying.  This needs to be addressed.
+                            k_sap_cav(ivm) = k_sap(ivm)
+                         ELSE
+                            k_sap_cav(ivm) = k_sap(ivm) * &
+                                 EXP(-((psi_soilroot(ipts,ivm)/psi_50(ivm)) ** &
+                                 c_cavitation(ivm)))
+                         ENDIF
+
+                      ENDIF
+
+                      ! If k_sap_cav is too low, we can get a divide by zero
+                      ! error in the next couple lines.  So this is a protection
+                      ! against that.
+                      IF(k_sap_cav(ivm) .LE. min_sechiba)THEN
+
+                         k_sap_cav(ivm) = min_sechiba
+
+                      ENDIF
+
+                      !  Following the expression by Magnani et al 2000, sapwood resistance
+                      !  is given as a function of sapwood area. Convert Sapwood mass to 
+                      !  sapwood area
+                      R_sap = (height(icirc)**2 * tree_ff(ivm)*pipe_density(ivm)) / (k_sap_cav(ivm) * &
+                           ( circ_class_biomass(ipts,ivm,icirc,isapabove,icarbon) + &
+                           circ_class_biomass(ipts,ivm,icirc,isapbelow,icarbon)))
+
+                   ELSE  ! IF (is_tree(ivm)) THEN
+
+                      !+++CHECK+++
+                      ! We have about the same leaf and root restistances and masses
+                      ! as for tress but lack a resistance in the sapwood. This is resulting
+                      ! in a huge supply because we lack part of the resistance. This was 
+                      ! the motivation to create an R_sap for grasses and roots. This equation 
+                      ! is made up and should be carefully checked against physiological
+                      ! studies for grasses and crops on the issue.
+                      R_sap = (height(icirc)**2 * pipe_density(ivm)) / (k_sap(ivm) *  &
+                           circ_class_biomass(ipts,ivm,icirc,isapabove,icarbon))
+                      !+++++++++++
+
+                   ENDIF  ! IF (is_tree(ivm)) THEN 
+
+                   !! 3.2.3.3 Leaf resistance
+                   !  Leaf resistance related to foliar projective area (Hickler 2006) or 
+                   !  LAI (more consistent with pipe model)? fpc instead of lai because 
+                   !  it is assumed that only sunlit leaves contribute to transpiration
+                   !  Initialy fpc = 1-e**(-0.5*LAI) but it was replaxced by veget which
+                   !  in itseld is calculated in Pgap and thus accounts for LAI and canopy
+                   !  structure. This was still inconsistent with the calculation of the
+                   ! atmospheric demand for transpiration, to improve consistency the coupled
+                   ! lai was used as was done in the energy budget calculations.
+                   ! R_leaf = 1/(k_leaf * fpc)
+!!$                   R_leaf = un / (k_leaf(ivm) * &
+!!$                        (un - EXP(-0.5 * circ_class_biomass(ipts,ivm,icirc,ileaf,icarbon) * &
+!!$                        sla(ivm))))
+                   R_leaf = un / (k_leaf(ivm) * &
+                        biomass_to_coupled_lai(circ_class_biomass(ipts,ivm,icirc,ileaf,icarbon), &
+                        veget(ipts,ivm),ivm))
+
+                   !! 3.2.3.4 Temperature dependance of resistance
+                   !  Decrease root resistance with soil temperature as a result of 
+                   !  changes in water viscosity (Cochard et al 2000)
+                   !  Decrease shoot resistance with air temperature (Cochard et al. 2000)
+                   R_root = R_root / (a_viscosity(1) + a_viscosity(2) * &
+                        (temp_sol_new(ipts) - zeroCelsius))               
+                   R_shoot = (R_leaf + R_sap) / (a_viscosity(1) + a_viscosity(2) * &
+                        (temp_air(ipts) - zeroCelsius))
+
+                     ! (JR 150115) in this version we try to calculate delta_P and vir_delta_P against height
+                     ! calculate the 'mid-point' of the P_gap points
+
+                   IF (.NOT. ok_impose_can_structure ) THEN
+                    !DO i = 1, nlevels_tot - 1
+                    !    cent_box(i, icirc) = z_array_out3(1,ivm,1,i) + (z_array_out3(1,ivm,1,i+1) - z_array_out3(1,ivm,1,i)) / 2.0d0
+                    !END DO
+                    !cent_box(nlevels_tot, icirc) = z_array_out3(1,ivm,1,nlevels_tot) + &
+                    !          &         ( h_array_out3(1,ivm,1, nlevels_tot) - z_array_out3(1,ivm,1,nlevels_tot) ) / 2.0d0                     
+                    ! DO i = 1, nlevels_tot
+                    !     WRITE(numout, *) 'cent_box(i, icirc) is: ', cent_box(i, icirc)
+                    ! END DO
+                    !   DO i = 1, nlevels_tot
+                    !       delta_P_column(i) = psi_leaf(ivm) - psi_soilroot(ipts,ivm) + &
+                    !            (cent_box(i, icirc)*cte_grav*rho_h2o) / kilo_to_unit                     
+                    !       vir_delta_P_column(i) = psi_leaf(ivm) - vir_psi_soilroot(ipts,ivm) + &
+                    !            (cent_box(i, icirc)*cte_grav*rho_h2o) / kilo_to_unit 
+                    !   END DO
+                   END IF ! (ok_impose_can_structure ) THEN 
+
+                   !! 3.2.3.5 Calculate pressure difference between leaves and soil 
+                   !  Defined by Whitehead 1998. Convert units to MPa.
+                   !+++CHECK+++
+                   ! If height is kept as a variable the delta_P gets out of bounds
+                   ! this seems to be one of the places where the static approach
+                   ! by Hickler fails. Could this be overcome by Sperry et al?
+                   ! As a quick fix we limit the height. This might have been acceptable
+                   ! if we would not have had to limit it at only 8m!
+!!$                   IF (height(icirc) .GT. 8.) height(icirc) = 8.
+                   delta_P = psi_leaf(ivm) - psi_soilroot(ipts,ivm) + &
+                        (height(icirc)*cte_grav*rho_h2o) / kilo_to_unit
+                   vir_delta_P = psi_leaf(ivm) - vir_psi_soilroot(ipts,ivm) + &
+                        (height(icirc)*cte_grav*rho_h2o) / kilo_to_unit
+                   !++++++++++
+
+                   !! 3.2.3.6 Calculate water supply for transpiration in m/s
+                   ! Using Dracy's law (Slatyer 1967, Whitehead 1998)
+                   circ_class_transpir_supply(icirc) = (-delta_P) / (R_root + R_shoot)
+                   vir_circ_class_transpir_supply(icirc) = (-vir_delta_P) / (R_root + R_shoot)
+
+
+
+                   IF (.NOT. ok_impose_can_structure ) THEN 
+                       DO i = 1, nlevels_tot
+                           circ_class_transpir_supply_column(i, icirc) = (-delta_P_column(i)) / (R_root + R_shoot)
+                           vir_circ_class_transpir_supply_column(i, icirc) = (-vir_delta_P_column(i)) / (R_root + R_shoot)
+                       END DO
+                   END IF ! (ok_impose_can_structure ) THEN 
+
+
+                ELSE  
+                      
+                   !set transpir_supply to zero if there is no leaf or root biomass in the circ_class 
+                   circ_class_transpir_supply(icirc) = zero
+                   vir_circ_class_transpir_supply(icirc) = zero
+
+             ENDIF
+
+             !---TEMP--- 
+             IF (printlev_loc>=4 .AND. ivm .EQ. test_pft) THEN
+                WRITE(numout,*) 'root_dens', root_dens(:,ivm)
+                WRITE(numout,*) 'k_sap_cavitation, biomass(iroot)', k_sap_cav(ivm), &
+                     2 * circ_class_biomass(ipts,ivm,icirc,iroot,icarbon) / 1000.
+                WRITE(numout,*) 'sapwood area, ', ( circ_class_biomass(ipts,ivm,icirc,isapabove,icarbon) + &
+                     circ_class_biomass(ipts,ivm,icirc,isapbelow,icarbon)) / (tree_ff(ivm) * pipe_density(ivm)) / &
+                     height(icirc)
+                WRITE(numout,*) 'fpc, ',(1-EXP(-0.5*circ_class_biomass(ipts,ivm,icirc,ileaf,icarbon)*sla(ivm)))
+                WRITE(numout,*) 'R_root, R_sap, R_leaf', R_root, R_sap, R_leaf
+                WRITE(numout,*) 'R_shoot', R_shoot 
+                WRITE(numout,*) 'delta_P', delta_P
+             ENDIF
+             !----------
+
+
+          ENDDO ! DO icirc = 1,tmp_ncirc (loopref ha7) 
+
+
+          ! trying to calculate the transpiration supply at different heights here:
+
+          IF (.NOT. ok_impose_can_structure ) THEN 
+
+              DO i = 1, nlevels_tot
+                  transpir_supply_column(i, ipts, ivm) = &
+                      (SUM(circ_class_transpir_supply_column(i, :) * circ_class_n(ipts,ivm,:))) * &
+                      dt_sechiba * kilo_to_unit
+                  vir_transpir_supply_column(i, ipts, ivm) = &
+                      (SUM(circ_class_transpir_supply_column(i, :) * circ_class_n(ipts,ivm,:))) * &
+                      dt_sechiba * kilo_to_unit
+              END DO ! i = 1, nlevels_tot
+
+
+
+          ! Set transpir_supply to zero when negative.
+          ! (When psisoilroot becomes very low, delta_P becomes positive and transpir_supply negative)
+            DO i = 1, nlevels_tot
+               IF (transpir_supply_column(i, ipts, ivm) .LT. zero) THEN
+                   WRITE(numout,*) 'transpir_supply before set to zero when negative', transpir_supply(ipts,ivm), ivm
+                   WRITE(numout,*) 'psisoilroot', psi_soilroot(ipts,ivm)
+                   transpir_supply_column(i, ipts, ivm) = MAX(transpir_supply_column(i, ipts, ivm), zero)
+                   vir_transpir_supply_column(i, ipts, ivm) = MAX(vir_transpir_supply_column(i, ipts, ivm), zero)
+               ELSE
+                   !do nothing
+               ENDIF   
+            END DO ! i = 1, nlevels_tot
+
+          END IF ! (ok_impose_can_structure ) THEN 
+
+
+
+          !+++CHECK+++
+          ! Just to be sure that we are not double counting for grasses and crops
+          IF (is_tree(ivm)) THEN
+             ! transpir_supply per PFT (sum of diameter classes) per timestep
+             transpir_supply(ipts,ivm) = &
+                  (SUM(circ_class_transpir_supply(:) * circ_class_n(ipts,ivm,:))) * &
+                  dt_sechiba * kilo_to_unit
+             vir_transpir_supply(ipts,ivm) = &
+                  (SUM(vir_circ_class_transpir_supply(:) * circ_class_n(ipts,ivm,:))) * &
+                  dt_sechiba * kilo_to_unit
+          ELSE
+             transpir_supply(ipts,ivm) = &
+                  (circ_class_transpir_supply(1) * circ_class_n(ipts,ivm,1)) * &
+                  dt_sechiba * kilo_to_unit
+             vir_transpir_supply(ipts,ivm) = &
+                  (vir_circ_class_transpir_supply(1) * circ_class_n(ipts,ivm,1)) * &
+                  dt_sechiba * kilo_to_unit
+          ENDIF
+          !+++++++++++
+
+          ! Set transpir_supply to zero when negative.
+          ! (When psisoilroot becomes very low, delta_P becomes positive and transpir_supply negative)
+          IF (transpir_supply(ipts,ivm) .LT. zero) then
+             IF(printlev_loc.GT.4)THEN
+                WRITE(numout,*) 'transpir_supply before set to zero when negative', transpir_supply(ipts,ivm), ivm
+                WRITE(numout,*) 'ipts, ivm:', ipts,ivm
+                WRITE(numout,*) 'transpir_supply: ', transpir_supply(ipts,ivm)
+                WRITE(numout,*) 'psisoilroot: ', psi_soilroot(ipts,ivm)
+             ENDIF
+             transpir_supply(ipts,ivm) = MAX(transpir_supply(ipts,ivm), zero)
+             vir_transpir_supply(ipts,ivm) = MAX(vir_transpir_supply(ipts,ivm), zero)
+          ELSE
+             !do nothing
+          ENDIF   
+
+          ! transpir_supply is in m/s. Convert to mm/dt
+          ! transpir_supply(ipts,ivm) = transpir_supply(ipts,ivm) * dt_sechiba * 1000
+!!$             WRITE(numout,*) 'transpir_supply', transpir_supply
+
+          ! Calculate daily water stress for use in stomate
+!!$             IF (transpir_supply .LE. transpir) THEN
+!!$                hydrol_stress(ipts,ivm) = transpir_supply(ipts,ivm)/transpir(ipts,ivm)
+!!$             ELSE IF (transpir_supply .GT. transpir) THEN
+!!$                hydrol_stress(ipts,ivm) = 1.
+!!$             ENDIF
+
+          ! Hydraulic architecure is not defined i.e. no biomass
+       ELSE
+
+          transpir_supply(ipts,ivm) = zero
+          psi_soilroot(ipts,ivm) = zero
+
+!                DO i = 1, nlevels_tot
+!                    transpir_supply_column(i, ipts, :) = zero
+!                    vir_transpir_supply_column(i, ipts, :) = zero
+!                END DO ! i = 1, nlevels_tot
+
+
+       ENDIF ! biomass leaves and roots.gt.zero
+          
+    ENDDO ! ivm = 2,nvm (loopref: ha6)
+
+ ENDDO ! kjpindexipts  ! DO ipts = 1,kjpindex (loopref: ha1) 
+
+ !---TEMP---
+ IF (printlev_loc>=4) THEN
+    WRITE(numout,*) 'transpir_supply, ', transpir_supply(:,:)
+    WRITE(numout,*) 'vir_transpir_supply, ', vir_transpir_supply(:,:)
+ ENDIF
+ !----------
+
+ ! Send output variables to xios
+ CALL xios_orchidee_send_field("psi_soil",psi_soil)
+
+END SUBROUTINE hydrol_arch
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : mleb_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
+!! - Yin, X. and Struik, P. C., 2009. C3 and C4 photosynthesis models: An overview from the perspective
+!!   of crop modelling, NJAS - Wageningen Journal of Life Sciences, 57, 27--38.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE mleb_diffuco_trans_co2 (kjpindex, swdown, temp_sol, pb, qsurf, q2m, t2m, &
+                                temp_growth, rau, u, v, q_cdrag, vegstress, &
+                                assim_param, Ca, &
+                                veget_max, qsintveg, qsintmax, vbeta3, vbeta3pot, rveget, rstruct, &
+                                cimean, gsmean, gpp, vbeta23, Isotrop_Abs_Tot_p,&
+                                Isotrop_Tran_Tot_p, lai_per_level, new_leaf_ci, &
+                                hydrol_flag2, hydrol_flag3, gs_distribution, &
+                                gs_diffuco_output, james_netcdf_flag, gstot_component, &
+                                gstot_frac, warnings, veget, circ_class_biomass,circ_class_n, &
+                                u_speed, profile_vbeta3, profile_rveget)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: kjpindex         !! Domain size (unitless)
+    REAL(r_std),DIMENSION (:), INTENT (in)                   :: swdown           !! Downwelling short wave flux 
+                                                                                 !! @tex ($W m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (:), INTENT (in)                   :: temp_sol         !! Skin temperature (K)
+    REAL(r_std),DIMENSION (:), INTENT (in)                   :: pb               !! Lowest level pressure (hPa)
+    REAL(r_std),DIMENSION (:), INTENT (in)                   :: qsurf            !! Near surface specific humidity 
+                                                                                 !! @tex ($kg kg^{-1}$) @endtex
+! N. de Noblet - 2006/06 - addition of q2m and t2m
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q2m              !! 2m specific humidity 
+                                                                                 !! @tex ($kg kg^{-1}$) @endtex
+! In off-line mode q2m and qair are the same.
+! In off-line mode t2m and temp_air are the same.
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: t2m              !! 2m air temperature (K)
+! N. de Noblet - 2006/06 - addition of q2m and t2m
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_growth      !! Growth temperature (Â°C) - Is equal to t2m_month
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau              !! air density @tex ($kg m^{-3}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u                !! Lowest level wind speed 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: v                !! Lowest level wind speed 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag          !! Surface drag coefficient (-) 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (:,:,:), INTENT (in)               :: assim_param      !! min+max+opt temps (K), vcmax, vjmax for 
+                                                                                 !! photosynthesis 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: Ca               !! CO2 concentration inside the canopy
+                                                                                 !! @tex ($\mu mol mol^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: vegstress        !! Soil moisture stress (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)        :: veget            !! Fraction of vegetation type (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: qsintveg         !! Water on vegetation due to interception 
+                                                                                 !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: qsintmax         !! Maximum water on vegetation
+                                                                                 !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: vbeta23          !! Beta for fraction of wetted foliage that will 
+                                                                                 !! transpire (unitless) 
+    REAL(r_std),DIMENSION (:,:,:), INTENT (in)               :: Isotrop_Abs_Tot_p !! Absorbed radiation per level for photosynthesis
+    REAL(r_std),DIMENSION (:,:,:), INTENT (in)               :: Isotrop_Tran_Tot_p !! Absorbed radiation per level for photosynthesis
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)                :: lai_per_level    !! This is the LAI per vertical level
+                                                                                 !! @tex $(m^{2} m^{-2})$
+                                                                                     
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)            :: circ_class_biomass          !! Stand level biomass @tex $(gC m^{-2})$ @endtex
+   REAL(r_std), DIMENSION(:,:,:), INTENT(in)                 :: circ_class_n           !! Stand level biomass @tex $(gC m^{-2})$ @endtex
+
+
+    LOGICAL, DIMENSION (kjpindex), INTENT (in)               :: hydrol_flag2     !! flag that 'trips' the alternative energy budget for each grid square
+    LOGICAL, DIMENSION (kjpindex, nvm), INTENT (in)          :: hydrol_flag3     !! flag that 'trips' the alternative energy budget for each grid square
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (in)        :: gs_distribution
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (in)        :: gs_diffuco_output
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (in)        :: gstot_component
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot), INTENT (in)        :: gstot_frac    
+
+    REAL(r_std),DIMENSION (:)                                            :: u_speed               ! wind speed at specified canopy level (m/s)    
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)                     :: profile_rveget
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)                     :: profile_vbeta3
+
+
+    LOGICAL, INTENT(in)                                     :: james_netcdf_flag !! Flag that controls the netCDF output routine
+
+
+    !
+    !! 0.2 Output variables
+    
+    !! 0.3 Modified variables
+    ! JR these are all defined as inout variables as we skip over PFTs and grid squares for which the hydrol stress constraint
+    !       does not apply. We can to use the values the values previously calculated (within diffuco) for these cases.
+    !
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)       :: vbeta3         !! Beta for Transpiration (unitless)
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)       :: vbeta3pot      !! Beta for Potential Transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)       :: rveget         !! stomatal resistance of vegetation 
+                                                                                 !! @tex ($s m^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)       :: rstruct        !! structural resistance @tex ($s m^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)       :: cimean         !! mean intercellular CO2 concentration 
+                                                                                 !! @tex ($\mu mol mol^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)       :: gsmean         !! mean stomatal conductance to CO2 (umol m-2 s-1)
+    REAL(r_Std),DIMENSION (kjpindex,nvm), INTENT (inout)       :: gpp            !! Assimilation ((gC m^{-2} s^{-1}), total area)
+    REAL(r_std),DIMENSION(kjpindex,nvm,nwarns), INTENT(inout)  :: warnings       !! A warning counter
+    !
+    !
+    REAL(r_std), DIMENSION (kjpindex,nvm,nlai)                 :: new_leaf_ci    !! intercellular CO2 concentration (ppm)
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std), DIMENSION(kjpindex, nvm)                                :: coupled_lai
+    REAL(r_std), DIMENSION(kjpindex, nvm)                                :: lai
+      
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot)                     :: gs_output
+    REAL(r_Std),DIMENSION (kjpindex,nvm,nlevels_tot)                     :: gstot_output
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)                     :: assimi_store
+
+    REAL(r_std), DIMENSION (kjpindex)      :: jwind                              !! Wind module (m s^{-1})
+
+    REAL(r_std),DIMENSION (kjpindex,nvm)  :: sum_rveget_rstruct
+
+    REAL(r_std),DIMENSION (kjpindex,nvm)  :: vcmax                               !! maximum rate of carboxylation 
+                                                                                 !! @tex ($\mu mol CO2 m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm)  :: nue                                 !! Nitrogen use Efficiency with impact of leaf 
+                                                                                 !! age (umol CO2 (gN)-1 s-1)
+    REAL(r_std),DIMENSION (kjpindex,nvm)  :: ntot                                !! Total canopy (eg leaf) N (gN m-2[ground]) 
+    REAL(r_std),DIMENSION (kjpindex)      :: leafN_top                           !! Leaf N content - top of canopy (gN m-2[leaf])
+
+    INTEGER(i_std)                        :: ji, jv, ilev, limit_photo           !! indices (unitless)
+    !REAL(r_std), DIMENSION(kjpindex)      :: leaf_ci_lowest                      !! intercellular CO2 concentration at the lowest 
+    !                                                                             !! LAI level
+    !                                                                             !! @tex ($\mu mol mol^{-1}$) @endtex
+    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) 
+    INTEGER(i_std)                        :: nia,inia,nina,inina,iainia          !! counter/indices (unitless)
+    INTEGER(i_std), DIMENSION(kjpindex)   :: index_assi,index_non_assi           !! indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: vc2                                 !! rate of carboxylation (at a specific LAI level) 
+                                                                                 !! @tex ($\mu mol CO2 m^{-2} s^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(kjpindex)      :: vj2                                 !! rate of Rubisco regeneration (at a specific LAI 
+                                                                                 !! level) @tex ($\mu mol e- m^{-2} s^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(kjpindex,nvm)  :: assimi                              !! assimilation (at a specific LAI level) 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+                                                                                 !! (temporary variables)
+    REAL(r_std), DIMENSION(kjpindex)      :: gstop                               !! stomatal conductance to H2O at topmost level 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: gs                                  !! stomatal conductance to CO2 
+                                                                                 !! @tex ($\mol m^{-2} s^{-1}$) @endtex
+
+
+    REAL(r_std), DIMENSION(kjpindex)      :: gamma_star                          !! CO2 compensation point (ppm)
+                                                                                 !! @tex ($\mu mol mol^{-1}$) @endtex
+
+    REAL(r_std), DIMENSION(kjpindex)      :: air_relhum                          !! air relative humidity at 2m 
+                                                                                 !! @tex ($kg kg^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: VPD                                 !! Vapor Pressure Deficit (kPa)
+    REAL(r_std), DIMENSION(kjpindex)      :: water_lim                           !! water limitation factor (0-1,unitless)
+
+    REAL(r_std), DIMENSION(kjpindex)      :: gstot                               !! total stomatal conductance to H2O
+                                                                                 !! Final unit is
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm)  :: assimtot                            !! total assimilation 
+                                                                                 !! @tex ($\mu mol CO2 m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: Rdtot                               !! Total Day respiration (respiratory CO2 release other than by photorespiration) (mumol CO2 mâ2 sâ1) 
+    REAL(r_std), DIMENSION(kjpindex)      :: gs_top                              !! leaf stomatal conductance to H2O across all top levels
+                                                                                 !! @tex ($\mol H2O m^{-2} s^{-1}$) @endtex
+    !REAL(r_std), DIMENSION(nlai+1)        :: laitab                              !! tabulated LAI steps @tex ($m^2 m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: qsatt                               !! surface saturated humidity at 2m (??) 
+                                                                                 !! @tex ($g g^{-1}$) @endtex
+    !REAL(r_std), DIMENSION(nvm,nlai)      :: light                               !! fraction of light that gets through upper LAI    
+                                                                                 !! levels (0-1,unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_Vcmax                             !! Temperature dependance of Vcmax (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: S_Vcmax_acclim_temp                 !! Entropy term for Vcmax 
+                                                                                 !! accounting for acclimation to temperature (J K-1 mol-1)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_Jmax                              !! Temperature dependance of Jmax
+    REAL(r_std), DIMENSION(kjpindex)      :: S_Jmax_acclim_temp                  !! Entropy term for Jmax 
+                                                                                 !! accounting for acclimation to temperature (J K-1 mol-1)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_Rd                                !! Temperature dependance of Rd (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_Kmc                               !! Temperature dependance of KmC (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_KmO                               !! Temperature dependance of KmO (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_gamma_star                        !! Temperature dependance of gamma_star (unitless)    
+    REAL(r_std), DIMENSION(kjpindex)      :: vc                                  !! Maximum rate of Rubisco activity-limited carboxylation (mumol CO2 mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex)      :: vj                                  !! Maximum rate of e- transport under saturated light (mumol CO2 mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex)      :: Rd                                  !! Day respiration (respiratory CO2 release other than by photorespiration) (mumol CO2 mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex)      :: Kmc                                 !! MichaelisâMenten constant of Rubisco for CO2 (mubar)
+    REAL(r_std), DIMENSION(kjpindex)      :: KmO                                 !! MichaelisâMenten constant of Rubisco for O2 (mubar)
+    REAL(r_std), DIMENSION(kjpindex)      :: gb                                  !! Boundary-layer conductance (mol mâ2 sâ1 barâ1)
+    REAL(r_std), DIMENSION(kjpindex)      :: fvpd                                !! Factor for describing the effect of leaf-to-air vapour difference on gs (-)
+    REAL(r_std), DIMENSION(kjpindex)      :: low_gamma_star                      !! Half of the reciprocal of Sc/o (bar bar-1)
+    REAL(r_std)                           :: N_Vcmax                             !! Nitrogen level dependance of Vcmacx and Jmax 
+    REAL(r_std)                           :: fcyc                                !! Fraction of electrons at PSI that follow cyclic transport around PSI (-)
+    REAL(r_std)                           :: z                                   !! A lumped parameter (see Yin et al. 2009) ( mol mol-1)                          
+    REAL(r_std)                           :: Rm                                  !! Day respiration in the mesophyll (umol CO2 mâ2 sâ1)
+    REAL(r_std)                           :: Cs_star                             !! Cs -based CO2 compensation point in the absence of Rd (ubar)
+    REAL(r_std), DIMENSION(kjpindex)      :: Iabs                                !! Photon flux density absorbed by leaf photosynthetic pigments (umol photon mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex)      :: Jmax                                !! Maximum value of J under saturated light (umol eâ mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex)      :: JJ                                  !! Rate of eâ transport (umol eâ mâ2 sâ1)
+    REAL(r_std)                           :: J2                                  !! Rate of all eâ transport through PSII (umol eâ mâ2 sâ1)
+    REAL(r_std)                           :: VpJ2                                !! eâ transport-limited PEP carboxylation rate (umol CO2 mâ2 sâ1)
+    REAL(r_std)                           :: A_1, A_3                            !! Lowest First and third roots of the analytical solution for a general 
+                                                                                 !! cubic equation (see Appendix A of Yin et al. 2009) (umol CO2 mâ2 sâ1)
+    REAL(r_std)                           :: A_1_tmp, A_3_tmp                    !! Temporary First and third roots of the analytical solution for a general 
+                                                                                 !! cubic equation (see Appendix A of Yin et al. 2009) (umol CO2 mâ2 sâ1)
+    REAL(r_std)                           :: Obs                                 !! Bundle-sheath oxygen partial pressure (ubar)
+    REAL(r_std)                           :: Cc                                  !! Chloroplast CO2 partial pressure (ubar)
+    REAL(r_std)                           :: ci_star                             !! Ci -based CO2 compensation point in the absence of Rd (ubar)        
+    REAL(r_std)                           :: a,b,c,d,m,f,j,g,h,i,l,p,q,r         !! Variables used for solving the cubic equation (see Yin et al. (2009))
+    REAL(r_std)                           :: QQ,UU,PSI,x1,x2,x3                  !! Variables used for solving the cubic equation (see Yin et al. (2009))
+
+    REAL(r_std),DIMENSION (kjpindex,nvm)  :: lai_total                           !! total LAI for column in question
+                                        
+    REAL(r_std)                           :: cresist                             !! coefficient for resistances (??)
+    REAL(r_std)                           :: lai_min                             !! mininum lai to calculate photosynthesis       
+                                                                                 !! coefficient for resistances (??)
+
+    LOGICAL,DIMENSION(kjpindex,nlevels_tot)  :: top_level                        !! A flag to see if a given level is considered
+                                                                                 !! a "top" level or not.  Must be done this way
+                                                                                 !! because there could be several "top" levels.
+    REAL(r_std)                           :: totlai_top                          !! The sum of the LAI in all the levels that we
+                                                                                 !! declare as the "top".
+    INTEGER(i_std)                        :: lev_count                           !! How many levels we have already taken for
+                                                                                 !! the "top"
+    INTEGER                               :: jij
+
+! @defgroup Photosynthesis Photosynthesis
+! @{   
+    ! 1. Preliminary calculations\n
+    REAL(r_std),DIMENSION (kjpindex,nvm)  :: rveget_min                          !! Minimal Surface resistance of vegetation
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot)     &
+                                          :: light_tran_to_level                 !! Cumulative amount of light transmitted
+                                                                                 !! to a given level
+    LOGICAL,DIMENSION (kjpindex)          :: lskip                               !! A flag to indicate we've hit an unusual
+                                                                                 !! case were we may have numerical instability.
+    INTEGER :: ipts
+    LOGICAL :: llight
+    LOGICAL :: llai
+    INTEGER,SAVE :: istep=0
+!_ ================================================================================================================================
+
+
+    ! JR 211013 define wind speed (this is defined in full in the diffuco module, but not here, so need to replicate it)
+    jwind(:) = SQRT (u(:)*u(:) + v(:)*v(:))
+    gs_output = 0.0d0
+    gstot_output = 0.0d0
+    lai_total = 0.0d0
+    assimi = 0.0d0
+    assimi_store = zero
+    
+    !+++CHECK+++
+    ! Why is total lai calculated as the sum of lai_per_layer rather than the more
+    ! common approach by using ccc_to_lai ? lai(ji,jv) = cc_to_lai( circ_class_biomass(ji,jv,:, ileaf,&
+    !      icarbon),circ_class_n(ji,jv,:),jv)?
+    ! Is there a difference between both approaches? Probably best to test before changing this 
+    ! code. I tried to test but the test requires running the multi-layer energy budget which
+    ! crashed in stomate_soilcarbon.f90 see ticket 457.
+    DO ji=1,kjpindex
+        DO jv = 1, nvm
+            DO ilev=1,nlevels_tot
+               !! total LAI for column in question
+               lai_total(ji,jv) = lai_total(ji,jv) + lai_per_level(ji,jv,ilev)   
+            END DO ! ilev = 1, nlevels_tot
+            ! Alternative and more consistent way to calculate total lai
+            !lai(ji,jv) = cc_to_lai( circ_class_biomass(ji,jv,:, ileaf,&
+            !      icarbon),circ_class_n(ji,jv,:),jv)
+        END DO ! jv = 1, nvm
+    END DO ! ji = 1, klpindex
+    
+    !
+    ! 1. Photosynthesis parameters
+    !
+    ! taking N into account for the calculations of Vcmax, as in
+    ! diffuco_trans_co2.
+ 
+    nue(:,:) = assim_param(:,:,inue)
+    ntot(:,:) = assim_param(:,:,ileafn)
+    DO jv = 1,nvm 
+       WHERE (lai_total(:,jv) .GT. min_sechiba)
+            leafN_top(:) = ntot(:,jv) * ext_coeff_N(jv) / ( 1.-exp(-ext_coeff_N(jv) * lai_total(:,jv)) )
+       ELSEWHERE
+            leafN_top(:) = zero
+       ENDWHERE
+
+        vcmax(:,jv) = nue(:,jv)*leafN_top(:)
+    ENDDO ! jv,nvm
+
+    !
+    ! @addtogroup Photosynthesis
+    ! @{   
+    !
+    ! 1.2 Estimate relative humidity of air (for calculation of the stomatal conductance).\n
+    !! \latexonly
+    !! \input{mleb_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
+
+    ! WRITE(*,*) '181113a test, pre call to qsatcalc sechiba_hydrol_arch line 858; temp_sol is: ', temp_sol
+
+    CALL qsatcalc (kjpindex, temp_sol, pb, qsatt)
+    air_relhum(:) = &
+      ( qsurf(:) * pb(:) / (Tetens_1+qsurf(:)* Tetens_2) ) / &
+      ( qsatt(:)*pb(:) / (Tetens_1+qsatt(:)*Tetens_2 ) )
+
+
+    VPD(:) = ( qsatt(:)*pb(:) / (Tetens_1+qsatt(:)*Tetens_2 ) ) &
+         - ( qsurf(:) * pb(:) / (Tetens_1+qsurf(:)* Tetens_2) )
+    ! VPD is needed in kPa
+    ! We limit the impact of VPD in the range of [0:6] kPa
+    ! This seems to be the typical range of values
+    ! that the vapor pressure difference can take, although
+    ! there is a paper by Mott and Parkhurst, Plant, Cell & Environment,
+    ! Vol. 14, pp. 509--519 (1991) which gives a value of 15 kPa.
+    VPD(:) = MAX(zero,MIN(VPD(:)/10.,6.))
+
+    ! @endcodeinc
+    ! N. de Noblet - 2006/06 
+    !
+    !
+    ! 2. beta coefficient for vegetation transpiration
+    !
+    rstruct(:,1) = rstruct_const(1)
+    rveget(:,:) = undef_sechiba
+    rveget_min(:,:) = undef_sechiba
+    !
+ 
+    ! JR 051113 need to preserve the value of vbeta3 modified by supply term constraint
+    ! in addition other values of vbeta3 are passed back from the earlier call to this
+    ! routine in sechiba, so no need to initialise again. It is an (inout) variable in
+    ! this version of the routine.
+    ! vbeta3(:,:) = zero
+    vbeta3pot(:,:) = zero
+    gsmean(:,:) = zero
+    gpp(:,:) = zero
+    light_tran_to_level(:,:,:)=un
+    !
+    cimean(:,1) = Ca(:)
+    !
+    ! @addtogroup Photosynthesis
+    ! @{   
+    ! 2. Loop over vegetation types\n
+    ! @} 
+    !
+    DO jv = 2,nvm
+      !
+      ! @addtogroup Photosynthesis
+      ! @{   
+      !
+      ! 2.1 Initializations\n
+      !! \latexonly
+      !! \input{diffuco_trans_co2_2.1.tex}
+      !! \endlatexonly
+      ! @}      
+      !
+      ! beta coefficient for vegetation transpiration
+      !
+      rstruct(:,jv) = rstruct_const(jv)
+      cimean(:,jv) = Ca(:)
+      !
+      !! mask that contains points where there is photosynthesis
+      !! For the sake of vectorisation [DISPENSABLE], computations are done only for convenient points.
+      !! nia is the number of points where the assimilation is calculated and nina the number of points where photosynthesis is not
+      !! calculated (based on criteria on minimum or maximum values on LAI, vegetation fraction, shortwave incoming radiation, 
+      !! temperature and relative humidity).
+      !! For the points where assimilation is not calculated, variables are initialized to specific values. 
+      !! The assimilate(kjpindex) array contains the logical value (TRUE/FALSE) relative to this photosynthesis calculation.
+      !! The index_assi(kjpindex) array indexes the nia points with assimilation, whereas the index_no_assi(kjpindex) array indexes
+      !! the nina points with no assimilation.
+      !          
+      ! set minimum lai value to test if photosynthesis should be calculated
+      ! 0.0001 is abitrary
+      ! could be externalised 
+      lai_min = 0.0001
+      !
+      nia=0
+      nina=0
+      index_assi=0
+      index_non_assi=0
+      !
+      !      
+      DO ji=1,kjpindex
+         !
+         ! This is tricky.  We need a certain amount of LAI to have photosynthesis.
+         ! However, we divide our canopy up into certain levels, so even if we
+         ! have a total amount that is sufficient, there might not be enough
+         ! in any particular layer.  So we check each layer to see if there
+         ! is one that has enough to give a non-zero photosynthesis.  In
+         ! the worst-case scenario (small LAI in every other level), this becomes 
+         ! our top level for the gs calculation.  If gs_top_level is zero below,
+         ! we have a divide by zero issue.
+         llai=.FALSE.
+         DO ilev=1,nlevels_tot
+            IF(lai_per_level(ji,jv,ilev) .GT. lai_min) llai=.TRUE.
+         ENDDO
+
+         IF ( llai .AND. &
+              ( veget_max(ji,jv) .GT. min_sechiba ) ) THEN
+            
+            ! Here we need to do something different than in the previous model.
+            ! We explicitly need to check for absorbed light.  This occurs
+            ! because our albedo in the two stream model is a function
+            ! of the solar angle.  If the sun has set, we have no
+            ! light, and therefore we cannot have photosynthesis.
+            llight=.FALSE.
+            DO ilev=1,nlevels_tot
+               IF(Isotrop_Abs_Tot_p(ji,jv,ilev) .GT. min_sechiba) llight=.TRUE.
+            ENDDO
+            IF ( ( swdown(ji) .GT. min_sechiba )   .AND. &
+                 ( temp_growth(ji) .GT. tphoto_min(jv) ) .AND. &
+                 llight .AND. &
+                 ( temp_growth(ji) .LT. tphoto_max(jv) )) THEN
+               !
+               assimilate(ji) = .TRUE.
+               nia=nia+1
+               index_assi(nia)=ji
+               !
+            ELSE
+               !
+               assimilate(ji) = .FALSE.
+               nina=nina+1
+               index_non_assi(nina)=ji
+               !
+            ENDIF
+         ELSE
+            !
+            assimilate(ji) = .FALSE.
+            nina=nina+1
+            index_non_assi(nina)=ji
+            !
+         ENDIF
+        ! 
+      ENDDO
+      !
+
+      IF(printlev_loc>=4 .AND. jv == test_pft)THEN
+         WRITE(numout,*) 'index_non_assi(:): ',index_non_assi(:)
+         WRITE(numout,*) 'index_assi(:): ',index_assi(:)
+         WRITE(numout,*) 'nia: ',nia
+      ENDIF
+
+
+      top_level(:,:)=.FALSE.
+      gstot(:) = zero
+      assimtot(:,:) = zero
+      Rdtot(:)=zero
+      gs_top(:) = zero
+      lskip(:)=.FALSE.
+      !
+      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.
+      !!Not used when hydrol_arch is used, can be deleted
+      WHERE ( assimilate(:) )
+         ! water_lim(:) = MAX( min_sechiba, MIN( vegstress(:,jv)/0.5, un ))
+         water_lim(:) = un
+      ELSEWHERE
+         water_lim(:) = zero
+      ENDWHERE
+
+      ! give a default value of ci for all pixel that do not assimilate
+      DO ilev=1,nlevels_tot
+         DO inina=1,nina
+            new_leaf_ci(index_non_assi(inina),jv,ilev) = Ca(index_non_assi(inina)) 
+         ENDDO
+      ENDDO
+      !
+      !
+      ! Here is the calculation of assimilation and stomatal conductance
+      ! based on the work of Farquahr, von Caemmerer and Berry (FvCB model) 
+      ! as described in Yin et al. 2009
+      ! Yin et al. developed a extended version of the FvCB model for C4 plants
+      ! and proposed an analytical solution for both photosynthesis pathways (C3 and C4)
+      ! Photosynthetic parameters used are those reported in Yin et al. 
+      ! Except For Vcmax25, relationships between Vcmax25 and Jmax25 for which we use 
+      ! Medlyn et al. (2002) and Kattge & Knorr (2007)
+      ! Because these 2 references do not consider mesophyll conductance, we neglect this term
+      ! in the formulations developed by Yin et al. 
+      ! Consequently, gm (the mesophyll conductance) tends to the infinite
+      ! This is of importance because as stated by Kattge & Knorr and Medlyn et al.,
+      ! values of Vcmax and Jmax derived with different model parametrizations are not 
+      ! directly comparable and the published values of Vcmax and Jmax had to be standardized
+      ! to one consistent formulation and parametrization
+
+      ! See eq. 6 of Yin et al. (2009)
+      ! Parametrization of Medlyn et al. (2002) - from Bernacchi et al. (2001)
+      T_KmC(:)        = Arrhenius(kjpindex,temp_sol,298.,E_KmC(jv))
+      T_KmO(:)        = Arrhenius(kjpindex,temp_sol,298.,E_KmO(jv))
+      T_gamma_star(:) = Arrhenius(kjpindex,temp_sol,298.,E_gamma_star(jv))
+
+
+      ! Parametrization of Yin et al. (2009) - from Bernacchi et al. (2001)
+      T_Rd(:)         = Arrhenius(kjpindex,temp_sol,298.,E_Rd(jv))
+
+
+      ! For C3 plants, we assume that the Entropy term for Vcmax and Jmax 
+      ! acclimates to temperature as shown by Kattge & Knorr (2007) - Eq. 9 and 10
+      ! and that Jmax and Vcmax respond to temperature following a modified Arrhenius function
+      ! (with a decrease of these parameters for high temperature) as in Medlyn et al. (2002) 
+      ! and Kattge & Knorr (2007).
+      ! In Yin et al. (2009), temperature dependance to Vcmax is based only on a Arrhenius function
+      ! Concerning this apparent unconsistency, have a look to the section 'Limitation of 
+      ! Photosynthesis by gm' of Bernacchi (2002) that may provide an explanation
+
+      ! Growth temperature tested by Kattge & Knorr range from 11 to 35Â°C
+      ! So, we limit the relationship between these lower and upper limits
+      S_Jmax_acclim_temp(:) = aSJ(jv) + bSJ(jv) * MAX(11., MIN(temp_growth(:),35.))      
+      T_Jmax(:)  = Arrhenius_modified(kjpindex,temp_sol,298.,E_Jmax(jv),D_Jmax(jv),S_Jmax_acclim_temp)
+
+      S_Vcmax_acclim_temp(:) = aSV(jv) + bSV(jv) * MAX(11., MIN(temp_growth(:),35.))   
+      T_Vcmax(:) = Arrhenius_modified(kjpindex,temp_sol,298.,E_Vcmax(jv),D_Vcmax(jv),S_Vcmax_acclim_temp)
+      !       
+      vc(:) = vcmax(:,jv) * T_Vcmax(:)
+      ! As shown by Kattge & Knorr (2007), we make use
+      ! of Jmax25/Vcmax25 ratio (rJV) that acclimates to temperature for C3 plants
+      ! rJV is written as a function of the growth temperature
+      ! rJV = arJV + brJV * T_month 
+      ! See eq. 10 of Kattge & Knorr (2007)
+      ! and Table 3 for Values of arJV anf brJV 
+      ! Growth temperature is monthly temperature (expressed in Â°C) - See first paragraph of
+      ! section Methods/Data of Kattge & Knorr
+      vj(:) = ( arJV(jv) + brJV(jv) *  MAX(11., MIN(temp_growth(:),35.)) ) * vcmax(:,jv) * T_Jmax(:)
+      !
+      ! @endcodeinc
+      !
+      KmC(:)=KmC25(jv)*T_KmC(:)
+      KmO(:)=KmO25(jv)*T_KmO(:)
+      gamma_star(:) = gamma_star25(jv)*T_gamma_star(:)
+      ! low_gamma_star is defined by Yin et al. (2009)
+      ! as the half of the reciprocal of Sco - See Table 2
+      ! We derive its value from Equation 7 of Yin et al. (2009)
+      ! assuming a constant O2 concentration (Oi)
+      low_gamma_star(:) = gamma_star(:)/Oi
+      ! VPD expressed in kPa
+      fvpd(:) = 1. / ( 1. / (a1(jv) - b1(jv) * VPD(:)) - 1. ) 
+      ! * water_lim(:)
+      !???
+      !leaf boundary layer conductance
+      gb(:) = (1.0_r_std /25.0_r_std)/(22.4_r_std *temp_sol(:)/273._r_std/1000._r_std) 
+      !???
+      !
+      ! @addtogroup Photosynthesis
+      ! @{   
+      !
+      ! 2.4 Loop over LAI levels to estimate assimilation and conductance\n
+      ! @}           
+      !
+
+
+
+
+      IF (nia .GT. 0) THEN
+         gridloop1: DO inia=1,nia
+            !
+            iainia=index_assi(inia)
+
+            ! JR we 'cycle' the LAI loop for those PFTs not subject to the hydrol stress for the grid square in question
+
+            IF (hydrol_flag3(iainia, jv)) THEN
+               !nothing              
+            ELSE
+               CYCLE gridloop1
+            END IF !(hydrol_flag3)
+
+
+            ! JR the first part of the routine is a copy of diffuco_trans_co2, so that we can 
+            ! calculate values for fvpd, assimtot, Rdtot, new_leaf_ci and ci_star
+            !
+            ! Find the top layer that still contains lai.  We have also
+            ! added a check in here to make sure this layer has absorbed
+            ! light.  If there is no absorbed light, we will not calculate
+            ! stomatal conductance for the top level, which means gstop
+            ! will be zero later and we'll crash when we divide by it.
+            ! Include a warning so we know how often this happens.
+            ! Include a warning so we know how often this happens.
+            ! The old system of chosing just one top level caused some bad results
+            ! in the transpir, evidently due to the calculation of vbeta3 being
+            ! too low due to too low of LAI in the top level.  Therefore, we are
+            ! now going to take several top levels in an effort to make sure
+            ! we have enough LAI.  We aim for an arbitrary amount of 0.1 or
+            ! the top three levels.  This has not been rigoursly tested, but it
+            ! is theoretically justified by the fact that if the LAI of the top
+            ! level is very low, other leaves will be getting a lot of sun and
+            ! well-exposed to the atmosphere, and therefore contribute equal
+            ! to the resistence of the vegetation.
+            totlai_top=zero
+            lev_count=0
+            !   
+            DO ilev=nlevels_tot, 1, -1
+               IF(lai_per_level(iainia,jv,ilev) .GT. lai_min)THEN
+                  IF(Isotrop_Abs_Tot_p(iainia,jv,ilev) .GT. min_sechiba)THEN
+                     IF(totlai_top .LT. lai_top(jv) .AND. lev_count .LT. nlev_top)THEN
+                        lev_count=lev_count+1
+                        top_level(iainia,ilev)=.TRUE.
+                        totlai_top=totlai_top+lai_per_level(iainia,jv,ilev)
+                     ELSE
+                        ! We have enough levels now.
+                        !WRITE(numout,*) 'Top levels ',totlai_top,lev_count
+                        EXIT
+                     ENDIF
+                  ELSE
+                     IF(err_act.GT.1)THEN
+                        WRITE(numout,*) 'WARNING: Found a level with LAI, ' // &
+                             'but no absorbed light.'
+                        WRITE(numout,*) 'WARNING: iainia,jv,ilev, ',iainia,jv,ilev
+                        WRITE(numout,*) 'WARNING: Isotrop_Abs_Tot_p(iainia,jv,ilev),' //&
+                             'lai_per_level(iainia,jv,ilev), ',iainia,jv,ilev
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDDO
+            IF(totlai_top .LT. min_sechiba)THEN
+               ! There seem to be some fringe cases where this happens, usually
+               ! at sunrise or sunset with low LAI levels.  Instead of stopping
+               ! here, I'm going to issue a warning.  If this case happens,
+               ! we produce no GPP, but we're not going to crash.  We need to
+               ! be careful in one of the loops below, since a stomatal 
+               ! conductance of zero will cause a crash.
+                IF(err_act.GT.1)THEN
+                   WRITE(numout,*) 'WARNING: Did not find a level with LAI in diffuco!'
+                   WRITE(numout,*) 'WARNING: iainia,ivm: ',iainia,jv
+                ENDIF
+               assimtot(iainia,jv) = zero
+               Rdtot(iainia) = zero
+               gstot(iainia) = zero
+               lskip(iainia)=.TRUE.
+               CYCLE gridloop1
+            ENDIF
+
+            ! We need to know how much is transmitted to this level
+            ! from the top of the canopy, since this aboslute number
+            ! is what is actually used in the photosyntheis.  Right now
+            ! Isotrop_Tran_Tot_p and Isotropic_Abs_Tot_p are the 
+            ! relative quantities transmitted through and absorbed
+            ! by the layer.
+            DO ilev = nlevels_tot-1,1,-1
+               light_tran_to_level(iainia,jv,ilev)=light_tran_to_level(iainia,jv,ilev+1)*Isotrop_Tran_Tot_p(iainia,jv,ilev+1)
+            ENDDO
+            IF(printlev_loc>=4 .AND. jv == test_pft .AND. iainia == test_grid)THEN
+               WRITE(numout,*) 'Absolute transmitted light to each level',jv,iainia
+               DO ilev = nlevels_tot,1,-1
+                  WRITE(numout,*) ilev,light_tran_to_level(iainia,jv,ilev)
+               ENDDO
+            ENDIF
+
+            DO ilev = 1, nlevels_tot
+               
+               IF (Isotrop_Abs_Tot_p(iainia,jv,ilev) .GT. min_sechiba) THEN
+
+                  IF(lai_per_level(iainia,jv,ilev) .LE. min_sechiba)THEN
+                     ! This is not necessarily a problem.  LAI is updated in slowproc, while
+                     ! absorbed light is updated in condveg, which is called after diffuco.
+                     ! So we might be one timestep off.  It generally should be at night,
+                     ! though, so there is no absorbed light.  If this persists, that
+                     ! is a real problem.
+                     IF(err_act.GT.1)THEN
+                        WRITE(numout,*) 'WARNING: We have absorbed light but no LAI ' // &
+                             'in this level. Skipping.'
+                        WRITE(numout,'(A,3I8)') 'WARNING: iainia,jv,ilev: ',iainia,jv,ilev
+                        WRITE(numout,'(A,2F20.10)') 'WARNING: Isotrop_Abs_Tot_p(iainia,jv,ilev), ' // &
+                             'lai_per_level(iainia,jv,ilev): ',&
+                             Isotrop_Abs_Tot_p(iainia,jv,ilev), lai_per_level(iainia,jv,ilev)
+                     ENDIF
+                     CYCLE
+                  ENDIF
+                  !
+                  ! nitrogen is scaled according to the transmitted light
+                  ! before the caclulation was (1 - exp(lai)) we replaced
+                  ! it by the transmitted light calculated by the 2stream
+                  ! model, maybe ( un - Isotrop_Tran_Tot_p(iainia,jv,ilev) )
+                  ! could be replaced by the directly calculated absorbed
+                  ! light Isotrop_Abs_Tot_p(iainia,jv,ilev).
+                  ! Notice that light in the old code was the cumulative light transmitted to
+                  ! the layer, while Isotrop_Tran_Tot_p is the relative light transmitted
+                  ! through the layer.  Therefore, we use a different variable.
+                  !
+!                     N_Vcmax = ( un - .7_r_std * ( un - Isotrop_Tran_Tot_p(iainia,jv,ilev) ) )
+                  N_Vcmax = ( un - .7_r_std * ( un - light_tran_to_level(iainia,jv,ilev) ) )
+                  !
+                 ! IF (control%ok_hydrol_arch) THEN
+                 
+                  !*********CHECK: only photsynthesis when day***************
+                 ! WHERE (assimilate(:))
+                 !    vc2(iainia) = vc(iainia) * N_Vcmax
+                 !    vj2(iainia) = vj(iainia) * N_Vcmax 
+                     ! see Comment in legend of Fig. 6 of Yin et al. (2009)
+                     ! Rd25 is assumed to equal 0.01 Vcmax25 
+                  !   Rd(iainia) = vcmax(iainia,jv) * N_Vcmax * 0.01 * T_Rd(iainia)
+                  !ELSEWHERE
+                  !   vc2(iainia) = zero
+                  !   vj2(iainia) = zero
+                  !   Rd(iainia) = zero
+                  !ENDWHERE
+
+                 ! ELSE
+                     
+                     vc2(iainia) = vc(iainia) * N_Vcmax 
+                     vj2(iainia) = vj(iainia) * N_Vcmax 
+                     
+                     ! see Comment in legend of Fig. 6 of Yin et al. (2009)
+                     ! Rd25 is assumed to equal 0.01 Vcmax25 
+                     Rd(iainia) = vcmax(iainia,jv) * N_Vcmax * 0.01 * T_Rd(iainia)
+                 
+                  !ENDIF
+
+                  !+++++ CHECK +++++
+                  IF(jv == test_pft .AND. iainia == test_grid .AND. printlev_loc>=4)THEN
+                     WRITE(numout,*) 'Iabs1: ',iainia,jv,ilev
+                     WRITE(numout,'(A,10F20.10)') 'Iabs2: ',swdown(iainia),W_to_mol,RG_to_PAR,&
+                          Isotrop_Abs_Tot_p(iainia,jv,ilev),light_tran_to_level(iainia,jv,ilev) &
+                          , lai_per_level(iainia,jv,ilev)
+                  ENDIF
+                  Iabs(iainia)=swdown(iainia)*W_to_mol*RG_to_PAR*&
+                       Isotrop_Abs_Tot_p(iainia,jv,ilev)*light_tran_to_level(iainia,jv,ilev) &
+                       / lai_per_level(iainia,jv,ilev) ! need to convert to per m**2 of leaves to
+                  ! be consistent with the units we use for Jmax
+!                  WRITE(numout,*) 'Iabs ',jv,Iabs(iainia),lai_per_level(iainia,jv,ilev)
+!                  Iabs(iainia)=swdown(iainia)*W_to_mmol*RG_to_PAR*Isotrop_Abs_Tot_p(iainia,jv,ilev)
+                  !+++++++++++++++++
+                  ! If we have a very dense canopy, the lower levels might
+                  ! get almost no light.  If the light is close to zero, it
+                  ! causes a numerical problem below, as x1 will be zero.  Of
+                  ! course, if the absorbed light is really small photosynthesis will
+                  ! not happen, so we can just skip this level.  This number is 
+                  ! fairly arbitrary, but it should be as small as possible.
+                  IF(Iabs(iainia) .LT. 1e-12)CYCLE
+
+                  !
+                  !
+                  ! eq. 4 of Yin et al (2009)
+                  Jmax(iainia)=vj2(iainia)
+                  JJ(iainia) = ( alpha_LL(jv) * Iabs(iainia) + Jmax(iainia) - &
+                       sqrt((alpha_LL(jv) * Iabs(iainia) + Jmax(iainia) )**2. &
+                       - 4 * theta(jv) * Jmax(iainia) * alpha_LL(jv) * &
+                       Iabs(iainia)) ) &
+                       / ( 2 * theta(jv))
+
+                  !
+
+                  IF(printlev_loc>=4 .AND. test_pft == jv)THEN
+                     WRITE(numout,*) '*************************'
+                     WRITE(numout,*) 'jv,ilev: ',jv,ilev
+                     WRITE(numout,*) 'JJ(iainia),Jmax(iainia),Iabs(iainia),Rd(iainia): ',&
+                          JJ(iainia),Jmax(iainia),Iabs(iainia),Rd(iainia)
+                     WRITE(numout,*) 'vj2(iainia),vc2(iainia),N_Vcmax:',&
+                          vj2(iainia),vc2(iainia),N_Vcmax
+                     WRITE(numout,*) 'Isotrop_Abs_Tot_p(iainia,jv,ilev),Isotrop_Tran_Tot_p(iainia,jv,ilev):',&
+                          Isotrop_Abs_Tot_p(iainia,jv,ilev),Isotrop_Tran_Tot_p(iainia,jv,ilev)
+                     
+                     WRITE(numout,*) 'water_lim(iainia),T_Rd(iainia):',water_lim(iainia),T_Rd(iainia)
+                     WRITE(numout,*) 'vc(iainia),vj(iainia), vcmax(iainia,jv):',&
+                          vc(iainia),vj(iainia),vcmax(iainia,jv)
+                     WRITE(numout,*) '*************************'
+                  ENDIF
+                  IF ( is_c4(jv) )  THEN
+                     !
+                     ! @addtogroup Photosynthesis
+                     ! @{   
+                     !
+                     ! 2.4.2 Assimilation for C4 plants (Collatz et al., 1992)\n
+                     !! \latexonly
+                     !! \input{mleb_diffuco_trans_co2_2.4.2.tex}
+                     !! \endlatexonly
+                     ! @}           
+                     !
+                     !
+                     !
+                     ! Analytical resolution of the Assimilation based Yin et al. (2009)
+                     ! Eq. 28 of Yin et al. (2009)
+                     fcyc= 1. - ( 4.*(1.-fpsir(jv))*(1.+fQ(jv)) + 3.*h_protons(jv)*fpseudo(jv) ) / &
+                          ( 3.*h_protons(jv) - 4.*(1.-fpsir(jv)))
+
+                     ! See paragraph after eq. (20b) of Yin et al.
+                     Rm=Rd(iainia)/2.
+
+                     ! We assume that cs_star equals ci_star (see Comment in legend of Fig. 6 of Yin et al. (2009)
+                     ! Equation 26 of Yin et al. (2009)
+                     Cs_star = (gbs(jv) * low_gamma_star(iainia) * Oi - ( 1. + &
+                          low_gamma_star(iainia) * alpha(jv) / 0.047) * Rd(iainia) + Rm ) &
+                          / ( gbs(jv) + kp(jv) ) 
+                     
+
+                     ! eq. 11 of Yin et al (2009)
+                     J2 = JJ(iainia) / ( 1. - fpseudo(jv) / ( 1. - fcyc ) )
+
+                     ! Equation right after eq. (20d) of Yin et al. (2009)
+                     z = ( 2. + fQ(jv) - fcyc ) / ( h_protons(jv) * (1. - fcyc ))
+
+                     VpJ2 = fpsir(jv) * J2 * z / 2.
+
+                     A_3=9999.
+
+                     ! See eq. right after eq. 18 of Yin et al. (2009)
+                     ! The loop over limit_photo calculates the assimultion
+                     ! rate of the Rubisco-limited CsO2 assimilation (Ac) and
+                     ! the rate of electron transport-limited CO2 assimultion
+                     ! (Aj).  The overall assimilation will be the slower
+                     ! of these two processes.
+                     DO limit_photo=1,2
+                        ! Is Vc limiting the Assimilation
+                        IF ( limit_photo .EQ. 1 ) THEN
+                           a = 1. + kp(jv) / gbs(jv)
+                           b = 0.
+                           x1 = Vc2(iainia)
+                           x2 = KmC(iainia)/KmO(iainia)
+                           x3 = KmC(iainia)
+                           ! Is J limiting the Assimilation
+                        ELSE
+                           a = 1.
+                           b = VpJ2
+                           x1 = (1.- fpsir(jv)) * J2 * z / 3.
+                           x2 = 7. * low_gamma_star(iainia) / 3.
+                           x3 = 0.
+                        ENDIF
+
+                        m=fvpd(iainia)-g0(jv)/gb(iainia)
+                        d=g0(jv)*(Ca(iainia)-Cs_star) + fvpd(iainia)*Rd(iainia)
+                        f=(b-Rm-low_gamma_star(iainia)*Oi*gbs(jv))*x1*d + a*gbs(jv)*x1*Ca(iainia)*d
+                        j=(b-Rm+gbs(jv)*x3 + x2*gbs(jv)*Oi)*m + (alpha(jv)*x2/0.047-1.)*d &
+                             + a*gbs(jv)*(Ca(iainia)*m - d/gb(iainia) - (Ca(iainia) - Cs_star ))
+
+                        g=(b-Rm-low_gamma_star(iainia)*Oi*gbs(jv))*x1*m - (alpha(jv)*low_gamma_star(iainia)/0.047+1.)*x1*d &
+                             + a*gbs(jv)*x1*(Ca(iainia)*m - d/gb(iainia) - (Ca(iainia)-Cs_star ))
+
+                        h=-((alpha(jv)*low_gamma_star(iainia)/0.047+1.)*x1*m + (a*gbs(jv)*x1*(m-1.))/gb(iainia) )
+                        i= ( b-Rm + gbs(jv)*x3 + x2*gbs(jv)*Oi )*d + a*gbs(jv)*Ca(iainia)*d
+                        l= ( alpha(jv)*x2/0.047 - 1.)*m - (a*gbs(jv)*(m-1.))/gb(iainia)
+
+                        p = (j-(h-l*Rd(iainia))) / l
+                        q = (i+j*Rd(iainia)-g) / l
+                        r = -(f-i*Rd(iainia)) / l 
+
+                        ! See Yin et al. (2009) and  Baldocchi (1994)
+                        QQ = ( (p**2._r_std) - 3._r_std * q) / 9._r_std
+                        UU = ( 2._r_std* (p**3._r_std) - 9._r_std *p*q + 27._r_std *r) /54._r_std
+
+                        IF (QQ .GE. 0._r_std) THEN
+                           IF (ABS(UU/(QQ**1.5_r_std) ) .LE. 1._r_std) THEN
+                              PSI = ACOS(UU/(QQ**1.5_r_std))
+                              A_3_tmp = -2._r_std * SQRT(QQ) * COS(( PSI + 4._r_std * PI)/3._r_std ) - p / 3._r_std
+                              IF (( A_3_tmp .LT. A_3 )) THEN
+                                 A_3 = A_3_tmp
+                              ELSE
+                                 ! In case, J is not limiting the assimilation
+                                 ! we have to re-initialise a, b, x1, x2 and x3 values
+                                 ! in agreement with a Vc-limited assimilation 
+                                 a = 1. + kp(jv) / gbs(jv)
+                                 b = 0.
+                                 x1 = Vc2(iainia)
+                                 x2 = KmC(iainia)/KmO(iainia)
+                                 x3 = KmC(iainia)
+                              ENDIF
+                           ENDIF
+                        ELSE
+                           WRITE(numout,*) 'WARNING: unexpected value for QQ (sechiba_hydrol_arch.f90)'
+                        ENDIF
+
+                        IF ( ( A_3 .EQ. 9999. ) .OR. ( A_3 .LT. (-Rd(iainia)) ) ) THEN
+                           WRITE(numout,*) 'We have a problem in mleb_diffuco_trans_co2'
+                           WRITE(numout,*) 'no real positive solution found for pft:',jv
+                           WRITE(numout,*) 'temp_sol:',temp_sol(iainia)
+                           WRITE(numout,*) 'vpd:',vpd(iainia)
+                           A_3 = -Rd(iainia)
+                        ENDIF
+                        assimi(iainia,jv) = A_3
+
+                        !++++ TEMP +++++
+                        IF(( x1 - (assimi(iainia,jv) + Rd(iainia) )) == zero)THEN
+                           
+                           ! This causes a problem, since we really should not
+                           ! be dividing by zero.  However, it seems to happen
+                           ! fairly rarely, so all we'll do is cycle to the
+                           ! next loop and keep track of this warning so we
+                           ! can look at it afterwards.
+                           warnings(iainia,jv,iwphoto)=warnings(iainia,jv,iwphoto)+un
+                           
+                           IF(err_act.GT.1)THEN
+                              WRITE(numout,*) 'jdiffuco, Getting ready to divide by zero! C4'
+                              WRITE(numout,*) '( x1 - ( assimi(iainia,jv) + Rd(iainia) ) ', &
+                                   ( x1 - (assimi(iainia,jv) + Rd(iainia) ))
+                              WRITE(numout,*) 'x1,assimi(iainia,jv),Rd(iainia): ', &
+                                   x1,assimi(iainia,jv),Rd(iainia)
+                              WRITE(numout,*) 'jv,ilev,iainia: ', jv,ilev,iainia
+                           ENDIF
+                           
+                           CYCLE
+                           
+                        ENDIF
+
+                        ! Eq. 24 of Yin et al. (2009) 
+                        Obs = ( alpha(jv) * assimi(iainia,jv) ) / ( 0.047 * gbs(jv) ) + Oi
+                        ! Eq. 23 of Yin et al. (2009)
+                        Cc = ( ( assimi(iainia,jv) + Rd(iainia) ) * ( x2 * Obs + x3 ) + low_gamma_star(iainia) &
+                             * Obs * x1 ) &
+                             / ( x1 - ( assimi(iainia,jv) + Rd(iainia) ))
+                        ! Eq. 22 of Yin et al. (2009)
+                        new_leaf_ci(iainia,jv,ilev) = ( Cc - ( b - assimi(iainia,jv) - Rm ) / gbs(jv) ) / a
+
+
+
+                        ! JR %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+                        ! For the cases in which the supply term condition applies, we need
+                        ! to work backwards and calculate gs, and hence assimi for the grid
+                        ! square and PFT in question, from the value of vbeta3 derived in the
+                        ! enerbil code.
+
+                        ! This sequence is for the c4 vegetation types, and should be identical
+                        ! to the c3 loop below, except for the definition of assimi
+
+                        IF (hydrol_flag3(iainia, jv)) THEN
+
+                           !WRITE(numout,*) '231113 in c4 loop ilev is: ', ilev, 'PFT is: ', jv
+
+                           ! WRITE(numout,*) '151113 in jenerbil_trans_co2 hydrol_flag3 C4 plants'
+
+                            speed = MAX(min_wind, jwind(iainia))
+
+                            ! first case
+
+                            IF (zqsvegrap(iainia) .lt. 1.0d0) THEN
+                           
+                            !cresist = vbeta3(iainia, jv) / &
+                            !     &  ( veget_max(iainia, jv) * (1.0d0 - zqsvegrap(iainia)) + &
+                            !     &  veget_max(iainia, jv) * zqsvegrap(iainia) )
+                            
+                            cresist = vbeta3(iainia, jv) / &
+                                  & (veget_max(iainia, jv) * ( un - zqsvegrap(iainia)) + &
+                                  &  veget(iainia,jv) * zqsvegrap(iainia) )     
+                                 
+                            
+                            ! WRITE(numout,*) 'cresist condition a)'
+
+                            ELSE
+
+                            ! cresist = vbeta3(iainia, jv) / &
+                            !      &  ( veget_max(iainia, jv) * zqsvegrap(iainia) )
+
+                            cresist = 0.0d0
+
+                            ! WRITE(numout,*) 'cresist condition b)'
+
+                            END IF
+                           
+                            IF (vbeta23(iainia, jv) .le. &
+                            &  (veget(iainia, jv) * zqsvegrap(iainia) * cresist) ) THEN
+                               ! do nothing
+                            ELSE
+
+                               IF (zqsvegrap(iainia) .lt. 1.0d0) THEN
+                               !cresist = (vbeta3(iainia, jv) - vbeta23(iainia, jv)  )  / &
+                               !    & ( veget_max(iainia, jv) * (1.0d0 - zqsvegrap(iainia))  )
+                               
+                               cresist = vbeta3(iainia, jv) / &
+                                  & (veget_max(iainia, jv) * ( un - zqsvegrap(iainia)) + &
+                                  &  veget(iainia,jv) * zqsvegrap(iainia) )    
+
+                               
+                               ! WRITE(numout,*) 'cresist condition c)'
+                            
+                               ELSE
+
+                               ! cresist = vbeta3(iainia, jv) / &
+                               !      &  ( veget_max(iainia, jv) * zqsvegrap(iainia) )
+
+                               cresist = 0.0d0
+
+                               END IF
+
+                            END IF !
+
+                                   !     
+                            IF (cresist .ne. 0.0d0) THEN
+                                sum_rveget_rstruct(iainia,jv) = &
+                                     & (1.0d0/cresist - 1.0d0) * (1.0d0 / (speed * q_cdrag(iainia) * rveg_pft(jv)))
+                              ELSE
+                                ! sum_rveget_rstruct(iainia,jv) = &
+                                !      & (1.0d0 / (speed * q_cdrag(iainia) * rveg_pft(jv)))
+                                  
+                                sum_rveget_rstruct(iainia,jv) = 0.0d0
+
+                            END IF
+
+                            !WRITE(numout,*) '241113 sub_rveget_rstruct is: ', sum_rveget_rstruct(iainia,jv)
+
+                            vbeta3pot(iainia,jv) = MAX(zero, veget_max(iainia,jv) * cresist)
+
+
+                            ! calculate approximate gs, working backwards from vbeta3
+                            IF (sum_rveget_rstruct(iainia,jv) .ne. 0.0d0) THEN
+                                gstot(iainia) = 1.0d0 / sum_rveget_rstruct(iainia,jv)
+                            ELSE
+                               ! Need to convert the units of g0
+                               gstot(iainia) = g0(jv)*mol_to_m_1 *(temp_sol(iainia)/tp_00)*&
+                                    (pb_std/pb(iainia))*ratio_H2O_to_CO2
+                            END IF
+
+                            !WRITE(numout,*) '241113 gstot is: ', gstot
+
+                            IF (gstot(iainia) .gt. 0.0d0) THEN
+                                ! nothing
+                            ELSE
+                                !WRITE(*,*) '121113 gstot .le. 0'
+                            ENDIF
+
+
+                            ! we now do a unit conversion, from m/s to mol/m^2/s, the reverse
+                            !   of the calculation of section 2.5, below
+
+                            gstot(iainia) =  gstot(iainia) / (mol_to_m_1 *(temp_sol(iainia)/tp_00)* &
+                                       (pb_std/pb(iainia))*ratio_H2O_to_CO2)
+
+
+                            ! gs(iainia) = gstot(iainia) / lai(iainia, jv)
+                            ! gs(iainia) = gstot(iainia) * gs_distribution(iainia, jv, ilev) !/ lai_total(iainia,jv)
+
+!************************CHECK KIM: gs should not be lower than g0************************************
+                            
+
+                            gs(iainia) = gstot(iainia)*gstot_frac(iainia,jv,ilev) / lai_per_level(iainia,jv,ilev)
+
+                           ! IF (gs(iainia) .gt. gstot(iainia)) THEN
+                           !    gs(iainia) = gstot(iainia)
+                           ! END IF
+                            
+
+                            IF (gs(iainia) .GE. g0(jv)) THEN
+                               assimi(iainia,jv) = (((gs(iainia) - g0(jv)) * (Ca(iainia) - Cs_star)) / fvpd(iainia)) &
+                                  & - Rd(iainia)
+                            ELSE
+                               assimi(iainia,jv) = -Rd(iainia)
+                            ENDIF
+
+                            assimi_store(iainia, jv, ilev) = assimi(iainia,jv)
+
+                            ! WRITE(numout,*) '281113 assimi is: ', assimi
+
+                             IF (assimi(iainia,jv) .lt. min_sechiba) THEN
+                                 assimi(iainia,jv) = 0.0d0
+                             !    WRITE(numout,*) 'assimi(iainia,jv) is negative ***************************************'
+                             !    WRITE(numout,*) 'assimi(iainia,jv) is: ', assimi(iainia,jv)
+                             !    WRITE(numout,*) 'gs(iainia) is: ', gs(iainia)
+                             !    WRITE(numout,*) 'g0(jv) is: ', g0(jv)
+                             !    WRITE(numout,*) 'new_leaf_ci(iainia,jv,ilev) is: ', new_leaf_ci(iainia,jv,ilev)
+                             !    WRITE(numout,*) 'Ca(iainia) is: ', Ca(iainia)
+                             !    WRITE(numout,*) 'Cs_star is: ', Cs_star
+                             !    WRITE(numout,*) 'fvpd(iainia) is: ', fvpd(iainia)
+                             !    WRITE(numout,*) 'Rd(iainia) is: ', Rd(iainia)
+                             !    WRITE(numout,*) '*********************************************************'
+                              ELSE IF (assimi(iainia,jv) .gt. 500.0d0) THEN
+                             !    WRITE(numout,*) 'assimi(iainia,jv) is very large'
+                             !    WRITE(numout,*) 'assimi(iainia,jv) is: ', assimi(iainia,jv)
+                             !    WRITE(numout,*) 'temp_sol(iainia) is: ', temp_sol(iainia)
+                             !    WRITE(numout,*) 'vbeta3(iainia, jv) is: ', vbeta3(iainia, jv)
+                             !    WRITE(numout,*) 'gs(iainia) is: ', gs(iainia)
+                             !    WRITE(numout,*) 'g0(jv) is: ', g0(jv)
+                             !    WRITE(numout,*) 'new_leaf_ci(iainia,jv,ilev) is: ', new_leaf_ci(iainia,jv,ilev)
+                             !    WRITE(numout,*) 'Ca(iainia) is: ', Ca(iainia)
+                             !    WRITE(numout,*) 'Cs_star is: ', Cs_star
+                             !    WRITE(numout,*) 'fvpd(iainia) is: ', fvpd(iainia)
+                             !    WRITE(numout,*) 'Rd(iainia) is: ', Rd(iainia)
+                             !    WRITE(numout,*) 'gstot(iainia) is: ', gstot(iainia)
+                             !    WRITE(numout,*) 'sum_rveget_rstruct(iainia,jv) is: ', sum_rveget_rstruct(iainia,jv)
+                             !    WRITE(numout,*) 'speed is: ', speed
+                             !    WRITE(numout,*) 'q_cdrag(iainia) is: ',q_cdrag(iainia)
+                             !    WRITE(numout,*) 'rveg_pft(jv) is: ', rveg_pft(jv)
+                             !    WRITE(numout,*) 'gstot_frac(iainia,jv,ilev) is: ', gstot_frac(iainia,jv,ilev)
+                             !    WRITE(numout,*) 'lai_per_level(iainia,jv,ilev) is: ', lai_per_level(iainia,jv,ilev)
+                             !    WRITE(numout,*) '*********************************************************'                                
+                              END IF       
+                
+                        ENDIF  ! (hydrol_flag3(iainia, jv))
+
+                        ! with new assimilation rates for the grid squares and the PFTs for
+                        ! which the supply term restriction replies, we let the rest of the
+                        ! routine run its course from here, to calculate gs and gpp (vbeta3
+                        ! remains the same as that calculated within enerbil)
+
+                        ! JR %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+                        ! Eq. 25 of Yin et al. (2009)
+                        ! It should be Cs instead of Ca but it seems that 
+                        ! other equations in Appendix C make use of Ca
+                       ! IF ( ABS( assimi(iainia,jv) + Rd(iainia) ) .LT. min_sechiba ) THEN
+
+!**************CHECK KIM: shouldn't this be done before the calculation of assimi? ***********************************
+                        IF ( gs(iainia) .LT. min_sechiba ) THEN
+                            gs(iainia) = g0(jv)
+                        ENDIF
+                        !      
+
+                     ENDDO
+                     !
+                  ELSE
+                     !
+                     ! @addtogroup Photosynthesis
+                     ! @{   
+                     !
+                     ! 2.4.3 Assimilation for C3 plants (Farqhuar et al., 1980)\n
+                     !! \latexonly
+                     !! \input{mleb_diffuco_trans_co2_2.4.3.tex}
+                     !! \endlatexonly
+                     ! @}           
+                     !
+                     !
+                     !
+                     A_1=9999.
+
+                     ! See eq. right after eq. 18 of Yin et al. (2009)
+                     DO limit_photo=1,2
+                        ! Is Vc limiting the Assimilation
+                        IF ( limit_photo .EQ. 1 ) THEN
+                           x1 = vc2(iainia)
+                           ! It should be O not Oi (comment from Vuichard)
+                           x2 = KmC(iainia) * ( 1. + Oi / KmO(iainia) )
+                           ! Is J limiting the Assimilation
+                        ELSE
+                           x1 = JJ(iainia)/4.
+                           x2 = 2. * gamma_star(iainia)
+                        ENDIF
+
+
+                        ! See Appendix B of Yin et al. (2009)
+                        a = g0(jv) * ( x2 + gamma_star(iainia) ) + ( fvpd(iainia) ) * ( x1 - Rd(iainia) )
+                        b = Ca(iainia) * ( x1 - Rd(iainia) ) - gamma_star(iainia) * x1 - Rd(iainia) * x2
+                        c = Ca(iainia) + x2 + ( 1./gb(iainia) ) * ( x1 - Rd(iainia) ) 
+                        d = x2 + gamma_star(iainia)
+                        m = fvpd(iainia) / gb(iainia)  
+
+                        p = - ( d + a / gb(iainia) + fvpd(iainia) * c ) / m
+
+                        q = ( d * ( x1 - Rd(iainia) ) + a*c + ( fvpd(iainia) ) * b ) / m
+                        r = - a * b / m
+
+                        ! See Yin et al. (2009) 
+                        QQ = ( (p**2._r_std) - 3._r_std * q) / 9._r_std
+                        UU = ( 2._r_std* (p**3._r_std) - 9._r_std *p*q + 27._r_std *r) /54._r_std
+
+                        IF ( (QQ .GE. 0._r_std) .AND. (ABS(UU/(QQ**1.5_r_std) ) .LE. 1._r_std) ) THEN
+                           PSI = ACOS(UU/(QQ**1.5_r_std))
+                           A_1_tmp = -2._r_std * SQRT(QQ) * COS( PSI / 3._r_std ) - p / 3._r_std
+                           IF (( A_1_tmp .LT. A_1 )) THEN
+                              A_1 = A_1_tmp
+                           ELSE
+                              ! In case, J is not limiting the assimilation
+                              ! we have to re-initialise x1 and x2 values
+                              ! in agreement with a Vc-limited assimilation 
+                              x1 = vc2(iainia)
+                              ! It should be O not Oi (comment from Vuichard)
+                              x2 = KmC(iainia) * ( 1. + Oi / KmO(iainia) )                           
+                           ENDIF
+                        ENDIF
+                     ENDDO
+
+                     IF ( (A_1 .EQ. 9999.) .OR. ( A_1 .LT. (-Rd(iainia)) ) ) THEN
+                        WRITE(numout,*) 'We have a problem in mleb_diffuco_trans_co2'
+                        WRITE(numout,*) 'no real positive solution found for pft:',jv
+                        WRITE(numout,*) 'temp_sol:',temp_sol(iainia)
+                        WRITE(numout,*) 'vpd:',vpd(iainia)
+                        WRITE(numout,*) 'Setting the solution to -Rd(iainia):',-Rd(iainia)
+                        A_1 = -Rd(iainia)
+                     ENDIF
+                     assimi(iainia,jv) = A_1
+                     ! Eq. 18 of Yin et al. (2009)
+
+                     !++++++++ TEMP +++++++
+                     IF(( x1 - (assimi(iainia,jv) + Rd(iainia) )) == zero)THEN
+                        ! This causes a problem, since we really should not
+                        ! be dividing by zero.  However, it seems to happen
+                        ! fairly rarely, so all we'll do is cycle to the
+                        ! next loop and keep track of this warning so we
+                        ! can look at it afterwards.
+                        warnings(iainia,jv,iwphoto)=warnings(iainia,jv,iwphoto)+un
+
+                        IF(err_act.GT.1)THEN
+                           WRITE(numout,*) 'jdiffuco, Getting ready to divide by zero! C3'
+                           WRITE(numout,*) '( x1 - ( assimi(iainia,jv) + Rd(iainia) ) ', &
+                                ( x1 - (assimi(iainia,jv) + Rd(iainia) ))
+                           WRITE(numout,*) 'x1,assimi(iainia,jv),Rd(iainia): ', &
+                                x1,assimi(iainia,jv),Rd(iainia)
+                           WRITE(numout,*) 'jv,ilev,iainia: ', jv,ilev,iainia
+                        ENDIF
+                        
+                        CYCLE
+
+                     ENDIF
+                     !++++++++++++++++++++++++++++++
+ 
+                     Cc = ( gamma_star(iainia) * x1 + ( assimi(iainia,jv) + Rd(iainia) ) * x2 )  &
+                          / ( x1 - ( assimi(iainia,jv) + Rd(iainia) ) )
+                     ! Eq. 17 of Yin et al. (2009)
+                     ! new_leaf_ci(iainia,jv,ilev) = Cc
+                     new_leaf_ci(iainia,jv,ilev) = Cc  
+                     ! See eq. right after eq. 15 of Yin et al. (2009)
+                     ci_star = gamma_star(iainia) 
+                     ! 
+
+
+                        ! JR %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+                        ! For the cases in which the supply term condition applies, we need
+                        ! to work backwards and calculate gs, and hence assimi for the grid
+                        ! square and PFT in question, from the value of vbeta3 derived in the
+                        ! enerbil code.
+
+                        ! This sequence is for the c3 vegetation types, and should be identical
+                        ! to the c4 loop above, except for the definition of assimi
+
+                        IF (hydrol_flag3(iainia, jv)) THEN
+
+                            !WRITE(numout,*) 'in mleb_diffuco_trans_co2'
+                            !WRITE(numout,*) '231113 in c3 loop ilev is: ', ilev, 'PFT is: ', jv
+
+                            speed = MAX(min_wind, jwind(iainia))
+
+                            ! first case
+                            ! WRITE(numout,*) '151113 cresist before: ', cresist
+
+                            IF (zqsvegrap(iainia) .lt. 1.0d0) THEN
+                            !calculation of cresist may need to be check 
+                            ! Here may to to devided gradient of specific
+                            ! humidity, at least which need to consist with the
+                            ! caculation in the diffuco_trans_co2.. 
+                            !cresist = vbeta3(iainia, jv) / &
+                            !     &  ( veget_max(iainia, jv) * (1.0d0 - zqsvegrap(iainia)) + &
+                            !     &  veget_max(iainia, jv) * zqsvegrap(iainia) )
+                             cresist = vbeta3(iainia, jv) / &
+                                  & (veget_max(iainia, jv) * ( un - zqsvegrap(iainia)) + &
+                                  &  veget(iainia,jv) * zqsvegrap(iainia) )        
+                                 
+
+                            ! WRITE(numout,*) 'cresist condition a)'
+                            
+                            ELSE
+
+                            ! cresist = vbeta3(iainia, jv) / &
+                            !      &  ( veget_max(iainia, jv) * zqsvegrap(iainia) )
+
+                            cresist = 0.0d0
+
+                            ! WRITE(numout,*) 'cresist condition b)'
+
+                            END IF
+
+
+                            IF (vbeta23(iainia, jv) .le. &
+                            &  (veget(iainia, jv) * zqsvegrap(iainia) * cresist) ) THEN
+
+                               ! do nothing
+ 
+                            ELSE
+
+                               IF (zqsvegrap(iainia) .lt. 1.0d0) THEN
+
+                               !cresist = (vbeta3(iainia, jv) - vbeta23(iainia, jv)  )  / &
+                               !    & ( veget_max(iainia, jv) * (1.0d0 - zqsvegrap(iainia))  )
+
+                               cresist = vbeta3(iainia, jv) / &
+                                  & (veget_max(iainia, jv) * ( un - zqsvegrap(iainia)) + &
+                                  &  veget(iainia,jv) * zqsvegrap(iainia) )     
+                               ! WRITE(numout,*) 'cresist condition c)'
+                            
+                               ELSE
+
+                               ! cresist = vbeta3(iainia, jv) / &
+                               !      &  ( veget_max(iainia, jv) * zqsvegrap(iainia) )
+
+                               cresist = 0.0d0
+
+                               ! WRITE(numout,*) 'cresist condition d)'
+
+                               END IF
+
+                            END IF !
+
+                            !WRITE(numout,*) '241113 cresist is: ', cresist
+
+                            !*****************************TEMP**************************
+                            !WRITE(*,*) '151113 cresist (mleb_diffuco_trans_co2) is: ', cresist
+                            !WRITE(*,*) '151113 speed: ', speed
+                            !WRITE(*,*) '151113 cresist (mleb_diffuco_trans_co2) is: ', q_cdrag(iainia)
+                            !WRITE(*,*) '151113 rveg_pft (mleb_diffuco_trans_co2) is: ', rveg_pft(jv)
+                            !*****************************TEMP****************************
+
+                            IF (cresist .ne. 0.0d0) THEN
+                                sum_rveget_rstruct(iainia,jv) = &
+                                     & (1.0d0/cresist - 1.0d0) * (1.0d0 / (speed * q_cdrag(iainia) * rveg_pft(jv)))
+                            ELSE
+                                sum_rveget_rstruct(iainia,jv) = &
+                                     & (1.0d0 / (speed * q_cdrag(iainia) * rveg_pft(jv)))
+                            END IF
+
+                            IF (cresist .ne. 0.0d0) THEN
+                                sum_rveget_rstruct(iainia,jv) = &
+                                     & (1.0d0/cresist - 1.0d0) * (1.0d0 / (speed * q_cdrag(iainia) * rveg_pft(jv)))
+                            ELSE
+                                ! sum_rveget_rstruct(iainia,jv) = &
+                                !      & (1.0d0 / (speed * q_cdrag(iainia) * rveg_pft(jv)))
+                                  
+                                sum_rveget_rstruct(iainia,jv) = 0.0d0
+
+                            END IF
+
+                            !WRITE(numout,*) '241113 sub_rveget_rstruct is: ', sum_rveget_rstruct(iainia,jv)
+
+                            vbeta3pot(iainia,jv) = MAX(zero, veget_max(iainia,jv) * cresist)
+
+                              
+                            ! calculate approximate gs, working backwards from vbeta3
+                            !
+                            IF (sum_rveget_rstruct(iainia,jv) .ne. 0.0d0) THEN
+                                gstot(iainia) = 1.0d0 / sum_rveget_rstruct(iainia,jv)
+                            ELSE
+                               ! Need to convert the units of g0
+                               gstot(iainia) = g0(jv)*mol_to_m_1 *(temp_sol(iainia)/tp_00)*&
+                                    (pb_std/pb(iainia))*ratio_H2O_to_CO2
+                            END IF
+                            
+    
+              
+                            !******CHECK KIM: this what I had for a divide by zero bug fix, for now I keep what's in James update
+                            ! IF (cresist .NE. un .AND. speed .GT. min_sechiba .AND. &
+                            !      & q_cdrag(iainia) .GT. min_sechiba .AND. rveg_pft(jv) .GT. min_sechiba) THEN
+                            ! 
+                            ! sum_rveget_rstruct(iainia,jv) = &
+                            !       & (1.0d0/cresist - 1.0d0) * (1.0d0 / (speed * q_cdrag(iainia) * rveg_pft(jv)))
+                            !ENDIF
+
+                            !WRITE(numout,*) '241113 sub_rveget_rstruct is: ', sum_rveget_rstruct(iainia,jv)
+
+
+                            IF (cresist .lt. min_sechiba) THEN
+                                IF(err_act.GT.1 .OR. printlev_loc>=4) THEN
+                                !       WRITE(numout,*) 'cresist is very small or negative   **********************'
+                                !       WRITE(numout,*) 'cresist is: ', cresist
+                                !       WRITE(numout,*) 'vbeta3(iainia, jv) is: ', vbeta3(iainia, jv)
+                                !       WRITE(numout,*) 'veget_max(iainia, jv) is: ', veget_max(iainia, jv)
+                                !       WRITE(numout,*) 'zqsvegrap(iainia) is: ', zqsvegrap(iainia)
+                                !       WRITE(numout,*) '*********************************************************'
+                                ENDIF
+                            ELSE IF (assimi(iainia,jv) .gt. 100.0d0) THEN
+                                WRITE(numout,*) 'assimi(iainia,jv) is very large'
+                            END IF
+
+
+                            IF (gstot(iainia) .gt. 0.0d0) THEN
+                                ! nothing
+                            ELSE
+                                !WRITE(*,*) '121113 gstot .le. 0'
+                            ENDIF
+
+                            ! we assume lai is the sum of lai_per_level over all of the levels
+
+                            ! we now do a unit conversion, from m/s to mol/m^2/s, the reverse
+                            !   of the calculation of section 2.5, below
+
+                            gstot(iainia) =  gstot(iainia) / (mol_to_m_1 *(temp_sol(iainia)/tp_00)* &
+                                       (pb_std/pb(iainia))*ratio_H2O_to_CO2)
+
+
+
+
+                            gs(iainia) = gstot(iainia)*gstot_frac(iainia,jv,ilev) / lai_per_level(iainia,jv,ilev)
+
+                            IF (gs(iainia) .gt. gstot(iainia)) THEN
+                                gs(iainia) = gstot(iainia)
+                            END IF
+                            
+
+
+                            ! define gs, based on vbeta3
+
+                            IF (gs(iainia) .GE. g0(jv)) THEN
+                               assimi(iainia,jv) = (((gs(iainia) - g0(jv)) * (new_leaf_ci(iainia,jv,ilev) - ci_star)) / &
+                                    fvpd(iainia)) - Rd(iainia)
+                            ELSE
+                               assimi(iainia,jv) = -Rd(iainia)
+
+                            ENDIF
+
+                           ! assimi(iainia,jv) = (gs(iainia) - g0(jv)) * (new_leaf_ci(iainia,jv,ilev) - ci_star) / fvpd(iainia) &
+                           !       & - Rd(iainia)
+ 
+                            assimi_store(iainia, jv, ilev) = assimi(iainia,jv)
+
+
+                            ! IF (assimi(iainia,jv) .lt. min_sechiba) THEN
+                            !     WRITE(numout,*) '281113 assimi is: ', assimi
+                            ! END IF
+
+                             IF (assimi(iainia,jv) .lt. min_sechiba) THEN
+                                 assimi(iainia,jv) = 0.0d0
+                             !    WRITE(numout,*) 'assimi(iainia,jv) is negative ***************************************'
+                             !    WRITE(numout,*) 'assimi(iainia,jv) is: ', assimi(iainia,jv)
+                             !    WRITE(numout,*) 'gs(iainia) is: ', gs(iainia)
+                             !    WRITE(numout,*) 'g0(jv) is: ', g0(jv)
+                             !    WRITE(numout,*) 'new_leaf_ci(iainia,jv,ilev) is: ', new_leaf_ci(iainia,jv,ilev)
+                             !    WRITE(numout,*) 'ci_star is: ', ci_star
+                             !    WRITE(numout,*) 'fvpd(iainia) is: ', fvpd(iainia)
+                             !    WRITE(numout,*) 'Rd(iainia) is: ', Rd(iainia)
+                             !    WRITE(numout,*) '*********************************************************'
+                              ELSE IF (assimi(iainia,jv) .gt. 500.0d0) THEN
+                             !    WRITE(numout,*) 'assimi(iainia,jv) is very large'
+                             !    WRITE(numout,*) 'assimi(iainia,jv) is: ', assimi(iainia,jv)
+                             !    WRITE(numout,*) 'temp_sol(iainia) is: ', temp_sol(iainia)
+                             !    WRITE(numout,*) 'vbeta3(iainia, jv) is: ', vbeta3(iainia, jv)
+                             !    WRITE(numout,*) 'gs(iainia) is: ', gs(iainia)
+                             !    WRITE(numout,*) 'g0(jv) is: ', g0(jv)
+                             !    WRITE(numout,*) 'new_leaf_ci(iainia,jv,ilev) is: ', new_leaf_ci(iainia,jv,ilev)
+                             !    WRITE(numout,*) 'ci_star is: ', ci_star
+                             !    WRITE(numout,*) 'Ca(iainia) is: ', Ca(iainia)
+                             !    WRITE(numout,*) 'fvpd(iainia) is: ', fvpd(iainia)
+                             !    WRITE(numout,*) 'Rd(iainia) is: ', Rd(iainia)
+                             !    WRITE(numout,*) 'gstot(iainia) is: ', gstot(iainia)
+                             !    WRITE(numout,*) 'sum_rveget_rstruct(iainia,jv) is: ', sum_rveget_rstruct(iainia,jv)
+                             !    WRITE(numout,*) 'speed is: ', speed
+                             !    WRITE(numout,*) 'q_cdrag(iainia) is: ',q_cdrag(iainia)
+                             !    WRITE(numout,*) 'rveg_pft(jv) is: ', rveg_pft(jv)
+                             !    WRITE(numout,*) 'gstot_frac(iainia,jv,ilev) is: ', gstot_frac(iainia,jv,ilev)
+                             !    WRITE(numout,*) 'lai_per_level(iainia,jv,ilev) is: ', lai_per_level(iainia,jv,ilev)
+                             !    WRITE(numout,*) '*********************************************************'      
+                              END IF
+
+
+
+
+                            ! WRITE(numout,*) '151113 assimi(iainia,jv) (mleb_diffuco_trans_co2) is: ', assimi(iainia,jv)              
+
+                        ENDIF  ! (hydrol_flag3(iainia, jv))
+ 
+                        ! with new assimilation rates for the grid squares and the PFTs for
+                        ! which the supply term restriction replies, we let the rest of the
+                        ! routine run its course from here, to calculate gs and gpp (vbeta3
+                        ! remains the same as that calculated within enerbil)
+
+                        ! JR %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+                        ! Eq. 25 of Yin et al. (2009)
+                        ! It should be Cs instead of Ca but it seems that 
+                        ! other equations in Appendix C make use of Ca
+                       ! IF ( ABS( assimi(iainia,jv) + Rd(iainia) ) .LT. min_sechiba ) THEN
+                        IF ( gs(iainia) .LT. min_sechiba ) THEN
+                            gs(iainia) = g0(jv)
+                        ELSE
+                            ! gs(iainia) = g0(jv) + ( assimi(iainia,jv) + Rd(iainia) ) / ( Ca(iainia) - Cs_star ) * fvpd(iainia)                    
+                            gs(iainia) = gs(iainia) ! as calculated in loop
+                        ENDIF
+
+
+
+                  ENDIF
+                  
+
+                  !
+                  ! @addtogroup Photosynthesis
+                  ! @{   
+                  !
+                  !! 2.4.4 Estimatation of the stomatal conductance (Ball et al., 1987).\n
+                  !! \latexonly
+                  !! \input{mleb_diffuco_trans_co2_2.4.4.tex}
+                  !! \endlatexonly
+                  ! @}           
+                  !
+                  !
+                  ! keep stomatal conductance of the levels which we decide
+                  ! are the top levels.  Notice that we multiply by the LAI
+                  ! in the level here, so this is no longer a per leaf quantity,
+                  ! but the whole quantity.
+                  IF ( top_level(iainia,ilev) ) THEN
+                     gs_top(iainia) = gs_top(iainia)+gs(iainia)*lai_per_level(iainia,jv,ilev)
+                     !
+                  ENDIF
+                  !
+                  ! @addtogroup Photosynthesis
+                  ! @{   
+                  !
+                  !! 2.4.5 Integration at the canopy level\n
+                  !! \latexonly
+                  !! \input{mleb_diffuco_trans_co2_2.4.5.tex}
+                  !! \endlatexonly
+                  ! @}           
+                  ! total assimilation and conductance
+                  !assimtot(iainia,jv) = assimtot(iainia,jv) + &
+                  !     assimi(iainia,jv) * (lai_per_level(ilev+1)-lai_per_level(ilev))
+                  !Rdtot(iainia) = Rdtot(iainia) + &
+                  !     Rd(iainia) * (lai_per_level(ilev+1)-lai_per_level(ilev))
+                  !gstot(iainia) = gstot(iainia) + &
+                  !     gs(iainia) * (lai_per_level(ilev+1)-lai_per_level(ilev))
+                  ! 
+                  !++++++++++++++++++++
+                  ! The equations give the amount of carbon produced per m**2 if
+                  ! leaf surface.  Therefore, since we want GPP in units of m**2 of land surface,
+                  ! we have to multiply by the LAI.
+                  assimtot(iainia,jv) = assimtot(iainia,jv) + &
+                       assimi(iainia,jv) * lai_per_level(iainia,jv,ilev)
+!                       assimi(iainia,jv) 
+                  IF(test_pft == jv .AND. printlev_loc>=4)THEN
+                     WRITE(numout,*) 'assimi ',ilev,iainia,assimi(iainia,jv),lai_per_level(iainia,jv,ilev)
+                  ENDIF
+                  Rdtot(iainia) = Rdtot(iainia) + &
+!                       Rd(iainia) 
+                       Rd(iainia) * lai_per_level(iainia,jv,ilev)
+                  gstot(iainia) = gstot(iainia) + &
+                       gs(iainia) * lai_per_level(iainia,jv,ilev)
+!                       gs(iainia) 
+                  ! WRITE(numout,*) '151113 iainia is: ', iainia, 'gs(iainia) is: ', gs(iainia)
+
+                  !
+                 gstot_output(iainia,jv,ilev) = gstot(iainia)
+                 gs_output(iainia,jv,ilev) = gs(iainia)
+                  !
+
+               ENDIF ! if there is absorbed light
+            ENDDO  ! loop over grid points
+         ENDDO gridloop1 ! loop over LAI steps
+
+
+
+         IF (err_act.GT.1 .AND. assimtot(iainia,jv) .gt. 20) THEN
+             WRITE(numout,*) 'WARNING: assimtot is very high'
+             WRITE(numout,*) 'assimtot is: ', assimtot(iainia,jv)
+             DO ilev=1,nlevels_tot
+                 WRITE (numout,*) 'level: ', ilev, ' pft: ', jv , ' assimi_store: ', assimi_store(iainia, jv, ilev), &
+                                     &' lai_per_level: ', lai_per_level(iainia, jv, ilev)
+             END DO
+         END IF
+
+
+
+
+         DO jij = 1, kjpindex
+             IF (hydrol_flag2(jij)) THEN
+                ! WRITE(*,*) '091113 new assimi(grid point) is: ', assimi(jij)
+             END IF
+         END DO !jij =1, nvm
+  
+     ! WRITE(numout,*) '151113b gstot is: ', gstot
+     ! WRITE(numout,*) '151113b lai_per_level is: ', lai_per_level
+
+      ! Due to the water limited by the transpiration, we nned to recalculated 
+      ! the stomata conductance(resistance) for the GPP.
+      ! In this section, the assimlation should be recalculated.
+      
+      !! 2.5 Calculate resistances
+
+         gridloop2: DO inia=1,nia
+            !
+            iainia=index_assi(inia)
+            !
+            ! We hit a fringe case above where we could not
+            ! calculate the GPP.  Skip this loop so we don't
+            ! divide by zero.
+            IF(lskip(iainia)) CYCLE
+
+           ! DO inina=1,nina
+                 IF (hydrol_flag3(iainia, jv)) THEN
+                 !nothing              
+                 ELSE
+                    CYCLE gridloop2
+                 END IF !(hydrol_flag3)
+           ! END DO !inina=1,nina
+
+
+            !++++++ CHECK ++++++
+            ! We introduce ::coupled_lai to calculate the :: vbeta3 
+            ! In an closed canopy not all the leaves fully interact with the
+            ! atmosphere because leaves can shelter each other. In a more open
+            ! canopy most leaves can interact with the atmosphere. We use the
+            ! ratio of lai over ::Pgap as a proxy for the amount of canopy that
+            ! can interact with the atmosphere. Clearly that amount of lai that
+            ! interacts should never exceed the:: total_lai.
+            coupled_lai(iainia, jv) = biomass_to_coupled_lai( SUM(circ_class_biomass(iainia, &
+                 jv, :,ileaf, icarbon)*circ_class_n(iainia, jv,:)), veget(iainia,jv), jv)
+            
+            ! Calculate lai
+            lai(iainia, jv) = cc_to_lai( circ_class_biomass(iainia, jv,:, ileaf,&
+                 icarbon),circ_class_n(iainia, jv,:), jv )
+            lai(:,ibare_sechiba) = zero
+
+            gstot(iainia) = gstot(iainia)* (coupled_lai(iainia,jv)/lai(iainia,jv))
+            
+           
+            ! WRITE(numout,*) '151113 inia is: ', inia, 'gstot is: ', gstot(iainia)
+            !
+            !! Mean stomatal conductance for CO2 (mol m-2 s-1)
+            gsmean(iainia,jv) = gstot(iainia)
+            !
+            ! cimean is the "mean ci" calculated in such a way that assimilation 
+            ! calculated in enerbil is equivalent to assimtot
+            !
+            IF((assimtot(iainia,jv)+Rdtot(iainia)) .GT. min_sechiba)THEN
+               cimean(iainia,jv) = (gsmean(iainia,jv)-g0(jv)) &
+                    / (fvpd(iainia)*(assimtot(iainia,jv)+Rdtot(iainia))) &
+                    + gamma_star(iainia) 
+            ELSE
+               ! According to Nicolas, this variable is completely diagnostic and not
+               ! used for anything.  If the analytical photosynthesis is unable to find
+               ! a solution for the A_1 coefficients in any of the levels, assimtot will
+               ! be equal to -Rd, which means we will be dividing by zero.  This loop
+               ! is to prevent that, and since cimean is diagnostic is doesn't matter
+               ! what the value is.
+               cimean(iainia,jv) = val_exp
+            ENDIF
+                 
+            ! conversion from umol m-2 (PFT) s-1 to gC m-2 (mesh area) tstep-1
+            gpp(iainia,jv) = assimtot(iainia,jv)*12e-6*veget_max(iainia,jv)*dt_sechiba
+
+            ! IF (gpp(iainia, jv) .lt. min_sechiba) THEN
+            !    WRITE(numout,*) 'gpp is very small ***************************************'
+            !    WRITE(numout,*) 'assimtot(iainia,jv) is: ', assimtot(iainia,jv)
+            !    WRITE(numout,*) 'fvpd(iainia) is: ', fvpd(iainia)
+            !    WRITE(numout,*) 'Rdtot(iainia) is: ', Rdtot(iainia)
+            !    WRITE(numout,*) 'veget_max(iainia,jv) is: ', veget_max(iainia,jv)
+            !    WRITE(numout,*) 'gsmean(iainia,jv) is: ', gsmean(iainia,jv)
+            !    WRITE(numout,*) 'g0(jv) is: ', g0(jv)
+            !    WRITE(numout,*) '*********************************************************'
+            ! ELSE IF (gpp(iainia, jv) .gt. 100.0d0) THEN
+            !    WRITE(numout,*) 'gpp is very large'
+            ! END IF
+
+            !IF(test_grid ==1 .AND. jv == test_pft)THEN
+            !   istep=istep+1
+            !   WRITE(numout,*) 'gpp jdiffuco: ',istep, gpp(iainia,jv), assimtot(iainia,jv),veget_max(iainia,jv)
+            !ENDIF
+
+            ! conversion from (mol m-2 s-1) to (umol m-2 s-1)
+            gsmean(iainia,jv) = gsmean(iainia,jv)*1e-6
+            !
+            ! conversion from mol/m^2/s to m/s
+            !
+            ! As in Pearcy, Schulze and Zimmermann
+            ! Measurement of transpiration and leaf conductance
+            ! Chapter 8 of Plant Physiological Ecology
+            ! Field methods and instrumentation, 1991
+            ! Editors:
+            !
+            !    Robert W. Pearcy,
+            !    James R. Ehleringer,
+            !    Harold A. Mooney,
+            !    Philip W. Rundel
+            !
+            ! ISBN: 978-0-412-40730-7 (Print) 978-94-010-9013-1 (Online)
+            !
+            !
+            !we have already do the unit convertoion in the assimilation loop (gridloop1) 
+            ! 
+            !gstot(iainia) =  mmol_to_m_1 *(temp_sol(iainia)/tp_00)*&
+            !     (pb_std/pb(iainia))*gstot(iainia)*ratio_H2O_to_CO2
+            !gstop(iainia) =  mmol_to_m_1 * (temp_sol(iainia)/tp_00)*&
+            !     (pb_std/pb(iainia))*gs_top(iainia)*ratio_H2O_to_CO2
+             
+            
+            !+++++++++Output some information regarding ::rveget and pft 
+            !IF (jv == test_pft .AND. test_grid == 1) THEN
+             !                  WRITE(numout, '(A20, ES15.5)' ) 'New_Vbeta3:', vbeta3(iainia,jv)
+             !                  WRITE(numout, '(A20, I5)'    ) 'pft type is:    ', jv
+             !                  WRITE(numout, '(A20, ES15.5)') 'New_Gs_total:', gstot(iainia)    
+            !ENDIF
+            !+++++++++++++++++++++++++++++++++++ 
+            
+            !rveget(iainia,jv) = un/gstop(iainia)
+            
+            !+++++CHECK+++++++++++++++++++++++++
+            !For the grass land, we assume that there are still  
+            !some stomata on the other side of its leaves.
+            !IF (.NOT. is_tree(jv) ) THEN
+            !    gstot(iainia) = 1.25_r_std * gstot(iainia)
+            !ENDIF
+            !we try to set rvegt as un/gstot 
+            rveget(iainia,jv) = un/gstot(iainia)
+            
+            ! Calculate the LAI from the biomass. 
+            lai(iainia,jv) = cc_to_lai(circ_class_biomass(iainia,jv,:,ileaf,icarbon), &
+                 circ_class_n(iainia,jv,:),jv)
+            lai(:,ibare_sechiba) = zero
+
+            IF (lai(iainia, jv) .lt. 0.1d0) THEN
+                rveget_min(iainia,jv) = (defc_plus / kzero(jv)) * (un / 0.1d0)
+            ELSE
+                rveget_min(iainia,jv) = (defc_plus / kzero(jv)) * (un / lai(iainia,jv))
+            END IF
+
+            !
+            ! rstruct is the difference between rtot (=1./gstot) and rveget
+            !
+            ! Correction Nathalie - le 27 Mars 2006 - Interdire a rstruct d'etre negatif
+            !rstruct(iainia,jv) = un/gstot(iainia) - &
+            !     rveget(iainia,jv)
+            !rstruct(iainia,jv) = MAX( un/gstot(iainia) - &
+            !     rveget(iainia,jv), min_sechiba)
+            !
+            !
+            !! wind is a global variable of the diffuco module.
+            speed = MAX(min_wind, jwind(iainia))
+            !
+            ! beta for transpiration
+            !
+            ! Corrections Nathalie - 28 March 2006 - on advices of Fred Hourdin
+            !! Introduction of a potentiometer rveg_pft to settle the rveg+rstruct sum problem in the coupled mode.
+            !! rveg_pft=1 in the offline mode. rveg_pft is a global variable declared in the diffuco module.
+            !vbeta3(iainia,jv) = veget_max(iainia,jv) * &
+            !  (un - zqsvegrap(iainia)) * &
+            !  (un / (un + speed * q_cdrag(iainia) * (rveget(iainia,jv) + &
+            !   rstruct(iainia,jv))))
+
+
+            !! Global resistance of the canopy to evaporation
+            cresist=(un / (un + speed * q_cdrag(iainia) * &
+                 (rveg_pft(jv)*(rveget(iainia,jv) ))))
+
+           !WRITE(*,*) '051113 within mleb_diffuco_trans_co2 before defn. vbeta3(1,:) is', vbeta3(1,:)
+
+           ! 051113 commenting out the calculation of vbeta3 (as this is already defined, either from 
+           ! the first call to this module or as part of the new enerbil (when constrained by the supply
+           ! term))
+
+!            vbeta3(icinic,jv) = veget_max(icinic,jv) * &
+!                 (un - zqsvegrap(icinic)) * cresist + &
+!    !!                 $          ! Addition Nathalie - June 2006
+!    !!            $          vbeta3(icinic,jv) = vbeta3(icinic,jv) + &
+!                 ! Corrections Nathalie - 09 November 2009 : veget => veget_max
+!    !                 MIN( vbeta23(icinic,jv), veget(icinic,jv) * &
+!                 MIN( vbeta23(icinic,jv), veget_max(icinic,jv) * &
+!     !                 zqsvegrap(icinic) * humrel(icinic,jv) * &
+!                 zqsvegrap(icinic) * cresist )
+            ! Fin ajout Nathalie
+
+           !WRITE(*,*) '051113 within mleb_diffuco_trans_co2 after defn. vbeta3(1,:) is', vbeta3(1,:)
+
+
+
+
+            ! vbeta3pot for computation of potential transpiration (needed for irrigation)
+           ! vbeta3pot(iainia,jv) = MAX(zero, veget_max(iainia,jv) * cresist)
+
+
+
+
+          ! 211013 - we have derived a new vbeta3 from the enerbil segment
+
+
+       !   WRITE(*,*) '051113 2nd call: vbeta3(iainia, jv) is: ', vbeta3(icinic, jv) 
+       !   WRITE(*,*) '051113 2nd call: veget_max(iainia, jv) is: ', veget_max(icinic, jv) 
+       !   WRITE(*,*) '051113 2nd call: zqsvegrap(iainia) is: ', zqsvegrap(icinic) 
+       !   WRITE(*,*) '051113 2nd call: vbeta23(iainia, jv) is: ', vbeta23(icinic, jv) 
+       !   WRITE(*,*) '051113 2nd call: cresist is: ', cresist 
+
+
+
+
+
+
+          ! first case
+          !WRITE(*,*) '051113 previous cresist: ', cresist
+          !cresist = vbeta3(iainia, jv) / &
+          !      &  ( veget_max(iainia, jv) * (1.0d0 - zqsvegrap(iainia)) + &
+          !      &  veget_max(iainia, jv) * zqsvegrap(iainia) )
+
+
+          !IF (vbeta23(iainia, jv) .le. &
+          !       &  (veget_max(iainia, jv) * zqsvegrap(iainia) * cresist) ) THEN
+             ! do nothing
+          ! ELSE
+          ! cresist = vbeta3(iainia, jv) / &
+          !       & ( veget_max(iainia, jv) * (1.0d0 - zqsvegrap(iainia)) + &
+          !       & vbeta23(iainia, jv) )
+          !cresist = (vbeta3(iainia, jv) - vbeta23(iainia, jv)  )  / &
+          !      & ( veget_max(iainia, jv) * (1.0d0 - zqsvegrap(iainia))  )
+
+          !END IF !
+
+
+
+
+
+
+
+          !WRITE(*,*) '051113 new cresist: ', cresist
+
+
+          !! Potentiometer to set vegetation resistance (unitless)
+
+          !sum_rveget_rstruct(iainia,jv) = &
+          !      & (1.0d0/cresist) * (1.0d0 / (speed * q_cdrag(iainia) * rveg_pft(jv)))
+
+
+
+
+
+
+
+
+          !WRITE(*,*) '051113 previous vbeta3pot: ', vbeta3pot
+          !vbeta3pot(iainia,jv) = MAX(zero, veget_max(iainia,jv) * cresist)
+          !WRITE(*,*) '051113 new vbeta3pot: ', vbeta3pot
+
+
+
+
+
+
+
+       ! vbetaco2 is not used anymore, replaced by gsmean, so I need to rethink the calculation
+       !   of these co-efficients when restriction by the supply term applies
+
+       !   WRITE(*,*) '211013c previous vbetaco2: ', vbetaco2
+       !   vbetaco2(iainia,jv) = veget_max(iainia,jv) * &
+       !      (un / (un + speed * q_cdrag(iainia) * &
+       !      (sum_rveget_rstruct(iainia,jv)))) / O2toCO2_stoechio
+       !   WRITE(*,*) '211013c new vbetaco2: ', vbetaco2
+
+       !   cimean(iainia,jv) = ccanopy(iainia) - &
+       !      assimtot(iainia,jv) / &
+       !      ( vbetaco2(iainia,jv)/veget_max(iainia,jv) * &
+       !      rau(iainia) * speed * q_cdrag(iainia))
+
+
+
+
+!          ! beta for transpiration
+!          !
+!          ! Corrections Nathalie - 28 March 2006 - on advices of Fred Hourdin
+!          !! Introduction of a potentiometer rveg_pft to settle the rveg+rstruct sum problem in the coupled mode.
+!          !! rveg_pft=1 in the offline mode. rveg_pft is a global variable declared in the diffuco module.
+!          !vbeta3(iainia,jv) = veget_max(iainia,jv) * &
+!          !  (un - zqsvegrap(iainia)) * &
+!          !  (un / (un + speed * q_cdrag(iainia) * (rveget(iainia,jv) + &
+!          !   rstruct(iainia,jv))))
+!          !! Global resistance of the canopy to evaporation
+!          cresist=(un / (un + speed * q_cdrag(iainia) * &
+!               (rveg_pft(jv)*(rveget(iainia,jv) + rstruct(iainia,jv)))))
+
+
+!          vbeta3(iainia,jv) = veget_max(iainia,jv) * &
+!            (un - zqsvegrap(iainia)) * cresist + &
+!!!$          ! Addition Nathalie - June 2006
+!!!$          vbeta3(iainia,jv) = vbeta3(iainia,jv) + &
+!             ! Corrections Nathalie - 09 November 2009 : veget => veget_max
+!!               MIN( vbeta23(iainia,jv), veget(iainia,jv) * &
+!               MIN( vbeta23(iainia,jv), veget_max(iainia,jv) * &
+!!               zqsvegrap(iainia) * humrel(iainia,jv) * &
+!               zqsvegrap(iainia) * cresist )
+!          ! Fin ajout Nathalie
+
+!          ! vbeta3pot for computation of potential transpiration (needed for irrigation)
+!          vbeta3pot(iainia,jv) = MAX(zero, veget_max(iainia,jv) * cresist)
+          !
+          ! beta for assimilation. The difference is that surface 
+          ! covered by rain (un - zqsvegrap(iainia)) is not taken into account
+          ! The factor 1.6 is conversion for H2O to CO2 conductance.
+          ! vbetaco2(iainia,jv) = veget_max(iainia,jv) * &
+          !   (un / (un + q_cdrag(iainia) * &
+          !   (rveget(iainia,jv))))/1.6
+          !
+
+!          !! Global resistance of the canopy to CO2 transfer
+!          vbetaco2(iainia,jv) = veget_max(iainia,jv) * &
+!             (un / (un + speed * q_cdrag(iainia) * &
+!             (rveget(iainia,jv) + rstruct(iainia,jv)))) / O2toCO2_stoechio
+          !
+          ! cimean is the "mean ci" calculated in such a way that assimilation 
+          ! calculated in enerbil is equivalent to assimtot
+          !
+!          cimean(iainia,jv) = ccanopy(iainia) - &
+!             assimtot(iainia,jv) / &
+!             ( vbetaco2(iainia,jv)/veget_max(iainia,jv) * &
+!             rau(iainia) * speed * q_cdrag(iainia))
+
+            !
+            !
+         ENDDO gridloop2 !loop over grid points
+         !
+      ENDIF ! if nia LT zero
+      !
+   ENDDO ! loop over vegetation types
+   !
+   IF (printlev>=3) WRITE (numout,*) ' mleb_diffuco_trans_co2 done '
+
+   !WRITE (numout,*) 'calling jnetcdf_trans_co2'
+
+    ! this writes canopy profile data from this routine to a seperate netCDF file every time step,
+    !   though it does slow the runtime considerably, so is only for diagnostics
+
+    !CALL jnetcdf_trans_co2(kjpindex, james_netcdf_flag, gs_distribution(1,:,:), gs_output(1,:,:), &
+    !                      & lai_per_level(1,:,:), light_tran_to_level(1,:,:), gs_diffuco_output(1,:,:), &
+    !                      & gstot_output(1,:,:))   
+    
+    
+             
+                          
+    IF(printlev_loc>=4)THEN
+       WRITE(numout,*) 'gpp at the end of mleb_diffuco_trans_co2 ',gpp
+    ENDIF
+
+
+END SUBROUTINE mleb_diffuco_trans_co2
+
+
+
+ ! ---------------------------------------------------------------------------------------
+
+
+
+  FUNCTION Arrhenius (kjpindex,temp,ref_temp,energy_act) RESULT ( val_arrhenius )
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                     :: kjpindex          !! Domain size (-)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)    :: temp              !! Temperature (K)
+    REAL(r_std), INTENT(in)                       :: ref_temp          !! Temperature of reference (K)
+    REAL(r_std),INTENT(in)                        :: energy_act        !! Activation Energy (J mol-1)
+    
+    !! 0.2 Result
+
+    REAL(r_std), DIMENSION(kjpindex)              :: val_arrhenius     !! Temperature dependance based on
+                                                                       !! a Arrhenius function (-)
+    
+    val_arrhenius(:)=EXP(((temp(:)-ref_temp)*energy_act)/(ref_temp*RR*(temp(:))))
+  END FUNCTION Arrhenius
+
+  FUNCTION Arrhenius_modified (kjpindex,temp,ref_temp,energy_act,energy_deact,entropy) RESULT ( val_arrhenius )
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                     :: kjpindex          !! Domain size (-)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)    :: temp              !! Temperature (K)
+    REAL(r_std), INTENT(in)                       :: ref_temp          !! Temperature of reference (K)
+    REAL(r_std),INTENT(in)                        :: energy_act        !! Activation Energy (J mol-1)
+    REAL(r_std),INTENT(in)                        :: energy_deact      !! Deactivation Energy (J mol-1)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)    :: entropy           !! Entropy term (J K-1 mol-1)
+        
+    !! 0.2 Result
+
+    REAL(r_std), DIMENSION(kjpindex)              :: val_arrhenius     !! Temperature dependance based on
+                                                                       !! a Arrhenius function (-)
+    
+    val_arrhenius(:)=EXP(((temp(:)-ref_temp)*energy_act)/(ref_temp*RR*(temp(:))))  &
+         * (1. + EXP( (ref_temp * entropy(:) - energy_deact) / (ref_temp * RR ))) &
+         / (1. + EXP( (temp(:) * entropy(:) - energy_deact) / ( RR*temp(:))))
+         
+  END FUNCTION Arrhenius_modified
+
+
+ ! ---------------------------------------------------------------------------------------
+
+
+ SUBROUTINE jnetcdf_trans_co2(kjpindex, james_netcdf_flag, gs_distribution_in, gs_output_in, &
+                               lai_per_level_in, light_tran_to_level_in, gs_diffuco_output_in, &
+                               gstot_output_in) 
+ 
+    USE netcdf
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                         :: kjpindex         !! Domain size (unitless)
+
+    CHARACTER(LEN=80)                                                  :: jamescdfname          
+ 
+    REAL(r_std), DIMENSION (nvm, nlevels_tot), INTENT(in)              :: gs_distribution_in     
+    REAL(r_std),DIMENSION (nvm, nlevels_tot), INTENT(in)               :: gs_output_in
+    REAL(r_std),DIMENSION (nvm, nlevels_tot), INTENT(in)               :: gstot_output_in
+    REAL(r_std),DIMENSION (nvm, nlevels_tot), INTENT(in)               :: lai_per_level_in
+    REAL(r_std),DIMENSION (nvm, nlevels_tot), INTENT(in)               :: light_tran_to_level_in
+    REAL(r_std),DIMENSION (nvm, nlevels_tot), INTENT(in)               :: gs_diffuco_output_in
+
+
+    LOGICAL                                                            :: james_netcdf_flag    
+
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std), SAVE                     :: gsd_id
+    INTEGER(i_std), SAVE                     :: gso_id
+    INTEGER(i_std), SAVE                     :: gsto_id
+    INTEGER(i_std), SAVE                     :: lpl_id
+    INTEGER(i_std), SAVE                     :: lttl_id
+    INTEGER(i_std), SAVE                     :: gsdo_id
+
+    INTEGER(i_std)                           :: ii, jj
+    INTEGER(i_std), SAVE                     :: mleb_step_count    
+
+    INTEGER(i_std), SAVE                     :: iret, iret2, fid, fid2
+    INTEGER(i_std)                           :: TimeDimID, jtid, ts_id, HeightDimID, i
+    INTEGER(i_std)                           :: height_dim_id, height_dim_id2, time_dim_id
+    INTEGER(i_std)                           :: pftno_dim_id
+    INTEGER(i_std)                           :: dimids(3) 
+    INTEGER(i_std), SAVE                     :: tap_id
+    INTEGER, DIMENSION(3)                    :: jstartnc, jcountnc    
+
+
+    jamescdfname = '/home/users/jryder/james.ryder/outputcdf.nc'
+ 
+    IF (james_netcdf_flag) THEN
+
+        james_netcdf_flag = .FALSE.
+        
+        ! mleb_step_count = 0
+ 
+        ! WRITE(numout,*) 'james_netcdf_flag call here'
+
+        ! âŠ define the parameters here
+ 
+        iret = nf90_create(jamescdfname, nf90_write, fid)
+        
+  
+        ! define the dimensions
+
+        iret = nf90_def_dim(fid, "pftno", nvm, pftno_dim_id)        
+        iret = nf90_def_dim(fid, "height", nlevels_tot, height_dim_id)
+        iret = nf90_def_dim(fid, "time", nf90_unlimited, time_dim_id)
+
+        dimids = (/ pftno_dim_id, height_dim_id, time_dim_id /)
+
+ 
+        ! define the variables
+        iret = nf90_def_var (fid, "gs_distribution_in", nf90_real4, dimids, gsd_id)
+        iret = nf90_def_var (fid, "gs_output_in", nf90_real4, dimids, gso_id)
+        iret = nf90_def_var (fid, "gstot_output_in", nf90_real4, dimids, gsto_id)
+        iret = nf90_def_var (fid, "lai_per_level_in", nf90_real4, dimids, lpl_id)
+        iret = nf90_def_var (fid, "light_tran_to_level_in", nf90_real4, dimids, lttl_id)
+        iret = nf90_def_var (fid, "gs_diffuco_output_in", nf90_real4, dimids, gsdo_id)
+
+ 
+        iret = nf90_enddef (fid)
+         
+    END IF !(james_netcdf_flag)
+
+
+    ! open the netCDF file at each step
+    iret = nf90_open(jamescdfname, nf90_Write, fid) 
+
+    jstartnc = (/ 1, 1, 1 /)  ! vector of integers specifying the index in the variable from 
+                              !   which the first of the data values will be read
+    jcountnc = (/ nvm, nlevels_tot, 1 /)  ! vector of integers specifying the number of indices 
+                                     !   selected along each dimension
+
+    mleb_step_count = mleb_step_count + 1    ! this is the time step counter
+    
+        
+    jstartnc(3) = mleb_step_count   ! (2) refers to the time dimension at present (it 
+                                     !   must always come last)
+ 
+
+    iret = nf90_put_var(fid, gsd_id, gs_distribution_in, start = jstartnc, count = jcountnc) 
+    iret = nf90_put_var(fid, gso_id, gs_output_in, start = jstartnc, count = jcountnc) 
+    iret = nf90_put_var(fid, gsto_id, gstot_output_in, start = jstartnc, count = jcountnc) 
+    iret = nf90_put_var(fid, lpl_id, lai_per_level_in, start = jstartnc, count = jcountnc) 
+    iret = nf90_put_var(fid, lttl_id, light_tran_to_level_in, start = jstartnc, count = jcountnc) 
+    iret = nf90_put_var(fid, gsdo_id, gs_diffuco_output_in, start = jstartnc, count = jcountnc) 
+
+
+
+    ! close the netCDF file and write to disk                   
+    iret = nf90_close(fid)
+
+ 
+ END SUBROUTINE jnetcdf_trans_co2
+
+ 
+ ! ------------------------------------------------------------------------------------------------------------------------------------- 
+
+
+
+END MODULE sechiba_hydrol_arch
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/sechiba_io.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/sechiba_io.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/sechiba_io.f90	(revision 6412)
@@ -0,0 +1,467 @@
+!! This subroutines initialize a variable or an array
+!! with a variable or an array of smaller rank
+!! - i is for integer interface - r for real interface
+!! - 0 is for a scalar - 1 for a 1D array - 2 for a 2D array
+!! Thee right routines is automatically called depending type of input variable
+!! This initialisation is done only if the value of input field is egal to val_exp
+!!
+!! If a key word is provided which is not equal to "NO_KEYWORD" or "NOKEYWORD" then
+!! we try to find the value to fill in in the configuration file.
+!!
+!! @author Marie-Alice Foujols and Jan Polcher
+!! @Version : $Revision$, $Date$
+!! 
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! IPSL (2006)
+!!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!!
+
+MODULE sechiba_io
+
+  USE defprec
+  USE constantes
+  USE ioipsl
+  USE sechiba_io_p
+
+  IMPLICIT NONE
+
+  INTERFACE setvar
+    MODULE PROCEDURE i0setvar, i10setvar, i20setvar, i11setvar, i21setvar, i22setvar
+    MODULE PROCEDURE r0setvar, r10setvar, r20setvar, r11setvar, r21setvar, r22setvar, r30setvar
+  END INTERFACE
+
+!
+! mettre la l'interface des routines utilisees:
+!
+! restget/put/ini histbeg/def flinopen/close
+!
+
+LOGICAL, SAVE                  :: long_print_setvar=.FALSE.  !! change to true to have more information
+!$OMP THREADPRIVATE(long_print_setvar)
+
+CONTAINS 
+
+
+!! Interface for integer scalar to scalar.
+SUBROUTINE i0setvar (var, val_exp, key_wd, val_put)
+
+  INTEGER(i_std), INTENT(inout)                   :: var                  !! Integer scalar to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Initial value to stored
+
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar) WRITE(numout,*) "i0setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( var == val_exp ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var = val_tmp
+  END IF
+  
+END SUBROUTINE i0setvar
+
+
+!! Interface for initialising an 1D integer array with a scalar integer.
+SUBROUTINE i10setvar (var, val_exp, key_wd, val_put)
+
+  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+  
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar) WRITE(numout,*) "i10setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var(:) = val_tmp
+  END IF
+  
+END SUBROUTINE i10setvar
+
+
+!! Interface for initialising an 1D array integer with an other 1D array integer.
+SUBROUTINE i11setvar (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
+
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar) WRITE(numout,*) "i11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var(:) = val_tmp (:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i11setvar
+
+
+!! Interface for initialising an 2D array integer with a scalar integer.
+SUBROUTINE i20setvar (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  !
+  ! this subroutine set val_put value to var if var is constant
+  ! 
+  !
+  IF (long_print_setvar) WRITE(numout,*) "i20setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var(:,:) = val_tmp
+  END IF
+  
+END SUBROUTINE i20setvar
+
+
+!! Interface for initialising an 2D array integer with an 1D array integer.
+!! Row or column depending size of 1D array to stored.
+!!
+!! example: 1D 1,2,3     2D is 1, 2, 3,
+!!                             1, 2, 3
+!!
+!!
+!! example: 1D 1,2,3     2D is 1, 1,
+!!                             2, 2,
+!!                             3, 3
+!!
+SUBROUTINE i21setvar (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D integer array to stored
+  
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  ! test if the 1D array dimension is compatible with first or second 
+  ! dimension of the 2D array
+
+  IF (long_print_setvar) WRITE(numout,*) "i21setvar :", key_wd, val_exp, val_put
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF (SIZE(val_put)==SIZE(var,1)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+      !                                1., 2., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
+      END IF
+  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 1.,
+      !                                2., 2.,
+      !                                3., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
+      END IF
+  ELSE 
+      WRITE(numout,*) ' incompatible dimension var and val_put'
+      WRITE(numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
+      WRITE(numout,*) ' val_put ', SIZE(val_put)
+      STOP 'setvar'
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i21setvar
+
+!! Interface for initialising an 2D array integer with an other 2D array integer.
+SUBROUTINE i22setvar (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd              !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
+
+  INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar) WRITE(numout,*) "i21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
+
+  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
+  val_tmp(:,:) = val_put(:,:)
+
+  IF ( ALL(var(:,:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:,:) = val_tmp(:,:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i22setvar
+
+
+!! Interface for scalar to scalar real
+SUBROUTINE r0setvar (var, val_exp, key_wd, val_put)
+  
+  REAL(r_std), INTENT(inout)                   :: var                  !! Real scalar to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Initial value to stored
+  
+  REAL(r_std)                                  :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar) WRITE(numout,*) "r0setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( var==val_exp ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var = val_tmp
+  END IF
+  
+END SUBROUTINE r0setvar
+
+
+!! Interface for initialising an 1D real array with a scalar real.
+SUBROUTINE r10setvar (var, val_exp, key_wd, val_put)
+  
+  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+   
+  REAL(r_std)                                  :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+ 
+  IF (long_print_setvar) WRITE(numout,*) "r10setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:) = val_tmp
+  END IF
+  
+END SUBROUTINE r10setvar
+
+
+!! Interface for initialising an 1D array real with an other 1D array real.
+SUBROUTINE r11setvar (var, val_exp, key_wd, val_put)
+  
+  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd              !! The Key word we will look for
+  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
+
+  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+   
+  IF (long_print_setvar) WRITE(numout,*) "r11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:) = val_tmp (:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r11setvar
+
+
+!! Interface for initialising an 2D array real with a scalar real.
+SUBROUTINE r20setvar (var, val_exp, key_wd, val_put)
+  
+  ! interface for scalar to 2D array real
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd                  !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+ 
+  REAL(r_std)                                  :: val_tmp  
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+ 
+  IF (long_print_setvar) WRITE(numout,*) "r20setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var(:,:) = val_tmp
+  END IF
+  
+END SUBROUTINE r20setvar
+
+
+!! Interface for initialising an 2D array real with an 1D array real.
+!! Row or column depending size of 1D array to stored.
+!!
+!! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+!!                                1., 2., 3.
+!!
+!!
+!! example: 1D 1.,2.,3.     2D is 1., 1.,
+!!                                2., 2.,
+!!                                3., 3.
+!!
+SUBROUTINE r21setvar (var, val_exp, key_wd, val_put)
+  
+  ! interface for 1D array to 2D array real
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D real array to stored
+
+  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  ! test if the 1D array dimension is compatible with first or second 
+  ! dimension of the 2D array
+
+  IF (long_print_setvar) WRITE(numout,*) "r21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF (SIZE(val_put)==SIZE(var,1)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+      !                                1., 2., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
+      END IF
+  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 1.,
+      !                                2., 2.,
+      !                                3., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
+      END IF
+  ELSE 
+      WRITE(numout,*) ' incompatible dimension var and val_put'
+      WRITE(numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
+      WRITE(numout,*) ' val_put ', SIZE(val_put)
+      STOP 'setvar'
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r21setvar
+
+
+!! Interface for initialising an 2D array real with an other 2D array real. 
+SUBROUTINE r22setvar (var, val_exp, key_wd, val_put)
+  
+  ! interface for 2D array to 2D array real
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd              !! The Key word we will look for
+  REAL(r_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
+
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar) WRITE(numout,*) "r22setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
+
+  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
+  val_tmp(:,:) = val_put(:,:)
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:,:) = val_tmp(:,:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r22setvar
+
+!! Interface for initialising an 3D array real with a scalar real.
+SUBROUTINE r30setvar (var, val_exp, key_wd, val_put)
+
+  ! interface for scalar to 3D array real
+
+  REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: var                  !! 3D integer array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+
+  REAL(r_std)                                  :: val_tmp 
+  INTEGER(i_std)                              :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar) WRITE(numout,*) 'r30setvar',val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:,:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:,:,:) = val_tmp
+  END IF
+
+END SUBROUTINE r30setvar
+
+END MODULE sechiba_io
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/sechiba_io_p.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/sechiba_io_p.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/sechiba_io_p.f90	(revision 6412)
@@ -0,0 +1,671 @@
+! ================================================================================================================================
+!  MODULE       : sechiba_io_p
+!
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!                 This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF          To be used for intializing variables not read available in the restart file
+!!
+!!\n DESCRIPTION: This module contains the interface to setvar_p to be used for intializing variables if they were 
+!!                not found in the restart file. The variable will only be modified if it was not found in the restart
+!!                file (i.e. if it is eqaul val_exp).
+!!
+!!                Syntax : CALL setvar_p (var, val_exp, key_wd, val_put)
+!!                  var : the variable to initialize; It can be an integer or a real, a scalar or have 1 or 2 dimensions
+!!                  val_exp : the value set by restget_p if the variable was not found in the restart file (do not change this)
+!!                  key_wd  : parameter name to be searched for in run.def
+!!                  val_put : a value to be used if the kew_wd was not found in run.def. val_put must have the same or
+!!                            smaller rank as var
+!!
+!!                Note that setvar_p must always be called by all processes because it contains call to getin_p.
+!!                - The variable var, will only be modified if before the call it is equal to val_exp. Otherwise nothing is done.
+!!                - If var is equal to val_exp and if key_wd is not equal "NO_KEYWORD" or "NOKEYWORD", then the value for key_wd 
+!!                  is read from run.def using getin_p and used to initialize var.
+!!                - If key_wd is not found in run.def or if key_wd="NO_KEYWORD" or "NOKEYWORD", then the val_put will be used to 
+!!                  initialize var.
+!!
+!!                The interface will automatically call the right subroutine depending on the type of input variables.
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE sechiba_io_p
+
+  USE defprec
+  USE constantes
+  USE ioipsl
+  USE ioipsl_para
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC setvar_p
+
+  INTERFACE setvar_p
+    MODULE PROCEDURE i0setvar_p, i10setvar_p, i20setvar_p, i11setvar_p, i21setvar_p
+    MODULE PROCEDURE r0setvar_p, r10setvar_p, r20setvar_p, r11setvar_p, r21setvar_p, &
+         r22setvar_p, r30setvar_p, r40setvar_p, r50setvar_p  
+  END INTERFACE
+
+  LOGICAL, SAVE                  :: long_print_setvar_p=.FALSE.  !! change to true to have more information
+!$OMP THREADPRIVATE(long_print_setvar_p)
+
+CONTAINS 
+
+!! =============================================================================================================================
+!! SUBROUTINE   : i0setvar_p
+!!
+!>\BRIEF	  Subroutine for initializing an integer scalar variable with a scalar integer.
+!!
+!! DESCRIPTION  : Subroutine for initializing an integer scalar variable with a scalar integer.
+!!                This subroutine must be called by all processes.
+!! \n
+!_ =============================================================================================================================
+
+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
+
+
+!! =============================================================================================================================
+!! SUBROUTINE   : i10setvar_p
+!!
+!>\BRIEF	  Subroutine for initializing an integer 1D array with a integer scalar variable.
+!!
+!! DESCRIPTION  : Subroutine for initializing an integer 1D array with a integer scalar variable.
+!!                This subroutine must be called by all processes.
+!! \n
+!_ =============================================================================================================================
+
+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
+
+
+!! =============================================================================================================================
+!! SUBROUTINE   : i11setvar_p
+!!
+!>\BRIEF	  Subroutine for initializing an integer 1D array with another integer 1D array.
+!!
+!! DESCRIPTION  : Subroutine for initializing an integer 1D array with another integer 1D array.
+!!                This subroutine must be called by all processes.
+!! \n
+!_ =============================================================================================================================
+
+SUBROUTINE i11setvar_p (var, val_exp, key_wd, val_put, is_grid)
+  
+  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                    :: key_wd              !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
+  LOGICAL,        OPTIONAL                        :: is_grid             !! Parameter present indicates a setvar for a grid variable 
+
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp_g
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar_p) WRITE (numout,*) "i11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+        IF (PRESENT(is_grid) ) THEN
+           IF (is_root_prc) THEN
+              ALLOCATE( val_tmp_g(nbp_glo) )
+           ELSE
+              ALLOCATE( val_tmp_g(1) )
+           ENDIF
+           CALL gather( val_tmp,val_tmp_g )
+           IF (is_root_prc) &
+              CALL getin(key_wd,  val_tmp_g)
+           CALL scatter( val_tmp,val_tmp_g )
+           DEALLOCATE( val_tmp_g )
+        ELSE
+           CALL getin_p(key_wd,  val_tmp)
+        ENDIF
+     ENDIF
+     var(:) = val_tmp (:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i11setvar_p
+
+
+!! =============================================================================================================================
+!! SUBROUTINE   : i20setvar_p
+!!
+!>\BRIEF	  Subroutine for initializing an integer 2D variable with a scalar integer variable.
+!!
+!! DESCRIPTION  : Subroutine for initializing an integer 2D variable with a scalar integer variable.
+!!                This subroutine must be called by all processes.
+!! \n
+!_ =============================================================================================================================
+
+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 be used as default
+
+  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,*) "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
+
+
+!! =============================================================================================================================
+!! SUBROUTINE   : i21setvar_p
+!!
+!>\BRIEF	  Subroutine for initialieing an 2D integer variable with a 1D array integer.
+!!
+!! DESCRIPTION  : Subroutine for initialieing an 2D integer variable with a 1D array integer.
+!!                This subroutine must be called by all processes.
+!!                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
+!! \n
+!_ =============================================================================================================================
+
+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
+
+
+!! =============================================================================================================================
+!! SUBROUTINE   : r0setvar_p
+!!
+!>\BRIEF	  Subroutine for initializing a real scalar variable.
+!!
+!! DESCRIPTION  : Subroutine for initializing a real scalar variable with a real scalar variable. 
+!!                This subroutine must be called by all processes.
+!! \n
+!_ =============================================================================================================================
+
+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
+
+
+!! =============================================================================================================================
+!! SUBROUTINE   : r10setvar_p
+!!
+!>\BRIEF	  Subroutine for initializing an real 1D array with a real scalar variable.
+!!
+!! DESCRIPTION  : Subroutine for initializing an real 1D array with a real scalar variable.
+!!                This subroutine must be called by all processes.
+!! \n
+!_ =============================================================================================================================
+
+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
+
+
+!! =============================================================================================================================
+!! SUBROUTINE   : r11setvar_p
+!!
+!>\BRIEF	  Subroutine for initializing an real 1D array with another real 1D array.
+!!
+!! DESCRIPTION  : Subroutine for initializing an real 1D array with another real 1D array.
+!!                This subroutine must be called by all processes.
+!! \n
+!_ =============================================================================================================================
+
+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
+
+
+!! =============================================================================================================================
+!! SUBROUTINE   : r20setvar_p
+!!
+!>\BRIEF	  Subroutine for initializing an real 2D variable with a scalar real variable.
+!!
+!! DESCRIPTION  : Subroutine for initializing an real 2D variable with a scalar real variable.
+!!                This subroutine must be called by all processes.
+!! \n
+!_ =============================================================================================================================
+
+SUBROUTINE r20setvar_p (var, val_exp, key_wd, val_put)
+  
+  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
+
+!! =============================================================================================================================
+!! SUBROUTINE   : r21setvar_p
+!!
+!>\BRIEF	  Subroutine for initialieing an 2D real variable with a 1D array real.
+!!
+!! DESCRIPTION  : Subroutine for initialieing an 2D real variable with a 1D array real.
+!!                This subroutine must be called by all processes.
+!!                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
+!! \n
+!_ =============================================================================================================================
+
+SUBROUTINE r21setvar_p (var, val_exp, key_wd, val_put, is_grid)
+  
+  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
+
+
+!! =============================================================================================================================
+!! SUBROUTINE   : r22setvar_p
+!!
+!>\BRIEF	  Subroutine for initializing a 2D real variable with a real with the same size. 
+!!
+!! DESCRIPTION  : Subroutine for initializing a 2D real variable with a real with the same size or by reading an scalar value
+!!                from run.def if key_wd is different from "NO_KEYWORD" or "NOKEYWORD". 
+!!                It is not possible to read a 2D variable from run.def.
+!!                This subroutine must be called by all processes.
+!! \n
+!_ =============================================================================================================================
+
+SUBROUTINE r22setvar_p (var, val_exp, key_wd, val_put)
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                 :: key_wd              !! The Key word we will look for
+  REAL(r_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
+  REAL(r_std)                                  :: val_scal            !! Temporary variable to read a scalar value from run.def
+  INTEGER(i_std)                               :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar_p) WRITE (numout,*) "r22setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
+
+  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
+  val_tmp(:,:) = val_put(:,:)
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+        ! This case only read a scalar value with getin
+        val_scal=val_exp
+        CALL getin_p(key_wd, val_scal)
+        ! If a value was found in run.def, then set val_tmp to this value.
+        IF (val_scal/=val_exp) val_tmp(:,:)=val_scal 
+     ENDIF
+     var(:,:) = val_tmp(:,:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r22setvar_p
+
+!! =============================================================================================================================
+!! SUBROUTINE   : r30setvar_p
+!!
+!>\BRIEF	  Subroutine for initializing an real 3D variable with a scalar real variable.
+!!
+!! DESCRIPTION  : Subroutine for initializing an real 3D variable with a scalar real variable.
+!!                This subroutine must be called by all processes.
+!! \n
+!_ =============================================================================================================================
+
+SUBROUTINE r30setvar_p (var, val_exp, key_wd, val_put)
+
+  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
+
+
+!! =============================================================================================================================
+!! SUBROUTINE   : r40setvar_p
+!!
+!>\BRIEF	  Subroutine for initializing an real 4D variable with a scalar real variable.
+!!
+!! DESCRIPTION  : Subroutine for initializing an real 4D variable with a scalar real variable.
+!!                This subroutine must be called by all processes.
+!! \n
+!_ =============================================================================================================================
+
+SUBROUTINE r40setvar_p (var, val_exp, key_wd, val_put)
+
+  REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout) :: var                !! 4D 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,*) 'r40setvar',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 r40setvar_p
+
+!! =============================================================================================================================
+!! SUBROUTINE   : r50setvar_p
+!!
+!>\BRIEF	  Subroutine for initializing an real 5D variable with a scalar real variable.
+!!
+!! DESCRIPTION  : Subroutine for initializing an real 5D variable with a scalar real variable.
+!!                This subroutine must be called by all processes.
+!! \n
+!_ =============================================================================================================================
+
+SUBROUTINE r50setvar_p (var, val_exp, key_wd, val_put)
+
+  REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: var              !! 5D 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,*) 'r50setvar',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 r50setvar_p
+
+END MODULE sechiba_io_p
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/slowproc.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/slowproc.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/slowproc.f90	(revision 6412)
@@ -0,0 +1,5012 @@
+! =================================================================================================================================
+! MODULE       : slowproc
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Groups the subroutines that: (1) initialize all variables used in 
+!! slowproc_main, (2) prepare the restart file for the next simulation, (3) Update the 
+!! vegetation cover if needed, and (4) handle all slow processes if the carbon
+!! cycle is activated (call STOMATE) or update the vegetation properties (LAI and 
+!! fractional cover) in the case of a run with only SECHIBA.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): Allowed reading of USDA map, Nov 2014, ADucharne
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE slowproc
+
+  USE defprec
+  USE constantes 
+  USE constantes_soil
+  USE pft_parameters
+  USE structures
+  USE ioipsl
+  USE xios_orchidee
+  USE ioipsl_para
+  USE sechiba_io_p
+  USE interpol_help
+  USE stomate
+  USE stomate_data
+  USE grid
+  USE mod_orchidee_para
+  USE stomate_laieff,    ONLY: effective_lai,find_lai_per_level, &
+                               calculate_z_level_photo,fitting_laieff 
+  USE function_library,  ONLY: wood_to_qmheight, cc_to_lai
+
+  IMPLICIT NONE
+
+  ! Private & public routines
+
+  PRIVATE
+  PUBLIC slowproc_main, slowproc_clear, slowproc_initialize, slowproc_finalize, slowproc_change_frac
+
+  !
+  ! variables used inside slowproc module : declaration and initialisation
+  !
+  REAL(r_std), SAVE                                  :: slope_default = 0.1
+!$OMP THREADPRIVATE(slope_default)
+  INTEGER(i_std) , SAVE                              :: veget_update        !! update frequency in years for landuse (nb of years)
+!$OMP THREADPRIVATE(veget_update)
+  INTEGER(i_std) , SAVE                              :: Ninput_update       !! update frequency in years for N inputs (nb of years)
+!$OMP THREADPRIVATE(Ninput_update)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: clayfraction        !! Clayfraction (0-1, unitless)
+!$OMP THREADPRIVATE(clayfraction)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: sandfraction        !!Sandfraction (0-1, unitless)
+!$OMP THREADPRIVATE(sansfraction)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: siltfraction        !! Siltfraction (0-1, unitless)
+!$OMP THREADPRIVATE(siltfraction)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: bulk                !! Bulk density (kg/m**3)
+!$OMP THREADPRIVATE(bulk)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: soil_ph             !! Soil pH (-)
+!$OMP THREADPRIVATE(soil_ph)  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:):: N_input             !! nitrogen inputs (gN/m2/day) per points and per type of N (Nox,NHx,Fert,BNF) - Monthly values (array of 12 elements)
+!$OMP THREADPRIVATE(N_input)  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:,:,:) :: cc_biomass_m   !! Monthly cc_biomass to prescribe the canopy structure if not calculated by STOMATE
+!$OMP THREADPRIVATE(cc_biomass_m)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:):: cc_n_m              !! Monthly cc_n to prescribe the canopy structure if not calculated by STOMATE
+!$OMP THREADPRIVATE(cc_n_m)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: soilclass_default
+!$OMP THREADPRIVATE(soilclass_default)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: veget_max_new       !! New year fraction of vegetation type (0-1, unitless)
+!$OMP THREADPRIVATE(veget_max_new)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: frac_nobio_new      !! New year fraction of ice+lakes+cities+... (0-1, unitless)
+!$OMP THREADPRIVATE(frac_nobio_new)
+  INTEGER(i_std) , SAVE                              :: veget_year          !! year for vegetation update
+!$OMP THREADPRIVATE(veget_year)
+  INTEGER(i_std) , SAVE                              :: ninput_year         !! year for N inputs update
+!$OMP THREADPRIVATE(ninput_year)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_bare_soil       !! total evaporating bare soil fraction 
+!$OMP THREADPRIVATE(tot_bare_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: frac_bare           !! Fraction (of veget_max) of bare soil in each vegetation type           
+!$OMP THREADPRIVATE(frac_bare)
+
+   PUBLIC tot_bare_soil
+   PUBLIC frac_bare
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: slowproc_initialize
+!!
+!>\BRIEF         Initialize slowproc module and call initialization of stomate module
+!!
+!! DESCRIPTION : Allocate module variables, read from restart file or initialize with default values
+!!               Call initialization of stomate module.
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_initialize (kjit,          kjpij,        kjpindex,                          &
+                                  rest_id,       rest_id_stom, hist_id_stom,   hist_id_stom_IPCC, &
+                                  IndexLand,     indexveg,     lalo,           neighbours,        &
+                                  resolution,    contfrac,     t2m,                               &
+                                  soiltile,      reinf_slope,  deadleaf_cover, assim_param,       &
+                                  frac_age,      height,       veget,             &
+                                  frac_nobio,    njsc,         veget_max,      tot_bare_soil,     &
+                                  totfrac_nobio, qsintmax,     co2_flux,       fco2_lu,           &
+                                  temp_growth,   circ_class_biomass,   &
+                                  circ_class_n,  lai_per_level,laieff_fit,     h_array_out,       &
+                                  z_array_out,   max_height_store)
+
+!! 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
+    INTEGER(i_std),INTENT (in)                          :: rest_id             !! Restart file identifier
+    INTEGER(i_std),INTENT (in)                          :: rest_id_stom        !! STOMATE's _Restart_ file identifier
+    INTEGER(i_std),INTENT (in)                          :: hist_id_stom        !! STOMATE's _history_ file identifier
+    INTEGER(i_std),INTENT(in)                           :: hist_id_stom_IPCC   !! STOMATE's IPCC _history_ file identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: IndexLand           !! Indices of the points on the land map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in):: indexveg            !! Indices of the points on the vegetation (3D map ???) 
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)     :: lalo                !! Geogr. coordinates (latitude,longitude) (degrees)
+    INTEGER(i_std), DIMENSION (kjpindex,NbNeighb), INTENT(in):: neighbours     !! neighbouring grid points if land.
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)     :: resolution          !! size in x an y of the grid (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: contfrac            !! Fraction of continent in the grid (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: t2m                 !! 2 m air temperature (K)
+    
+!! 0.2 Output variables 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)     :: co2_flux       !! CO2 flux per average ground area (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: fco2_lu        !! CO2 flux from land-use (without forest management) 
+                                                                             !! (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: temp_growth    !! Growth temperature (°C) - Is equal to t2m_month 
+    INTEGER(i_std), DIMENSION(kjpindex), INTENT(out)       :: njsc           !! Index of the dominant soil textural class in the grid 
+                                                                             !! cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: height         !! height of vegetation (m)
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT(out):: frac_age   !! Age efficacity from STOMATE for isoprene
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: veget          !! Fraction of vegetation type in the mesh (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out)  :: frac_nobio     !! Fraction of ice, lakes, cities etc. in the mesh (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: veget_max      !! Maximum fraction of vegetation type in the mesh (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: totfrac_nobio  !! Total fraction of ice+lakes+cities etc. in the mesh (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)    :: soiltile       !! Fraction of each soil tile with vegtot (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: reinf_slope    !! slope coef for reinfiltration
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2),INTENT (out):: assim_param    !! min+max+opt temperatures & vmax for photosynthesis 
+                                                                             !! (K, \mumol m^{-2} s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: deadleaf_cover !! Fraction of soil covered by dead leaves (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: qsintmax       !! Maximum water storage on vegetation from interception (mm) 
+
+!! 0.3 Modified variables
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)       :: circ_class_biomass  !!  Biomass components of the model tree  
+                                                                              !! within a circumference class
+                                                                              !! class @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)           :: circ_class_n    !! Number of trees within each circumference
+                                                                              !! class @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)           :: lai_per_level   !! This is the LAI per vertical level
+                                                                              !! @tex $(m^{2} m^{-2})$
+    TYPE(laieff_type),DIMENSION (:,:,:), INTENT(inout)     :: laieff_fit      !! Fitted parameters for the effective LAI
+    REAL(r_std),DIMENSION(:,:,:,:), INTENT(inout)          :: h_array_out     !! An output of h_array, to use in sechiba                                         
+    REAL(r_std),DIMENSION(:,:,:,:), INTENT(inout)          :: z_array_out     !! An output of h_array, to use in sechiba
+    REAL(r_std),DIMENSION(:,:), INTENT(inout)              :: max_height_store!! ???
+    REAL(r_std),DIMENSION (:), INTENT (inout)              :: tot_bare_soil   !! Total evaporating bare soil fraction in the mesh (unitless)
+
+!! 0.4 Local variables
+    INTEGER(i_std)                                         :: j, jv, ji       !! indices 
+    REAL(r_std),DIMENSION(kjpindex,nvm)                    :: resp_maint      !! Maitanance component of autotrophic respiration in 
+                                                                              !! (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION(kjpindex,nvm)                    :: resp_hetero     !! heterotrophic resp. (gC/(m**2 of total ground)/time step)
+    REAL(r_std),DIMENSION(kjpindex,nvm)                    :: resp_growth     !! Growth component of autotrophic respiration in 
+                                                                              !! gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION(kjpindex,nvm)                    :: npp             !! Net Ecosystem Exchange (gC/(m**2 of total ground)/time step)
+    REAL(r_std),DIMENSION(kjpindex,nvm)                    :: lai             !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex)                       :: totfrac_nobio_new !! Total fraction for the next year
+    LOGICAL                                                :: FirstTsYear     !! Flag set to true for the first sechiba time step on the year.
+    LOGICAL                                                :: LastTsDay       !! Flag set to true for the last sechiba time step of the day.
+    REAL(r_std)                                            :: tmp_day(1)      !! temporary variable for I/O
+    CHARACTER(LEN=80)                                      :: var_name        !! To store variables names for I/O
+
+!_ ================================================================================================================================
+
+    !! Initialize local printlev
+    !printlev_loc=get_printlev('slowproc')
+    IF(printlev>=5) WRITE(numout,*) 'Entering slowproc_initialize'
+
+    !! 1. Perform the allocation of all variables, define some files and some flags.
+    !  Restart file read for Sechiba.
+    CALL slowproc_init (kjit, kjpindex, IndexLand, &
+         lalo, neighbours, resolution, contfrac, &
+         rest_id, frac_age, veget, frac_nobio, &
+         reinf_slope, veget_max, njsc, veget_update, &
+         veget_year, ninput_update, ninput_year, &
+         circ_class_biomass, circ_class_n, assim_param)
+
+    !! 2. Define time step in days for stomate
+    dt_days = dt_stomate / one_day
+    
+    !! 3. check time step coherence between slow processes and fast processes
+    IF ( dt_stomate .LT. dt_sechiba ) THEN
+       WRITE(numout,*) 'slow_processes: time step smaller than forcing time step.'
+       CALL ipslerr_p(3,'slowproc_initialize',&
+            'Coherence problem between dt_stomate and dt_sechiba',&
+            'Time step smaller than forcing time step','')
+    ENDIF
+    
+    !! 4. Call stomate to initialize all variables managed in stomate.
+    IF ( ok_stomate ) THEN
+
+       IF(printlev>=5) WRITE(numout,*) 'Entering stomate_initialize in slowproc'
+
+       !  Note that some of the variables are stored in both sechiba and
+       !  stomate. The values of these variables should be identical in 
+       !  the stomate and sechiba restart. Anyway, the values found in
+       !  sechiba will be overwritten by those found in stomate.
+       CALL stomate_initialize (kjit,         kjpij,             kjpindex,     &
+            rest_id_stom,   hist_id_stom,     hist_id_stom_IPCC,               &
+            indexLand,      lalo,             neighbours,        resolution,   &
+            contfrac,       totfrac_nobio,    clayfraction,      siltfraction, &
+            bulk,           t2m,              veget,             veget_max,    & 
+            co2_flux,       fco2_lu,          deadleaf_cover,    assim_param,  &
+            circ_class_biomass, circ_class_n, lai_per_level,     laieff_fit)
+
+    ELSE
+    
+       ! The model is not using stomate but it needs to calculate a 
+       ! vegetation structure anyway to calculate photosynthesis,
+       ! albedo, and the energy budget
+       CALL slowproc_canopy (kjpindex, circ_class_biomass, circ_class_n, &
+            veget_max, lai_per_level, h_array_out, z_array_out, &
+            max_height_store, laieff_fit, frac_age)
+
+    ENDIF
+
+    !! 5. Vegetation structure can be read from sechiba and stomate
+    !  All key variable should be initialized, read from a restart or imposed
+    !  by the time this part of the code is reached. These variables now have
+    !  to be used to calculate some derived variables that are required by
+    !  sechiba. For example, circ_class_biomass and circ_class_n are used to
+    !  calculate lai_effit which is required to calculate the albedo but is not
+    !  stored in the sechiba restart file. veget_max may come from a map which 
+    ! implies that there might be small imprecisions. The following routine 
+    ! deals with those imprecisions as well. This routine also calculates veget.
+    !     Update veget, since the biomass has possibly been 
+    !     read in from a restart file, taken from a map or prescribed
+    !     by an imposed value.
+    CALL slowproc_veget (kjpindex, lai_per_level, circ_class_biomass, &
+         circ_class_n, frac_nobio, totfrac_nobio, &
+         veget_max, veget, soiltile, tot_bare_soil)
+
+    !! 6. Calculate height and lai from biomass
+    height(:,ibare_sechiba) = zero
+    lai(:,ibare_sechiba) = zero  
+    DO jv = 2,nvm
+       DO ji = 1,kjpindex
+
+          ! Skip if veget_max = 0, else calculate height and lai
+          IF (veget_max(ji,jv) .EQ. zero) CYCLE
+          height(ji,jv) = wood_to_qmheight(circ_class_biomass(ji,jv,:,:,icarbon), &
+               circ_class_n(ji,jv,:), jv)
+          lai(ji,jv) = cc_to_lai(circ_class_biomass(ji,jv,:,ileaf,icarbon), &
+               circ_class_n(ji,jv,:),jv)
+
+       ENDDO
+    ENDDO
+
+    !! 3. Initialize the maximum water on vegetation for interception
+    qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:) 
+    qsintmax(:,1) = zero
+
+    !! 5. Specific run without the carbon cycle (STOMATE not called): 
+    !!     Need to initialize some variables that will be used in SECHIBA
+    IF (.NOT. ok_stomate ) THEN
+
+       ! Initialize some missing variables
+       deadleaf_cover(:) = zero
+       temp_growth(:)=25.
+
+    ENDIF
+    
+    IF(printlev>=5) WRITE(numout,*) 'Leaving slowproc_initialize'
+
+  END SUBROUTINE slowproc_initialize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_main
+!!
+!>\BRIEF         Main routine that manage variable initialisation (slowproc_init), 
+!! prepare the restart file with the slowproc variables, update the time variables 
+!! for slow processes, and possibly update the vegetation cover, before calling 
+!! STOMATE in the case of the carbon cycle activated or just update the canopy (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, ::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, &
+       IndexLand, indexveg, lalo, neighbours, &
+       resolution, contfrac, soiltile,  &
+       temp_air, temp_sol, stempdiag, humrel, &
+       shumdiag, litterhumdiag, precip_rain, precip_snow, &
+       pb, gpp, tmc_pft, drainage_pft, swc_pft, &
+       deadleaf_cover, assim_param, frac_age, &
+       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, temp_growth, &
+       tot_bare_soil, circ_class_biomass, circ_class_n, &
+       lai_per_level, max_height_store, laieff_fit, &
+       h_array_out, z_array_out, transpir, transpir_mod, &
+       transpir_supply, vir_transpir_supply, coszang, &
+       stressed, unstressed, Isotrop_Tran_Tot_p, &
+       u, v)
+
+!! 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
+    
+    INTEGER(i_std),INTENT (in)                                    :: rest_id,hist_id    !! _Restart_ file and _history_ file identifier
+    INTEGER(i_std),INTENT (in)                                    :: hist2_id           !! _history_ file 2 identifier
+    INTEGER(i_std),INTENT (in)                                    :: rest_id_stom       !! STOMATE's _Restart_ file identifier
+    INTEGER(i_std),INTENT (in)                                    :: hist_id_stom       !! STOMATE's _history_ file identifier
+    INTEGER(i_std),INTENT(in)                                     :: hist_id_stom_IPCC  !! STOMATE's IPCC _history_ file identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)              :: IndexLand          !! Indices of the points on the land map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in)          :: indexveg           !! Indices of the points on the vegetation (3D map ???) 
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)               :: lalo               !! Geogr. coordinates (latitude,longitude) (degrees)
+    INTEGER(i_std), DIMENSION (kjpindex,NbNeighb), INTENT(in)     :: neighbours         !! neighbouring 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,nvm), INTENT (in)   :: transpir            !! transpiration @tex $(kg m^{-2} days^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm)                :: transpir_mod        !! transpir converted from mm/day to mm dt^(-1)
+    REAL(r_std), DIMENSION(kjpindex,nvm),INTENT (in)    :: transpir_supply     !! Supply of water for transpiration @tex $(mm dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm),INTENT (in)    :: vir_transpir_supply !! Virtual supply of water for transpiration to deal
+                                                                               !! with water stress when PFT1 becomes vegetated in LCC
+                                                                               !! @tex $(mm dt^{-1})$ @endtex
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: u                   !! Lowest level wind speed in direction u (m/s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: v                   !! Lowest level wind speed in direction v (m/s)
+
+
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)                    :: temp_air           !! Temperatur of first model layer (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_stomate^{-1})
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)                    :: precip_snow        !! Snow precipitation (mm dt_stomate^{-1})
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)                    :: pb                 !! Lowest level pressure (Pa) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)                :: gpp                !! GPP of total ground area (gC m^{-2} time step^{-1}). 
+                                                                                        !! Calculated in sechiba, account for vegetation cover and 
+                                                                                        !! effective time step to obtain gpp_d     
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)                :: tmc_pft            !! Total soil water per PFT (mm/m2) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)                :: drainage_pft       !! Drainage per PFT (mm/m2)   
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)                :: swc_pft            !! Relative Soil water content [tmcr:tmcs] per pft (-)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)                    :: coszang            !! the cosine of the solar zenith angle (unitless)  
+    REAL(r_std),DIMENSION(:,:,:),INTENT(in)                       :: Isotrop_Tran_Tot_p !! Transmitted radiation per level (unitless)    
+
+!! 0.2 Output variables 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)               :: co2_flux           !! CO2 flux per average ground area (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)                   :: fco2_lu            !! CO2 flux from land-use (without forest management) (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)                   :: temp_growth        !! Growth temperature (°C) - Is equal to t2m_month 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)               :: max_height_store   !! ???
+ 
+!! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)          :: height             !! height of vegetation (m)
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT(inout) :: frac_age           !! Age efficacity from STOMATE for isoprene
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)          :: veget              !! Fraction of vegetation in the mesh (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout)       :: frac_nobio         !! Fraction of ice, lakes, cities etc. in the mesh (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)          :: veget_max          !! Maximum fraction of vegetation type in the mesh (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)              :: totfrac_nobio      !! Total fraction of ice+lakes+cities etc. in the mesh (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(inout)         :: soiltile           !! Fraction of each soil tile within vegtot (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2),INTENT (inout)     :: assim_param        !! vcmax, nue and leaf N for photosynthesis 
+    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)
+    REAL(r_std),DIMENSION(kjpindex,nvm,ncirc,nparts,nelements), &
+                                               INTENT(inout)      :: circ_class_biomass !!  Biomass components of the model tree  
+                                                                                        !! within a circumference class
+                                                                                        !! class @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm,ncirc), INTENT(inout)      :: circ_class_n       !! Number of trees within each circumference
+                                                                                        !! class @tex $(m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(:,:,:), INTENT(inout)                   :: lai_per_level      !! This is the LAI per vertical level
+                                                                                        !! @tex $(m^{2} m^{-2})$
+    TYPE(laieff_type),DIMENSION (:,:,:), INTENT(inout)            :: laieff_fit         !! Fitted parameters for the effective LAI
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout)           :: stressed      !! adjusted ecosystem functioning. Takes the unit of the variable
+                                                                                   !! used as a proxy for waterstress (assigned in sechiba)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout)           :: unstressed    !! initial ecosystem functioning after the first calculation and 
+                                                                                   !! before any recalculations. Takes the unit of the variable used
+                                                                                   !! as a proxy for unstressed.
+
+
+
+    REAL(r_std),DIMENSION(:,:,:,:), INTENT(inout)                 :: h_array_out        !! An output of h_array, to use in sechiba
+                                                                           
+    REAL(r_std),DIMENSION(:,:,:,:), INTENT(inout)                 :: z_array_out        !! An output of h_array, to use in sechiba
+    REAL(r_std),DIMENSION (:), INTENT(inout)                      :: tot_bare_soil      !! total evaporating bare soil fraction 
+
+
+!! 0.4 Local variables
+    INTEGER(i_std)                                     :: j, jv, ji,jj,ipts,ivm,jvm  !! indices 
+    REAL(r_std), DIMENSION(kjpindex,nvm)               :: resp_maint           !! Maitanance component of autotrophic respiration in (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm)               :: resp_hetero          !! heterotrophic resp. (gC/(m**2 of total ground)/time step)
+    REAL(r_std), DIMENSION(kjpindex,nvm)               :: resp_growth          !! Growth component of autotrophic respiration in gC m^{-2} dt_stomate^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm)               :: npp                  !! Net Ecosystem Exchange (gC/(m**2 of total ground)/time step)
+    REAL(r_std),DIMENSION (kjpindex,nvm)               :: lai                  !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex)                   :: totfrac_nobio_new    !! Total fraction for the next year 
+    LOGICAL                                            :: FirstTsYear          !! Flag set to true for the first sechiba time step on the year.
+    LOGICAL                                            :: LastTsDay            !! Flag set to true for the last sechiba time step of the day. 
+    CHARACTER(LEN=80)                                  :: fieldname            !! name of the field read in the N input map
+    REAL(r_std), DIMENSION(kjpindex,nvm)               :: veget_max_temp
+    REAL(r_std), DIMENSION(kjpindex,nvm)               :: veget_ny_map
+    INTEGER(i_std)                                     :: nfound               !! The number of PFTs for this pixel which have veget_max
+    LOGICAL(r_std),DIMENSION (nvm)                     :: lfound_veget         !! Do we have a given threshold of veget_max on for this pixel?
+    REAL(r_std)                                        :: excess_veg           !! The veget_max which we have to redistribute t0 other pixels.
+    REAL(r_std)                                        :: nobio_frac_sum_old   !! Total vegetated land for the current year.
+    REAL(r_std)                                        :: nobio_frac_sum_new   !! Total vegetated land for next year.
+    REAL(r_std)                                        :: nobio_diff           !! How much the nonvegetative land coverage changes between the current and next year.i
+    REAL(r_std)                                        :: nobio_scale          !! This scaling factor is trying to redistribute the nobio_diff to new one
+    REAL(r_std), DIMENSION(kjpindex,nvm,12)            :: N_input_temp
+
+
+!_ ================================================================================================================================
+
+    !! 1. Compute and update all variables linked to the date and time
+    IF (printlev_loc>=5)WRITE(numout,*) 'Entering slowproc_main, month, day, sec=',month,day,sec
+
+
+    IF ( sec == dt_sechiba .AND. month==1 .AND. day==1 ) THEN
+
+       ! The current time step is the first sechiba timestep of a new year
+       IF (printlev_loc>=4) WRITE(numout,*) &
+            "This is a new day and a new year: month, day, sec=", month, day, sec
+       FirstTsYear=.TRUE.
+
+    ELSE
+
+       FirstTsYear=.FALSE.
+
+    END IF
+
+    IF ( sec == 0 ) THEN
+
+       ! The current time step is the last sechiba time step on a day
+       LastTsDay=.TRUE.
+
+       IF ( month == 1 .AND. day == 1 ) THEN
+
+          ! The current time step is the last sechiba time step on a year
+          ! Note that month=1, day=1, sec=O is the last day of the year. 
+          ! This is due to a problem before the first call to slowproc. 
+          ! slowproc_main enters the first time on the 2nd time step (1800s)
+          EndOfYear = .TRUE.
+          IF (printlev_loc>=4) WRITE(numout,*) &
+               'This is the last sechiba time step of a year, '//&
+               'EndOfYear is activated'
+       ELSE
+
+          EndOfYear = .FALSE.
+
+       END IF
+
+    ELSE
+
+       LastTsDay = .FALSE.
+       EndOfYear = .FALSE.
+
+    END IF
+
+    !! 2. Activate slow processes if it is the end of the day
+    IF ( LastTsDay ) THEN
+
+       ! 3.2.2 Activate slow processes in the end of the day
+       do_slow = .TRUE.
+
+       ! 3.2.3 Count the number of days 
+       date = date + nint(dt_days)
+       IF (printlev_loc>=4) WRITE(numout,*) "New date : ", &
+            date, 'year_length ',year_length,kjit
+    ELSE
+
+       do_slow = .FALSE.
+
+    ENDIF
+
+    !! 3. Update the vegetation if it is time to do so.
+    !     This is done at the first sechiba time step on a new year
+    !     and only every "veget_update" years. 
+    !     veget_update correspond to a number of years between each
+    !     vegetation updates. Nothing is done if veget_update=0.
+    !     Update will never be done if impveg=true because veget_update=0.
+    IF ( (veget_update > 0) .AND. FirstTsYear) THEN
+       veget_year = veget_year + 1
+
+
+       WRITE(numout,*) 'We are updating veget_year =' , veget_year
+
+       ! 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
+
+          !#482
+!!$          IF (printlev_loc>=3) 
+          WRITE(numout,*) &
+               'We are updating the vegetation map for year =' , veget_year
+!!$          WRITE(numout,*) 'before reading the map, veget_max',veget_max
+!!$          WRITE(numout,*) 'veget_max_new', veget_max_new
+!!$          WRITE(numout,*) 'frac_nobio_new',frac_nobio_new
+ 
+          ! Read the new the vegetation from file. Output is
+          ! veget_max_new and frac_nobio_new.
+          CALL slowproc_readvegetmax(kjpindex, lalo, neighbours, resolution,&
+               contfrac, veget_max, veget_max_new, frac_nobio_new, &
+               veget_year, .FALSE.)
+
+          !#481
+!!$          !+++HACK+++
+!!$          veget_max_new = zero
+!!$          veget_max_new(:,1) = 2*veget_max(:,1)
+!!$          veget_max_new(:,2) = SUM(veget_max(:,:),2)-(2*veget_max(:,1))
+!!$          frac_nobio_new(:,1) = 1 - SUM(veget_max(:,:),2)
+!!$          !++++++++++
+
+          !#481
+!!$          WRITE(numout,*) 'after reading the map, veget_max',veget_max
+!!$          WRITE(numout,*) 'veget_max_new', veget_max_new
+!!$          WRITE(numout,*) 'frac_nobio_new',frac_nobio_new
+
+
+          DO ipts=1,kjpindex
+             lfound_veget(:)=.FALSE.
+             nfound=0
+             excess_veg=zero
+
+             ! The total sum of vegetation should never be greater than 1.0,
+             ! since otherwise
+             ! there will be a negative nobio fraction.  So check for that
+             ! now, at the 
+             ! beginning, before doing all the other adjustments.  If there
+             ! is a problem,
+             ! scale all the values by a factor to set it exactly equal to
+             ! one.
+             nobio_frac_sum_new=SUM(veget_max_new(ipts,:))
+             IF(nobio_frac_sum_new .GT. un)THEN
+                WRITE(numout,*) "WARNING: Scaling vegetation fractions location 1"
+                WRITE(numout,*) "ipts,nobio_frac_sum_new: ",&
+                     ipts,nobio_frac_sum_new
+                CALL ipslerr_p (2,'slowproc_main', 'The nobio fraction of &
+                     this square on the new map','is negative.  Scaling all &
+                     vegetation fractions to compensate.  Look for','"WARNING:&
+                     Scaling vegetation fractions location 1" for more details.')
+
+                veget_max_new(ipts,:)=veget_max_new(ipts,:)/nobio_frac_sum_new
+
+             ENDIF
+
+             ! We also want to check to see if the nonbio fraction changes at
+             ! all.  If it does,
+             ! this needs to be handled different in sapiens_lcchange.  Right
+             ! now our maps
+             ! might vary by a very small number, close to min_stomate.  If
+             ! that is the 
+             ! case, we scale the fraction of all vegetation fraction so that
+             ! the nobio fraction
+             ! is the same size as the previous year.  If the difference in
+             ! the nobio fraction
+             ! is greater than min_vegfrac, then we have a problem, and
+             ! someone needs to change
+             ! the maps or fix sapiens_lcchange.
+             nobio_frac_sum_old=SUM(veget_max(ipts,:))
+             nobio_frac_sum_new=SUM(veget_max_new(ipts,:))
+             nobio_diff=(un-nobio_frac_sum_new)-(un-nobio_frac_sum_old)
+
+             ! Is this a real difference, or just something numerical?
+             IF(ABS(nobio_diff) .GT. min_vegfrac)THEN
+                WRITE(numout,*) 'ipts: ',ipts
+                WRITE(numout,*) 'ivm  veget_max  veget_max_new'
+                DO ivm=1,nvm
+                   WRITE(numout,*) ivm,veget_max(ipts,ivm),veget_max_new(ipts,ivm)
+                ENDDO
+                WRITE(numout,*) 'SUM(veget_max): ',nobio_frac_sum_old
+                WRITE(numout,*) 'SUM(veget_max_new): ',nobio_frac_sum_new
+                CALL ipslerr_p (3,'slowproc_main', 'The nobio frac for the new map &
+                     is significantly different','than that of the old map.  We do not &
+                     know how to handle this.', 'Please change your maps or fix &
+                     sapiens_lcchange.f90.')
+             ELSE
+
+                IF(nobio_diff .GT. zero)THEN
+                   ! Our nobio fraction increases slightly.  We add this
+                   ! difference to excess_veg, which will be distributed
+                   ! over the PFTs.
+                   excess_veg=excess_veg+nobio_diff
+
+                ELSE
+                   ! Our nobio fraction decreases slightly.  We therefore
+                   ! remove this fraction from excess_veg.  We need to check
+                   ! later to make sure that excess_veg is still positive.
+                   excess_veg=excess_veg-ABS(nobio_diff)
+
+                ENDIF
+             ENDIF
+
+             ! Even if the extra fraction is less than
+             ! min_stomate, we'll redistribute it, just
+             ! to be sure since a difference an order
+             ! of magnitude less than min_stomate could cause
+             ! a mass balance error later.
+             DO ivm=1,nvm
+                IF(veget_max_new(ipts,ivm) .GT. min_vegfrac)THEN
+                   lfound_veget(ivm)=.TRUE.
+                   nfound=nfound+1
+                ELSE
+                   excess_veg=excess_veg+veget_max_new(ipts,ivm)
+                   veget_max_new(ipts,ivm)=zero
+                ENDIF
+             ENDDO
+
+             ! If this threshold is zero, there are numbers like 1e-17 which
+             ! trigger it.  If I used min_stomate, we can get small mass
+             ! balance errors in land cover change.
+             IF(ABS(excess_veg) .GT. min_stomate*0.01)THEN
+                IF(nfound .LE. 0)THEN
+                   WRITE(numout,*) 'ipts, ivm: ',ipts,ivm
+                   WRITE(numout,*) 'nfound, excess_veg: ',nfound, excess_veg, min_stomate*0.01
+                   DO ivm=1,nvm
+                      WRITE(numout,*) 'veget_max_new: ',ivm,veget_max_new(ipts,ivm)
+                   ENDDO
+                   CALL ipslerr_p (2,'slowproc_main', 'When reading in the &
+                        new PFT maps, we found','a pixel with extra vegetation but',&
+                        'with no PFTs left which to add it to!')
+                   veget_max_new(ipts,1)=veget_max_new(ipts,1)+excess_veg
+                   excess_veg=zero
+                ENDIF
+
+                ! We have vegetation to distribute.
+                excess_veg=excess_veg/REAL(nfound)
+                loop1:DO ivm=1,nvm
+                   IF(lfound_veget(ivm))THEN
+                      IF((veget_max_new(ipts,ivm)+excess_veg) .GT. min_vegfrac .AND.&
+                           (veget_max_new(ipts,ivm)+excess_veg) .GT. min_stomate)THEN
+                         veget_max_new(ipts,ivm)=veget_max_new(ipts,ivm)+excess_veg
+                         excess_veg=zero
+                         EXIT loop1
+                      ENDIF
+                   ENDIF
+                ENDDO loop1
+
+                ! If this threshold is zero, there are numbers like 1e-17
+                ! which trigger it.  If I used min_stomate, we can get small mass
+                ! balance errors in land cover change.
+                IF(ABS(excess_veg) .GT. min_stomate*0.01)THEN
+                   WRITE(numout,*) 'ipts, ivm: ',ipts,ivm
+                   WRITE(numout,*) 'excess_veg: ',excess_veg
+                   DO jvm=1,nvm
+                      WRITE(numout,*) 'veget_max_new: ',jvm,veget_max_new(ipts,jvm)
+                   ENDDO
+                   CALL ipslerr_p (3,'slowproc_main', 'When reading in the &
+                        new PFT maps, we could',&
+                        'not find a place to dump the extra vegetation!','')
+                ENDIF
+
+                ! excess_veg might be negative.  This removes a small
+                ! fraction from every PFT.  We need to check that we did not
+                ! make any PFT less than min_vegfrac by doing this.
+                DO ivm=1,nvm
+                   IF(lfound_veget(ivm))THEN
+                      IF(veget_max_new(ipts,ivm) .LT. min_vegfrac)THEN
+                         WRITE(numout,*) 'ipts, ivm: ',ipts,ivm
+                         DO jvm=1,nvm
+                            WRITE(numout,*) 'veget_max_new:',jvm,veget_max_new(ipts,jvm)
+                         ENDDO
+                         CALL ipslerr_p (3,'slowproc_main', 'When reading in the new &
+                              PFT maps, we corrected','vegetation fractions but our &
+                              corrections reduced one PFT to below','the detectable limit!')
+                      ENDIF
+                   ENDIF
+                ENDDO
+             ENDIF
+             ! Update vegetation and fraction and save old values
+             !DO ivm=1,nvm
+             !veget_max(ipts,ivm) = veget_max_new(ipts,ivm)
+             !WRITE(numout,*) 'Pixel:',ipts,ivm,'and PFT,',ivm
+             !WRITE(numout,*) 'slowprocc Veget_max=',veget_max(ipts,ivm)
+             !ENDDO
+             !frac_nobio(ipts,:) = frac_nobio_new(ipts,:)
+          ENDDO
+
+          !+++CHECK+++
+          ! Shouldn we use veget_max_new here???
+          ! Verification and correction of veget_max, calculation
+          ! of veget and soiltile.
+          CALL slowproc_veget (kjpindex, lai_per_level, circ_class_biomass, &
+               circ_class_n, frac_nobio, totfrac_nobio, &
+               veget_max, veget, soiltile, tot_bare_soil)
+          !++++++++++++
+
+          ! Set the flag do_now_stomate_lcchange to activate stomate_lcchange.
+          ! This flag will be kept to true until stomate_lcchange has been done. 
+          ! The variable totfrac_nobio_new will only be used in stomate when
+          ! this flag is activated
+          do_now_stomate_lcchange=.TRUE.
+          IF ( .NOT. ok_stomate ) THEN
+             ! Special case if stomate is not activated : set the variable
+             ! done_stomate_lcchange=true 
+             ! so that the subroutine slowproc_change_frac will be called in the
+             ! end of sechiba_main.
+             done_stomate_lcchange=.TRUE.
+          END IF
+       ENDIF
+    ENDIF ! ( (veget_update > 0) .AND. FirstTsYear )
+
+    ! 3.1 Read the Nitrogen inputs
+    IF(ok_ncycle .AND. (.NOT. impose_CN)) THEN
+       IF ( (Ninput_update > 0) .AND. FirstTsYear ) THEN
+          ! Update of the vegetation cover with Land Use only if 
+          ! the current year match the requested condition (a multiple of "veget_update")
+          Ninput_year = Ninput_year + 1
+          IF ( MOD(Ninput_year - Ninput_year_orig, Ninput_update) == 0 ) THEN
+             IF (printlev_loc>=1) WRITE(numout,*)  'We are updating the Ninputs map for year =' , Ninput_year
+             
+             IF(.NOT. impose_ninput_dep) THEN
+                ! Read the new N inputs from file. Output is Ninput and frac_nobio_nextyear.
+                fieldname='Nammonium'
+                CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                     N_input(:,:,:,iammonium), Ninput_year, veget_max)
+                fieldname='Nnitrate'
+                CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                     N_input(:,:,:,initrate), Ninput_year, veget_max)
+                ! Conversion from mgN/m2/yr to gN/m2/day
+                N_input(:,:,:,iammonium)=N_input(:,:,:,iammonium)/1000./365.
+                N_input(:,:,:,initrate)=N_input(:,:,:,initrate)/1000./365.
+             ENDIF
+
+             IF(.NOT. impose_ninput_fert) THEN
+                fieldname='Nfert'
+                CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                     N_input_temp, Ninput_year, veget_max)
+                ! Conversion from gN/m2(cropland)/yr to gN/m2/day ! PALMI
+                N_input(:,:,:,ifert) = N_input_temp(:,:,:)/365.
+
+                fieldname='Nfert_cropland'
+                CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                     N_input_temp, Ninput_year, veget_max)
+                ! Conversion from gN/m2(cropland)/yr to gN/m2/day ! PALMI
+                N_input(:,:,:,ifert) = N_input(:,:,:,ifert)+ N_input_temp(:,:,:)/365.
+
+                fieldname='Nfert_pasture'
+                CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                     N_input_temp, Ninput_year, veget_max)
+                ! Conversion from gN/m2(pasture)/yr to gN/m2/day ! PALMI
+                N_input(:,:,:,ifert) = N_input(:,:,:,ifert)+ N_input_temp(:,:,:)/365.
+
+             ENDIF
+
+             IF(.NOT. impose_ninput_manure) THEN
+                fieldname='Nmanure'
+                CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                     N_input_temp, Ninput_year, veget_max)
+                ! Conversion from kgN/km2/yr to gN/m2/day ! PALMI
+                N_input(:,:,:,imanure) = N_input_temp(:,:,:)/1000./365.
+
+               fieldname='Nmanure_cropland'
+               CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                    N_input_temp, Ninput_year, veget_max)
+               ! Conversion from gN/m2(cropland)/yr to gN/m2/day ! PALMI
+                N_input(:,:,:,imanure) = N_input(:,:,:,imanure)+N_input_temp(:,:,:)/365.
+
+               fieldname='Nmanure_pasture'
+               CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                    N_input_temp, Ninput_year, veget_max)
+               ! Conversion from gN/m2(cropland)/yr to gN/m2/day ! PALMI
+                N_input(:,:,:,imanure) = N_input(:,:,:,imanure)+N_input_temp(:,:,:)/365.
+
+             ENDIF
+
+             IF(.NOT. impose_ninput_bnf) THEN
+                fieldname='Nbnf'
+                CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                     N_input(:,:,:,ibnf), Ninput_year, veget_max)
+                N_input(:,:,:,ibnf) = N_input(:,:,:,ibnf)/1000./365.
+             ENDIF
+
+          ENDIF
+          
+       ENDIF
+    ENDIF
+
+
+    !! 4. Main call to STOMATE
+    IF ( ok_stomate ) THEN
+
+       ! Calculate totfrac_nobio_new only for the case when the land use map 
+       ! has been read previously
+       IF (do_now_stomate_lcchange) THEN 
+          totfrac_nobio_new(:) = zero 
+          DO jv = 1, nnobio 
+             totfrac_nobio_new(:) = totfrac_nobio_new(:) + frac_nobio_new(:,jv)
+          ENDDO
+       ELSE 
+          totfrac_nobio_new(:) = zero 
+       END IF
+
+       !! 4.1 Call stomate main routine that will call all c-cycle routines
+       CALL stomate_main (kjit, kjpij, kjpindex, &
+            IndexLand, lalo, neighbours, resolution, contfrac, &
+            totfrac_nobio, clayfraction, siltfraction, bulk, &
+            temp_air, temp_sol, stempdiag, &
+            humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, &
+            tmc_pft, drainage_pft, swc_pft, gpp, &
+            deadleaf_cover, assim_param, &
+            frac_age, height, veget, veget_max, &
+            veget_max_new, totfrac_nobio_new, &
+            hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+            co2_flux, fco2_lu, resp_maint, resp_hetero, &
+            resp_growth, temp_growth, &
+            soil_pH, pb, n_input(:,:,month,:), circ_class_biomass, &
+            circ_class_n, lai_per_level, &
+            laieff_fit, h_array_out, z_array_out, max_height_store, &
+            transpir, transpir_mod, transpir_supply, vir_transpir_supply, &
+            coszang, stressed, unstressed, Isotrop_Tran_Tot_p, &
+            u, v)
+
+       !#481
+       !WRITE(numout,*) 'AHAAA: after stomate_main veget_max', veget_max(:,1)
+
+       ! Calculate height from biomass
+       DO jv = 2,nvm
+
+          DO ji = 1,kjpindex
+
+             ! this vegetation type is not present, so no reason to do the 
+             ! calculation. CYCLE refers to the DO-loop.
+             IF(veget_max(ji,jv) == zero) CYCLE       
+             height(ji,jv) = wood_to_qmheight(&
+                  circ_class_biomass(ji,jv,:,:,icarbon), &
+                  circ_class_n(ji,jv,:), jv)
+
+          ENDDO
+
+       ENDDO
+       height(:,1) = zero
+
+       !! 4.2 Output the respiration terms and the net primary
+       !!     production (NPP) that are calculated in STOMATE
+
+       ! 4.2.1 Compute the net primary production as the diff from
+       ! Gross primary productin and the growth and maintenance
+       ! respirations
+       npp(:,1)=zero
+       DO j = 2,nvm
+          npp(:,j) = gpp(:,j) - resp_growth(:,j) - resp_maint(:,j)
+       ENDDO
+
+       ! 4.2.2 Output npp & respiration terms
+       CALL xios_orchidee_send_field("npp",npp/dt_sechiba)
+       CALL xios_orchidee_send_field("maint_resp",resp_maint/dt_sechiba)
+       CALL xios_orchidee_send_field("hetero_resp",resp_hetero/dt_sechiba)
+       CALL xios_orchidee_send_field("growth_resp",resp_growth/dt_sechiba)
+
+       CALL histwrite_p(hist_id, 'npp', kjit, npp, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'maint_resp', kjit, resp_maint, &
+            kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'hetero_resp', kjit, resp_hetero, &
+            kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'growth_resp', kjit, resp_growth, &
+            kjpindex*nvm, indexveg)
+
+       ! Write the same information to a different history file file 
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'maint_resp', kjit, resp_maint, &
+               kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'hetero_resp', kjit, resp_hetero, &
+               kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'growth_resp', kjit, resp_growth, &
+               kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'npp', kjit, npp, kjpindex*nvm, indexveg)
+       ENDIF
+
+    ELSE
+
+       ! ok_stomate is not activated
+       ! Define the CO2 flux from the grid point to zero (no carbone cycle)
+       co2_flux(:,:) = zero
+
+    ENDIF ! ok_stomate
+
+
+    !! 5. Do daily processes if necessary
+    !!
+    IF ( do_slow ) THEN
+
+       !!  5.1 Calculate canopy structure when STOMATE is not activated
+       IF ( .NOT. ok_stomate ) THEN
+          
+          ! Slowproc_canopy calculates the canopy structure including
+          ! laieff_fit. It should therefore only be calculated once 
+          ! per day
+          CALL slowproc_canopy (kjpindex, circ_class_biomass, circ_class_n, &
+               veget_max, lai_per_level, h_array_out, z_array_out, &
+               max_height_store, laieff_fit, frac_age)
+
+       ENDIF
+
+       ! Calculate veget and the bare soil fractions
+       CALL slowproc_veget (kjpindex, lai_per_level, circ_class_biomass, &
+            circ_class_n, frac_nobio, totfrac_nobio, &
+            veget_max, veget, soiltile, tot_bare_soil)
+
+       ! Calculate lai
+       DO ji = 1, kjpindex
+          DO ivm = 1, nvm
+             lai(ji,ivm) = cc_to_lai(circ_class_biomass(ji,ivm,:,ileaf,icarbon),&
+                  circ_class_n(ji,ivm,:),ivm)
+          ENDDO
+       ENDDO
+       lai(:,ibare_sechiba) = zero
+
+       !! 5.3 updates qsintmax and other derived variables
+       IF ( .NOT. ok_stomate ) THEN
+
+          ! Initialize missing variables
+          deadleaf_cover(:) = zero
+          temp_growth(:) = 25.
+
+       ENDIF
+
+       qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:)
+       qsintmax(:,1) = zero
+
+    END IF ! do_slow
+
+    !! 7. Do some basic tests on the surface fractions updated above, only if
+    !!    slowproc_veget has been done (do_slow). No change of the variables. 
+    IF (do_slow) THEN
+       CALL slowproc_checkveget(kjpindex, frac_nobio, veget_max, &
+            veget, tot_bare_soil, soiltile)
+    END IF
+
+    !! 8. Write output fields
+    CALL xios_orchidee_send_field("tot_bare_soil",tot_bare_soil)
+    CALL xios_orchidee_send_field("frac_bare",frac_bare)
+
+    IF ( .NOT. almaoutput) THEN
+       CALL histwrite_p(hist_id, 'tot_bare_soil', kjit, tot_bare_soil, &
+            kjpindex, IndexLand)
+       CALL histwrite_p(hist_id, 'frac_bare', kjit, frac_bare, &
+            kjpindex*nvm, indexveg)
+    END IF
+
+
+    IF (printlev_loc>=3) WRITE (numout,*) ' slowproc_main done '
+
+  END SUBROUTINE slowproc_main
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: slowproc_finalize
+!!
+!>\BRIEF         Write to restart file variables for slowproc module and call finalization of stomate module
+!!
+!! DESCRIPTION : 
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_finalize (kjit,       kjpindex,    rest_id,     IndexLand,  &
+                                njsc,       height,      veget,       frac_nobio, &
+                                veget_max,  reinf_slope, assim_param, frac_age,   &
+                                circ_class_biomass, circ_class_n,   &
+                                lai_per_level, laieff_fit)
+
+!! 0.1 Input variables
+    INTEGER(i_std),INTENT(in)                            :: kjit           !! Time step number
+    INTEGER(i_std),INTENT(in)                            :: kjpindex       !! Domain size - terrestrial pixels only
+    INTEGER(i_std),INTENT(in)                            :: rest_id        !! Restart file identifier
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)        :: IndexLand      !! Indices of the points on the land map
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)        :: njsc           !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)       :: height         !! height of vegetation (m)
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)       :: veget          !! Fraction of vegetation type in the mesh (unitless)
+    REAL(r_std),DIMENSION(kjpindex,nnobio),INTENT(in)    :: frac_nobio     !! Fraction of ice, lakes, cities etc. in the mesh (unitless)
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)       :: veget_max      !! Maximum fraction of vegetation type in the mesh (unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)           :: reinf_slope    !! slope coef for reinfiltration
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(in) :: assim_param    !! assimilation parameters vcmax, nue, and leaf nitrogen
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(in) :: frac_age   !! Age efficacity from STOMATE for isoprene
+    REAL(r_std),DIMENSION(:,:,:,:,:),INTENT(in)          :: circ_class_biomass !!  Biomass components of the model tree  
+                                                                           !! within a circumference class
+                                                                           !! class @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std),DIMENSION(:,:,:),INTENT(in)              :: circ_class_n   !! Number of trees within each circumference
+                                                                           !! class @tex $(m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(:,:,:),INTENT(in)              :: lai_per_level  !! This is the LAI per vertical level
+                                                                           !! @tex $(m^{2} m^{-2})$
+    TYPE(laieff_type),DIMENSION(:,:,:),INTENT(in) &
+                                                         :: laieff_fit     !! Fitted parameters for the effective LAI
+
+!! 0.4 Local variables
+    REAL(r_std),DIMENSION(kjpindex,nmonth)               :: Ninput_ammo    !! Daily ammonium inputs (gN m-2 day-1) 
+    REAL(r_std),DIMENSION(kjpindex,nmonth)               :: Ninput_nitr    !! Daily nitrate inputs (gN m-2 day-1)
+    REAL(r_std),DIMENSION(kjpindex,nmonth)               :: Ninput_fert    !! Daily N fertilization (gN m-2 day-1)
+    REAL(r_std),DIMENSION(kjpindex,nmonth)               :: Ninput_bnf     !! Daily biological N fixation (gN m-2 day-1)
+    REAL(r_std)                                          :: tmp_day(1)     !! temporary variable for I/O
+    INTEGER                                              :: ji, jv, imonth !! Indices
+    INTEGER                                              :: iele,im        !! Indices
+    CHARACTER(LEN=4)                                     :: laistring      !! Temporary character string
+    CHARACTER(LEN=80)                                    :: var_name       !! To store variables names for I/O
+    CHARACTER(LEN=2), DIMENSION(nelements)               :: element_str    !! Element string used to make nice variables names 
+                                                                           !! in restart files
+    CHARACTER(LEN=10)                                    :: part_str       !! string suffix indicating an index
+    CHARACTER(LEN=2)                                     :: month_str      !! string used in variable name in restart files
+    
+!_ ================================================================================================================================
+
+    IF (printlev_loc>=3) WRITE (numout,*) 'Write restart file with SLOWPROC variables '
+
+    !! 1. Define element string
+    DO iele = 1,nelements
+       IF (iele == icarbon) THEN 
+          element_str(iele) = 'c' 
+       ELSEIF (iele == initrogen) THEN 
+          element_str(iele) = 'n' 
+       ELSE 
+          STOP 'Define element_str' 
+       ENDIF
+    ENDDO
+
+    ! 2.1 Write a series of variables controled by slowproc to the restart file
+    CALL restput_p (rest_id, 'veget', nbp_glo, nvm, 1, kjit, &
+         veget, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'veget_max', nbp_glo, nvm, 1, kjit, &
+         veget_max, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'circ_class_n', nbp_glo, nvm, ncirc, kjit, &
+         circ_class_n, 'scatter', nbp_glo, index_g)
+    DO iele = 1,nelements
+       var_name = 'cc_biomass_'//TRIM(element_str(iele))
+       CALL restput_p (rest_id, var_name, nbp_glo, nvm, ncirc, nparts, kjit, &
+            circ_class_biomass(:,:,:,:,iele), 'scatter', nbp_glo, index_g)
+    ENDDO
+    CALL restput_p (rest_id, 'assim_param',nbp_glo, nvm, npco2, kjit, &
+         assim_param, 'scatter', nbp_glo, index_g)
+    CALL restput_p (rest_id, 'frac_nobio', nbp_glo, nnobio, 1, kjit, &
+         frac_nobio, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'frac_age', nbp_glo, nvm, nleafages, kjit, &
+         frac_age, 'scatter',  nbp_glo, index_g)
+
+    ! Add the soil_classif as suffix for the variable name of njsc when it is
+    ! stored in the restart file. 
+    IF (soil_classif == 'zobler') THEN
+       var_name= 'njsc_zobler'
+    ELSE IF (soil_classif == 'usda') THEN
+       var_name= 'njsc_usda'
+    END IF
+    CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, &
+         REAL(njsc, r_std), 'scatter',  nbp_glo, index_g)        
+    CALL restput_p (rest_id, 'clay_frac', nbp_glo, 1, 1, kjit, &
+         clayfraction, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'silt_frac', nbp_glo, 1, 1, kjit, &
+         siltfraction, 'scatter',  nbp_glo, index_g)    
+    CALL restput_p (rest_id, 'bulk', nbp_glo, 1, 1, kjit, &
+         bulk, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'soil_ph', nbp_glo, 1, 1, kjit, &
+         soil_ph, 'scatter',  nbp_glo, index_g)
+
+    ! Specific case when CWRR hydrology is used
+    CALL restput_p (rest_id, 'reinf_slope', nbp_glo, 1, 1, kjit, &
+         reinf_slope, 'scatter',  nbp_glo, index_g) 
+    CALL restput_p (rest_id, 'clay_frac', nbp_glo, 1, 1, kjit, &
+         clayfraction, '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
+       DO iele = 1,nelements
+          DO imonth = 1,nmonth
+10           FORMAT(I2)
+             WRITE (month_str,10) imonth
+             var_name = 'cc_biomass_m_'//TRIM(month_str)//'_'//TRIM(element_str(iele))
+             CALL restput_p (rest_id, var_name, nbp_glo, nvm, ncirc, nparts, kjit, &
+                  cc_biomass_m(:,:,:,:,imonth,iele), 'scatter', nbp_glo, index_g)
+          ENDDO
+       ENDDO
+       var_name = 'cc_n_m'
+       CALL restput_p (rest_id, var_name, nbp_glo, nvm, ncirc, 12, kjit, &
+            cc_n_m(:,:,:,:), 'scatter', nbp_glo, index_g)
+    ENDIF
+    !
+    ! If there is some land use change, write the year for the land use ??? 
+    tmp_day(1) = REAL(veget_year,r_std)
+    IF (is_root_prc) CALL restput (rest_id, 'veget_year', 1 , 1  , 1, kjit, tmp_day)
+    
+
+    IF(ok_ncycle .AND. (.NOT. impose_CN))THEN
+       DO im = 1,12
+          WRITE(part_str,'(I2)') im
+          IF ( im < 10 ) part_str(1:1) = '0'
+          var_name = 'Nammonium_'//part_str(1:LEN_TRIM(part_str))
+          CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, N_input(:,:,im,iammonium), 'scatter', nbp_glo, index_g)
+          var_name = 'Nnitrate_'//part_str(1:LEN_TRIM(part_str))
+          CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, N_input(:,:,im,initrate), 'scatter', nbp_glo, index_g)
+          var_name = 'Nfert_'//part_str(1:LEN_TRIM(part_str))
+          CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, N_input(:,:,im,ifert), 'scatter', nbp_glo, index_g)
+          var_name = 'Nmanure_'//part_str(1:LEN_TRIM(part_str))
+          CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit,N_input(:,:,im,imanure), 'scatter',  nbp_glo, index_g)
+          var_name = 'Nbnf_'//part_str(1:LEN_TRIM(part_str))
+          CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, N_input(:,:,im,ibnf), 'scatter', nbp_glo, index_g)
+      ENDDO 
+    ENDIF
+
+    !
+    ! If there is some N inputs change, write the year 
+    IF (ninput_year /= 0.) THEN
+       tmp_day(1) = REAL(ninput_year,r_std)
+       IF (is_root_prc) CALL restput (rest_id, 'ninput_year', 1 , 1  , 1, kjit, tmp_day)
+    ENDIF
+    
+    ! 2.2 Write restart variables managed by STOMATE
+    ! The restart files of stomate and sechiba both contain circ_class_biomass, and circ_class_n. 
+    ! This allows to run a first simulation with stomate and then use its restarts
+    ! for a simulation with only sechiba.
+    IF ( ok_stomate ) THEN
+       CALL stomate_finalize (kjit, kjpindex, indexLand, clayfraction, assim_param, &
+            siltfraction, bulk, circ_class_biomass, circ_class_n, &
+            lai_per_level, laieff_fit) 
+    ENDIF
+    
+  END SUBROUTINE slowproc_finalize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_init
+!!
+!>\BRIEF         Initialisation of all variables linked to SLOWPROC
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): The subroutine manages 
+!! diverses tasks:
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::veget_update, ::veget_year,
+!! ::veget, ::frac_nobio, ::totfrac_nobio, ::veget_max, ::height, ::soiltype
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_init (kjit, kjpindex, IndexLand,& 
+       lalo, neighbours, resolution, contfrac, &
+       rest_id, frac_age, veget, frac_nobio, &
+       reinf_slope, veget_max, njsc, veget_update, &
+       veget_year, Ninput_update, Ninput_year, &
+       circ_class_biomass, circ_class_n, assim_param)
+    
+    !! INTERFACE DESCRIPTION
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT (in)                           :: kjit                !! Time step number
+    INTEGER(i_std), INTENT (in)                           :: kjpindex            !! Domain size - Terrestrial pixels only 
+    INTEGER(i_std), INTENT (in)                           :: rest_id             !! Restart file identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: IndexLand           !! Indices of the land points on the map
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT (in)      :: lalo                !! Geogr. coordinates (latitude,longitude) (degrees)
+    INTEGER(i_std), DIMENSION (kjpindex,NbNeighb), INTENT(in):: neighbours       !! Vector of neighbours for each grid point
+                                                                                 !! (1=North and then clockwise)
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)       :: resolution          !! size in x and y of the grid (m)
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)        :: contfrac            !! Fraction of continent in the grid (unitless)
+    
+    !! 0.2 Output variables
+!!$    INTEGER(i_std), INTENT(out)                           :: lcanop              !! Number of Canopy level used to compute LAI
+    INTEGER(i_std), INTENT(out)                           :: veget_update        !! update frequency in timesteps (years) for landuse
+    INTEGER(i_std), INTENT(out)                           :: veget_year          !! first year for landuse   (year or index ???)
+    INTEGER(i_std), INTENT(out)                           :: Ninput_update       !! update frequency in timesteps (years) for N inputs
+    INTEGER(i_std), INTENT(out)                           :: ninput_year         !! first year for landuse   (year or index ???)
+    INTEGER(i_std), DIMENSION(kjpindex), INTENT(out)      :: njsc                !! Index of the dominant soil textural class in the grid 
+                                                                                 !! cell (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (out)   :: veget               !! Fraction of vegetation type in the mesh (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT (out):: frac_nobio          !! Fraction of ice,lakes,cities, in the mesh (unitless)
+!!$    REAL(r_std), DIMENSION (kjpindex), INTENT (out)       :: totfrac_nobio       !! Total fraction of ice+lakes+cities+ in the mesh 
+!!$                                                                                 !! (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (out)   :: veget_max           !! Max fraction of vegetation type in the mesh (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm,nleafages), INTENT (out):: frac_age     !! Age efficacity from STOMATE for isoprene
+!!$    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)   :: soiltile            !! Fraction of each soil tile within vegtot 
+!!$                                                                                 !! (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)        :: reinf_slope         !! slope coef for reinfiltration
+!!$    REAL(r_std), DIMENSION (:,:,:), INTENT(out)           :: lai_per_level       !! This is the LAI per vertical level
+!!$                                                                                 !! @tex $(m^{2} m^{-2})$
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(out)        :: circ_class_biomass  !! Biomass components of the model tree  
+                                                                                 !! within a circumference class
+                                                                                 !! class @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(out)            :: circ_class_n        !! Number of trees within each circumference
+                                                                                 !! class @tex $(m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(:,:,:), INTENT(out)             :: assim_param         !! assimilation parameters, vcmax, nue and leaf nitrogen
+!!$    REAL(r_std), DIMENSION(:,:,:,:), INTENT(out)          :: z_array_out         !! height above the soil, to use in sechiba
+!!$    REAL(r_std), DIMENSION(:,:,:,:), INTENT(out)          :: h_array_out         !! An output of h_array, to use in sechiba    
+!!$    REAL(r_std), DIMENSION(:,:), INTENT(out)              :: max_height_store    !! maximum vegetation height in the PFT 
+!!$    TYPE(laieff_type), DIMENSION (:,:,:), INTENT(out)     :: laieff_fit          !! Fitted parameters for the effective LAI
+
+    !! 0.3 Modified variables
+    
+    !! 0.4 Local
+    REAL(r_std), DIMENSION(kjpindex,nvm,nlevels_tot)      :: z_level_photo       !! The height of the levels that we will
+                                                                                 !! use to calculate the effective LAI for
+                                                                                 !! the albedo routines and photosynthesis.
+                                                                                 !! @tex $(m)$ @endtex 
+!!$    REAL(r_std),DIMENSION(:), INTENT (inout)              :: tot_bare_soil       !! Total evaporating bare soil fraction 
+
+   !! 0.4 Local variables 
+    REAL(r_std)                                           :: tmp_veget_year(1)   !! temporary variable
+    REAL(r_std)                                           :: tmp_ninput_year(1)  !! temporary variable
+    REAL(r_std)                                           :: zcanop              !! ???? soil depth taken for canopy
+    INTEGER(i_std)                                        :: vtmp(1)             !! temporary variable
+    REAL(r_std), DIMENSION(nbdl)                          :: zsoil               !! soil depths at diagnostic levels
+    CHARACTER(LEN=4)                                      :: laistring           !! Temporary character string
+    INTEGER(i_std)                                        :: j, l, jf, im        !! Indices
+    CHARACTER(LEN=80)                                     :: var_name            !! To store variables names for I/O
+    INTEGER(i_std)                                        :: ji, jv, ier,jst     !! Indices 
+    LOGICAL                                               :: get_slope
+    REAL(r_std)                                           :: frac_nobio1         !! temporary variable for frac_nobio(see above)
+    REAL(r_std), DIMENSION(kjpindex)                      :: tmp_real
+    REAL(r_std), DIMENSION(kjpindex,nbdl)                 :: stempdiag2_bid      !! matrix to store stempdiag_bid
+    REAL(r_std), DIMENSION (kjpindex,nscm)                :: soilclass           !! Fractions of each soil textural class in the grid 
+                                                                                 !! cell (0-1, unitless)
+    CHARACTER(LEN=30), SAVE                               :: veget_str           !! update frequency for landuse
+    !$OMP THREADPRIVATE(veget_str)
+    CHARACTER(LEN=30), SAVE                               :: ninput_str          !! update frequency for N inputs
+    !$OMP THREADPRIVATE(ninput_str)
+    CHARACTER(LEN=10)                                     :: part_str            !! string suffix indicating an index
+
+    REAL(r_std), DIMENSION(kjpindex)                      :: frac_crop_tot       !! Total fraction occupied by crops (0-1, unitless)
+    LOGICAL                                               :: found_restart       !! found_restart=true if all 3 variables veget_max, 
+                                                                                 !! veget and frac_nobio are read from restart file
+    CHARACTER(LEN=80)                                     :: fieldname           !! name of the field read in the N input map
+    REAL(r_std)                                           :: nammonium, nnitrate !! Precribed amounts of deposition 
+    REAL(r_std)                                           :: nfert, nbnf,nmanure !! Prescribed amounts of N input from fertilizer, 
+                                                                                 !! biological fixation and manure
+    REAL(r_std), DIMENSION(kjpindex,nvm,12)               :: N_input_temp
+    INTEGER                                               :: iele, imonth        !! Indices
+    CHARACTER(LEN=2), DIMENSION(nelements)                :: element_str         !! Element string used to make nice variables names 
+                                                                                 !! in restart files
+    CHARACTER(LEN=2)                                      :: month_str           !! string used in variable name in restart files
+
+    !_ ================================================================================================================================
+
+    !! 0. Initialize local printlev
+    !printlev_loc=get_printlev('slowproc')
+    IF (printlev_loc>=3) WRITE (numout,*) "In slowproc_init"
+    
+    !! 1. Allocate memory
+    ALLOCATE (clayfraction(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
+         'Problem in allocation of variable clayfraction','','')
+    clayfraction(:)=undef_sechiba
+
+    ALLOCATE (sandfraction(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
+         'Problem in allocation of variable sandfraction','','')
+    sandfraction(:)=undef_sechiba
+
+    ALLOCATE (siltfraction(kjpindex),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p(3,'slowproc_init',&
+         'Problem in allocation of variable siltfraction','','')
+    !? why there is a specific undef for sechiba ?
+    siltfraction(:)=undef_sechiba
+
+    ALLOCATE (bulk(kjpindex),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p(3,'slowproc_init',&
+         'Problem in allocation of variable bulk','','')
+    !? why there is a specific undef for sechiba ?
+    bulk(:)=undef_sechiba
+
+    ALLOCATE (soil_ph(kjpindex),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p(3,'slowproc_init',&
+         'Problem in allocation of variable soilph','','')
+    !? why there is a specific undef for sechiba ?
+    soil_ph(:)=undef_sechiba
+
+    !+++CHECK+++
+    ! n_input is hardcoded for monthly nitrogen files
+    ALLOCATE (n_input(kjpindex,nvm,12,ninput),stat=ier)
+    IF (ier.NE.0) CALL ipslerr_p(3,'slowproc_init',&
+         'Problem in allocation of variable n_input','','')
+    !+++++++++++
+
+    ! Allocation of the default soilclass
+    ALLOCATE (soilclass_default(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
+         'Problem in allocation of variable soilclass_default','','')
+    soilclass_default(:)=undef_sechiba
+
+    ! Allocation of the fraction of bare soil
+    ALLOCATE (frac_bare(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) CALL ipslerr(3,'slowproc_init',&
+         'Problem in allocation of variable frac_bare','','')
+
+    ! Allocation of last year vegetation fraction in case of land use change
+    ALLOCATE(veget_max_new(kjpindex, nvm), STAT=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
+         'Problem in allocation of variable veget_max_new','','')
+
+    ! Allocation of the fraction of non biospheric areas 
+    ALLOCATE(frac_nobio_new(kjpindex, nnobio), STAT=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
+         'Problem in allocation of variable frac_nobio_new','','')
+    
+    ! Allocate variables to prescribe canopy structure when
+    ! stomate is not used
+    IF (read_lai)THEN
+       ! cc_biomass and cc_n are prescribed from files with monthly values
+       ALLOCATE (cc_biomass_m(kjpindex,nvm,ncirc,nparts,nelements,12),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
+            'Problem in allocation of variable cc_biomass_m','','')
+       ALLOCATE (cc_n_m(kjpindex,nvm,ncirc,12), stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
+            'Problem in allocation of variable cc_n_m','','')
+    ELSE
+       ! allocate the variables but they will never be used
+       ALLOCATE (cc_biomass_m(1,1,1,1,1,1), stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
+            'Problem in allocation of variable cc_biomass_m(1,1,1,1,1,1)','','')
+       ALLOCATE (cc_n_m(1,1,1,1), stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
+            'Problem in allocation of variable cc_n_m(1,1,1,1)','','')
+    ENDIF
+
+    !! 2. Read general parameters
+    
+    !  Interception reservoir coefficient
+    !
+    !Config Key   = SECHIBA_QSINT 
+    !Config Desc  = Interception reservoir coefficient
+    !Config If    = OK_SECHIBA 
+    !Config Def   = 0.1
+    !Config Help  = Transforms leaf area index into size of interception reservoir
+    !Config         for slowproc_derivvar or stomate
+    !Config Units = [m]
+    CALL getin_p('SECHIBA_QSINT', qsintcst)
+    WRITE(numout, *)' SECHIBA_QSINT, qsintcst = ', qsintcst
+    !
+    ! Time step of STOMATE and LAI update when reading an LAI map
+    !
+    !Config Key   = DT_STOMATE
+    !Config Desc  = Time step of STOMATE and other slow processes
+    !Config If    = OK_STOMATE
+    !Config Def   = one_day
+    !Config Help  = Time step (s) of regular update of vegetation
+    !Config         cover, LAI etc. This is also the time step
+    !Config         of STOMATE.
+    !Config Units = [seconds]
+    dt_stomate = one_day
+    CALL getin_p('DT_STOMATE', dt_stomate)
+
+    !! 3. Read the soil related variables
+    !  The model could start from scratch, from a restart file or the value of 
+    !  specific variables could be imposed. Imposing could make use of fixed
+    !  values or from maps. This results in many possible configurations some
+    !  of which are not very useful. The order of the code in this subroutine 
+    !  already limits the number of possible configurations to initialize the
+    !  model but the real quality control on this issue is taking place in 
+    !  sechiba in the subroutine check_configuration. The order implemented 
+    !  here is: (1) Read the values from a restart file if available. If
+    !  no restart file is found, give the variable the value val_exp (done
+    !  in the subroutine restget_p). If a restart file was found, the value 
+    !  for impose_soilt will be ingnored (this is taken care of in setvar_p by 
+    !  checking whether the variable has the value val_exp or not). If no 
+    !  restart file was found there are still two more options to initialize 
+    !  the model: (2) initialize all soil variables by fixed values which can 
+    !  be set in the run.def or their default values, or (3) initialize the 
+    !  soil variables with values from a map or file (in this case possible 
+    !  conflicts with the restart file are explicitly dealt with througf 
+    !  IF-statements in this subroutine). Note that all the information 
+    !  required to initialize the soil is stored in the sechiba restart. Hence, 
+    !  the value of ok_stomate does not affect this part of the initialization. 
+
+    ! Add the soil classification as suffix for the variable name of njsc to make
+    ! sure that the correct njsc is read from the restart. A restart made with one
+    ! soil classification cannot be used for a simulation with another soil 
+    ! classification. The model will crash by saying that the specific variable 
+    ! for njsc was not found in the restart file.
+    IF (soil_classif == 'zobler') THEN
+       var_name= 'njsc_zobler'
+    ELSE IF (soil_classif == 'usda') THEN
+       var_name= 'njsc_usda'
+    ELSE
+       CALL ipslerr_p(3,'slowproc_init',&
+            'Non supported soil typeclassification','','')
+    END IF
+
+    ! Index of the dominant soil type in the grid cell
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Index of soil type')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, &
+         .TRUE., tmp_real, "gather", nbp_glo, index_g)
+    IF ( ALL( tmp_real(:) .EQ. val_exp) ) THEN
+       njsc (:) = undef_int
+    ELSE
+       njsc = NINT(tmp_real)
+    END IF
+
+    var_name= 'clay_frac'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Fraction of clay in each mesh')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, &
+         .TRUE., clayfraction, "gather", nbp_glo, index_g)
+
+    var_name= 'silt_frac'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Fraction of silt in each mesh')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, &
+         .TRUE., siltfraction, "gather", nbp_glo, index_g)
+
+    ! Initialize the sandfraction as the residual as it does not
+    ! need to be in the restart file
+    IF ( ALL( siltfraction(:) .EQ. val_exp) ) THEN
+       sandfraction(:) = val_exp
+    ELSE
+       sandfraction(:) = 1. - clayfraction(:) - siltfraction(:)
+    END IF
+
+    var_name= 'bulk'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Bulk density in each mesh')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, &
+         .TRUE., bulk, "gather", nbp_glo, index_g)
+
+    var_name= 'soil_ph'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Soil pH in each mesh')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, &
+         .TRUE., soil_ph, "gather", nbp_glo, index_g)
+
+    IF (impsoilt.EQ..TRUE.) THEN 
+
+       ! If the initial value of a specific variable still equals to
+       ! val_exp, the value could be overwritten by a fixed value 
+       ! taken from the run.def (or its concurrent default value).
+       ! Unless the restart files were manipulated, val_exp is only
+       ! expected at this point in the code when no restart file
+       ! was found. This is explictly accounted for in check_config.
+       ! Note that the subroutine setvar_p only works if the value 
+       ! has not yet been initialized. Hence, it is NOT possible to 
+       ! take a restart file and only overwrite the soil-related 
+       ! variables.
+       
+       !Config Key   = SOIL_FRACTIONS
+       !Config Desc  = Fraction of the 3 soil types (0-dim mode)
+       !Config Def   = undef_sechiba
+       !Config If    = IMPOSE_VEG and IMPOSE_SOILT
+       !Config Help  = Determines the fraction for the 3 soil types
+       !Config         in the mesh in the following order : sand loam and clay.
+       !Config Units = [-]
+       soilclass(1,:) = soilclass_default(:)
+       CALL getin_p('SOIL_FRACTIONS',soilclass(1,:))
+
+       ! Assign for each grid-cell the % of the different 
+       ! textural classes (up to 12 if 'usda')
+       DO ji=2,kjpindex
+          ! here we read, for the prescribed grid-cell, the
+          ! percentage occupied by each of the soil texture classes 
+          soilclass(ji,:) = soilclass(1,:)
+       ENDDO
+
+       ! Simplify a heterogeneous grid-cell into an homogeneous one 
+       ! with the dominant texture
+       njsc(:) = 0
+       DO ji = 1, kjpindex
+          ! here we reduce to the dominant texture class
+          njsc(ji) = MAXLOC(soilclass(ji,:),1)
+       ENDDO
+
+       !Config Key   = CLAY_FRACTION
+       !Config Desc  = Fraction of the clay fraction (0-dim mode)
+       !Config Def   = 0.2
+       !Config If    = IMPOSE_VEG and IMPOSE_SOIL
+       !Config Help  = Determines the fraction of clay in the grid box.
+       !Config Units = [-] 
+
+       ! If clayfraction was not in restart file it will be read from the
+       ! run.def file instead or initialized based on fractions of each textural 
+       ! class
+       CALL setvar_p (clayfraction, val_exp, 'CLAY_FRACTION', clayfraction_default)
+
+       !Config Key   = SAND_FRACTION
+       !Config Desc  = Fraction of the sand fraction (0-dim mode)
+       !Config Def   = 0.5
+       !Config If    = IMPOSE_VEG and IMPOSE_SOIL
+       !Config Help  = Determines the fraction of sand in the grid box.
+       !Config Units = [-] 
+       CALL setvar_p (sandfraction, val_exp, 'SAND_FRACTION',sandfraction_default)
+
+       !Config Key   = SILT_FRACTION
+       !Config Desc  = Fraction of the silt fraction (0-dim mode)
+       !Config Def   = 0.5
+       !Config If    = IMPOSE_VEG and IMPOSE_SOIL
+       !Config Help  = Determines the fraction of silt in the grid box.
+       !Config Units = [-] 
+       CALL setvar_p (siltfraction, val_exp, 'SILT_FRACTION', siltfraction_default)
+
+       !Config Key   = Bulk density
+       !Config Desc  = Bulk density (0-dim mode)
+       !Config Def   = XXX
+       !Config If    = IMPOSE_VEG and IMPOSE_SOIL
+       !Config Help  = Determines the bulk density in the grid box.
+       !Config Units = [-] 
+       CALL setvar_p (bulk, val_exp, 'BULK', bulk_default)
+
+       !Config Key   = Soil pH
+       !Config Desc  = Soil pH (0-dim mode)
+       !Config Def   = XXX
+       !Config If    = IMPOSE_VEG and IMPOSE_SOIL
+       !Config Help  = Determines the pH in the grid box.
+       !Config Units = [-]
+       CALL setvar_p (soil_ph, val_exp, 'SOIL_PH', ph_default)
+
+    ELSEIF (impsoilt.EQ..FALSE.) THEN
+
+       IF ( MAXVAL(clayfraction) .EQ. val_exp .AND. &	               
+            MAXVAL(sandfraction) .EQ. val_exp .AND. &
+            MAXVAL(siltfraction) .EQ. val_exp .AND. &
+            MAXVAL(bulk) .EQ. val_exp .AND. &
+            MAXVAL(soil_ph) .EQ. val_exp .AND. &
+            MAXVAL(njsc) .EQ. undef_int ) THEN
+
+          ! None of the variables was initialized. This implies that no 
+          ! restart was found and the user did not want to impose values 
+          ! by making use of the run.def or the default model settings. 
+          ! Search for a map and initialize. 
+          CALL slowproc_soilt(kjpindex, lalo, neighbours, resolution, &
+               contfrac, soilclass, clayfraction, sandfraction, siltfraction, &
+               bulk, soil_ph)
+          njsc(:) = 0
+          DO ji = 1, kjpindex
+             njsc(ji) = MAXLOC(soilclass(ji,:),1)
+          ENDDO
+
+       ELSEIF ( MAXVAL(clayfraction) .NE. val_exp .AND. &	               
+            MAXVAL(sandfraction) .NE. val_exp .AND. &
+            MAXVAL(siltfraction) .NE. val_exp .AND. &
+            MAXVAL(bulk) .NE. val_exp .AND. &
+            MAXVAL(soil_ph) .NE. val_exp .AND. &
+            MAXVAL(njsc) .NE. undef_int ) THEN
+
+          ! None of the values is still val_exp which suggest that the 
+          ! initialization went well. We expect the code to pass through here 
+          ! at all 1+ period states. 
+
+       ELSE
+
+          ! We should never end-up here. This means that some of the variables
+          ! were initialized and some were not. That is unexpected. Note that
+          ! the code in slowproc_soilt could overwrite the values retrieved from a 
+          ! restart file as well overwrite the values set by setvar_p. It will
+          ! overwrite all variables with those read from the map not only the
+          ! variables that were not yet defined. This case should be further
+          ! tested and developed.
+          CALL ipslerr(3,'Some but not all soil variables were initialized',&
+               'This is an expected case for which the code should be',&
+               'further developed','Look into slowproc_init for more text')
+
+       ENDIF
+
+    ENDIF
+
+    !! 4. Read the infiltration related variables
+    
+    !Config Key   = GET_SLOPE
+    !Config Desc  = Read slope from a file and do the interpolation
+    !Config Def   = n
+    !Config If    =
+    !Config Help  = Needed for reading the slopesfile and doing the 
+    !               interpolation. This will be used by the re-infiltration 
+    !               parametrization
+    !Config Units = [FLAG]
+    get_slope = .FALSE.
+    CALL getin_p('GET_SLOPE',get_slope)
+
+    IF (get_slope .EQ. .TRUE.) THEN
+
+       ! Read the slope coefficients from a map
+       CALL slowproc_slope(kjpindex, lalo, neighbours, resolution, contfrac, reinf_slope)
+
+    ELSE
+
+       ! No slope map will be used, try to find a restart file
+       var_name= 'reinf_slope'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Slope coef for reinfiltration')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, &
+            .TRUE., reinf_slope, "gather", nbp_glo, index_g)
+
+       IF (MAXVAL(reinf_slope) .EQ. val_exp) THEN
+  
+          ! No restart was found, use the default value
+          !Config Key   = REINF_SLOPE
+          !Config Desc  = Slope coef for reinfiltration 
+          !Config Def   = 0.1
+          !Config If    = No restart available
+          !Config Help  = Determines the reinfiltration ratio in the grid box due to 
+          !               flat areas
+          !Config Units = [-]
+          slope_default=0.1
+          CALL setvar_p (reinf_slope, val_exp, 'SLOPE', slope_default)
+
+       END IF
+
+    END IF
+
+    !! 5. Read the vegetation related variables
+    !  The model could start from scratch, from a restart file or the value of 
+    !  specific variables could be imposed. Imposing could make use of fixed
+    !  values or from maps. This results in many possible configurations some
+    !  of which are not very useful. The order of the code in this subroutine 
+    !  already limits the number of possible configurations to initialize the
+    !  model but the real quality control on this issue is taking place in 
+    !  sechiba in the subroutine check_configuration. The order implemented 
+    !  here is: (1) Read the values from a restart file if available. If
+    !  no restart file is found, give the variable the value val_exp (done
+    !  in the subroutine restget_p). If a restart file was found, the value 
+    !  for impveg will be ignored (this is taken care of in setvar_p by 
+    !  checking whether the variable has the value val_exp or not). If no 
+    !  restart file was found there are still two more options to initialize 
+    !  the model: (2) initialize the vegetation fractions by fixed values which can 
+    !  be set in the run.def or their default values, or (3) initialize the 
+    !  vegetation fractions with values from a map or file. In case (2) and (3)
+    !  the default of the vegetation varaibles is set to zero. This enables the
+    !  users to prescribe the vegetation fractions but start the rest of the
+    !  model from scratch. Finally there is 4th option in which the vegetation
+    !  variables are also imposed or prescribed from a map. In this case
+    !  conflicts may be introduced, for example, the map contains biomass for a
+    !  given PFT but previous steps in the initialization resulted in a
+    !  veget_max of zero for that PFT. Note that all the information 
+    !  required to initialize the vegetation is also stored in the sechiba restart. 
+    !  Hence, the value of ok_stomate does not affect this part of the initialization. 
+
+    ! Set default value. It may get overwritten in the subsequent code
+    found_restart=.TRUE.
+
+    ! Define element string
+    DO iele = 1,nelements
+       IF (iele == icarbon) THEN 
+          element_str(iele) = 'c' 
+       ELSEIF (iele == initrogen) THEN 
+          element_str(iele) = 'n' 
+       ELSE 
+          STOP 'Define element_str' 
+       ENDIF
+    ENDDO
+
+    !! 5.1 Try to read the values from a sechiba restart file.
+    var_name= 'veget'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Vegetation fraction')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., &
+         veget, "gather", nbp_glo, index_g)
+    IF ( ALL( veget(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
+
+    var_name= 'veget_max'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Maximum vegetation fraction')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., &
+         veget_max, "gather", nbp_glo, index_g)
+    IF ( ALL( veget_max(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
+
+    var_name= 'frac_nobio'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Special soil type fraction')
+    CALL restget_p (rest_id, var_name, nbp_glo, nnobio, 1, kjit, .TRUE., &
+         frac_nobio, "gather", nbp_glo, index_g)
+    IF ( ALL( frac_nobio(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
+
+    var_name= 'circ_class_n'
+    CALL ioconf_setatt_p('UNITS', 'trees m-2')
+    CALL ioconf_setatt_p('LONG_NAME','Stand density')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, ncirc, kjit, .TRUE., &
+         circ_class_n, "gather", nbp_glo, index_g)
+    IF ( ALL( circ_class_n(:,:,:) .EQ. val_exp ) ) found_restart=.FALSE.
+
+    DO iele = 1,nelements
+       var_name = 'cc_biomass_'//TRIM(element_str(iele))
+       CALL ioconf_setatt_p('UNITS', 'gC(N) tree-1')
+       CALL ioconf_setatt_p('LONG_NAME','Carbon (or N) mass for the different &
+            & biomass components of an individual tree')
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, ncirc, nparts, kjit, .TRUE., &
+            circ_class_biomass(:,:,:,:,iele), "gather", nbp_glo, index_g)
+       IF ( ALL( circ_class_biomass(:,:,:,:,iele) .EQ. val_exp ) ) found_restart=.FALSE.
+    ENDDO
+
+    var_name= 'assim_param'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Assimilation parameters, Vcmax, nue and leaf nitrogen')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, npco2, kjit, .TRUE., &
+         assim_param, "gather", nbp_glo, index_g)
+    IF ( ALL( assim_param(:,:,:) .EQ. val_exp ) ) found_restart=.FALSE.
+
+    !  frac_age is used in ok_bvoc which can be called if ok_stomate = F.
+    !  In case stomate is not used, it needs to be read from the sechiba 
+    !  restart file. 
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Fraction of leaves in leaf age class ')
+    CALL restget_p (rest_id, 'frac_age', nbp_glo, nvm, nleafages, kjit, .TRUE., &
+         frac_age, "gather", nbp_glo, index_g)
+    IF ( ALL( frac_age(:,:,:) .EQ. val_exp ) ) found_restart=.FALSE.
+
+    !Config Key   = VEGET_UPDATE
+    !Config Desc  = Update vegetation frequency
+    !Config If    = 
+    !Config Def   = 0Y
+    !Config Help  = The veget datas will be update each this time step.
+    !Config Units = [years]
+    veget_update=0
+    WRITE(veget_str,'(a)') '0Y'
+    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
+
+    !! 5.2 Impose vegetation fractions or read from a PFT map
+    IF (impveg) THEN
+
+       ! impveg=TRUE: there can not be any land use change, veget_update must be =0
+       ! Read VEGET_UPDATE from run.def and exit if it is different from 0Y
+       IF (veget_update /= 0) THEN
+          WRITE(numout,*) 'veget_update=',veget_update,' is not coeherent with impveg=',impveg
+          CALL ipslerr_p(3,'slowproc_init','Incoherent values between impveg and veget_update', &
+               'veget_update must be equal to 0 if impveg=true','')
+       ENDIF
+
+       ! Initialize the vegetation fractions by reading run.def. The routine setvar_p 
+       ! will only initialize the variable if it was not found in restart file.  
+       !Config Key   = SECHIBA_VEGMAX
+       !Config Desc  = Maximum vegetation distribution within the mesh (0-dim mode)
+       !Config If    = IMPOSE_VEG
+       !Config Def   = 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0
+       !Config Help  = The fraction of vegetation is read from the restart file. If
+       !Config         it is not found there we will use the values provided here.
+       !Config Units = [-]
+       CALL setvar_p (veget_max, val_exp, 'SECHIBA_VEGMAX', veget_ori_fixed_test_1)
+
+       !Config Key   = SECHIBA_FRAC_NOBIO
+       !Config Desc  = Fraction of other surface types within the mesh (0-dim mode)
+       !Config If    = IMPOSE_VEG
+       !Config Def   = 0.0
+       !Config Help  = The fraction of ice, lakes, etc. is read from the restart file. If
+       !Config         it is not found there we will use the values provided here.
+       !Config         For the moment, there is only ice.
+       !Config Units = [-]
+       frac_nobio1 = frac_nobio(1,1)
+       CALL setvar_p (frac_nobio1, val_exp, 'SECHIBA_FRAC_NOBIO', frac_nobio_fixed_test_1)
+       frac_nobio(:,:) = frac_nobio1       
+
+       
+    ELSE
+
+       ! The DGVM cannot be combined with land use change if agriculture is not 
+       ! accounted for from by reading a land cover change map (agriculture cannot
+       ! be predicted by the dgvm and therefore needs to be prescribed by a map)
+       IF (veget_update > 0 .AND. ok_dgvm .AND. .NOT. agriculture) THEN
+          CALL ipslerr_p(3,'slowproc_init',&
+               'The combination DGVM=TRUE, AGRICULTURE=FALSE and VEGET_UPDATE>0 is not possible', &
+               'Set VEGET_UPDATE=0Y in run.def','')
+       END IF  
+
+       ! The vegetation fractions are not imposed, hence, land cover change is possible.
+       ! Read the year that the vegetation map needs to be updated.
+       var_name= 'veget_year'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Last year get in Land Use file.')
+       IF (is_root_prc) THEN
+          CALL restget (rest_id, var_name, 1       , 1  , 1, kjit, .TRUE., tmp_veget_year)
+          IF (veget_reinit) THEN
+             ! Do not take the value read from restart file
+             veget_year=veget_year_orig
+          ELSE IF (tmp_veget_year(1) == val_exp) THEN
+             ! veget_year was not found in restart file
+             veget_year=veget_year_orig
+          ELSE
+             ! veget_year was found in restart file, transform to integer
+             veget_year=INT(tmp_veget_year(1))
+          ENDIF
+       ENDIF
+       CALL bcast(veget_year) 
+
+       IF ( .NOT. found_restart ) THEN
+
+          ! Only when there is no restart and the values have not been imposed, the model
+          ! will read the vegetation fractions from a file
+          IF (printlev_loc>=3) WRITE(numout,*) 'Before call slowproc_readvegetmax in &
+               & initialization phase without restart files'
+          IF (printlev_loc>=3) WRITE(numout,*) 'veget_year=', veget_year
+
+          ! Call the routine to read the vegetation from file (output is veget_max_new)
+          CALL slowproc_readvegetmax(kjpindex, lalo, neighbours, resolution, contfrac, &
+               veget_max, veget_max_new, frac_nobio_new, veget_year, .TRUE.)
+          IF (printlev_loc>=4) WRITE (numout,*) 'After slowproc_readvegetmax in initialization phase'
+
+          ! Update vegetation with values read from the file
+          veget_max = veget_max_new
+          frac_nobio = frac_nobio_new         
+
+          !! Reset totaly or partialy veget_max if using DGVM
+          IF ( ok_dgvm  ) THEN
+
+             ! If we are dealing with dynamic vegetation then all natural PFTs should 
+             ! be set to veget_max = 0. In case no agriculture is desired, agriculture 
+             ! PFTS should be set to 0 as well
+             IF (agriculture) THEN
+
+                DO jv = 2, nvm
+                   IF (natural(jv)) THEN 
+                      veget_max(:,jv)=zero
+                   ENDIF
+                ENDDO
+
+                ! Calculate the fraction of crop for each point.
+                ! Sum only on the indexes corresponding to the non_natural pfts
+                frac_crop_tot(:) = zero
+                DO jv = 2, nvm
+                   IF(.NOT. natural(jv)) THEN
+                      DO ji = 1, kjpindex
+                         frac_crop_tot(ji) = frac_crop_tot(ji) + veget_max(ji,jv)
+                      ENDDO
+                   ENDIF
+                END DO
+
+                ! Calculate the fraction of bare soil
+                DO ji = 1, kjpindex
+                   veget_max(ji,1) = un - frac_crop_tot(ji) - SUM(frac_nobio(ji,:))   
+                ENDDO
+
+             ELSE
+                
+                ! No agriculture land in this simulation
+                veget_max(:,:) = zero
+                DO ji = 1, kjpindex
+                   veget_max(ji,1) = un  - SUM(frac_nobio(ji,:))
+                ENDDO
+
+             END IF ! agriculture is considered in the DGVM
+
+          END IF  ! end ok_dgvm
+     
+       END IF ! No restart was found
+
+    END IF ! impose vegetation fractions
+
+    !! 5.3 Initialize vegetation characteristics
+    !  If a restart file has been read, the vegetation characteristics are
+    !  already known. Note that reading the vegetation characteristics is 
+    !  only controlled by the read_lai flag.The user could still decide to 
+    !  use all information from the restart but overwrite circ_class_biomass 
+    !  and circ_class_n. If no restart file has been read this far, sechiba 
+    !  will need a description of the canopy to be able to run. This description 
+    !  should come from a so called lai map (note that the map no longer contains
+    !  lai but contains information on the biomass and number of individuals)
+
+    !+++CHECK+++
+    IF (read_lai)THEN
+
+       ! Initialize
+       found_restart = .TRUE.
+
+       ! Read "canopy structure map". This map should be based on
+       ! a previous simulation with ORCHIDEE.
+       ! The difference with a normal restart is that it should read
+       ! circ_class_biomass and circ_class_n for 12 months.
+       var_name= 'cc_biomass_monthly'
+       CALL ioconf_setatt_p('UNITS', 'g C(N) m-2 tree-1')
+       CALL ioconf_setatt_p('LONG_NAME','Monthly values for biomass &
+            & components per circumference class')
+       DO iele = 1,nelements
+          DO imonth = 1,nmonth
+10           FORMAT(I2)
+             WRITE (month_str,10) imonth
+             var_name = 'cc_biomass_m_'//TRIM(month_str)//'_'//TRIM(element_str(iele))
+             CALL restget_p (rest_id, var_name, nbp_glo, nvm, ncirc, nparts, kjit, .TRUE., &
+                  cc_biomass_m(:,:,:,:,imonth,iele),"gather", nbp_glo, index_g)
+             IF ( ALL( cc_biomass_m(:,:,:,:,imonth,iele) .EQ. val_exp ) ) found_restart=.FALSE.
+          ENDDO
+       ENDDO
+
+       var_name = 'cc_n_m'
+       CALL ioconf_setatt_p('UNITS', 'tree-1 m-2')
+       CALL ioconf_setatt_p('LONG_NAME','trees per m2 for each circ class')
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, ncirc, 12, kjit, .TRUE. , &
+            cc_n_m, "gather", nbp_glo, index_g)
+       IF ( ALL( cc_n_m(:,:,:,:) .EQ. val_exp) ) found_restart=.FALSE.
+
+       IF ( .NOT. found_restart ) THEN
+
+          WRITE(numout,*) 'AHAAA: inside read_lai - did not find a restart'
+          ! cc_biomass_m and/or cc_n_m were not found in the restart file try 
+          ! to find and read a dedicated file that contains monthly values
+          ! for these variables
+          !#286
+          !+++TEMP+++
+          circ_class_biomass(:,:,:,:,:) = zero
+          circ_class_n(:,:,:) = zero
+          circ_class_biomass(1,6,1,:,icarbon) = 3*(/64.1790961402884, 1219.15235836900, 564.11952303, &
+               712.783132227959, 417.796173293409, 122.105778809076, 20.5181600482659, &
+               337.744066746780, 46.6473441173028/)     
+          circ_class_biomass(1,6,1,:,initrogen) = 3*(/5.38391872316575,14.5306615478275, 6.32728500214539, &
+               6.73356880989017, 3.63140992343535, 8.80379728708368, 0.909221528487578, &     
+               4.255487191806592E-004,  6.783452513144551E-003/)
+          circ_class_biomass(1,6,2,:,icarbon) =  3*(/285.559552359068, 8632.15052183103, 3862.94977896271, &
+               4440.95806491165, 2462.91756260235, 543.299510808887, 20.5181600482660, &     
+               337.744066746985, 99.9253437952986/)     
+          circ_class_biomass(1,6,2,:,initrogen) = 3*(/10.8985571313903, 36.6657154882537, 15.9658547505304, &
+               16.9910445846784, 9.16326091799929, 17.8213477283047, 3.105548985182576E-003, &
+               4.255487191808893E-004, 1.603616996966766E-002/)
+          circ_class_biomass(1,6,3,:,icarbon) =  3*(/1358.39825416204, 66727.3342051582, 28610.5603591189, &
+               28941.8798532254, 15160.4663937242, 2584.45953172628, 20.5181600482660, &
+               337.744066746983, 180.177367238784/)     
+          circ_class_biomass(1,6,3,:,initrogen) = 3*(/18.7135366977149, 74.2989491440166, 32.3530091900281, &
+               34.4304410998095, 18.5683177833507, 30.6004217526930, 1.039620165307951E-005, &
+               4.255487191808977E-004, 5.568363409712271E-002/)
+
+          circ_class_n(1,6,:) = (/0.373684875218478, 0.124561625072826, 4.152054169094205E-002/)
+
+          ! Read LAI map and interpolate
+!!$          ! CHECK - Should be activated again
+!!$          CALL slowproc_interlai (kjpindex, lalo, resolution,  neighbours, &
+!!$               contfrac, cc_biomass_m, circ_class_biomass, cc_n_m, &
+!!$               circ_class_n)
+          !++++++++++
+
+!!$       ! Read lai map
+!!$       lai(: ,1) = zero
+!!$       ! Loop over PFTs
+!!$       DO jv = 2,nvm
+!!$
+!!$          SELECT CASE (type_of_lai(jv))
+!!$             
+!!$          CASE ("mean ")           
+!!$             ! Force MAXVAL of laimap on lai on this PFT
+!!$             DO ji = 1,kjpindex
+!!$                lai(ji,jv) = MAXVAL(laimap(ji,jv,:))
+!!$             ENDDO
+!!$             
+!!$          CASE ("inter")          
+!!$             ! Do the interpolation between laimax and laimin
+!!$             IF (mm .EQ. 1 ) THEN
+!!$                ! If January
+!!$                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 December
+!!$                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
+!!$                ! All other months
+!!$                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 ! Which months
+!!$             
+!!$          CASE default             
+!!$             ! Problem - not clear how to interpolate
+!!$             WRITE (numout,*) 'This kind of lai choice is not possible. '// &
+!!$                  ' We stop with type_of_lai ',jv,' = ', type_of_lai(jv) 
+!!$             CALL ipslerr_p(3,'slowproc_canopy',&
+!!$                  'Bad value for type_of_lai','read_lai=true','')
+!!$             
+!!$          END SELECT ! type_of_lai
+!!$          
+!!$       ENDDO
+
+       ENDIF ! read_lai
+
+    ENDIF
+    !+++++++++++
+    
+    !  If no restart was found, the model will need to make up its assimilation
+    !  parameters to calculate photosynthesis and transpiration. Note that
+    !  circ_class_biomass should be available either through a restart file,
+    !  or an lai map (that no longer contains lai but contains biomass and
+    !  and the number of individuals.
+    IF ( .NOT. found_restart .AND. read_lai ) THEN
+
+       ! Initialize the variables revelant for the assimilation parameters
+       DO jv = 1, nvm
+          assim_param(:,jv,ivcmax) = vcmax_fix(jv)
+          assim_param(:,jv,inue) = nue_opt(jv)
+          assim_param(:,jv,ileafN) = SUM( &
+               circ_class_biomass(:,jv,:,ileaf,initrogen) * &
+               circ_class_n(:,jv,:),2 )
+       ENDDO
+
+    ENDIF
+ 
+    ! None of the above options was used. It looks like the user wants the model
+    ! to start from scratch, the canopy structure will be initialized with zeros. 
+    ! setvar checks whether the restart was found. If the user wants to read the canopy 
+    ! structure from a map, these values will get overwritten later on in this routine 
+    CALL setvar_p (circ_class_biomass, val_exp, 'CIRC_CLASS_BIOMASS', zero)
+    CALL setvar_p (circ_class_n, val_exp, 'CIRC_CLASS_N',zero)
+    CALL setvar_p (frac_age, val_exp, 'FRAC_AGE',zero)
+    CALL setvar_p (assim_param, val_exp, 'ASSIM_PARAM', zero)
+   
+    !+++CHECK+++
+    ! Special case for DGVM and restart file. 
+    ! JG why is specific treatement needed for DGVM ? Is not the veget_max variable 
+    ! correct in the end of last run ?
+    IF (found_restart) THEN
+       ! WITH restarts for vegetation and DGVM and NO AGRICULTURE
+       IF ( ok_dgvm  .AND. .NOT. agriculture ) THEN
+          ! Calculate the total fraction of crops for each point
+          frac_crop_tot(:) = zero
+          DO jv = 2, nvm  
+             IF ( .NOT. natural (jv))  THEN
+                DO ji = 1, kjpindex
+                   frac_crop_tot(ji) = frac_crop_tot(ji) + veget_max(ji,jv)
+                ENDDO
+             ENDIF
+          ENDDO
+          
+          ! Add the crops fraction to the bare soil fraction
+          DO ji = 1, kjpindex
+             veget_max(ji,1) = veget_max(ji,1) + frac_crop_tot(ji)
+          ENDDO
+          
+          ! Set the crops fraction to zero
+          DO jv = 2, nvm                  
+             IF ( .NOT. natural (jv))  THEN
+                veget_max(:,jv) = zero
+             ENDIF
+          ENDDO
+       ENDIF
+    ENDIF ! end found_restart
+    !+++++++++++
+
+
+!!$    !+++ CHECK+++
+!!$    ! Why recalculating if these variables were just calculate in slowproc_veget/canopy?
+!!$    !! 7. Some calculations always done, with and without restart files
+!!$    !  The variables veget, veget_max and frac_nobio were all read from 
+!!$    !  restart file or initialized above. Calculate now totfrac_nobio and
+!!$    !  soiltiles using these variables.
+!!$    
+!!$    ! Calculate totfrac_nobio
+!!$    totfrac_nobio(:) = zero
+!!$    DO jv = 1, nnobio
+!!$       totfrac_nobio(:) = totfrac_nobio(:) + frac_nobio(:,jv)
+!!$    ENDDO
+!!$    
+!!$    ! Calculate soiltile. This variable do not need to be in the restart file.
+!!$    ! The sum of all soiltiles makes one, and corresponds to the bio fraction
+!!$    ! of the grid cell (called vegtot in hydrol)
+!!$    soiltile(:,:) = zero
+!!$    DO jv = 1, nvm
+!!$       jst = pref_soil_veg(jv)
+!!$       DO ji = 1, kjpindex
+!!$          soiltile(ji,jst) = soiltile(ji,jst) + veget_max(ji,jv)
+!!$       ENDDO
+!!$    ENDDO
+!!$    DO ji = 1, kjpindex 
+!!$       IF (totfrac_nobio(ji) .LT. (1-min_sechiba)) THEN
+!!$          soiltile(ji,:)=soiltile(ji,:)/(1-totfrac_nobio(ji))
+!!$       ENDIF
+!!$    ENDDO
+!!$    !+++++++++++++
+  
+!!$    !! 8. Verify consistency between different fractions.
+!!$    CALL slowproc_checkveget(kjpindex, frac_nobio, veget_max, &
+!!$         veget, tot_bare_soil, soiltile)
+
+    !! 9. Initialize different sources of nitrogen
+    IF(ok_ncycle .AND. (.NOT. impose_CN)) THEN
+       IF((.NOT. impose_ninput_dep) .OR. (.NOT. impose_ninput_fert) .OR. (.NOT. impose_ninput_bnf)) THEN
+          var_name= 'Ninput_year'
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Last year get in N input file.')
+          IF (is_root_prc) THEN
+             CALL restget (rest_id, var_name, 1       , 1  , 1, kjit, .TRUE., tmp_ninput_year)
+             !
+             IF (tmp_ninput_year(1) == val_exp) THEN
+                Ninput_year=Ninput_year_orig
+             ELSE
+                IF (Ninput_reinit) THEN
+                   Ninput_year=Ninput_year_orig
+                ELSE
+                   Ninput_year=INT(tmp_ninput_year(1))
+                ENDIF
+             ENDIF
+          ENDIF
+          CALL bcast(Ninput_year)
+       
+          !
+          !Config Key   = NINPUT_UPDATE
+          !Config Desc  = Update N input frequency
+          !Config If    = ok_ncycle .AND. (.NOT. impose_cn) .AND. .NOT. impsoilt
+          !Config Def   = 0Y
+          !Config Help  = The veget datas will be update each this time step.
+          !Config Units = [years]
+          !
+          ninput_update=0
+          WRITE(ninput_str,'(a)') '0Y'
+          CALL getin_p('NINPUT_UPDATE', ninput_str)
+          l=INDEX(TRIM(ninput_str),'Y')
+          READ(ninput_str(1:(l-1)),"(I2.2)") ninput_update
+          WRITE(numout,*) "Update frequency for N inputs in years :",ninput_update
+       ENDIF
+
+
+       IF(.NOT. impose_Ninput_dep) THEN
+          FOUND_RESTART=.TRUE.
+          DO im = 1,12
+             WRITE (part_str,'(I2)') im
+             IF ( im < 10 ) part_str(1:1) = '0'
+             var_name = 'Nammonium_'//part_str(1:LEN_TRIM(part_str))
+             CALL ioconf_setatt_p('UNITS', 'kgN m-2 yr-1')
+             CALL ioconf_setatt_p('LONG_NAME','N ammonium deposition')
+             CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., N_input(:,:,im,iammonium), &
+                  "gather", nbp_glo, index_g)
+             IF ( ALL( N_input(:,:,im,iammonium) .EQ. val_exp ) ) FOUND_RESTART=.FALSE.
+          ENDDO
+
+          DO im = 1,12
+             WRITE (part_str,'(I2)') im
+             IF ( im < 10 ) part_str(1:1) = '0'
+             var_name = 'Nnitrate_'//part_str(1:LEN_TRIM(part_str))
+             CALL ioconf_setatt_p('UNITS', 'kgN m-2 yr-1')
+             CALL ioconf_setatt_p('LONG_NAME','N nitrate deposition')
+             CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., N_input(:,:,im,initrate), &
+                  "gather", nbp_glo, index_g)
+             IF ( ALL( N_input(:,:,im,initrate) .EQ. val_exp ) ) FOUND_RESTART=.FALSE.
+          ENDDO
+
+          IF(.NOT. FOUND_RESTART) THEN
+             ! Read the new N inputs from file. Output is Ninput and frac_nobio_nextyear.
+             fieldname='Nammonium'
+             CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                  N_input(:,:,:,iammonium), Ninput_year, veget_max)
+             fieldname='Nnitrate'
+             CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                  N_input(:,:,:,initrate), Ninput_year, veget_max)
+             ! Conversion from mgN/m2/yr to gN/m2/day
+             N_input(:,:,:,iammonium)=N_input(:,:,:,iammonium)/1000/365
+             N_input(:,:,:,initrate)=N_input(:,:,:,initrate)/1000/365
+          ENDIF
+       ELSE
+             !Config Key   = NAMMONIUM
+             !Config Desc  = Amount of N ammonium deposition 
+             !Config Def   = 0
+             !Config If    = ok_ncycle .AND. (.NOT. impose_cn)
+             !Config Help  = 
+             !Config Units = [gN m-2 d-1] 
+             nammonium=zero
+             CALL getin_p('NAMMONIUM',nammonium)       
+             n_input(:,:,:,iammonium)=nammonium
+             !Config Key   = NNITRATE
+             !Config Desc  = Amount of N nitrate deposition 
+             !Config Def   = 0
+             !Config If    = ok_ncycle .AND. (.NOT. impose_cn)
+             !Config Help  = 
+             !Config Units = [gN m-2 d-1] 
+             nnitrate=zero
+             CALL getin_p ('NNITRATE',nnitrate)       
+             n_input(:,:,:,initrate)=nnitrate
+       ENDIF
+
+
+       IF(.NOT. impose_Ninput_fert) THEN
+          FOUND_RESTART=.TRUE.
+
+          DO im = 1,12
+             WRITE (part_str,'(I2)') im
+             IF ( im < 10 ) part_str(1:1) = '0'
+             var_name = 'Nfert_'//part_str(1:LEN_TRIM(part_str))
+             CALL ioconf_setatt_p('UNITS', 'kgN m-2 yr-1')
+             CALL ioconf_setatt_p('LONG_NAME','N fertilizer')
+             CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., N_input(:,:,im,ifert), "gather", nbp_glo, index_g)
+             IF ( ALL( N_input(:,:,im,ifert) .EQ. val_exp ) ) FOUND_RESTART=.FALSE.
+          ENDDO
+
+          IF(.NOT. FOUND_RESTART) THEN
+             ! Read the new N inputs from file. Output is Ninput and frac_nobio_nextyear.
+             fieldname='Nfert'
+             CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                  N_input_temp, Ninput_year, veget_max)
+             ! Conversion from gN/m2(cropland)/yr to gN/m2/day ! PALMI
+             N_input(:,:,:,ifert) = N_input_temp(:,:,:)/365.
+
+             fieldname='Nfert_cropland'
+             CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                  N_input_temp, Ninput_year, veget_max)
+             ! Conversion from gN/m2(cropland)/yr to gN/m2/day ! PALMI
+             N_input(:,:,:,ifert) = N_input(:,:,:,ifert)+ N_input_temp(:,:,:)/365.
+             
+             fieldname='Nfert_pasture'
+             CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                  N_input_temp, Ninput_year, veget_max)
+             ! Conversion from gN/m2(pasture)/yr to gN/m2/day ! PALMI
+             N_input(:,:,:,ifert) = N_input(:,:,:,ifert)+ N_input_temp(:,:,:)/365.
+          ENDIF
+       ELSE
+             !Config Key   = NFERT
+             !Config Desc  = Amount of N fertiliser 
+             !Config Def   = 0
+             !Config If    = ok_ncycle .AND. (.NOT. impose_cn)
+             !Config Help  = 
+             !Config Units = [gN m-2 d-1] 
+             nfert=zero
+             CALL getin_p ('NFERT',nfert)       
+             n_input(:,:,:,ifert)=nfert
+       ENDIF
+
+
+       IF(.NOT. impose_Ninput_manure) THEN
+          FOUND_RESTART=.TRUE.
+
+          DO im = 1,12
+             WRITE (part_str,'(I2)') im
+             IF ( im < 10 ) part_str(1:1) = '0'
+             var_name = 'Nmanure_'//part_str(1:LEN_TRIM(part_str))
+             CALL ioconf_setatt_p('UNITS', 'kgN m-2 yr-1')
+             CALL ioconf_setatt_p('LONG_NAME','N manure')
+             CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., N_input(:,:,im,imanure), "gather", nbp_glo, index_g)
+             IF ( ALL( N_input(:,:,im,imanure) .EQ. val_exp ) ) FOUND_RESTART=.FALSE.
+          ENDDO
+
+
+
+          IF(.NOT. FOUND_RESTART) THEN
+             ! Read the new N inputs from file. Output is Ninput and frac_nobio_nextyear.
+             fieldname='Nmanure'
+             CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                  N_input_temp, Ninput_year, veget_max)
+             N_input(:,:,:,imanure) = N_input_temp(:,:,:)/1000./365.
+
+
+             fieldname='Nmanure_cropland'
+             CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                  N_input_temp, Ninput_year, veget_max)
+             ! Conversion from gN/m2(cropland)/yr to gN/m2/day ! PALMI
+             N_input(:,:,:,imanure) = N_input(:,:,:,imanure)+N_input_temp(:,:,:)/365.
+                
+             fieldname='Nmanure_pasture'
+             CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                  N_input_temp, Ninput_year, veget_max)
+             ! Conversion from gN/m2(cropland)/yr to gN/m2/day ! PALMI
+             N_input(:,:,:,imanure) = N_input(:,:,:,imanure)+N_input_temp(:,:,:)/365.
+          ENDIF
+       ELSE
+          !Config Key   = NMANURE
+          !Config Desc  = Amount of N manure 
+          !Config Def   = 0
+          !Config If    = ok_ncycle .AND. (.NOT. impose_cn)
+          !Config Help  = 
+          !Config Units = [gN m-2 d-1] 
+          nmanure=zero
+          CALL getin_p ('NMANURE',nmanure)       
+          n_input(:,:,:,imanure)=nmanure
+       ENDIF
+
+
+
+       IF(.NOT. impose_Ninput_bnf) THEN
+          FOUND_RESTART=.TRUE.
+          DO im = 1,12
+             WRITE (part_str,'(I2)') im
+             IF ( im < 10 ) part_str(1:1) = '0'
+             var_name = 'Nbnf_'//part_str(1:LEN_TRIM(part_str))
+             CALL ioconf_setatt_p('UNITS', 'kgN m-2 yr-1')
+             CALL ioconf_setatt_p('LONG_NAME','N bilogical fixation')
+             CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., N_input(:,:,im,ibnf), "gather", nbp_glo, index_g)
+             IF ( ALL( N_input(:,:,im,ibnf) .EQ. val_exp ) ) FOUND_RESTART=.FALSE.
+          ENDDO
+          
+          IF(.NOT. FOUND_RESTART) THEN
+             fieldname='Nbnf'
+             CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
+                  N_input(:,:,:,ibnf), Ninput_year, veget_max)
+
+             N_input(:,:,:,ibnf) = N_input(:,:,:,ibnf)/1000./365.
+             ! Conversion from kgN/km2/yr to gN/m2/day ! PALMI
+          ENDIF
+       ELSE
+          !Config Key   = NBNF
+          !Config Desc  = Amount of N biological fixation 
+          !Config Def   = 0
+          !Config If    = ok_ncycle .AND. (.NOT. impose_cn)
+          !Config Help  = 
+          !Config Units = [gN m-2 d-1] 
+          nbnf=zero
+          CALL getin_p ('NBNF',nbnf)       
+          n_input(:,:,:,ibnf)=nbnf
+       ENDIF
+    ELSE
+       n_input(:,:,:,:)=zero
+    ENDIF
+    
+    IF (printlev_loc>=3) WRITE (numout,*) ' slowproc_init done '
+    
+  END SUBROUTINE slowproc_init
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_clear
+!!
+!>\BRIEF          Clear all variables related to slowproc and stomate modules  
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_clear 
+
+  ! 1 clear all the variables defined as common for the routines in slowproc 
+
+    IF (ALLOCATED (clayfraction)) DEALLOCATE (clayfraction)
+    IF (ALLOCATED (sandfraction)) DEALLOCATE (sandfraction)
+    IF (ALLOCATED (siltfraction)) DEALLOCATE (siltfraction)
+    IF (ALLOCATED (bulk)) DEALLOCATE (bulk)
+    IF (ALLOCATED (soil_ph)) DEALLOCATE (soil_ph)
+    IF (ALLOCATED (cc_biomass_m)) DEALLOCATE (cc_biomass_m)
+    IF (ALLOCATED (cc_n_m)) DEALLOCATE (cc_n_m)
+    IF (ALLOCATED (veget_max_new)) DEALLOCATE (veget_max_new)
+    IF (ALLOCATED (frac_nobio_new)) DEALLOCATE (frac_nobio_new)
+    IF (ALLOCATED (soilclass_default)) DEALLOCATE (soilclass_default)
+
+ ! 2. Clear all the variables in stomate 
+
+    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, ::height  
+!!$!!
+!!$!! REFERENCE(S) : None
+!!$!!
+!!$!! FLOWCHART    : None
+!!$!! \n
+!!$!_ ================================================================================================================================
+!!$
+!!$  SUBROUTINE slowproc_derivvar (kjpindex, veget, circ_class_biomass,circ_class_n, &
+!!$       qsintmax, deadleaf_cover, height, temp_growth)
+!!$
+!!$    !! INTERFACE DESCRIPTION
+!!$
+!!$    !! 0.1 Input scalar and fields 
+!!$    INTEGER(i_std),INTENT (in)                                  :: kjpindex       !! Domain size - terrestrial pixels only
+!!$    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)           :: veget          !! Fraction of pixel covered by PFT in the mesh (unitless)
+!!$    !! 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 (:,:,:,:,:), INTENT (inout)           :: circ_class_biomass
+!!$    REAL(r_std),DIMENSION (:,:,:), INTENT (inout)               :: circ_class_n
+!!$    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)          :: height         !! height of the vegetation or surface in general ??? (m)
+!!$    REAL(r_std),DIMENSION (kjpindex), INTENT (out)              :: temp_growth    !! growth temperature (°C)  
+!!$    !
+!!$    !! 0.3 Local declaration
+!!$    REAL(r_std),DIMENSION (kjpindex,nvm)                        :: lai            !! PFT leaf area index (m^{2} m^{-2})
+!!$    INTEGER(i_std)                                              :: ji, jv         !! Local indices
+!!$!_ ================================================================================================================================
+!!$
+!!$    !! 1. Intialize the fraction of soil covered by dead leaves 
+!!$    deadleaf_cover(:) = zero
+!!$
+!!$    !! 2. Initialize vegetation height and LAI per PFT
+!!$    height(:,1) = zero
+!!$    lai(:,ibare_sechiba) = zero
+!!$    DO jv = 1, nvm
+!!$       DO ji = 1, kjpindex
+!!$          height(:,jv) = wood_to_qmheight(circ_class_biomass(ji,jv,:,:,icarbon, &
+!!$               circ_class_n(ji,jv,:),jv)
+!!$          lai(ji,jv) = cc_to_lai(circ_class_biomass(ji,jv,:,ileaf,icarbon),&
+!!$               circ_class_n(ji,jv,:),jv)
+!!$       ENDDO
+!!$    ENDDO
+!!$    
+!!$    !! 3. Initialize the maximum water on vegetation for interception
+!!$    qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:) 
+!!$    qsintmax(:,1) = zero
+!!$
+!!$    !! 4. Initialize the growth temperature
+!!$    temp_growth(:)=25.
+!!$
+!!$  END SUBROUTINE slowproc_derivvar
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_mean
+!!
+!>\BRIEF          Accumulates field_in over a period of dt_tot.
+!! Has to be called at every time step (dt). 
+!! Mean value is calculated if ldmean=.TRUE.
+!! field_mean must be initialized outside of this routine! 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!! (1) AcumAcuumlm 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::field_main
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_mean (kjpindex, n_dim2, dt_tot, dt, ldmean, field_in, field_mean)
+
+    !
+    !! 0 declarations
+
+    !! 0.1 input scalar and variables 
+    INTEGER(i_std), INTENT(in)                           :: kjpindex     !! 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(kjpindex,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(kjpindex,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 (kjpindex, n_dim2, dt, tau, field_inst, field_long)
+
+    !
+    ! 0 declarations
+    !
+
+    ! 0.1 input scalar and fields 
+
+    INTEGER(i_std), INTENT(in)                                 :: kjpindex        !! 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(kjpindex,n_dim2), INTENT(in)            :: field_inst  !! Instantaneous field 
+
+
+    ! 0.2 modified field
+
+    ! Long-term field
+    REAL(r_std), DIMENSION(kjpindex,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_canopy
+!!
+!>\BRIEF         Convert circ_class_biomass and circ_class_n in a 3D canopy used
+!!               in the albedo, transpiration and energy budget calculations   
+!!
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lai_per_level, ::h_array_out, ::z_array_out, 
+!!                          ::max_height_store, ::laieff_fit, ::frac_age
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_canopy(kjpindex, circ_class_biomass, circ_class_n, &
+       veget_max, lai_per_level, h_array_out, z_array_out, &
+       max_height_store, laieff_fit, frac_age)
+    !
+    ! 0. Declarations
+    !
+    !! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                             :: kjpindex             !! Domain size - terrestrial pixels only
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)          :: circ_class_biomass   !! Biomass of the different components per
+                                                                                   !! PFT and circ class (g C(N) tree-1 y-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)              :: circ_class_n         !! Number of trees per circ_class (trees m-2)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)       :: veget_max            !! Maximum fraction of vegetation type including
+                                                                                   !! none biological fraction (unitless)
+
+    !! 0.2 Modified variables 
+
+    !! 0.3 Output
+    REAL(r_std), DIMENSION(:,:,:), INTENT(out)             :: lai_per_level        !! This is the LAI per vertical level
+                                                                                   !! @tex $(m^{2} m^{-2})$   
+    REAL(r_std),DIMENSION(kjpindex,nvm,ncirc,nlevels_tot), INTENT(out) &
+                                                           :: z_array_out          !! Height above soil of the Pgap points.
+                                                                                   !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm,ncirc,nlevels_tot), INTENT(out) &
+                                                           :: h_array_out          !! An output of h_array, to use in sechiba
+    REAL(r_std), DIMENSION(kjpindex, nvm), INTENT(out)     :: max_height_store     !! ???
+    TYPE(laieff_type),DIMENSION (:,:,:),INTENT(out)        :: laieff_fit           !! Fitted parameters for the effective LAI
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(out) &
+                                                           :: frac_age             !! leaf age distribution calculated in stomate 
+    
+    !! 0.4 Local
+    REAL(r_std), DIMENSION(kjpindex,nvm,nlevels_tot)       :: z_level_photo        !! The height of the levels that we will
+                                                                                   !! use to calculate the effective LAI for
+                                                                                   !! the albedo routines and photosynthesis.
+                                                                                   !! @tex $(m)$ @endtex
+    
+    INTEGER(i_std)                                         :: ji, jv               !! Indices    
+
+!_ ================================================================================================================================
+
+    !! 1. Calculate canopy structure
+    ! Compute the height of the photosynthesis levels given the height 
+    ! of the energy levels and the vegetation on the grid square. The 
+    ! hightest levels will be a function of the height of the vegetation 
+    ! so that we don't waste computational time on empty levels.
+    CALL calculate_z_level_photo(kjpindex, circ_class_biomass, circ_class_n, &
+         z_level_photo)
+      
+    ! Finding the true LAI per level is different from finding the
+    ! effective LAI per level, so we'll do that here.  This only
+    ! changes once every day so hopefully it is not too expensive.
+    ! It will eventually be needed by the energy budget.  It is
+    ! also needed by effective_lai for grasses and crops.
+    CALL find_lai_per_level(kjpindex, z_level_photo, &
+         circ_class_biomass, circ_class_n, lai_per_level, &
+         max_height_store)
+      
+    ! Now we actually find the effective LAI and fit the function 
+    ! we'll use later on. Note that this fir allows us to calculate 
+    ! the effective lai once per day. This should not be repeated
+    ! every half hour!
+    CALL fitting_laieff(kjpindex, z_level_photo, circ_class_biomass, & 
+         circ_class_n, veget_max, lai_per_level, laieff_fit, &
+         h_array_out, z_array_out)
+
+    !! 2. Calculate frac_age
+    ! The variable frac_age is only used when BVOCs are calculated.
+    ! slowproc_canopy should only be used when only sechiba is used.
+    frac_age(:,:,1) = un
+    frac_age(:,:,2) = zero
+    frac_age(:,:,3) = zero
+    frac_age(:,:,4) = zero
+
+    WRITE(numout,*) 'Leaving slowproc_canopy'
+
+  END SUBROUTINE slowproc_canopy
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_veget
+!!
+!>\BRIEF        Set small fractions to zero and normalize to keep the sum equal 1. Calucate veget and soiltile.
+!!
+!! DESCRIPTION  : Set small fractions to zero and normalize to keep the sum equal 1. Calucate veget and soiltile.
+!! (1) Set veget_max and frac_nobio for fraction smaller than min_vegfrac.
+!! (2) Reset some variables in stomate for small fractions
+!! (3) Calculate veget
+!! (5) Calculate totfrac_nobio
+!! (6) Calculate soiltile
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: frac_nobio, totfrac_nobio, veget_max, veget, soiltile
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_veget (kjpindex, lai_per_level, circ_class_biomass, &
+       circ_class_n, frac_nobio, totfrac_nobio, &
+       veget_max, veget, soiltile, tot_bare_soil)
+    
+    !! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                             :: kjpindex             !! Domain size - terrestrial pixels only
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)              :: lai_per_level        !! This is the LAI per vertical level
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)          :: circ_class_biomass   !! Biomass of the different components per
+                                                                                   !! PFT and circ class (g C(N) tree-1 y-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)              :: circ_class_n         !! Number of trees per circ_class (trees m-2)                                                                                                                             !! @tex $(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)
+    REAL(r_std),DIMENSION(:), INTENT (inout)               :: tot_bare_soil        !! Total evaporating bare soil fraction 
+
+    !! 0.3 Output variables 
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)      :: veget                !! Fraction of pixel covered by PFT in the mesh (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: totfrac_nobio
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)    :: soiltile             !! Fraction of each soil tile within vegtot (0-1, unitless)   
+
+    !! 0.4 Local scalar and varaiables 
+    REAL(r_std), DIMENSION(kjpindex)                       :: fracsum              !! Sum of both fracnobio and veget_max
+    INTEGER(i_std)                                         :: nbad                 !! Number of problems
+    INTEGER(i_std)                                         :: ilev, ji, jv         !! Indices
+    INTEGER(i_std)                                         :: jst, ivm             !! Indices
+    REAL(r_std), DIMENSION(kjpindex,nvm,1)                 :: z_level_loc          !! The physical height of the levels used in the
+                                                                                   !! effective LAI routines.  Will be equal to zero
+                                                                                   !! everywhere in this routine.
+                                                                                   !! @tex $(m)$
+    REAL(r_std), DIMENSION(1,kjpindex,nvm)                 :: laieff_temp          !! The effective LAI.  Not used here, just need it as an
+                                                                                   !! argument in this routine.
+    REAL(r_std), DIMENSION(kjpindex,nvm,1)                 :: lai_per_level_temp   !! The total LAI found for the PFT and grid square.
+    REAL(r_std), DIMENSION(kjpindex)                       :: cosang               !! The cosine of the solar zenith angle.
+    REAL(r_std),DIMENSION(kjpindex,nvm,nlevels_tot)        :: z_array4             !! Same as z_array, but one less dimension.
+                                                                                   !! @tex $(m)$ @endtex (local because the call to
+                                                                                   !! effective_lai requires it) 
+    REAL(r_std),DIMENSION(kjpindex,nvm,ncirc,nlevels_tot)  :: h_array_out          !! An output of h_array, to use in sechiba
+    REAL(r_std), DIMENSION(kjpindex,nvm,nlevels_tot)       :: z_array2_out         !! Same as z_array, but one less dimension.
+                                                                                   !! @tex $(m)$ @endtex (local because the 
+                                                                                   !! call to effective_lai requires it)]
+    REAL(r_std),DIMENSION(kjpindex,nvm,ncirc,nlevels_tot)  :: z_array_out          !! Height above soil of the Pgap points.
+                                                                                   !! @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,1)                 :: Pgap                 !! The transmission probability of light through to
+                                                                                   !! canopy to the soil. (unitless, 0-1)           
+ 
+!_ ================================================================================================================================
+
+    IF(printlev_loc>=4) WRITE(numout,*) 'Entering slowproc_veget'
+
+    !! 1. Truncate fractions of frac_nobio and veget_max smaller than min_vegfrac.
+    !  If frac_nobio and/or veget_max values are too small they are truncated
+    !  and renormalized to make sure the sum adds up to 1.
+    DO ji = 1, kjpindex
+       IF ( SUM(frac_nobio(ji,:)) .LT. min_vegfrac ) THEN
+          frac_nobio(ji,:) = zero
+       ENDIF
+
+       IF (.NOT. ok_dgvm) THEN
+          ! Truncate small values. This helps to speed up the model
+          DO jv = 1, nvm
+             IF ( veget_max(ji,jv) .LT. min_vegfrac ) THEN
+                veget_max(ji,jv) = zero
+             ENDIF
+          ENDDO
+       ELSE
+          ! If the DGVM is used small vegetation fractions are left
+          ! untouched because they may represent an emerging PFT
+       END IF
+
+       ! Calculate total
+       fracsum(ji) = SUM(frac_nobio(ji,:))+SUM(veget_max(ji,:))
+    ENDDO
+    
+    !! 2. Stop if there an error above 0.01%
+    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,:)) )
+             
+             IF(hack_lcc)THEN
+                WRITE(numout,*) 'ERROR: Not stopping, but should stop here in place 123!'
+                frac_nobio(ji,:)=frac_nobio(ji,:)/fracsum(ji)
+                veget_max(ji,:)=veget_max(ji,:)/fracsum(ji)
+                fracsum(ji)=un
+             ELSE   
+                CALL ipslerr(3, 'slowproc.f90','slowproc_veget','','')
+             ENDIF
+             
+          ENDIF
+          
+       ENDDO
+       
+    ENDIF ! nbad .GT. 0
+    
+    !! 3. Correct where the problem is surely precision-related
+    nbad = COUNT( ABS(fracsum(:)-un) .GT. EPSILON(un) )
+    
+    IF ( nbad .GT. 0 ) THEN
+
+       ! Debug
+       IF (printlev_loc>=4) THEN
+          WRITE(numout,*) 'WARNING! scaling frac_nobio and veget_max at', &
+               nbad, ' points'
+       ENDIF
+       !-
+
+       ! Rescale frac_nobio and veget_max
+       DO ji = 1, kjpindex
+          IF ( ABS(fracsum(ji)-un) .GT. EPSILON(un) ) THEN
+             frac_nobio(ji,:) = frac_nobio(ji,:)/fracsum(ji)
+             veget_max(ji,:) = veget_max(ji,:)/fracsum(ji)
+          ENDIF
+       ENDDO
+       
+    ELSE
+
+       ! The missing fraction is so small that
+       ! nothing should be done
+
+    ENDIF
+
+    !! 4. Calculate veget making use of the canopy structure
+    ! Determine the coverage based on stand structure and LAI. There
+    ! should always be trees in the model even if we only run sechiba.
+    ! The veget should be related to the effective LAI if you are looking
+    ! straight down on the canopy. So let us use the same routine
+    ! that we use for the effective LAI but put the solar angle equal to
+    ! the zenith, zero degrees. We only need one level at the soil, 
+    ! which makes the calculation faster. Here we take advantage of an 
+    ! optional argument which returns the transmission probability 
+    ! through the canopy. The transmission  probability will be between 
+    ! zero and one. This takes into account the canopy structure as well 
+    ! as the LAI thickness. We set our z_level to be equal to zero 
+    ! since we are interested in how  much reaches the ground.
+    veget(:,:) = zero
+    z_level_loc(:,:,:)=zero
+    cosang(:)=un
+    lai_per_level_temp(:,:,:)=zero
+    lai_per_level_temp(:,:,1)=SUM(lai_per_level(:,:,:),3)
+    CALL effective_lai(kjpindex, 1, z_level_loc,  circ_class_biomass, &
+         circ_class_n, veget_max, cosang, lai_per_level_temp, &
+         laieff_temp, h_array_out=h_array_out,z_array_out=z_array_out,&
+            z_array2_out=z_array2_out, Pgap_out=Pgap)
+
+    ! Now convert the transmission probability (1, light makes it through
+    ! without hitting anything) to veget (1*veget_max, the canopy is
+    ! completely opaque).
+    DO ivm=1,nvm
+
+       ! We don't want to overwrite the bare soil value, since that
+       ! means something different than the other values.
+       IF(ivm == ibare_sechiba) THEN
+          ! Calculate veget
+          veget(:,ibare_sechiba)=veget_max(:,ibare_sechiba)
+       ELSE
+          veget(:,ivm)=veget_max(:,ivm)*(un-Pgap(:,ivm,1))
+       ENDIF
+
+    ENDDO
+
+    !! 6. Calculate totfrac_nobio, frac_bare and tot_bare_soil making use of veget 
+    IF (ok_bare_soil_new) THEN
+       
+       !+++CHECK+++
+       ! We no longer want to treat the gaps in the canopy as
+       ! bare soil. It needs to be tested what will happen with
+       ! the evaporation in the single-layer model. The multi-
+       ! layer energy budget should be able to correctly deal
+       ! with the gaps in the canopy.
+       tot_bare_soil(:) = veget_max(:,1)
+       
+       ! No bare soil in a PFT
+       frac_bare(:,:) = zero
+       
+       ! Overwrite the value for PFT 1. It is pure bare soil
+       frac_bare(:,1) = un
+       
+       ! Total frac nobio
+       totfrac_nobio(:) = SUM(frac_nobio(:,:),2)
+       !+++++++++++
+       
+    ELSE
+
+       ! Initialize
+       fracsum(:) = zero
+       tot_bare_soil(:) = veget_max(:,1)
+
+       ! Calculate bare soil fraction
+       DO ji = 1, kjpindex
+
+          ! Calculate frac_bare for PFT 1
+          IF( veget_max(ji,1) .GT. min_sechiba ) THEN
+             frac_bare(ji,1) = un
+          ELSE
+             frac_bare(ji,1) = zero
+          ENDIF
+
+          ! Total frac nobio
+          totfrac_nobio(ji) = SUM(frac_nobio(ji,:))
+          
+          DO jv = 2, nvm
+
+             ! Move the canopy gaps into the bare soil
+             ! fraction for this time step. Calculate
+             ! the total fraction of bare soil in the
+             ! grid
+             tot_bare_soil(ji) = tot_bare_soil(ji) + &
+                  (veget_max(ji,jv) - veget(ji,jv))
+             fracsum(ji) = fracsum(ji) + veget(ji,jv)
+
+             ! Calculate the frac_bare
+             IF( veget_max(ji,jv) .GT. min_sechiba ) THEN
+                frac_bare(ji,jv) = un - veget(ji,jv) / &
+                     veget_max(ji,jv)
+             ELSE
+                frac_bare(ji,jv) = zero
+             ENDIF
+          ENDDO
+
+          ! Consistency check
+          fracsum(ji) = fracsum(ji) + tot_bare_soil(ji) + SUM(frac_nobio(ji,:)) 
+          IF (fracsum(ji) .LT. 0.99999) THEN
+             WRITE(numout,*)' ATTENTION, in ji, fracsum LT 1: ', ji, fracsum(ji)
+             WRITE(numout,*)'  frac_nobio = ',SUM(frac_nobio(ji,:))
+             WRITE(numout,*)'  veget = ',veget(ji,:)
+             WRITE(numout,*)'  tot_bare_soil = ',tot_bare_soil(ji)
+          ENDIF
+       ENDDO
+       
+    ENDIF ! ok_bare_soil_new
+    
+    !! 7. Calculate soiltiles
+    !  Soiltiles are only used in hydrol, but we fix them in here 
+    !  because some time it might depend on a changing vegetation 
+    !  (but then some adaptation should be made to hydrol) and be 
+    !  also used in the other modules to perform separated energy 
+    !  balances. The sum of all soiltiles makes one, and corresponds 
+    !  to the bio fraction of the grid cell (called vegtot in hydrol)
+    soiltile(:,:) = zero
+    DO jv = 1, nvm
+       jst = pref_soil_veg(jv)
+       DO ji = 1, kjpindex
+          soiltile(ji,jst) = soiltile(ji,jst) + veget_max(ji,jv)
+       ENDDO
+    ENDDO
+    DO ji = 1, kjpindex 
+       IF (totfrac_nobio(ji) .LT. (1-min_sechiba)) THEN
+          soiltile(ji,:)=soiltile(ji,:)/(1.-totfrac_nobio(ji))
+       ENDIF
+    ENDDO
+
+  END SUBROUTINE slowproc_veget
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_interlai
+!!
+!>\BRIEF         Interpolate the LAI map to the grid of the model 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::cc_biomass_m, cc_n_m
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_interlai(nbpt, lalo, resolution, neighbours, contfrac, &
+       cc_biomass_m, circ_class_biomass, cc_n_m, circ_class_n)
+
+    USE interpweight
+
+    IMPLICIT NONE
+
+    !
+    !
+    !
+    !  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,NbNeighb) !! Vector of neighbours for each grid point
+                                                                  !! (1=North and then clockwise)
+    REAL(r_std), INTENT(in)          :: contfrac(nbpt)            !! Fraction of land in each grid box.
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(inout)         ::  cc_biomass_m(nbpt,nvm,ncirc,nparts,nelements,12)      !! prescribed monthly circ class biomass 
+                                                                  !! to be used when running without stomate
+    REAL(r_std), INTENT(inout)         ::  cc_n_m(nbpt,nvm,ncirc,12) !! prescribed monthly number of individuals
+                                                                  !! to be used when running without stomate
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)    :: circ_class_biomass   !! Biomass per PFT
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)        :: circ_class_n
+
+    !
+    !  0.3 LOCAL
+    !
+    CHARACTER(LEN=80)                :: filename                  !! name of the LAI map read
+    INTEGER(i_std)                   :: ib, ip, jp, it, jv
+    REAL(r_std)                      :: lmax, lmin, ldelta
+    LOGICAL                          :: renormelize_lai           !! flag to force LAI renormelization
+    INTEGER                          :: ier
+
+    REAL(r_std), DIMENSION(nbpt)                         :: alaimap          !! availability of the lai interpolation 
+    INTEGER, DIMENSION(4)                                :: invardims
+    REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE           :: lairefrac        !! lai fractions re-dimensioned
+    REAL(r_std), DIMENSION(:), ALLOCATABLE               :: vmin, vmax       !! min/max values to use for the 
+                                                                             !!   renormalization
+    CHARACTER(LEN=80)                                    :: variablename     !! Variable to interpolate
+    CHARACTER(LEN=80)                                    :: lonname, latname !! lon, lat names in input file
+    REAL(r_std), DIMENSION(nvm)                          :: variabletypevals !! Values for all the types of the variable
+                                                                             !!   (variabletypevals(1) = -un, not used)
+    CHARACTER(LEN=50)                                    :: fractype         !! method of calculation of fraction
+                                                                             !!   'XYKindTime': Input values are kinds 
+                                                                             !!     of something with a temporal 
+                                                                             !!     evolution on the dx*dy matrix'
+    LOGICAL                                              :: nonegative       !! whether negative values should be removed
+    CHARACTER(LEN=50)                                    :: maskingtype      !! Type of masking
+                                                                             !!   'nomask': no-mask is applied
+                                                                             !!   'mbelow': take values below maskvals(1)
+                                                                             !!   'mabove': take values above maskvals(1)
+                                                                             !!   'msumrange': take values within 2 ranges;
+                                                                             !!      maskvals(2) <= SUM(vals(k)) <= maskvals(1)
+                                                                             !!      maskvals(1) < SUM(vals(k)) <= maskvals(3)
+                                                                             !!        (normalized by maskvals(3))
+                                                                             !!   'var': mask values are taken from a 
+                                                                             !!     variable inside the file (>0)
+    REAL(r_std), DIMENSION(3)                            :: maskvals         !! values to use to mask (according to 
+                                                                             !!   `maskingtype') 
+    CHARACTER(LEN=250)                                   :: namemaskvar      !! name of the variable to use to mask 
+!_ ================================================================================================================================
+
+    ! Read an LAI map. In ORCHIDEE-CN-CAN lai is no longer passed from one 
+    ! routine to another but more importantly it changed from a 1-D to a 3-D
+    ! variable. Reading, e.g. MODIS LAI, and using that information to force 
+    ! ORCHIDEE-CN-CAN would first require to downscale the observed pixel-level
+    ! LAI into PFT-level LAI. Subsequently, assumptions should be made to 
+    ! convert the 1-D LAI into circ_class_biomass and circ_class_n which in 
+    ! turn are used to calculate a 3-D canopy structure that is used in the
+    ! laieff calculation to calculate a 1-D effective LAI. The 1-D MODIS LAI
+    ! cannot be assumed to be the same as the 1-D effective LAI. What was
+    ! previously known as read_lai and laimap has therefore been replaces by
+    ! code that reads a file containing circ_class_biomass and circ_class_n.
+
+    !Config Key   = LAI_FILE
+    !Config Desc  = Name of file from which the vegetation map is to be read
+    !Config If    = LAI_MAP
+    !Config Def   = lai2D.nc
+    !Config Help  = The name of the file to be opened to read the LAI
+    !Config         map is to be given here. Usualy SECHIBA runs with a 5kmx5km
+    !Config         map which is derived from a Nicolas VIOVY one. 
+    !Config Units = [FILE]
+    !
+    filename = 'lai2D.nc'
+    CALL getin_p('LAI_FILE',filename)
+
+    variablename = 'LAI'
+
+    IF (printlev_loc >= 2) WRITE(numout,*) "slowproc_interlai: Start interpolate " &
+         // TRIM(filename) //" for variable " //TRIM(variablename)
+
+    ! invardims: shape of variable in input file to interpolate
+    invardims = interpweight_get_var4dims_file(filename, variablename)
+    ! Check coherence of dimensions read from the file
+    IF (invardims(4) /= 12)  CALL ipslerr_p(3,'slowproc_interlai','Wrong dimension of time dimension in input file for lai','','')
+    IF (invardims(3) /= nvm) CALL ipslerr_p(3,'slowproc_interlai','Wrong dimension of PFT dimension in input file for lai','','')
+
+    ALLOCATE(vmin(nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable vmin','','')
+
+    ALLOCATE(vmax(nvm), STAT=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable vmax','','')
+
+    ALLOCATE(lairefrac(nbpt,nvm,invardims(4)), STAT=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable lairefrac','','')
+
+    ! Assigning values to vmin, vmax
+    vmin = un
+    vmax = nvm*un
+
+    variabletypevals = -un
+
+    !! Variables for interpweight
+    ! Type of calculation of cell fractions
+    fractype = 'default'
+    ! Name of the longitude and latitude in the input file
+    lonname = 'longitude'
+    latname = 'latitude'
+    ! Should negative values be set to zero from input file?
+    nonegative = .TRUE.
+    ! Type of mask to apply to the input data (see header for more details)
+    maskingtype = 'mbelow'
+    ! Values to use for the masking
+    maskvals = (/ 20., undef_sechiba, undef_sechiba /)
+    ! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
+    namemaskvar = ''
+
+    CALL interpweight_4D(nbpt, nvm, variabletypevals, lalo, resolution, neighbours,        &
+      contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype,        &
+      maskvals, namemaskvar, nvm, invardims(4), -1, fractype,                            &
+      -1., -1., lairefrac, alaimap)
+
+    IF (printlev_loc >= 5) WRITE(numout,*)'  slowproc_interlai after interpweight_4D'
+
+    !
+    !
+    !Config Key   = RENORM_LAI
+    !Config Desc  = flag to force LAI renormelization
+    !Config If    = LAI_MAP
+    !Config Def   = n
+    !Config Help  = If true, the laimap will be renormalize between llaimin and llaimax parameters.
+    !Config Units = [FLAG]
+    !
+    renormelize_lai = .FALSE.
+    CALL getin_p('RENORM_LAI',renormelize_lai)
+
+    !
+!!$    laimap(:,:,:) = zero
+!!$    !
+!!$    IF (printlev_loc >= 5) THEN
+!!$      WRITE(numout,*)'  slowproc_interlai before starting loop nbpt:', nbpt
+!!$    END IF 
+!!$
+!!$    ! Assigning the right values and giving a value where information was 
+!!$    ! not found
+!!$    DO ib=1,nbpt
+!!$       IF (alaimap(ib) < 0.) THEN 
+!!$          DO jv=1,nvm 
+!!$             laimap(ib,jv,:) = (llaimax(jv)+llaimin(jv))/deux
+!!$          ENDDO
+!!$       ELSE 
+!!$          DO jv=1, nvm 
+!!$             DO it=1, invardims(4) 
+!!$                laimap(ib,jv,it) = lairefrac(ib,jv,it) 
+!!$             ENDDO
+!!$          ENDDO
+!!$       END IF
+!!$    ENDDO
+!!$    !
+!!$    ! Normalize the read LAI by the values SECHIBA is used to
+!!$    !
+!!$    IF ( renormelize_lai ) THEN
+!!$       DO ib=1,nbpt
+!!$          DO jv=1, nvm
+!!$             lmax = MAXVAL(laimap(ib,jv,:))
+!!$             lmin = MINVAL(laimap(ib,jv,:))
+!!$             ldelta = lmax-lmin
+!!$             IF ( ldelta < min_sechiba) THEN
+!!$                ! LAI constante ... keep it constant
+!!$                laimap(ib,jv,:) = (laimap(ib,jv,:)-lmin)+(llaimax(jv)+llaimin(jv))/deux
+!!$             ELSE
+!!$                laimap(ib,jv,:) = (laimap(ib,jv,:)-lmin)/(lmax-lmin)*(llaimax(jv)-llaimin(jv))+llaimin(jv)
+!!$             ENDIF
+!!$          ENDDO
+!!$       ENDDO
+!!$    ENDIF
+!!$
+!!$    ! Write diagnostics
+!!$    CALL xios_orchidee_send_field("alaimap",alaimap)
+    
+    IF (printlev_loc >= 3) WRITE(numout,*) '  slowproc_interlai ended'
+
+  END SUBROUTINE slowproc_interlai
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_readvegetmax
+!!
+!>\BRIEF          Read and interpolate a vegetation map (by pft)
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): The subroutine was previously called slowproc_update.
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_readvegetmax(nbpt, lalo, neighbours,  resolution, contfrac, veget_last_in,         & 
+       veget_next_out, frac_nobio_next, veget_year, init)
+
+    USE interpweight
+
+    IMPLICIT NONE
+
+    !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)                             :: nbpt            !! Number of points for which the data needs 
+                                                                              !! to be interpolated
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in)             :: lalo            !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), INTENT(in)   :: neighbours      !! Vector of neighbours for each grid point
+                                                                              !! (1=North and then clockwise)
+    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_in   !! old max vegetfrac
+    INTEGER(i_std), INTENT(in)         :: veget_year            !! first year for landuse (0 == NO TIME AXIS)
+    LOGICAL, INTENT(in)                :: init                  !! initialisation : in case of dgvm, it forces update of all PFTs
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), DIMENSION(nbpt,nvm), INTENT(out)          :: veget_next_out   !! 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) :: ib, inobio, jv, ivma
+    REAL(r_std) :: sumf, err, norm
+    !
+    ! 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)
+    REAL(r_std), DIMENSION(nbpt,nvmap)                   :: veget_last        !Temporary variable for veget_last_in on the same number of pfts as in the file 
+    REAL(r_std), DIMENSION(nbpt,nvmap)                   :: veget_next        !Temporary variable for veget_next_out on the same number of pfts as in the file
+
+    REAL(r_std), DIMENSION(nbpt,nvmap)                   :: vegetrefrac      !! veget fractions re-dimensioned
+    REAL(r_std), DIMENSION(nbpt)                         :: aveget           !! Availability of the soilcol interpolation
+    REAL(r_std), DIMENSION(nvmap)                        :: vmin, vmax       !! min/max values to use for the renormalization
+    CHARACTER(LEN=80)                                    :: variablename     !! Variable to interpolate
+    CHARACTER(LEN=80)                                    :: lonname, latname !! lon, lat names in input file
+    REAL(r_std), DIMENSION(nvmap)                        :: variabletypevals !! Values for all the types of the variable
+                                                                             !!   (variabletypevals(1) = -un, not used)
+    CHARACTER(LEN=50)                                    :: fractype         !! method of calculation of fraction
+                                                                             !!   'XYKindTime': Input values are kinds 
+                                                                             !!     of something with a temporal 
+                                                                             !!     evolution on the dx*dy matrix'
+    LOGICAL                                              :: nonegative       !! whether negative values should be removed
+    CHARACTER(LEN=50)                                    :: maskingtype      !! Type of masking
+                                                                             !!   'nomask': no-mask is applied
+                                                                             !!   'mbelow': take values below maskvals(1)
+                                                                             !!   'mabove': take values above maskvals(1)
+                                                                             !!   'msumrange': take values within 2 ranges;
+                                                                             !!      maskvals(2) <= SUM(vals(k)) <= maskvals(1)
+                                                                             !!      maskvals(1) < SUM(vals(k)) <= maskvals(3)
+                                                                             !!        (normalized by maskvals(3))
+                                                                             !!   'var': mask values are taken from a 
+                                                                             !!     variable inside the file (>0)
+    REAL(r_std), DIMENSION(3)                            :: maskvals         !! values to use to mask (according to 
+                                                                             !!   `maskingtype') 
+    CHARACTER(LEN=250)                                   :: namemaskvar      !! name of the variable to use to mask 
+    CHARACTER(LEN=250)                                   :: msg
+
+!_ ================================================================================================================================
+
+    IF (printlev_loc >= 5) PRINT *,'  In slowproc_readvegetmax'
+
+    !
+    !Config Key   = VEGETATION_FILE
+    !Config Desc  = Name of file from which the vegetation map is to be read
+    !Config If    = 
+    !Config Def   = PFTmap.nc
+    !Config Help  = The name of the file to be opened to read a vegetation
+    !Config         map (in pft) is to be given here. 
+    !Config Units = [FILE]
+    !
+    filename = 'PFTmap.nc'
+    CALL getin_p('VEGETATION_FILE',filename)
+    variablename = 'maxvegetfrac'
+
+    IF (printlev_loc >= 2) WRITE(numout,*) "slowproc_readvegetmax: Start interpolate " &
+         // TRIM(filename) // " for variable " // TRIM(variablename)
+
+    ! Assigning values to vmin, vmax
+    vmin = 1
+    vmax = nvmap*1._r_std
+
+    variabletypevals = -un
+
+    !! Variables for interpweight
+    ! Type of calculation of cell fractions
+    fractype = 'default'
+    ! Name of the longitude and latitude in the input file
+    lonname = 'lon'
+    latname = 'lat'
+    ! Should negative values be set to zero from input file?
+    nonegative = .FALSE.
+    ! Type of mask to apply to the input data (see header for more details)
+    maskingtype = 'msumrange'
+    ! Values to use for the masking
+    maskvals = (/ 1.-1.e-7, min_sechiba, 2. /)
+    ! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
+    namemaskvar = ''
+
+    CALL interpweight_3D(nbpt, nvmap, variabletypevals, lalo, resolution, neighbours,        &
+      contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype,        &
+      maskvals, namemaskvar, nvmap, 0, veget_year, fractype,                                 &
+      -1., -1., vegetrefrac, aveget)
+    IF (printlev_loc >= 5) WRITE(numout,*)'  slowproc_readvegetmax after interpweight_3D'
+    
+
+    !! Consider special case with age classes. 
+    IF (nagec > 1)THEN
+       ! If we are using age classes, we have to do this a little differently.
+       ! We pass fake arrays which get the new vegetation from the maps for
+       ! the PFTs ignoring the age classes, and then we set up the vegetation
+       ! for the age classes using that information.
+       DO ivma=1,nvmap
+          veget_last(:,ivma)=SUM(veget_last_in(:,start_index(ivma):start_index(ivma)+nagec_pft(ivma)-1))
+       ENDDO
+    ELSE
+       ! Standard case with only 1 age class. All the PFT's are read from the
+       ! file. 
+       veget_last(:,:) = veget_last_in(:,:)
+    END IF
+
+    !
+    ! Compute the logical for partial (only anthropic) PTFs update
+    IF (ok_dgvm .AND. .NOT. init) THEN
+       partial_update= .TRUE.
+    ELSE
+       partial_update=.FALSE.
+    END IF
+    
+    IF (printlev_loc >= 5) THEN
+      WRITE(numout,*)'  slowproc_readvegetmax before updating loop nbpt:', nbpt
+    END IF
+    
+    IF ( .NOT. partial_update ) THEN
+       veget_next(:,:)=zero
+       
+       IF (printlev_loc >=3 .AND. ANY(aveget < min_sechiba)) THEN
+          WRITE(numout,*) 'Some grid cells on the model grid did not have any points on the source grid.'
+          IF (init) THEN
+             WRITE(numout,*) 'Initialization with full fraction of bare soil are done for the below grid cells.'
+          ELSE
+             WRITE(numout,*) 'Old values are kept for the below grid cells.'
+          ENDIF
+          WRITE(numout,*) 'List of grid cells (ib, lat, lon):'
+       END IF
+    
+      DO ib = 1, nbpt
+          ! vegetrefrac is already normalized to sum equal one for each grid cell
+          veget_next(ib,:) = vegetrefrac(ib,:)
+    
+          IF (aveget(ib) < min_sechiba) THEN
+             IF (printlev_loc >=3) WRITE(numout,*) ib,lalo(ib,1),lalo(ib,2)
+             IF (init) THEN
+                veget_next(ib,1) = un
+                veget_next(ib,2:nvmap) = zero
+             ELSE
+                veget_next(ib,:) = veget_last(ib,:)
+             ENDIF
+          ENDIF
+       ENDDO
+    ELSE
+       ! Partial update
+       DO ib = 1, nbpt
+          IF (aveget(ib) > min_sechiba) THEN
+             ! For the case with properly interpolated grid cells (aveget>0)
+    
+             ! last veget for this point
+             sum_veg=SUM(veget_last(ib,:))
+             !
+             ! If the DGVM is activated, only anthropic PFTs are updated, the others are copied from previous time-step
+             veget_next(ib,:) = veget_last(ib,:)
+             
+             DO jv = 2, nvmap
+                IF ( .NOT. natural(jv) ) THEN       
+                   veget_next(ib,jv) = vegetrefrac(ib,jv)
+                ENDIF
+             ENDDO
+    
+             sumvAnthro_old = zero
+             sumvAnthro     = zero
+             DO jv = 2, nvmap
+                IF ( .NOT. natural(jv) ) THEN
+                   sumvAnthro = sumvAnthro + veget_next(ib,jv)
+                   sumvAnthro_old = sumvAnthro_old + veget_last(ib,jv)
+                ENDIF
+             ENDDO
+    
+             IF ( sumvAnthro_old < sumvAnthro ) THEN
+                ! Increase of non natural vegetations (increase of agriculture)
+                ! The proportion of natural PFT's must be preserved
+                ! ie the sum of vegets is preserved
+                !    and natural PFT / (sum of veget - sum of antropic veget)
+                !    is preserved.
+                rapport = ( sum_veg - sumvAnthro ) / ( sum_veg - sumvAnthro_old )
+                DO jv = 1, nvmap
+                   IF ( natural(jv) ) THEN
+                      veget_next(ib,jv) = veget_last(ib,jv) * rapport
+                   ENDIF
+                ENDDO
+             ELSE
+                ! Increase of natural vegetations (decrease of agriculture)
+                ! The decrease of agriculture is replaced by bare soil. The DGVM will
+                ! re-introduce natural PFT's.
+                DO jv = 1, nvmap
+                   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,*) 'slowproc_readvegetmax _______'
+                msg = "  No conservation of sum of veget for point "
+                WRITE(numout,*) TRIM(msg), ib, ",(", lalo(ib,1),",", lalo(ib,2), ")" 
+                WRITE(numout,*) "  last sum of veget ", sum_veg, " new sum of veget ", &
+                  SUM(veget_next(ib,:)), " error : ", SUM(veget_next(ib,:))-sum_veg
+                WRITE(numout,*) "  Anthropic modifications : last ",sumvAnthro_old," new ",sumvAnthro     
+                CALL ipslerr_p (3,'slowproc_readvegetmax', &
+                     &          'No conservation of sum of veget_next', &
+                     &          "The sum of veget_next is different after reading Land Use map.", &
+                     &          '(verify the dgvm case model.)')
+             ENDIF
+          ELSE
+             ! For the case when there was a propblem with the interpolation, aveget < min_sechiba
+             WRITE(numout,*) 'slowproc_readvegetmax _______'
+             WRITE(numout,*) "  No land point in the map for point ", ib, ",(", lalo(ib,1), ",", &
+               lalo(ib,2),")" 
+             CALL ipslerr_p (2,'slowproc_readvegetmax', &
+                  &          'Problem with vegetation file for Land Use.', &
+                  &          "No land point in the map for point", & 
+                  &          '(verify your land use file.)')
+             veget_next(ib,:) = veget_last(ib,:)
+          ENDIF
+         
+       ENDDO
+    ENDIF
+    
+    IF (printlev_loc >= 5) WRITE(numout,*)'  slowproc_readvegetmax after updating'
+    !
+    frac_nobio_next (:,:) = un
+    !
+
+    ! Work only for one nnobio !! (ie ice)
+    DO inobio=1,nnobio
+       DO jv=1,nvmap
+          DO ib = 1, nbpt
+             frac_nobio_next(ib,inobio) = frac_nobio_next(ib,inobio) - veget_next(ib,jv)
+          ENDDO
+       ENDDO
+    ENDDO
+    
+    DO ib = 1, nbpt
+       sum_veg = SUM(veget_next(ib,:))
+       sum_nobio = SUM(frac_nobio_next(ib,:))
+       IF (sum_nobio < 0.) THEN
+          frac_nobio_next(ib,:) = zero
+          veget_next(ib,1) = veget_next(ib,1) + sum_nobio
+          sum_veg = SUM(veget_next(ib,:))
+       ENDIF
+       sumf = sum_veg + sum_nobio
+       IF (sumf > min_sechiba) THEN
+          veget_next(ib,:) = veget_next(ib,:) / sumf
+          frac_nobio_next(ib,:) = frac_nobio_next(ib,:) / sumf
+          norm=SUM(veget_next(ib,:))+SUM(frac_nobio_next(ib,:))
+          err=norm-un
+          IF (printlev_loc >=5) WRITE(numout,*) " slowproc_readvegetmax: ib ",ib,                    &
+            " SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-un, sumf",err,sumf
+          IF (abs(err) > -EPSILON(un)) THEN
+             IF ( SUM(frac_nobio_next(ib,:)) > min_sechiba ) THEN
+                frac_nobio_next(ib,1) = frac_nobio_next(ib,1) - err
+             ELSE
+                veget_next(ib,1) = veget_next(ib,1) - err
+             ENDIF
+             norm=SUM(veget_next(ib,:))+SUM(frac_nobio_next(ib,:))
+             err=norm-un
+             IF (printlev_loc >=5) WRITE(numout,*) " slowproc_readvegetmax: ib ", ib,                &
+               " SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-un",err
+             IF (abs(err) > EPSILON(un)) THEN
+                WRITE(numout,*) '  slowproc_readvegetmax _______'
+                WRITE(numout,*) "update : Problem with point ",ib,",(",lalo(ib,1),",",lalo(ib,2),")" 
+                WRITE(numout,*) "         err(sum-1.) = ",abs(err)
+                CALL ipslerr_p (2,'slowproc_readvegetmax', &
+                     &          'Problem with sum vegetation + sum fracnobio for Land Use.',          &
+                     &          "sum not equal to 1.", &
+                     &          '(verify your land use file.)')
+                aveget(ib) = -0.6
+             ENDIF
+          ENDIF
+       ELSE
+          ! sumf < min_sechiba
+          WRITE(numout,*) '  slowproc_readvegetmax _______'
+          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:nvmap) = zero
+          frac_nobio_next(ib,:) = zero
+!!!$          CALL ipslerr_p (3,'slowproc_readvegetmax', &
+!!!$               &          'Problem with vegetation file for Land Use.', &
+!!!$               &          "No vegetation nor frac_nobio for point ", &
+!!!$               &          '(verify your land use file.)')
+       ENDIF
+    ENDDO
+
+    IF ( nagec > 1 ) THEN
+       ! Now we need to change this into the map with age classes.        
+       ! We have the total area for each PFT for next year from the map.
+       ! However, we do not have the area for each age class; this is 
+       ! only present in the simulation, not the  maps.  I am going to 
+       ! put all of the vegetmax for a given PFT in only the youngest
+       ! age class for now. This will be properly taken into account in
+       ! land_cover_change_main. The reason we don't do it here is because 
+       ! the age classes can change between this part of the code and between 
+       ! land_cover_change main, due to growth or death.
+       veget_next_out(:,:) = 0.0
+       DO ivma=1,nvmap
+          veget_next_out(:,start_index(ivma))=veget_next(:,ivma)
+       ENDDO
+
+    ELSE
+       ! Standard case with 1 age class
+       veget_next_out(:,:) = veget_next(:,:)
+    END IF
+ 
+    ! Write diagnostics
+    CALL xios_orchidee_send_field("aveget",aveget)
+    
+    IF (printlev_loc >= 3) WRITE(numout,*) '  slowproc_readvegetmax ended'
+    
+  END SUBROUTINE slowproc_readvegetmax
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_nearest
+!!
+!>\BRIEF         looks for nearest grid point on the fine map
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::inear
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_nearest(iml, lon5, lat5, lonmod, latmod, inear)
+
+    !! INTERFACE DESCRIPTION
+    
+    !! 0.1 input variables
+
+    INTEGER(i_std), INTENT(in)                   :: iml             !! size of the vector
+    REAL(r_std), DIMENSION(iml), INTENT(in)      :: lon5, lat5      !! longitude and latitude vector, for the 5km vegmap
+    REAL(r_std), INTENT(in)                      :: lonmod, latmod  !! longitude  and latitude modelled
+
+    !! 0.2 output variables
+    
+    INTEGER(i_std), INTENT(out)                  :: inear           !! location of the grid point from the 5km vegmap grid
+                                                                    !! closest from the modelled grid point
+
+    !! 0.4 Local variables
+
+    REAL(r_std)                                  :: pa, p
+    REAL(r_std)                                  :: coscolat, sincolat
+    REAL(r_std)                                  :: cospa, sinpa
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: cosang
+    INTEGER(i_std)                               :: i
+    INTEGER(i_std), DIMENSION(1)                 :: ineartab
+    INTEGER                                      :: ALLOC_ERR
+
+!_ ================================================================================================================================
+
+    ALLOCATE(cosang(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_nearest','Error in allocation for cosang','','')
+
+    pa = pi/2.0 - latmod*pi/180.0 ! dist. between north pole and the point a 
+                                                      !! COLATITUDE, in radian
+    cospa = COS(pa)
+    sinpa = SIN(pa)
+
+    DO i = 1, iml
+
+       sincolat = SIN( pi/2.0 - lat5(i)*pi/180.0 ) !! sinus of the colatitude
+       coscolat = COS( pi/2.0 - lat5(i)*pi/180.0 ) !! cosinus of the colatitude
+
+       p = (lonmod-lon5(i))*pi/180.0 !! angle between a & b (between their meridian)in radians
+
+       !! dist(i) = ACOS( cospa*coscolat + sinpa*sincolat*COS(p))
+       cosang(i) = cospa*coscolat + sinpa*sincolat*COS(p) !! TL : cosang is maximum when angle is at minimal value  
+!! orthodromic distance between 2 points : cosang = cosinus (arc(AB)/R), with
+!R = Earth radius, then max(cosang) = max(cos(arc(AB)/R)), reached when arc(AB)/R is minimal, when
+! arc(AB) is minimal, thus when point B (corresponding grid point from LAI MAP) is the nearest from
+! modelled A point
+    ENDDO
+
+    ineartab = MAXLOC( cosang(:) )
+    inear = ineartab(1)
+
+    DEALLOCATE(cosang)
+  END SUBROUTINE slowproc_nearest
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_soilt
+!!
+!>\BRIEF         Interpolate the Zobler or Reynolds/USDA soil type map
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): Nov 2014, ADucharne
+!!
+!! MAIN OUTPUT VARIABLE(S): ::soiltype, ::clayfraction, sandfraction, siltfraction, ::bulk, ::soilph
+!!
+!! REFERENCE(S) : Reynold, Jackson, and Rawls (2000). Estimating soil water-holding capacities 
+!! by linking the Food and Agriculture Organization soil map of the world with global pedon
+!! databases and continuous pedotransfer functions, WRR, 36, 3653-3662
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_soilt(nbpt, lalo, neighbours, resolution, contfrac, &
+       soilclass, clayfraction, sandfraction, siltfraction, bulk, soil_ph)
+
+    USE interpweight
+
+    IMPLICIT NONE
+    !
+    !
+    !   This subroutine should read the Zobler/Reynolds map and interpolate to the model grid. 
+    !   The method is to get fraction of the three/12 main soiltypes for each grid box.
+    !   For the Zobler case, also called FAO in the code, the soil fraction are going to be put 
+    !   into the array soiltype in the following order : coarse, medium and fine.
+    !   For the Reynolds/USDA case, the soiltype array follows the order defined in constantes_soil_var.f90
+    !
+    !
+    !!  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)    :: nbpt                   !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)       :: lalo(nbpt,2)           !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)    :: neighbours(nbpt,NbNeighb)!! Vector of neighbours for each grid point
+                                                              !! (1=North and then clockwise)
+    REAL(r_std), INTENT(in)       :: resolution(nbpt,2)     !! The size in km of each grid-box in X and Y
+    REAL(r_std), INTENT(in)       :: contfrac(nbpt)         !! Fraction of land in each grid box.
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(out)      :: soilclass(nbpt, nscm)  !! Soil type map to be created from the Zobler map
+                                                            !! or a map defining the 12 USDA classes (e.g. Reynolds)
+                                                            !! Holds the area of each texture class in the ORCHIDEE grid cells
+                                                            !! Final unit = fraction of ORCHIDEE grid-cell (unitless)
+    REAL(r_std), INTENT(out)      :: clayfraction(nbpt)     !! The fraction of clay as used by STOMATE
+    REAL(r_std), INTENT(out)      :: sandfraction(nbpt)     !! The fraction of sand (for SP-MIP)
+    REAL(r_std), INTENT(out)      :: siltfraction(nbpt)     !! The fraction of silt (for SP-MIP)
+    REAL(r_std), INTENT(out)      :: bulk(nbpt)             !! Bulk density  as used by STOMATE
+    REAL(r_std), INTENT(out)      :: soil_ph(nbpt)          !! Soil pH  as used by STOMATE
+    !
+    !
+    !  0.3 LOCAL
+    !
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: ib, ilf, nbexp, i
+    INTEGER(i_std) :: fopt                                  !! Nb of pts from the texture map within one ORCHIDEE grid-cell
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: solt       !! Texture the different points from the input texture map 
+                                                            !! in one ORCHIDEE grid cell (unitless)
+    !
+    ! Number of texture classes in Zobler
+    !
+    INTEGER(i_std), PARAMETER :: nzobler = 7                !! Nb of texture classes according in the Zobler map
+    REAL(r_std),ALLOCATABLE   :: textfrac_table(:,:)        !! conversion table between the texture index
+                                                            !! and the granulometric composition
+    !   
+    INTEGER                  :: ALLOC_ERR
+    INTEGER                                              :: ntextinfile      !! number of soil textures in the in the file
+    REAL(r_std), DIMENSION(:,:), ALLOCATABLE             :: textrefrac       !! text fractions re-dimensioned
+    REAL(r_std), DIMENSION(nbpt)                         :: atext            !! Availability of the texture interpolation
+    REAL(r_std), DIMENSION(nbpt)                         :: abulkph          !! Availability of the bulk and ph interpolation
+    REAL(r_std)                                          :: vmin, vmax       !! min/max values to use for the 
+
+    CHARACTER(LEN=80)                                    :: variablename     !! Variable to interpolate
+    CHARACTER(LEN=80)                                    :: lonname, latname !! lon, lat name in input file
+    REAL(r_std), DIMENSION(:), ALLOCATABLE               :: variabletypevals !! Values for all the types of the variable
+                                                                             !!   (variabletypevals(1) = -un, not used)
+    CHARACTER(LEN=50)                                    :: fractype         !! method of calculation of fraction
+                                                                             !!   'XYKindTime': Input values are kinds 
+                                                                             !!     of something with a temporal 
+                                                                             !!     evolution on the dx*dy matrix'
+    LOGICAL                                              :: nonegative       !! whether negative values should be removed
+    CHARACTER(LEN=50)                                    :: maskingtype      !! Type of masking
+                                                                             !!   'nomask': no-mask is applied
+                                                                             !!   'mbelow': take values below maskvals(1)
+                                                                             !!   'mabove': take values above maskvals(1)
+                                                                             !!   'msumrange': take values within 2 ranges;
+                                                                             !!      maskvals(2) <= SUM(vals(k)) <= maskvals(1)
+                                                                             !!      maskvals(1) < SUM(vals(k)) <= maskvals(3)
+                                                                             !!        (normalized by maskvals(3))
+                                                                             !!   'var': mask values are taken from a 
+                                                                             !!     variable inside the file (>0)
+    REAL(r_std), DIMENSION(3)                            :: maskvals         !! values to use to mask (according to 
+                                                                             !!   `maskingtype') 
+    CHARACTER(LEN=250)                                   :: namemaskvar      !! name of the variable to use to mask 
+    INTEGER(i_std), DIMENSION(:), ALLOCATABLE            :: vecpos
+    CHARACTER(LEN=80)                                    :: fieldname        !! name of the field read in the N input map
+    REAL(r_std)                                          :: sgn              !! sum of fractions excluding glaciers and ocean
+!_ ================================================================================================================================
+
+    IF (printlev_loc>=3) WRITE (numout,*) 'slowproc_soilt'
+    !
+    !  Needs to be a configurable variable
+    !
+    !
+    !Config Key   = SOILCLASS_FILE
+    !Config Desc  = Name of file from which soil types are read
+    !Config Def   = soils_param.nc
+    !Config If    = NOT(IMPOSE_VEG)
+    !Config Help  = The name of the file to be opened to read the soil types. 
+    !Config         The data from this file is then interpolated to the grid of
+    !Config         of the model. The aim is to get fractions for sand loam and
+    !Config         clay in each grid box. This information is used for soil hydrology
+    !Config         and respiration.
+    !Config Units = [FILE]
+    !
+    ! soils_param.nc file is 1deg soil texture file (Zobler)
+    ! The USDA map from Reynolds is soils_param_usda.nc (1/12deg resolution)
+
+    filename = 'soils_param.nc'
+    CALL getin_p('SOILCLASS_FILE',filename)
+
+    !! Variables for interpweight
+    ! Type of calculation of cell fractions
+    fractype = 'default'
+    ! Name of the longitude and latitude in the input file
+    lonname = 'nav_lon'
+    latname = 'nav_lat'
+
+    IF ( TRIM(soil_classif) /= 'none' ) THEN
+
+       ! Define a variable for the number of soil textures in the input file
+       SELECTCASE(soil_classif)
+       CASE('zobler')
+          ntextinfile=nzobler
+       CASE('usda')
+          ntextinfile=nscm
+       CASE DEFAULT
+          WRITE(numout,*) 'slowproc_soilt:'
+          WRITE(numout,*) '  A non supported soil type classification has been chosen'
+          CALL ipslerr_p(3,'slowproc_soilt','non supported soil type classification','','')
+       ENDSELECT
+
+       ALLOCATE(textrefrac(nbpt,ntextinfile), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_soilt','Problem in allocation of variable textrefrac',&
+         '','')
+       
+       ALLOCATE(variabletypevals(ntextinfile), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_soilt','Problem in allocation of variabletypevals','','')
+       variabletypevals = -un
+       
+       !! Variables for interpweight
+       ! Should negative values be set to zero from input file?
+       nonegative = .FALSE.
+       ! Type of mask to apply to the input data (see header for more details)
+       maskingtype = 'mabove'
+       ! Values to use for the masking
+       maskvals = (/ min_sechiba, undef_sechiba, undef_sechiba /)
+       ! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') ( not used)
+       namemaskvar = ''
+       
+       ! Read soilbulk
+       fieldname= 'soilbulk'
+       vmin=0  ! not used in interpweight_2Dcont
+       vmax=0  ! not used in interpweight_2Dcont
+
+       IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_soilt: Read and interpolate " &
+           // TRIM(filename) // " for variable " // TRIM(fieldname)
+
+       CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours,                        &
+            contfrac, filename, fieldname, lonname, latname, vmin, vmax, nonegative, maskingtype,    &
+            maskvals, namemaskvar, -1, fractype, bulk_default, undef_sechiba,                        &
+            bulk, abulkph)
+
+       ! Read soilph
+       fieldname= 'soilph'
+
+       IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_soilt: Read and interpolate" &
+         // TRIM(filename) // " for variable " // TRIM(fieldname)
+
+       CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours,                        &
+            contfrac, filename, fieldname, lonname, latname, vmin, vmax, nonegative, maskingtype,    &
+            maskvals, namemaskvar, -1, fractype, ph_default, undef_sechiba,                          &
+            soil_ph, abulkph)
+
+       ! Read soiltexture
+
+       ! Assigning values to vmin, vmax
+       vmin = un
+       vmax = ntextinfile*un
+       variablename = 'soiltext'
+
+       SELECTCASE(soil_classif)
+       CASE('zobler')
+
+          IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_soilt: Read and interpolate" &
+          // TRIM(filename) // " for variable " // TRIM(variablename)
+ 
+         CALL interpweight_2D(nbpt, ntextinfile, variabletypevals, lalo,resolution, neighbours,        &
+             contfrac, filename, variablename, lonname, latname, vmin, vmax,nonegative, maskingtype,    &
+             maskvals, namemaskvar, 0, 0, -1, fractype, -1., -1., textrefrac,atext)
+
+       CASE('usda')
+
+          filename = 'soils_param_usda.nc'
+          CALL getin_p('SOILCLASS_FILE2',filename)
+
+          IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_soilt: Read and interpolate" &
+          // TRIM(filename) // " for variable " // TRIM(variablename)
+
+          CALL interpweight_2D(nbpt, ntextinfile, variabletypevals,lalo,resolution, neighbours,        &
+             contfrac, filename, variablename, lonname, latname, vmin,vmax,nonegative, maskingtype,    &
+             maskvals, namemaskvar, 0, 0, -1, fractype, -1., -1., textrefrac,atext)
+       ENDSELECT
+
+       WRITE(numout,*)'filename soilclass_file2', filename   
+
+       ALLOCATE(vecpos(ntextinfile), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_soilt','Problem in allocation of variable vecpos','','')
+       ALLOCATE(solt(ntextinfile), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_soilt','Problem in allocation of variable solt','','')
+       
+       IF (printlev_loc >= 5) THEN
+          WRITE(numout,*)'  slowproc_soilt after interpweight_2D'
+          WRITE(numout,*)'  slowproc_soilt before starting loop nbpt:', nbpt
+          WRITE(numout,*)"  slowproc_soilt starting classification '" // TRIM(soil_classif) // "'..."
+       END IF
+    ELSE
+      IF (printlev_loc >= 5) WRITE(numout,*)'  slowproc_soilt using default values all points are propertly ' // &
+        'interpolated atext = 1. everywhere!'
+      atext = 1.
+    END IF
+
+    nbexp = 0
+    SELECTCASE(soil_classif)
+    CASE('none')
+       ALLOCATE(textfrac_table(nscm,ntext), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for textfrac_table','','')
+       DO ib=1, nbpt
+          soilclass(ib,:) = soilclass_default_fao
+          clayfraction(ib) = clayfraction_default
+          sandfraction(ib) = sandfraction_default
+          siltfraction(ib) = siltfraction_default
+       ENDDO
+    CASE('zobler')
+       !
+       soilclass_default=soilclass_default_fao ! FAO means here 3 final texture classes
+       !
+       IF (printlev_loc>=2) WRITE(numout,*) "Using a soilclass map with Zobler classification"
+       !
+       ALLOCATE(textfrac_table(nzobler,ntext), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for textfrac_table','','')
+       CALL get_soilcorr_zobler (nzobler, textfrac_table)
+       !
+       !
+       IF (printlev_loc >= 5) WRITE(numout,*)'  slowproc_soilt after getting table of textures'
+       DO ib =1, nbpt
+          soilclass(ib,:) = zero
+          clayfraction(ib) = zero
+          sandfraction(ib) = zero
+          siltfraction(ib) = zero
+          !
+          ! vecpos: List of positions where textures were not zero
+          ! vecpos(1): number of not null textures found
+          vecpos = interpweight_ValVecR(textrefrac(ib,:),nzobler,zero,'neq')
+          fopt = vecpos(1)
+
+          IF ( fopt .EQ. 0 ) THEN
+             ! No points were found for current grid box, use default values
+             nbexp = nbexp + 1
+             soilclass(ib,:) = soilclass_default(:)
+             clayfraction(ib) = clayfraction_default
+             sandfraction(ib) = sandfraction_default
+             siltfraction(ib) = siltfraction_default
+
+          ELSE
+             IF (fopt == nzobler) THEN
+                ! All textures are not zero
+                solt=(/(i,i=1,nzobler)/)
+             ELSE
+               DO ilf = 1,fopt
+                 solt(ilf) = vecpos(ilf+1)
+               END DO
+             END IF
+             !
+             !   Compute the fraction of each textural class
+             !
+             sgn = 0.
+             DO ilf = 1,fopt
+                !
+                ! Here we make the correspondance between the 7 zobler textures and the 3 textures in ORCHIDEE
+                ! and soilclass correspond to surfaces covered by the 3 textures of ORCHIDEE (coase,medium,fine)
+                ! For type 6 = glacier, default values are set and it is also taken into account during the normalization 
+                ! of the fractions (done in interpweight_2D)
+                ! Note that type 0 corresponds to ocean but it is already removed using the mask above.
+                !
+                IF ( (solt(ilf) .LE. nzobler) .AND. (solt(ilf) .GT. 0) .AND. & 
+                     (solt(ilf) .NE. 6) ) THEN
+                   SELECT CASE(solt(ilf))
+                     CASE(1)
+                        soilclass(ib,1) = soilclass(ib,1) + textrefrac(ib,solt(ilf))
+                     CASE(2)
+                        soilclass(ib,2) = soilclass(ib,2) + textrefrac(ib,solt(ilf))
+                     CASE(3)
+                        soilclass(ib,2) = soilclass(ib,2) + textrefrac(ib,solt(ilf))
+                     CASE(4)
+                        soilclass(ib,2) = soilclass(ib,2) + textrefrac(ib,solt(ilf))
+                     CASE(5)
+                        soilclass(ib,3) = soilclass(ib,3) + textrefrac(ib,solt(ilf))
+                     CASE(7)
+                        soilclass(ib,2) = soilclass(ib,2) + textrefrac(ib,solt(ilf))
+                     CASE DEFAULT
+                        WRITE(numout,*) 'We should not be here, an impossible case appeared'
+                        CALL ipslerr_p(3,'slowproc_soilt','Bad value for solt','','')
+                   END SELECT
+                   ! clayfraction is the sum of the % of clay (as a mineral of small granulometry, and not as a texture)
+                   ! over the zobler pixels composing the ORCHIDEE grid-cell
+                   clayfraction(ib) = clayfraction(ib) + &
+                        & textfrac_table(solt(ilf),3) * textrefrac(ib,solt(ilf))
+                   sandfraction(ib) = sandfraction(ib) + &
+                        & textfrac_table(solt(ilf),2) * textrefrac(ib,solt(ilf))
+                   siltfraction(ib) = siltfraction(ib) + &
+                        & textfrac_table(solt(ilf),1) * textrefrac(ib,solt(ilf))
+                   ! Sum the fractions which are not glaciers nor ocean
+                   sgn = sgn + textrefrac(ib,solt(ilf))
+                ELSE
+                   IF (solt(ilf) .GT. nzobler) THEN
+                      WRITE(numout,*) 'The file contains a soil color class which is incompatible with this program'
+                      CALL ipslerr_p(3,'slowproc_soilt','Problem soil color class incompatible','','')
+                   ENDIF
+                ENDIF
+             ENDDO
+
+             IF ( sgn .LT. min_sechiba) THEN
+                ! Set default values if grid cells were only covered by glaciers or ocean 
+                ! or if now information on the source grid was found.
+                nbexp = nbexp + 1
+                soilclass(ib,:) = soilclass_default(:)
+                clayfraction(ib) = clayfraction_default
+                sandfraction(ib) = sandfraction_default
+                siltfraction(ib) = siltfraction_default
+             ELSE
+                ! Normalize using the fraction of surface not including glaciers and ocean
+                soilclass(ib,:) = soilclass(ib,:)/sgn
+                clayfraction(ib) = clayfraction(ib)/sgn
+                sandfraction(ib) = sandfraction(ib)/sgn
+                siltfraction(ib) = siltfraction(ib)/sgn
+             ENDIF
+          ENDIF
+       ENDDO
+   
+    ! The "USDA" case reads a map of the 12 USDA texture classes, 
+    ! such as to assign the corresponding soil properties
+    CASE("usda")
+       IF (printlev_loc>=2) WRITE(numout,*) "Using a soilclass map with usda classification"
+
+       soilclass_default=soilclass_default_usda
+
+       ALLOCATE(textfrac_table(nscm,ntext), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for textfrac_table','','')
+
+       CALL get_soilcorr_usda (nscm, textfrac_table)
+
+       IF (printlev_loc>=4) WRITE (numout,*) 'slowproc_soilt: After get_soilcorr_usda'
+       !
+       DO ib =1, nbpt
+          !
+          ! GO through the point we have found
+          !
+          !
+          ! Provide which textures were found
+          ! vecpos: List of positions where textures were not zero
+          !   vecpos(1): number of not null textures found
+          vecpos = interpweight_ValVecR(textrefrac(ib,:),ntextinfile,zero,'neq')
+          fopt = vecpos(1)
+         
+          !
+          !    Check that we found some points
+          !
+          soilclass(ib,:) = 0.0
+          clayfraction(ib) = 0.0
+          sandfraction(ib) = 0.0
+          siltfraction(ib) = 0.0
+          
+          IF ( fopt .EQ. 0) THEN
+             ! No points were found for current grid box, use default values
+             IF (printlev_loc>=3) WRITE(numout,*)'slowproc_soilt: no soil class in input file found for point=', ib
+             nbexp = nbexp + 1
+             soilclass(ib,:) = soilclass_default
+             clayfraction(ib) = clayfraction_default
+             sandfraction(ib) = sandfraction_default
+             siltfraction(ib) = siltfraction_default
+          ELSE
+             IF (fopt == nscm) THEN
+                ! All textures are not zero
+                solt(:) = (/(i,i=1,nscm)/)
+             ELSE
+               DO ilf = 1,fopt
+                 solt(ilf) = vecpos(ilf+1) 
+               END DO
+             END IF
+             !
+             !
+             !   Compute the fraction of each textural class  
+             !
+             !
+             DO ilf = 1,fopt
+                IF ( (solt(ilf) .LE. nscm) .AND. (solt(ilf) .GT. 0) ) THEN
+                   soilclass(ib,solt(ilf)) = textrefrac(ib,solt(ilf))
+                   clayfraction(ib) = clayfraction(ib) + textfrac_table(solt(ilf),3) * &
+                        textrefrac(ib,solt(ilf))
+                   sandfraction(ib) = sandfraction(ib) + textfrac_table(solt(ilf),2) * &
+                        textrefrac(ib,solt(ilf))
+                   siltfraction(ib) = siltfraction(ib) + textfrac_table(solt(ilf),1) * &
+                        textrefrac(ib,solt(ilf))
+                ELSE
+                   IF (solt(ilf) .GT. nscm) THEN
+                      WRITE(*,*) 'The file contains a soil color class which is incompatible with this program'
+                      CALL ipslerr_p(3,'slowproc_soilt','Problem soil color class incompatible 2','','')
+                   ENDIF
+                ENDIF
+                !
+             ENDDO
+
+             ! Set default values if the surface in source file is too small
+             IF ( atext(ib) .LT. min_sechiba) THEN
+                nbexp = nbexp + 1
+                soilclass(ib,:) = soilclass_default(:)
+                clayfraction(ib) = clayfraction_default
+                sandfraction(ib) = sandfraction_default
+                siltfraction(ib) = siltfraction_default
+             ENDIF
+          ENDIF
+
+       ENDDO
+       IF (printlev_loc>=4) WRITE (numout,*) '  slowproc_soilt: End case usda'
+       
+    CASE DEFAULT
+       WRITE(numout,*) 'slowproc_soilt _______'
+       WRITE(numout,*) '  A non supported soil type classification has been chosen'
+       CALL ipslerr_p(3,'slowproc_soilt','non supported soil type classification','','')
+    ENDSELECT
+    IF (printlev_loc >= 5 ) WRITE(numout,*)'  slowproc_soilt end of type classification'
+
+    IF ( nbexp .GT. 0 ) THEN
+       WRITE(numout,*) 'slowproc_soilt:'
+       WRITE(numout,*) '  The interpolation of the bare soil albedo had ', nbexp
+       WRITE(numout,*) '  points without data. This are either coastal points or ice covered land.'
+       WRITE(numout,*) '  The problem was solved by using the default soil types.'
+    ENDIF
+
+    IF (ALLOCATED(variabletypevals)) DEALLOCATE (variabletypevals)
+    IF (ALLOCATED(textrefrac)) DEALLOCATE (textrefrac)
+    IF (ALLOCATED(solt)) DEALLOCATE (solt)
+    IF (ALLOCATED(textfrac_table)) DEALLOCATE (textfrac_table)
+
+    ! Write diagnostics
+    CALL xios_orchidee_send_field("atext",atext)
+    
+    IF (printlev_loc >= 3) WRITE(numout,*) '  slowproc_soilt ended'
+
+  END SUBROUTINE slowproc_soilt
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_slope
+!!
+!>\BRIEF         Calculate mean slope coef in each  model grid box from the slope map
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::reinf_slope
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_slope(nbpt, lalo, neighbours, resolution, contfrac, reinf_slope)
+
+    USE interpweight
+
+    IMPLICIT NONE
+
+
+  !! 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,NbNeighb) !! Vector of neighbours for each grid point
+                                                                !! (1=North and then clockwise)
+    REAL(r_std), INTENT(in)        :: resolution(nbpt,2)        !! The size in km of each grid-box in X and Y
+    REAL(r_std), INTENT (in)       :: contfrac(nbpt)            !! Fraction of continent in the grid
+    
+   !! 0.2 OUTPUT
+    REAL(r_std), INTENT(out)       ::  reinf_slope(nbpt)        !! slope coef 
+  
+   !! 0.3 LOCAL
+    REAL(r_std)                    :: slope_noreinf             !! Slope above which runoff is maximum
+    CHARACTER(LEN=80)              :: filename
+    REAL(r_std)                    :: vmin, vmax                !! min/max values to use for the 
+                                                                !! renormalization
+    REAL(r_std), DIMENSION(nbpt)   :: aslope                    !! slope availability 
+    CHARACTER(LEN=80)              :: variablename              !! Variable to interpolate
+    CHARACTER(LEN=80)              :: lonname, latname          !! lon, lat name in the input file
+    CHARACTER(LEN=50)              :: fractype                  !! method of calculation of fraction
+                                                                !! 'XYKindTime': Input values are kinds 
+                                                                !! of something with a temporal 
+                                                                !! evolution on the dx*dy matrix'
+    LOGICAL                        :: nonegative                !! whether negative values should be removed
+    CHARACTER(LEN=50)              :: maskingtype               !! Type of masking
+                                                                !! 'nomask': no-mask is applied
+                                                                !! 'mbelow': take values below maskvals(1)
+                                                                !! 'mabove': take values above maskvals(1)
+                                                                !! 'msumrange': take values within 2 ranges;
+                                                                !! maskvals(2) <= SUM(vals(k)) <= maskvals(1)
+                                                                !! maskvals(1) < SUM(vals(k)) <= maskvals(3)
+                                                                !! (normalized by maskvals(3))
+                                                                !! 'var': mask values are taken from a 
+                                                                !! variable inside the file  (>0)
+    REAL(r_std), DIMENSION(3)      :: maskvals                  !! values to use to mask (according to 
+                                                                !! `maskingtype') 
+    CHARACTER(LEN=250)             :: namemaskvar               !! name of the variable to use to mask 
+
+!_ ================================================================================================================================
+
+    !
+    !Config Key   = SLOPE_NOREINF
+    !Config Desc  = See slope_noreinf above
+    !Config If    = 
+    !Config Def   = 0.5
+    !Config Help  = The slope above which there is no reinfiltration
+    !Config Units = [-]
+    slope_noreinf = 0.5
+    CALL getin_p('SLOPE_NOREINF',slope_noreinf)
+    !
+    !Config Key   = TOPOGRAPHY_FILE
+    !Config Desc  = Name of file from which the topography map is to be read
+    !Config If    = 
+    !Config Def   = cartepente2d_15min.nc
+    !Config Help  = The name of the file to be opened to read the orography
+    !Config         map is to be given here. Usualy SECHIBA runs with a 2'
+    !Config         map which is derived from the NGDC one. 
+    !Config Units = [FILE]
+    filename = 'cartepente2d_15min.nc'
+    CALL getin_p('TOPOGRAPHY_FILE',filename)
+
+    variablename = 'pente'
+    IF (printlev_loc >= 2) WRITE(numout,*) "slowproc_slope: Start interpolate " &
+         // TRIM(filename) // " for variable " // TRIM(variablename)
+
+    ! For this case there are not types/categories. We have 'only' a continuous field
+    ! Assigning values to vmin, vmax
+    vmin = 0.
+    vmax = 9999.
+
+    !! Variables for interpweight
+    ! Type of calculation of cell fractions
+    fractype = 'slopecalc'
+    ! Name of the longitude and latitude in the input file
+    lonname = 'longitude'
+    latname = 'latitude'
+    ! Should negative values be set to zero from input file?
+    nonegative = .FALSE.
+    ! Type of mask to apply to the input data (see header for more details)
+    maskingtype = 'mabove'
+    ! Values to use for the masking
+    maskvals = (/ min_sechiba, undef_sechiba, undef_sechiba /)
+    ! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
+    namemaskvar = ''
+
+    CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours,                                &
+      contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype,        &
+      maskvals, namemaskvar, -1, fractype, slope_default, slope_noreinf,                              &
+      reinf_slope, aslope)
+    IF (printlev_loc >= 5) WRITE(numout,*)'  slowproc_slope after interpweight_2Dcont'
+
+    ! Write diagnostics
+    CALL xios_orchidee_send_field("aslope",aslope)
+
+    IF (printlev_loc >= 3) WRITE(numout,*) '  slowproc_slope ended'
+
+  END SUBROUTINE slowproc_slope
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_Ninput
+!!
+!>\BRIEF         Read Ninput map
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::N_input
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_Ninput(nbpt, lalo, neighbours, resolution, &
+       contfrac, Ninput_field, Ninput_vec, Ninput_year,veget_max)
+    
+    
+    
+    !  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,NbNeighb) !! Vector of neighbours for each grid point 
+                                                               !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std),INTENT(in)        :: resolution(nbpt,2)        !! The size in km of each grid-box in X and Y
+    REAL(r_std),INTENT(in)        :: contfrac(nbpt)            !! Fraction of continent in the grid
+    CHARACTER(LEN=80),INTENT(in)  :: Ninput_field              !! Name of the default field reading in the map
+    INTEGER(i_std),INTENT(in)     :: Ninput_year               !! year for N inputs update
+    REAL(r_std),DIMENSION (nbpt,nvm), INTENT(in) :: veget_max  !! Maximumfraction of vegetation type including none biological fraction (unitless)
+
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std),INTENT(out)       ::  Ninput_vec(nbpt,nvm,12)  !! Nitrogen input (kgN m-2 yr-1) 
+    !
+    !  0.3 LOCAL
+    !
+    !
+    CHARACTER(LEN=80)             :: filename
+    CHARACTER(LEN=30)             :: callsign
+    INTEGER(i_std)                :: iml, jml, lml, tml, fid, ib, ip, jp, vid, l, im
+    INTEGER(i_std)                :: nb_coord, nb_var, nb_gat, nb_dim
+    INTEGER(i_std)                :: idi, idi_last, nbvmax
+    REAL(r_std)                   :: coslat
+    REAL(r_std),DIMENSION(12)     :: Ninput_val
+    INTEGER(i_std),ALLOCATABLE,DIMENSION(:,:)   :: mask
+    INTEGER(i_std),ALLOCATABLE,DIMENSION(:,:,:) :: sub_index
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:)      :: lat_rel, lon_rel 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)    :: Ninput_map
+    REAL(r_std),ALLOCATABLE,DIMENSION(:)        :: lat_lu, lon_lu
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:)      :: sub_area
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)    :: resol_lu
+    REAL(r_std)                                 :: Ninput_read(nbpt,12)       ! Nitrogen input temporary variable  
+    REAL(r_std)                                 :: SUMveg_max(nbpt)           ! Sum of veget_max grid cell 
+    REAL(r_std)                                 :: SUMmanure_pftweight(nbpt)  ! Sum of veget_max*manure_pftweight grid cell
+    INTEGER(i_std) :: nix, njx,iv
+    !
+    LOGICAL                       :: ok_interpol = .FALSE.             !! optionnal return of aggregate_2d
+    !
+    INTEGER                       :: ALLOC_ERR
+    CHARACTER(LEN=80)             :: Ninput_field_read                 !! Name of the field reading in the map
+    CHARACTER(LEN=80)             :: Ninput_year_str                   !! Ninput year as a string variable
+    LOGICAL                       :: latitude_exists, longitude_exists !! Test existence of variables in the input files
+
+!_ ================================================================================================================================
+
+  
+    !Config Key   = NINPUT File
+    !Config Desc  = Name of file from which the N-input map is to be read
+    !Config If    = 
+    !Config Def   = 'Ninput_fied'.nc
+    !Config Help  = The name of the file to be opened to read the N-input map
+    !Config Units = [FILE]
+    !
+    filename = TRIM(Ninput_field)//'.nc'
+    CALL getin_p(TRIM(Ninput_field)//'_FILE',filename)
+
+
+    !Config Key   = NINPUT var
+    !Config Desc  = Name of the variable in the file from which the N-input map is to be read
+    !Config If    = 
+    !Config Def   = 'Ninput_fied'
+    !Config Help  = The name of the variable  to be read for the N-input map
+    !Config Units = [FILE]
+    !
+    Ninput_field_read=Ninput_field
+    CALL getin_p(TRIM(Ninput_field)//'_VAR',Ninput_field_read)
+    !
+
+    ! Are we reading, what we are expecting to read
+    WRITE(numout,*)'filename',filename    
+    WRITE(numout,*)'Ninput_field',Ninput_field
+    WRITE(numout,*)'Ninput_field_read',Ninput_field_read
+
+    IF((TRIM(filename) .NE. 'NONE') .AND. (TRIM(filename) .NE. 'none')) THEN
+
+       IF(Ninput_suffix_year) THEN
+          l=INDEX(TRIM(filename),'.nc')
+          WRITE(Ninput_year_str,'(i4)') Ninput_year
+          filename=TRIM(filename(1:(l-1)))//'_'//Ninput_year_str//'.nc'
+       ENDIF
+
+       IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+       CALL bcast(iml)
+       CALL bcast(jml)
+       CALL bcast(lml)
+       CALL bcast(tml)
+       
+       ALLOCATE(lat_lu(jml), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_ninput','Problem in allocation of variable lat_lu','','')
+   
+       ALLOCATE(lon_lu(iml), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_ninput','Problem in allocation of variable lon_lu','','')
+   
+       ALLOCATE(Ninput_map(iml,jml,tml), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_ninput','Problem in allocation of variable Ninput_map','','')
+   
+       ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_ninput','Problem in allocation of variable resol_lu','','')
+   
+       WRITE(numout,*) 'Reading the Ninput file'
+   
+       IF (is_root_prc) THEN
+          CALL flinquery_var(fid, 'longitude', longitude_exists)
+          IF(longitude_exists)THEN
+             CALL flinget(fid, 'longitude', iml, 0, 0, 0, 1, 1, lon_lu)
+          ELSE
+             CALL flinget(fid, 'lon', iml, 0, 0, 0, 1, 1, lon_lu)
+          ENDIF
+          CALL flinquery_var(fid, 'latitude', latitude_exists)
+          IF(latitude_exists)THEN
+             CALL flinget(fid, 'latitude', jml, 0, 0, 0, 1, 1, lat_lu)
+          ELSE
+             CALL flinget(fid, 'lat', jml, 0, 0, 0, 1, 1, lat_lu)
+          ENDIF
+          CALL flinget(fid, Ninput_field_read, iml, jml, 0, tml, 1, tml, Ninput_map)
+          !
+          CALL flinclo(fid)
+       ENDIF
+       CALL bcast(lon_lu)
+       CALL bcast(lat_lu)
+       CALL bcast(Ninput_map)
+       
+       
+
+       ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable lon_rel','','')
+   
+       ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable lat_rel','','')
+   
+       DO ip=1,iml
+          lat_rel(ip,:) = lat_lu(:)
+       ENDDO
+       DO jp=1,jml
+          lon_rel(:,jp) = lon_lu(:)
+       ENDDO
+       !
+       !
+       ! Mask of permitted variables.
+       !
+       ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable mask','','')
+   
+       mask(:,:) = zero
+       DO ip=1,iml
+          DO jp=1,jml
+             IF (ANY(Ninput_map(ip,jp,:) .GE. 0.)) THEN
+                mask(ip,jp) = un
+             ENDIF
+             !
+             ! Resolution in longitude
+             !
+             coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )     
+             IF ( ip .EQ. 1 ) THEN
+                resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip,jp) ) * pi/180. * R_Earth * coslat
+             ELSEIF ( ip .EQ. iml ) THEN
+                resol_lu(ip,jp,1) = ABS( lon_rel(ip,jp) - lon_rel(ip-1,jp) ) * pi/180. * R_Earth * coslat
+             ELSE
+                resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
+             ENDIF
+             !
+             ! Resolution in latitude
+             !
+             IF ( jp .EQ. 1 ) THEN
+                resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp) - lat_rel(ip,jp+1) ) * pi/180. * R_Earth
+             ELSEIF ( jp .EQ. jml ) THEN
+                resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp) ) * pi/180. * R_Earth
+             ELSE
+                resol_lu(ip,jp,2) =  ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp+1) )/2. * pi/180. * R_Earth
+             ENDIF
+             !
+          ENDDO
+       ENDDO
+       !
+       !
+       ! The number of maximum vegetation map points in the GCM grid is estimated.
+       ! Some lmargin is taken.
+       !
+       IF (is_root_prc) THEN
+          nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
+          njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
+          nbvmax = nix*njx
+       ENDIF
+       CALL bcast(nbvmax)
+       !
+       callsign="Ninput map"
+       ok_interpol = .FALSE.
+       DO WHILE ( .NOT. ok_interpol )
+          !
+          WRITE(numout,*) "Projection arrays for ",callsign," : "
+          WRITE(numout,*) "nbvmax = ",nbvmax
+   
+          ALLOCATE(sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_Ninput','Problem in allocation of variable sub_index','','')
+          sub_index(:,:,:)=0
+   
+          ALLOCATE(sub_area(nbpt,nbvmax), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_Ninput','Problem in allocation of variable sub_area','','')
+          sub_area(:,:)=zero
+   
+          CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+               &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+               &                nbvmax, sub_index, sub_area, ok_interpol)
+          
+          IF (.NOT. ok_interpol ) THEN
+             IF (printlev_loc>=3) WRITE(numout,*) 'nbvmax will be increased from ',nbvmax,' to ', nbvmax*2
+             DEALLOCATE(sub_area)
+             DEALLOCATE(sub_index)
+             nbvmax = nbvmax * 2
+          END IF
+       END DO
+       !
+       !
+       DO ib = 1, nbpt
+         ! Calcule of the total veget_max per grid cell
+         SUMveg_max(ib) = SUM(veget_max(ib,:))
+         ! Calcule of veget_max*manure_pftweight per grid cell
+         SUMmanure_pftweight(ib) = SUM(veget_max(ib,:)*manure_pftweight(:))
+         !-
+         !- Reinfiltration coefficient due to the slope: Calculation with parameteres maxlope_ro 
+         !-
+         Ninput_val(:) = zero
+   
+         ! Initialize last index to the highest possible 
+         idi_last=nbvmax
+         DO idi=1, nbvmax
+            ! Leave the do loop if all sub areas are treated, sub_area <= 0
+            IF ( sub_area(ib,idi) <= zero ) THEN
+               ! Set last index to the last one used
+               idi_last=idi-1
+               ! Exit do loop
+               EXIT
+            END IF
+            ip = sub_index(ib,idi,1)
+            jp = sub_index(ib,idi,2)
+    
+ 
+            IF(tml == 12) THEN
+               Ninput_val(:) = Ninput_val(:) + Ninput_map(ip,jp,:) * sub_area(ib,idi)
+            ELSE
+                Ninput_val(:) = Ninput_val(:) + Ninput_map(ip,jp,1) * sub_area(ib,idi)
+            ENDIF
+         ENDDO
+         
+         IF ( idi_last >= 1 ) THEN
+            Ninput_read(ib,:) = Ninput_val(:) / SUM(sub_area(ib,1:idi_last)) 
+         ELSE
+            CALL ipslerr_p(2,'slowproc_ninput', '', '',&
+               &                 'No information for a point') ! Warning error
+            Ninput_read(ib,:) = 0.
+         ENDIF
+       ENDDO
+       !
+
+       !       
+       ! Initialize Ninput_vec
+       Ninput_vec(:,:,:) = 0.
+       SELECT CASE (Ninput_field)
+          CASE ("Nammonium")
+             DO iv = 1,nvm 
+                Ninput_vec(:,iv,:) = Ninput_read(:,:)
+             ENDDO
+          CASE ("Nnitrate")
+             DO iv = 1,nvm 
+                Ninput_vec(:,iv,:) = Ninput_read(:,:)
+             ENDDO
+          CASE ("Nfert")
+             DO iv = 1,nvm 
+                IF ( .NOT. natural(iv) ) THEN
+                   Ninput_vec(:,iv,:) = Ninput_read(:,:)
+                ENDIF
+             ENDDO
+          CASE ("Nfert_cropland")
+             DO iv = 1,nvm 
+                IF ( .NOT. natural(iv) ) THEN
+                   Ninput_vec(:,iv,:) = Ninput_read(:,:)
+                ENDIF
+             ENDDO
+          CASE ("Nmanure_cropland")
+             DO iv = 1,nvm 
+                IF ( .NOT. natural(iv) ) THEN
+                   Ninput_vec(:,iv,:) = Ninput_read(:,:)
+                ENDIF
+             ENDDO
+          CASE ("Nfert_pasture")
+             DO iv = 1,nvm 
+                IF ( natural(iv) .AND. (.NOT.(is_tree(iv))) ) THEN
+                   Ninput_vec(:,iv,:) = Ninput_read(:,:)
+                ENDIF
+             ENDDO
+          CASE ("Nmanure_pasture")
+             DO iv = 1,nvm 
+                IF ( natural(iv) .AND. (.NOT.(is_tree(iv))) ) THEN
+                   Ninput_vec(:,iv,:) = Ninput_read(:,:)
+                ENDIF
+             ENDDO
+
+          CASE ("Nmanure")
+             DO im = 1,12
+                DO iv = 1,nvm 
+                   WHERE ( (SUMmanure_pftweight(:)) .GT. zero )
+                      Ninput_vec(:,iv,im) = Ninput_read(:,im)*manure_pftweight(iv)*SUMveg_max(:)/SUMmanure_pftweight(:)
+                   ENDWHERE
+                ENDDO
+             ENDDO
+          CASE ("Nbnf")
+             DO iv = 1,nvm 
+                IF ( natural(iv) ) THEN 
+                   Ninput_vec(:,iv,:) = Ninput_read(:,:)
+                ENDIF
+             ENDDO
+          CASE default
+             WRITE (numout,*) 'This kind of Ninput_field choice is not possible. '
+             CALL ipslerr_p(3,'slowproc_ninput', '', '',&
+               &              'This kind of Ninput_field choice is not possible.') ! Fatal error
+       END SELECT
+       !
+       WRITE(numout,*) 'Interpolation Done'
+       !
+       !
+       DEALLOCATE(Ninput_map)
+       DEALLOCATE(sub_index)
+       DEALLOCATE(sub_area)
+       DEALLOCATE(mask)
+       DEALLOCATE(lon_lu)
+       DEALLOCATE(lat_lu)
+       DEALLOCATE(lon_rel)
+       DEALLOCATE(lat_rel)
+    ELSE
+       Ninput_vec(:,:,:)=zero
+    ENDIF
+ 
+  END SUBROUTINE slowproc_Ninput
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: get_soilcorr_zobler
+!!
+!>\BRIEF         The "get_soilcorr" routine defines the table of correspondence
+!!               between the Zobler types and the three texture types known by SECHIBA and STOMATE :
+!!               silt, sand and clay. 
+!!
+!! DESCRIPTION : get_soilcorr is needed if you use soils_param.nc .\n
+!!               The data from this file is then interpolated to the grid of the model. \n
+!!               The aim is to get fractions for sand loam and clay in each grid box.\n
+!!               This information is used for soil hydrology and respiration.
+!!
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::texfrac_table
+!!
+!! REFERENCE(S)	: 
+!! - Zobler L., 1986, A World Soil File for global climate modelling. NASA Technical memorandum 87802. NASA 
+!!   Goddard Institute for Space Studies, New York, U.S.A.
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE get_soilcorr_zobler (nzobler,textfrac_table)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+    
+    INTEGER(i_std),PARAMETER :: nbtypes_zobler = 7                    !! Number of Zobler types (unitless)
+
+    !! 0.1  Input variables
+    
+    INTEGER(i_std),INTENT(in) :: nzobler                              !! Size of the array (unitless)
+    
+    !! 0.2 Output variables 
+    
+    REAL(r_std),DIMENSION(nzobler,ntext),INTENT(out) :: textfrac_table !! Table of correspondence between soil texture class
+                                                                       !! and granulometric composition (0-1, unitless)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std) :: ib                                              !! Indice (unitless)
+    
+!_ ================================================================================================================================
+
+    !-
+    ! 0. Check consistency
+    !-  
+    IF (nzobler /= nbtypes_zobler) THEN 
+       CALL ipslerr_p(3,'get_soilcorr', 'nzobler /= nbtypes_zobler',&
+          &   'We do not have the correct number of classes', &
+          &                 ' in the code for the file.')  ! Fatal error
+    ENDIF
+
+    !-
+    ! 1. Textural fraction for : silt        sand         clay
+    !-
+    textfrac_table(1,:) = (/ 0.12, 0.82, 0.06 /)
+    textfrac_table(2,:) = (/ 0.32, 0.58, 0.10 /)
+    textfrac_table(3,:) = (/ 0.39, 0.43, 0.18 /)
+    textfrac_table(4,:) = (/ 0.15, 0.58, 0.27 /)
+    textfrac_table(5,:) = (/ 0.34, 0.32, 0.34 /)
+    textfrac_table(6,:) = (/ 0.00, 1.00, 0.00 /)
+    textfrac_table(7,:) = (/ 0.39, 0.43, 0.18 /)
+
+
+    !-
+    ! 2. Check the mapping for the Zobler types which are going into the ORCHIDEE textures classes 
+    !-
+    DO ib=1,nzobler ! Loop over # classes soil
+       
+       IF (ABS(SUM(textfrac_table(ib,:))-1.0) > EPSILON(1.0)) THEN ! The sum of the textural fractions should not exceed 1 !
+          WRITE(numout,*) &
+               &     'Error in the correspondence table', &
+               &     ' sum is not equal to 1 in', ib
+          WRITE(numout,*) textfrac_table(ib,:)
+          CALL ipslerr_p(3,'get_soilcorr', 'SUM(textfrac_table(ib,:)) /= 1.0',&
+               &                 '', 'Error in the correspondence table') ! Fatal error
+       ENDIF
+       
+    ENDDO ! Loop over # classes soil
+
+    
+  END SUBROUTINE get_soilcorr_zobler
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: get_soilcorr_usda
+!!
+!>\BRIEF         The "get_soilcorr_usda" routine defines the table of correspondence
+!!               between the 12 USDA textural classes and their granulometric composition, 
+!!               as % of silt, sand and clay. This is used to further defien clayfraction.
+!!
+!! DESCRIPTION : get_soilcorr is needed if you use soils_param.nc .\n
+!!               The data from this file is then interpolated to the grid of the model. \n
+!!               The aim is to get fractions for sand loam and clay in each grid box.\n
+!!               This information is used for soil hydrology and respiration.
+!!               The default map in this case is derived from Reynolds et al 2000, \n
+!!               at the 1/12deg resolution, with indices that are consistent with the \n
+!!               textures tabulated below
+!!
+!! RECENT CHANGE(S): Created by A. Ducharne on July 02, 2014
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::texfrac_table
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE get_soilcorr_usda (nusda,textfrac_table)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+    
+    !! 0.1  Input variables
+    
+    INTEGER(i_std),INTENT(in) :: nusda                               !! Size of the array (unitless)
+    
+    !! 0.2 Output variables 
+    
+    REAL(r_std),DIMENSION(nusda,ntext),INTENT(out) :: textfrac_table !! Table of correspondence between soil texture class
+                                                                     !! and granulometric composition (0-1, unitless)
+    
+    !! 0.4 Local variables
+
+    INTEGER(i_std),PARAMETER :: nbtypes_usda = 12                    !! Number of USDA texture classes (unitless)
+    INTEGER(i_std) :: n                                              !! Index (unitless)
+    
+!_ ================================================================================================================================
+
+    !-
+    ! 0. Check consistency
+    !-  
+    IF (nusda /= nbtypes_usda) THEN 
+       CALL ipslerr_p(3,'get_soilcorr', 'nusda /= nbtypes_usda',&
+          &   'We do not have the correct number of classes', &
+          &                 ' in the code for the file.')  ! Fatal error
+    ENDIF
+
+    !! Parameters for soil type distribution :
+    !! Sand, Loamy Sand, Sandy Loam, Silt Loam, Silt, Loam, Sandy Clay Loam, Silty Clay Loam, Clay Loam, Sandy Clay, Silty Clay, Clay
+    ! The order comes from constantes_soil.f90
+    ! The corresponding granulometric composition comes from Carsel & Parrish, 1988
+
+    !-
+    ! 1. Textural fractions for : sand, clay
+    !-
+    textfrac_table(1,2:3)  = (/ 0.93, 0.03 /) ! Sand
+    textfrac_table(2,2:3)  = (/ 0.81, 0.06 /) ! Loamy Sand
+    textfrac_table(3,2:3)  = (/ 0.63, 0.11 /) ! Sandy Loam
+    textfrac_table(4,2:3)  = (/ 0.17, 0.19 /) ! Silt Loam
+    textfrac_table(5,2:3)  = (/ 0.06, 0.10 /) ! Silt
+    textfrac_table(6,2:3)  = (/ 0.40, 0.20 /) ! Loam
+    textfrac_table(7,2:3)  = (/ 0.54, 0.27 /) ! Sandy Clay Loam
+    textfrac_table(8,2:3)  = (/ 0.08, 0.33 /) ! Silty Clay Loam
+    textfrac_table(9,2:3)  = (/ 0.30, 0.33 /) ! Clay Loam
+    textfrac_table(10,2:3) = (/ 0.48, 0.41 /) ! Sandy Clay
+    textfrac_table(11,2:3) = (/ 0.06, 0.46 /) ! Silty Clay
+    textfrac_table(12,2:3) = (/ 0.15, 0.55 /) ! Clay
+
+    ! Fraction of silt
+
+    DO n=1,nusda
+       textfrac_table(n,1) = 1. - textfrac_table(n,2) - textfrac_table(n,3)
+    END DO
+       
+  END SUBROUTINE get_soilcorr_usda
+
+!! ================================================================================================================================
+!! FUNCTION 	: tempfunc
+!!
+!>\BRIEF        ! This function interpolates value between ztempmin and ztempmax
+!! used for lai detection. 
+!!
+!! DESCRIPTION   : This subroutine calculates a scalar between 0 and 1 with the following equation :\n
+!!                 \latexonly
+!!                 \input{constantes_veg_tempfunc.tex}
+!!                 \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : tempfunc_result
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION tempfunc (temp_in) RESULT (tempfunc_result)
+
+
+    !! 0. Variables and parameters declaration
+
+    REAL(r_std),PARAMETER    :: ztempmin=273._r_std   !! Temperature for laimin (K)
+    REAL(r_std),PARAMETER    :: ztempmax=293._r_std   !! Temperature for laimax (K)
+    REAL(r_std)              :: zfacteur              !! Interpolation factor   (K^{-2})
+
+    !! 0.1 Input variables
+
+    REAL(r_std),INTENT(in)   :: temp_in               !! Temperature (K)
+
+    !! 0.2 Result
+
+    REAL(r_std)              :: tempfunc_result       !! (unitless)
+    
+!_ ================================================================================================================================
+
+    !! 1. Define a coefficient
+    zfacteur = un/(ztempmax-ztempmin)**2
+    
+    !! 2. Computes tempfunc
+    IF     (temp_in > ztempmax) THEN
+       tempfunc_result = un
+    ELSEIF (temp_in < ztempmin) THEN
+       tempfunc_result = zero
+    ELSE
+       tempfunc_result = un-zfacteur*(ztempmax-temp_in)**2
+    ENDIF !(temp_in > ztempmax)
+
+
+  END FUNCTION tempfunc
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_checkveget
+!!
+!>\BRIEF         To verify the consistency of the various fractions defined within the grid box after having been
+!!               been updated by STOMATE or the standard procedures.
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: none
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!
+   SUBROUTINE slowproc_checkveget(nbpt, frac_nobio, veget_max, veget, tot_bare_soil, soiltile)
+ 
+
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)                      :: nbpt           !! Number of points for which the data needs to be interpolated
+    REAL(r_std),DIMENSION (nbpt,nnobio), INTENT(in) :: frac_nobio     !! Fraction of ice,lakes,cities, ... (unitless)
+    REAL(r_std),DIMENSION (nbpt,nvm), INTENT(in)    :: veget_max      !! Maximum fraction of vegetation type including none 
+                                                                      !! biological fraction (unitless) 
+    REAL(r_std),DIMENSION (nbpt,nvm), INTENT(in)    :: veget          !! Vegetation fractions in the mesh (unitless)
+    REAL(r_std),DIMENSION (nbpt), INTENT(in)        :: tot_bare_soil  !! Total evaporating bare soil fraction (unitless)
+    REAL(r_std),DIMENSION (nbpt,nstm), INTENT(in)   :: soiltile       !! Fraction of soil tile within vegtot (0-1, unitless)
+
+    !  0.3 LOCAL
+    !
+    INTEGER(i_std) :: ji, jn, jv, js
+    REAL(r_std)  :: epsilocal  !! A very small value
+    REAL(r_std)  :: totfrac
+    CHARACTER(len=80) :: str1, str2
+    INTEGER(i_std), PARAMETER :: ibaresoil=1
+    
+!_ ================================================================================================================================
+    
+    !
+    ! There is some margin added as the computing errors might bring us above EPSILON(un)
+    !
+    epsilocal = EPSILON(un)*1000.
+    
+    !! 1.0 Verify that none of the fractions are smaller than min_vegfrac, without beeing zero.
+    !!
+    DO ji=1,nbpt
+       DO jn=1,nnobio
+          IF ( frac_nobio(ji,jn) > epsilocal .AND. frac_nobio(ji,jn) < min_vegfrac ) THEN
+             WRITE(str1,'("Occurs on grid box", I8," and nobio type ",I3 )') ji, jn
+             WRITE(str2,'("The small value obtained is ", E14.4)') frac_nobio(ji,jn)
+             CALL ipslerr_p (3,'slowproc_checkveget', &
+                  "frac_nobio is larger than zero but smaller than min_vegfrac.", str1, str2)
+          ENDIF
+       ENDDO
+    END DO
+    
+    IF (.NOT. ok_dgvm) THEN       
+       DO ji=1,nbpt
+          DO jv=1,nvm
+             IF ( veget_max(ji,jv) > epsilocal .AND. veget_max(ji,jv) < min_vegfrac ) THEN
+                WRITE(str1,'("Occurs on grid box", I8," and nvm ",I3 )') ji, jv
+                WRITE(str2,'("The small value obtained is ", E14.4)') veget_max(ji,jv)
+                CALL ipslerr_p (3,'slowproc_checkveget', &
+                     "veget_max is larger than zero but smaller than min_vegfrac.", str1, str2)
+             ENDIF
+          ENDDO
+       ENDDO
+    END IF
+    
+    !! 2.0 verify that with all the fractions we cover the entire grid box  
+    !!
+    DO ji=1,nbpt
+       totfrac = zero
+       DO jn=1,nnobio
+          totfrac = totfrac + frac_nobio(ji,jn)
+       ENDDO
+       DO jv=1,nvm
+          totfrac = totfrac + veget_max(ji,jv)
+       ENDDO
+       IF ( ABS(totfrac - un) > epsilocal) THEN
+             WRITE(str1,'("This occurs on grid box", I8)') ji
+             WRITE(str2,'("The sum over all fraction and error are ", E14.4, E14.4)') totfrac, ABS(totfrac - un)
+             CALL ipslerr_p (3,'slowproc_checkveget', &
+                   "veget_max + frac_nobio is not equal to 1.", str1, str2)
+             WRITE(*,*) "EPSILON =", epsilocal 
+       ENDIF
+    ENDDO
+    
+    !! 3.0 Verify that veget is smaller or equal to veget_max
+    !!
+    DO ji=1,nbpt
+       DO jv=1,nvm
+          IF ( jv == ibaresoil ) THEN
+             IF ( ABS(veget(ji,jv) - veget_max(ji,jv)) > epsilocal ) THEN
+                WRITE(str1,'("This occurs on grid box", I8)') ji
+                WRITE(str2,'("The difference is ", E14.4)') veget(ji,jv) - veget_max(ji,jv)
+                CALL ipslerr_p (3,'slowproc_checkveget', &
+                     "veget is not equal to veget_max on bare soil.", str1, str2)
+             ENDIF
+          ELSE
+             IF ( veget(ji,jv) > veget_max(ji,jv) ) THEN
+                WRITE(str1,'("This occurs on grid box", I8)') ji
+                WRITE(str1,'("This occurs on PFT", I8)') jv
+                WRITE(str2,'("The values for veget and veget_max :", F8.4, F8.4)') veget(ji,jv), veget_max(ji,jv)
+                CALL ipslerr_p (3,'slowproc_checkveget', &
+                     "veget is greater than veget_max.", str1, str2)
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+ 
+   
+    !! 4.0 Test tot_bare_soil in relation to the other variables
+    DO ji=1,nbpt
+       IF (ok_bare_soil_new) THEN
+          totfrac = veget_max(ji,ibaresoil)
+       ELSE
+          totfrac = zero
+          DO jv=1,nvm
+             totfrac = totfrac + (veget_max(ji,jv) - veget(ji,jv))
+          ENDDO
+          ! add the bare soil fraction to totfrac
+          totfrac = totfrac + veget(ji,ibaresoil)
+       ENDIF
+       ! do the test
+       IF ( ABS(totfrac - tot_bare_soil(ji)) > epsilocal ) THEN
+          WRITE(str1,'("This occurs on grid box", I8)') ji
+          WRITE(str2,'("The values for tot_bare_soil, tot frac and error :", F8.4, F8.4, E14.4)') &
+               &  tot_bare_soil(ji), totfrac, ABS(totfrac - tot_bare_soil(ji))
+          CALL ipslerr_p (3,'slowproc_checkveget', &
+               "tot_bare_soil does not correspond to the total bare soil fraction.", str1, str2)
+       ENDIF
+    ENDDO
+    
+    !! 5.0 Test that soiltile has the right sum
+    !!
+    DO ji=1,nbpt
+       totfrac = zero
+       DO js=1,nstm
+          totfrac = totfrac + soiltile(ji,js)
+       ENDDO
+       IF ( ABS(totfrac - un) > epsilocal ) THEN
+          WRITE(str1,'("This occurs on grid box", I8)') ji
+          WRITE(str2,'("The sum of soiltile and error are :", F8.4, E14.4)') soiltile, ABS(totfrac - un)
+          CALL ipslerr_p (3,'slowproc_checkveget', &
+               "soiltile does not sum-up to one.", str1, str2)
+       ENDIF
+    ENDDO
+    
+  END SUBROUTINE slowproc_checkveget
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_change_frac
+!!
+!>\BRIEF        Update the vegetation fractions
+!!
+!! DESCRIPTION  : Update the vegetation fractions. This subroutine is called in the same time step as lcchange in stomatelpj has
+!!                has been done. This subroutine is called after the diagnostics have been written in sechiba_main.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: veget_max, veget, frac_nobio, totfrac_nobio, tot_bare_soil, soiltile
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_change_frac(kjpindex, veget_max, veget, &
+       frac_nobio, totfrac_nobio, tot_bare_soil, soiltile, &
+       circ_class_biomass, circ_class_n, lai_per_level,&
+       z_array_out)
+    !
+    ! 0. Declarations
+    !
+    ! 0.1 Input variables 
+    INTEGER(i_std),INTENT(in)                          :: kjpindex           !! Domain size - terrestrial pixels only
+    REAL(r_std),DIMENSION(:,:,:,:,:),INTENT(in)        :: circ_class_biomass !! Biomass components of the model tree  
+                                                                             !! within a circumference class
+                                                                             !! class @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std),DIMENSION(:,:,:),INTENT(in)            :: circ_class_n       !! Number of trees within each circumference
+                                                                             !! class @tex $(m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(:,:,:),INTENT(in)            :: lai_per_level      !! This is the LAI per vertical level
+                                                                             !! @tex $(m^{2} m^{-2})$ 
+
+    ! 0.2 Output variables
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)    :: veget_max          !! Maximum fraction of vegetation type including none biological fraction (unitless)
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)    :: veget              !! Fraction of vegetation type including in the mesh (unitless)
+    REAL(r_std),DIMENSION(kjpindex,nnobio),INTENT(out) :: frac_nobio         !! Fraction of ice, lakes, cities etc. in the mesh (unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)        :: totfrac_nobio      !! Total fraction of ice+lakes+cities etc. in the mesh (unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)        :: tot_bare_soil      !! Total evaporating bare soil fraction (unitless)
+    REAL(r_std),DIMENSION(kjpindex,nstm),INTENT(out)   :: soiltile           !! Fraction of each soil tile within vegtot (0-1, unitless)
+
+    ! 0.3 Modified variables
+    REAL(r_std),DIMENSION(:,:,:,:),INTENT(inout)       :: z_array_out        !! Same as z_array, but one less dimension.
+
+    ! 0.4 Local variables
+    REAL(r_std),DIMENSION(kjpindex,nvm)                :: lai                !! PFT leaf area index (m^{2} m^{-2})LAI 
+    INTEGER(i_std)                                     :: ji, jv             !! Loop index
+!_ ================================================================================================================================    
+       
+    !! Update vegetation fractions with the values coming from the vegetation file read in slowproc_readvegetmax.
+    !! Partial update has been taken into account for the case with DGVM and AGRICULTURE in slowproc_readvegetmax.
+    veget_max  = veget_max_new
+    frac_nobio = frac_nobio_new
+
+    !! Verification and correction on veget_max, calculation of veget and soiltile.
+    CALL slowproc_veget (kjpindex, lai_per_level, circ_class_biomass, &
+       circ_class_n, frac_nobio, totfrac_nobio, &
+       veget_max, veget, soiltile, tot_bare_soil)
+
+    !! Do some basic tests on the surface fractions updated above
+    CALL slowproc_checkveget(kjpindex, frac_nobio, veget_max, &
+         veget, tot_bare_soil, soiltile)
+     
+  END SUBROUTINE slowproc_change_frac 
+
+END MODULE slowproc
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/thermosoil.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/thermosoil.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/thermosoil.f90	(revision 6412)
@@ -0,0 +1,1802 @@
+! =================================================================================================================================
+! MODULE       : thermosoil
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Calculates the soil temperatures by solving the heat
+!! diffusion equation within the soil. This module is only used with CWRR hydrology.
+!!
+!!\n DESCRIPTION : General important informations about the numerical scheme and
+!!                 the soil vertical discretization:\n
+!!               - the soil is zmaxt deep (by default 10m) and divided into "ngrnd" layers. 
+!!                 From 0-zmaxh(default 2m), the discretization is the same as for hydrology. 
+!!                 From zmaxh(2m) and below, the depth increase linearly (by default) or geometrically. \n
+!!               - "jg" is usually used as the index going from 1 to ngrnd to describe the
+!!                  layers, from top (jg=1) to bottom (jg=ngrnd)\n
+!!               - the thermal numerical scheme is implicit finite differences.\n
+!!                 -- When it is resolved in thermosoil_profile at the present timestep t, the
+!!                 dependancy from the previous timestep (t-1) is hidden in the
+!!                 integration coefficients cgrnd and dgrnd, which are therefore
+!!                 calculated at the very end of thermosoil_main (call to
+!!                 thermosoil_coef) for use in the next timestep.\n
+!!                 -- At timestep t, the system becomes :\n 
+!!
+!!                              T(k+1)=cgrnd(k)+dgrnd(k)*T(k) \n
+!!                                      -- EQ1 -- \n
+!!
+!!                 (the bottom boundary condition has been used to obtained this equation).\n
+!!                 To solve it, the uppermost soil temperature T(1) is required.
+!!                 It is obtained from the surface temperature Ts, which is
+!!                 considered a linear extrapolation of T(1) and T(2)\n
+!!
+!!                           Ts=(1+lambda)*T(1) -lambda*T(2) \n 
+!!                                      -- EQ2--\n
+!!
+!!                 -- caveat 1 : Ts is called 'temp_soil_new' in this routine,
+!!                 don' t act.\n
+!!                 -- caveat 2 : actually, the surface temperature at time t Ts
+!!                 depends on the soil temperature at time t through the
+!!                 ground heat flux. This is again implicitly solved, with Ts(t)
+!!                 expressed as :\n
+!!
+!!                 soilcap*(Ts(t)-Ts(t-1))/dt=soilflx+otherfluxes(Ts(t))\n 
+!!                                      -- EQ3 --\n
+!!
+!!                 and the dependency from the previous timestep is hidden in
+!!                 soilcap and soilflx (apparent surface heat capacity and heat
+!!                 flux respectively). Soilcap and soilflx are therefore
+!!                 calculated at the previous timestep, at the very end of thermosoil
+!!                 (final call to thermosoil_coef) and stored to be used at the next time step.
+!!                 At timestep t, EQ3 is solved for Ts in enerbil, and Ts
+!!                 is used in thermosoil to get T(1) and solve EQ1.\n
+!!
+!! - lambda is the @tex $\mu$ @endtex of F. Hourdin' s PhD thesis, equation (A28); ie the
+!! coefficient of the linear extrapolation of Ts (surface temperature) from T1 and T2 (ptn(jg=1) and ptn(jg=2)), so that:\n
+!! Ts= (1+lambda)*T(1)-lambda*T(2) --EQ2-- \n
+!! lambda = (zlt(1))/((zlt(2)-zlt(1))) \n
+!!
+!! RECENT CHANGE(S) : - Change soil thermal properties to consider also soil texture, rev 2922.
+!!                    - Change vertical discretization, rev 2917. Note: In the revised thermosoil, 
+!!                    cstgrnd and lskin are not needed any more. The depth znt, zlt and dlt
+!!                    are computed in vertical_soil and are in meter
+!!
+!! REFERENCE(S) : None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE thermosoil
+
+  ! modules used :
+  USE ioipsl
+  USE ioipsl_para
+  USE xios_orchidee
+  USE constantes
+  USE constantes_soil
+  USE sechiba_io_p
+  USE grid
+
+  IMPLICIT NONE
+
+  !private and public routines :
+  PRIVATE
+  PUBLIC :: thermosoil_main, thermosoil_clear,  thermosoil_initialize, thermosoil_finalize
+
+  REAL(r_std), SAVE                               :: lambda                   !! See Module description
+!$OMP THREADPRIVATE(lambda)
+  REAL(r_std), SAVE                               :: fz1, zalph               !! usefull constants for diverse use
+!$OMP THREADPRIVATE(fz1, zalph)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ptn                      !! vertically discretized 
+                                                                              !! soil temperatures @tex ($K$) @endtex. 
+!$OMP THREADPRIVATE(ptn)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: dz1                      !! numerical constant used in the thermal numerical
+                                                                              !! scheme  @tex ($m^{-1}$) @endtex. ; it corresponds
+                                                                              !! to the coefficient  @tex $d_k$ @endtex of equation
+                                                                              !! (A.12) in F. Hourdin PhD thesis.
+!$OMP THREADPRIVATE(dz1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: cgrnd                    !! integration coefficient for the numerical scheme,
+                                                                              !! see eq.1
+!$OMP THREADPRIVATE(cgrnd)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dgrnd                    !! integration coefficient for the numerical scheme,
+                                                                              !! see eq.1
+!$OMP THREADPRIVATE(dgrnd)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcapa                    !! volumetric vertically discretized soil heat 
+                                                                              !! capacity  @tex ($J K^{-1} m^{-3}$) @endtex. 
+                                                                              !! It depends on the soil
+                                                                              !! moisture content (shum_ngrnd_perma) and is calculated at 
+                                                                              !! each time step in thermosoil_coef.
+!$OMP THREADPRIVATE(pcapa)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pkappa                   !! vertically discretized soil thermal conductivity 
+                                                                              !!  @tex ($W K^{-1} m^{-1}$) @endtex. Same as pcapa.
+!$OMP THREADPRIVATE(pkappa)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcapa_snow               !! volumetric vertically discretized snow heat 
+                                                                              !! capacity @tex ($J K^{-1} m^{-3}$) @endtex. 
+!$OMP THREADPRIVATE(pcapa_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pkappa_snow              !! vertically discretized snow thermal conductivity 
+                                                                              !! @tex ($W K^{-1} m^{-1}$) @endtex.
+!$OMP THREADPRIVATE(pkappa_snow)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcapa_en                 !! heat capacity used for surfheat_incr and 
+                                                                              !! coldcont_incr 
+!$OMP THREADPRIVATE(pcapa_en)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ptn_beg                  !! vertically discretized temperature at the 
+                                                                              !! beginning of the time step  @tex ($K$) @endtex; 
+                                                                              !! is used in 
+                                                                              !! thermosoil_energy for energy-related diagnostic of
+                                                                              !! the routine.
+!$OMP THREADPRIVATE(ptn_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: temp_sol_beg             !! Surface temperature at the beginning of the 
+                                                                              !! timestep  @tex ($K$) @endtex
+!$OMP THREADPRIVATE(temp_sol_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: surfheat_incr            !! Change in soil heat content during the timestep 
+                                                                              !!  @tex ($J$) @endtex.
+!$OMP THREADPRIVATE(surfheat_incr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: coldcont_incr            !! Change in snow heat content  @tex ($J$) @endtex.
+!$OMP THREADPRIVATE(coldcont_incr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: shum_ngrnd_perma         !! Saturation degree on the thermal axes (0-1, dimensionless)
+!$OMP THREADPRIVATE(shum_ngrnd_perma)
+
+  !  Variables related to soil freezing
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: profil_froz              !! Frozen fraction of the soil on hydrological levels (-)
+!$OMP THREADPRIVATE(profil_froz)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION (:) :: e_soil_lat                  !! Accumulated latent heat for the whole soil (J)
+!$OMP THREADPRIVATE(e_soil_lat)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcappa_supp               !! Additional heat capacity due to soil freezing for each soil layer (J/K)
+!$OMP THREADPRIVATE(pcappa_supp)    
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: dz5                      !! Used for numerical calculation [-]
+!$OMP THREADPRIVATE(dz5)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcs                      !! Saturation humidity [m3/m3]
+!$OMP THREADPRIVATE(mcs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: SMCMAX                   !! Soil porosity [m3/m3]
+!$OMP THREADPRIVATE(SMCMAX)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: QZ                       !! quartz content [-]
+!$OMP THREADPRIVATE(QZ)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: so_capa_dry_ns           !! Dry soil Heat capacity of soils,J.m^{-3}.K^{-1} 
+!$OMP THREADPRIVATE(so_capa_dry_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mc_layt                  !! Volumetric soil moisture (liquid+ice) (m3/m3) on the thermodynamical levels at interface
+!$OMP THREADPRIVATE(mc_layt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mcl_layt                 !! Volumetric soil moisture (liquid) (m3/m3) on the thermodynamical levels at interface
+!$OMP THREADPRIVATE(mcl_layt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_layt                 !! Total soil moisture content for each layer (liquid+ice) (mm) on the thermodynamical levels
+!$OMP THREADPRIVATE(tmc_layt)
+  INTEGER(i_std), SAVE                            :: brk_flag = 0             !! Flag to consider bedrock: 0.no; 1.yes
+!$OMP THREADPRIVATE(brk_flag)
+
+
+CONTAINS
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : thermosoil_initialize
+  !!
+  !>\BRIEF			            Allocate module variables, read from restart file or initialize with default values
+  !!
+  !! DESCRIPTION			    : Allocate module variables, read from restart file or initialize with default values.
+  !!                                          Call thermosoil_var_init to calculate physical constants. 
+  !!                                          Call thermosoil_coef to calculate thermal soil properties.
+  !!
+  !! RECENT CHANGE(S)			    : None
+  !!
+  !! REFERENCE(S)			    : None
+  !! 
+  !! FLOWCHART                              : None
+  !! \n
+  !_ ==============================================================================================================================
+  SUBROUTINE thermosoil_initialize (kjit,          kjpindex,   rest_id,                   &
+                                    temp_sol_new,  snow,       shumdiag_perma,            &
+                                    soilcap,       soilflx,    stempdiag,                 &
+                                    gtemp,                   &
+                                    mc_layh,       mcl_layh,   tmc_layh,        njsc,     &
+                                    frac_snow_veg,frac_snow_nobio,totfrac_nobio, &
+                                    snowdz, snowrho, snowtemp, lambda_snow, cgrnd_snow, dgrnd_snow, pb)
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                            :: kjit             !! Time step number (unitless) 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex         !! Domain size (unitless)
+    INTEGER(i_std),INTENT (in)                            :: rest_id          !! Restart file identifier (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: temp_sol_new     !! Surface temperature at the present time-step,
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: snow             !! Snow mass (kg)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: shumdiag_perma   !! Soil saturation degree (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: mc_layh          !! Volumetric soil moisture content (liquid+ice) for hydrological layers, at node (m3/m3)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: mcl_layh         !! Volumetric soil moisture content (liquid) for hydrological layers, at node (m3/m3)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: tmc_layh         !! Total soil moisture content(liquid+ice) for hydrological layers (mm)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: frac_snow_veg    !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in)   :: frac_snow_nobio  !! Snow cover fraction on non-vegeted area
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: totfrac_nobio    !! Total fraction of continental ice+lakes+cities+...
+                                                                              !! (unitless,0-1)
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT (in)    :: snowdz           !! Snow depth
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)   :: snowrho          !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)   :: snowtemp         !! Snow temperature (K)
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)        :: pb               !! Surface presure (hPa)
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: soilcap          !! apparent surface heat capacity considering snow and soil surface (J m-2 K-1)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: soilflx          !! apparent soil heat flux considering snow and soil surface (W m-2)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out)   :: stempdiag        !! temperature profile on the levels in hydrol(K)
+    REAL(r_std),DIMENSION (kjpindex),INTENT(out)          :: gtemp            !! First soil layer temperature
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)       :: lambda_snow     !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: cgrnd_snow      !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: dgrnd_snow      !! Integration coefficient for snow numerical scheme
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                        :: ier, i, jg
+    LOGICAL                                               :: calculate_coef   !! Local flag to initialize variables by call to thermosoil_coef   
+!_ ================================================================================================================================
+    
+
+    !
+    !  !! Flag to consider bedrock at deeper layers
+    !  !! It affects heat capacity and thermal conductivity (energy balance). 
+    !
+    !Config Key  = BEDROCK_FLAG
+    !Config Desc = Flag to consider bedrock at deeper layers.
+    !Config If   = 
+    !Config Def  = 0
+    !Config Help = 0, no, 1, yes. 
+    !Config Units = [FLAG]
+    brk_flag = 0
+    CALL getin_p('BEDROCK_FLAG', brk_flag)
+
+    IF (printlev >= 3) WRITE (numout,*) 'Start thermosoil_initialize '
+
+    !! 1. Allocate soil temperatures variables
+    ALLOCATE (ptn(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of ptn','','')
+
+    ALLOCATE (dz1(ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of dz1','','')
+
+    ALLOCATE (cgrnd(kjpindex,ngrnd-1),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of cgrnd','','')
+
+    ALLOCATE (dgrnd(kjpindex,ngrnd-1),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of dgrnd','','')
+
+    ALLOCATE (pcapa(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of pcapa','','')
+
+    ALLOCATE (pkappa(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of pkappa','','')
+
+    ALLOCATE (pcapa_snow(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of pcapa_snow','','')
+
+    ALLOCATE (pkappa_snow(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of pkappa_snow','','')
+
+    ! Temporary fix: Initialize following variable because they are output to xios before the first calculation
+    pcapa  = 0
+    pkappa = 0
+    pcapa_snow  = 0
+    pkappa_snow = 0
+
+    ALLOCATE (surfheat_incr(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of surfheat_incr','','')
+
+    ALLOCATE (coldcont_incr(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of coldcont_incr','','')
+
+    ALLOCATE (pcapa_en(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of pcapa_en','','')
+
+    ALLOCATE (ptn_beg(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of ptn_beg','','')
+
+    ALLOCATE (temp_sol_beg(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of temp_sol_beg','','')
+
+    ALLOCATE (shum_ngrnd_perma(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of shum_ngrnd_perma','','')
+
+    ALLOCATE (profil_froz(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of profil_froz','','')
+
+    IF (ok_freeze_thermix) THEN
+       ALLOCATE (pcappa_supp(kjpindex,ngrnd),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of ok_freeze_termix','','')
+    END IF
+    IF (ok_Ecorr) THEN
+       ALLOCATE (e_soil_lat(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of e_soil_lat','','')
+    END IF
+
+    ALLOCATE (dz5(ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of dz5','','')
+
+    ALLOCATE (mc_layt(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of mc_layt','','')
+
+    ALLOCATE (mcl_layt(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of mcl_layt','','')
+
+    ALLOCATE (tmc_layt(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of tmc_layt','','')
+
+    ALLOCATE (mcs(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of mcs','','')
+
+    ALLOCATE (SMCMAX(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of SMCMAX','','')
+
+    ALLOCATE (QZ(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of QZ','','')
+
+    ALLOCATE (so_capa_dry_ns(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of so_capa_dry_ns','','')
+
+
+!! Soil texture choose
+    SELECTCASE (nscm)
+    CASE (3)
+       SMCMAX(:) = SMCMAX_fao(:)
+       QZ(:) = QZ_fao(:)
+       so_capa_dry_ns(:) = so_capa_dry_ns_fao(:)
+       mcs(:) = mcs_fao(:)
+    CASE (12)
+       SMCMAX(:) = SMCMAX_usda(:)
+      QZ(:) = QZ_usda(:)
+       so_capa_dry_ns(:) = so_capa_dry_ns_usda(:)
+       mcs(:) = mcs_usda(:)
+    CASE DEFAULT
+       WRITE (numout,*) 'Unsupported soil type classification. Choose between zobler, fao and usda according to the map'
+       STOP 'thermosoil_initialize'
+    ENDSELECT
+
+    
+    !! 2. Initialize variable from restart file or with default values 
+    
+    !! Reads restart files for soil temperatures only. If no restart file is
+    !! found,  the initial soil temperature is by default set to 280K at all depths. The user
+    !! can decide to initialize soil temperatures at an other value, in which case he should set the flag THERMOSOIL_TPRO
+    !! to this specific value in the run.def.
+    IF (printlev>=3) WRITE (numout,*) 'Read restart file for THERMOSOIL variables'
+
+    CALL ioconf_setatt_p('UNITS', 'K')
+    CALL ioconf_setatt_p('LONG_NAME','Soil Temperature profile')
+    CALL restget_p (rest_id, 'ptn', nbp_glo, ngrnd, 1, kjit, .TRUE., ptn, "gather", nbp_glo, index_g)
+
+    ! Initialize ptn if it was not found in restart file
+    IF (ALL(ptn(:,:)==val_exp)) THEN 
+       ! ptn was not found in restart file
+
+       IF (read_reftemp) THEN
+          ! Read variable ptn from file
+          CALL thermosoil_read_reftempfile(kjpindex,lalo,ptn)
+       ELSE
+          ! Initialize ptn with a constant value which can be set in run.def
+
+          !Config Key   = THERMOSOIL_TPRO
+          !Config Desc  = Initial soil temperature profile if not found in restart
+          !Config Def   = 280.
+          !Config If    = OK_SECHIBA
+          !Config Help  = The initial value of the temperature profile in the soil if 
+          !Config         its value is not found in the restart file. Here
+          !Config         we only require one value as we will assume a constant 
+          !Config         throughout the column.
+          !Config Units = Kelvin [K]
+          CALL setvar_p (ptn, val_exp,'THERMOSOIL_TPRO',280._r_std)
+       END IF
+    END IF
+    
+    ! Initialize ptn_beg (variable needed in thermosoil_coef before calucation in thermosoil_energy)
+    ptn_beg(:,:) = ptn(:,:)
+    
+    ! Initialize temp_sol_beg with values from previous time-step
+    temp_sol_beg(:) = temp_sol_new(:) 
+    
+    ! Read e_soil_lat from restart file or initialize
+    IF (ok_Ecorr) THEN
+       CALL restget_p (rest_id, 'e_soil_lat', nbp_glo, 1, 1, kjit, .TRUE., &
+            e_soil_lat, "gather", nbp_glo, index_g)
+       CALL setvar_p (e_soil_lat, val_exp,'NO_KEYWORD',zero)
+    END IF
+
+    ! Read gtemp from restart file
+    CALL restget_p (rest_id, 'gtemp', nbp_glo, 1, 1, kjit, .TRUE., &
+         gtemp, "gather", nbp_glo, index_g)
+    CALL setvar_p (gtemp, val_exp,'NO_KEYWORD',zero)
+    
+
+    ! Read variables calculated in thermosoil_coef from restart file
+    ! If the variables were not found in the restart file, the logical 
+    ! calculate_coef will be true and thermosoil_coef will be called further below.
+    ! These variables need to be in the restart file to avoid a time shift that
+    ! would be done using thermosoil_coef at this stage.
+    calculate_coef=.FALSE.
+    CALL ioconf_setatt_p('UNITS', 'J m-2 K-1')
+    CALL ioconf_setatt_p('LONG_NAME','Apparent surface heat capacity')
+    CALL restget_p (rest_id, 'soilcap', nbp_glo, 1, 1, kjit, .TRUE., &
+         soilcap, "gather", nbp_glo, index_g)
+    IF (ALL(soilcap(:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', 'W m-2')
+    CALL ioconf_setatt_p('LONG_NAME','Apparent soil heat flux')
+    CALL restget_p (rest_id, 'soilflx', nbp_glo, 1, 1, kjit, .TRUE., &
+         soilflx, "gather", nbp_glo, index_g)
+    IF (ALL(soilflx(:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Integration coefficient for the numerical scheme')
+    CALL restget_p (rest_id, 'cgrnd', nbp_glo, ngrnd-1, 1, kjit, .TRUE., &
+         cgrnd, "gather", nbp_glo, index_g)
+    IF (ALL(cgrnd(:,:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Integration coefficient for the numerical scheme')
+    CALL restget_p (rest_id, 'dgrnd', nbp_glo, ngrnd-1, 1, kjit, .TRUE., &
+         dgrnd, "gather", nbp_glo, index_g)
+    IF (ALL(dgrnd(:,:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Integration coefficient for the numerical scheme')
+    CALL restget_p (rest_id, 'cgrnd_snow', nbp_glo, nsnow, 1, kjit, .TRUE., &
+         cgrnd_snow, "gather", nbp_glo, index_g)
+    IF (ALL(cgrnd_snow(:,:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Integration coefficient for the numerical scheme')
+    CALL restget_p (rest_id, 'dgrnd_snow', nbp_glo, nsnow, 1, kjit, .TRUE., &
+         dgrnd_snow, "gather", nbp_glo, index_g)
+    IF (ALL(dgrnd_snow(:,:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Coefficient of the linear extrapolation of surface temperature')
+    CALL restget_p (rest_id, 'lambda_snow', nbp_glo, 1, 1, kjit, .TRUE., &
+         lambda_snow, "gather", nbp_glo, index_g)
+    IF (ALL(lambda_snow(:)==val_exp)) calculate_coef=.TRUE.
+
+    !! 2.2 Computes some physical constants and arrays depending on the soil 
+    !!     vertical discretization 
+
+    ! Calculate so_capa_ice
+    so_capa_ice = so_capa_dry + poros*capa_ice*rho_ice
+    IF (printlev>=2) WRITE(numout,*) 'Calculation of so_capa_ice=', so_capa_ice, &
+       ' using poros=',poros,' and capa_ice=',capa_ice
+    
+    ! Computing some usefull constants for the numerical scheme
+    ! Use znt(depth of nodes) and zlt(depth of deeper layer interface) 
+    ! from vertical_soil module.  
+    DO jg=1,ngrnd-1
+      dz1(jg)  = un / (znt(jg+1) - znt(jg))
+      dz5(jg) = (zlt(jg) - znt(jg)) * dz1(jg)
+    ENDDO
+    dz5(ngrnd) = 0.0
+    lambda = znt(1) * dz1(1)
+
+    ! Send out the temperature profile on the first nslm 
+    ! levels(the levels treated in hydrol)
+    stempdiag(:,:) = ptn(:,1:nslm)
+    
+
+    !! 2.3. Computes cgrnd, dgrnd, soilflx and soilcap coefficients only if 
+    !!      they were not found in restart file.
+    IF (calculate_coef) THEN
+       ! Interpolate variables needed by thermosoil_coef to the thermal levels
+       CALL thermosoil_humlev(kjpindex, shumdiag_perma, mc_layh, mcl_layh, tmc_layh)
+
+       IF (printlev>=3) WRITE (numout,*) 'thermosoil_coef will be called in &
+          & the intialization phase'
+       CALL thermosoil_coef (&
+            kjpindex,      temp_sol_new,    snow,           njsc, &
+            frac_snow_veg, frac_snow_nobio, totfrac_nobio,        &
+            snowdz,        snowrho,         snowtemp,       pb,   &
+            ptn,                                                  &
+            soilcap,       soilflx,         cgrnd,          dgrnd,&
+	    lambda_snow,   cgrnd_snow,      dgrnd_snow)
+    END IF
+
+  END SUBROUTINE thermosoil_initialize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_main
+!!
+!>\BRIEF        Thermosoil_main computes the soil thermal properties and dynamics, ie solves
+!! the heat diffusion equation within the soil. 
+!!
+!! DESCRIPTION : The resolution of the soil heat diffusion equation 
+!! relies on a numerical finite-difference implicit scheme
+!! fully described in the reference and in the header of the thermosoil module.
+!! - The dependency of the previous timestep hidden in the 
+!! integration coefficients cgrnd and dgrnd (EQ1), calculated in thermosoil_coef, and 
+!! called at the end of the routine to prepare for the next timestep.
+!! - The effective computation of the new soil temperatures is performed in thermosoil_profile. 
+!!
+!! - thermosoil_coef calculates the coefficients for the numerical scheme for the very first iteration of thermosoil;
+!! after that, thermosoil_coef is called only at the end of the module to calculate the coefficients for the next timestep.
+!! - thermosoil_profile solves the numerical scheme.\n
+!!
+!! - Flags : one unique flag : THERMOSOIL_TPRO (to be set to the desired initial soil in-depth temperature in K; by default 280K)
+!!
+!! RECENT CHANGE(S) : Change vertical discretization (consistent with hydrology layers) and soil thermal properties (taking into account soil texture effects).
+!!
+!! MAIN OUTPUT VARIABLE(S): vertically discretized soil temperatures ptn, soil
+!! thermal properties (pcapa, pkappa), apparent surface heat capacity (soilcap)
+!! and heat flux (soilflx) to be used in enerbil at the next timestep to solve
+!! the surface energy balance.
+!!
+!! REFERENCE(S) : 
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of planetary atmospheres,
+!!  Ph.D. thesis, Paris VII University. Remark: the part of F. Hourdin' s PhD thesis relative to the thermal
+!!  integration scheme has been scanned and is provided along with the documentation, with name : 
+!!  Hourdin_1992_PhD_thermal_scheme.pdf
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{thermosoil_flowchart.png}
+!! \endlatexonly
+!! 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_main (kjit, kjpindex, &
+       index, indexgrnd, &
+       temp_sol_new, snow, soilcap, soilflx, &
+       shumdiag_perma, stempdiag, ptnlev1, rest_id, hist_id, hist2_id, &
+       snowdz,snowrho,snowtemp,gtemp,pb,&
+       mc_layh, mcl_layh, tmc_layh, njsc, frac_snow_veg,frac_snow_nobio,totfrac_nobio,temp_sol_add, &
+       lambda_snow, cgrnd_snow, dgrnd_snow)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                            :: kjit             !! Time step number (unitless) 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex         !! Domain size (unitless)
+    INTEGER(i_std),INTENT (in)                            :: rest_id,hist_id  !! Restart_ file and history file identifier 
+                                                                              !! (unitless)
+    INTEGER(i_std),INTENT (in)                            :: hist2_id         !! history file 2 identifier (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: index            !! Indeces of the points on the map (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex*ngrnd), INTENT (in):: indexgrnd        !! Indeces of the points on the 3D map (vertical 
+                                                                              !! dimension towards the ground) (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: temp_sol_new     !! Surface temperature at the present time-step,
+                                                                              !! Ts @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: snow             !! Snow mass @tex ($kg$) @endtex.
+                                                                              !! Caveat: when there is snow on the
+                                                                              !! ground, the snow is integrated into the soil for
+                                                                              !! the calculation of the thermal dynamics. It means
+                                                                              !! that the uppermost soil layers can completely or 
+                                                                              !! partially consist in snow. In the second case, zx1
+                                                                              !! and zx2 are the fraction of the soil layer 
+                                                                              !! consisting in snow and 'normal' soil, respectively
+                                                                              !! This is calculated in thermosoil_coef.
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: shumdiag_perma   !! Soil saturation degree (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT (in)    :: snowdz           !! Snow depth
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT (in)    :: snowrho          !! Snow density
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT (inout) :: snowtemp         !! Snow temperature (K)
+    REAL(r_std), DIMENSION (kjpindex),INTENT (in)         :: pb               !! Surface presure (hPa)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: mc_layh          !! Volumetric soil moisture content for each layer in hydrol at nodes(liquid + ice) (m3/m3)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: mcl_layh         !! Volumetric soil moisture content for each layer in hydrol at nodes(liquid) (m3/m3)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: tmc_layh         !! Total soil moisture content for each layer in hydrol(liquid + ice) (mm)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: frac_snow_veg    !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in)   :: frac_snow_nobio  !! Snow cover fraction on non-vegeted area
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: totfrac_nobio    !! Total fraction of continental ice+lakes+cities+...
+                                                                              !!(unitless,0-1)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: temp_sol_add     !! additional surface temperature due to the melt of first layer
+                                                                              !! at the present time-step @tex ($K$) @endtex
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: ptnlev1          !! 1st level soil temperature   
+    REAL(r_std),DIMENSION (kjpindex),INTENT(out)          :: gtemp            !! First soil layer temperature
+
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: soilcap          !! apparent surface heat capacity considering snow and soil surface
+                                                                              !! @tex ($J m^{-2} K^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: soilflx          !! apparent soil heat flux  considering snow and soil surface
+                                                                              !! @tex ($W m^{-2}$) @endtex
+                                                                              !! , positive 
+                                                                              !! towards the soil, writen as Qg (ground heat flux) 
+                                                                              !! in the history files, and computed at the end of 
+                                                                              !! thermosoil for the calculation of Ts in enerbil, 
+                                                                              !! see EQ3.
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out)   :: stempdiag        !! temperature profile @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT(inout)       :: lambda_snow      !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (inout):: cgrnd_snow       !! Integration coefficient for snow numerical scheme
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (inout):: dgrnd_snow       !! Integration coefficient for snow numerical scheme
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                        :: jv,ji,ii
+
+!_ ================================================================================================================================
+    
+  !! 3. Put the soil wetness diagnostic on the levels of the soil temperature
+
+    !!?? this could logically be put just before the last call to
+    !!thermosoil_coef, as the results are used there...
+    CALL thermosoil_humlev(kjpindex, shumdiag_perma, mc_layh, mcl_layh, tmc_layh)
+
+    
+  !! 4. Effective computation of the soil temperatures profile, using the cgrnd and dgrnd coefficients from previous tstep.
+    
+    CALL thermosoil_profile (kjpindex,      temp_sol_new,                   &
+                             frac_snow_veg, frac_snow_nobio, totfrac_nobio, &
+                             ptn,           stempdiag,       snowtemp,      &
+                             cgrnd_snow,    dgrnd_snow)
+
+  !! 5. Call to thermosoil_energy, still to be clarified..
+
+    CALL thermosoil_energy (kjpindex, temp_sol_new, soilcap)
+
+  !! 6. Writing the history files according to the ALMA standards (or not..)
+
+    CALL xios_orchidee_send_field("ptn",ptn)
+    CALL xios_orchidee_send_field("soilflx",soilflx)
+    CALL xios_orchidee_send_field("surfheat_incr",surfheat_incr)
+    CALL xios_orchidee_send_field("coldcont_incr",coldcont_incr)
+    CALL xios_orchidee_send_field("pkappa",pkappa)
+    CALL xios_orchidee_send_field("pkappa_snow",pkappa_snow)
+    CALL xios_orchidee_send_field("pcapa",pcapa)
+    CALL xios_orchidee_send_field("pcapa_snow",pcapa_snow)
+    CALL xios_orchidee_send_field("snowtemp",snowtemp)
+
+    IF ( .NOT. almaoutput ) THEN
+      CALL histwrite_p(hist_id, 'ptn', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+      CALL histwrite_p(hist_id, 'Qg', kjit, soilflx, kjpindex, index)
+
+      CALL histwrite_p(hist_id, 'ptn_beg', kjit, ptn_beg, kjpindex*ngrnd, indexgrnd)
+      CALL histwrite_p(hist_id, 'pkappa', kjit, pkappa, kjpindex*ngrnd, indexgrnd)
+      CALL histwrite_p(hist_id, 'pcapa', kjit, pcapa, kjpindex*ngrnd, indexgrnd)
+      
+      IF (ok_freeze_thermix) THEN
+         CALL histwrite_p(hist_id, 'profil_froz', kjit, profil_froz, kjpindex*ngrnd, indexgrnd)
+         CALL histwrite_p(hist_id, 'pcappa_supp', kjit, pcappa_supp, kjpindex*ngrnd, indexgrnd)
+      END IF
+      CALL histwrite_p(hist_id, 'shum_ngrnd_perma', kjit, shum_ngrnd_perma(:,:), kjpindex*ngrnd, indexgrnd)
+      
+    ELSE
+      CALL histwrite_p(hist_id, 'SoilTemp', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+      CALL histwrite_p(hist_id, 'Qg', kjit, soilflx, kjpindex, index)
+      CALL histwrite_p(hist_id, 'DelSurfHeat', kjit, surfheat_incr, kjpindex, index)
+      CALL histwrite_p(hist_id, 'DelColdCont', kjit, coldcont_incr, kjpindex, index)
+    ENDIF
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite_p(hist2_id, 'ptn', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+       ELSE
+          CALL histwrite_p(hist2_id, 'SoilTemp', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+          CALL histwrite_p(hist2_id, 'Qg', kjit, soilflx, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSurfHeat', kjit, surfheat_incr, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelColdCont', kjit, coldcont_incr, kjpindex, index)
+       ENDIF
+    ENDIF
+    
+  !! 7. A last final call to thermosoil_coef
+ 
+    !! A last final call to thermosoil_coef, which calculates the different
+    !!coefficients (cgrnd, dgrnd, soilcap, soilflx) from this time step to be
+    !!used at the next time step, either in the surface temperature calculation
+    !!(soilcap, soilflx) or in the soil thermal numerical scheme.
+    CALL thermosoil_coef (&
+         kjpindex,      temp_sol_new,    snow,         njsc, &
+         frac_snow_veg, frac_snow_nobio, totfrac_nobio,      &
+         snowdz,        snowrho,         snowtemp,     pb,   &
+         ptn,                                                &
+         soilcap,       soilflx,         cgrnd,        dgrnd,&
+         lambda_snow,   cgrnd_snow,      dgrnd_snow)
+         
+
+    ! Save variables for explicit snow model
+    gtemp(:) = ptn(:,1)
+
+    !! Initialize output arguments to be used in sechiba
+    ptnlev1(:) = ptn(:,1)
+
+    !! Surface temperature is forced to zero celcius if its value is larger than melting point
+    DO ji=1,kjpindex
+       IF  (SUM(snowdz(ji,:)) .GT. 0.0) THEN
+          IF (temp_sol_new(ji) .GE. tp_00) THEN
+             temp_sol_new(ji) = tp_00
+          ENDIF
+       END IF
+    END DO
+ 
+    IF (printlev>=3) WRITE (numout,*) ' thermosoil_main done '
+
+  END SUBROUTINE thermosoil_main
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : thermosoil_finalize
+  !!
+  !>\BRIEF                                    Write to restart file
+  !!
+  !! DESCRIPTION			    : This subroutine writes the module variables and variables calculated in thermosoil
+  !!                                          to restart file
+  !! \n
+  !_ ==============================================================================================================================
+  SUBROUTINE thermosoil_finalize (kjit,    kjpindex, rest_id,   gtemp, &
+                                  soilcap, soilflx, lambda_snow, cgrnd_snow, dgrnd_snow)
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                            :: kjit             !! Time step number (unitless) 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex         !! Domain size (unitless)
+    INTEGER(i_std),INTENT (in)                            :: rest_id          !! Restart file identifier(unitless)
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: gtemp            !! First soil layer temperature
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: soilcap
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: soilflx
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)         :: lambda_snow      !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (in)  :: cgrnd_snow       !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (in)  :: dgrnd_snow       !! Integration coefficient for snow numerical scheme
+
+!_ ================================================================================================================================
+    
+    !! 1. Write variables to restart file to be used for the next simulation
+    IF (printlev>=3) WRITE (numout,*) 'Write restart file with THERMOSOIL variables'
+    
+    CALL restput_p(rest_id, 'ptn', nbp_glo, ngrnd, 1, kjit, ptn, 'scatter', nbp_glo, index_g)
+    
+    IF (ok_Ecorr) THEN
+       CALL restput_p(rest_id, 'e_soil_lat', nbp_glo, 1 , 1, kjit, e_soil_lat, 'scatter', nbp_glo, index_g)
+    END IF
+    
+    CALL restput_p(rest_id, 'gtemp', nbp_glo, 1, 1, kjit, gtemp, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'soilcap', nbp_glo, 1, 1, kjit, soilcap, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'soilflx', nbp_glo, 1, 1, kjit, soilflx, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'cgrnd', nbp_glo, ngrnd-1, 1, kjit, cgrnd, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'dgrnd', nbp_glo, ngrnd-1, 1, kjit, dgrnd, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'cgrnd_snow', nbp_glo, nsnow, 1, kjit, cgrnd_snow, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'dgrnd_snow', nbp_glo, nsnow, 1, kjit, dgrnd_snow, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'lambda_snow', nbp_glo, 1, 1, kjit, lambda_snow, 'scatter', nbp_glo, index_g)
+    
+  END SUBROUTINE thermosoil_finalize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_clear
+!!
+!>\BRIEF        Deallocates the allocated arrays.
+!! The call of thermosoil_clear originates from sechiba_clear but the calling sequence and 
+!! its purpose require further investigation.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE thermosoil_clear()
+
+        IF ( ALLOCATED (ptn)) DEALLOCATE (ptn)
+        IF ( ALLOCATED (cgrnd)) DEALLOCATE (cgrnd) 
+        IF ( ALLOCATED (dgrnd)) DEALLOCATE (dgrnd) 
+        IF ( ALLOCATED (pcapa)) DEALLOCATE (pcapa)
+        IF ( ALLOCATED (pkappa))  DEALLOCATE (pkappa)
+        IF ( ALLOCATED (pcapa_snow)) DEALLOCATE (pcapa_snow)
+        IF ( ALLOCATED (pkappa_snow))  DEALLOCATE (pkappa_snow)
+        IF ( ALLOCATED (pcapa_en)) DEALLOCATE (pcapa_en)
+        IF ( ALLOCATED (ptn_beg)) DEALLOCATE (ptn_beg)
+        IF ( ALLOCATED (temp_sol_beg)) DEALLOCATE (temp_sol_beg)
+        IF ( ALLOCATED (surfheat_incr)) DEALLOCATE (surfheat_incr)
+        IF ( ALLOCATED (coldcont_incr)) DEALLOCATE (coldcont_incr)
+        IF ( ALLOCATED (shum_ngrnd_perma)) DEALLOCATE (shum_ngrnd_perma)
+        IF ( ALLOCATED (profil_froz)) DEALLOCATE (profil_froz)
+        IF ( ALLOCATED (mc_layt)) DEALLOCATE (mc_layt)
+        IF ( ALLOCATED (mcl_layt)) DEALLOCATE (mcl_layt)
+        IF ( ALLOCATED (tmc_layt)) DEALLOCATE (tmc_layt)
+  END SUBROUTINE thermosoil_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_coef
+!!
+!>\BRIEF        Calculate soil thermal properties, integration coefficients, apparent heat flux,
+!! surface heat capacity,  
+!!
+!! DESCRIPTION	: This routine computes : \n
+!!		1. the soil thermal properties. \n 
+!!		2. the integration coefficients of the thermal numerical scheme, cgrnd and dgrnd,
+!!              which depend on the vertical grid and on soil properties, and are used at the next 
+!!              timestep.\n
+!!              3. the soil apparent heat flux and surface heat capacity (soilflx
+!!              and soilcap), used by enerbil to compute the surface temperature at the next
+!!              timestep.\n
+!!             -  The soil thermal properties depend on water content (shum_ngrnd_perma, shumdiag_perma, 
+!!              mc_layt, mcl_layt, tmc_layt), dominant soil texture(njsc), and on the presence 
+!!              of snow : snow is integrated into the soil for the thermal calculations, ie if there 
+!!              is snow on the ground, the first thermal layer(s) consist in snow, depending on the 
+!!              snow-depth. If a layer consists out of snow and soil, wheighed soil properties are 
+!!              calculated\n
+!!             - The coefficients cgrnd and dgrnd are the integration
+!!              coefficients for the thermal scheme \n
+!!                              T(k+1)=cgrnd(k)+dgrnd(k)*T(k) \n
+!!                                      -- EQ1 -- \n
+!!              They correspond respectively to $\beta$ and $\alpha$ from F. Hourdin\'s thesis and 
+!!              their expression can be found in this document (eq A19 and A20)
+!!             - soilcap and soilflx are the apparent surface heat capacity and flux
+!!               used in enerbil at the next timestep to solve the surface
+!!               balance for Ts (EQ3); they correspond to $C_s$ and $F_s$ in F.
+!!               Hourdin\'s PhD thesis and are expressed in eq. A30 and A31. \n
+!!                 soilcap*(Ts(t)-Ts(t-1))/dt=soilflx+otherfluxes(Ts(t)) \n
+!!                                      -- EQ3 --\n
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): cgrnd, dgrnd, pcapa, pkappa, soilcap, soilflx
+!!
+!! REFERENCE(S) :
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of planetary atmospheres,
+!! Ph.D. thesis, Paris VII University. Remark: the part of F. Hourdin's PhD thesis relative to the thermal
+!! integration scheme has been scanned and is provided along with the documentation, with name : 
+!! Hourdin_1992_PhD_thermal_scheme.pdf
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_coef (kjpindex,      temp_sol_new,    snow,           njsc, &
+                              frac_snow_veg, frac_snow_nobio, totfrac_nobio,        &
+                              snowdz,        snowrho,         snowtemp,       pb,   &
+                              ptn,                                                  &
+                              soilcap,       soilflx,         cgrnd,          dgrnd,&
+			      lambda_snow,   cgrnd_snow,      dgrnd_snow)
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                             :: kjpindex     !! Domain size (unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)         :: temp_sol_new !! soil surface temperature @tex ($K$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)         :: snow         !! snow mass @tex ($Kg$) @endtex
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)       :: njsc         !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: frac_snow_veg   !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in)    :: frac_snow_nobio !! Snow cover fraction on non-vegeted area
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)            :: totfrac_nobio   !! Total fraction of continental ice+lakes+cities+...
+                                                                              !!(unitless,0-1)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)    :: snowdz          !! Snow depth (m)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)    :: snowrho         !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)    :: snowtemp        !! Snow temperature (K)
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)         :: pb              !! Surface presure (hPa)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)        :: soilcap      !! surface heat capacity considering snow and soil surface
+                                                                           !! @tex ($J m^{-2} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)        :: soilflx      !! surface heat flux considering snow and soil surface @tex ($W m^{-2}$) @endtex,
+                                                                           !! positive towards the 
+                                                                           !! soil, writen as Qg (ground heat flux) in the history 
+                                                                           !! files.
+    REAL(r_std), DIMENSION (kjpindex,ngrnd-1), INTENT(out) :: cgrnd        !! matrix coefficient for the computation of soil 
+                                                                           !! temperatures (beta in F. Hourdin thesis)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd-1), INTENT(out) :: dgrnd        !! matrix coefficient for the computation of soil 
+                                                                           !! temperatures (alpha in F. Hourdin thesis)
+
+
+    !! 0.3 Modified variable
+
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT (inout):: ptn          !! vertically discretized soil temperatures. ptn is only modified if ok_Ecorr.
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)       :: lambda_snow  !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: cgrnd_snow   !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: dgrnd_snow   !! Integration coefficient for snow numerical scheme
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                         :: ji, jg
+    REAL(r_std), DIMENSION (kjpindex,ngrnd-1)              :: zdz1         !! numerical (buffer) constant 
+                                                                           !! @tex ($W m^{-1} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)                :: zdz2         !! numerical (buffer) constant  
+                                                                           !! @tex ($W m^{-1} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex)                      :: z1           !! numerical constant @tex ($W m^{-1} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex)                      :: soilcap_nosnow      !! surface heat capacity
+                                                                                  !! @tex ($J m^{-2} K^{-1}$)
+                                                                                  !! @endtex
+    REAL(r_std), DIMENSION (kjpindex)                      :: soilflx_nosnow      !! surface heat flux @tex ($W m^{-2}$) @endtex,
+                                                                                  !! positive towards the soil, written as Qg
+                                                                                  !!(ground heat flux in the history files).
+    REAL(r_std), DIMENSION (kjpindex)                      :: snowcap             !! apparent snow heat capacity @tex ($J m^{-2} K^{-1}$)
+    REAL(r_std), DIMENSION (kjpindex)                      :: snowflx             !! apparent snow-atmosphere heat flux @tex ($W m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: dz1_snow
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: ZSNOWDZM
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: dz2_snow
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: zdz1_snow
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: zdz2_snow
+    REAL(r_std), DIMENSION (kjpindex)                      :: z1_snow
+
+!_ ================================================================================================================================
+
+  !! 1. Computation of the soil thermal properties
+   
+    ! Computation of the soil thermal properties; snow properties are also accounted for
+    IF (ok_freeze_thermix) THEN
+       CALL thermosoil_getdiff( kjpindex, snow, ptn, njsc, snowrho, snowtemp, pb )
+    ELSE 
+       ! Special case without soil freezing
+       CALL thermosoil_getdiff_old_thermix_without_snow( kjpindex, njsc, snowrho, snowtemp, pb )
+    ENDIF
+
+    ! Energy conservation : Correction to make sure that the same latent heat is released and 
+    ! consumed during freezing and thawing
+    IF (ok_Ecorr) THEN
+       CALL thermosoil_readjust(kjpindex, ptn)
+    ENDIF
+    
+
+    !! 2. Computation of the coefficients of the numerical integration scheme for the soil layers
+
+    !! 2.1 Calculate numerical coefficients zdz1 and zdz2
+    DO jg=1,ngrnd
+      DO ji=1,kjpindex
+        zdz2(ji,jg)=pcapa(ji,jg) * dlt(jg)/dt_sechiba
+      ENDDO
+    ENDDO
+    
+    DO jg=1,ngrnd-1
+      DO ji=1,kjpindex
+        zdz1(ji,jg) = dz1(jg) * pkappa(ji,jg)
+      ENDDO
+    ENDDO
+    
+    !! 2.2 Calculate coefficients cgrnd and dgrnd for soil
+    DO ji = 1,kjpindex
+      z1(ji) = zdz2(ji,ngrnd) + zdz1(ji,ngrnd-1)
+      cgrnd(ji,ngrnd-1) = zdz2(ji,ngrnd) * ptn(ji,ngrnd) / z1(ji)
+      dgrnd(ji,ngrnd-1) = zdz1(ji,ngrnd-1) / z1(ji)
+    ENDDO
+
+    DO jg = ngrnd-1,2,-1
+      DO ji = 1,kjpindex
+        z1(ji) = un / (zdz2(ji,jg) + zdz1(ji,jg-1) + zdz1(ji,jg) * (un - dgrnd(ji,jg)))
+        cgrnd(ji,jg-1) = (ptn(ji,jg) * zdz2(ji,jg) + zdz1(ji,jg) * cgrnd(ji,jg)) * z1(ji)
+        dgrnd(ji,jg-1) = zdz1(ji,jg-1) * z1(ji)
+      ENDDO
+    ENDDO
+
+
+    !! 3. Computation of the coefficients of the numerical integration scheme for the snow layers
+
+    !! 3.1 Calculate numerical coefficients zdz1_snow, zdz2_snow and lambda_snow
+    DO ji = 1, kjpindex
+
+       ! Calculate internal values
+       DO jg = 1, nsnow
+          ZSNOWDZM(ji,jg) = MAX(snowdz(ji,jg),psnowdzmin)
+       ENDDO
+       dz2_snow(ji,:)=ZSNOWDZM(ji,:)
+       
+       DO jg = 1, nsnow-1
+          dz1_snow(ji,jg)  = 2.0 / (dz2_snow(ji,jg+1)+dz2_snow(ji,jg))
+       ENDDO
+       
+       lambda_snow(ji) = dz2_snow(ji,1)/2.0 * dz1_snow(ji,1)
+       
+       DO jg=1,nsnow
+          zdz2_snow(ji,jg)=pcapa_snow(ji,jg) * dz2_snow(ji,jg)/dt_sechiba
+       ENDDO
+       
+       DO jg=1,nsnow-1
+          zdz1_snow(ji,jg) = dz1_snow(ji,jg) * pkappa_snow(ji,jg)
+       ENDDO
+       
+       ! the bottom snow
+       zdz1_snow(ji,nsnow) = pkappa_snow(ji,nsnow) / ( zlt(1) + dz2_snow(ji,nsnow)/2 )
+       
+    ENDDO
+
+    !! 3.2 Calculate coefficients cgrnd_snow and dgrnd_snow for snow
+    DO ji = 1,kjpindex
+       ! bottom level
+       z1_snow(ji) = zdz2(ji,1)+(un-dgrnd(ji,1))*zdz1(ji,1)+zdz1_snow(ji,nsnow)
+       cgrnd_snow(ji,nsnow) = (zdz2(ji,1) * ptn(ji,1) + zdz1(ji,1) * cgrnd(ji,1) ) / z1_snow(ji)
+       dgrnd_snow(ji,nsnow) = zdz1_snow(ji,nsnow) / z1_snow(ji)
+       
+       ! next-to-bottom level
+       z1_snow(ji) = zdz2_snow(ji,nsnow)+(un-dgrnd_snow(ji,nsnow))*zdz1_snow(ji,nsnow)+zdz1_snow(ji,nsnow-1)
+       cgrnd_snow(ji,nsnow-1) = (zdz2_snow(ji,nsnow)*snowtemp(ji,nsnow)+&
+            zdz1_snow(ji,nsnow)*cgrnd_snow(ji,nsnow))/z1_snow(ji)
+       dgrnd_snow(ji,nsnow-1) = zdz1_snow(ji,nsnow-1) / z1_snow(ji)
+       
+       DO jg = nsnow-1,2,-1
+          z1_snow(ji) = un / (zdz2_snow(ji,jg) + zdz1_snow(ji,jg-1) + zdz1_snow(ji,jg) * (un - dgrnd_snow(ji,jg)))
+          cgrnd_snow(ji,jg-1) = (snowtemp(ji,jg) * zdz2_snow(ji,jg) + zdz1_snow(ji,jg) * cgrnd_snow(ji,jg)) * z1_snow(ji)
+          dgrnd_snow(ji,jg-1) = zdz1_snow(ji,jg-1) * z1_snow(ji)
+       ENDDO
+    ENDDO
+
+
+
+  !! 4. Computation of the apparent ground heat flux 
+    !! Computation of apparent snow-atmosphere flux  
+    DO ji = 1,kjpindex
+       snowflx(ji) = zdz1_snow(ji,1) * (cgrnd_snow(ji,1) + (dgrnd_snow(ji,1)-1.) * snowtemp(ji,1))
+       snowcap(ji) = (zdz2_snow(ji,1) * dt_sechiba + dt_sechiba * (un - dgrnd_snow(ji,1)) * zdz1_snow(ji,1))
+       z1_snow(ji) = lambda_snow(ji) * (un - dgrnd_snow(ji,1)) + un 
+       snowcap(ji) = snowcap(ji) / z1_snow(ji)
+       snowflx(ji) = snowflx(ji) + &
+            & snowcap(ji) * (snowtemp(ji,1) * z1_snow(ji) - lambda_snow(ji) * cgrnd_snow(ji,1) - temp_sol_new(ji)) / dt_sechiba
+    ENDDO
+
+ 
+    !! Computation of the apparent ground heat flux (> towards the soil) and
+    !! apparent surface heat capacity, used at the next timestep by enerbil to
+    !! compute the surface temperature.
+    DO ji = 1,kjpindex
+      soilflx_nosnow(ji) = zdz1(ji,1) * (cgrnd(ji,1) + (dgrnd(ji,1)-1.) * ptn(ji,1))
+      soilcap_nosnow(ji) = (zdz2(ji,1) * dt_sechiba + dt_sechiba * (un - dgrnd(ji,1)) * zdz1(ji,1))
+      z1(ji) = lambda * (un - dgrnd(ji,1)) + un
+      soilcap_nosnow(ji) = soilcap_nosnow(ji) / z1(ji)
+      soilflx_nosnow(ji) = soilflx_nosnow(ji) + &
+         & soilcap_nosnow(ji) * (ptn(ji,1) * z1(ji) - lambda * cgrnd(ji,1) - temp_sol_new(ji)) / dt_sechiba 
+    ENDDO
+
+    !! Add snow fraction
+    ! Using an effective heat capacity and heat flux by a simple pondering of snow and soil fraction
+    DO ji = 1, kjpindex
+       soilcap(ji) = snowcap(ji)*frac_snow_veg(ji)*(1-totfrac_nobio(ji))+    & ! weights related to snow cover fraction on vegetation  
+            soilcap_nosnow(ji)*SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji)+ & ! weights related to SCF on nobio
+            soilcap_nosnow(ji)*(1-(frac_snow_veg(ji)*(1-totfrac_nobio(ji))+SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji))) ! weights related to non snow fraction
+       soilflx(ji) = snowflx(ji)*frac_snow_veg(ji)*(1-totfrac_nobio(ji))+    & ! weights related to snow cover fraction on vegetation  
+            soilflx_nosnow(ji)*SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji)+ & ! weights related to SCF on nobio
+            soilflx_nosnow(ji)*(1-(frac_snow_veg(ji)*(1-totfrac_nobio(ji))+SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji))) ! weights related to non snow fraction
+    ENDDO
+    
+    IF (printlev>=3) WRITE (numout,*) ' thermosoil_coef done '
+
+  END SUBROUTINE thermosoil_coef
+ 
+ 
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_profile
+!!
+!>\BRIEF        In this routine solves the numerical soil thermal scheme, ie calculates the new soil temperature profile; 
+!! 
+!!
+!! DESCRIPTION	: The calculation of the new soil temperature profile is based on
+!! the cgrnd and dgrnd values from the previous timestep and the surface temperature Ts aka temp_sol_new. (see detailed
+!! explanation in the header of the thermosoil module or in the reference).\n
+!!                              T(k+1)=cgrnd(k)+dgrnd(k)*T(k)\n
+!!                                      -- EQ1 --\n
+!!                           Ts=(1+lambda)*T(1) -lambda*T(2)\n 
+!!                                      -- EQ2--\n
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): ptn (soil temperature profile on the thermal axis), 
+!!                          stempdiag (soil temperature profile on the diagnostic axis)
+!!
+!! REFERENCE(S) :
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of planetary atmospheres,
+!! Ph.D. thesis, Paris VII University. Remark: the part of F. Hourdin's PhD thesis relative to the thermal
+!! integration scheme has been scanned and is provided along with the documentation, with name : 
+!! Hourdin_1992_PhD_thermal_scheme.pdf
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+ SUBROUTINE thermosoil_profile (kjpindex,      temp_sol_new,                   &
+                                frac_snow_veg, frac_snow_nobio, totfrac_nobio, &
+                                ptn,           stempdiag,       snowtemp,      &
+                                cgrnd_snow,    dgrnd_snow)
+
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex       !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_sol_new   !! Surface temperature at the present time-step 
+                                                                               !! @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)             :: frac_snow_veg  !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in)      :: frac_snow_nobio!! Snow cover fraction on non-vegeted area
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)              :: totfrac_nobio  !! Total fraction of continental ice+lakes+cities+...
+                                                                               !! (unitless,0-1)
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(in)       :: snowtemp       !! Snow temperature (K)
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(in)       :: cgrnd_snow     !! Integration coefficient for snow numerical scheme
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(in)       :: dgrnd_snow     !! Integration coefficient for snow numerical scheme
+ 
+    !! 0.3 Modified variables
+
+ 
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex,ngrnd), INTENT (out)     :: ptn            !! vertically discretized soil temperatures 
+                                                                               !! @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out)      :: stempdiag      !! diagnostic temperature profile 
+                                                                               !! @tex ($K$) @endtex
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jg
+    REAL(r_std)                                              :: temp_sol_eff   !! effective surface temperature including snow and soil
+     
+!_ ================================================================================================================================
+
+  !! 1. Computes the soil temperatures ptn.
+
+    !! 1.1. ptn(jg=1) using EQ1 and EQ2
+    DO ji = 1,kjpindex
+
+       ! Using an effective surface temperature by a simple pondering 
+       temp_sol_eff=snowtemp(ji,nsnow)*frac_snow_veg(ji)*(1-totfrac_nobio(ji))+ &      ! weights related to snow cover fraction on vegetation  
+            temp_sol_new(ji)*SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji)+ &           ! weights related to SCF on nobio
+            temp_sol_new(ji)*(1-(frac_snow_veg(ji)*(1-totfrac_nobio(ji))+SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji))) ! weights related to non snow fraction
+       ! Soil temperature calculation with explicit snow if there is snow on the ground
+       ptn(ji,1) = cgrnd_snow(ji,nsnow) + dgrnd_snow(ji,nsnow) * temp_sol_eff
+    ENDDO
+
+    !! 1.2. ptn(jg=2:ngrnd) using EQ1.
+    DO jg = 1,ngrnd-1
+      DO ji = 1,kjpindex
+        ptn(ji,jg+1) = cgrnd(ji,jg) + dgrnd(ji,jg) * ptn(ji,jg)
+      ENDDO
+    ENDDO
+
+    !! 2. Assigne the soil temperature to the output variable. 
+    !  It is already on the right axis. 
+    stempdiag(:,:) = ptn(:,1:nslm)
+
+    IF (printlev>=3) WRITE (numout,*) ' thermosoil_profile done '
+
+  END SUBROUTINE thermosoil_profile
+
+!================================================================================================================================
+!! SUBROUTINE   : thermosoil_cond
+!!
+!>\BRIEF          Calculate soil thermal conductivity.  
+!!
+!! DESCRIPTION  : This routine computes soil thermal conductivity
+!!                Code introduced from NOAH LSM. 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): cnd
+!!
+!! REFERENCE(S) :
+!!    Farouki, O.T.,1986: Thermal Properties of Soils. Series on Rock
+!!            and Soil Mechanics, Vol. 11, Trans Tech, 136 PP.
+!!    Johansen, O., 1975: Thermal Conductivity of Soils. Ph.D. Thesis,
+!!            University of Trondheim,
+!!    Peters-Lidard, C. D., Blackburn, E., Liang, X., & Wood, E. F.,
+!!            1998: The effect of soil thermal conductivity 
+!!            Parameterization on Surface Energy fluxes
+!!            and Temperatures. J. of The Atmospheric Sciences,
+!!            Vol. 55, pp. 1209-1224.
+!! Modify histroy:
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+
+  SUBROUTINE thermosoil_cond (kjpindex, njsc, smc, qz, smcmax, sh2o, cnd)
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                                 :: kjpindex      !! Domain size (unitless)
+    INTEGER(i_std), DIMENSION (kjpindex), INTENT (in)          :: njsc          !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(IN)        :: smc           !! Volumetric Soil Moisture Content (m3/m3)
+    REAL(r_std), DIMENSION (nscm), INTENT(IN)                  :: qz            !! Quartz Content (Soil Type Dependent) (0-1)               
+    REAL(r_std), DIMENSION (nscm), INTENT(IN)                  :: smcmax        !! Soil Porosity (0-1)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(IN)        :: sh2o          !! Unfrozen Soil Moisture Content; Frozen Soil Moisture = smc - sh2o
+    
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(OUT)       :: cnd           !! Soil Thermal Conductivity (W/m/k)
+    
+    !! 0.3 Modified variables
+    
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)                    :: ake           !! Kerston Number (unitless)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)                    :: thksat        !! Saturated Thermal Conductivity (W/m/k)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)                    :: satratio      !! Degree of Saturation (0-1)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)                    :: xu            !! Unfrozen Volume For Saturation (0-1)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)                    :: xunfroz       !! Unfrozon Volume Fraction (0-1)
+    REAL(r_std)                                                :: thko          !! Thermal Conductivity for Other Ssoil Components (W/m/k)
+    REAL(r_std)                                                :: gammd         !! Dry Dendity (kg/m3)
+    REAL(r_std)                                                :: thkdry        !! Dry Thermal Conductivity (W/m/k)
+    REAL(r_std)                                                :: thks          !! Thermal Conductivity for the Solids Combined (Quartz + Other) (W/m/k)
+    REAL(r_std), PARAMETER                                     :: THKICE = 2.2  !! Ice Thermal Conductivity (W/m/k)
+    REAL(r_std), PARAMETER                                     :: THKQTZ = 7.7  !! Thermal Conductivity for Quartz (W/m/k)
+    REAL(r_std), PARAMETER                                     :: THKW = 0.57   !! Water Thermal Conductivity (W/m/k)
+    INTEGER(i_std)                                             :: ji, jg, jst
+    
+!_================================================================================================================================
+    
+    !! 1. Dry and Saturated Thermal Conductivity.
+   
+    DO ji = 1,kjpindex
+      jst = njsc(ji)
+
+      !! 1.1. Dry density (Kg/m3) and Dry thermal conductivity (W.M-1.K-1)
+      gammd = (1. - smcmax(jst))*2700.
+      thkdry = (0.135* gammd+ 64.7)/ (2700. - 0.947* gammd)
+
+      !! 1.2. thermal conductivity of "other" soil components
+      IF (qz(jst) > 0.2) THEN
+         thko = 2.0
+      ELSEIF (qz(jst) <= 0.2) THEN
+         thko = 3.0
+      ENDIF
+
+      !! 1.3. Thermal conductivity of solids
+      thks = (THKQTZ ** qz(jst))* (thko ** (1. - qz(jst)))
+
+      DO jg = 1,ngrnd      
+        !! 1.4. saturation ratio
+        satratio(ji,jg) = smc(ji,jg) / smcmax(jst)
+    
+        !! 1.5. Saturated Thermal Conductivity (thksat)
+        IF ( smc(ji,jg) > min_sechiba ) THEN
+           xunfroz(ji,jg) = sh2o(ji,jg) / smc(ji,jg)   ! Unfrozen Fraction (From i.e., 100%Liquid, to 0. (100% Frozen))
+           xu(ji,jg) = xunfroz(ji,jg) * smcmax(jst)  ! Unfrozen volume for saturation (porosity*xunfroz)
+           thksat(ji,jg) = thks ** (1. - smcmax(jst))* THKICE ** (smcmax(jst) - xu(ji,jg))* THKW ** (xu(ji,jg))
+        ELSE
+           ! this value will not be used since ake=0 for this case
+           thksat(ji,jg)=0 
+        END IF
+      END DO ! DO jg = 1,ngrnd
+
+      !! 2. Kerston Number (ake)
+      DO jg = 1,ngrnd
+        IF ( (sh2o(ji,jg) + 0.0005) <  smc(ji,jg) ) THEN
+          ! Frozen
+          ake(ji,jg) = satratio(ji,jg)
+        ELSE
+          ! Unfrozen
+          IF ( satratio(ji,jg) >  0.1 ) THEN
+            ake(ji,jg) = LOG10 (satratio(ji,jg)) + 1.0
+          ELSEIF ( satratio(ji,jg) >  0.05 .AND. satratio(ji,jg) <=  0.1 ) THEN
+            ake(ji,jg) = 0.7 * LOG10 (satratio(ji,jg)) + 1.0
+          ELSE
+            ake(ji,jg) = 0.0  ! use k = kdry
+          END IF
+        END IF
+      END DO ! DO jg = 1,ngrnd
+
+      !! 3. Thermal conductivity (cnd)
+      DO jg = 1,ngrnd
+        cnd(ji,jg) = ake(ji,jg) * (thksat(ji,jg) - thkdry) + thkdry
+      END DO ! DO jg = 1,ngrnd
+
+    END DO !DO ji = 1,kjpindex
+    
+  END SUBROUTINE thermosoil_cond
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_humlev
+!!
+!>\BRIEF           Interpolate variables from the hydrology layers to the thermodynamic layers
+!!
+!! DESCRIPTION  :  Interpolate the volumetric soil moisture content from the node to the interface of the layer. 
+!!                 The values for the deep layers in thermosoil where hydrology is not existing are constant. 
+!!                 No interpolation is needed for the total soil moisture content and for the soil saturation degree.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): mc_layt, mcl_layt, tmc_layt, shum_ngrnd_perma
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+  SUBROUTINE thermosoil_humlev(kjpindex, shumdiag_perma, mc_layh, mcl_layh, tmc_layh)
+  
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex       !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: shumdiag_perma !! Soil saturation degree on the diagnostic axis (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: mc_layh        !! Volumetric soil moisture content for each layer in hydrol at nodes(liquid+ice) [m/s]
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: mcl_layh       !! Volumetric soil moisture content for each layer in hydrol at nodes(liquid) [m/s]
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: tmc_layh       !! Total soil moisture content for each layer in hydrol(liquid+ice) [mm]
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                       :: ji, jd
+
+!_ ================================================================================================================================
+
+    IF (printlev >= 4) WRITE(numout,*) 'Start thermosoil_humlev' 
+
+    ! The values for the deep layers in thermosoil where hydrology is not existing are constant. 
+    ! For exemple if thermosoil uses 8m, and hydrol uses 2m vertical discretization,
+    ! the values between 2m and 8m are constant.
+    ! The moisture computed in hydrol is at the nodes (except for the
+    ! top and bottom layer which are at interfaces)
+    ! A linear interpolation is applied to obtain the moisture values at
+    ! the interfaces (mc_layt), from the mc_layh at the nodes
+
+    DO ji=1,kjpindex
+       DO jd = 1, nslm
+          IF(jd == 1) THEN ! the moisture at the 1st interface mc_layh(1) is at the surface, no interpolation
+             mc_layt(ji,jd) = mc_layh(ji,jd)
+             mcl_layt(ji,jd) = mcl_layh(ji,jd)
+          ELSEIF(jd == 2) THEN  !! the mc_layt at the 2nd interface is interpolated using mc_layh(1) at surface and mc_layh(2) at the node
+             mc_layt(ji, jd) = mc_layh(ji,jd-1)*(znt(jd)-zlt(jd-1))/(znt(jd)-0.0) + &
+                  mc_layh(ji, jd)*(zlt(jd-1)-0.0)/(znt(jd)-0.0)
+             mcl_layt(ji, jd) = mcl_layh(ji,jd-1)*(znt(jd)-zlt(jd-1))/(znt(jd)-0.0) + &
+                  mcl_layh(ji, jd)*(zlt(jd-1)-0.0)/(znt(jd)-0.0)
+          ELSEIF(jd == nslm) THEN ! the mc_layt at the nslm interface is interpolated using mc_layh(nslm) and mc_layh(nslm-1)
+             mc_layt(ji, jd) = mc_layh(ji,jd-1)*(zlt(jd)-zlt(jd-1))/(zlt(jd)-znt(jd-1))  + &
+                  mc_layh(ji,jd)*(zlt(jd-1)-znt(jd-1))/(zlt(jd)-znt(jd-1))
+             mcl_layt(ji, jd) = mcl_layh(ji,jd-1)*(zlt(jd)-zlt(jd-1))/(zlt(jd)-znt(jd-1))  + &
+                  mcl_layh(ji,jd)*(zlt(jd-1)-znt(jd-1))/(zlt(jd)-znt(jd-1))
+          ELSE ! the mc_layt at the other interfaces are interpolated using mc_layh at adjacent nodes.
+             mc_layt(ji, jd) = mc_layh(ji, jd-1)*(1-dz5(jd-1)) + mc_layh(ji,jd)*dz5(jd-1)
+             mcl_layt(ji, jd) = mcl_layh(ji, jd-1)*(1-dz5(jd-1)) + mcl_layh(ji,jd)*dz5(jd-1)
+          ENDIF
+
+          shum_ngrnd_perma(ji,jd) = shumdiag_perma(ji,jd)
+          tmc_layt(ji,jd) = tmc_layh(ji,jd)
+       ENDDO
+       
+       ! The deep layers in thermosoil where hydro is not existing
+       DO jd = nslm+1, ngrnd
+          shum_ngrnd_perma(ji,jd) = shumdiag_perma(ji,nslm)
+          mc_layt(ji,jd) = mc_layh(ji,nslm)
+          mcl_layt(ji,jd) = mcl_layh(ji,nslm)
+          tmc_layt(ji,jd) = tmc_layh(ji,nslm)
+       ENDDO
+    ENDDO
+
+    IF (printlev >= 4) WRITE(numout,*) 'thermosoil_humlev done' 
+
+  END SUBROUTINE thermosoil_humlev
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_energy
+!!
+!>\BRIEF         Energy check-up.
+!!
+!! DESCRIPTION  : I didn\'t comment this routine since at do not understand its use, please
+!! ask initial designers (Jan ? Nathalie ?).
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ??
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_energy(kjpindex, temp_sol_new, soilcap)
+  
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                     :: kjpindex     !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: temp_sol_new !! Surface temperature at the present time-step, Ts 
+                                                                   !! @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: soilcap      !! Apparent surface heat capacity 
+                                                                   !! @tex ($J m^{-2} K^{-1}$) @endtex, 
+                                                                   !! see eq. A29 of F. Hourdin\'s PhD thesis.
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                 :: ji, jg
+!_ ================================================================================================================================
+    
+    !  Sum up the energy content of all layers in the soil.
+    DO ji = 1, kjpindex
+   
+       IF (pcapa_en(ji,1) .LE. sn_capa) THEN
+          
+          ! Verify the energy conservation in the surface layer
+          coldcont_incr(ji) = soilcap(ji) * (temp_sol_new(ji) - temp_sol_beg(ji))
+          surfheat_incr(ji) = zero
+       ELSE
+          
+          ! Verify the energy conservation in the surface layer
+          surfheat_incr(ji) = soilcap(ji) * (temp_sol_new(ji) - temp_sol_beg(ji))
+          coldcont_incr(ji) = zero
+       ENDIF
+    ENDDO
+    
+    ptn_beg(:,:)      = ptn(:,:)
+    temp_sol_beg(:)   = temp_sol_new(:)
+
+  END SUBROUTINE thermosoil_energy
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_readjust
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION	: Energy conservation : Correction to make sure that the same latent heat is released and 
+!!                consumed during freezing and thawing  
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): ptn (soil temperature profile on the thermal axis), 
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_readjust(kjpindex, ptn)
+
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                             :: kjpindex
+    
+    !! 0.2 Modified variables
+    REAL(r_std),DIMENSION(kjpindex,ngrnd),INTENT(inout)    :: ptn
+
+    !! 0.3 Local variables
+    INTEGER(i_std)  :: ji, jg
+    INTEGER(i_std)  :: lev3m  !! Closest interface level to 3m
+    REAL(r_std) :: ptn_tmp
+
+    ! The energy is spread over the layers down to approximatly 3m
+    ! Find the closest level to 3m. It can be below or above 3m.
+    lev3m=MINLOC(ABS(zlt(:)-3.0),dim=1)
+    IF (printlev >= 3) WRITE(numout,*) 'In thermosoil_adjust: lev3m=',lev3m, ' zlt(lev3m)=', zlt(lev3m)
+    
+    DO jg=1, ngrnd
+       DO ji=1, kjpindex
+          ! All soil latent energy is put into e_soil_lat(ji)
+          ! because the variable soil layers make it difficult to keep track of all
+          ! layers in this version
+          ! NOTE : pcapa has unit J/K/m3 and pcappa_supp has J/K
+          e_soil_lat(ji)=e_soil_lat(ji)+pcappa_supp(ji,jg)*(ptn(ji,jg)-ptn_beg(ji,jg))
+       END DO
+    END DO
+
+   DO ji=1, kjpindex
+      IF (e_soil_lat(ji).GT.min_sechiba.AND.MINVAL(ptn(ji,:)).GT.ZeroCelsius+fr_dT/2.) THEN
+         ! The soil is thawed: we spread the excess of energy over the uppermost lev3m levels
+         ! Here we increase the temperatures
+         DO jg=1, lev3m
+            ptn_tmp=ptn(ji,jg)
+            
+            ptn(ji,jg)=ptn(ji,jg)+MIN(e_soil_lat(ji)/pcapa(ji,jg)/zlt(lev3m), 0.5)
+            e_soil_lat(ji)=e_soil_lat(ji)-(ptn(ji,jg)-ptn_tmp)*pcapa(ji,jg)*dlt(jg)
+         ENDDO
+      ELSE IF (e_soil_lat(ji).LT.-min_sechiba.AND.MINVAL(ptn(ji,:)).GT.ZeroCelsius+fr_dT/2.) THEN
+         ! The soil is thawed
+         ! Here we decrease the temperatures
+         DO jg=1, lev3m
+            ptn_tmp=ptn(ji,jg)
+            ptn(ji,jg)=MAX(ZeroCelsius+fr_dT/2., ptn_tmp+e_soil_lat(ji)/pcapa(ji,jg)/zlt(lev3m))
+            e_soil_lat(ji)=e_soil_lat(ji)+(ptn_tmp-ptn(ji,jg))*pcapa(ji,jg)*dlt(jg)
+         END DO
+      END IF
+   END DO
+
+  END SUBROUTINE thermosoil_readjust
+   
+!-------------------------------------------------------------------
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_getdiff
+!!
+!>\BRIEF          Computes soil and snow heat capacity and conductivity    
+!!
+!! DESCRIPTION	: Computation of the soil thermal properties; snow properties are also accounted for
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): 
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_getdiff( kjpindex, snow, ptn, njsc, snowrho, snowtemp, pb )
+
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in)				:: kjpindex
+    REAL(r_std),DIMENSION(kjpindex),INTENT (in)	        :: snow       !! Snow mass
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: njsc       !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowrho    !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowtemp   !! Snow temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: pb         !! Surface presure (hPa)
+    REAL(r_std),DIMENSION(kjpindex,ngrnd),INTENT(in)	:: ptn        !! Soil temperature profile
+
+    !! 0.3 Local variables
+    REAL						:: xx         !! Unfrozen fraction of the soil
+    REAL(r_std), DIMENSION(kjpindex)             	:: snow_h
+    REAL(r_std), DIMENSION(kjpindex,ngrnd) 		:: zx1, zx2    
+    REAL			   			:: cap_iw     !! Heat capacity of ice/water mixture 
+    INTEGER						:: ji,jg
+    INTEGER                                             :: jst
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)             :: pcapa_tmp  !! soil heat capacity (J/m3/K) 
+
+    pcapa_tmp(:,:) = 0.0
+
+    !! Computes soil heat capacity and conductivity
+    DO ji = 1,kjpindex
+      ! Since explicitsnow module is implemented set zx1=0 and zx2=1 
+      zx1(ji,:) = 0.
+      zx2(ji,:) = 1.
+       
+      DO jg = 1, ngrnd
+         jst = njsc(ji)
+         pcapa_tmp(ji, jg) = so_capa_dry_ns(jst) + water_capa * tmc_layt(ji,jg)/mille/dlt(jg)
+         !
+         ! 2. Calculate heat capacity with allowance for permafrost
+         ! 2.1. soil heat capacity depending on temperature and humidity
+	 
+         IF (ptn(ji,jg) .LT. ZeroCelsius-fr_dT/2.) THEN
+	    ! frozen soil
+	    profil_froz(ji,jg) = 1.
+ 	    pcappa_supp(ji,jg)= 0.
+            pcapa(ji, jg) = so_capa_dry_ns(jst) + so_capa_ice * tmc_layt(ji,jg) / mille / dlt(jg)
+
+     	 ELSEIF (ptn(ji,jg) .GT. ZeroCelsius+fr_dT/2.) THEN
+	    ! unfrozen soil	 
+            pcapa(ji, jg) = pcapa_tmp(ji, jg)
+	    profil_froz(ji,jg) = 0.
+ 	    pcappa_supp(ji,jg)= 0.
+     	 ELSE
+     	   ! xx is the unfrozen fraction of soil water	   	   
+     	   xx = (ptn(ji,jg)-(ZeroCelsius-fr_dT/2.)) / fr_dT
+           profil_froz(ji,jg) = (1. - xx)
+
+	   ! net heat capacity of the ice/water mixture
+     	   cap_iw = xx * so_capa_wet + (1.-xx) * so_capa_ice
+           pcapa(ji, jg) = so_capa_dry_ns(jst) + &
+                water_capa * tmc_layt(ji,jg)/mille / dlt(jg) * xx + &
+                so_capa_ice * tmc_layt(ji,jg) / mille/dlt(jg) * (1.-xx)
+ 	   pcappa_supp(ji,jg)= shum_ngrnd_perma(ji,jg)*poros*lhf*rho_water/fr_dT*zx2(ji,jg)*dlt(jg)
+
+         ENDIF
+
+         !
+	 ! 2.2. Take into account the snow and soil fractions in the layer
+	 !
+         pcapa(ji,jg) = zx1(ji,jg) * sn_capa + zx2(ji,jg) * pcapa(ji,jg)
+
+	 !
+	 ! 2.3. Calculate the heat capacity for energy conservation check 
+	 IF ( zx1(ji,jg).GT.0. ) THEN
+            pcapa_en(ji,jg) = sn_capa
+	 ELSE
+            pcapa_en(ji,jg) = pcapa(ji,jg)
+	 ENDIF
+
+      END DO            
+    ENDDO   
+
+    !
+    ! 3. Calculate the heat conductivity with allowance for permafrost
+    !
+    CALL thermosoil_cond (kjpindex, njsc, mc_layt, QZ, SMCMAX, mcl_layt, pkappa)
+
+    !! Computes snow heat capacity and conductivity    
+    DO ji = 1,kjpindex
+       pcapa_snow(ji,:) = snowrho(ji,:) * xci
+       pkappa_snow(ji,:) = (ZSNOWTHRMCOND1 + ZSNOWTHRMCOND2*snowrho(ji,:)*snowrho(ji,:)) +      &
+            MAX(0.0,(ZSNOWTHRMCOND_AVAP+(ZSNOWTHRMCOND_BVAP/(snowtemp(ji,:)+ &
+            ZSNOWTHRMCOND_CVAP)))*(XP00/(pb(ji)*100.)))
+    END DO
+   
+   END SUBROUTINE thermosoil_getdiff
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_getdiff_old_thermix_without_snow
+!!
+!>\BRIEF          Computes soil and snow heat capacity and conductivity    
+!!
+!! DESCRIPTION	: Calculations of soil and snow thermal properties without effect of freezing.
+!!                
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S):
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+    SUBROUTINE thermosoil_getdiff_old_thermix_without_snow( kjpindex, njsc, snowrho, snowtemp, pb )
+
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+      INTEGER(i_std), INTENT(in) :: kjpindex
+      INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: njsc     !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+      REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowrho  !! Snow density
+      REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowtemp !! Snow temperature (K)
+      REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: pb       !! Surface presure (hPa)
+
+
+    !! 0.1 Local variables
+      INTEGER(i_std)    				  :: ji,jg, jst     !! Index
+      REAL(r_std), DIMENSION (kjpindex,ngrnd)             :: pcapa_tmp      !! Soil heat capacity (J/m3/K) 
+
+      !! Computes soil heat capacity and conductivity
+      DO jg = 1,ngrnd
+         DO ji = 1,kjpindex
+            jst = njsc(ji)
+            pcapa_tmp(ji, jg) = so_capa_dry_ns(jst) + water_capa * tmc_layt(ji,jg)/mille/dlt(jg)
+            pcapa(ji,jg) = pcapa_tmp(ji, jg)
+            pcapa_en(ji,jg) = pcapa_tmp(ji, jg)
+         ENDDO
+      ENDDO
+
+      CALL thermosoil_cond (kjpindex, njsc, mc_layt, QZ, SMCMAX, mcl_layt, pkappa)
+
+      IF (brk_flag == 1) THEN
+        ! Bedrock flag is activated
+        DO jg = ngrnd-1,ngrnd
+          DO ji = 1,kjpindex
+             pcapa(ji,jg) = brk_capa
+             pcapa_en(ji,jg) = brk_capa 
+             pkappa(ji,jg) = brk_cond
+          ENDDO
+        ENDDO
+      ENDIF
+
+    !! Computes snow heat capacity and conductivity
+    DO ji = 1,kjpindex
+        pcapa_snow(ji,:) = snowrho(ji,:) * xci
+        pkappa_snow(ji,:) = (ZSNOWTHRMCOND1 + ZSNOWTHRMCOND2*snowrho(ji,:)*snowrho(ji,:)) +      &
+              MAX(0.0,(ZSNOWTHRMCOND_AVAP+(ZSNOWTHRMCOND_BVAP/(snowtemp(ji,:)+ &
+              ZSNOWTHRMCOND_CVAP)))*(XP00/(pb(ji)*100.)))
+    END DO
+
+  END SUBROUTINE thermosoil_getdiff_old_thermix_without_snow
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_read_reftempfile
+!!
+!>\BRIEF          
+!!
+!! DESCRIPTION	: Read file with longterm soil temperature
+!!                
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): reftemp : Reference temerature
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+  SUBROUTINE thermosoil_read_reftempfile(kjpindex,lalo,reftemp)
+    
+    USE interpweight
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in) :: kjpindex
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT(in) :: lalo
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(kjpindex, ngrnd), INTENT(out) :: reftemp
+
+    !! 0.3 Local variables
+    INTEGER(i_std) :: ib
+    CHARACTER(LEN=80) :: filename
+    REAL(r_std),DIMENSION(kjpindex) :: reftemp_file                          !! Horizontal temperature field interpolated from file [C]
+    INTEGER(i_std),DIMENSION(kjpindex,8) :: neighbours
+    REAL(r_std)                                          :: vmin, vmax       !! min/max values to use for the
+                                                                             !!   renormalization
+    REAL(r_std), DIMENSION(kjpindex)                     :: areftemp         !! Availability of data for  the interpolation
+    CHARACTER(LEN=80)                                    :: variablename     !! Variable to interpolate
+                                                                             !!   the file
+    CHARACTER(LEN=80)                                    :: lonname, latname !! lon, lat names in input file
+    REAL(r_std), DIMENSION(:), ALLOCATABLE               :: variabletypevals !! Values for all the types of the variable
+                                                                             !!   (variabletypevals(1) = -un, not used)
+    CHARACTER(LEN=50)                                    :: fractype         !! method of calculation of fraction
+                                                                             !!   'XYKindTime': Input values are kinds 
+                                                                             !!     of something with a temporal 
+                                                                             !!     evolution on the dx*dy matrix'
+    LOGICAL                                              :: nonegative       !! whether negative values should be removed
+    CHARACTER(LEN=50)                                    :: maskingtype      !! Type of masking
+                                                                             !!   'nomask': no-mask is applied
+                                                                             !!   'mbelow': take values below maskvals(1)
+                                                                             !!   'mabove': take values above maskvals(1)
+                                                                             !!   'msumrange': take values within 2 ranges;
+                                                                             !!      maskvals(2) <= SUM(vals(k)) <= maskvals(1)
+                                                                             !!      maskvals(1) < SUM(vals(k)) <= maskvals(3)
+                                                                             !!       (normalized by maskvals(3))
+                                                                             !!   'var': mask values are taken from a 
+                                                                             !!     variable inside the file (>0)
+    REAL(r_std), DIMENSION(3)                            :: maskvals         !! values to use to mask (according to 
+                                                                             !!   `maskingtype') 
+    CHARACTER(LEN=250)                                   :: namemaskvar      !! name of the variable to use to mask 
+    REAL(r_std)                                          :: reftemp_norefinf
+    REAL(r_std)                                          :: reftemp_default  !! Default value
+    
+
+    !Config Key   = SOIL_REFTEMP_FILE
+    !Config Desc  = File with climatological soil temperature
+    !Config If    = READ_REFTEMP
+    !Config Def   = reftemp.nc
+    !Config Help  = 
+    !Config Units = [FILE]
+    filename = 'reftemp.nc'
+    CALL getin_p('REFTEMP_FILE',filename)
+
+    variablename = 'temperature'
+
+    IF (printlev >= 3) WRITE(numout,*) " in thermosoil_read_reftempfile filename '" // TRIM(filename) // &
+      "' variable name: '" //TRIM(variablename) // "'"
+
+    ! For this case there are not types/categories. We have 'only' a continuos field
+    ! Assigning values to vmin, vmax
+
+    vmin = 0.
+    vmax = 9999.
+
+!   For this file we do not need neightbours!
+    neighbours = 0
+
+    !! Variables for interpweight
+    ! Type of calculation of cell fractions
+    fractype = 'default'
+    ! Name of the longitude and latitude in the input file
+    lonname = 'nav_lon'
+    latname = 'nav_lat'
+    ! Default value when no value is get from input file
+    reftemp_default = 1.
+    ! Reference value when no value is get from input file
+    reftemp_norefinf = 1.
+    ! Should negative values be set to zero from input file?
+    nonegative = .FALSE.
+    ! Type of mask to apply to the input data (see header for more details)
+    maskingtype = 'nomask'
+    ! Values to use for the masking (here not used)
+    maskvals = (/ undef_sechiba, undef_sechiba, undef_sechiba /)
+    ! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
+    namemaskvar = ''
+
+    CALL interpweight_2Dcont(kjpindex, 0, 0, lalo, resolution, neighbours,                            &
+      contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype,        &
+      maskvals, namemaskvar, -1, fractype, reftemp_default, reftemp_norefinf,                         &
+      reftemp_file, areftemp)
+    IF (printlev >= 5) WRITE(numout,*)'  thermosoil_read_reftempfile after interpweight_2Dcont'
+
+    ! Copy reftemp_file temperature to all ground levels and transform into Kelvin
+    DO ib=1, kjpindex
+      reftemp(ib, :) = reftemp_file(ib)+ZeroCelsius
+    END DO
+
+    ! Write diagnostics
+    CALL xios_orchidee_send_field("areftemp",areftemp)
+
+  END SUBROUTINE thermosoil_read_reftempfile
+
+END MODULE thermosoil
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/AA_make
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/AA_make	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/AA_make	(revision 6412)
@@ -0,0 +1,212 @@
+#-
+#- $Id$
+#-
+PARALLEL_LIB = $(LIBDIR)/libparallel.a
+SXPARALLEL_LIB = $(PARALLEL_LIB)
+#-Q- sxnec  SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- eshpux SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-
+PARAM_LIB = $(LIBDIR)/libparameters.a
+SXPARAM_LIB = $(PARAM_LIB)
+#-Q- sxnec  SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- eshpux SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-
+ORGLOB_LIB = $(LIBDIR)/liborglob.a
+SXORGLOB_LIB = $(ORGLOB_LIB)
+#-Q- sxnec  SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx6nec SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- eshpux SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx8brodie SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-
+MODS1 = stomate_data.f90      \
+        lpj_constraints.f90        \
+        lpj_cover.f90              \
+        lpj_crown.f90              \
+        lpj_establish.f90          \
+        lpj_fire.f90               \
+        lpj_gap.f90                \
+        lpj_kill.f90               \
+        lpj_light.f90              \
+        lpj_pftinout.f90           \
+        stomate_growth_fun_all.f90          \
+        stomate_data.f90           \
+        stomate_io.f90             \
+        stomate_litter.f90         \
+        stomate_phenology.f90      \
+        stomate_prescribe.f90      \
+        stomate_season.f90         \
+        stomate_soilcarbon.f90     \
+        stomate_turnover.f90       \
+        stomate_vmax.f90           \
+        stomate_lcchange.f90       \
+        stomate_lpj.f90            \
+        stomate_resp.f90           \
+        stomate.f90
+
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libparallel
+	$(M_K) libparameters
+	$(M_K) liborglob
+	$(M_K) m_all
+	@echo stomate is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+#-Q- intel m_all: WORK_MOD $(MODEL_LIB)($(OBJSMODS1))
+
+memory:
+#-Q- sxnec 	@echo maximum memory must be defined on Rhodes 
+#-Q- sxnec 	@echo in sh or ksh : ulimit -v unlimited 
+#-Q- sxnec 	@echo in csh or tcsh : limit vmemoryuse unlimited 
+#-Q- sxnec 	-/sbin/ulimit -v unlimited
+#-Q- sxnec 	-limit vmemoryuse unlimited
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+libparameters:
+	(cd ../src_parameters; $(M_K) -f Makefile)
+
+liborglob:
+	(cd ../src_global; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o): %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+#-Q- intel
+#-Q- intel WORK_MOD:
+#-Q- intel 	$(RM) work.pcl
+#-Q- intel 	@echo "work.pc" > work.pcl
+#-Q- intel 	@echo "../src_parameters/work.pc" >> work.pcl
+#-Q- intel 	@echo "../../IOIPSL/src/work.pc" >> work.pcl
+
+config: 
+	$(BINDIR)/Fparser -name STOMATE $(MODS1)
+	echo 'Configuration of STOMATE done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(stomate.o):          \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(stomate_io.o)      \
+  $(MODEL_LIB)(stomate_lpj.o)
+
+$(MODEL_LIB)(stomate_data.o): \
+  $(PARAM_LIB)(pft_parameters.o)	\
+  $(PARAM_LIB)(constantes.o)  
+
+$(MODEL_LIB)(lpj_constraints.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_cover.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_crown.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_establish.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_fire.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_gap.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_kill.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_light.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_pftinout.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_growth_fun_all.o): \
+  $(MODEL_LIB)(stomate_data.o) \
+  $(PARAM_LIB)(pft_parameters.o) \
+  $(PARAM_LIB)(function_library.o) 
+  
+
+$(MODEL_LIB)(stomate_io.o): \
+  $(MODEL_LIB)(stomate_data.o) \
+  $(PARALLEL_LIB)(mod_orchidee_para.o)
+
+
+$(MODEL_LIB)(stomate_litter.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_phenology.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_prescribe.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_resp.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_season.o): \
+  $(PARAM_LIB)(pft_parameters.o)	\
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_soilcarbon.o): \
+  $(MODEL_LIB)(stomate_data.o) \
+  $(ORGLOB_LIB)(grid.o)\
+  $(ORGLOB_LIB)(solar.o)
+
+$(MODEL_LIB)(stomate_turnover.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_vmax.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_lcchange.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_lpj.o):            \
+  $(MODEL_LIB)(lpj_constraints.o)       \
+  $(MODEL_LIB)(lpj_cover.o)             \
+  $(MODEL_LIB)(lpj_crown.o)             \
+  $(MODEL_LIB)(lpj_establish.o)         \
+  $(MODEL_LIB)(lpj_fire.o)              \
+  $(MODEL_LIB)(lpj_gap.o)               \
+  $(MODEL_LIB)(lpj_kill.o)              \
+  $(MODEL_LIB)(lpj_light.o)             \
+  $(MODEL_LIB)(lpj_pftinout.o)          \
+  $(MODEL_LIB)(stomate_data.o)          \
+  $(MODEL_LIB)(stomate_litter.o)        \
+  $(MODEL_LIB)(stomate_growth_fun_all.o)           \
+  $(MODEL_LIB)(stomate_phenology.o)     \
+  $(MODEL_LIB)(stomate_prescribe.o)     \
+  $(MODEL_LIB)(stomate_season.o)        \
+  $(MODEL_LIB)(stomate_soilcarbon.o)    \
+  $(MODEL_LIB)(stomate_turnover.o)      \
+  $(MODEL_LIB)(stomate_vmax.o)          \
+  $(MODEL_LIB)(stomate_resp.o)          \
+  $(MODEL_LIB)(stomate_lcchange.o)
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/AA_make.ldef
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/AA_make.ldef	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/AA_make.ldef	(revision 6412)
@@ -0,0 +1,19 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a STOMATE
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/libstomate.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxstomate.a
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_constraints.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_constraints.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_constraints.f90	(revision 6412)
@@ -0,0 +1,246 @@
+! =================================================================================================================================
+! MODULE       : lpj_constraints
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!              This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Groups the subroutines that: (1) initialize all variables in 
+!! lpj_constraints and (2) check the temperature threshold to decide for each PFT 
+!! if it can adapt to and regenerate under prevailing climate conditions**1
+!! 
+!!\n RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) :
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!   plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!   global vegetation model, Global Change Biology, 9, 161-185.\n
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!   dynamics in the modelling of terrestrial ecosystems: comparing two
+!!   contrasting approaches within European climate space,
+!!   Global Ecology and Biogeography, 10, 621-637.\n
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_constraints
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC constraints,constraints_clear
+
+  REAL(r_std), PARAMETER          :: grow_limit = 7+ZeroCelsius          !! Growing-season temperature limit to tree extension (K)
+  LOGICAL, SAVE                   :: firstcall_constraints = .TRUE.      !! first call
+!$OMP THREADPRIVATE(firstcall_constraints)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : constraints_clear
+!!
+!>\BRIEF        Set the flag ::firstcall_constraints to .TRUE. and as such activate section 
+!!              1.1 of the subroutine constraints (see subroutine constraints).
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE constraints_clear
+    firstcall_constraints = .TRUE. 
+  END SUBROUTINE constraints_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : constraints
+!!
+!>\BRIEF        Determine whether each PFT can adapt to and regenerate under the prevailing climate
+!! conditions. Climate conditions are characterised by different threshold values for air temperature.
+!!
+!! DESCRIPTION : PFTs are adapted to the climate conditions if the daily air temperature does not drop below 
+!! the treshold values ::tcm_crit. Some PFT's do not have a ::tcm_crit treshold. Seasonal trees die if leafage 
+!! does not show a clear seasonality. (i.e. if the start of the growing season is never detected)
+!! 
+!! If the monthly temperature is below ::tcm_crit i.e. the critical temperature of the coldest month, the 
+!! PFT will be able to regenerate. If minimum temperatures do not drop below ::tcm_crit, its regenerative 
+!! capacity decreases with time. Hence, plants that need vernalization die after a few years if they don't
+!! vernalize (even if they would not loose their leaves).
+!!
+!! The treshold values ::t_min_crit, the critical temperature of the coldest month is defined in 
+!! stomate_constants.f90'. However, ::regenerate_min, the critical temperature to support regeneration is 
+!! calculated in this routine from parameters of which none depenent on the PFT. The value for 
+!! ::large_value is defined as 1.E33 in stomata_constraints
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::adapted (0-1, unitless) and ::regenerate (0-1, unitless)
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : 
+!! \latexonly 
+!!     \includegraphics[scale=0.3]{lpj_constraints_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+  
+    SUBROUTINE constraints (npts, dt, &
+       t2m_month, t2m_min_daily, when_growthinit, Tseason, &
+       adapted, regenerate)
+    
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variable
+
+    INTEGER(i_std), INTENT(in)                      :: npts            !! Domain size (unitless)
+    REAL(r_std), INTENT(in)                         :: dt              !! Time step   (days)
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: t2m_month       !! "Monthly" 2-meter temperature by defualt 
+                                                                       !! monthly spans 20 days a (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: Tseason         !! "seasonal" 2-meter temperature (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: t2m_min_daily   !! Daily minimum 2-meter temperature (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)    :: when_growthinit !! Days since beginning of growing season (days)
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: adapted         !! Winter too cold? (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: regenerate      !! Winter sufficiently cold? (0 to 1, unitless)
+
+    !! 0.4 Local variables
+
+    REAL(r_std)                                     :: tau_adapt       !! Memory length for adaption (days)
+    REAL(r_std)                                     :: tau_regenerate  !! Memory length for regeneration (days)
+    REAL(r_std)                                     :: regenerate_min  !! Critical value of "regenerate" below which plant 
+                                                                       !! dies (unitless)
+    INTEGER(i_std)                                  :: j               !! Index
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering constraints' ! diagnostic level in implimentation
+
+  !! 1. Initializations
+
+    tau_adapt = one_year
+    tau_regenerate = one_year
+
+    !! 1.1 Print parameter settings
+    IF ( firstcall_constraints ) THEN
+
+       WRITE(numout,*) 'constraints:'
+       
+       WRITE(numout,*) '   > Memory length for adaption (d): ',tau_adapt
+       WRITE(numout,*) '   > Memory length for regeneration (d): ',tau_regenerate
+       WRITE(numout,*) '   > Longest sustainable time without vernalization (y):', too_long
+       WRITE(numout,*) '   > For trees, longest sustainable time without growth init (y):', too_long
+       
+       firstcall_constraints = .FALSE.
+       
+    ENDIF
+
+    !! 1.2 Calculate critical value for "regenerate"
+    !      Critical value for "regenerate", below this value, the last vernalization
+    !      happened too far in the past, The PFT is can not regenerate under the 
+    !      prevailing climate conditions.
+    regenerate_min = exp ( - too_long * one_year / tau_regenerate )
+
+  !! 2. Calculate ::adapted and ::regenerate
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! 2.1 PFT mask for natural or agriculture vegetations
+       IF ( natural(j) .OR. agriculture ) THEN
+
+          !! 2.1.1 Climate criteria
+          !! There is no critical temperature for the PFT 
+          !  Frost restistant PFT do not have a critical temperature for growth
+          IF ( tmin_crit(j) .EQ. undef ) THEN
+             adapted(:,j) = un 
+          ENDIF
+
+          !! 2.1.2 Seasonal trees die if leafage does not show a clear seasonality.
+          !        Seasonal trees die if leafage does not show a clear seasonality
+          !        (i.e. if the start of the growing season is never detected).
+          IF ( is_tree(j) .AND. ( pheno_model(j) .NE. 'none' ) ) THEN
+
+             WHERE ( when_growthinit(:,j) .GT. too_long*one_year .AND. when_growthinit(:,j).LT. large_value)
+                adapted(:,j) = zero
+             ENDWHERE
+
+          ENDIF
+
+          ! "seasonal" temperature Tseason must exceed 7 degree (grow_limit) for trees to be declared adapted.
+          IF ( is_tree(j) ) THEN
+             WHERE ( Tseason(:) .LT. grow_limit )
+                adapted(:,j)=zero
+             ENDWHERE
+          ENDIF
+
+          adapted(:,j) = un - ( un - adapted(:,j) ) * (tau_adapt- dt)/tau_adapt 
+
+          !! 2.1.3 Test if PFT is regenerative
+
+          !! 2.1.3.1 Check PFT vernalization. 
+          !          If sufficiently cold, PFT will be able to regenerate for some time.
+          !          Several PFTs (ex: evergreen) don't need vernalization 
+          IF ( tcm_crit(j) .EQ. undef ) THEN
+
+             regenerate(:,j) = un
+
+          !! 2.1.3.2 PFT needs vernalization
+          ELSE
+
+             WHERE ( t2m_month(:) .LE. tcm_crit(j) )
+                regenerate(:,j) = un
+             ENDWHERE
+
+             ! Limited memory: after some time, the winter is forgotten and the PFT can no longer
+             ! produce seeds, hence, with time ::regenerate approaches 0
+             regenerate(:,j) = regenerate(:,j) * (tau_regenerate-dt)/tau_regenerate
+
+          ENDIF
+
+          !! 2.1.4 Plants that need vernalization die
+          !        Plants that need vernalization die after a few years if they don't
+          !        vernalize (even if they would not loose their leaves).
+          WHERE ( regenerate(:,j) .LE. regenerate_min )
+             adapted(:,j) = zero
+          ENDWHERE
+
+       !! 2.1 PFT except natual and agriculture vegetation
+       !      Should be developed if needed 
+       ELSE
+
+          adapted(:,j) = zero
+
+          regenerate(:,j) = zero
+
+       ENDIF ! PFT of natural or agriculture
+
+    ENDDO ! Loop over # PFTs
+
+  !! 3. Write history files
+    CALL xios_orchidee_send_field("ADAPTATION",adapted)
+    CALL xios_orchidee_send_field("REGENERATION",regenerate)
+
+    CALL histwrite_p (hist_id_stomate, 'ADAPTATION', itime, &
+         adapted, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'REGENERATION', itime, &
+         regenerate, npts*nvm, horipft_index)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving constraints'
+
+  END SUBROUTINE constraints
+
+END MODULE lpj_constraints
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_cover.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_cover.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_cover.f90	(revision 6412)
@@ -0,0 +1,347 @@
+! =================================================================================================================================
+! MODULE       : lpj_cover
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Recalculate vegetation cover and LAI
+!!
+!!\n DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) : 
+!!        Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!        plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!        global vegetation model, Global Change Biology, 9, 161-185.\n
+!!        Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!        dynamics in the modelling of terrestrial ecosystems: comparing two
+!!        contrasting approaches within European climate space,
+!!        Global Ecology and Biogeography, 10, 621-637.\n
+!!
+!! SVN :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_cover
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+
+  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 shaded ground area by leaf's light capture
+!! Finally, grid-scale fpc is adjusted not to exceed 1.0
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : lai (leaf area index, @tex $(m^2 m^{-2})$ @endtex), 
+!!                           veget (fractional vegetation cover, unitless)
+!!
+!! REFERENCE(S)   : None
+!! 
+!! FLOWCHART :
+!! \latexonly 
+!!     \includegraphics[scale=0.5]{lpj_cover_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE cover (npts, cn_ind, ind, biomass, &
+       veget_max, veget_max_old, lai, litter, som, turnover_daily, bm_to_litter, &
+       co2_to_bm, co2_fire, resp_hetero, resp_maint, resp_growth, gpp_daily,&
+        lignin_struc, lignin_wood, soil_n_min)
+
+!! 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 
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: lai            !! Leaf area index OF AN INDIVIDUAL PLANT 
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(inout) :: litter    !! Metabolic and structural litter, above and 
+                                                                                       !! below ground @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nelements), INTENT(inout)  :: som            !! Carbon pool: active, slow, or passive @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! Biomass @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: veget_max      !! "Maximal" coverage fraction of a PFT (LAI->
+                                                                                       !! infinity) on ground (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: turnover_daily !! Turnover rates (gC m^{-2} day^{-1})
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter   !! Conversion of biomass to litter 
+                                                                                       !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: co2_to_bm      !! biomass up take for establishment           
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: co2_fire       !! Carbon emitted to the atmosphere by fire(living
+                                                                                       !! and dead biomass)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: resp_hetero    !! Heterotrophic respiration
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: resp_maint     !! Maintenance respiration 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: resp_growth    !! Growth respiration
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: gpp_daily      !! Daily gross primary productivity
+    REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(inout)            :: lignin_struc   !! ratio Lignine/Carbon in structural litter,
+                                                                                       !! above and below ground
+    REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(inout)            :: lignin_wood    !! ratio Lignine/Carbon in woody litter,
+                                                                                       !! above and below ground
+    REAL(r_std),DIMENSION(npts,nvm,nnspec), INTENT(inout)            :: soil_n_min     !! mineral nitrogen in the soil (gN/m**2)  
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                              :: i,j,k,m             !! Index (unitless)
+    REAL(r_std), DIMENSION(npts,nlitt,nlevs,nelements)          :: dilu_lit            !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts,ncarb,nelements)                :: dilu_som            !! Dilution for soil Organic Matter
+                                                                                       !! @tex $(gC(or N) m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nnspec)                         :: dilu_sin            !! Dilution for soil Inorganic Nitrogen
+                                                                                       !! @tex $(gN m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nlevs)                          :: dilu_lf_struc       !! Dilution for fraction of structural litter that is lignin
+    REAL(r_std), DIMENSION(npts,nlevs)                          :: dilu_lf_wood        !! Dilution for fraction of woody litter that is lignin
+    REAL(r_std), DIMENSION(npts,nparts,nelements)               :: dilu_bio            !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_TCarbon        !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts,nparts,nelements)               :: dilu_turnover_daily !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts,nparts,nelements)               :: dilu_bm_to_litter   !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_co2flux_new    !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_gpp_daily      !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_resp_growth    !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_resp_maint     !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_resp_hetero    !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_co2_to_bm      !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_co2_fire       !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts,nvm)                            :: TCarbon             !! Total carbon
+    REAL(r_std), DIMENSION(npts,nvm)                            :: co2flux_new         !! NBP after re-calculation in order to conserve carbon 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: co2flux_old         !! NBP before re-calculation 
+    REAL(r_std), DIMENSION(nvm)                                 :: delta_veg           !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(nvm)                                 :: reduct              !! Conversion factors (unitless)
+    REAL(r_std)                                                 :: delta_veg_sum       !! Conversion factors (unitless)
+    REAL(r_std)                                                 :: diff                !! Conversion factors (unitless)
+    REAL(r_std)                                                 :: sr                  !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: frac_nat            !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: sum_vegettree       !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: sum_vegetgrass      !! Conversion factors (unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: sum_veget_natveg    !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: vartmp              !! Temporary variable used to add history
+
+!_ ================================================================================================================================
+
+ !! 1. If the vegetation is dynamic, calculate new maximum vegetation cover for natural plants
+  
+    IF ( ok_dgvm ) THEN
+
+       !! 1.1  Calculate initial values of vegetation cover
+       frac_nat(:) = un
+       sum_veget_natveg(:) = zero
+       veget_max(:,ibare_sechiba) = un
+
+       DO j = 2,nvm ! loop over PFTs
+
+          IF ( natural(j) ) THEN
+	     
+             ! Summation of individual tree crown area to get total foliar projected coverage
+             veget_max(:,j) = ind(:,j) * cn_ind(:,j)
+             sum_veget_natveg(:) = sum_veget_natveg(:) + veget_max(:,j)
+
+          ELSE
+             
+             !fraction occupied by agriculture needs to be substracted for the DGVM
+             !this is used below to constrain veget for natural vegetation, see below
+             frac_nat(:) = frac_nat(:) - veget_max(:,j)
+
+          ENDIF
+
+       ENDDO ! loop over PFTs
+
+       DO i = 1, npts ! loop over grid points
+	  
+          ! Recalculation of vegetation projected coverage when ::frac_nat was below ::sum_veget_natveg
+          ! It means that non-natural vegetation will recover ::veget_max as natural vegetation
+          IF (sum_veget_natveg(i) .GT. frac_nat(i) .AND. frac_nat(i) .GT. min_stomate) THEN
+
+             DO j = 2,nvm ! loop over PFTs
+                IF( natural(j) ) THEN
+                   veget_max(i,j) =  veget_max(i,j) * frac_nat(i) / sum_veget_natveg(i)
+                ENDIF
+             ENDDO ! loop over PFTs
+
+          ENDIF
+       ENDDO ! loop over grid points
+	
+       ! Renew veget_max of bare soil as 0 to difference of veget_max (ibare_sechiba) 
+       ! to current veget_max
+       DO j = 2,nvm ! loop over PFTs
+          veget_max(:,ibare_sechiba) = veget_max(:,ibare_sechiba) - veget_max(:,j)
+       ENDDO ! loop over PFTs
+       veget_max(:,ibare_sechiba) = MAX( veget_max(:,ibare_sechiba), zero )
+
+       !! 1.2 Calculate carbon fluxes between PFTs to maintain mass balance
+       !! Assure carbon closure when veget_max changes(delta_veg): if veget_max of some PFTs decrease, we use "dilu" to 
+       !! record the corresponding lost in carbon (biomass, litter, soil carbon, gpp, respiration etc.) for 
+       !! these PFTs, and re-allocate "dilu" to those PFTs with increasing veget_max.
+       DO i = 1, npts ! loop over grid points
+          
+          ! Calculate the change in veget_max between previous time step and current time step
+          delta_veg(:) = veget_max(i,:)-veget_max_old(i,:)
+          delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.zero)
+
+          dilu_lit(i,:,:,:) = zero
+          dilu_som(i,:,:) = zero
+          dilu_sin(i,:) = zero
+          dilu_lf_struc(i,:) = zero
+          dilu_lf_wood(i,:) = zero
+          dilu_bio(i,:,:) = zero
+          dilu_TCarbon(i)=zero
+          dilu_turnover_daily(i,:,:)=zero
+          dilu_bm_to_litter(i,:,:)=zero
+          dilu_co2flux_new(i)=zero
+          dilu_gpp_daily(i)=zero
+          dilu_resp_growth(i)=zero
+          dilu_resp_maint(i)=zero
+          dilu_resp_hetero(i)=zero
+          dilu_co2_to_bm(i)=zero
+          dilu_co2_fire(i)=zero
+
+          ! Calculate TCarbon: total carbon including biomass, litter and soil carbon, as well as "today's" turnover and 
+          ! bm_to_litter due to mortality, because today's turnover and bm_to_litter are not yet added into "litter" until tomorrow. 
+          DO j=1, nvm
+                TCarbon(i,j)=SUM(biomass(i,j,:,icarbon))+SUM(som(i,:,j,icarbon))+SUM(litter(i,:,j,:,icarbon))+&
+                     SUM(turnover_daily(i,j,:,icarbon))+SUM(bm_to_litter(i,j,:,icarbon))
+                co2flux_old(i,j)=resp_maint(i,j)+resp_growth(i,j)+resp_hetero(i,j)+co2_fire(i,j)-co2_to_bm(i,j)-gpp_daily(i,j)
+                co2flux_new(i,j)=resp_maint(i,j)+resp_growth(i,j)+resp_hetero(i,j)+co2_fire(i,j)-co2_to_bm(i,j)-gpp_daily(i,j)
+          ENDDO
+
+          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_som(i,:,:) =  dilu_som(i,:,:) + delta_veg(j) * som(i,:,j,:) / delta_veg_sum
+                dilu_sin(i,:) =  dilu_sin(i,:) + delta_veg(j) * soil_n_min(i,j,:) / delta_veg_sum 
+                dilu_lf_struc(i,:) = dilu_lf_struc(i,:) + & 
+                     delta_veg(j) * lignin_struc(i,j,:) * litter(i,istructural,j,:,icarbon)/ delta_veg_sum
+                dilu_lf_wood(i,:) = dilu_lf_wood(i,:) + &
+                     delta_veg(j) * lignin_wood(i,j,:)*litter(i,iwoody,j,:,icarbon)  / delta_veg_sum
+                dilu_TCarbon(i)= dilu_TCarbon(i) + delta_veg(j) * TCarbon(i,j) / delta_veg_sum
+                dilu_turnover_daily(i,:,:)=dilu_turnover_daily(i,:,:)+delta_veg(j)*turnover_daily(i,j,:,:)/delta_veg_sum
+                dilu_bm_to_litter(i,:,:)=dilu_bm_to_litter(i,:,:)+delta_veg(j)*bm_to_litter(i,j,:,:)/delta_veg_sum
+                dilu_co2flux_new(i)=dilu_co2flux_new(i)+delta_veg(j)*co2flux_old(i,j)/delta_veg_sum
+                dilu_gpp_daily(i)=dilu_gpp_daily(i)+delta_veg(j)*gpp_daily(i,j)/delta_veg_sum
+                dilu_resp_growth(i)=dilu_resp_growth(i)+delta_veg(j)*resp_growth(i,j)/delta_veg_sum
+                dilu_resp_maint(i)=dilu_resp_maint(i)+delta_veg(j)*resp_maint(i,j)/delta_veg_sum
+                dilu_resp_hetero(i)=dilu_resp_hetero(i)+delta_veg(j)*resp_hetero(i,j)/delta_veg_sum
+                dilu_co2_to_bm(i)=dilu_co2_to_bm(i)+delta_veg(j)*co2_to_bm(i,j)/delta_veg_sum
+                dilu_co2_fire(i)=dilu_co2_fire(i)+delta_veg(j)*co2_fire(i,j)/delta_veg_sum
+             ENDIF
+          ENDDO ! 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
+                ! Lignin fraction of structural litter
+                lignin_struc(i,j,:)=(lignin_struc(i,j,:) * veget_max_old(i,j)* litter(i,istructural,j,:,icarbon) + & 
+                     dilu_lf_struc(i,:) * delta_veg(j)) / veget_max(i,j) 
+
+                ! Lignin fraction of woody litter
+                lignin_wood(i,j,:)=(lignin_wood(i,j,:) * veget_max_old(i,j)* litter(i,iwoody,j,:,icarbon) + & 
+                     dilu_lf_wood(i,:) * delta_veg(j)) / veget_max(i,j)
+
+                litter(i,:,j,:,:)=(litter(i,:,j,:,:) * veget_max_old(i,j) + dilu_lit(i,:,:,:) * delta_veg(j)) / veget_max(i,j)
+
+                WHERE ( litter(i,istructural,j,:,icarbon) > min_stomate )
+                   lignin_struc(i,j,:) = lignin_struc(i,j,:)/litter(i,istructural,j,:,icarbon)
+                ELSEWHERE
+                   lignin_struc(i,j,:) = LC_leaf(j)
+                ENDWHERE
+
+                WHERE ( litter(i,iwoody,j,:,icarbon) > min_stomate )
+                   lignin_wood(i,j,:) = lignin_struc(i,j,:)/litter(i,iwoody,j,:,icarbon)
+                ELSEWHERE
+                   lignin_wood(i,j,:) = LC_heartabove(j)
+                ENDWHERE
+
+                ! Soil carbon
+                som(i,:,j,:)=(som(i,:,j,:) * veget_max_old(i,j) + dilu_som(i,:,:) * delta_veg(j)) / veget_max(i,j)
+                ! Soil inorganic nitrogen  
+                soil_n_min(i,j,:)=(soil_n_min(i,j,:) * veget_max_old(i,j) + dilu_sin(i,:) &  
+                     * delta_veg(j)) / veget_max(i,j) 
+                TCarbon(i,j)=(TCarbon(i,j) * veget_max_old(i,j) + dilu_TCarbon(i) * delta_veg(j)) / veget_max(i,j)
+                turnover_daily(i,j,:,:)=(turnover_daily(i,j,:,:)*veget_max_old(i,j)+&
+                     dilu_turnover_daily(i,:,:)*delta_veg(j))/veget_max(i,j)
+                bm_to_litter(i,j,:,:)=(bm_to_litter(i,j,:,:)*veget_max_old(i,j)+&
+                     dilu_bm_to_litter(i,:,:)*delta_veg(j))/veget_max(i,j)
+                co2flux_new(i,j)=(co2flux_old(i,j)*veget_max_old(i,j)+dilu_co2flux_new(i)*delta_veg(j))/veget_max(i,j)
+                gpp_daily(i,j)=(gpp_daily(i,j)*veget_max_old(i,j)+dilu_gpp_daily(i)*delta_veg(j))/veget_max(i,j)
+                resp_growth(i,j)=(resp_growth(i,j)*veget_max_old(i,j)+dilu_resp_growth(i)*delta_veg(j))/veget_max(i,j)
+                resp_maint(i,j)=(resp_maint(i,j)*veget_max_old(i,j)+dilu_resp_maint(i)*delta_veg(j))/veget_max(i,j)
+                resp_hetero(i,j)=(resp_hetero(i,j)*veget_max_old(i,j)+dilu_resp_hetero(i)*delta_veg(j))/veget_max(i,j)
+                co2_to_bm(i,j)=(co2_to_bm(i,j)*veget_max_old(i,j)+dilu_co2_to_bm(i)*delta_veg(j))/veget_max(i,j)
+                co2_fire(i,j)=(co2_fire(i,j)*veget_max_old(i,j)+dilu_co2_fire(i)*delta_veg(j))/veget_max(i,j)
+             ENDIF
+
+             IF(veget_max(i,j).GT.min_stomate) THEN
+
+                ! Correct biomass densities to conserve mass
+                ! since it's defined on veget_max
+                biomass(i,j,:,:) = biomass(i,j,:,:) * veget_max_old(i,j) / veget_max(i,j)
+
+             ENDIF
+
+          ENDDO ! loop over PFTs
+       ENDDO ! loop over grid points
+
+       vartmp(:)=SUM(gpp_daily*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tGPP", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_growth*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tRESP_GROWTH", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_maint*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tRESP_MAINT", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_hetero*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tRESP_HETERO", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2_to_bm*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCO2_TAKEN", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2_fire*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCO2_FIRE", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2flux_new*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCO2FLUX", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2flux_old*veget_max_old,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCO2FLUX_OLD", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(TCarbon*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCARBON", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(SUM(biomass(:,:,:,icarbon),dim=3)*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tBIOMASS", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(SUM(SUM(litter(:,:,:,:,icarbon),dim=4),dim=2)*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tLITTER", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(SUM(som(:,:,:,icarbon),dim=2)*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tSOILC", itime, vartmp, npts, hori_index)
+    ENDIF
+
+  END SUBROUTINE cover
+
+END MODULE lpj_cover
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_crown.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_crown.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_crown.f90	(revision 6412)
@@ -0,0 +1,203 @@
+! =================================================================================================================================
+! MODULE       : lpj_crown
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Calculate individual crown area from stem mass
+!!
+!! \n DESCRIPTION : Calculating crown area of individual tree by diameter and tree height
+!!
+!! REFERENCE(S) :
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!  dynamics in the modelling of terrestrial ecosystems: comparing two
+!!  contrasting approaches within European climate space,
+!!  Global Ecology and Biogeography, 10, 621-637.
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_crown
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+  
+  IMPLICIT NONE
+  
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC crown
+  
+CONTAINS
+  
+  
+!! ================================================================================================================================
+!! SUBROUTINE    : lpj_crown
+!!
+!>\BRIEF         Calculate individual crown area from stem mass
+!!
+!! DESCRIPTION   : Calculating crown area of individual tree by diameter and tree height
+!! which are also calculated internally within this program from stem mass and allometory.
+!! Calculations for diameter, height and crown area originate from eqns 1, 2, and 3 in 
+!! Appendix B, Smith et al. (2001) following Huang et al. 1992 and Zeide 1993.
+!! \latexonly
+!!  \input{lpj_crown1.tex}
+!!  \input{lpj_crown2.tex}
+!!  \input{lpj_crown3.tex}
+!! \endlatexonly
+!! \n
+!! where \f$k_{allom1}(=100.)\f$, \f$k_{allom2}(=40.)\f$, \f$k_{allom3}(=0.85)\f$ and \f$k_{rp}(=1.6)\f$ are 
+!! constants, \f$WD\f$ is wood density (\f$=2 \times 10^5\f$ gC m\f$^3\f$) and \f$CA_{max}\f$ is maximum 
+!! crown area (\f$=27.3\f$ m\f$^2\f$).
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::cn_ind (crown area per individual, @tex $m^2 $ @endtex) and ::height (m)
+!!
+!! REFERENCE(S)   :
+!! - Huang, S., Titus, S.J. and Wiens, D.P. (1992) Comparison of nonlinear heightâdiameter functions for major 
+!! Alberta tree species. Canadian Journal of Forest Research, 22, 1297â1304.\n
+!! - Zeide, B. (1993) Primary unit of the tree crown. Ecology, 74, 1598â1602.\n
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation dynamics in the modelling of 
+!! terrestrial ecosystems: comparing two contrasting approaches within European climate space,
+!! Global Ecology and Biogeography, 10, 621-637.\n
+!! 
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE crown &
+       &  (npts, PFTpresent, ind, biomass, woodmass_ind, veget_max, cn_ind, height)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                         :: npts              !! Domain size (unitless) 
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in)            :: PFTpresent        !! Is pft there (unitless)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)        :: ind               !! [DISPENSABLE] Density of individuals 
+                                                                           !! @tex $(m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: biomass !! [DISPENSABLE] Biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)        :: woodmass_ind      !! Woodmass of the individual, needed to calculate 
+                                                                           !! crownarea in lpj_crown (gC)
+
+    !! 0.2 Output variables
+  
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out)       :: cn_ind            !! Crown area per individual @tex $(m^{2})$ @endtex    
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(inout)     :: veget_max        !! [DISPENSABLE] "Maximal" coverage fraction of a PFT 
+                                                                          !! infinity) on ground (unitless)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(inout)     :: height           !! Height of vegetation (m)           
+
+    !! 0.4 Local variables
+	
+!   REAL(r_std),DIMENSION(npts)                       :: woodmass        !! Wood mass of an individual (gC)
+    INTEGER(i_std)                                    :: j               !! Index
+    REAL(r_std),DIMENSION(npts)                       :: dia             !! Stem diameter (m)
+    REAL(r_std),DIMENSION(nvm)                        :: height_presc_12 !! [DISPENSABLE] Prescribed height of each pfts (m)
+
+!_ ================================================================================================================================
+    
+  !! 1. Initializations
+    
+    !! 1.1 Check if DGVM is activated
+    IF (.NOT.ok_dgvm .AND. lpj_gap_const_mort) THEN
+       CALL ipslerr_p(3,'crown','Coherence error','crown cannot be called with static vegetation.','')
+    ENDIF
+    
+    !! 1.2 Initialize output to zero
+    cn_ind(:,:) = zero
+
+    !! 1.3 Copy prescribed height to new variable**3 !![DISPENSABLE]
+    height_presc_12(1:nvm) = height_presc(1:nvm)     !![DISPENSABLE]
+    
+  !! 2. Calculate (or prescribe) crown area
+    
+    DO j = 2,nvm ! loop over PFTs
+       IF (is_tree(j)) THEN
+          
+          !! 2.1 Trees
+          IF (natural(j)) THEN
+
+             !! 2.1.1 Natural trees
+             !WHERE (PFTpresent(:,j) .AND.ind(:,j).GT.min_stomate)
+             WHERE (PFTpresent(:,j) .AND.woodmass_ind(:,j).GT.min_stomate)
+
+                !! 2.1.1.1 Calculate individual wood mass**2
+
+                !! S. Zaehle note that woodmass_ind needs to be defined on the individual, hence
+                !! biomass*veget_max/ind, not as stated here, correction MERGE 
+                !!         woodmass(:) = &
+                !! &         (biomass(:,j,isapabove,icarbon) + biomass(:,j,isapbelow,icarbon) &
+                !! &         +biomass(:,j,iheartabove,icarbon) + biomass(:,j,iheartbelow,icarbon))/ind(:,j)
+          
+                !! 2.1.1.2 Stem diameter from pipe model
+                !          Stem diameter (pipe model) is calculated by allometory (eqn 1, Appdx B, Smith et al. (2001))
+                !!!$          dia(:) = (woodmass(:)/(pipe_density*pi/4.*pipe_tune2)) &
+                dia(:) = (woodmass_ind(:,j)/(pipe_density(j)*pi/4.*pipe_tune2)) &
+                 &       **(1./(2.+pipe_tune3))
+
+                !! 2.1.1.3 Individual tree height from pipe model
+                !          Individual tree height (eqn 2, Appdx B, Smith et al. (2001))
+                height(:,j) = pipe_tune2*(dia(:)**pipe_tune3)
+
+                !!!$S. Zaehle : The constraint on height has nothing to do with LPJ (for that purpose there's dia_max
+                !!!$ cannot see why this is necessary - it also blurrs the output, hence I leave it commented
+                !!!$ WHERE (height(:,j) > height_presc_12(j))
+                !!!$    dia(:) = (height_presc_12(j)/pipe_tune2)**(1./pipe_tune3)
+                !!!$    height(:,j) = height_presc_12(j)
+                !!!$ ENDWHERE
+
+                !! 2.1.1.4 Crown area of individual tree  
+                !          Calculate crown area, truncate crown area for trunks with large diameters 
+                ! crown area cannot exceed a certain value, prescribed through maxdia 
+                ! (eqn 3, Appdx B, Smith et al. (2001))
+                cn_ind(:,j) = pipe_tune1*MIN(dia(:),maxdia(j))**pipe_tune_exp_coeff
+
+             ENDWHERE
+          ELSE
+
+             !! 2.1.2 Agricultural tree
+             !        To be developped if needed
+             CALL ipslerr_p(3,'crown','Cannot treat agricultural trees.','','')
+          ENDIF
+       ELSE
+          
+       !! 2.2 Grasses
+          
+          WHERE (PFTpresent(:,j))
+
+             !! 2.2.1 Crown area of grass
+             !        An "individual" is 1 m^2 of grass
+             cn_ind(:,j) = un
+          ENDWHERE
+       ENDIF
+       
+       !! 2.3 Recalculate vegetation cover 
+       
+       !!!$S. Zaehle : since now all state variables are defined on veget_max it is very
+       !!!$ dangerous to change this several times in stomate_lpj, as then GPP, turnover and allocated 
+       !!!$ biomass are not defined on the same space! Hence, veget_max is now kept constant
+       !!!$ and updated at the end of stomate_lpj in lpj_cover.f90
+       !!!$ Eventually, this routine should only be called once at the beginning and the end of stomate_lpj
+       !!!$ or prefereably cn_ind made a saved state variable!
+       !!!$ IF (natural(j).AND.ok_dgvm) THEN
+       !!!$   veget_max(:,j) = ind(:,j) * cn_ind(:,j)
+       !!!$ ENDIF
+
+    ENDDO ! loop over PFTs
+
+  END SUBROUTINE crown
+
+END MODULE lpj_crown
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_establish.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_establish.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_establish.f90	(revision 6412)
@@ -0,0 +1,897 @@
+! =================================================================================================================================
+! MODULE       : lpj_establish
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Establish pft's
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: 
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!        plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!        global vegetation model, Global Change Biology, 9, 161-185.\n
+!! - Haxeltine, A. and I. C. Prentice (1996), BIOME3: An equilibrium
+!!        terrestrial biosphere model based on ecophysiological constraints, 
+!!        resource availability, and competition among plant functional types,
+!!        Global Biogeochemical Cycles, 10(4), 693-709.\n
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!        dynamics in the modelling of terrestrial ecosystems: comparing two
+!!        contrasting approaches within European climate space,
+!!        Global Ecology and Biogeography, 10, 621-637.\n
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_establish
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE grid
+  USE function_library,    ONLY: biomass_to_lai
+
+  IMPLICIT NONE
+
+  ! private & public routines
+  PRIVATE
+  PUBLIC establish,establish_clear
+
+  LOGICAL, SAVE                          :: firstcall_establish = .TRUE.           !! first call
+!$OMP THREADPRIVATE(firstcall_establish)
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : fire_clear 
+!!
+!>\BRIEF       Set the firstcall_establish flag to .TRUE. and activate initialization
+!_ ================================================================================================================================
+
+  SUBROUTINE establish_clear
+    firstcall_establish = .TRUE.
+  END SUBROUTINE establish_clear
+
+
+! =================================================================================================================================
+! SUBROUTINE   : establish 
+!
+!>\BRIEF       Calculate sstablishment of new woody PFT and herbaceous PFTs
+!!
+!! DESCRIPTION : Establishments of new woody and herbaceous PFT are simulated. 
+!! Maximum establishment rate (0.12) declines due to competition for light (space).
+!! There are two establishment estimates: one for the for DGVM and one for the 
+!! static cases.\n
+!! In the case of DGVM, competitive process of establishment for the area of 
+!! available space is represented using more detailed description compared with static 
+!! one. Biomass and distribution of plant age are updated on the basis of changes 
+!! in number of individuals. Finally excess sapwood of is converted to heartwood.
+!!
+!! \latexonly
+!! \input{equation_lpj_establish.tex}
+!! \endlatexonly
+!! \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)    :
+!! Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!    dynamics in the modelling of terrestrial ecosystems: comparing two
+!!    contrasting approaches within European climate space,
+!!    Global Ecology and Biogeography, 10, 621-637.
+!!
+!! FLOWCHART       : 
+!! \latexonly
+!! \includegraphics[scale = 0.7]{establish.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE establish (npts, dt, PFTpresent, regenerate, &
+       neighbours, resolution, need_adjacent, herbivores, &
+       precip_annual, gdd0, lm_lastyearmax, &
+       cn_ind, avail_tree, avail_grass,  npp_longterm, &
+       leaf_age, leaf_frac, &
+       ind, biomass, age, everywhere, co2_to_bm, &
+       soil_n_min, n_uptake, nstress_season, veget_max, woodmass_ind, &
+       mortality, bm_to_litter)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size - number of pixels (dimensionless)    
+    REAL(r_std), INTENT(in)                                   :: dt              !! Time step of vegetation dynamics for stomate 
+                                                                                 !! (days)            
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                  :: PFTpresent      !! Is pft there (unitless)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: regenerate      !! Winter sufficiently cold (unitless)   
+    INTEGER(i_std), DIMENSION(npts,NbNeighb), INTENT(in)      :: neighbours      !! indices of the neighbours of each grid point 
+                                                                                 !! (unitless);  
+                                                                                 !! [1=North and then clockwise]  
+    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), INTENT(in)                  :: avail_tree      !! space availability for trees (unitless)     
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: avail_grass     !! space availability for grasses (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: npp_longterm    !! longterm NPP, for each PFT (gC m^{-2})   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: veget_max       !! "maximal" coverage fraction of a PFT 
+                                                                                 !! (LAI -> infinity) on ground (unitless)
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(in)               :: mortality       !! Fraction of individual dying this time 
+                                                                                 !! step (0 to 1, unitless) 
+
+    !! 0.2 Output variables
+    
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age        !! leaf age (days)     
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! fraction of leaves in leaf age class (unitless)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! Number of individuals (individuals m^{-2})          
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass   !! biomass (gC m^{-2 })     
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age             !! mean age (years)       
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! is the PFT everywhere in the grid box or very 
+                                                                                 !! localized (unitless)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm       !! biomass up take for establishment i.e. 
+                                                                                 !! pseudo-photosynthesis (gC m^{-2} day^{-1}) 
+    REAL(r_std), DIMENSION(npts,nvm,nnspec), INTENT(inout)    :: soil_n_min      !! Nitrogen in mineral soil,    
+ !! (gN/(m**2 of PFT)) 
+ !! to correct for nitrogen creation associated with establishmnet   
+    REAL(r_std), DIMENSION(npts,nvm,nionspec), INTENT(inout)  :: n_uptake        !! Plant uptake of ammonium and nitrate  
+ !! (gN/m**2/day) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: nstress_season  !! seasonal nitrogen stress  
+ !! (unitless) 
+ !! (get's initialised at first establishment) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: woodmass_ind    !! woodmass of the individual, needed to calculate
+                                                                                 !! crownarea in lpj_crownarea (gC m^{-2 })  
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !!Biomass transfer to litter
+
+    !! 0.4 Local variables
+
+    REAL(r_std)                                               :: tau_eatup       !! time during which a sapling can be entirely 
+                                                                                 !! eaten by herbivores (days) 
+    REAL(r_std), DIMENSION(npts,nvm)                          :: fpc_nat         !! new fpc, foliage projective cover: fractional
+                                                                                 !! coverage (unitless)       
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_climate_tree  !! maximum tree establishment rate, 
+                                                                                              !! based on climate only (unitless)  
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_climate_grass !! maximum grass establishment rate,
+                                                                                              !! based on climate only (unitless)
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_tree          !! maximum tree establishment rate, 
+                                                                                              !! based on climate and fpc 
+                                                                                              !! (unitless) 
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_grass         !! maximum grass establishment rate,
+                                                                                              !! based on climate and fpc 
+                                                                                              !! (unitless) 
+    REAL(r_std), DIMENSION(npts)                              :: sumfpc          !! total natural fpc (unitless)
+    REAL(r_std), DIMENSION(npts)                              :: fracnat         !! total fraction occupied by natural 
+                                                                                 !! vegetation (unitless)  
+    REAL(r_std), DIMENSION(npts)                              :: sumfpc_wood     !! total woody fpc (unitless)    
+    REAL(r_std), DIMENSION(npts)                              :: spacefight_grass!! for grasses, measures the total concurrence 
+                                                                                 !! for available space (unitless)
+    REAL(r_std), DIMENSION(npts,nvm)                          :: d_ind           !! change in number of individuals per time step 
+                                                                                 !! (individuals m^{-2} day{-1})         
+    REAL(r_std), DIMENSION(npts,nelements)                    :: bm_new          !! biomass increase (gC m^{-2 })        
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements)         :: biomass_old     !! Save the original biomass passed into the subroutine 
+    REAL(r_std), DIMENSION(npts,nelements)                    :: bm_non          !! Non-effective establishment: the "virtual" saplings that die instantly
+    REAL(r_std), DIMENSION(npts,nelements)                    :: bm_eff          !! Effective (or real) establishment  
+    REAL(r_std), DIMENSION(npts)                              :: dia             !! stem diameter (m)    
+    REAL(r_std), DIMENSION(npts)                              :: b1              !! temporary variable           
+    REAL(r_std), DIMENSION(npts)                              :: woodmass        !! woodmass of an individual (gC m^{-2})  
+    REAL(r_std), DIMENSION(npts)                              :: leaf_mass_young !! carbon mass in youngest leaf age class 
+                                                                                 !! (gC m^{-2})
+    REAL(r_std), DIMENSION(npts)                              :: factor          !! reduction factor for establishment if many 
+                                                                                 !! trees or grasses are present (unitless)  
+    REAL(r_std), DIMENSION(npts,nelements)                    :: total_bm        !! Total carbon (or nitrogen) mass for all pools (gC m^{-2})    
+    REAL(r_std), DIMENSION(npts,nelements)                    :: total_bm_sapl   !! Total sappling biomass for all pools 
+                                                                                 !! (gC(orN) m^{-2})  
+    REAL(r_std), DIMENSION(npts,nelements)                    :: total_bm_sapl_non !! total non-effective sapling biomass 
+
+    INTEGER(i_std)                                            :: nfrontx         !! from how many sides is the grid box invaded
+                                                                                 !! (unitless?)   
+    INTEGER(i_std)                                            :: nfronty         !! from how many sides is the grid box invaded
+                                                                                 !! (unitless?)   
+    REAL(r_std), DIMENSION(npts)                              :: vn              !! flow due to new individuals veget_max after 
+                                                                                 !! establishment, to get a proper estimate of 
+                                                                                 !! carbon and nitrogen
+    REAL(r_std), DIMENSION(npts,nvm)                          :: lai             !! leaf area index OF an individual plant 
+    REAL(r_std), DIMENSION(npts)                              :: lai_ind         !! lai on each PFT surface (m^2 m^{-2})   
+    REAL(r_std), DIMENSION(npts)                              :: veget_max_tree  !! Sum of veget_max for the pft's which are trees
+    INTEGER(i_std)                                            :: nbtree          !! Number of PFT's which are trees
+    INTEGER(i_std)                                            :: i,j,k,m         !! indices (unitless)       
+    REAL(r_std), DIMENSION(npts)                              :: soil_n_constraint !! Soil inorganic N pool (gN m-2) 
+    REAL(r_std), DIMENSION(npts)                              :: ntake           !! total N associated to establishment (gN) 
+    REAL(r_std), DIMENSION(npts)                              :: ntake_nitrate   !! nitrate associated to establishment (gN) 
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering establish'
+
+  !! 0. Calculate the LAI from the biomass. 
+  !! This is done to prevent passing an incorrect
+  !! LAI around, since LAI is diagnostic.
+  !! We can't do this if we use an LAI map! So this breaks DO_STOMATE=N
+    lai(:,ibare_sechiba) = zero
+    DO i = 1, npts
+       DO j = 1, nvm
+          lai(i,j) = biomass_to_lai(biomass(i,j,ileaf,icarbon),j)
+       ENDDO
+    ENDDO
+
+  !! 1. messages and initialization
+
+    ! Assumption: time durasion that sapling is completely eaten by hervioures is a half year?   
+    ! No reference
+    tau_eatup = one_year/2.
+    
+    ! Calculate the sum of the vegetation over the tree pft's and the number of pft's which are trees
+    veget_max_tree(:) = 0.0
+    nbtree=0
+    DO j = 1, nvm 
+       IF (is_tree(j)) THEN
+          veget_max_tree(:) = veget_max_tree(:) + veget_max(:,j)
+          nbtree = nbtree + 1
+       END IF
+    END DO
+    ! Set nbtree=1 to avoid zero division later if there are no tree PFT's.
+    ! For that case veget_max_tree=0 so there will not be any impact.
+    IF (nbtree == 0) nbtree=1
+
+    !! 1.1 First call only
+    IF ( firstcall_establish ) THEN
+
+       WRITE(numout,*) 'establish:'
+
+       WRITE(numout,*) '   > time during which a sapling can be entirely eaten by herbivores (d): ', &
+            tau_eatup
+
+       firstcall_establish = .FALSE.
+
+    ENDIF
+
+  !! 2. recalculate fpc
+
+    IF (ok_dgvm) THEN
+       fracnat(:) = un
+
+       !! 2.1 Only natural part of the grid cell
+       do j = 2,nvm ! Loop over # PFTs
+          
+          IF ( .NOT. natural(j) ) THEN
+             fracnat(:) = fracnat(:) - veget_max(:,j)
+          ENDIF
+       ENDDO ! Loop over # PFTs
+       
+       sumfpc(:) = zero
+
+       !! 2.2 Total natural fpc on grid
+       !      The overall fractional coverage of a PFT in a grid is calculated here.
+       !      FPC is related to mean individual leaf area index by the Lambert-Beer law.
+       !      See Eq. (1) in tex file.\n
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( natural(j) ) THEN
+             WHERE(fracnat(:).GT.min_stomate)
+                WHERE (lai(:,j) == val_exp) 
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                ELSEWHERE
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) & 
+                        * ( un - exp( - biomass_to_lai(lm_lastyearmax(:,j),npts,j)* ext_coeff(j) ) )
+                ENDWHERE
+             ENDWHERE
+
+             WHERE ( PFTpresent(:,j) )
+                sumfpc(:) = sumfpc(:) + fpc_nat(:,j)
+             ENDWHERE
+          ELSE
+
+             fpc_nat(:,j) = zero
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+       
+       !! 2.3 Total woody fpc on grid and number of regenerative tree pfts
+       !      Total woody FPC increases by adding new FPC.
+       !      Under the condition that temperature in last winter is higher than a threshold, 
+       !      woody plants is exposed in higher competitive environment.
+       sumfpc_wood(:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( is_tree(j) .AND. natural(j) ) THEN
+
+             ! total woody fpc
+             WHERE ( PFTpresent(:,j) )
+                sumfpc_wood(:) = sumfpc_wood(:) + fpc_nat(:,j)
+             ENDWHERE
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+
+       !! 2.4 Total number of natural grasses on grid\n
+       !     Grass increment equals 'everywhere'\n
+       spacefight_grass(:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( .NOT. is_tree(j) .AND. natural(j) ) THEN
+
+             ! Count a PFT fully only if it is present on a grid.
+             WHERE ( PFTpresent(:,j) )
+                spacefight_grass(:) = spacefight_grass(:) + everywhere(:,j)
+             ENDWHERE
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+
+       !! 2.5 Maximum establishment rate, based on climate only\n
+       WHERE ( ( precip_annual(:) .GE. precip_crit ) .AND. ( gdd0(:) .GE. gdd_crit_estab ) )
+
+          estab_rate_max_climate_tree(:) = estab_max_tree ! 'estab_max_*'; see 'stomate_constants.f90'
+          estab_rate_max_climate_grass(:) = estab_max_grass
+
+       ELSEWHERE
+
+          estab_rate_max_climate_tree(:) = zero
+          estab_rate_max_climate_grass(:) = zero
+
+       ENDWHERE
+
+       !! 2.6 Reduce maximum tree establishment rate if many trees are present.
+       !      In the original DGVM, this is done using a step function which yields a
+       !      reduction by factor 4 if sumfpc_wood(i) .GT.  fpc_crit - 0.05.
+       !      This can lead to small oscillations (without consequences however).
+       !      Here, a steady linear transition is used between fpc_crit-0.075 and
+       !      fpc_crit-0.025.
+       !      factor(:) = 1. - 15. * ( sumfpc_wood(:) - (fpc_crit-.075))
+       !      factor(:) = MAX( 0.25_r_std, MIN( 1._r_std, factor(:)))
+       !      S. Zaehle modified according to Smith et al. 2001
+       !      See Eq. (2) in header
+       factor(:)=(un - exp(- establish_scal_fact * (un - sumfpc_wood(:))))*(un - sumfpc_wood(:))
+       estab_rate_max_tree(:) = estab_rate_max_climate_tree(:) * factor(:)
+
+       !! 2.7 Modulate grass establishment rate.
+       !      If canopy is not closed (fpc < fpc_crit-0.05), normal establishment.
+       !      If canopy is closed, establishment is reduced by a factor 4.
+       !      Factor is linear between these two bounds.
+       !      This is different from the original DGVM where a step function is
+       !      used at fpc_crit-0.05 (This can lead to small oscillations,
+       !      without consequences however).
+       !      factor(:) = 1. - 15. * ( sumfpc(:) - (fpc_crit-.05))
+       !      factor(:) = MAX( 0.25_r_std, MIN( 1._r_std, factor(:)))
+       !      estab_rate_max_grass(:) = estab_rate_max_climate_grass(:) * factor(:)
+       !      S. Zaehle modified to true LPJ formulation, grasses are only allowed in the
+       !      fpc fraction not occupied by trees..., 080806
+       !      estab_rate_max_grass(:)=MAX(0.98-sumfpc(:),zero)
+       !      See Eq. (3) in header
+       estab_rate_max_grass(:) = MAX(MIN(estab_rate_max_climate_grass(:), max_tree_coverage - sumfpc(:)),zero)
+
+       !! 2.8 Longterm grass NPP for competition between C4 and C3 grasses
+       !      to avoid equal veget_max, the idea is that more reestablishment
+       !      is possible for the more productive PFT
+       factor(:) = min_stomate
+
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( natural(j) .AND. .NOT.is_tree(j)) & 
+               factor(:) = factor(:) + npp_longterm(:,j) * &
+               biomass_to_lai(lm_lastyearmax(:,j),npts,j)
+       ENDDO ! Loop over # PFTs
+
+       !! 2.9 Establish natural PFTs
+       d_ind(:,:) = zero
+
+       IF ( NbNeighb /= 8 ) THEN
+          CALL ipslerr(3, "establish", "This routine needs to be adapted to non rectengular grids", "Talk to Jan Polcher", " ")
+       ENDIF
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( natural(j) ) THEN ! only for natural PFTs
+
+             !! 2.9.1 PFT expansion across the grid box. Not to be confused with areal coverage.
+             IF ( treat_expansion ) THEN
+
+                ! only treat plants that are regenerative and present and still can expand
+                DO i = 1, npts ! Loop over # pixels - domain size
+
+                   IF ( PFTpresent(i,j) .AND. &
+                        ( everywhere(i,j) .LT. un ) .AND. &
+                        ( regenerate(i,j) .GT. regenerate_crit ) ) THEN
+
+                      ! from how many sides is the grid box invaded (separate x and y directions
+                      ! because resolution may be strongly anisotropic)
+                      ! For the moment we only look into 4 direction but that can be expanded (JP) 
+                      nfrontx = 0
+                      IF ( neighbours(i,3) .GT. 0 ) THEN
+                         IF ( everywhere(neighbours(i,3),j) .GT. 1.-min_stomate ) nfrontx = nfrontx+1
+                      ENDIF
+                      IF ( neighbours(i,7) .GT. 0 ) THEN
+                         IF ( everywhere(neighbours(i,7),j) .GT. 1.-min_stomate ) nfrontx = nfrontx+1
+                      ENDIF
+
+                      nfronty = 0
+                      IF ( neighbours(i,1) .GT. 0 ) THEN
+                         IF ( everywhere(neighbours(i,1),j) .GT. 1.-min_stomate ) nfronty = nfronty+1
+                      ENDIF
+                      IF ( neighbours(i,5) .GT. 0 ) THEN
+                         IF ( everywhere(neighbours(i,5),j) .GT. 1.-min_stomate ) nfronty = nfronty+1
+                      ENDIF
+                      
+                      everywhere(i,j) = &
+                           everywhere(i,j) + migrate(j) * dt/one_year * &
+                           ( nfrontx / resolution(i,1) + nfronty / resolution(i,2) )
+                      
+                      IF ( .NOT. need_adjacent(i,j) ) THEN
+                         
+                         ! in that case, we also assume that the PFT expands from places within
+                         ! the grid box (e.g., oasis).
+                         ! What is this equation? No reference.
+                         everywhere(i,j) = &
+                              everywhere(i,j) + migrate(j) * dt/one_year * &
+                              2. * SQRT( pi*everywhere(i,j)/(resolution(i,1)*resolution(i,2)) )
+
+                      ENDIF
+
+                      everywhere(i,j) = MIN( everywhere(i,j), un )
+
+                   ENDIF
+
+                ENDDO ! Loop over # pixels - domain size
+
+             ENDIF ! treat expansion?
+
+             !! 2.9.2 Establishment rate
+             !      - Is lower if the PFT is only present in a small part of the grid box
+             !        (after its introduction), therefore multiplied by "everywhere".
+             !      - Is divided by the number of PFTs that compete ("spacefight").
+             !      - Is modulated by space availability (avail_tree, avail_grass).
+
+             !! 2.9.2.1 present and regenerative trees
+             IF ( is_tree(j) ) THEN
+
+                WHERE ( PFTpresent(:,j) .AND. ( regenerate(:,j) .GT. regenerate_crit ) )
+                   d_ind(:,j) = estab_rate_max_tree(:)*everywhere(:,j) * &
+                        avail_tree(:) * dt/one_year
+                ENDWHERE
+
+             !! 2.9.2.2 present and regenerative grasses
+             ELSE
+                WHERE ( PFTpresent(:,j) .AND. ( regenerate(:,j) .GT. regenerate_crit )  & 
+                     .AND.factor(:).GT.min_stomate .AND. spacefight_grass(:).GT. min_stomate) 
+                   
+                   d_ind(:,j) = estab_rate_max_grass(:)*everywhere(:,j)/spacefight_grass(:) * &
+                        MAX(min_stomate,npp_longterm(:,j)*biomass_to_lai(lm_lastyearmax(:,j),npts,j)/factor(:)) &
+                        * fracnat(:) * dt/one_year
+                ENDWHERE
+                
+             ENDIF  ! tree/grass
+             
+          ENDIF ! if natural
+       ENDDO  ! Loop over # PFTs
+       
+  !! 3. Lpj establishment in static case 
+
+    !     Lpj establishment in static case, S. Zaehle 080806, account for real LPJ dynamics in
+    !     prescribed vegetation, i.e. population dynamics within a given area of the grid cell.
+    ELSE 
+
+       d_ind(:,:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+          WHERE(ind(:,j)*cn_ind(:,j).GT.min_stomate)
+             lai_ind(:) = biomass_to_lai(lm_lastyearmax(:,j),npts,j)/(ind(:,j)*cn_ind(:,j))
+          ELSEWHERE
+             lai_ind(:) = zero
+          ENDWHERE
+
+          !! 3.1 For natural woody PFTs
+          IF ( natural(j) .AND. is_tree(j)) THEN 
+
+             ! See Eq. (4) in tex file.            
+             fpc_nat(:,j) =  MIN(un, cn_ind(:,j) * ind(:,j) * & 
+                  MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover ) )
+
+
+             WHERE (veget_max(:,j).GT.min_stomate.AND.ind(:,j).LE.2.)
+
+                !! 3.1.1 Only establish into growing stands 
+                !        Only establish into growing stands, ind can become very
+                !        large in the static mode because LAI is very low in poor 
+                !        growing conditions, favouring continuous establishment. 
+                !        To avoid this a maximum IND is set. BLARPP: This should be
+                !        replaced by a better stand density criteria.
+                factor(:)=(un - exp(-establish_scal_fact * (un - fpc_nat(:,j))))*(un - fpc_nat(:,j))
+
+                estab_rate_max_tree(:) = estab_max_tree * factor(:) * MAX(0.11 , nstress_season(:,j) )
+
+                !! 3.1.2 do establishment for natural PFTs\n
+                d_ind(:,j) = MAX( zero, estab_rate_max_tree(:) * dt/one_year)
+
+             ENDWHERE
+
+             !S. Zaehle: quickfix: to simulate even aged stand, uncomment the following lines...
+             !where (ind(:,j) .LE. min_stomate)
+             !d_ind(:,j) = 0.1 !MAX( 0.0, estab_rate_max_tree(:) * dt/one_year)
+             WHERE (veget_max(:,j).GT.min_stomate .AND. ind(:,j).EQ.zero)
+                d_ind(:,j) = ind_0_estab
+             ENDWHERE
+
+          !! 3.2 For natural grass PFTs
+          ELSEIF ( natural(j) .AND. .NOT.is_tree(j)) THEN 
+
+             WHERE (veget_max(:,j).GT.min_stomate)
+
+                fpc_nat(:,j) =  cn_ind(:,j) * ind(:,j) * & 
+                     MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover )
+
+                d_ind(:,j) = MAX(zero , (un - fpc_nat(:,j)) * dt/one_year )
+
+             ENDWHERE
+
+             WHERE (veget_max(:,j).GT.min_stomate .AND. ind(:,j).EQ. zero)
+                d_ind(:,j) = ind_0_estab 
+             ENDWHERE
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+
+    ENDIF ! DGVM OR NOT
+
+  !! 4. Biomass calculation
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN ! only for natural PFTs
+
+          !! 4.1 Herbivores reduce establishment rate
+          !      We suppose that saplings are vulnerable during a given time after establishment.
+          !      This is taken into account by preventively reducing the establishment rate.
+          IF ( ok_herbivores ) THEN
+
+             d_ind(:,j) = d_ind(:,j) * EXP( - tau_eatup/herbivores(:,j) )
+
+          ENDIF
+
+          !! 4.2 Total biomass.
+          !      Add biomass only if d_ind, over one year, is of the order of ind.
+          !      save old leaf mass to calculate leaf age
+          leaf_mass_young(:) = leaf_frac(:,j,1) * biomass(:,j,ileaf,icarbon)
+
+          ! total biomass of existing PFT to limit biomass added from establishment
+          total_bm(:,:) = zero
+
+          DO k = 1, nparts
+             total_bm(:,:) = total_bm(:,:) + biomass(:,j,k,:)
+          ENDDO
+          ! soil nitrogen available to feed plant establishment.  
+          ! This needs to be taken from soil N. Reason: plants must not produce nitrogen by establishment 
+          ! (otherwise this creates N) 
+          soil_n_constraint(:)=soil_n_min(:,j,iammonium)+soil_n_min(:,j,initrate) 
+
+
+          IF(ok_dgvm) THEN
+             vn(:) = veget_max(:,j)
+          ELSE
+             vn(:) = un
+          ENDIF
+
+          !! 4.3 Woodmass calculation
+
+          !! 4.3.1 with DGVM
+          IF(ok_dgvm) THEN
+
+             ! S. Zaehle calculate new woodmass_ind and veget_max after establishment (needed for correct scaling!)
+             ! essential correction for MERGE!
+             IF(is_tree(j))THEN
+                DO i=1,npts ! Loop over # pixels - domain size
+                   IF((d_ind(i,j)+ind(i,j)).GT.min_stomate) THEN
+
+                      IF((total_bm(i,icarbon).LE.min_stomate) .OR. (veget_max(i,j) .LE. min_stomate)) THEN
+
+                         ! new wood mass of PFT
+                         woodmass_ind(i,j) = &
+                              (((biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                              + biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon))*veget_max(i,j)) &
+                              + (bm_sapl(j,isapabove,icarbon) + bm_sapl(j,isapbelow,icarbon) &
+                              + bm_sapl(j,iheartabove,icarbon) + bm_sapl(j,iheartbelow,icarbon))*d_ind(i,j))/(ind(i,j) + d_ind(i,j))
+
+                      ELSE
+ 
+                         ! new biomass is added to the labile pool, hence there is no change 
+                         ! in CA associated with establishment
+                         woodmass_ind(i,j) = &
+                              & (biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                              & +biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon))*veget_max(i,j) &
+                              & /(ind(i,j) + d_ind(i,j))
+
+                      ENDIF
+
+                      ! new diameter of PFT
+                      dia(i) = (woodmass_ind(i,j)/(pipe_density(j)*pi/4.*pipe_tune2(j))) &
+                           &                **(1./(2.+pipe_tune3(j)))
+                      vn(i) = (ind(i,j) + d_ind(i,j))*pipe_tune1(j)*MIN(dia(i),maxdia(j))**pipe_tune_exp_coeff(j)
+
+                   ENDIF
+                ENDDO ! Loop over # pixels - domain size
+             ELSE ! for grasses, cnd=1, so the above calculation cancels
+                vn(:) = ind(:,j) + d_ind(:,j)
+             ENDIF
+
+          !! 4.3.2 without DGVM (static)\n
+          ELSE 
+             DO i=1,npts ! Loop over # pixels - domain size
+                IF(is_tree(j).AND.(d_ind(i,j)+ind(i,j)).GT.min_stomate) THEN
+                   IF(total_bm(i,icarbon).LE.min_stomate) THEN
+
+                      ! new wood mass of PFT
+                      woodmass_ind(i,j) = &
+                           & (((biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                           & + biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon))) &
+                           & + (bm_sapl(j,isapabove,icarbon) + bm_sapl(j,isapbelow,icarbon) &
+                           & + bm_sapl(j,iheartabove,icarbon) + bm_sapl(j,iheartbelow,icarbon))*d_ind(i,j))/(ind(i,j)+d_ind(i,j))
+
+                   ELSE
+ 
+                      ! new biomass is added to the labile pool, hence there is no change 
+                      ! in CA associated with establishment
+                      woodmass_ind(i,j) = &
+                           & (biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                           & + biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon)) &
+                           & /(ind(i,j) + d_ind(i,j))
+
+                   ENDIF
+                ENDIF
+             ENDDO ! Loop over # pixels - domain size
+
+             vn(:) = un ! cannot change in static!, and veget_max implicit in d_ind
+
+          ENDIF
+
+          !! 4.4 total biomass of PFT added by establishment defined over veget_max ...
+
+          total_bm_sapl(:,:) = zero
+          total_bm_sapl_non(:,:) = zero
+          biomass_old(:,j,:,:)=biomass(:,j,:,:)
+          DO k = 1, nparts ! Loop over # litter tissues (nparts=8); see 'stomate_constants.f90'
+             WHERE(d_ind(:,j).GT.min_stomate.AND.total_bm(:,icarbon).GT.min_stomate.AND.vn(:).GT.min_stomate)
+
+                total_bm_sapl(:,icarbon) = total_bm_sapl(:,icarbon) + bm_sapl(j,k,icarbon) * d_ind(:,j) / vn(:)
+                total_bm_sapl(:,initrogen) = total_bm_sapl(:,initrogen) + bm_sapl(j,k,initrogen) * d_ind(:,j)  / vn(:) 
+
+                ! non-effective establishment
+                total_bm_sapl_non(:,icarbon) = total_bm_sapl_non(:,icarbon) + &
+                     bm_sapl(j,k,icarbon) * (ind(:,j)+d_ind(:,j))*mortality(:,j) / vn(:)
+
+                total_bm_sapl_non(:,initrogen) = total_bm_sapl_non(:,initrogen) + &
+                     bm_sapl(j,k,initrogen) * (ind(:,j)+d_ind(:,j))*mortality(:,j) / vn(:)
+                
+
+             ENDWHERE
+          ENDDO ! Loop over # litter tissues
+
+
+          total_bm_sapl(:,initrogen)=MIN(total_bm_sapl(:,initrogen),soil_n_constraint(:)) 
+          ntake(:)=zero 
+!Dan Zhu modification: there is a problem here, if DGVM is activated, co2_to_bm will never reach
+!0 due to establishment, where d_ind is still large at equilibrium (=ind*mortality). So we
+!need to subtract it from litter (not biomass, because the
+!corresponding biomass has been lost in lpj_gap).
+
+          !! 4.5 Update biomass at each component
+          DO k = 1, nparts ! Loop over # litter tissues
+
+             bm_new(:,:) = zero
+             bm_non(:,:) = zero
+             bm_eff(:,:) = zero
+
+             ! first ever establishment, C flows
+             WHERE( d_ind(:,j).GT.min_stomate .AND. &
+                  total_bm(:,icarbon).LE.min_stomate .AND. &
+                  vn(:).GT.min_stomate)
+
+                bm_new(:,icarbon) = d_ind(:,j) * bm_sapl(j,k,icarbon) / vn(:)
+                biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) + bm_new(:,icarbon)
+
+                bm_new(:,initrogen) = d_ind(:,j) * (bm_sapl(j,k,initrogen)) / vn(:)
+                biomass(:,j,k,initrogen) = biomass(:,j,k,initrogen) + bm_new(:,initrogen)
+
+                ! bm_to_litter minus the 'non-effective' establishment (mortality), but cannot be less than 0
+                WHERE((veget_max_tree(:) .GT. 0.1) .AND. (veget_max(:,j) .LT. veget_max_tree(:)/nbtree) )
+
+                   bm_non(:,icarbon) = MIN( biomass(:,j,k,icarbon)+bm_to_litter(:,j,k,icarbon), &
+                        (ind(:,j)+d_ind(:,j))*mortality(:,j) * bm_sapl(j,k,icarbon)/vn(:) )
+                   bm_eff(:,icarbon) = MIN( npp_longterm(:,j)/one_year, bm_new(:,icarbon)-bm_non(:,icarbon) )
+                   bm_non(:,icarbon) = MIN( biomass(:,j,k,icarbon)+bm_to_litter(:,j,k,icarbon), &
+                        bm_new(:,icarbon)-bm_eff(:,icarbon) )
+
+                   bm_non(:,initrogen) = MIN( biomass(:,j,k,initrogen)+bm_to_litter(:,j,k,initrogen), &
+                        (ind(:,j)+d_ind(:,j))*mortality(:,j) * bm_sapl(j,k,initrogen)/vn(:) )
+                   bm_eff(:,initrogen) = bm_new(:,initrogen)-bm_non(:,initrogen) 
+                   bm_non(:,initrogen) = MIN( biomass(:,j,k,initrogen)+bm_to_litter(:,j,k,initrogen), &
+                        bm_new(:,initrogen)-bm_eff(:,initrogen) )
+                   ! I think there was an error 
+                   ! co2_to_bm(:,j)=co2_to_bm(:,j) + bm_new(:) - bm_non(:)
+                   co2_to_bm(:,j)=co2_to_bm(:,j) + bm_new(:,icarbon)/dt - bm_non(:,icarbon)/dt
+                   ntake(:) = ntake(:) + bm_new(:,initrogen) - bm_non(:,initrogen)
+
+                   WHERE( bm_to_litter(:,j,k,icarbon) .LT. bm_non(:,icarbon) )
+                      biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) - &
+                           ( bm_non(:,icarbon) - bm_to_litter(:,j,k,icarbon) )
+                   ENDWHERE
+                   bm_to_litter(:,j,k,icarbon) = bm_to_litter(:,j,k,icarbon) - &
+                        MIN(bm_to_litter(:,j,k,icarbon), bm_non(:,icarbon) )
+
+                   WHERE( bm_to_litter(:,j,k,initrogen) .LT. bm_non(:,initrogen) )
+                      biomass(:,j,k,initrogen) = biomass(:,j,k,initrogen) - &
+                           ( bm_non(:,initrogen) - bm_to_litter(:,j,k,initrogen) )
+                   ENDWHERE
+                   bm_to_litter(:,j,k,initrogen) = bm_to_litter(:,j,k,initrogen) - &
+                        MIN(bm_to_litter(:,j,k,initrogen), bm_non(:,initrogen) )
+
+                ELSEWHERE
+
+                   bm_non(:,icarbon) = MIN( bm_to_litter(:,j,k,icarbon), &
+                        (ind(:,j)+d_ind(:,j))*mortality(:,j) * bm_sapl(j,k,icarbon)/vn(:) )
+                   co2_to_bm(:,j)=co2_to_bm(:,j) + bm_new(:,icarbon)/dt - bm_non(:,icarbon)/dt
+                   bm_to_litter(:,j,k,icarbon)=bm_to_litter(:,j,k,icarbon)- bm_non(:,icarbon)
+
+                   bm_non(:,initrogen) = MIN( bm_to_litter(:,j,k,initrogen), &
+                        (ind(:,j)+d_ind(:,j))*mortality(:,j) * bm_sapl(j,k,initrogen)/vn(:) )
+                   ntake(:)= ntake(:) + bm_new(:,initrogen) - bm_non(:,initrogen)
+                   bm_to_litter(:,j,k,initrogen)=bm_to_litter(:,j,k,initrogen)- bm_non(:,initrogen)
+                ENDWHERE
+
+             ENDWHERE
+
+             ! establishment into existing population, C flows
+             WHERE(d_ind(:,j).GT.min_stomate.AND.total_bm(:,icarbon).GT.min_stomate)
+
+                bm_new(:,icarbon) = total_bm_sapl(:,icarbon) * biomass_old(:,j,k,icarbon) / total_bm(:,icarbon)
+                biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) + bm_new(:,icarbon)
+
+                bm_new(:,initrogen) = total_bm_sapl(:,initrogen) * biomass_old(:,j,k,initrogen) / total_bm(:,initrogen)
+                biomass(:,j,k,initrogen) = biomass(:,j,k,initrogen) + bm_new(:,initrogen)
+
+                WHERE((veget_max_tree(:) .GT. 0.1) .AND. (veget_max(:,j) .LT. veget_max_tree(:)/nbtree) )
+
+                   bm_non(:,icarbon) = MIN( biomass(:,j,k,icarbon)+bm_to_litter(:,j,k,icarbon), &
+                        total_bm_sapl_non(:,icarbon) *biomass_old(:,j,k,icarbon)/total_bm(:,icarbon) )
+                   bm_eff(:,icarbon) = MIN( npp_longterm(:,j)/one_year, bm_new(:,icarbon)-bm_non(:,icarbon) )
+                   bm_non(:,icarbon) = MAX( zero, MIN( biomass(:,j,k,icarbon)+bm_to_litter(:,j,k,icarbon)-min_stomate, &
+                        bm_new(:,icarbon)-bm_eff(:,icarbon) ) )
+
+                   bm_non(:,initrogen) = MIN( biomass(:,j,k,initrogen)+bm_to_litter(:,j,k,initrogen), &
+                        total_bm_sapl_non(:,initrogen) *biomass_old(:,j,k,initrogen)/total_bm(:,initrogen) )
+                   bm_eff(:,initrogen) = bm_new(:,initrogen)-bm_non(:,initrogen)
+                   bm_non(:,initrogen) = MAX( zero, MIN( biomass(:,j,k,initrogen)+bm_to_litter(:,j,k,initrogen)-min_stomate, &
+                        bm_new(:,initrogen)-bm_eff(:,initrogen) ) )
+
+                   co2_to_bm(:,j)=co2_to_bm(:,j) + bm_new(:,icarbon) - bm_non(:,icarbon)
+                   ntake(:) = ntake(:) + bm_new(:,initrogen) - bm_non(:,initrogen)
+
+                   WHERE( bm_to_litter(:,j,k,icarbon) .LT. bm_non(:,icarbon) )
+                      biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) - ( bm_non(:,icarbon) - bm_to_litter(:,j,k,icarbon) )
+                   ENDWHERE
+                   bm_to_litter(:,j,k,icarbon) = bm_to_litter(:,j,k,icarbon) - MIN(bm_to_litter(:,j,k,icarbon), bm_non(:,icarbon) )
+
+                   WHERE( bm_to_litter(:,j,k,initrogen) .LT. bm_non(:,initrogen) )
+                      biomass(:,j,k,initrogen) = biomass(:,j,k,initrogen) - ( bm_non(:,initrogen) - bm_to_litter(:,j,k,initrogen) )
+                   ENDWHERE
+                   bm_to_litter(:,j,k,initrogen) = bm_to_litter(:,j,k,initrogen) - &
+                        MIN(bm_to_litter(:,j,k,initrogen), bm_non(:,initrogen) )
+
+                ELSEWHERE
+
+                   bm_non(:,icarbon) = MIN( bm_to_litter(:,j,k,icarbon), &
+                        total_bm_sapl_non(:,icarbon) *biomass_old(:,j,k,icarbon)/total_bm(:,icarbon) )
+                   co2_to_bm(:,j) = co2_to_bm(:,j) + bm_new(:,icarbon)/dt - bm_non(:,icarbon)/dt
+                   bm_to_litter(:,j,k,icarbon)=bm_to_litter(:,j,k,icarbon)- bm_non(:,icarbon)
+
+                   bm_non(:,initrogen) = MIN( bm_to_litter(:,j,k,initrogen), &
+                        total_bm_sapl_non(:,initrogen) *biomass_old(:,j,k,initrogen)/total_bm(:,initrogen) )
+                   ntake(:) = ntake(:) + bm_new(:,initrogen) - bm_non(:,initrogen)
+                   bm_to_litter(:,j,k,initrogen)=bm_to_litter(:,j,k,initrogen)- bm_non(:,initrogen)
+                ENDWHERE
+
+             ENDWHERE
+
+          ENDDO ! Loop over # litter tissues
+
+          ntake_nitrate(:)=MIN(ntake(:),MAX(soil_n_min(:,j,iammonium)-min_stomate,0.0)) 
+          soil_n_min(:,j,iammonium)=soil_n_min(:,j,iammonium)-ntake_nitrate(:) 
+          n_uptake(:,j,iammonium)=n_uptake(:,j,iammonium) + ntake_nitrate(:)/dt 
+  
+          ntake(:)=MIN(ntake(:)-ntake_nitrate(:),MAX(soil_n_min(:,j,initrate)-min_stomate,0.0)) 
+          soil_n_min(:,j,initrate)=soil_n_min(:,j,initrate)-ntake(:) 
+          n_uptake(:,j,initrate)=n_uptake(:,j,initrate) + ntake(:)/dt 
+
+          IF (ANY( bm_to_litter(:,j,:,icarbon) .LT. 0.0 ) .OR. ANY( biomass(:,j,:,icarbon) .LT. 0.0 ) ) THEN
+             CALL ipslerr_p(3,'establish','something wrong in establish/gap.','','')
+          ENDIF 
+
+          !! 4.6 Decrease leaf age in youngest class if new leaf biomass is higher than old one.
+          WHERE ( d_ind(:,j) * bm_sapl(j,ileaf,icarbon) .GT. min_stomate )
+ 
+             ! reset leaf ages. Should do a real calculation like in the npp routine, 
+             ! but this case is rare and not worth messing around.
+             ! S. Zaehle 080806, added real calculation now, because otherwise leaf_age/leaf_frac
+             ! are not initialised for the calculation of vmax, and hence no growth at all.
+             ! logic follows that of stomate_npp.f90, just that it's been adjusted for the code here
+             leaf_age(:,j,1) = leaf_age(:,j,1) * leaf_mass_young(:) / &
+                  ( leaf_mass_young(:) + d_ind(:,j) * bm_sapl(j,ileaf,icarbon) )
+
+          ENDWHERE
+
+          leaf_mass_young(:) = leaf_mass_young(:) + d_ind(:,j) * bm_sapl(j,ileaf,icarbon)   
+
+          !! 4.7 Youngest class: new mass in youngest class divided by total new mass
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+             ! new age class fractions (fraction in youngest class increases)
+             leaf_frac(:,j,1) = leaf_mass_young(:) / biomass(:,j,ileaf,icarbon)
+
+          ENDWHERE
+
+          !! 4.8 Other classes: old mass in leaf age class divided by new mass
+          DO m = 2, nleafages
+
+             WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+                leaf_frac(:,j,m) = leaf_frac(:,j,m) * & 
+                     ( biomass(:,j,ileaf,icarbon) + d_ind(:,j) * bm_sapl(j,ileaf,icarbon) ) /  biomass(:,j,ileaf,icarbon)
+
+             ENDWHERE
+
+          ENDDO
+
+          !! 4.9 Update age and number of individuals
+          WHERE ( d_ind(:,j) .GT. min_stomate )
+
+             age(:,j) = age(:,j) * ind(:,j) / ( ind(:,j) + d_ind(:,j) )
+
+             ind(:,j) = ind(:,j) + d_ind(:,j)
+
+          ENDWHERE
+
+          !! 4.10 Convert excess sapwood to heartwood
+          !!      No longer done : supressed by S. Zaehle given that the LPJ logic of carbon allocation was 
+          !!      contradictory to SLAVE allocation. See CVS tag 1_5 for initial formulation. 
+
+
+       ENDIF ! natural
+
+    ENDDO ! Loop over # PFTs
+
+  !! 5. history
+
+    d_ind = d_ind / dt
+
+    CALL xios_orchidee_send_field("IND_ESTAB",d_ind)
+    CALL xios_orchidee_send_field("ESTABTREE",estab_rate_max_tree)
+    CALL xios_orchidee_send_field("ESTABGRASS",estab_rate_max_grass)
+
+    CALL histwrite_p (hist_id_stomate, 'IND_ESTAB', itime, d_ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ESTABTREE', itime, estab_rate_max_tree, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'ESTABGRASS', itime, estab_rate_max_grass, npts, hori_index)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving establish'
+
+  END SUBROUTINE establish
+
+END MODULE lpj_establish
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_fire.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_fire.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_fire.f90	(revision 6412)
@@ -0,0 +1,636 @@
+! =================================================================================================================================
+! MODULE        : lpj_fire
+!
+! CONTACT	: orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Calculates the probability of fire and its effects on the carbon cycle
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN           :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_fire
+
+  ! modules used:
+  USE xios_orchidee
+  USE stomate_data
+  USE ioipsl_para 
+  USE pft_parameters
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC fire,fire_clear
+
+  LOGICAL, SAVE                   :: firstcall_fire = .TRUE.        !! first call 
+!$OMP THREADPRIVATE(firstcall_fire)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : fire_clear 
+!!
+!>\BRIEF        Set the firstcall_fire flag to .TRUE. and activate initialization
+!! 
+!_ ================================================================================================================================
+
+  SUBROUTINE fire_clear
+    firstcall_fire = .TRUE.
+  END SUBROUTINE fire_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE     : fire 
+!!
+!>\BRIEF          Calculate fire index and fraction of area burned by comparing 
+!! daily litter moisture with prescribed moisture of fire inhibition. If daily 
+!! moisture is below the precribed threshold, allow fire disturbance and 
+!! calculate CO_2 emissions from fire. The main algorithm follows Thonicke et al. 
+!! (2001)
+!!
+!! DESCRIPTION	: Fire occurs when the three basic prerequisites are met: 
+!! sufficient fuel on the ground, relatively dry fuel (fuel moisture lower than 
+!! the moisture of extinction), and presence of ignition sources.  The flag 
+!! ::disable_fire is used to use this fire module or not. While here in the module the 
+!! ignition source is not explicitely represented. It's assumed 
+!! that the ignition source is always available, i.e., if a sufficient amount 
+!! of dead fuel exists with a moisture content below the moisture of fire 
+!! inhibition, then both live and dead fuel will start to burn.\n
+!!
+!! The module completes the following tasks:
+!! 1. Calculates daily fire index, long term fire index and available ground 
+!! litter for burning.\n
+!! \latexonly
+!! \input{lpj_fire_1.tex}  
+!! \endlatexonly
+!! Where, m is the daily litter moisture, m_e is the moisture of extinction, p(m) 
+!! is probability of fire (i.e. the daily fire index).\n
+!! 
+!! \latexonly
+!! \input{lpj_fire_2.tex}  
+!! \endlatexonly
+!! Where, s is the long term fire index and A(s) is the annual fire fraction.\n
+!! 2. Calculates annual fire fraction, then transform to daily fraction in the 
+!! same time step of stomate.\n
+!! 3. Ground litter and grass live biomass (in growing season and except root and carbon 
+!! reserve pool) are  burned at full fire fraction.\n
+!! 4. Fire fraction for tree PFT are compromised by prescribed fire resistence.
+!! Tree live biomass are consumed using this compromised fire fraction and consumption
+!! fraction for different biomass parts. In the case of activation of dynamic 
+!! vegetation, tree individual density is updated after fire. \n 
+!! 5. For all types of fuel (either ground litter or live biomass) that are 
+!! burned, there is a certain fraction of âresidueâ that are not completely 
+!! burned. The remaining part is transferred to (in case of biomass) or
+!! remains (in case of ground litter) as litter.\n
+!! 6. Update the biomass, litter or dead leaves pool after burning.
+!! 7. If the flag SPINUP_ANALYTIC is set to true, the matrix A is updated following
+!! Lardy (2011).
+!! 
+!! RECENT CHANGE(S): April 2015: Black carbon calculations is removed. The black carbon was not conserved.
+!!
+!! MAIN OUTPUT VARIABLE(S): ::co2_fire or the carbon emitted into the atmosphere 
+!! by fire, including both living and dead biomass (gC m^{-2} dtslow^{-1})$ @endtex
+!!
+!! REFERENCES    :
+!! - Thonicke K., Venevsky S., Sitch S., and Cramer W. (2001) The role of fire 
+!! disturbance for global vegetation dynamics: coupling fire into a Dynamic 
+!! Global Vegetation Model, Global Ecology & Biogeography, 10, 661-677.
+!! - Kuhlbusch et al. JGR 101, 23651-23665, 1996
+!! - Kuhlbusch & Crutzen, GBC 9, 491-501, 1995
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART     : None
+!! \n 
+!_ ================================================================================================================================
+  
+  SUBROUTINE fire (npts, dt, &
+       litterhum_daily, t2m_daily, lignin_struc,lignin_wood,veget_max, &
+       fireindex, firelitter, biomass, ind, &
+       litter, dead_leaves, bm_to_litter, &
+       co2_fire, MatrixA)
+
+  !! 0. Variable and parameter declarations
+
+    !! 0.1 Input variables
+   
+    INTEGER(i_std), INTENT(in)                                   :: npts                !! Domain size - number of pixels 
+                                                                                        !! (unitless)   
+    REAL(r_std), INTENT(in)                                      :: dt                  !! Time step of the simulations for stomate 
+                                                                                        !! (days)   
+    REAL(r_std), DIMENSION(npts), 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 
+    REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(in)           :: lignin_wood         !! Ratio Lignine/Carbon in woody litter for above and	 
+                                                                                        !! and below ground litter 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                 :: veget_max           !! Maximum fraction of vegetation type including 
+                                                                                        !! non-biological fraction (0-1, unitless) 
+
+    !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                :: co2_fire            !! Carbon emitted into the atmosphere by 
+                                                                                        !! fire, including both living and dead 
+                                                                                        !! biomass 
+                                                                                        !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    !! 0.3 Modified variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)              :: fireindex           !! Probability of fire; in the code means 
+                                                                                        !! long term fire index (unitless, 0-1)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)              :: firelitter          !! Total natural litter 
+                                                                                        !! available for burning above the ground 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)  :: biomass        !! Biomass @tex $(gC m^{-2})$ @endtex
+    REAl(r_std), DIMENSION(npts,nvm), INTENT(inout)                   :: ind            !! Density of individuals 
+                                                                                        !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), 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,nelements), INTENT(inout):: bm_to_litter     !! Biomass entering the litter pool 
+                                                                                        !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(inout) :: MatrixA          !! Matrix containing the fluxes between the carbon pools
+                                                                                        !! here, it is called only if disable_fire = n
+                                                                                        !! once a day 
+                                                                                        !! @tex $(gC.m^2.day^{-1})$ @endtex
+   
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                                  :: fire_disturb       !! Actual fire disturbance fraction 
+                                                                                        !! after consideration of inherent fire 
+                                                                                        !! resistance of different PFTs 
+                                                                                        !! (unitless, 0-1)  
+    REAL(r_std), DIMENSION(npts,nvm)                              :: firedeath          !! In case of activation of dynamic 
+                                                                                        !! vegetation, the daily fraction of 
+                                                                                        !! burned individuals (unitless, 0-1)  
+    REAL(r_std), DIMENSION(npts)                                  :: moistlimit         !! Moisture for fire inhibition per PFT                                                                                         !! 
+                                                                                        !! (unitless, 0-1) ; temporary variable 
+                                                                                        !! for each PFT in the loop over #PFT ? 
+                                                                                        !! it's not fire inhibition, it's 
+                                                                                        !! "moisture of extinction" by the original
+                                                                                        !! reference paper, and a more "fire 
+                                                                                        !! professional name" it's better to change
+                                                                                        !! the name of moistlimit 
+    REAL(r_std), DIMENSION(npts)                                  :: litter_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)                                  :: wood_residual      !! Fraction of woody litter not burned
+                                                                                        !! (thus residual), depending on strutural 
+                                                                                        !! litter lignin content  (unitless, 0-1) 
+    REAL(r_std), DIMENSION(npts)                                  :: residue_frac       !! Fraction of Fuel (either biomass or litter) not 
+                                                                                        !! burned  (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
+    REAL(r_std), DIMENSION(npts,nvm)                              :: nox_emission       !! NOx emitted into the atmosphere by fire (living and dead biomass) 
+                                                                                        !! (in gN/m**2/day) 
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering fire'
+
+ !! 1. Initialization
+
+    IF ( firstcall_fire ) THEN
+
+       !! 1.1 Fraction to CO_2
+       !      What fraction of the plant biomass compartment, if burned, is transformed 
+       !      into CO_2 released to the atmosphere?
+       !??! the fraction for heartabove seems too big, it's not clear if this value is correct. 
+
+       !! 1.2 print control messages
+       WRITE(numout,*) 'fire:'
+
+       WRITE(numout,*) '   > temporal inertia of fire probability (d): ',tau_fire
+
+       WRITE(numout,*) '   > fraction of burned biomass that becomes CO2:'
+       WRITE(numout,*) '     leaves: ', co2frac(ileaf)
+       WRITE(numout,*) '     sap above ground: ', co2frac(isapabove)
+       WRITE(numout,*) '     sap below ground: ', co2frac(isapbelow)
+       WRITE(numout,*) '     heartwood above ground: ', co2frac(iheartabove)
+       WRITE(numout,*) '     heartwood below ground: ', co2frac(iheartbelow)
+       WRITE(numout,*) '     roots: ', co2frac(iroot)
+       WRITE(numout,*) '     fruits: ', co2frac(ifruit)
+       WRITE(numout,*) '     carbohydrate reserve: ', co2frac(icarbres)
+       WRITE(numout,*) '     labile reserve: ', co2frac(ilabile)
+
+       WRITE(numout,*) '   > critical litter quantity (gC/m**2): ',litter_crit
+       WRITE(numout,*) '   > We calculate a fire probability on agricultural ground, but'
+       WRITE(numout,*) '       the effective fire fraction is zero.'
+
+       firstcall_fire = .FALSE.
+
+    ENDIF
+
+    !! 1.4 Initialize output
+    co2_fire(:,:) = zero
+    firedeath(:,:) = zero
+    fireindex_daily(:,:) = zero
+    firefrac(:,:) = zero
+    nox_emission(:,:)=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,icarbon) + &
+            litter(:,istructural,j,iabove,icarbon)
+
+
+       !! 2.2 Calculate the PFT litter amount weighted by moisture 
+       ! If litter moisture is higher than moisture of extinction, fire is not possible.
+       moistlimit(:) = zero
+
+       WHERE ( (t2m_daily(:) .GT. ZeroCelsius) .AND. (litter_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(:) =  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 = zero
+       
+       !! 3.2 For agricultural ground, no fire is burned for the moment
+       IF ( .NOT. natural(j)) firefrac(:,j) = zero
+       
+  !! 4. Determine fire impact
+
+       ! Calculate fire disturbance fraction for each PFT, and fire emissions due 
+       ! to grasses.
+   
+       !! 4.1 Tree and grass live biomass 
+       ! Tree live biomass is not burned in fire. 
+       ! However, in the dynamic vegetation module, tree individual density 
+       ! will be updated after fire. The fraction of tree individuals that are 
+       ! supposed to die in fire is the fire fraction multiplied by the tree PFT fire 
+       ! resistance which reflect survivorship of different tree PFTs during fire.  
+       IF ( is_tree(j) ) THEN
+
+          !! 4.1.1 Disturban,ce factor for trees 
+          !        Trees are disturbed over the whole year. A resistance factor is  
+          !        used to reflect survivorship of different tree PFTs during fire. 
+          fire_disturb(:) = ( un - resist(j) ) * firefrac(:,j)
+
+       ELSE
+
+          !! 4.1.2 Disturbance factor for grasses 
+          !        Grass is not disturbed outside the growing season thus grass biomass 
+          !        is only burned during the growing season.
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+             fire_disturb(:) = ( un - resist(j) ) * firefrac(:,j)
+
+          ELSEWHERE
+
+             fire_disturb(:) = zero
+
+          ENDWHERE
+
+       ENDIF
+
+       !! 4.2 Burn live biomass
+       !      The burned part goes to either the atmposhere or litter
+       DO k = 1, nparts
+
+          ! for tree PFT, all biomass compartments are burned.
+          ! for grass biomass compartments, all are burned except root and carbon reserve
+          ! IF concerning PFT is tree; OR (the PFT is grass, but not root or carbon reserve biomass); then it's burned.
+          IF ( .NOT. ( ( .NOT. is_tree(j) ) .AND. ( ( k.EQ.iroot ) .OR. ( k.EQ.icarbres ) ) ) ) THEN
+
+             !! 4.2.1 Fraction to the atmosphere.
+             co2_fire(:,j) =  co2_fire(:,j)+ biomass(:,j,k,icarbon) * fire_disturb(:) * co2frac(k) / dt
+
+             nox_emission(:,j) = nox_emission(:,j) + biomass(:,j,k,initrogen) &  
+                  * fire_disturb(:) * co2frac(k) / dt 
+
+             !! 4.2.2 Determine the residue
+             !        Residual is expressed as a fraction
+             residue_frac(:) = fire_disturb(:) * ( un - co2frac(k) )
+
+             !! 4.2.2.3 The rest (largest part) of the residue becomes litter.
+             bm_to_litter(:,j,k,icarbon) = bm_to_litter(:,j,k,icarbon) + residue_frac(:) &
+                  * biomass(:,j,k,icarbon)
+
+             bm_to_litter(:,j,k,initrogen) = bm_to_litter(:,j,k,initrogen) + residue_frac(:) & 
+                  * biomass(:,j,k,initrogen) 
+          ENDIF
+
+       ENDDO
+
+      
+       !! 4.3 Update biomass pool after burning
+       
+       !! 4.3.1 Decrease biomass amount except for grass roots and carbon reserve.
+       DO m = 1, nelements ! Loop over # elements
+          
+          DO k = 1, nparts
+
+             ! **2
+             IF ( .NOT. ( ( .NOT. is_tree(j) ) .AND. ( ( k.EQ.iroot ) .OR. ( k.EQ.icarbres) ) ) ) THEN
+                
+                biomass(:,j,k,m) = ( un - fire_disturb(:) ) * biomass(:,j,k,m)
+                
+             ENDIF
+
+          ENDDO
+          
+       END DO ! End Loop over # elements
+
+
+       !! 4.3.2 If vegetation is dynamic, then decrease the density of tree individuals.
+       IF ( (ok_dgvm .OR. .NOT.lpj_gap_const_mort) .AND. is_tree(j) ) THEN
+
+          firedeath(:,j) = fire_disturb(:) / dt
+
+          ind(:,j) = ( un - fire_disturb(:) ) * ind(:,j)
+
+       ENDIF
+
+    ENDDO      ! loop over #PFT
+
+  !! 5. Burn litter
+
+    !   All litter (either forest or grass) is burned throughout the whole year
+    !   Metabolic litter is totally burned. Burning fraction of structural litter is related 
+    !   with its lignin content. The burned part either goes to the atmosphere
+    !   or remains in litter as unburned residue.
+    DO j = 2,nvm  !loop over #PFT
+
+       !! 5.1 Burn exposed metabolic litter
+       !      Exposed metabolic litter burns completely and goes directly into the atmosphere as CO2.
+
+       !! 5.1.1 CO2 flux from litter burning
+       !        Flux expressed in gC m^{-2}dtslow^{-1}
+       co2_fire(:,j) = co2_fire(:,j) + litter(:,imetabolic,j,iabove,icarbon) * &
+            firefrac(:,j) / dt
+
+       nox_emission(:,j) = nox_emission(:,j) + litter(:,imetabolic,j,iabove,initrogen) * & 
+            firefrac(:,j) / dt 
+
+       !! 5.1.2 Decrease metabolic litter
+       DO m = 1,nelements
+          litter(:,imetabolic,j,iabove,m) = litter(:,imetabolic,j,iabove,m) * &
+               ( un - firefrac(:,j) )
+       END DO
+    
+       !! 5.2 Burning exposed structural litter 
+       !      The fraction that goes to the atmosphere is related to its lignin content. The remaining unburned 
+       !      residues remain as litter.
+
+       !! 5.2.1 Incomplete burning of exposed structural litter  
+       !        Fraction of structural litter that does not burn completly. This fraction depends on lignin 
+       !        content (lignin_struc).
+       struc_residual(:) = fire_resist_lignin * 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,icarbon) * firefrac(:,j) * &
+            ( un - struc_residual(:) )/ dt
+
+       nox_emission(:,j) = nox_emission(:,j) + & 
+            litter(:,istructural,j,iabove,initrogen) * firefrac(:,j) * & 
+            ( 1. - struc_residual(:) )/ dt
+ 
+       !! 5.2.3 Determine residue 
+       !        The residue is litter that undergoes fire, but is not transformed into CO2
+       residue_frac(:) = firefrac(:,j) * struc_residual(:)
+
+       !! 5.2.6 TResidue remaining litter
+       !        The rest (largest part) of the residue remains litter. Remaining 
+       !        litter is the sum of this and of the litter which has not undergone a fire.
+       litter(:,istructural,j,iabove,icarbon) = &
+            litter(:,istructural,j,iabove,icarbon) * ( un - firefrac(:,j) ) + &
+            residue_frac(:) * litter(:,istructural,j,iabove,icarbon)
+
+       litter(:,istructural,j,iabove,initrogen) = & 
+            litter(:,istructural,j,iabove,initrogen) * ( un - firefrac(:,j) ) + & 
+            residue_frac(:) * litter(:,istructural,j,iabove,initrogen) 
+
+       !! 5.3 Burning exposed woody litter is not totally transformed into CO2.
+       
+       !! 5.3.1 Fraction of exposed woody litter that does not
+       !       burn totally should depend on lignin content (lignin_wood). 
+       
+       wood_residual(:) =  fire_resist_lignin * lignin_wood(:,j,iabove)
+       
+       !! 5.3.2 CO2 flux, in gC/(m**2 of total ground)/day.
+       
+       co2_fire(:,j) = co2_fire(:,j) + &
+            litter(:,iwoody,j,iabove,icarbon) * firefrac(:,j) * &
+            ( 1. - wood_residual(:) )/ dt
+
+       nox_emission(:,j) = nox_emission(:,j) + &
+            litter(:,iwoody,j,iabove,initrogen) * firefrac(:,j) * &
+            ( 1. - wood_residual(:) )/ dt
+
+       !! 5.3.3 determine residue (litter that undergoes fire, but is not transformed
+       !       into CO2)
+
+       residue_frac(:) = firefrac(:,j) * wood_residual(:)
+
+       !! 5.3.5 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(:,iwoody,j,iabove,icarbon) = &
+            litter(:,iwoody,j,iabove,icarbon) * ( 1. - firefrac(:,j) ) + &
+            residue_frac(:) * litter(:,iwoody,j,iabove,icarbon)
+
+       litter(:,iwoody,j,iabove,initrogen) = &
+            litter(:,iwoody,j,iabove,initrogen) * ( 1. - firefrac(:,j) ) + &
+            residue_frac(:) * litter(:,iwoody,j,iabove,initrogen)
+
+       !! 5.2.7 Update matrix A for analytical spin-up (only if SPINUP_ANALYTIC is activated)
+
+       IF (spinup_analytic) THEN
+          
+          ! litter structural above
+          MatrixA(:,j,istructural_above,istructural_above) =  MatrixA(:,j,istructural_above,istructural_above) - firefrac(:,j) &
+                                                                +  firefrac(:,j)* struc_residual(:)
+          
+          ! litter_metabolic above
+          MatrixA(:,j,imetabolic_above,imetabolic_above) = MatrixA(:,j,imetabolic_above,imetabolic_above) - firefrac(:,j)
+
+          ! litter woody above
+          MatrixA(:,j,iwoody_above,iwoody_above) =  MatrixA(:,j,iwoody_above,iwoody_above) - firefrac(:,j) &
+                                                              +  firefrac(:,j)* wood_residual(:) 
+          
+          !DS! This is the exact formulation. The above is a simplified formulation.
+          !          MatrixA(:,j,istructural_above,istructural_above) =  MatrixA(:,j,istructural_above,istructural_above)*(1. - firefrac(:,j) + &
+          !                                                             firefrac(:,j)* struc_residual(:)
+          !          MatrixA(:,j,imetabolic_above,imetabolic_above) = MatrixA(:,j,imetabolic_above,imetabolic_above)*(1 - firefrac(:,j))
+          
+       ENDIF !(spinup_analytic)
+
+    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 xios_orchidee_send_field("FIREFRAC",firefrac(:,:))
+    CALL xios_orchidee_send_field("FIREDEATH",firedeath(:,:))
+    CALL xios_orchidee_send_field("NOX_FIRE_EMISSION",nox_emission(:,:))
+
+    CALL histwrite_p (hist_id_stomate, 'FIREFRAC', itime, &
+         firefrac(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FIREDEATH', itime, &
+         firedeath(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'NOX_FIRE_EMISSION', itime, & 
+         nox_emission(:,:), npts*nvm, horipft_index) 
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving fire'
+
+  END SUBROUTINE fire
+
+
+!! ================================================================================================================================
+!! FUNCTION     : firefrac_func
+!!
+!>\BRIEF        Calculate the annual fire fraction using long term fire index
+!! 
+!! DESCRIPTION	: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : annual fire fraction (::firefrac_result)
+!!
+!! REFERENCES   :
+!! - Thonicke K., Venevsky S., Sitch S., and Cramer W. (2001) The role of fire 
+!! disturbance for global vegetation dynamics: coupling fire into a Dynamic 
+!! Global Vegetation Model, Global Ecology & Biogeography, 10, 661-677.\n
+!!
+!! FLOWCHART    : None
+!! \n 
+!_ ================================================================================================================================
+   
+  FUNCTION firefrac_func (npts, x) RESULT (firefrac_result)
+
+!! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                 :: npts             !! Domain size (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)   :: x                !! fire index (unitless, 0-1)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts)               :: firefrac_result  !! fire fraction (unitless, 0-1)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts)               :: xm1              !! intermediate variable
+!_ ================================================================================================================================
+
+!! 1. Function
+
+    xm1(:) = x(:) - 1.
+
+    ! this equation is from Thonicke et al. (2001) equation (9), it use the fire index as input to calculate annual fire fraction.
+    ! but with different parameters with the source literature.
+    !! \latexonly
+    !! \input{lpj_fire_2.tex}  
+    !! \endlatexonly
+    !! Where, s is the long term fire index and A(s) is the annual fire fraction.\n
+    !??! here we use a different parameter with K. Thonicke et al. (2001)
+    !??! it's not clear if these parameters are correct.
+    firefrac_result(:) = &
+         &     x(:) * EXP( xm1(:) / ( -firefrac_coeff(4)*xm1(:)*xm1(:)*xm1(:) + &
+         &     firefrac_coeff(3)*xm1(:)*xm1(:) + &
+         &     firefrac_coeff(2)*xm1(:) +  &      
+         &     firefrac_coeff(1) ) )
+
+  END FUNCTION firefrac_func
+
+END MODULE lpj_fire
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_gap.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_gap.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_gap.f90	(revision 6412)
@@ -0,0 +1,345 @@
+! =================================================================================================================================
+! MODULE       : lpj_gap
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Simulate mortality of individuals and update biomass, litter and 
+!! stand density of the PFT
+!!
+!!\n DESCRIPTION : Simulate mortality of individuals and update biomass, litter and 
+!! stand density of the PFT. This module differs from lpj_kill.f90 in that this 
+!! module kills individuals within a PFT and lpj_kill.f90 removes a PFT from a 
+!! gridbox
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) : 
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!         plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!         global vegetation model, Global Change Biology, 9, 161-185.\n
+!! - Waring, R. H. (1983). "Estimating forest growth and efficiency in relation 
+!!         to canopy leaf area." Advances in Ecological Research 13: 327-354.\n
+!! 
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_gap
+
+  ! modules used:
+  USE xios_orchidee
+  USE stomate_data
+  USE pft_parameters
+  USE ioipsl_para 
+  USE constantes
+  USE function_library,    ONLY: biomass_to_lai
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC gap,gap_clear
+  
+  ! Variable declaration 
+
+  LOGICAL, SAVE             :: firstcall_gap = .TRUE.                  !! first call flag
+!$OMP THREADPRIVATE(firstcall_gap)
+  REAL(r_std), PARAMETER    :: frost_damage_limit = -3 + ZeroCelsius   !! Spring frost-damage limitation (K)
+  REAL(r_std), PARAMETER    :: coldness_mort = 0.04                    !! Daily mortality induced by extreme coldness in winter
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gap_clear
+!!
+!>\BRIEF        Set the firstcall_gap flag back to .TRUE. to prepare for the next simulation.
+!_ ================================================================================================================================
+  
+  SUBROUTINE gap_clear
+    firstcall_gap = .TRUE.
+  END SUBROUTINE gap_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gap
+!!
+!>\BRIEF        Simulate tree and grass mortality, transfer dead biomass to litter and update stand density
+!!
+!! DESCRIPTION  : Calculate mortality of trees and grasses, transfer the dead biomass to litter pool,
+!! and update biomass pool and number of individuals. To get tree mortality, it's possible to choose either a 
+!! constant mortality rate; or to calculate the tree mortality rate based on it's growth efficiency, which is 
+!! defined as this year's net biomass increment per leaf area.\n
+!!
+!! When using growth efficiency mortality, first calculate the net biomass increment for the last year, then 
+!! calculate the growth efficiency and finally calculate the growth efficiency mortality.\n
+!!
+!! Eqation to calculate growth efficiency:
+!! \latexonly 
+!!     \input{gap1.tex}
+!! \endlatexonly
+!! Where $greff$ is growth efficiency, $\Delta$ is net biomass increment, 
+!! $C_{leaf} is last year's leaf biomass, and $SLA$ the specific leaf area. 
+!! 
+!!
+!! Eqation to calculate growth efficiency mortality:
+!! \latexonly 
+!!     \input{gap2.tex}
+!! \endlatexonly
+!! Where $mort_{greff}$ is the growth efficiency mortality, $greff$ is growth  
+!! efficiency, $k_{mort1}$ is asymptotic maximum mortality rate.
+!! 
+!! The name for variable ::availability is not well chosen. Actually the meaning of the variable is mortailty 
+!! rate derived from growth efficiency related mortality. ?? Suggestion: change the name "availability" to 
+!! "mortgref", which means "mortality caused by ".\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::biomass; biomass, ::ind density of individuals, ::bm_to_litter biomass transfer 
+!! to litter and ::mortality mortality (fraction of trees that is dying per time step)
+!!
+!! REFERENCE(S)   :
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!         plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!         global vegetation model, Global Change Biology, 9, 161-185.
+!! - Waring, R. H. (1983). "Estimating forest growth and efficiency in relation 
+!!         to canopy leaf area." Advances in Ecological Research 13: 327-354.
+!!
+!! FLOWCHART    : None
+!!\n
+!_ ================================================================================================================================
+  
+  SUBROUTINE gap (npts, dt, &
+       npp_longterm, turnover_longterm, lm_lastyearmax, &
+       PFTpresent, t2m_min_daily, Tmin_spring_time, &
+       biomass, ind, bm_to_litter, mortality )
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                              :: npts                    !! Domain size (-)
+    REAL(r_std), INTENT(in)                                 :: dt                      !! Time step (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: npp_longterm            !! "Long term" (default 3-year) net primary
+                                                                                       !! productivity  
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: turnover_longterm       !! "Long term" (default 3-year) turnover  
+                                                                                       !! rate @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: lm_lastyearmax          !! Last year's maximum leaf mass, for each 
+                                                                                       !! PFT @tex $(gC m^{-2})$ @endtex
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                :: PFTpresent              !! Is the pft present in the pixel
+    REAL(r_std), DIMENSION(npts), INTENT(in)                :: t2m_min_daily           !! Daily minimum 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: Tmin_spring_time        !! Number of days after begin_leaves (leaf onset) 
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(out)            :: mortality               !! Mortality (fraction of trees that is 
+                                                                                       !! dying per time step)
+
+    !! 0.3 Modified variables   
+    
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)  :: biomass       !! Biomass @tex $(gC m^{-2}) $@endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                   :: ind           !! Number of individuals 
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)  :: bm_to_litter  !! Biomass transfer to litter 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex  
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                            :: delta_biomass           !! Net biomass increase for the previous 
+                                                                                       !! year @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts)                            :: dmortality              !! Dead biomass caused by mortality 
+                                                                                       !! @tex $(gC m^{-2}) $@endtex
+    REAL(r_std), DIMENSION(npts)                            :: vigour                  !! Growth efficiency, an indicator of tree 
+                                                                                       !! vitality, used to calculate mortality
+    REAL(r_std), DIMENSION(npts)                            :: availability            !! Mortality rate derived by growth 
+                                                                                       !! efficiency @tex $(year^{-1})$ @endtex 
+    INTEGER(i_std)                                          :: i, j,k,m                !! Indices
+
+!_ ================================================================================================================================
+
+    IF ( firstcall_gap ) THEN
+
+       firstcall_gap = .FALSE.
+
+    ENDIF
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering gap',lpj_gap_const_mort
+
+    mortality(:,:) = zero
+
+    ! loop over #PFT
+    DO j = 2,nvm
+
+ !! 1. Tree mortality
+
+       IF ( is_tree(j) ) THEN 
+
+          !! 1.1 Use growth efficiency or constant mortality?
+          IF ( .NOT.  lpj_gap_const_mort  ) THEN
+
+             !! 1.1.1 Estimate net biomass increment
+             !        To calculate growth efficiency mortality, first estimate net biomass increment by 
+             !        subtracting turnover from last year's NPP.
+             WHERE ( PFTpresent(:,j) .AND. ( lm_lastyearmax(:,j) .GT. min_stomate ) )
+
+            !??! the following should be removed
+            ! note that npp_longterm is now actually longterm growth efficiency (NPP/LAI)
+            ! to be fair to deciduous trees
+            ! calculate net biomass increment
+             delta_biomass(:) = MAX( npp_longterm(:,j) - ( turnover_longterm(:,j,ileaf,icarbon) + &
+                  turnover_longterm(:,j,iroot,icarbon) + turnover_longterm(:,j,ifruit,icarbon) + & 
+                  turnover_longterm(:,j,isapabove,icarbon) + turnover_longterm(:,j,isapbelow,icarbon) ) ,zero)
+
+            !! 1.1.2 Calculate growth efficiency 
+            !        Calculate growth efficiency by dividing net biomass increment by last year's 
+            !        maximum LAI. (corresponding actually to the maximum LAI of the previous year)
+
+             vigour(:) = delta_biomass(:) / (biomass_to_lai(lm_lastyearmax(:,j),npts,j))
+
+             ELSEWHERE
+
+                vigour(:) = zero
+
+             ENDWHERE
+
+             !! 1.1.3 Calculate growth efficiency mortality rate
+             WHERE ( PFTpresent(:,j) )
+                
+                availability(:) = availability_fact(j) / ( un + ref_greff * vigour(:) )
+                ! Scale mortality by timesteps per year
+                mortality(:,j) = MAX(min_avail,availability(:))  * dt/one_year  
+
+             ENDWHERE
+
+          ELSE  ! .NOT. lpj_gap_const_mort
+
+             !! 1.2 Use constant mortality accounting for the residence time of each tree PFT
+             WHERE ( PFTpresent(:,j) )
+
+                mortality(:,j) = dt/(residence_time(j)*one_year)
+
+             ENDWHERE
+
+          ENDIF ! .NOT.  lpj_gap_const_mort
+
+          !! 1.3 Mortality in DGVM
+          !      If the long term NPP is zero, all trees are killed
+          !??! This is this only applied in the DGVM maybe in order to make the DGVM respond faster and thus make the vegetation dynamics more dynamic?
+          !??! the link here with lpj_kill.f90 is still not clear and so would leave to who especially working on this. 
+          IF ( ok_dgvm ) THEN
+
+             WHERE ( PFTpresent(:,j) .AND. ( npp_longterm(:,j) .LE. min_stomate ) )
+
+                mortality(:,j) = un
+
+             ENDWHERE
+
+          ENDIF
+
+          IF ( ok_dgvm .AND. (tmin_crit(j) .NE. undef) ) THEN
+             ! frost-sensitive PFTs
+             WHERE ( t2m_min_daily(:) .LT. tmin_crit(j) )
+                mortality(:,j) = MIN(un,(coldness_mort*(tmin_crit(j)-t2m_min_daily(:))+mortality(:,j) ) )
+             ENDWHERE
+          ENDIF
+
+          IF ( ok_dgvm .AND. leaf_tab(j)==1 .AND. pheno_type(j)==2) THEN
+             ! Treat the spring frost for broadleaf and summergreen vegetations
+             ! leaf_tab=broadleaf and pheno_typ=summergreen
+             DO i=1,npts
+                IF ( (Tmin_spring_time(i,j)>0) .AND. (Tmin_spring_time(i,j)<spring_days_max+1) ) THEN
+                   IF ( t2m_min_daily(i) .LT. frost_damage_limit ) THEN
+                      mortality(i,j) = MIN(un,(0.01*(frost_damage_limit-t2m_min_daily(i))* &
+                           Tmin_spring_time(i,j)/spring_days_max+mortality(i,j) ) )
+                   END IF
+                END IF
+             END DO
+          END IF
+       
+
+          !! 1.4 Update biomass and litter pools 
+          !    Update biomass and litter pool after dying and transfer recently died biomass to litter
+          
+          DO m = 1,nelements
+             DO k = 1, nparts
+                
+                WHERE ( PFTpresent(:,j) )
+                   
+                   dmortality(:) =  mortality(:,j) * biomass(:,j,k,m)
+                   bm_to_litter(:,j,k,m) = bm_to_litter(:,j,k,m) + dmortality(:)
+                   biomass(:,j,k,m) = biomass(:,j,k,m) - dmortality(:)
+
+                ENDWHERE
+
+             ENDDO
+          END DO
+
+          !! 1.5 In case of dynamic vegetation, update tree individual density
+          IF ( ok_dgvm ) THEN
+
+             WHERE ( PFTpresent(:,j) )
+
+                ind(:,j) = ind(:,j) * ( un - mortality(:,j) )
+
+             ENDWHERE
+
+          ENDIF
+       ELSE 
+
+ !! 2. Grasses mortality
+
+          ! For grasses, if last year's NPP is very small (less than 10 gCm^{-2}year{-1})
+          ! the grasses completely die
+          IF ( .NOT.ok_dgvm .AND. .NOT.lpj_gap_const_mort) THEN
+
+             WHERE ( PFTpresent(:,j) .AND. ( npp_longterm(:,j) .LE. npp_longterm_init ) )
+
+                mortality(:,j) = un
+
+             ENDWHERE
+
+             ! Update biomass and litter pools
+             DO m = 1,nelements
+                DO k = 1, nparts
+
+                   WHERE ( PFTpresent(:,j) )
+                      
+                      dmortality(:) =  mortality(:,j) * biomass(:,j,k,m)
+                      
+                      bm_to_litter(:,j,k,m) = bm_to_litter(:,j,k,m) + dmortality(:)
+                      
+                      biomass(:,j,k,m) = biomass(:,j,k,m) - dmortality(:)
+                      
+                   ENDWHERE
+
+                ENDDO
+             END DO
+             
+          ENDIF
+
+       ENDIF   !IF ( is_tree(j) )
+
+    ENDDO      !loop over pfts
+
+ !! 3. Write to history files
+
+    ! output in fraction of trees that dies/day.
+    mortality(:,:) = mortality(:,:) / dt
+
+    CALL xios_orchidee_send_field("MORTALITY",mortality)
+
+    CALL histwrite_p (hist_id_stomate, 'MORTALITY', itime, &
+         mortality, npts*nvm, horipft_index)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving gap'
+
+  END SUBROUTINE gap
+
+END MODULE lpj_gap
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_kill.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_kill.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_kill.f90	(revision 6412)
@@ -0,0 +1,267 @@
+! =================================================================================================================================
+! MODULE       : lpj_kill
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Kills natural PFTs with low biomass and low number of individuals. 
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE lpj_kill
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC kill
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE  : kill
+!!
+!>\BRIEF       Kills natural pfts that have low biomass or low number of individuals, 
+!! returns biomass to litter pools,  and resets biomass to zero.  
+!!
+!! DESCRIPTION : Kills natural PFTS. The PFT vegetation characteristics are
+!! reinitialized. Kill is either done in DGVM mode or in non-DGVM mode
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): senescence, PFTpresent, cn_ind, ind, RIP_time, age, when_growthinit, 
+!! everywhere,beget, veget_max, npp_longterm, biomass, bm_to_litter, leaf_age, leaf_frac
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE kill (npts, whichroutine, lm_lastyearmax, &
+       ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+       lai, age, leaf_age, leaf_frac, npp_longterm, &
+       when_growthinit, everywhere, veget_max, bm_to_litter)
+
+ !! 0. Variable and parameter description
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size (unitless)
+    CHARACTER(LEN=10), INTENT(in)                             :: whichroutine    !! Message (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lai             !! [DISPENSABLE] leaf area index OF AN INDIVIDUAL PLANT 
+                                                                                 !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lm_lastyearmax  !! Last year's maximum leaf mass, for each PFT 
+                                                                                 !! @tex $(gC.m^{-2})$ @endtex
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: senescence      !! Is the plant senescent? (only for deciduous 
+                                                                                 !! trees - carbohydrate reserve) (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent      !! Is pft there (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: cn_ind          !! Crown area of individuals 
+                                                                                 !! @tex $(m^2)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! Number of individuals 
+                                                                                 !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: RIP_time        !! How much time ago was the PFT eliminated for
+                                                                                 !! the last time (y)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age             !! Mean age (years)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit !! How many days ago was the beginning of the 
+                                                                                 !! growing season (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! Is the PFT everywhere in the grid box or very
+                                                                                 !! localized (after its introduction)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget_max       !! "Maximal" coverage fraction of a PFT (LAI -> 
+                                                                                 !! infinity) on ground (unitless;0-1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm    !! "Long term" (default = 3-year) net primary 
+                                                                                 !! productivity 
+                                                                                 !! @tex $(gC.m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age        !! Leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! Fraction of leaves in leaf age class 
+                                                                                 !! (unitless;0-1)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass       !! Biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter  !! Conversion of biomass to litter 
+                                                                                      !! @tex $(gC.m^{-2} day^{-1})$ @endtex
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                            :: j,m             !! Indices       (unitless)
+    LOGICAL, DIMENSION(npts)                                  :: was_killed      !! Bookkeeping   (true/false)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering kill'
+
+ !! 1. Kill PFTs
+
+    ! Kill plants if number of individuals or last year's leaf mass is close to zero.
+    ! the "was_killed" business is necessary for a more efficient code on the VPP processor
+    DO j = 2,nvm ! loop plant functional types
+
+       was_killed(:) = .FALSE.
+
+       IF ( natural(j) ) THEN
+
+          !! 1.1 Kill natural PFTs when DGVM is activated
+          IF ( ok_dgvm ) THEN
+             WHERE ( PFTpresent(:,j) .AND. &
+                  ( ( ind(:,j) .LT. min_stomate ) .OR. &
+                  ( lm_lastyearmax(:,j) .LT. min_stomate ) ) )
+             
+                was_killed(:) = .TRUE.
+             
+             ENDWHERE
+          
+          ELSE
+
+             !! 1.2 Kill natural PFTs when running STOMATE without DGVM
+
+             !! 1.2.1 Kill PFTs
+             WHERE ( PFTpresent(:,j) .AND. & 
+                  (((biomass(:,j,icarbres,icarbon) .LE.zero).AND.(biomass(:,j,ilabile,icarbon) .LE.zero)) .OR. & 
+                  biomass(:,j,iroot,icarbon).LT.-min_stomate .OR. biomass(:,j,ileaf,icarbon).LT.-min_stomate ).AND. & 
+                  ind(:,j).GT. zero)
+
+                was_killed(:) = .TRUE.
+
+             ENDWHERE
+
+             !! 1.2.2 Overwrite long-term NPP for grasses
+             IF(.NOT.is_tree(j).AND..NOT.lpj_gap_const_mort)THEN
+                WHERE ( was_killed(:) )
+
+                   npp_longterm(:,j) = 500.
+
+                ENDWHERE
+             ENDIF
+
+          ENDIF ! ok_dgvm
+
+          !! 1.3 Bookkeeping for PFTs that were killed
+          !      For PFTs that were killed, return biomass pools to litter 
+          !      and update biomass pools to zero
+          IF ( ANY( was_killed(:) ) ) THEN
+          
+             DO m = 1,nelements
+
+                WHERE ( was_killed(:) )
+
+                   bm_to_litter(:,j,ileaf,m) = bm_to_litter(:,j,ileaf,m) + biomass(:,j,ileaf,m)
+                   bm_to_litter(:,j,isapabove,m) = bm_to_litter(:,j,isapabove,m) + biomass(:,j,isapabove,m)
+                   bm_to_litter(:,j,isapbelow,m) = bm_to_litter(:,j,isapbelow,m) + biomass(:,j,isapbelow,m)
+                   bm_to_litter(:,j,iheartabove,m) = bm_to_litter(:,j,iheartabove,m) + &
+                                                     biomass(:,j,iheartabove,m)
+                   bm_to_litter(:,j,iheartbelow,m) = bm_to_litter(:,j,iheartbelow,m) + &
+                                                     biomass(:,j,iheartbelow,m)
+                   bm_to_litter(:,j,iroot,m) = bm_to_litter(:,j,iroot,m) + biomass(:,j,iroot,m)
+                   bm_to_litter(:,j,ifruit,m) = bm_to_litter(:,j,ifruit,m) + biomass(:,j,ifruit,m)
+                   bm_to_litter(:,j,icarbres,m) = bm_to_litter(:,j,icarbres,m) + biomass(:,j,icarbres,m)
+
+                   bm_to_litter(:,j,ilabile,m) = bm_to_litter(:,j,ilabile,m) + biomass(:,j,ilabile,m)
+                   
+                   
+                   biomass(:,j,ileaf,m) = zero
+                   biomass(:,j,isapabove,m) = zero
+                   biomass(:,j,isapbelow,m) = zero
+                   biomass(:,j,iheartabove,m) = zero
+                   biomass(:,j,iheartbelow,m) = zero
+                   biomass(:,j,iroot,m) = zero
+                   biomass(:,j,ifruit,m) = zero
+                   biomass(:,j,icarbres,m) = zero
+                   biomass(:,j,ilabile,m) = zero
+                ENDWHERE   ! was_killed
+
+             END DO
+
+            !! 1.4 Update veget_max in DGVM
+            !      Update veget_max in DGVM for killed PFTs and reset RIP_time
+            IF (ok_dgvm) THEN
+
+                WHERE ( was_killed(:) )
+                   PFTpresent(:,j) = .FALSE.
+
+                   veget_max(:,j) = zero
+                   
+                   RIP_time(:,j) = zero
+
+                ENDWHERE  ! was_killed
+
+            ENDIF ! ok_dgvm
+
+            !! 1.5 Reinitialize vegetation characteristics in DGVM and STOMATE
+            !      Reinitialize number of individuals, crown area and age
+            WHERE ( was_killed(:) )
+
+                ind(:,j) = zero
+
+                cn_ind(:,j) = zero
+
+                senescence(:,j) = .FALSE.
+
+                age(:,j) = zero
+
+                when_growthinit(:,j) = large_value 
+
+                everywhere(:,j) = zero
+
+!                veget(:,j) = zero
+!MM Ã  imposer ?!
+!                lai(:,j) = zero
+
+             ENDWHERE   ! was_killed
+
+             !! 1.6 Update leaf ages
+             DO m = 1, nleafages
+
+                WHERE ( was_killed(:) )
+
+                   leaf_age(:,j,m) = zero 
+                   leaf_frac(:,j,m) = zero 
+
+                ENDWHERE ! was_killed
+
+             ENDDO
+
+             !! 1.7 Print sub routine messages
+             IF ( printlev>=2 ) THEN
+
+                WRITE(numout,*) 'kill: eliminated ',PFT_name(j)
+                WRITE(numout,*) '  at ',COUNT( was_killed(:) ),' points after '//whichroutine
+
+             ENDIF
+
+          ENDIF     ! PFT must be killed at at least one place
+
+       ENDIF       ! PFT is natural
+
+    ENDDO         ! loop over PFTs
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving kill'
+
+  END SUBROUTINE kill
+
+END MODULE lpj_kill
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_light.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_light.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_light.f90	(revision 6412)
@@ -0,0 +1,645 @@
+! =================================================================================================================================
+! MODULE       : lpj_light
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Light competition within a PFT
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_light
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE constantes
+  USE stomate_data
+  USE function_library,    ONLY: biomass_to_lai
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC light, light_clear
+
+  LOGICAL, SAVE                                            :: firstcall_light = .TRUE.             !! first call
+!$OMP THREADPRIVATE(firstcall_light)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : light_clear
+!!
+!>\BRIEF          Activation
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE light_clear
+    firstcall_light=.TRUE.
+  END SUBROUTINE light_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: light
+!!
+!>\BRIEF         Light competition within a PFT
+!!
+!! DESCRIPTION  : This module kills PFTs based on light competition
+!! 
+!! Here, fpc ("foilage projected cover") takes into account the minimum fraction
+!! of space covered by trees through branches etc. This is done to prevent strong relative
+!! changes of FPC from one day to another for deciduous trees at the beginning of their
+!! growing season, which would yield too strong cutbacks.\n
+!!
+!! fpc is now always calculated from lm_lastyearmax*sla, since the aim of this DGVM is 
+!! to represent community ecology effects; seasonal variations in establishment related to phenology
+!! may be relevant, but beyond the scope of a 1st generation DGVM.\n
+!!
+!! If agriculture is present, fpc can never reach 1.0 since natural veget_max < 1.0. To
+!! correct for this, ::ind must be recalculated to correspond to the natural density.
+!! since ::ind is expressed in m^{-2} grid cell, this can be achieved by dividing individual 
+!! density by the agricultural fraction.\n
+!!
+!! The flow in the routine is different for ::ok_dgvm. When ::ok_dgvm is true
+!! the following processes are considered:
+!!
+!! No competition between woody pfts (height of individuals is not considered).
+!! Exception: when one woody pft is overwhelming (i.e. fpc > fpc_crit). In that
+!! case, eliminate all other woody pfts and reduce dominant pft to fpc_crit.
+!! Age of individuals is not considered. In reality, light competition would more
+!! easily kill young individuals, thus increasing the mean age of the stand.
+!! Exclude agricultural pfts from competition.\n
+!!
+!! When ::ok_dgvm is false then light competition is calculated for the static case if the mortality is not 
+!! assumed to be constant. The following processes are considered: XXX
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ind, biomass, veget_lastlight, bm_to_litter, mortality
+!!
+!! REFERENCES   : 
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!! plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!! global vegetation model, Global Change Biology, 9, 161-185.\n
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE light (npts, dt, &
+       veget_max, fpc_max, PFTpresent, cn_ind, 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  
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: maxfpc_lastyear          !! Last year's maximum fpc for each natural 
+                                                                                       !! PFT(unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: lm_lastyearmax           !! Last year's maximum leafmass for each 
+                                                                                       !! natural PFT 
+                                                                                       !! @tex $(gC m^2 s^{-1})$ @endtex   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget_max                !! Last year's maximum fpc for each natural 
+                                                                                       !! PFT (unitless;0-1)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: fpc_max                  !! Last year's maximum fpc for each natural 
+                                                                                       !! PFT (unitless)    
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: ind                      !! Number of individuals 
+                                                                                       !! @tex $(m^{-2})$ @endtex    
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! Biomass @tex $(gCm^{-2})$ @endtex    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: veget_lastlight          !! Vegetation cover after last light 
+                                                                                       !! competition (unitless;0-1)     
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter   !! Biomass transfer to litter per timestep
+                                                                                       !! @tex $(gCm^{-2})$ @endtex    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: mortality                !! Fraction of individuals that died this 
+                                                                                       !! time step per dt (unitless;0-1)   
+
+    !! 0.4 Local variables
+
+    LOGICAL, PARAMETER                                     :: annual_increase = .TRUE. !! For diagnosis of fpc increase, compare 
+                                                                                       !! today's fpc to last year's  Maximum (T)
+                                                                                       !! or to fpc of last time step (F) 
+    REAL(r_std), DIMENSION(npts,nvm)                       :: lai                      !! Leaf area index OF AN INDIVIDUAL PLANT
+    INTEGER(i_std)                                         :: i,j,k,m                  !! Index (unitless)    
+    INTEGER(i_std)                                         :: ipts, ivm                !! Indices (unitless)
+    REAL(r_std), DIMENSION(npts)                           :: sumfpc                   !! Total natural fpc, sum of all the PFTs
+                                                                                       !! (unitless)   
+    REAL(r_std), DIMENSION(npts)                           :: fracnat                  !! Fraction of natural vegetation within a 
+                                                                                       !! grid cell (unitless;0-1)   
+    REAL(r_std)                                            :: sumfpc_wood              !! Total natural woody fpc (unitless)   
+    REAL(r_std)                                            :: sumdelta_fpc_wood        !! Change in total woody fpc (unitless)   
+    REAL(r_std)                                            :: maxfpc_wood              !! Maximum wood fpc (unitless)   
+    INTEGER(i_std)                                         :: optpft_wood              !! Which woody pft is maximum (unitless)   
+    REAL(r_std)                                            :: sumfpc_grass             !! Total natural grass fpc (unitless)   
+    REAL(r_std), DIMENSION(npts,nvm)                       :: fpc_nat                  !! This year's foliage projected cover on 
+                                                                                       !! natural part of the grid cell 
+                                                                                       !! @tex $(m^2)$ @endtex
+    REAL(r_std), DIMENSION(nvm)                            :: deltafpc                 !! fpc change within last year (unitless)    
+    REAL(r_std)                                            :: reduct                   !! Relative change of number of individuals
+                                                                                       !! for trees (ind)    
+    REAL(r_std), DIMENSION(nvm)                            :: survive                  !! Fraction of plants that survive 
+                                                                                       !! (unitless;0-1)     
+    REAL(r_std), DIMENSION(npts)                           :: fpc_real                 !! FPC for static mode (unitless)     
+    REAL(r_std), DIMENSION(npts)                           :: lai_ind                  !! FPC mortality for static mode     
+    REAL(r_std)                                            :: sumfpc_grass2            !! New total grass fpc     
+    REAL(r_std), DIMENSION(npts,nvm)                       :: light_death              !! Fraction of plants that dies each day 
+                                                                                       !! @tex $(day^{-1})$ @endtex     
+    REAL(r_std)                                            :: fpc_dec                  !! Relative change of number of individuals 
+                                                                                       !! for trees
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering light'
+
+ !! 0. Calculate the LAI from the biomass. 
+    ! This is done to prevent passing an incorrect
+    ! LAI around, since LAI is diagnostic.
+    ! We can't do this if we use an LAI map! So this breaks DO_STOMATE=N
+    lai(:,ibare_sechiba) = zero
+    DO ipts = 1, npts
+       DO ivm = 1, nvm
+          lai(ipts,ivm) = biomass_to_lai(biomass(ipts,ivm,ileaf,icarbon),ivm)
+       ENDDO
+    ENDDO
+   
+ !! 1. Write diagnostics to out_orchidee files
+  
+    IF ( firstcall_light ) THEN
+
+       WRITE(numout,*) 'light:'
+
+       WRITE(numout,*) '   > For trees, minimum fraction of crown area covered'
+       WRITE(numout,*) '       (due to its branches etc.)', min_cover
+
+       WRITE(numout,*) '   > for diagnosis of fpc increase, compare today''s fpc'
+       IF ( annual_increase ) THEN
+          WRITE(numout,*) '     to last year''s maximum.'
+       ELSE
+          WRITE(numout,*) '     to fpc of the last time step.'
+       ENDIF
+
+       firstcall_light = .FALSE.
+
+    ENDIF
+
+ !! 2. Light competition in DGVM
+
+    IF (ok_dgvm) THEN
+             
+       !! 2.1 Calculate natural part of the grid cell
+       fracnat(:) = un
+       DO j = 2,nvm
+          IF ( .NOT. natural(j) ) THEN
+             fracnat(:) = fracnat(:) - veget_max(:,j)
+          ENDIF
+       ENDDO
+       
+       !! 2.2 Calculate fpc on natural part of grid cell
+       fpc_nat(:,:) = zero
+       fpc_nat(:,ibare_sechiba) = un
+
+       DO j = 2, nvm ! loop over #PFTs
+
+
+          !! 2.2.1 Natural PFTs
+          IF ( natural(j) ) THEN
+   
+             !!?? it seems that the treatment below for trees and grasses are the same? so there is no necessity to use IF...ELSE...ENDIF structure?
+	     !!?? CODE SHOULD BE CLEANED UP BELOW
+
+             !! 2.2.1.1 Trees
+             IF ( is_tree(j) ) THEN
+
+                ! !! 2.1.1.1 trees: minimum cover due to stems, branches etc.
+                !          DO i = 1, npts
+                !             IF (lai(i,j) == val_exp) THEN
+                !                fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
+                !             ELSE
+                !                fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
+                !                     MAX( ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
+                !             ENDIF
+                !          ENDDO
+                !NV : modif from S. Zaehle version : fpc is based on veget_max, not veget.
+
+                WHERE(fracnat(:).GE.min_stomate)
+
+                   !            WHERE(LAI(:,j) == val_exp)
+                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                   !            ELSEWHERE
+                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * &
+                   !                    MAX( ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ), min_cover )
+                   !            ENDWHERE
+
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                ENDWHERE
+
+             ELSE
+
+                !NV : modif from S. Zaehle version : fpc is based on veget_max, not veget.
+		!!?? DO GRASSES HAVE CROWNS?
+                
+                !! 2.2.1.1 Grasses
+                WHERE(fracnat(:).GE.min_stomate)
+
+                   !            WHERE(LAI(:,j) == val_exp)
+                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                   !            ELSEWHERE
+                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * &
+                   !                    ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
+                   !            ENDWHERE
+
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                ENDWHERE
+
+!!!$                ! 2.1.1.2 bare ground 
+!!!$                IF (j == ibare_sechiba) THEN
+!!!$                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) 
+!!!$
+!!!$                   ! 2.1.1.3 grasses
+!!!$                ELSE
+!!!$                   DO i = 1, npts
+!!!$                      IF (lai(i,j) == val_exp) THEN
+!!!$                         fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
+!!!$                      ELSE
+!!!$                         fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
+!!!$                              ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) )
+!!!$                      ENDIF
+!!!$                   ENDDO
+!!!$                ENDIF
+
+             ENDIF  ! tree/grass
+
+          ELSE
+
+             !! 2.2.2 Agricultural PFTs
+             !        Agriculural PFTs are not present on natural part
+             fpc_nat(:,j) = zero
+
+          ENDIF    ! natural/agricultural
+
+       ENDDO
+
+       
+       !! 2.3 Total fpc for grid point
+       sumfpc(:) = zero
+       DO j = 2,nvm
+
+          !S. Zaehle bug correction MERGE: need to subtract agricultural area!
+          sumfpc(:) = sumfpc(:) + fpc_nat(:,j)
+       ENDDO
+
+       
+       !! 2.4 Light competition
+
+       light_death(:,:) = zero
+
+       DO i = 1, npts ! S. Zaehle why this loop and not a vector statement ?
+
+          !! 2.4.1 Dense canopy 
+          IF ( sumfpc(i) .GT. fpc_crit ) THEN
+
+             ! 2.4.1.1 fpc change for each pft
+             ! There are two possibilities: either we compare today's fpc with the fpc after the last
+             ! time step, or we compare it to last year's maximum fpc of that PFT. In the first case,
+             ! the fpc increase will be strong for seasonal PFTs at the beginning of the growing season.
+             ! As for trees, the cutback is proportional to this increase, this means that seasonal trees
+             ! will be disadvantaged compared to evergreen trees. In the original LPJ model, with its 
+             ! annual time step, the second method was used (this corresponds to annual_increase=.TRUE.)
+
+             IF ( annual_increase ) THEN
+                deltafpc(:) = MAX( (fpc_nat(i,:)-maxfpc_lastyear(i,:)),  zero )
+             ELSE
+                deltafpc(:) = MAX( (fpc_nat(i,:)-veget_lastlight(i,:)),  zero )
+             ENDIF
+
+             !! 2.4.1.2 Default survival
+             survive(:) = un
+
+             
+             !! 2.4.1.3 Determine some characteristics of the fpc distribution
+             sumfpc_wood = zero
+             sumdelta_fpc_wood = zero
+             maxfpc_wood = zero
+             optpft_wood = 0
+             sumfpc_grass = zero
+
+             DO j = 2,nvm ! loop over #PFTs
+
+                !! 2.4.1.3.1 Natural pfts
+                IF ( natural(j) ) THEN
+
+                   !! 2.4.1.3.1.1 Trees
+                   IF ( is_tree(j) ) THEN
+
+                      ! total woody fpc
+                      sumfpc_wood = sumfpc_wood + fpc_nat(i,j)
+
+                      ! how much did the woody fpc increase
+                      sumdelta_fpc_wood = sumdelta_fpc_wood + deltafpc(j)
+
+                      ! which woody pft is preponderant
+                      IF ( fpc_nat(i,j) .GT. maxfpc_wood ) THEN
+
+                         optpft_wood = j
+
+                         maxfpc_wood = fpc_nat(i,j)
+
+                      ENDIF
+
+                   ELSE
+
+                      !! 2.4.1.3.1.2 Grasses
+                      ! total (natural) grass fpc
+                      sumfpc_grass = sumfpc_grass + fpc_nat(i,j)
+
+                   ENDIF   ! tree or grass
+
+                ENDIF   ! natural
+
+             ENDDO  ! loop over pfts
+
+             !! 2.4.1.4 Wood outcompetes grass
+             !          Light competition where wood outcompetes grasses
+             
+             !S. Zaehle           IF (sumfpc_wood .GE. fpc_crit ) THEN
+             !
+             !! 3.2.1 all allowed natural space is covered by wood:
+             !!       cut back trees to fpc_crit.
+             !!       Original DGVM: kill grasses. Modified: we let a very
+             !!       small fraction of grasses survive.
+             !
+
+             DO j = 2,nvm ! Loop over #PFTs
+
+                ! only present and natural pfts compete
+                IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
+
+                   !! 2.4.1.4.1 Trees
+                   IF ( is_tree(j) ) THEN
+
+                      ! no single woody pft is overwhelming
+                      ! (original DGVM: tree_mercy = 0.0 )
+                      ! The reduction rate is proportional to the ratio deltafpc/fpc.
+                      IF (sumfpc_wood .GE. fpc_crit .AND. fpc_nat(i,j) .GT. min_stomate .AND. & 
+                           sumdelta_fpc_wood .GT. min_stomate) THEN
+
+                         ! reduct = MIN( ( ( deltafpc(j)/sumdelta_fpc_wood * &
+                         !     (sumfpc_wood-fpc_crit) ) / fpc_nat(i,j) ), &
+                         !     ( 1._r_std - 0.01 ) ) ! (0.01 = tree_mercy previously)
+
+                         !!? difficult to fully understand but doesn't look so simple
+                         reduct = un - MIN((fpc_nat(i,j)-(sumfpc_wood-fpc_crit) & 
+                              * deltafpc(j)/sumdelta_fpc_wood)/fpc_nat(i,j), un )
+
+                      ELSE
+
+                         ! tree fpc didn't icrease or it started from nothing
+                         reduct = zero
+
+                      ENDIF
+                   ELSE
+
+                      !! 2.4.1.4.2 Grasses 
+                      !            Let a very small fraction survive (the sum of all
+                      !            grass individuals may make up a maximum cover of
+                      !            grass_mercy [for lai -> infinity]).
+                      !            In the original DGVM, grasses were killed in that case,
+                      !            corresponding to grass_mercy = 0.
+                      !
+
+                      IF(sumfpc_grass .GE. un-MIN(fpc_crit,sumfpc_wood).AND. & 
+                           sumfpc_grass.GE.min_stomate) THEN
+
+                         fpc_dec = (sumfpc_grass - un + MIN(fpc_crit,sumfpc_wood))*fpc_nat(i,j)/sumfpc_grass
+
+                         reduct = fpc_dec
+                      ELSE 
+                         reduct = zero
+                      ENDIF
+                   ENDIF   ! tree or grass
+
+                   survive(j) = un - reduct
+                ENDIF     ! pft there and natural
+
+             ENDDO       ! loop over pfts
+
+             !S. Zaehle
+!!!$          ELSE
+!!!$
+!!!$             !
+!!!$             ! 3.2.2 not too much wood so that grasses can subsist
+!!!$             !
+!!!$
+!!!$             ! new total grass fpc
+!!!$             sumfpc_grass2 = fpc_crit - sumfpc_wood
+!!!$
+!!!$             DO j = 2,nvm
+!!!$
+!!!$                ! only present and natural PFTs compete
+!!!$
+!!!$                IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
+!!!$
+!!!$                   IF ( is_tree(j) ) THEN
+!!!$
+!!!$                      ! no change for trees
+!!!$
+!!!$                      survive(j) = 1.0
+!!!$
+!!!$                   ELSE
+!!!$
+!!!$                      ! grass: fractional loss is the same for all grasses
+!!!$
+!!!$                      IF ( sumfpc_grass .GT. min_stomate ) THEN
+!!!$                         survive(j) = sumfpc_grass2 / sumfpc_grass
+!!!$                      ELSE
+!!!$                         survive(j)=  zero
+!!!$                      ENDIF
+!!!$
+!!!$                   ENDIF
+!!!$
+!!!$                ENDIF    ! pft there and natural
+!!!$
+!!!$             ENDDO       ! loop over pfts
+!!!$
+!!!$          ENDIF    ! sumfpc_wood > fpc_crit
+
+             
+             !! 2.4.1.5 Update biomass and litter pools
+             
+             DO j = 2,nvm ! Loop over #PFTs
+
+                ! Natural PFTs
+                IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
+
+                   bm_to_litter(i,j,:,:) = 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 ( ok_dgvm ) THEN
+                      ind(i,j) = ind(i,j) * survive(j)
+                   ENDIF
+
+                   ! fraction of plants that dies each day. 
+                   ! exact formulation: light_death(i,j) = un - survive(j) / dt
+                   light_death(i,j) = ( un - survive(j) ) / dt
+
+                ENDIF      ! pft there and natural
+
+             ENDDO        ! loop over pfts
+
+          ENDIF      ! sumfpc > fpc_crit
+
+       ENDDO        ! loop over grid points
+
+       
+       !! 2.5 Recalculate fpc for natural PFTs
+       !      Recalculate fpc on natural part of the grid cell for next light competition
+       DO j = 2,nvm ! loop over #PFT
+
+          !! 2.5.1 Natural PFTs
+          IF ( natural(j) ) THEN
+ 
+             !! 2.5.1.1 Trees
+             IF ( is_tree(j) ) THEN
+
+                DO i = 1, npts
+
+                   !NVMODIF         
+                   !    IF (lai(i,j) == val_exp) THEN
+                   !                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+                   !             ELSE
+                   !                veget_lastlight(i,j) = &
+                   !                     cn_ind(i,j) * ind(i,j) * &
+                   !                     MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
+                   !             ENDIF
+                   !!                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
+ 
+                   IF (lai(i,j) == val_exp) THEN
+                      veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+                   ELSE
+                      veget_lastlight(i,j) = &
+                           cn_ind(i,j) * ind(i,j) * &
+                           MAX( ( un - EXP( - biomass_to_lai(lm_lastyearmax(i,j),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( - biomass_to_lai(lm_lastyearmax(i,j),j) * ext_coeff(j) ) )
+                   ENDIF
+                ENDDO
+             ENDIF    ! tree/grass
+
+          ELSE
+
+             !! 2.5.2 Agricultural PFTs
+             !        Agricultural PFTs are not present on the natural part of the grid point
+             veget_lastlight(:,j) = zero
+
+          ENDIF  ! natural/agricultural
+
+       ENDDO ! # PFTs
+
+    ELSE ! ok_dgvm
+
+ !! 3. Light competition in stomate (without DGVM)
+
+       light_death(:,:) = zero
+
+       DO j = 2, nvm 
+
+          IF ( natural(j) ) THEN
+
+	     !! NUMBERING BELOW SHOULD BE 5.0 or 4.3
+             !! 2.1.1 natural PFTs, in the one PFT only case there needs to be no special case for grasses,
+             !! neither a redistribution of mortality (delta fpc)
+             !! 3.1 XXX
+             WHERE( ind(:,j)*cn_ind(:,j) .GT. min_stomate ) 
+                lai_ind(:) = biomass_to_lai(lm_lastyearmax(:,j),npts,j) / ( ind(:,j) * cn_ind(:,j) )
+             ELSEWHERE
+                lai_ind(:) = zero
+             ENDWHERE
+
+             fpc_nat(:,j) =  cn_ind(:,j) * ind(:,j) * & 
+                  MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover )
+
+             WHERE(fpc_nat(:,j).GT.fpc_max(:,j))
+
+                light_death(:,j) = MIN(un, un - fpc_max(:,j)/fpc_nat(:,j)) 
+
+             ENDWHERE
+
+             !! 3.2 Update biomass and litter pools
+             DO m = 1,nelements
+                DO k=1,nparts
+                   
+                   bm_to_litter(:,j,k,m) = bm_to_litter(:,j,k,m) + light_death(:,j)*biomass(:,j,k,m)
+                   biomass(:,j,k,m) = biomass(:,j,k,m) - light_death(:,j)*biomass(:,j,k,m)
+                   
+                ENDDO
+             END DO
+
+             !! 3.3 Update number of individuals
+             ind(:,j) = ind(:,j)-light_death(:,j)*ind(:,j)
+
+          ENDIF
+       ENDDO
+
+       light_death(:,:) = light_death(:,:)/dt
+
+    ENDIF ! ok_dgvm
+
+   
+ !! 4. Write history files
+    CALL xios_orchidee_send_field("LIGHT_DEATH",light_death)
+
+    CALL histwrite_p (hist_id_stomate, 'LIGHT_DEATH', itime, &
+         light_death, npts*nvm, horipft_index)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving light'
+
+  END SUBROUTINE light
+
+END MODULE lpj_light
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_pftinout.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_pftinout.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_pftinout.f90	(revision 6412)
@@ -0,0 +1,520 @@
+! =================================================================================================================================
+! MODULE       : lpj_pftinout
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Introduce and eliminate PFT's from pixel
+!!
+!! \n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! REFERENCE(S) :
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!        plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!        global vegetation model, Global Change Biology, 9, 161-185.\n
+!! - Thonicke, K., S. Venevsky, et al. (2001), The role of fire disturbance 
+!!        for global vegetation dynamics: coupling fire into a Dynamic Global
+!!        Vegetation Model, Global Ecology and Biogeography, 10, 661-677.\n
+!! - Haxeltine, A. and I. C. Prentice (1996), BIOME3: An equilibrium
+!!        terrestrial biosphere model based on ecophysiological constraints, 
+!!        resource availability, and competition among plant functional types,
+!!        Global Biogeochemical Cycles, 10(4), 693-709.\n
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!        dynamics in the modelling of terrestrial ecosystems: comparing two
+!!        contrasting approaches within European climate space,
+!!        Global Ecology and Biogeography, 10, 621-637.\n
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ==============================================================================================================================
+
+MODULE lpj_pftinout
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE grid
+  USE function_library,    ONLY: biomass_to_lai
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC pftinout,pftinout_clear
+
+  LOGICAL, SAVE                       :: firstcall_pftinout = .TRUE.                !! first call
+!$OMP THREADPRIVATE(firstcall_pftinout)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE  : pftinout_clear
+!!
+!>\BRIEF       Set flag ::firstcall_pftinout to true and initialize the variables
+!_ ================================================================================================================================
+
+  SUBROUTINE pftinout_clear
+    firstcall_pftinout = .TRUE.
+  END SUBROUTINE pftinout_clear
+
+!! ================================================================================================================================ 
+!! SUBROUTINE  : pftinout
+!! 
+!>\BRIEF       Introduce and eliminate PFT's from pixel
+!!
+!! DESCRIPTION**3 : Introduction and elimination of PFTs on the basis of climate condition.
+!! For natural and woody PFTs the foliage projected coverage is calculated as follows:
+!! \latexonly
+!!  \input{equation_lpj_pftinout.tex}
+!! \endlatexonly
+!! \n
+!! where FPC is foliage projective cover (::fpc_nat), CN crown area (::cn_ind, 
+!! @tex $ m^{2} $ @endtex), IND number of individuals (::ind, @tex $ m^{-2} $ @endtex,
+!! FRAC total fraction occupied by natural vegetation (::fracnat),
+!! @tex $ LM_{rm max} $ @endtex maximum leaf mass in last year
+!! (::lm_lastyearmax, @tex $ g C m^{-2} $ @endtex), SLA specific leaf area (sla,
+!! @tex $ m^{2} (g C)^{-1} $ @endtex), and coff coefficient (::ext_coeff). ::ext_coeff 
+!! describes a property of the canopy (i.e. law of Lambert-Beer) and is defined in **2
+!!
+!! The foliage projective cover feeds into the calculation of the space available for 
+!! expansion of existing and dispersion of new PFTs within a gridbox. In turn, available
+!! space is use to calculate the number of individuals with a PFT. 
+!!
+!! Saplings are introduced under the condition that winter temperature is 
+!! moderate, plant age is older than 1.25, (and for some PFTs at least one adjacent grid 
+!! box exists for expansion), new saplings are introduced for narural PFT. In the simulation of 
+!! agricultural grassland, if target PFT does not exist in the gridbox, it is introduced 
+!! regardless of climate condition. When a new PFT is introduced CO_2 is taken from the
+!! atmosphere to account for CO_2 present in the seed and required by the germinated seeds
+!! to establish a sapling. These initial phases in ontology are not accounted for. However,
+!! by taking this small amount of CO2 from the atmosphere, mass balance closure for C is
+!! preserved. 
+!!
+!! PFTs are eliminated under the condition that they are no longer adapted to the critical 
+!! temperatures in winter. When a PFT is eliminated its number of indiviuals is set to zero and
+!! the rest of the elimination process is taken care of in lpj_kill.f90.
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: avail_tree (space availability for trees, unitless),   
+!! :: avail_grass (space availability for grasses, unitless), :: biomass (biomass, \f$gC m^{-2}\f$) 
+!! and :: ind (density of individuals, \f$m^{-2}\f$)    
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    :
+!! \latexonly
+!!   \includegraphics[scale = 0.6]{pftinout.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+
+
+
+
+
+  SUBROUTINE pftinout (npts, dt, adapted, regenerate, &
+       neighbours, veget_max, &
+       biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, &
+       PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, &
+       co2_to_bm, n_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,NbNeighb), INTENT(in)      :: neighbours      !! Indices of the 8 neighbours of each grid point
+                                                                                 !! (unitless); 1=North and then clockwise.
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget_max       !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                                 !! infinity) on ground (unitless)        
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: avail_tree      !! Space availability for trees (unitless)   
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: avail_grass     !! Space availability for grasses (unitless)      
+
+
+    !! 0.3 Modified variables   
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass  !! Biomass (gC m^{-2})      
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! Density of individuals (m^{-2})
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: cn_ind          !! Crown area of individuals (m^2)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age             !! Mean age (years)            
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! Fraction of leaves in leaf age class (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm    !! "long term" net primary productivity 
+                                                                                 !! (gC m^{-2} year^{-1})   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: lm_lastyearmax  !! Last year's maximum leaf mass, for each PFT 
+                                                                                 !! (gC m^{-2})  
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: senescence      !! Plant senescent for deciduous trees; .FALSE. 
+                                                                                 !! if PFT is introduced or killed      
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent      !! PFT exists    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! is the PFT everywhere in the grid box or very 
+                                                                                 !! localized (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit !! how many days ago was the beginning of the 
+                                                                                 !! growing season (days) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: need_adjacent   !! in order for this PFT to be introduced, does it
+                                                                                 !! have to be present in an adjacent grid box?   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: RIP_time        !! How much time ago was the PFT eliminated for 
+                                                                                 !! the last time (years)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm       !! C biomass uptaken (gC m^{-2} day^{-1})   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: n_to_bm       !! N biomass uptaken (gN m^{-2} day^{-1})   
+ 
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                              :: avail           !! availability           
+    INTEGER(i_std)                                            :: i,j,m           !! indices      
+    REAL(r_std), DIMENSION(npts)                              :: sumfrac_wood    !! total woody vegetation cover     
+    INTEGER(i_std), DIMENSION(npts)                           :: n_present       !! number of adjacent grid cells where PFT is 
+                                                                                 !! ubiquitous        
+    LOGICAL, DIMENSION(npts)                                  :: can_introduce   !! we can introduce this PFT    
+    REAL(r_std), DIMENSION(npts)                              :: fracnat         !! no real need for dimension(ntps) except for 
+                                                                                 !! vectorisation          
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering pftinout'
+
+  !! 1. Messages    
+
+    IF ( firstcall_pftinout ) THEN
+
+       WRITE(numout,*) 'pftinout: Minimum space availability: ', min_avail
+
+       firstcall_pftinout = .FALSE.
+
+    ENDIF
+
+  !! 2. Total woody fpc and space avaibility on grid
+
+    ! Only natural part of the grid cell\n
+    ! S. Zaehle bug correction MERGE: need to subtract agricultural area!
+    ! fraction of agricultural surface
+
+    !! 2.1 only natural PFT
+    fracnat(:) = un
+    DO j = 2,nvm ! Loop over # PFTs
+       IF ( .NOT. natural(j) ) THEN
+          fracnat(:) = fracnat(:) - veget_max(:,j)
+       ENDIF
+    ENDDO ! Loop over # PFTs
+
+    !! 2.2 Total woody fractional plant cover
+    sumfrac_wood(:) = zero
+    DO j = 2,nvm ! Loop over # PFTs
+       ! S. Zaehle problem here: agriculture, not convinced that this representation of LPJ is correct
+       ! if agriculture is present, ind must be recalculated to correspond to the natural density...
+       ! since ind is per grid cell, can be achived by discounting for agricultura fraction
+       IF ( natural(j).AND.is_tree(j) ) THEN
+          WHERE(fracnat(:).GT.min_stomate) 
+                sumfrac_wood(:) = sumfrac_wood(:) + cn_ind(:,j) * ind(:,j) / fracnat(:) & 
+                     * ( un - exp( - biomass_to_lai(lm_lastyearmax(:,j),npts,j) * ext_coeff(j) ) )
+                !lai changed to lm_last
+          ENDWHERE
+       ENDIF
+    ENDDO ! Loop over # PFTs
+
+    !! 2.3 Space availability
+    avail_grass(:) = MAX( ( un - sumfrac_wood(:) ), min_avail )
+    avail_tree(:) = MAX( ( fpc_crit - sumfrac_wood(:) ), min_avail )
+
+  !! 3. Time since last elimination (y)
+
+    RIP_time = RIP_time + dt / one_year
+
+  !! 4. Agicultural PFTs
+
+    ! Agricultural PFTs are only present if they are prescribed
+    DO j = 2,nvm ! Loop over # PFTs
+       
+       IF ( .NOT. natural(j) ) THEN
+          
+          IF (printlev>=4) WRITE(numout,*) 'pftinout: Agricultural PFTs'
+          
+          !! 4.1 Agricultural trees
+          !      Agricultural trees are not treated for the moment
+          IF ( is_tree(j) ) THEN
+
+             CALL ipslerr_p(3,'pftinout','Agricultural trees not treated.','','')
+
+          !! 4.2 Initialization of agricultural grass lands
+          !      Initialize parameter values of prescribed agricultural PFTs
+          ELSE
+
+             DO i = 1, npts ! Loop over # pixels - domain size
+
+                IF ( ( veget_max(i,j) .GT. min_stomate ) .AND. ( .NOT. PFTpresent(i,j) ) ) THEN
+
+                   ! prescribed, but not yet there.
+                   ind(i,j) = veget_max(i,j)
+                   biomass(i,j,:,:) = bm_sapl(j,:,:) * ind(i,j) /veget_max(i,j) 
+                   co2_to_bm(i,j) =  co2_to_bm(i,j) +SUM( biomass(i,j,:,icarbon) ) / dt
+                   n_to_bm(i,j) =  n_to_bm(i,j) +SUM( biomass(i,j,:,initrogen) ) / dt
+                   PFTpresent(i,j) = .TRUE.
+                   everywhere(i,j) = un
+                   senescence(i,j) = .FALSE.
+                   age(i,j) = zero
+
+                ENDIF  ! prescribed, but PFT not yet present
+
+             ENDDO ! Loop over # pixels - domain size
+
+          ENDIF
+
+       ENDIF ! not natural
+
+    ENDDO ! Loop over # PFTs
+
+  !! 5 Eliminate PFTs
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       ! only for natural PFTs
+       IF ( natural(j) ) THEN
+
+          ! Number of individuals are set to zero in the condition of cold winter   
+          ! 'adapted_crit' critical value for being adapted = 1.-(1./euler); see 'stomate_constants.f90'
+          WHERE (  PFTpresent(:,j) .AND. ( adapted(:,j) .LT. adapted_crit ) )
+
+             ! PFT there, but not adapted any more (ex: winter too cold): kill
+             ! set number of individuals to zero - rest will be done in lpj_kill
+             ind(:,j) = zero
+
+          ENDWHERE
+
+       ENDIF ! natural
+
+    ENDDO ! Loop over # PFTs
+
+  !! 6. Introduce PFTs
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN
+
+          ! space availability for this PFT
+          IF ( is_tree(j) ) THEN
+             avail(:) = avail_tree(:)
+          ELSE
+             avail(:) = avail_grass(:)
+          ENDIF
+          
+          !! 6.1 Check if PFT not present but (adapted and regenerative)     
+          can_introduce(:) = .FALSE.
+          
+          IF ( NbNeighb /= 8 ) THEN
+             CALL ipslerr(3, "pftinout", "This routine needs to be adapted to non rectengular grids", &
+                  &           "Talk to Jan Polcher", " ")
+          ENDIF
+
+          DO i = 1, npts ! Loop over # pixels - domain size
+
+             IF ( .NOT. PFTpresent(i,j) .AND. &
+                  ( adapted(i,j) .GT. adapted_crit ) .AND. &
+                  ( regenerate(i,j) .GT. regenerate_crit )  ) THEN
+
+                ! Seed are available nearby
+                IF ( need_adjacent(i,j) ) THEN
+
+                   !! 6.1.1 Climate allows introduction of the PFT but dispersion requires the 
+                   !        presence of seeds. Seed are considered available if at least one
+                   !        neighbouring pixel is entirely invaded by the PFT. If that condition is
+                   !        satisfied, the PFT can establish in the new pixel.
+                   ! Count number of totally invaded neighbours.
+                   ! no loop so that it can vectorize
+                   n_present(i) = 0
+                   IF ( neighbours(i,1) .GT. 0 ) THEN
+                      IF ( everywhere(neighbours(i,1),j) .GE. un-min_stomate ) THEN
+                         n_present(i) = n_present(i)+1
+                      ENDIF
+                   ENDIF
+                   IF ( neighbours(i,3) .GT. 0 ) THEN
+                      IF ( everywhere(neighbours(i,3),j) .GE. un-min_stomate ) THEN
+                         n_present(i) = n_present(i)+1
+                      ENDIF
+                   ENDIF
+                   IF ( neighbours(i,5) .GT. 0 ) THEN
+                      IF ( everywhere(neighbours(i,5),j) .GE. un-min_stomate ) THEN
+                         n_present(i) = n_present(i)+1
+                      ENDIF
+                   ENDIF
+                   IF ( neighbours(i,7) .GT. 0 ) THEN
+                      IF ( everywhere(neighbours(i,7),j) .GE. un-min_stomate ) THEN
+                         n_present(i) = n_present(i)+1
+                      ENDIF
+                   ENDIF
+
+                   IF ( n_present(i) .GT. 0 ) THEN
+
+                      ! PFT is ubiquitous in at least one adjacent grid box
+                      can_introduce(i) = .TRUE.
+
+                   ENDIF
+
+                ELSE
+
+                   !! 6.1.2 No seed (trees) required for dispersion
+                   !        The PFT can establish without the presence of seed trees in 
+                   !        neighbouring pixels.
+                   can_introduce(i) = .TRUE.
+
+                ENDIF ! do we have to look at the neighbours?
+
+             ENDIF ! we'd like to introduce the PFT
+
+          ENDDO ! Loop over # pixels - domain size 
+
+          !! 6.2 Has the PFT been eliminated lately?
+          !      Additional test whether the PFT has been eliminated lately, i.e.
+          !      less than 1.25 years ago. Do not only take full years as success of
+          !      introduction, as introduction might depend on season.
+          WHERE ( RIP_time(:,j) .LT. RIP_time_min )
+
+             ! PFT was eliminated lately - cannot reintroduce
+             can_introduce(:) = .FALSE.
+
+          ENDWHERE
+
+          !! 6.3 Introduce that PFT where possible
+          !      "can_introduce" means that it either exists in neighbouring grid boxes 
+          !      or that we do not look at neighbours, that it has not been eliminated 
+          !      lately, and, of course, that the climate is good for that PFT.
+          WHERE ( can_introduce(:) )
+             
+             PFTpresent(:,j) = .TRUE.
+             
+             senescence(:,j) = .FALSE.
+             
+             ! introduce at least a few saplings, even if canopy is closed
+             ! initial density of individuals (ind_0) = 0.02, see 'stomate_constant.f90'
+             ind(:,j) = ind_0 * (dt/one_year) * avail(:)
+             
+             WHERE(veget_max(:,j) .GT. min_stomate)
+                biomass(:,j,ileaf,icarbon) = bm_sapl(j,ileaf,icarbon) * ind(:,j) /veget_max(:,j)
+                biomass(:,j,isapabove,icarbon) = bm_sapl(j,isapabove,icarbon) * ind(:,j) /veget_max(:,j)
+                biomass(:,j,isapbelow,icarbon) = bm_sapl(j,isapbelow,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iheartabove,icarbon) = bm_sapl(j,iheartabove,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iheartbelow,icarbon) = bm_sapl(j,iheartbelow,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iroot,icarbon) = bm_sapl(j,iroot,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,ifruit,icarbon) = bm_sapl(j,ifruit,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,icarbres,icarbon) = bm_sapl(j,icarbres,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,ilabile,icarbon) = bm_sapl(j,ilabile,icarbon) * ind(:,j)/veget_max(:,j)
+
+                biomass(:,j,ileaf,initrogen) = bm_sapl(j,ileaf,initrogen) * ind(:,j) /veget_max(:,j)
+                biomass(:,j,isapabove,initrogen) = bm_sapl(j,isapabove,initrogen) * ind(:,j) /veget_max(:,j)
+                biomass(:,j,isapbelow,initrogen) = bm_sapl(j,isapbelow,initrogen) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iheartabove,initrogen) = bm_sapl(j,iheartabove,initrogen) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iheartbelow,initrogen) = bm_sapl(j,iheartbelow,initrogen) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iroot,initrogen) = bm_sapl(j,iroot,initrogen) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,ifruit,initrogen) = bm_sapl(j,ifruit,initrogen) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,icarbres,initrogen) = bm_sapl(j,icarbres,initrogen) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,ilabile,initrogen) = bm_sapl(j,ilabile,initrogen) * ind(:,j)/veget_max(:,j)
+             ELSEWHERE              
+                biomass(:,j,ileaf,icarbon) = bm_sapl(j,ileaf,icarbon) * ind(:,j)
+                biomass(:,j,isapabove,icarbon) = bm_sapl(j,isapabove,icarbon) * ind(:,j)
+                biomass(:,j,isapbelow,icarbon) = bm_sapl(j,isapbelow,icarbon) * ind(:,j)
+                biomass(:,j,iheartabove,icarbon) = bm_sapl(j,iheartabove,icarbon) * ind(:,j)
+                biomass(:,j,iheartbelow,icarbon) = bm_sapl(j,iheartbelow,icarbon) * ind(:,j)
+                biomass(:,j,iroot,icarbon) = bm_sapl(j,iroot,icarbon) * ind(:,j)
+                biomass(:,j,ifruit,icarbon) = bm_sapl(j,ifruit,icarbon) * ind(:,j)
+                biomass(:,j,icarbres,icarbon) = bm_sapl(j,icarbres,icarbon) * ind(:,j)
+                biomass(:,j,ilabile,icarbon) = bm_sapl(j,ilabile,icarbon) * ind(:,j) 
+
+                biomass(:,j,ileaf,initrogen) = bm_sapl(j,ileaf,initrogen) * ind(:,j)
+                biomass(:,j,isapabove,initrogen) = bm_sapl(j,isapabove,initrogen) * ind(:,j)
+                biomass(:,j,isapbelow,initrogen) = bm_sapl(j,isapbelow,initrogen) * ind(:,j)
+                biomass(:,j,iheartabove,initrogen) = bm_sapl(j,iheartabove,initrogen) * ind(:,j)
+                biomass(:,j,iheartbelow,initrogen) = bm_sapl(j,iheartbelow,initrogen) * ind(:,j)
+                biomass(:,j,iroot,initrogen) = bm_sapl(j,iroot,initrogen) * ind(:,j)
+                biomass(:,j,ifruit,initrogen) = bm_sapl(j,ifruit,initrogen) * ind(:,j)
+                biomass(:,j,icarbres,initrogen) = bm_sapl(j,icarbres,initrogen) * ind(:,j)
+                biomass(:,j,ilabile,initrogen) = bm_sapl(j,ilabile,initrogen) * ind(:,j) 
+             END WHERE
+            
+             co2_to_bm(:,j) = &
+                  co2_to_bm(:,j) +  &
+                  ( biomass(:,j,ileaf,icarbon) + biomass(:,j,isapabove,icarbon) + &
+                  biomass(:,j,isapbelow,icarbon) + biomass(:,j,iheartabove,icarbon) + &
+                  biomass(:,j,iheartbelow,icarbon) + biomass(:,j,iroot,icarbon) + &
+                  biomass(:,j,ifruit,icarbon) + biomass(:,j,icarbres,icarbon)+ &
+                  biomass(:,j,ilabile,icarbon) )/dt
+
+             n_to_bm(:,j) = &
+                  n_to_bm(:,j) +  &
+                  ( biomass(:,j,ileaf,initrogen) + biomass(:,j,isapabove,initrogen) + &
+                  biomass(:,j,isapbelow,initrogen) + biomass(:,j,iheartabove,initrogen) + &
+                  biomass(:,j,iheartbelow,initrogen) + biomass(:,j,iroot,initrogen) + &
+                  biomass(:,j,ifruit,initrogen) + biomass(:,j,icarbres,initrogen)+ &
+                  biomass(:,j,ilabile,initrogen) )/dt
+
+             when_growthinit(:,j) = large_value
+
+             age(:,j) = zero
+
+             ! all leaves are young
+             leaf_frac(:,j,1) = un
+
+             ! non-zero "long term" npp and last year's leaf mass for saplings -
+             ! so they won't be killed off by gap or kill
+             npp_longterm(:,j) = npp_longterm_init
+
+             lm_lastyearmax(:,j) = bm_sapl(j,ileaf,icarbon) * ind(:,j)
+
+          ENDWHERE    ! we can introduce the PFT
+
+          !! 6.4 Expansion of the PFT within the grid box 
+          !      PFT expansion/dispersion to a new grid box should not be confused with 
+          !      expansion in areal coverage
+          IF ( treat_expansion ) THEN
+
+             WHERE ( can_introduce(:) )
+
+                ! low value at the beginning
+                everywhere(:,j) = everywhere_init
+             ENDWHERE
+
+          ELSE
+
+             ! expansion is not treated
+             WHERE ( can_introduce(:) )
+                everywhere(:,j) = un
+             ENDWHERE
+
+          ENDIF ! treat expansion
+
+       ENDIF ! only natural PFTs
+
+    ENDDO ! Loop over # PFTs
+
+  !! 7. If a PFT has been present once in a grid box, we suppose that it will survive
+
+    !   If a PFT has been present once in a grid box, we suppose that it will survive
+    !   in isolated places (e.g., an oasis) within that grid box, even if it gets
+    !   officially eliminated from it later. That means that if climate becomes favorable
+    !   again, it will not need to get seeds from adjacent grid cells.
+    WHERE ( PFTpresent )
+       need_adjacent = .FALSE.
+    ENDWHERE
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving pftinout'
+
+  END SUBROUTINE pftinout
+
+END MODULE lpj_pftinout
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_agriculture.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_agriculture.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_agriculture.f90	(revision 6412)
@@ -0,0 +1,512 @@
+! ================================================================================================================================
+! MODULE       : sapiens_agriculture
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Simple approach to harvesting croplands
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-DOFOCO/ORCHIDEE/src_stomate/stomate_lpj.f90 $
+!! $Date: 2013-08-28 16:34:04 +0200 (Wed, 28 Aug 2013) $
+!! $Revision: 1438 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE sapiens_agriculture
+
+  ! modules used:
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+  USE function_library,    ONLY: cc_to_biomass
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC crop_planting, crop_harvest
+
+  ! Variable declaration 
+
+  LOGICAL, SAVE             :: firstcall = .TRUE.                !! first call flag
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+
+  !! ================================================================================================================================
+  !! SUBROUTINE   : crop_planting
+  !!
+  !>\BRIEF        Plant croplands
+  !!
+  !! DESCRIPTION  : Plant the crops when the weather is suitable. Uses begin_leaves to decide
+  !! when to plant a crop. To be used within the DOFOCO branch.
+  !!
+  !! RECENT CHANGE(S) : 
+  !!
+  !! MAIN OUTPUT VARIABLE(S): 
+  !!
+  !! REFERENCE(S) :
+  !!
+  !! FLOWCHART    : None
+  !! \n
+  !_ =============================================================================================================================
+
+  SUBROUTINE crop_planting(npts, dt, ipts, ivm, &
+       veget_cov_max, PFTpresent, c0_alloc, when_growthinit, &
+!!$       time_hum_min, everywhere, plant_status, ind, &
+       time_hum_min, everywhere, plant_status, &
+       circ_class_n, KF, leaf_frac, age, &
+!!$       npp_longterm, lm_lastyearmax, biomass, circ_class_biomass, &
+       npp_longterm, lm_lastyearmax, circ_class_biomass, &
+       atm_to_bm, k_latosa_adapt)
+
+
+  !! 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)                         :: ipts                 !! specific pixel to plant (unitless)
+    INTEGER(i_std), INTENT(in)                         :: ivm                  !! specific pft to plant in the specific pixel
+                                                                               !! (unitless)
+    REAL(r_std), INTENT(in)                            :: dt                   !! time step (dt_days)  
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: veget_cov_max            !! "maximal" coverage fraction of a 
+                                                                               !! PFT (LAI -> infinity) on ground 
+                                                                               !! (0-1, unitless)
+    REAL(r_std), INTENT(in)                            :: c0_alloc             !! Root to sapwood tradeoff parameter
+
+
+  !! 0.2 Ouput variables
+
+
+  !! 0.3 Modified variables
+    
+    LOGICAL, DIMENSION(:,:), INTENT(inout)             :: PFTpresent           !! PFT exists (true/false)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: plant_status         !! Growth and phenological status of the plant
+                                                                               !! Different stati are listed in constantes_var 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: when_growthinit      !! how many days since the 
+                                                                               !! beginning of the growing season (days) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: time_hum_min         !! time elapsed since strongest 
+                                                                               !! moisture availability (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: everywhere           !! is the PFT everywhere in the grid box or 
+                                                                               !! very localized (after its introduction) (?)
+!!$    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ind                  !! Stand level number of individuals
+!!$                                                                               !! @tex $(ind m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: circ_class_n         !! Number of individuals in each circ class
+                                                                               !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: KF                   !! Scaling factor to convert sapwood mass
+                                                                               !! into leaf mass (m)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: k_latosa_adapt       !! Leaf to sapwood area adapted for long 
+                                                                               !! term water stress (m)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: leaf_frac            !! fraction of leaves in leaf age 
+                                                                               !! class (0-1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: age                  !! mean age (years)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: npp_longterm         !! "long term" net primary productivity
+                                                                               !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: lm_lastyearmax       !! last year's maximum leaf mass for each PFT 
+                                                                               !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: atm_to_bm            !! co2 taken up by carbohydrate 
+                                                                               !! reserve at the beginning of the 
+                                                                               !! growing season @tex ($gC m^{-2} 
+                                                                               !! of total ground/day$) @endtex
+!!$    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: biomass              !! biomass @tex ($gC m^{-2} of 
+!!$                                                                               !! ground$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)   :: circ_class_biomass   !! Biomass components of the model tree  
+                                                                               !! within a circumference class
+                                                                               !! class @tex $(g C ind^{-1})$ @endtex
+    
+  !! 0.4 Local variables
+    
+    REAL(r_std), DIMENSION(npts,nvm)                   :: LF                   !! Scaling factor to convert sapwood mass
+                                                                               !! into root mass (unitless)
+    REAL(r_std), DIMENSION(npts,nvm)                   :: k_latosa             !! Height dependent base value to calculate 
+                                                                               !! KF (-) 
+    REAL(r_std), DIMENSION(npts,nvm)                   :: histvar              !! controls the history output 
+                                                                               !! level - 0: nothing is written; 
+                                                                               !! 10: everything is written 
+                                                                               !! (0-10, unitless)
+    REAL(r_std), DIMENSION(npts,nvm)                   :: lstress_fac          !! Light stress factor, based on total
+                                                                               !! transmitted light (unitless, 0-1)
+    REAL(r_std)                                        :: Cs_grass             !! Individual plant, sapwood compartment
+                                                                               !! @tex $(gC. ind^{-1})$ @endtex
+    REAL(r_std)                                        :: Cl_init              !! Initial leaf carbon required to start
+                                                                               !! the growing season
+                                                                               !! @tex $(gC tree^{-1})$ @endtex
+    REAL(r_std)                                        :: Cr_init              !! Initial root carbon required to start
+                                                                               !! the growing season
+                                                                               !! @tex $(gC tree^{-1})$ @endtex
+                                                                               !! relationships (m) 
+    INTEGER(i_std)                                     :: iele                 !! index (unitless)
+!!$    REAL(r_std)                                        :: ind                  !! Density of individuals at the stand level 
+!!$                                                                               !! @tex $(m^{-2})$ @endtex
+!!$    REAL(r_std), DIMENSION(nparts,nelements)           :: biomass              !! Stand level biomass 
+!!$                                                                               !! tex $(gC.m^{-2})$ @endtex
+
+    !++++ temp ++++                                                            
+    REAL(r_std)                                        :: cn_leaf,cn_root,cn_wood !! C/N ratio of leaves, root and wood pool
+                                                                               !! (gC/gN)
+     
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering sapiens_crop_planting'
+
+    !! Initialize local printlev
+    !printlev_loc=get_printlev('crop_planting')
+
+    IF ( veget_cov_max(ipts,ivm) .GT. min_stomate .AND. &
+         SUM(circ_class_n(ipts,ivm,:)) .LT. min_stomate) THEN
+
+       !! 1. Prescribe the crops
+ 
+       ! Prescribe the crops - should move to an agricultural routine
+       ! Lightstress varies from 0 to 1 and is calculated from the canopy structure (veget)
+       ! Given that there is no vegetation at this point, the lightstress cannot be 
+       ! calculated and is set to 1. However as soon as we grow a canopy it will 
+       ! experience light stress and so KF should be adjusted. If this is not done, we 
+       ! can't prescribe tall vegetation which is a useful feature to speed up 
+       ! optimisation and testing. We will have iterate over light stress and KF to 
+       ! prescribe vegetation that is in balance with its light environment. 
+       lstress_fac(ipts,ivm) = un
+
+       ! For crops we assume that an individual crop is 1 m2 of crop. This is set
+       ! in nmaxtrees in pft_parameters.f90. It could be set to another value but 
+       ! with the current code this should not have any meaning. The cropland
+       ! does not necessarily covers the whole 1 m2 so adjust for the canopy cover
+       circ_class_n(ipts,ivm,1) = nmaxtrees(ivm) * ha_to_m2 * canopy_cover(ivm)
+       
+       ! Now we generate the size of a single crop sapling. We do not deal with 
+       ! circumference classes for crops, but we want to keep the arrays the 
+       ! same as for the trees so we put the sapling information into the first 
+       ! circumference class
+
+       ! Calculate the sapwood to leaf mass in a similar way as has been done for trees.
+       ! For trees this approach had been justified by observations. For crops such
+       ! justification is not supported by observations but we didn't try to find it.
+       ! Needs more work by someone interested in crops. There might be a more elegant
+       ! solution making use of a well observed parameter. 
+       k_latosa(ipts,ivm) = (k_latosa_adapt(ipts,ivm) + (lstress_fac(ipts,ivm) * &
+            (k_latosa_max(ivm)-k_latosa_min(ivm))))
+
+       ! The mass of the structural carbon relates to the mass of the leaves through
+       ! a prescribed parameter ::k_latosa
+       KF(ipts,ivm) = k_latosa(ipts,ivm)
+
+       ! Calculate leaf to root area 
+       LF(ipts,ivm) = c0_alloc * KF(ipts,ivm)
+
+       !---TEMP---
+       IF(printlev_loc>=4 .AND. test_pft == ivm)THEN
+          WRITE(numout,*) 'KF, ', k_latosa(ipts,ivm), KF(ipts,ivm)
+          WRITE(numout,*) 'LF, c0_alloc, ', c0_alloc * KF(ipts,ivm), &
+               c0_alloc
+       ENDIF
+       !----------
+
+       ! initialize everything to make sure there are not random values floating around
+       ! for ncirc = 1
+       circ_class_biomass(ipts,ivm,:,:,:) = zero
+       circ_class_biomass(ipts,ivm,1,:,:) = val_exp
+       
+       ! Similar as for trees, the initial height of the vegetation can be calculated 
+       ! from prescribed parameters
+       circ_class_biomass(ipts,ivm,1,ileaf,icarbon) = height_init_min(ivm) / &
+            lai_to_height(ivm) / sla(ivm)
+       
+       ! Use allometric relationships to define the root mass based on leaf mass. Some 
+       ! sapwood mass is needed to store the reserves.
+       circ_class_biomass(ipts,ivm,1,iroot,icarbon) = &
+            circ_class_biomass(ipts,ivm,1,ileaf,icarbon) / LF(ipts,ivm)
+       circ_class_biomass(ipts,ivm,1,isapabove,icarbon) = &
+            circ_class_biomass(ipts,ivm,1,ileaf,icarbon) / KF(ipts,ivm)
+
+       ! Pools that are defined in the same way for trees and grasses      
+       circ_class_biomass(ipts,ivm,1,ilabile,icarbon) = labile_to_total * &
+            ( circ_class_biomass(ipts,ivm,1,ileaf,icarbon) + &
+            fcn_root(ivm) *  circ_class_biomass(ipts,ivm,1,iroot,icarbon) + &
+            fcn_wood(ivm) * ( circ_class_biomass(ipts,ivm,1,isapabove,icarbon) +  &
+            circ_class_biomass(ipts,ivm,1,isapbelow,icarbon) + &
+            circ_class_biomass(ipts,ivm,1,icarbres,icarbon)))
+       
+       ! Allocate the required N for the phenological growth
+       ! Similar as to the carbon this is taken from the atmosphere
+       ! That is dealt with later in the code.
+       ! Calculate the C/N ratio
+       cn_leaf=cn_leaf_init(ivm)
+       cn_wood=cn_leaf/fcn_wood(ivm)
+       cn_root=cn_leaf/fcn_root(ivm) 
+       
+       ! Use the C/N ratio to calculate the N content for
+       ! all the biomass components.
+       circ_class_biomass(ipts,ivm,1,:,initrogen) = &
+            circ_class_biomass(ipts,ivm,1,:,icarbon) / cn_root
+
+       ! Overwrite the N content for the leaves and wood
+       ! components.
+       circ_class_biomass(ipts,ivm,1,ileaf,initrogen) = &
+            circ_class_biomass(ipts,ivm,1,ileaf,icarbon) / cn_leaf
+       circ_class_biomass(ipts,ivm,1,isapabove,initrogen) = &
+            circ_class_biomass(ipts,ivm,1,isapabove,icarbon) / cn_wood
+      
+       ! Some of the biomass components that exist for trees are undefined for grasses
+       circ_class_biomass(ipts,ivm,1,isapbelow,:) = zero
+       circ_class_biomass(ipts,ivm,1,iheartabove,:) = zero
+       circ_class_biomass(ipts,ivm,1,iheartbelow,:) = zero
+       circ_class_biomass(ipts,ivm,1,ifruit,:) = zero
+       circ_class_biomass(ipts,ivm,1,icarbres,:) = zero     
+            
+       ! Write initial values
+       IF (printlev_loc>=4) THEN
+          WRITE(numout,*) 'Crop prescribed biomass, carbon ', &
+               circ_class_biomass(ipts,ivm,1,:,icarbon)
+          WRITE(numout,*) 'Crop prescribed biomass, nitrogen ', &
+               circ_class_biomass(ipts,ivm,1,:,initrogen)
+       ENDIF
+
+!!$       ! Initial biomass (g C m-2)
+!!$       biomass(ipts,ivm,:,:) = circ_class_biomass(ipts,ivm,1,:,:) * &
+!!$            ind(ipts,ivm)
+       
+!!$       ! Synchronize biomass and circ_class_biomass (gC tree-1). This 
+!!$       ! allows to more easily check the mass balance closure
+!!$       circ_class_n(ipts,ivm,1) = ind(ipts,ivm)
+       
+       ! Set leaf age classes -> all leaves will be current year leaves
+       leaf_frac(ipts,ivm,:) = zero
+       leaf_frac(ipts,ivm,1) = un
+       
+       ! Set time since last beginning of growing season but only
+       ! for the first day of the whole simulation. When the model
+       ! is initialized when_growthinit is set to undef. In subsequent
+       ! time steps it should have a value.
+       IF (when_growthinit(ipts,ivm) .EQ. undef) THEN
+          when_growthinit(ipts,ivm) = 200
+          time_hum_min(ipts,ivm) = 200
+       ENDIF
+       
+       ! The biomass to build the saplings is taken from the atmosphere, keep track of
+       ! amount to calculate the C-balance closure
+       atm_to_bm(ipts,ivm,:) = atm_to_bm(ipts,ivm,:) + &
+                        (SUM(cc_to_biomass(npts, ivm, &
+                        circ_class_biomass(ipts,ivm,:,:,:), &
+                        circ_class_n(ipts,ivm,:)),1) / dt )
+
+!!$       DO iele = 1,nelements
+!!$
+!!$          atm_to_bm(ipts,ivm,iele) = atm_to_bm(ipts,ivm,iele) + &
+!!$               ( SUM(biomass(ipts,ivm,:,iele))  / dt )
+!!$
+!!$       ENDDO
+
+       !! 2.3 Declare PFT present 
+       !! Now that the PFT has biomass it should be declared 'present'
+       !! everywhere in that grid box. Assign some additional properties
+       PFTpresent(ipts,ivm) = .TRUE.
+       everywhere(ipts,ivm) = un
+       age(ipts,ivm) = zero
+       npp_longterm(ipts,ivm) = npp_longterm_init
+       lm_lastyearmax(ipts,ivm) = zero
+
+       !! 4.3 reset when_growthinit counter: start of the growing season
+       when_growthinit(ipts,ivm) = zero
+       plant_status(ipts,ivm) = icanopy
+
+    ! PFT is not present, initialize the variables
+    ELSE
+
+       ! At the tree level
+       circ_class_n(ipts,ivm,:) = zero
+       circ_class_biomass(ipts,ivm,:,:,:) = zero
+       
+!!$       ! At the stand level
+!!$       biomass(ipts,ivm,:,:) = zero
+!!$       ind(ipts,ivm) = zero
+       
+    ENDIF ! veget_cov_max gt min_stomate
+
+    IF (printlev_loc>=4) WRITE(numout,*) 'Leaving sapiens_crop_planting'
+
+  END SUBROUTINE crop_planting
+
+
+  !! ================================================================================================================================
+  !! SUBROUTINE   : crop_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 turnover. To be used 
+  !! within the DOFOCO branch.
+  !!
+  !! RECENT CHANGE(S) : Harvest is stored in harvest_pool for further 
+  !! modelling of product use 
+  !!
+  !! MAIN OUTPUT VARIABLE(S): ::harvest_pool
+  !!
+  !! 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 crop_harvest(npts, ipts, ivm, dt_days, &
+       veget_cov_max, turnover, harvest_pool, harvest_type, &
+       harvest_cut, harvest_area, resolution, circ_class_biomass, &
+       circ_class_n, leaf_meanage) 
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                :: npts            !! Domain size (unitless)
+    INTEGER(i_std), INTENT(in)                         :: ipts            !! specific pixel to plant (unitless)
+    INTEGER(i_std), INTENT(in)                         :: ivm             !! specific pft to plant in the specific pixel
+                                                                          !! (unitless)
+    REAL(r_std), INTENT(in)                            :: dt_days         !! Time step (days)
+    REAL(r_std),DIMENSION(npts,2), INTENT(in)          :: resolution      !! The length in m of each grid-box in X and Y
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)       :: veget_cov_max       !! Fraction of the pixel covered by a PFT 
+                                                                          !! @tex $(m^2 m^{-2})$ @endtex
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)    :: circ_class_biomass          !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:),INTENT(inout)     :: turnover         !! Turnover rates 
+                                                                          !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)    :: harvest_pool     !! The wood and biomass that have been
+                                                                          !! havested by humans @tex $(gC)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: harvest_type     !! Type of management that resulted
+                                                                          !! in the harvest (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: harvest_cut      !! Type of cutting that was used for the harvest
+                                                                          !! (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: harvest_area     !! Harvested area (m^{2})
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)        :: circ_class_n              !! Density of individuals 
+                                                                          !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: leaf_meanage     !! mean age of the leaves (days)
+
+
+    !! 0.4 Local variables
+               
+    REAL(r_std)                                       :: pixel_area       !! surface area of the pixel @tex ($m^{2}$) @endtex
+
+ !_ ================================================================================================================================
+
+    IF(printlev>=3) WRITE(numout,*) 'Entering sapiens_crop_harvest'
+
+    !! 1.1 Initialize local printlev
+    !printlev_loc=get_printlev('crop_harvest')
+    
+    !! 1. Initialize
+    !  Reset harvest pool
+    IF(printlev>=4 .AND. ipts == test_grid .AND. ivm == test_pft)THEN
+       WRITE(numout,*) "Entering the crop_harvest routine: ", &
+            harvest_pool(ipts,ivm,:,:)
+    ENDIF
+
+    ! We should not reset!  Sometimes there is harvest in the harvest 
+    ! pool, and our mass balance will not be closed if we eliminate it 
+    ! here. It seems possible that we hit senesence twice in a single 
+    ! year. This happened on a grid point near the equator.
+    ! harvest_pool(ipts,ivm,:,:) = zero
+
+    !  Surface area (m2) of the pixel
+    pixel_area = resolution(ipts,1) * resolution(ipts,2)
+   
+
+    !! 2. Harvest croplands
+
+    ! NOTE that this is a quick fix rather than a final solution. The turnover
+    ! of crop biomass has for long be calculated and was assumed to entirely 
+    ! return to the litter pools. This approach ignored crop harvest. Rather 
+    ! than harvesting the aboveground biomass (or below ground for some
+    ! crops i.e. potatoes, beet, etc which is currently not accounted for) this
+    ! routine makes use of the turnover and diverts part of the turnover into 
+    ! the harvest pool. By doing so it does not end up in the litter.
+
+    ! Assume all aboveground biomass is harvested and put it all in the first 
+    ! diameter class.
+    harvest_pool(ipts,ivm,1,:) = harvest_pool(ipts,ivm,1,:) + &
+         harvest_ratio(ivm) * circ_class_n(ipts,ivm,1) *( circ_class_biomass(ipts,ivm,1,ileaf,:) + &
+         circ_class_biomass(ipts,ivm,1,icarbres,:) + circ_class_biomass(ipts,ivm,1,ilabile,:) + &
+         circ_class_biomass(ipts,ivm,1,ifruit,:) + circ_class_biomass(ipts,ivm,1,isapabove,:)) * &
+         veget_cov_max(ipts,ivm) * pixel_area
+
+    ! Associated harvest variables
+    harvest_type(ipts,ivm) = ifm_crop
+    harvest_cut(ipts,ivm) = icut_crop
+    harvest_area(ipts,ivm) = veget_cov_max(ipts,ivm) * pixel_area
+
+    ! The belowground becomes litter. All roots remain on site. 
+    ! Half (::harvest_ratio) of the other biomas pools was harvested.
+    turnover(ipts,ivm,iroot,:) = turnover(ipts,ivm,iroot,:) + &
+         circ_class_biomass(ipts,ivm,1,iroot,:)*circ_class_n(ipts,ivm,1)
+    turnover(ipts,ivm,ileaf,:) = turnover(ipts,ivm,ileaf,:) + &
+         (un - harvest_ratio(ivm)) * circ_class_biomass(ipts,ivm,1,ileaf,:)*&
+         circ_class_n(ipts,ivm,1)
+    turnover(ipts,ivm,icarbres,:) = turnover(ipts,ivm,icarbres,:) + &
+         (un - harvest_ratio(ivm)) * circ_class_biomass(ipts,ivm,1,icarbres,:)*&
+         circ_class_n(ipts,ivm,1)
+    turnover(ipts,ivm,ilabile,:) = turnover(ipts,ivm,ilabile,:) + &
+         (un - harvest_ratio(ivm)) * circ_class_biomass(ipts,ivm,1,ilabile,:)*&
+         circ_class_n(ipts,ivm,1)
+    turnover(ipts,ivm,ifruit,:) = turnover(ipts,ivm,ifruit,:) + &
+         (un - harvest_ratio(ivm)) * circ_class_biomass(ipts,ivm,1,ifruit,:)*&
+         circ_class_n(ipts,ivm,1)
+    turnover(ipts,ivm,isapabove,:) = turnover(ipts,ivm,isapabove,:) + &
+         (un - harvest_ratio(ivm)) * circ_class_biomass(ipts,ivm,1,isapabove,:)*&
+         circ_class_n(ipts,ivm,1)
+
+
+    ! Account for the pools that should not contain biomass for the moment
+    ! Do so to make sure the mass balance will be closed 
+    turnover(ipts,ivm,isapbelow,:) = turnover(ipts,ivm,isapbelow,:) +  &
+         circ_class_biomass(ipts,ivm,1,isapbelow,:)*&
+         circ_class_n(ipts,ivm,1)
+    turnover(ipts,ivm,iheartabove,:) = turnover(ipts,ivm,iheartabove,:) +  &
+         circ_class_biomass(ipts,ivm,1,iheartabove,:)*&
+         circ_class_n(ipts,ivm,1)
+    turnover(ipts,ivm,iheartbelow,:) = turnover(ipts,ivm,iheartbelow,:) +  &
+         circ_class_biomass(ipts,ivm,1,iheartbelow,:)*&
+         circ_class_n(ipts,ivm,1)
+    ! Reset the biomass pools
+    circ_class_biomass(ipts,ivm,:,isapabove,:) = zero
+    circ_class_biomass(ipts,ivm,:,ileaf,:) = zero
+    circ_class_biomass(ipts,ivm,:,iroot,:) = zero
+    circ_class_biomass(ipts,ivm,:,ifruit,:) = zero
+    circ_class_biomass(ipts,ivm,:,icarbres,:) = zero
+    circ_class_biomass(ipts,ivm,:,ilabile,:) = zero
+                
+    ! These pools should always be empty for crops - just to be sure
+    circ_class_biomass(ipts,ivm,:,iheartbelow,:) = zero
+    circ_class_biomass(ipts,ivm,:,iheartabove,:) = zero
+    circ_class_biomass(ipts,ivm,:,isapbelow,:) = zero
+
+    ! No individuals left
+     circ_class_n(ipts,ivm,:) = zero
+
+    ! reset leaf age
+    leaf_meanage(ipts,ivm) = zero
+
+    IF(printlev_loc>=4) WRITE(numout,*) 'Leaving sapiens_crop_harvest'
+
+  END SUBROUTINE crop_harvest
+
+END MODULE sapiens_agriculture
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_forestry.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_forestry.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_forestry.f90	(revision 6412)
@@ -0,0 +1,4037 @@
+! =================================================================================================================================
+! MODULE       : forestry
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Gathers the main elements for forest management: the "forestry"
+!! subroutine, which itself calls a set of subroutines
+!! forestry_clear, clearcut, thinning, harvest, force_load, QsortC, and
+!! Partition, and a set of functions used in these subroutines.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)   :
+!! - Asael, S., 1999. Typologie des peuplements forestiers du massif vosgiens. 
+!! C.R.P.F. Lorraine-Alsace, Nancy, 54 p.
+!! - Bellassen, V., Le Maire, G., Dhote, J.F., Viovy, N., Ciais, P., 2010. 
+!! Modeling forest management within a global vegetation model â Part 1: 
+!! model structure aSnd general behaviour. Ecological Modelling 221, 2458â2474.
+!! - Bellassen, V., Le Maire, G., Guin, O., Dhote, J.F., Viovy, N., Ciais, P., 
+!! 2011a. Modeling forest management within a global vegetation model â Part 2: 
+!! model validation from tree to continental scale. Ecological Modelling 222, 
+!! 57â75.
+!! - Bellassen, V., Viovy, N., Luyssaert, S., Le Maire, G., Schelhaas, M.J., 
+!! Ciais, P., 2011b. Reconstruction and attribution of the carbon sink of 
+!! European forests between 1950 and 2000. Global Change Biology 17, 3274-3292.
+!! - Bottcher, H., Kurz, W.A., Freibauer, A., 2008. Accounting of forest carbon
+!! sinks and sources under a future climate protocol-factoring out past 
+!! disturbance and management effects on age-class structure. Environmental 
+!! Science & Policy 11, 669-686.
+!! - Cazin, A., Vallet, P., Dhote, J.F., 2003. Propositions LERFoB pour CARBOFOR
+!! Atelier modÃ©lisation.
+!! - Condes, S., Sterba, H., 2005. Derivation of compatible crown width 
+!! equations for some important tree species of Spain. Forest Ecology and 
+!! Management 217, 203-218.
+!! - Deleuze, C., Pain, O., Dhote, J.F., Herve, J.C., 2004. A flexible radial
+!! increment model for individual trees in pure even-aged stands. Annals of 
+!! Forest Science 61, 327-335.
+!! - DhÃŽte, J.-F., HervÃ©, J.-C., 2000. Changements de productivitÃ© dans quatre 
+!! forÃªts de chÃªnes sessiles depuis 1930 : une approche au niveau du peuplement. 
+!! Ann. For. Sci. 57, 651-680.
+!! - DhÃŽte, J.F., 1999. CompÃ©tition entre classes sociales chez le chÃªne sessile
+!! et le hÃªtre. Revue ForestiÃšre FranÃ§aise, 309-325.
+!! - DhÃŽte, J.F., Le MoguÃ©dec, G., 2003. PrÃ©sentation du modÃšle FagacÃ©es. 
+!! INRA, 31 p.
+!! - IFN, 2008. Raw inventory data - 2005-2007 inventory campaigns, www.ifn.fr.
+!! - Kolari, P., Pumpanen, J., Rannik, U., Ilvesniemi, H., Hari, P., Berninger,
+!! F., 2004. Carbon balance of different aged Scots pine forests in Southern 
+!! Finland. Global Change Biology 10, 1106-1119.
+!! - Lanier, L., 1994. PrÃ©cis de sylviculture. Ecole Nationale du GÃ©nie Rural, 
+!! des Eaux et des ForÃªts (ENGREF), Nancy, 477 p.
+!! - Law, B.E., Sun, O.J., Campbell, J., Van Tuyl, S., Thornton, P.E., 2003. 
+!! Changes in carbon storage and fluxes in a chronosequence of ponderosa pine. 
+!! Global Change Biology 9, 510-524.
+!! - Liberloo, M., Calfapietra, C., Lukac, M., Godbold, D., Luos, Z.B., Polle, 
+!! A., Hoosbeek, M.R., Kull, O., Marek, M., Raines, C., Rubino, M., Taylor, G., 
+!! Scarascia-Mugnozza, G., Ceulemans, R., 2006. Woody biomass production during 
+!! the second rotation of a bio-energy Populus plantation increases in a future 
+!! high CO2 world. Global Change Biology 12, 1094-1106.
+!! - Liberloo, M., Luyssaert, S., Bellassen, V., Djomo, S.N., Lukac, M., 
+!! Calfapietra, C., Janssens, I., Hoosbeek, M.R., Viovy, N., Churkina, G., 
+!! Scarascia-Mugnozza, G., Ceulemans, R., 2010. Bio-energy retains its 
+!! mitigation potential under elevated CO2. PLOS-one 5, e1 1648.
+!! - Litton, C.M., Raich, J.W., Ryan, M.G., 2007. Carbon allocation in forest 
+!! ecosystems. Global Change Biology 13, 2089-2109.
+!! - Luyssaert, S., Inglima, I., Jung, M., Richardson, A.D., Reichsteins, M., 
+!! Papale, D., Piao, S.L., Schulzes, E.D., Wingate, L., Matteucci, G., Aragao, 
+!! L., Aubinet, M., Beers, C., Bernhoffer, C., Black, K.G., Bonal, D., 
+!! Bonnefond, J.M., Chambers, J., Ciais, P., Cook, B., Davis, K.J., Dolman, 
+!! A.J., Gielen, B., Goulden, M., Grace, J., Granier, A., Grelle, A., Griffis,
+!! T., Grunwald, T., Guidolotti, G., Hanson, P.J., Harding, R., Hollinger, D.
+!! Y., Hutyra, L.R., Kolar, P., Kruijt, B., Kutsch, W., Lagergren, F., 
+!! Laurila, T., Law, B.E., Le Maire, G., Lindroth, A., Loustau, D., Malhi, Y.,
+!! Mateus, J., Migliavacca, M., Misson, L., Montagnani, L., Moncrieff, J., 
+!! Moors, E., Munger, J.W., Nikinmaa, E., Ollinger, S.V., Pita, G., 
+!! Rebmann, C., Roupsard, O., Saigusa, N., Sanz, M.J., Seufert, G., Sierra, C., 
+!! Smith, M.L., Tang, J., Valentini, R., Vesala, T., Janssens, I.A., 2007. CO2 
+!! balance of boreal, temperate, and tropical forests derived from a global 
+!! database. Global Change Biology 13, 2509-2537.
+!! - Mokany, K., Raison, R.J., Prokushkin, A.S., 2006. Critical analysis of 
+!! root: shoot ratios in terrestrial biomes. Global Change Biology 12, 84-96.
+!! - Mund, M., Kummetz, E., Hein, M., Bauer, G.A., Schulze, E.D., 2002. Growth
+!! and carbon stocks of a spruce forest chronosequence in central Europe. 
+!! Forest Ecology and Management 171, 275-296.
+!! - Newton, R.F., Amponsah, I.G., 2007. Comparative evaluation of five height-
+!! diameter models developed for black spruce and jack pine stand-types in 
+!! terms of goodness-of-fit, lack-of-fit and predictive ability. Forest Ecology
+!! and Management 247, 149-166.
+!! - Numerical Recipes, 2007. Numerical Recipes: The Art of Scientific Computing. 
+!! Cambridge University Press, 1256 p.
+!! - Ovington, J.D., Madgwick, H.A.I., 1957. Afforestation and soil reaction. 
+!! Journal of Soil Science 8, 141-149.
+!! - Pontailler, J.Y., Ceulemans, R., Guittet, J., 1999. Biomass yield of poplar 
+!! after five 2-year coppice rotations. Forestry 72, 157-163.
+!! - Pretzsch, H., Biber, P., DurskÃœ, J., 2002. The single tree-based stand 
+!! simulator SILVA: construction, application and evaluation. Forest Ecology and 
+!! Management 162, 3.
+!! - Reineke, L.H., 1933. Perfecting a stand-density index for even-aged forests. 
+!! Journal of Agricultural Research 46, 627-638.
+!! - Turner, D.P., Ritts, W.D., Cohen, W.B., Maeirsperger, T.K., Gower, S.T., 
+!! Kirschbaum, A.A., Running, S.W., Zhao, M.S., Wofsy, S.C., Dunn, A.L., Law, B.E.,
+!! Campbell, J.L., Oechel, W.C., Kwon, H.J., Meyers, T.P., Small, E.E., Kurc, S.A.,
+!! Gamon, J.A., 2005. Site-level evaluation of satellite-based global terrestrial 
+!! gross primary production and net primary production monitoring. Global Change 
+!! Biology 11, 666-684.
+!! - Vacchiano, G., Motta, R., Long, J.N., Shaw, J.D., 2008. A density management 
+!! diagram for Scots pine (Pinus sylvestris L.): A tool for assessing the forest's 
+!! protective effect. Forest Ecology and Management 255, 2542-2554.
+!! - Vieira, I.C.G., de Almeida, A.S., Davidson, E.A., Stone, T.A., de Carvalho, 
+!! C.J.R., Guerrero, J.B., 2003. Classifying successional forests using Landsat 
+!! spectral properties and ecological characteristics in eastern Amazonia. Remote 
+!! Sensing of Environment 87, 470-481.
+!! - Zianis, D., Mencuccini, M., 2004. On simplifying allometric analyses of forest 
+!! biomass. Forest Ecology and Management 187, 311-332.
+!! 
+!! SVN      :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE sapiens_forestry
+
+  ! modules used:
+#ifdef __NAGFOR
+  USE,INTRINSIC :: IEEE_ARITHMETIC
+#endif
+
+  USE netcdf
+  USE ioipsl_para
+  USE constantes
+  USE pft_parameters
+  USE function_library,     ONLY: wood_to_volume, wood_to_height, &
+                                  wood_to_cn, wood_to_circ, Nmax, &
+                                  wood_to_dia, Nmaxyield, Nminyield, &
+                                  wood_to_qmdia, calculate_rdi, &
+                                  check_surface_area, check_mass_balance
+  USE interpol_help,        ONLY: aggregate_p
+  USE stomate_data
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+
+  PUBLIC species_change, flag_species_change
+  PUBLIC forestry, forestry_clear, read_in_fm_map, &
+       read_in_species_change_map, read_in_desired_fm_map, &
+       read_in_litter_map, litter_raking
+  
+  LOGICAL, SAVE                 :: firstcall_forestry = .TRUE.   !! first call
+!$OMP THREADPRIVATE(firstcall_prescribe)  
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE    : forestry_clear
+!!
+!>\BRIEF        Set the flag ::firstcall_forestry to .TRUE. and as such activate section 2 of the subroutine forestry (see below).
+!! 
+!_ ================================================================================================================================
+
+  SUBROUTINE forestry_clear
+    firstcall_forestry = .TRUE.
+  END SUBROUTINE forestry_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : forestry
+!!
+!>\BRIEF        This subroutine is the core of the forest management module. It
+!! has been modified so it only decides if trees are getting cut or not.
+!!
+!! DESCRIPTION   : This forest management module has been changed quite a bit
+!! from Valentin's original version (documented in Ballassen et al (2010).  The
+!! biggest reason for these changes is that it is meant to be used with the new
+!! functional allocation scheme.  This scheme already includes circumference
+!! classes.  In each circumference class there are circ_class_n model trees
+!! which are all identical.  Therefore, we don't need to create a picture
+!! of every tree on the stand since in reality we only have ncirc trees, each
+!! of which are replicated.
+!!
+!! In addition to this, several other processes that were done here were moved
+!! to other parts of the code.  For example, trees are just scheduled to die
+!! here; the actually killing of the biomass and moving the wood to the harvest
+!! and litter pools is done in sapiens_kill.f90.  All tree establishment after
+!! clearcutting is done in stomate_prescribe.f90.  Self-thinning is a completely
+!! natural process, and therefore done with environmental mortality in 
+!! stomate_mark_kill.f90.
+
+!!++++ CHECK REFERENCE ++++
+!! Liberloo et al. (2010) describes how short 
+!! rotation coppices are simulated and validated.\n
+!!+++++++++++++++++++++++
+
+!! The forest management flags have changed as well.
+!! FM = 1 : No human intervention (ORCHIDEE default)
+!!      2 : Thinnings based on the RDI, clearcuts based on tree density,
+!!              annual increment, and tree diameter.  Thinnings from above and
+!!              from below are determined by the sign of thstrat.
+!!      3 : Coppices
+!!      4 : Short rotation coppices
+!!
+!! Relative density index (RDI) target of human thinning at the beginning of 
+!! the rotation (unitless). This is the value aimed at by human thinning at 
+!! the beginning of the rotation. It is necessarily lower than 1. The actual 
+!! RDI varies around this target, + or - delta_rdi, when forest_managed = 2. 
+!! When forest_managed = 3, human thinning occurs every year.  For FM = 4,
+!! the thinnings occur as a function of stand age.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::circ_class_kill
+!!
+!! REFERENCE(S)   : See above, module description.
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE forestry (npts, age_stand, last_cut, &
+             circ_class_n, circ_class_kill, forest_managed, rdi,&
+             circ_class_biomass, mai, pai, previous_wood_volume, &
+             mai_count, coppice_dens, veget_cov_max, rdi_target_upper,&
+             rdi_target_lower, fm_change_map, species_change_map)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                             :: npts                !! Domain size - number of pixels 
+                                                                                  !! (dimensionless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget_cov_max           !! "maximal" coverage fraction of a PFT on 
+                                                                                  !! the ground (unitless, 0-1) 
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), &                      
+                                          INTENT(in)       :: circ_class_biomass  !! Biomass components of the model tree  
+                                                                                  !! within a circumference class
+                                                                                  !! class @tex $(g C ind^{-1})$ @endtex
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(in)         :: last_cut            !! Years since last thinning (years)
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(in)         :: age_stand           !! Age of stand (years)
+    INTEGER(i_std), DIMENSION(:,:), INTENT(in)             :: fm_change_map       !! A map which gives the desired FM strategy when
+                                                                                  !! the PFT will be replanted after a clearcut.
+                                                                                  !! (1-nvm,unitless)
+    INTEGER(i_std), DIMENSION(:,:), INTENT(in)             :: species_change_map  !! A map which gives the PFT number that each
+                                                                                  !! PFT will be replanted as in case of a clearcut.
+                                                                                  !! (1-nvm,unitless)
+
+    !! 0.2 Output
+
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(inout)  :: circ_class_n        !! Number of trees in each circumference 
+                                                                                  !! class (0-2.2+ and poles-large wood, see 
+                                                                                  !! part 12.) 
+       
+
+    !! 0.3 Modified fields
+
+    INTEGER(i_std), DIMENSION(npts,nvm), INTENT(inout)     :: forest_managed      !! Forest management flag: 0 = orchidee 
+                                                                                  !! standard, 1= self-thinning only, 2= 
+                                                                                  !! high-stand, 3= high-stand smoothed, 4= 
+                                                                                  !! coppices 
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nfm_types,ncut_times), &
+                                             INTENT(inout) :: circ_class_kill     !! Number of trees within a circ that needs
+                                                                                  !! to be killed @tex $(ind m^{-2})$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: mai                 !! The mean annual increment
+                                                                                  !! @tex $(m**3 / m**2 / year)$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: pai                 !! The period annual increment
+                                                                                  !! @tex $(m**3 / m**2 / year)$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: previous_wood_volume!! The volume of the tree trunks
+                                                                                  !! in a stand for the previous year.
+                                                                                  !! @tex $(m**3 / m**2 )$ @endtex
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(inout)      :: mai_count           !! The number of times we've
+                                                                                  !! calculated the volume increment
+                                                                                  !! for a stand
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(inout)         :: coppice_dens        !! The density of a coppice at the first
+                                                                                  !! cutting.
+                                                                                  !! @tex $( 1 / m**2 )$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: rdi                 !! Relative density index (unitless, 0-2)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: rdi_target_upper    !! Upper limit of RDI. When reached the stand
+                                                                                  !! needs to be thinned (unitless)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: rdi_target_lower    !! Lower limit of RDI. When thinned, thin to this             
+                                                                                  !! stand density (unitless)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                         :: icir,ivm,ipts       !! Indexes
+    INTEGER(i_std)                                         :: imbc, iele, ipar    !! Indexes
+    REAL(r_std)                                            :: trees,total_trees   !! a number of trees
+    REAL(r_std), DIMENSION(ncirc)                          :: diameters_temp      !! Trunk diameter calculated from allometry [m]
+    REAL(r_std), DIMENSION(ncirc)                          :: circ_temp           !! Trunk circumference calculated from allometry
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)                 :: height,dia,cn       !! Tree height calculated from allometric 
+                                                                                  !! relationships (m)
+    REAL(r_std)                                            :: ave_tree_height
+    REAL(r_std)                                            :: woody_biomass
+    REAL(r_std)                                            :: current_wood_volume
+    REAL(r_std)                                            :: current_increment
+    REAL(r_std)                                            :: ave_tree_dia
+    INTEGER(i_std)                                         :: nrotations          !! The number of rotations that we've done
+                                                                                  !! for SRC minus one
+    REAL(r_std)                                            :: qm_dia              !! quadratic mean diameter of the forest (m)
+    INTEGER(i_std)                                         :: ierr                !! error message
+    INTEGER(i_std)                                         :: igroup_new          !! Species group to which the species with which
+                                                                                  !! the stand will be replanted belongs (unitless)
+    INTEGER(i_std)                                         :: igroup_old          !! Species group to which the current species
+                                                                                  !! belongs (unitless)
+
+!_ ===============================================================================================================================
+
+    IF ( printlev>= 3) WRITE(numout,*) 'Entering forestry'
+
+ !! 1. Initialize
+
+    !! 1.1 Initialize local printlev 
+    !printlev_loc=get_printlev('forestry')
+
+    !! 1.2 Initialize check for mass balance closure
+    !  We don't actually have to do this in forestry, since none of the 
+    !  pools are changed even touched. The sole purpose of this routine 
+    !  is to schedule trees for killing which means that only 
+    !  ::circ_class_kill is changed.
+
+    !! 1.3 Initialize check for surface area conservation
+    !  Veget_max is a INTENT(in) variable and can therefore
+    !  not be changed during the course of this subroutine
+    !  No need to check whether the subroutine preserves the
+    !  total surface area of the pixel.
+
+
+ !! 2. Check and apply forestry
+ 
+    ! for every forest stand in the model, we need to decide 
+    ! if we are thinning or clearcutting.
+    DO ipts=1,npts
+
+       pft:DO ivm=1,nvm
+
+          ! Forest management can only be applied to forests
+          IF(.NOT. is_tree(ivm)) CYCLE
+
+          ! This PFT is not present, so it can't be managed
+          IF(veget_cov_max(ipts,ivm) == zero) CYCLE
+
+          ! There is no biomass, so nothing to manage
+          IF(SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1),1) .LE. min_stomate) CYCLE
+          
+          ! Does our management strategy allow for thinning?
+          IF ( forest_managed(ipts,ivm) .EQ. ifm_none ) THEN
+
+             ! Unmanged PFT, so no reason to do the calculation
+             CYCLE
+
+          ELSE
+
+             ! Managed pft, apply to appropriate management
+             IF(printlev_loc>=4)THEN
+                WRITE(numout,*) 'Forestry: check whether the stand ',&
+                     'needs management', ivm
+                CALL flush(numout)
+             ENDIF
+
+             ! Convert the aboveground woody biomass into a wood volume, 
+             ! removing the influence of the branches.
+             current_wood_volume = wood_to_volume(npts,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:),ivm,branch_ratio(ivm),0)
+
+             ! The mean annual increment is tricky. Need to calculate it
+             ! for the volume, since that is what foresters use and the NPP
+             ! would include leaf NPP.  However, we cannot calculate a
+             ! volume increment immediately after thinning.  Instead, the first
+             ! year after a thinning or after a clearcut (for consistency)
+             ! we just save the current volume.
+             IF(last_cut(ipts,ivm) .EQ. 1)THEN
+
+                ! do nothing.  We'll save the current wood volume later.
+                
+             ELSEIF(last_cut(ipts,ivm) .GT. 1)THEN
+
+                current_increment=&
+                     current_wood_volume-previous_wood_volume(ipts,ivm)
+                mai_count(ipts,ivm)=mai_count(ipts,ivm)+1
+                mai(ipts,ivm)=mai(ipts,ivm)*REAL(mai_count(ipts,ivm)-1)/&
+                     REAL(mai_count(ipts,ivm))+current_increment/&
+                     REAL(mai_count(ipts,ivm))
+
+                ! The periodic annual increment is an average over the past few
+                ! years.  Notice that the first year after a cut that we can
+                ! compute an increment for is year 2 (the difference between 
+                ! year 2 and year 1).     
+                IF(last_cut(ipts,ivm) .LT. (n_pai+1))THEN
+                   
+                   pai(ipts,ivm)=pai(ipts,ivm)*REAL(last_cut(ipts,ivm)-2)/&
+                        REAL(last_cut(ipts,ivm)-1)+&
+                        current_increment/REAL(last_cut(ipts,ivm)-1)
+
+                ELSE
+
+                   pai(ipts,ivm)=pai(ipts,ivm)*REAL(n_pai-1)/REAL(n_pai)+&
+                        (current_wood_volume-previous_wood_volume(ipts,ivm))&
+                        /REAL(n_pai)
+
+                ENDIF
+
+             ELSE
+
+                ! Cannot think of a scenario where last_cut is zero.
+                ! If it is zero, we thinned or clearcut, but that happens
+                ! after this routine and we always increment it before this
+                ! routine.
+                WRITE(numout,*) 'ERROR: Forestry, why is last_cut equal to zero?'
+                WRITE(numout,*) 'ipts, ivm, last_cut(ipts,ivm) ',&
+                     ipts, ivm, last_cut(ipts,ivm)
+                IF (err_act.GT.1) CALL ipslerr_p (3, &
+                     'forestry', 'last_cut is zero.',&
+                     'This should not happen.',&
+                     'Look in the output file for ERROR.')
+             ENDIF
+
+             ! We also need to store the wood volume of this year in order to 
+             ! calculate the PAI for next year.
+             previous_wood_volume(ipts,ivm)=current_wood_volume
+
+             ! The following is specific for each forest management strategy
+             IF(forest_managed(ipts,ivm).EQ.ifm_thin)THEN
+
+                ! Forests can only be thinned if it is profitable for the 
+                ! managers to do so. This profitability is based on the 
+                ! average height of the 100 tallest trees per hectare.  
+                ! If it's profitable, the stand is thinned to a target 
+                ! relative density index (RDI), which is the ratio of the 
+                ! true density to the self thinning density. This target 
+                ! depends on the management type, but it is always less 
+                ! than unity. Table 1 in Bellassen et al, Ecological 
+                ! Modeling (2010) gives values for some of these parameters.
+
+                ! First, calculate the average height of the 100 tallest 
+                ! trees on the hectare. Remember that all our trees are the 
+                ! same height in a given circ class. Since we don't explicitly 
+                ! track trees, we just start at the largest circ classs and 
+                ! add trees to our average until we have 100 (Note that this 
+                ! number has been externalised as ::ntress_profit)
+                height(ipts,ivm,:)=&
+                     wood_to_height(circ_class_biomass(ipts,ivm,:,:,icarbon),&
+                     ivm)
+
+                ! Debug
+                IF(printlev_loc>=4 .AND. ipts == test_grid .AND. &
+                   ivm == test_pft)THEN
+                   WRITE(numout,*) 'Forestry, check for thinning', ivm
+                   ! just for printing out some information
+                   cn(ipts,ivm,:)= &
+                        wood_to_cn(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+                   dia(ipts,ivm,:)= &
+                        wood_to_dia(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+                   DO icir=1,ncirc     
+                      WRITE(numout,*) circ_class_n(ipts,ivm,icir)*m2_to_ha,&
+                           height(ipts,ivm,icir), &
+                           deux*SQRT(cn(ipts,ivm,icir)/pi), dia(ipts,ivm,icir)
+                   ENDDO
+                   CALL flush(numout)
+                ENDIF
+                !-
+
+                ! Select the 100 tallest treesb and calculate their 
+                ! average height
+                total_trees=zero
+                ave_tree_height=zero
+                tree:DO icir=ncirc,1,-1
+                   trees=circ_class_n(ipts,ivm,icir)*m2_to_ha
+                   IF(trees .GE. ntrees_profit)THEN
+                      ave_tree_height=height(ipts,ivm,icir)
+                      EXIT tree
+                   ELSEIF((trees + total_trees) .GE. ntrees_profit)THEN
+                      ave_tree_height=ave_tree_height*total_trees/&
+                           REAL(ntrees_profit,r_std)+&
+                           (REAL(ntrees_profit,r_std)-total_trees)/&
+                           REAL(ntrees_profit,r_std)*&
+                           height(ipts,ivm,icir)
+                      EXIT tree
+                   ELSE
+                      ave_tree_height=ave_tree_height*total_trees/&
+                           (total_trees+trees)+&
+                           trees/(total_trees+trees)*height(ipts,ivm,icir)
+                      total_trees=total_trees+trees
+                   ENDIF
+
+                ENDDO tree
+
+                ! This is our condition for thinning
+                IF(ave_tree_height >= h_first(ivm))THEN
+
+                   ! Debug
+                   IF(printlev_loc>=4 .AND. ipts == test_grid .AND. &
+                        ivm == test_pft)THEN
+                      WRITE(numout,*) 'Forestry, check for thinning: ', &
+                           ave_tree_height,h_first(ivm)
+                      WRITE(numout,*) 'Forestry, check for thinning ',&
+                           '- tree height OK', ivm
+                      CALL flush(numout)
+                   ENDIF
+                   !-
+
+                   ! in order to thin, we need to know the relative 
+                   ! density index (RDI) of our stand.  This is the 
+                   ! ratio of the current stand density to
+                   ! the self-thinning density, Nmax.
+                   diameters_temp(:)= &
+                        wood_to_dia(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+
+                   ! with these diameters, we can check to see if we 
+                   ! want to clearcut. If the diameters get too big, 
+                   ! harvesting equipment can't handle the trees anymore. 
+                   ! On the other hand, we need to make sure there
+                   ! are enough big trees that it is worthwhile to cut 
+                   ! them down.
+                   total_trees=zero
+                   DO icir=1,ncirc
+                      IF(diameters_temp(icir) .GT. largest_tree_dia(ivm)) THEN
+                         total_trees=total_trees+circ_class_n(ipts,ivm,icir)*&
+                              m2_to_ha
+                      ENDIF
+                   ENDDO
+
+                   ! Debug
+                   IF(printlev_loc>=4 .AND. ipts == test_grid .AND. &
+                        ivm == test_pft)THEN
+                      WRITE(numout,*) 'Forestry, testing diameter criterion', ivm
+                      WRITE(numout,*) 'total_trees: ', total_trees
+                      WRITE(numout,*) 'dens_target: ', dens_target(ivm)
+                      WRITE(numout,*) 'largest_tree_dia: ', largest_tree_dia(ivm)
+                      WRITE(numout,*) 'diameters_temp: ', diameters_temp(:)
+                      WRITE(numout,*) 'circ_class_n (in trees per hectare): ', &
+                           circ_class_n(ipts,ivm,:)*m2_to_ha
+                      CALL flush(numout)
+                   ENDIF
+                   !-
+
+                   ! CONDITION 1: there are less than 100 trees left
+                   IF( SUM(circ_class_n(ipts,ivm,:))*m2_to_ha .LT. &
+                        dens_target(ivm)) THEN
+
+                      ! These are conditions which are suitable for switching
+                      ! from a management to a conservation strategy. 
+                      ! Such a switch is not internalized in the code and 
+                      ! needs to be prescribed. The way to prescribe it is 
+                      ! by using species/management changes and prescribing 
+                      ! the desired management for some of all pixels
+                      ! as unmanaged.
+                      IF(ok_change_species)THEN
+
+                         ! The criteria for a clearcut are met but check 
+                         ! whether we want to switch to a conservation 
+                         ! strategy on this site.
+                         IF(fm_change_map(ipts,ivm) .EQ. ifm_none) THEN
+
+                            ! Change the management strategy (most likely 
+                            ! high stand management) to conservation
+                            forest_managed(ipts,ivm) = ifm_none
+
+                            ! Debug
+                            IF(printlev_loc>=4)THEN
+                               WRITE(numout,*) 'species change ',&
+                                    '- conservation strategy, ',&
+                                    'density becoming too low'
+                            ENDIF  
+                            !-             
+
+                         ELSE
+
+                            ! The species/management change scenario does
+                            ! not prescribe a change to a conservation strategy
+                            ! but the criteria for a clearcut are met 
+                            CALL clearcut_harvest(circ_class_n(ipts,ivm,:), &
+                                 circ_class_kill(ipts,ivm,:,ifm_thin,icut_clear))
+
+                         ENDIF
+                                 
+                      ELSE
+
+                         ! Species/management changes are not considered. The 
+                         ! criteria for a clearcut are met 
+                         CALL clearcut_harvest(circ_class_n(ipts,ivm,:), &
+                              circ_class_kill(ipts,ivm,:,ifm_thin,icut_clear))
+
+                      ENDIF
+
+                      CYCLE pft
+
+                   ENDIF
+                   
+                   ! CONDITION 2: There are more than 100 trees for which 
+                   ! the diameter exceeds the threshold, time to cut
+                   IF(total_trees .GT. dens_target(ivm))THEN
+
+                      ! Debug
+                      IF(printlev_loc>=4 .AND. ipts == test_grid .AND. &
+                           ivm == test_pft)THEN
+                         WRITE(numout,*) 'Forestry, diameter exceeds ',&
+                              'treshold, clearcut', ivm
+                         WRITE(numout,*) 'total_trees: ', total_trees
+                         WRITE(numout,*) 'dens_target: ', dens_target(ivm)
+                         WRITE(numout,*) 'largest_tree_dia: ', &
+                              largest_tree_dia(ivm)
+                         WRITE(numout,*) 'diameters_temp: ', diameters_temp(:)
+                         WRITE(numout,*) 'circ_class_n (trees per hectare): ', &
+                              circ_class_n(ipts,ivm,:)*m2_to_ha
+                         CALL flush(numout)
+                      ENDIF
+                      !-
+
+                      ! These are conditions which are suitable for switching
+                      ! from a management to a conservation strategy. Such a 
+                      ! switch is not internalized in the code and needs to be 
+                      ! prescribed. The way to prescribe it is by using 
+                      ! species/management changes and prescribing the desired 
+                      ! management for some of all pixels as unmanaged.
+                      IF(ok_change_species)THEN
+
+                         ! The criteria for a clearcut are met but check whether 
+                         ! we want to switch to a conservation strategy on this 
+                         ! site.
+                         IF( fm_change_map(ipts,ivm) .EQ. ifm_none) THEN
+
+                            ! Change the management strategy (most likely 
+                            ! high stand management) to conservation
+                            forest_managed(ipts,ivm) = ifm_none
+
+                            ! debug
+                            IF(printlev_loc>=4)THEN
+                              WRITE(numout,*) 'species change - ',&
+                                   'conservation strategy, ',&
+                                   'exceeded largest diameter'
+                            ENDIF
+                            !-
+
+                         ELSE
+
+                            ! The species/management change scenario does
+                            ! not prescribe a change to a conservation strategy
+                            ! but the criteria for a clearcut are met 
+                            CALL clearcut_harvest(circ_class_n(ipts,ivm,:), &
+                                 circ_class_kill(ipts,ivm,:,ifm_thin,icut_clear))
+
+                         ENDIF
+                                 
+                      ELSE
+
+                         ! Species/management changes are not considered. The 
+                         ! criteria for a clearcut are met 
+                         CALL clearcut_harvest(circ_class_n(ipts,ivm,:), &
+                              circ_class_kill(ipts,ivm,:,ifm_thin,icut_clear))
+
+                      ENDIF
+
+                      CYCLE pft
+                   ENDIF
+
+                   ! CONTION 3: a clearcut is expected if the trees start 
+                   ! growing too slowly. This is measured by looking at 
+                   ! the mean annual increment, which is simply the trunk 
+                   ! volume divided by the age of the tree.  We compare 
+                   ! this to average tree growth over the past five years 
+                   ! (i.e. the tree volume divided by 5), called the 
+                   ! periodic annual increment.  If the PAI is smaller than 
+                   ! the MAI, the trees are past their prime and the owner 
+                   ! will cut them and plant anew.
+
+                   ! We calculate the MAI and the PAI at the same place where 
+                   ! we increment the age of the stand, so here we just have 
+                   ! to compare them.  We need to check that we have enough 
+                   ! years from the last cut to calculate a good PAI.
+                   IF(PAI(ipts,ivm) .LT. MAI(ipts,ivm) .AND. &
+                        last_cut(ipts,ivm) .GT. n_pai)THEN
+
+                       ! Debug
+                       IF(printlev_loc>=4 .AND. ipts == test_grid .AND. &
+                            ivm == test_pft)THEN
+                          WRITE(numout,*) 'Forestry, harvesting ',&
+                               'increment PAI<MAI'
+                          WRITE(numout,*) 'ipts, ivm, mai, pai: ',ipts, &
+                               ivm, mai(ipts,ivm), pai(ipts,ivm)
+                       ENDIF
+                       !-
+
+                       IF(ok_change_species)THEN
+
+                          ! The criteria for a clearcut are met but check 
+                          ! whether we want to switch to a conservation 
+                          ! strategy on this site.
+                          IF( fm_change_map(ipts,ivm) .EQ. ifm_none) THEN
+
+                             ! Change the management strategy (could be 
+                             ! high stand, coppice and short rotation 
+                             ! coppice) to conservation
+                             forest_managed(ipts,ivm) = ifm_none
+
+                             IF(printlev_loc>=4)THEN
+                                WRITE(numout,*) 'species change - ',&
+                                     'conservation strategy, ', &
+                                     'stand growth is too low'
+                             ENDIF  
+
+                         ELSE
+
+                            ! The species/management change scenario does
+                            ! not prescribe a change to a conservation strategy
+                            ! but the criteria for a clearcut are met 
+                            CALL clearcut_harvest(circ_class_n(ipts,ivm,:), &
+                                 circ_class_kill(ipts,ivm,:,ifm_thin,icut_clear))
+
+                         ENDIF
+                                 
+                      ELSE
+
+                         ! Species/management changes are not considered. The 
+                         ! criteria for a clearcut are met
+                         CALL clearcut_harvest(circ_class_n(ipts,ivm,:), &
+                              circ_class_kill(ipts,ivm,:,ifm_thin,icut_clear))
+                        
+                      ENDIF
+
+                     CYCLE pft
+                   ENDIF
+   
+                   ! our rdi_target will become a function of both PFT 
+                   ! and diameter/density Calculate rdi and rdi_target 
+                   ! and delta_rdi based on the yield models rdi of the 
+                   ! stand as it is
+                   qm_dia = wood_to_qmdia(&
+                        circ_class_biomass(ipts,ivm,:,:,icarbon), &
+                        circ_class_n(ipts,ivm,:), ivm)
+
+                   ! The self-thinning and yield relationships are for 
+                   ! diameters expressed in cm
+                   rdi(ipts,ivm) = (SUM(circ_class_n(ipts,ivm,:))*m2_to_ha)/ &
+                        Nmax(qm_dia*m_to_cm,ivm)  
+                   
+                   ! rdi_target_upper (based on the yield tables)
+                   ! rdi depends on the observed self-thinning 
+                   ! relationship and rdi_target_upper
+                   rdi_target_upper(ipts,ivm) = Nmaxyield(qm_dia*m_to_cm,ivm)/ &
+                        Nmax(qm_dia*m_to_cm,ivm)
+                  
+                   ! Debug
+                   IF(printlev_loc>=4 .AND. ipts == test_grid .AND. &
+                        ivm == test_pft)THEN
+                      WRITE(numout,*) 'rdi', rdi(ipts,ivm)
+                      WRITE(numout,*) 'rdi_target_upper calcul', &
+                           rdi_target_upper(ipts,ivm)
+                   ENDIF
+                   !-
+
+                   ! depends on the yield tables. Because the data are not 
+                   ! perfect and the model fitted to the yield table data 
+                   ! is rather limited it happens that rdi_target_upper 
+                   ! exceeds rdi. This is nonesensical from a biological point 
+                   ! of view. Either we have to use more flexible statistical 
+                   ! models to fit to the yield data or we need a better 
+                   ! algorithm that takes the above constraint into account 
+                   ! or we simply use the minimum of the two. The last 
+                   ! solution is here implemented by prescribing an 
+                   ! rdi_limit_upper. In theory this value is one but because 
+                   ! self-thinning is checked daily and thinning annually 
+                   ! this condition is rarely satisfied. So to make sure 
+                   ! thinning keeps happening set the limit to a value just 
+                   ! below 1 i.e. 0.9 rdi_target_lower (based on the yield 
+                   ! tables). If the lower rdi for harvest is
+                   rdi_target_upper(ipts,ivm) = &
+                        MIN(rdi_target_upper(ipts,ivm), rdi_limit_upper)
+               
+                   ! rdi_target_lower (based on the yield tables). If the 
+                   ! lower rdi for harvest is also above self-thinning 
+                   ! there won't be any thinning because then the upper 
+                   ! and lower harvest rdi are equal. This is an undesired 
+                   ! situation but we have to deal with the numerics to 
+                   ! avoid stupid results.
+
+                   ! rdi_target_lower (based on the yield tables)
+                   rdi_target_lower(ipts,ivm) = Nminyield(qm_dia*m_to_cm,ivm)/ &
+                        Nmax(qm_dia*m_to_cm,ivm)            
+                   rdi_target_lower(ipts,ivm) = MIN(rdi_target_lower(ipts,ivm),&
+                        rdi_limit_upper)
+                  
+                   ! Debug
+                   IF(printlev_loc>=4)THEN
+                      IF(ivm == test_pft .AND. ipts == test_grid)THEN
+                         WRITE(numout,*) 'Forestry, rdi print ',rdi(ipts,ivm),&
+                              rdi_target_upper(ipts,ivm),&
+                              rdi_target_lower(ipts,ivm)
+                         WRITE(numout,*) "qm_dia,Nminyield ",qm_dia, &
+                              Nminyield(qm_dia*m_to_cm,ivm)
+                         WRITE(numout,*) "qm_dia,Nmaxyield ",qm_dia, & 
+                              Nmaxyield(qm_dia*m_to_cm,ivm)
+                         WRITE(numout,*) "Nmax ",Nmax(qm_dia*m_to_cm,ivm)
+                         WRITE(numout,*) "alpha_rdi_upper,beta_rdi_upper ", &
+                              alpha_rdi_upper(ivm),beta_rdi_upper(ivm)
+                         WRITE(numout,*) "nmaxtrees,dens_target ", &
+                              nmaxtrees(ivm), &
+                              dens_target(ivm)
+                      ENDIF
+                   ENDIF
+                   !-
+
+                   ! we only need to thin if the rdi of our stand is outside 
+                   ! the acceptable rdi range given by rdi_target_upper and 
+                   ! rdi_target_lower
+                   IF((rdi(ipts,ivm) .GT. (rdi_target_upper(ipts,ivm))))THEN
+
+                      ! we need the circumference of each model tree in meters 
+                      circ_temp(:)= wood_to_circ(&
+                           circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+
+                      ! Debug
+                      IF(printlev_loc>=4 .AND. ipts == test_grid .AND. &
+                           ivm == test_pft)THEN
+                         DO icir=1,ncirc
+                            WRITE(numout,*) 'Forestry thinning now: ',&
+                                 ipts,ivm,icir
+                            WRITE(numout,*) 'Forestry height, ccn, ',&
+                                 height(ipts,ivm,icir),&
+                                 circ_class_n(ipts,ivm,icir)*m2_to_ha
+                         ENDDO
+                         WRITE(numout,*) "circ_temp ",circ_temp(:)
+                         WRITE(numout,*) "NOTE: assumes ncirc = 3"
+                         WRITE(numout,*) "circ_class_biomass(1) ",&
+                              SUM(circ_class_biomass(ipts,ivm,1,:,icarbon))
+                         WRITE(numout,*) "circ_class_biomass(2) ",&
+                              SUM(circ_class_biomass(ipts,ivm,2,:,icarbon))
+                         WRITE(numout,*) "circ_class_biomass(3) ",&
+                              SUM(circ_class_biomass(ipts,ivm,3,:,icarbon))
+                      ENDIF
+                      !-
+
+                      ! we always thin down to the lower end of this range, 
+                      ! which then gives our forest a few years to grow before 
+                      ! we need to thin again
+                      CALL thinning(taumin(ivm),taumax(ivm),thinstrat(ivm),&
+                           diameters_temp(:),circ_temp(:),&
+                           circ_class_kill(ipts,ivm,:,ifm_thin,icut_thin),&
+                           circ_class_n(ipts,ivm,:),rdi_target_lower(ipts,ivm),&
+                           ivm,ipts)
+
+                      ! Debug
+                      IF(printlev_loc>=4 .AND. ipts == test_grid .AND. &
+                           ivm == test_pft)THEN
+                         WRITE(numout,*) 'Forestry, circ_class_kill ',&
+                              circ_class_kill(ipts,ivm,:,ifm_thin,icut_thin)
+                         WRITE(numout,*) 'circ_class_n(ipts,ivm,:) ',&
+                              circ_class_n(ipts,ivm,:)
+                         DO icir=1,ncirc
+                            WRITE(numout,*) 'Forestry, circ_biomass(iparts)',&
+                                 icir,circ_class_biomass(ipts,ivm,icir,:,icarbon)
+                         ENDDO
+                      ENDIF
+                      !-
+
+                   ENDIF ! rdi .GT. rdi_target_uppe
+
+                ENDIF ! ave_height .GE. h_first
+
+             ! Coppicing
+             ELSEIF(forest_managed(ipts,ivm).EQ.ifm_cop)THEN
+
+                ! This is for coppicing.
+                ! It makes no sense to coppice an evergreen tree species.
+                IF(is_needleleaf(ivm))THEN
+
+                   WRITE(numout,*) 'ERROR', is_needleleaf(ivm)
+                   WRITE(numout,*) 'Forestry, Coppicing (FM = 3) should  ' &
+                        // 'only be done on deciduous trees.'
+                   WRITE(numout,*) 'ipts,ivm,forest_managed(ipts,ivm): ',&
+                        ipts,ivm,forest_managed(ipts,ivm) 
+                   IF (err_act.GT.1) CALL ipslerr (3,'sapiens_forestry', &
+                        'Don t coppice conifers','','')
+                   WRITE(numout,*) ' I am not going to stop you now.'
+                   WRITE(numout,*) 'Be sure you know what you are doing!'
+                   
+                ENDIF
+
+                ! Depending on the age of the stand we have different options.
+                ! The current system is to do nothing until the diameter of the
+                ! trees is greater than a certain value.  Once this happens, we
+                ! coppice, saving the number of trees that exist in this stand.
+                ! The trees then regrow until they reach this diameter again.
+                ! Some trees will have died due to mortality.  At the second
+                ! (and subsequent) cuts, we redistribute the below ground root 
+                ! mass to have the same number of trees as the first cut, 
+                ! killing the fine roots and harvesting aboveground biomass.
+
+                ! Check first to see if the average diameter of the
+                ! stand is greater than the prescribed treshold parameter.
+                diameters_temp(:)=wood_to_dia(&
+                     circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+                ave_tree_dia=zero
+                DO icir=1,ncirc
+                   ave_tree_dia=ave_tree_dia+diameters_temp(icir)*&
+                        circ_class_n(ipts,ivm,icir)
+                ENDDO
+                ave_tree_dia=ave_tree_dia/SUM(circ_class_n(ipts,ivm,:))
+
+                ! Debug
+                IF(printlev_loc>=4)THEN
+                   WRITE(numout,*) 'Forestry, Do we coppice? '
+                   WRITE(numout,*) 'ipts,ivm,SUM(circ_class_n(ipts,ivm,:)) ',&
+                        ipts,ivm,SUM(circ_class_n(ipts,ivm,:))
+                   WRITE(numout,*) 'ave_tree_dia,coppice_diameter, '&
+                        //'coppice_dens(ipts,ivm) ',&
+                        ave_tree_dia,coppice_diameter(ivm),coppice_dens(ipts,ivm)
+                ENDIF
+                !-
+
+                ! We have already coppiced once, so we know our target
+                ! tree density.
+                IF(ave_tree_dia .GE. coppice_diameter(ivm) .AND. &
+                     coppice_dens(ipts,ivm) .GT. zero)THEN
+
+                   ! Debug
+                   IF(printlev_loc>=4) WRITE(numout,*) 'Forestry, '&
+                        // 'Coppicing second cut. '
+                   !-
+
+                   IF(ok_change_species)THEN
+
+                      ! The criteria coppicing are met but check whether 
+                      ! we want to switch to a conservation strategy on 
+                      ! this site.
+                      IF(fm_change_map(ipts,ivm) .EQ. ifm_none) THEN
+
+                         ! Change the management strategy in this case 
+                         ! coppicing to conservation
+                         forest_managed(ipts,ivm) = ifm_none
+
+                      ELSEIF(fm_change_map(ipts,ivm).EQ.ifm_thin .OR. & 
+                         fm_change_map(ipts,ivm).EQ.ifm_src) THEN    
+
+                         ! We would like to change the forest management so 
+                         ! this is a good opportunity. However, we can not 
+                         ! simply coppice because then the roots will stay
+                         ! on the site. We have two options depending on
+                         ! whether we also want to change the species or
+                         ! not.
+                         
+                         ! Calculate the pft corresponding with the youngest
+                         ! age class of this species.
+                         igroup_new = species_change_map(ipts,ivm)
+                         igroup_old = agec_group(ivm)
+
+                         ! Debug
+                         IF(printlev_loc>=4)THEN
+                            WRITE(numout,*) 'replant coppice 1+?'
+                            WRITE(numout,*) 'igroup_new, igroup_old, ivm, ', &
+                                 igroup_new, igroup_old, ivm
+                         ENDIF
+                         !-
+                         
+                         IF(igroup_new.EQ.igroup_old)THEN
+
+                            ! We have the intention to replant with the same
+                            ! species and change to high stand management so
+                            ! it is better not to harvest the trees and let
+                            ! the coppice develop in standards.
+                            forest_managed(ipts,ivm) = ifm_thin
+
+                         ELSE
+
+                            ! We want to replace this coppice by another 
+                            ! species and to change the management strategy.
+                            ! We have to make sure that the whole stand is
+                            ! harvested. If so biomass will be zero and
+                            ! the flag_species_change routine will flag this
+                            ! PFT to be replanted in species_change the
+                            ! management will be changed
+                            CALL clearcut_harvest(circ_class_n(ipts,ivm,:), &
+                              circ_class_kill(ipts,ivm,:,ifm_thin,icut_clear))
+
+                         ENDIF !species_change
+
+                      ELSE
+
+                         ! The species/management change scenario does
+                         ! not prescribe a change to a conservation strategy
+                         ! but the criteria for coppicing are met. We have 
+                         ! already coppiced once, so we know our target
+                         ! tree density.  We just have to mark all the trees
+                         ! for coppicing.
+                         circ_class_kill(ipts,ivm,:,ifm_cop,icut_cop2) = & 
+                              circ_class_n(ipts,ivm,:)
+
+                      ENDIF
+                                 
+                   ELSE
+
+                      ! Species/management changes are not considered. The 
+                      ! criteria for a coppice are met.  We have already 
+                      ! coppiced once, so we know our target tree density.  
+                      ! We just have to mark all the trees for coppicing.
+                      circ_class_kill(ipts,ivm,:,ifm_cop,icut_cop2) = &
+                           circ_class_n(ipts,ivm,:)
+
+                   ENDIF
+                   
+                  
+                ! First time coppicing still need to save the coppice density
+                ELSEIF(ave_tree_dia .GE. coppice_diameter(ivm))THEN
+                   
+                   ! debug
+                   IF(printlev_loc>=4)THEN
+                      WRITE(numout,*) 'Forestry, Coppicing first cut. '
+                      WRITE(numout,*) 'coppice_dens(ipts,ivm): ',&
+                           SUM(circ_class_n(ipts,ivm,:))
+                   ENDIF
+
+                   ! save this tree density.  We will reallocate to this in 
+                   ! future cuts.
+                   coppice_dens(ipts,ivm)=SUM(circ_class_n(ipts,ivm,:))
+
+                   IF(ok_change_species)THEN
+
+                      ! The criteria for coppicing are met but check whether 
+                      ! we want to switch to a conservation strategy on this 
+                      ! site.
+                      IF( fm_change_map(ipts,ivm) .EQ. ifm_none) THEN
+
+                         ! Change the management strategy in this case
+                         ! coppicing to conservation
+                         forest_managed(ipts,ivm) = ifm_none
+
+                      ELSEIF(fm_change_map(ipts,ivm).EQ.ifm_thin .OR. &
+                         fm_change_map(ipts,ivm).EQ.ifm_src) THEN
+
+                         ! We would like to change the forest management so 
+                         ! this is a good opportunity. However, we can not 
+                         ! simply coppice because then the roots will stay
+                         ! on the site. We have two options depending on
+                         ! whether we also want to change the species or
+                         ! not.
+                         
+                         ! Calculate the pft corresponding with the youngest
+                         ! age class of this species.
+                         igroup_new = species_change_map(ipts,ivm)
+                         igroup_old = agec_group(ivm)
+
+                         ! Debug
+                         IF(printlev_loc>=4)THEN
+                            WRITE(numout,*) 'replant coppice 1?'
+                            WRITE(numout,*) 'igroup_new, igroup_old, ivm, ', &
+                                 igroup_new, igroup_old, ivm
+                         ENDIF
+                         !-
+                         
+                         IF(igroup_new.EQ.igroup_old)THEN
+
+                            ! We have the intention to replant with the same
+                            ! species and change to high stand management so
+                            ! it is better not to harvest the trees and let
+                            ! the coppice develop in standards. Stop coppicing
+                            ! and change the management
+                            forest_managed(ipts,ivm) = ifm_thin
+
+                         ELSE
+
+                            ! We want to replace this coppice by another 
+                            ! species and by another management strategy.
+                            ! We have to make sure that the whole stand is
+                            ! harvested. If so, biomass will be zero and
+                            ! the flag_species_change routine will flag this
+                            ! PFT to be replanted. In species_change the
+                            ! management will be changed and the new PFT
+                            ! will be set.
+                            CALL clearcut_harvest(circ_class_n(ipts,ivm,:), &
+                              circ_class_kill(ipts,ivm,:,ifm_thin,icut_clear))
+
+                         ENDIF !species_change
+
+                      ELSE
+
+                         ! The species/management change scenario does
+                         ! not prescribe a change to a conservation strategy
+                         ! but the criteria for a coppicing are met. This is
+                         ! the first coppice. Mark all the trees
+                         ! for coppicing.
+                         circ_class_kill(ipts,ivm,:,ifm_cop,icut_cop1) = &
+                              circ_class_n(ipts,ivm,:)
+
+                      ENDIF
+                      
+                   ELSE
+
+                      ! Species/management changes are not considered. The 
+                      ! criteria for a coppice are met. Mark all the trees 
+                      ! for coppicing.
+                      circ_class_kill(ipts,ivm,:,ifm_cop,icut_cop1) = &
+                           circ_class_n(ipts,ivm,:)
+                      
+                   ENDIF
+
+                ELSE
+                   
+                   ! We don't need to coppice anything.
+
+                ENDIF
+
+             ! This is for short rotation coppices.
+             ELSEIF(forest_managed(ipts,ivm).EQ.ifm_src)THEN
+                
+                ! It makes no sense to coppice an evergreen tree. SRC is limited
+                ! to poplar and willow species.
+                IF(.NOT. is_deciduous(ivm))THEN
+
+                   WRITE(numout,*) 'ERROR: Forestry, Short rotation ' &
+                        // ' coppicing (FM = 4)' & 
+                        // 'should only be done on deciduous trees.'
+                   WRITE(numout,*) 'ipts,ivm,forest_managed(ipts,ivm): ',&
+                       ipts,ivm,forest_managed(ipts,ivm) 
+                   IF (err_act.GT.1) CALL ipslerr (3,'ERROR: forestry', &
+                        'SRC should only be done on deciduous trees.',&
+                        'Look in the output file for ERROR.','')
+                   
+                ENDIF
+
+                ! Debug
+                IF(printlev_loc>=4)THEN
+                   WRITE(numout,*) 'Forestry, Do we SRC? '
+                   WRITE(numout,*) 'ipts,ivm,SUM(circ_class_n(ipts,ivm,:)) ',&
+                        ipts,ivm,SUM(circ_class_n(ipts,ivm,:))
+                   WRITE(numout,*) 'age_stand(ipts,ivm),src_rot_length(ivm),' &
+                        // ' coppice_dens(ipts,ivm): ',&
+                        age_stand(ipts,ivm),src_rot_length(ivm), &
+                        coppice_dens(ipts,ivm)
+                   WRITE(numout,*) 'src_nrots(ivm) ',&
+                        src_nrots(ivm)
+                ENDIF
+                !-
+
+                ! NOTE: SRC is not implemented as a historic forest 
+                ! management strategy but only used as a future strategy. 
+                ! Hence, for the moment we never have the situation where we 
+                ! decide we want to convert an SRC into an unmanaged forest. 
+                ! This is not a very realist conversion anyway. Contrary to 
+                ! ifm_none, ifm_cop and ifm_thin we don not check whether 
+                ! the future management strategy is ifm_none.
+
+                ! The qualifications for doing a short rotation coppice are 
+                ! fairly simple.  It's based on the age of the stand.  
+                ! We harvest all the aboveground biomass.  After a certain 
+                ! number of rotations, we harvest the aboveground and kill 
+                ! the belowground.
+                ! http://www.coppiceresources.co.uk/SRC.asp says that 30 
+                ! years between total harvests.
+                IF(MOD(age_stand(ipts,ivm),src_rot_length(ivm)) == 0)THEN
+
+                   nrotations=age_stand(ipts,ivm)/src_rot_length(ivm)
+
+                   IF(nrotations == src_nrots(ivm))THEN
+
+                      ! Debug
+                      IF(printlev_loc>=4) WRITE(numout,*) 'Forestry, ' &
+                           // 'SRC final harvest. '
+                      !-
+
+                      ! This is the final harvest, where we will kill
+                      ! all belowground biomass.
+                      circ_class_kill(ipts,ivm,:,ifm_src,icut_cop3)=&
+                           circ_class_n(ipts,ivm,:)
+
+                   ELSEIF(nrotations == 1)THEN
+
+                      ! Debug
+                       IF(printlev_loc>=4) WRITE(numout,*) 'Forestry, '&
+                           // 'SRC first harvest. '
+                       !-
+
+                      ! This is the first harvest, which will lead
+                      ! to coppices. Save this tree density. We will 
+                      ! reallocate to this in future cuts.
+                      coppice_dens(ipts,ivm)=SUM(circ_class_n(ipts,ivm,:))
+                      
+                      ! Mark all trees for the first coppice cut.
+                      circ_class_kill(ipts,ivm,:,ifm_src,icut_cop1)= &
+                           circ_class_n(ipts,ivm,:)
+
+                   ELSEIF(nrotations < src_nrots(ivm))THEN
+
+                      ! Debug
+                      IF(printlev_loc>=4) WRITE(numout,*) 'Forestry, ' &
+                           // 'SRC standard harvest. '
+                      !-
+
+                      ! This is a standard harvest where we take the
+                      ! aboveground biomass and leave the belowground.
+                      ! Mark all trees for a standard coppice cut.
+                      circ_class_kill(ipts,ivm,:,ifm_src,icut_cop2)=&
+                           circ_class_n(ipts,ivm,:)
+
+                  ELSE
+
+                      WRITE(numout,*) 'ERROR: Forestry, How did we arrive '&
+                           // 'here? We must have '
+                      WRITE(numout,*) 'somehow skipped the harvest in SRC. '
+                      WRITE(numout,*) 'ipts, ivm: ',ipts,ivm
+                      WRITE(numout,*) 'nrotations,src_nrots(ivm): ',&
+                           nrotations,src_nrots(ivm)
+                      IF(err_act.GT.1) CALL ipslerr(3,'ERROR: forestry', &
+                           'Somehow skipped harvest in SRC.',&
+                           'Look in the output file for ERROR.','')
+
+                   ENDIF ! check to see how many rotations we've done
+
+
+                ENDIF ! checking if it's a harvest year
+
+             ELSE
+
+                WRITE(numout,*) 'Forestry, We do not have any action '&
+                     //'for this management strategy'
+                WRITE(numout,*) 'forest_managed(ipts,ivm),ipts,ivm ', &
+                     forest_managed(ipts,ivm),ipts,ivm
+                IF(err_act.GT.1) CALL ipslerr(3,'ERROR: forestry', &
+                     'No action for this management strategy.',&
+                     'Look in the output file for ERROR.','')
+
+             ENDIF ! test of management strategy
+
+          END IF
+          
+       ENDDO pft
+
+    ENDDO
+
+    ! Debug
+    IF(printlev_loc>=4)THEN
+       DO ipts=1,npts
+          DO ivm=1,nvm
+
+             DO icir = 1,ncirc
+                IF(ipts == test_grid .AND. ivm == test_pft)THEN
+                   WRITE(numout,*) 'Forestry, How many trees do we kill?'
+                   WRITE(numout,*) 'Name  icir  test_pft  circ_class_kill  '
+                   WRITE(numout,*) 'Thin ',icir,test_pft,&
+                     circ_class_kill(test_grid,test_pft,:,ifm_thin,icut_thin)
+                   WRITE(numout,*) 'Clearcut ',icir,test_pft,&
+                        circ_class_kill(test_grid,test_pft,:,ifm_thin,icut_clear)
+                   WRITE(numout,*) 'Coppice 1 ',icir,test_pft,&
+                        circ_class_kill(test_grid,test_pft,:,ifm_cop,icut_cop1)
+                   WRITE(numout,*) 'Coppice 2 ',icir,test_pft,&
+                        circ_class_kill(test_grid,test_pft,:,ifm_cop,icut_cop2)
+                   WRITE(numout,*) 'SRC 1 ',icir,test_pft,&
+                        circ_class_kill(test_grid,test_pft,:,ifm_src,icut_cop1)
+                   WRITE(numout,*) 'SRC 2 ',icir,test_pft,&
+                        circ_class_kill(test_grid,test_pft,:,ifm_src,icut_cop2)
+                   WRITE(numout,*) 'SRC 3 ',icir,test_pft,&
+                        circ_class_kill(test_grid,test_pft,:,ifm_src,icut_cop3)
+                ENDIF
+             ENDDO
+
+          ENDDO
+       ENDDO
+    ENDIF
+    !-
+    
+
+ !! 4. Check mass balance closure
+  
+    ! We don't actually have to do this in forestry, since none of the 
+    ! pools are even touched in this subroutine.  The sole purpose of 
+    ! this routine is to schedule trees for killing which means that 
+    ! only circ_class_kill is changed.
+
+    IF (printlev >= 4) WRITE(numout,*) 'Leaving forestry'
+
+  END SUBROUTINE forestry
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : clearcut_harvest
+!!
+!>\BRIEF        Marks all the trees at this point and this PFT for clearing
+!!
+!! DESCRIPTION   : This marks all the trees in this stand for killing.  The
+!!                 difference between this and clearcut_noharvest is that
+!!                 these trees are moved into the harvest pools in stomate_kill,
+!!                 where only the branches should be left onsite.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::circ_class_kill; the number of trees in each circumference class to kill
+!!
+!! REFERENCE(S)   : See above, module description.
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!! \includegraphics[scale=0.5]{clearcutflow.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE clearcut_harvest(circ_class_n_temp, circ_class_kill_temp)
+
+    IMPLICIT NONE
+
+ !! 0  Variable and parameter declaration
+
+    !! 0.1 Input variables
+    REAL(r_std), DIMENSION(ncirc), INTENT(IN)            :: circ_class_n_temp          !! Number of trees in each circumference 
+                                                                                       !! class 
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(ncirc), INTENT(OUT)           :: circ_class_kill_temp       !! Number of trees within a circ that needs
+                                                                                       !! to be killed @tex $(ind m^{-2})$ @endtex  
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+   
+
+!_ ================================================================================================================================
+
+
+    ! This routine has gotten much simpler.  All we want to do here is to
+    ! indicate how many trees we want to kill.  The actual killing of
+    ! the trees will be done in lpj_gap.  As this is a clearcut, we
+    ! want to kill all of the trees.
+    circ_class_kill_temp(:)=circ_class_n_temp(:)
+
+
+  END SUBROUTINE clearcut_harvest
+
+!! ================================================================================================================================
+!! SUBROUTINE    : thinning
+!!
+!>\BRIEF        Thinning of the stand in gridpoint i for PFT j according to the
+!! management type (self-thinning, anthropogenic thinning, smoothed anthropogenic
+!! thinning or coppicing). Selects which trees are thinned in order to respect 
+!! self-thinning rules or rdi_objective. Only trees with circumference lower than 
+!! circ_lim can be thinned.
+!!
+!! DESCRIPTION   : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::circ_ij0; circumference of all individual trees 
+!! before thinning for 1 ha at gridpoint i and for PFT j (m), ::vol_thinned 
+!! Volume of thinned trees including waste wood \f$(m^3 ha^{-1})\f$ all other readjusted 
+!! stand-level variables: ::rdi, ::ind, ::av_height, ...
+!!
+!! REFERENCE(S)   : See above, module description.
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!! \includegraphics[scale=0.5]{thinningflow.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE thinning(tmin,tmax,thstrat,diameters_temp, &
+       circ_temp,circ_class_kill_temp,circ_class_n_temp,&
+       rdi_limit,ivm,ipts)
+    
+ !! 0  Variable and parameter declaration
+    
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(in)                :: tmin
+    REAL(r_std), INTENT(in)                :: tmax
+    REAL(r_std), INTENT(in)                :: thstrat
+    REAL(r_std), INTENT(in)                :: rdi_limit
+    REAL(r_std), DIMENSION(ncirc), INTENT(in)                :: diameters_temp
+    REAL(r_std), DIMENSION(ncirc), INTENT(in)                :: circ_temp
+    REAL(r_std), DIMENSION(ncirc), INTENT(in)                :: circ_class_n_temp
+    INTEGER(i_std),INTENT(IN)                  :: ivm
+    INTEGER(i_std),INTENT(IN)                  :: ipts
+
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(ncirc), INTENT(out)                :: circ_class_kill_temp
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(ncirc)                :: probability
+    REAL(r_std), DIMENSION(ncirc)                :: circ_class_kill_pot
+    REAL(r_std)                                  :: circmax
+    REAL(r_std)                                  :: circmin
+    REAL(r_std)                                  :: current_rdi
+    REAL(r_std)                                  :: potential_rdi
+    REAL(r_std)                                  :: dead_trees
+    REAL(r_std)                                  :: previous_step
+    INTEGER    :: icir,endcir,startcir,inccir,nsteps_tried
+
+
+   INTEGER :: istep1 
+
+!_ ================================================================================================================================    
+
+   ! We are going to assign a thinning probability to every 
+   ! circumference class, based on Eq. 12 in Bellassen 2010.  
+   ! He does it there for individual trees. The equation 
+   ! differs based on the thinning strategy used (from above or below).
+   circ_class_kill_temp(:)=zero
+   circmin=circ_temp(1)
+   circmax=circ_temp(ncirc)
+   probability(:)=zero
+   
+   DO icir=1,ncirc
+      
+      IF(thstrat .GE. zero)THEN
+
+         ! thinning from below         
+         IF(ncirc == 1)THEN
+
+            ! In this case, circmin=circmax and the denominator will be
+            ! zero.  However, if we have only one circ class it doesn't really
+            ! matter what the probability is set to, because all the biomass
+            ! has to come from this circ class.  So we set it equal to the 
+            ! minimum probability.
+            probability(icir)=tmin
+            
+         ELSE
+
+            probability(icir)=tmin+(tmax-tmin)*((circmax-circ_temp(icir))/&
+                 (circmax-circmin))**thstrat
+            
+         ENDIF ! ncirc ==1
+         
+      ELSE !thstrat
+         
+         ! thinning from above
+         IF(ncirc == 1)THEN
+          
+            ! Same issue as above
+            probability(icir)=tmin
+
+         ELSE
+
+            probability(icir)=tmin+(tmax-tmin)*&
+                 ((circ_temp(icir)-circmin)/(circmax-circmin))**ABS(thstrat)
+            
+         ENDIF !ncirc == 1
+
+      ENDIF ! thstrat
+
+      !+++CHECK+++
+      ! This is a temporary fix to prevent a hang from occuring.  
+      ! Still need to figure out what causes the middle circumference 
+      ! class to have a larger model tree than the highest circ class.
+      ! Some work was done on figuring that out and two possible cases 
+      ! were identified.
+      
+      ! First, when prescribing the biomass, the code truncates the 
+      ! distribution. So when many ncirc are used, the largest circ 
+      ! classes all contain trees with the same dimensions but 
+      ! typically with very low densities. In gap_clean the biomass
+      ! is divided by the number of trees to recalculate 
+      ! circ_class_biomass. Because circ_class_n is very small (1e-10), 
+      ! machine precision can cause circ_classes to change their order. 
+      ! This is unlikely to be the main problem but clearly it is
+      ! not a good start. A routine to sort the circ_classes was added 
+      ! to mortality_clean. 
+      
+      ! Second, in growth allocation the reserve and labile pools are 
+      ! dealt with at the stand level and then calculated at the 
+      ! individual tree level. The same problem can happen again 
+      ! (small differences getting divided by small number of individuals. 
+      ! The growth_fun_alloc code was checked and the ::circ_class_biomass
+      ! was in correct order until the end of the allocation code. Then 
+      ! labile and reserve pools are calculated and the totals are 
+      ! distributed over the circ classes. That is where the classes are 
+      ! no longer ordered. Again, the initial differences are small and 
+      ! it remains unclear whether this problem can propagate in long 
+      ! simulations. Even if it does propagate it is unlikely this is a real
+      ! problem as carbon is preserved at all times. 
+      IF(hack_circ_class)THEN
+         IF(probability(icir) .LT. min_stomate) probability(icir)=zero
+      ENDIF
+      !+++++++++++
+
+      ! Debug
+      IF(printlev_loc>=4 .AND. ivm == test_pft .AND. ipts == test_grid)THEN
+         WRITE(numout,*) 'probability',probability(icir),icir
+         WRITE(numout,*) 'circ_temp',circ_temp(icir),icir
+         WRITE(numout,*) 'tmin,tmax',tmin,tmax
+         WRITE(numout,*) 'circmin,circmax',circmin,circmax
+         WRITE(numout,*) 'thstrat',thstrat
+      ENDIF
+      CALL flush(numout)
+      !-
+      
+   ENDDO
+
+   ! now we need to kill enough trees to get down to the proper density.  If we
+   ! are thinning from above, we start from the highest class, and from
+   ! below, we start from the lowest.  One thing to keep in mind here is
+   ! that it is possible that we have not removed enough trees after looping
+   ! through all the circ classes one time, so we need to keep looping through 
+   ! until our density is low enough.
+   IF(thstrat .GE. zero)THEN
+      startcir=1
+      endcir=ncirc
+      inccir=1
+   ELSE
+      startcir=ncirc
+      endcir=1
+      inccir=-1
+   ENDIF
+
+   istep1=0
+   thin_out:DO
+      istep1=istep1+1
+      
+      IF(istep1 .GT. 1000)THEN
+
+         ! Something is wrong.  Why did it take us so many steps?
+         WRITE(numout,*) 'WARNING: Taking too many steps in thinning'
+         WRITE(numout,*) 'ipts,ivm: ',ipts,ivm
+         WRITE(numout,*) 'current_rdi, rdi_limit: ',current_rdi,rdi_limit
+         IF(istep1 .GT. 1001)THEN
+            WRITE(numout,*) 'Exiting the loop'
+            CALL flush(numout)
+            EXIT thin_out
+         ENDIF
+
+      ENDIF
+      
+      DO icir=startcir,endcir,inccir
+
+         ! check the density to see if we have gotten enough trees.  
+         ! Notice we only want to include the trees that will still 
+         ! be living at the end of this step
+         current_rdi=calculate_rdi(diameters_temp(:),circ_class_n_temp(:)-&
+              circ_class_kill_temp(:),ivm)
+
+         ! Debug
+         IF(printlev_loc>=4 .AND. ivm == test_pft .AND. &
+              ipts == test_grid)THEN
+            WRITE(numout,*) 'Debugging thinning',ivm
+            WRITE(numout,*) 'icir,startcir,endcir,inccir',&
+                 icir,startcir,endcir,inccir
+            WRITE(numout,*) 'rdi_limit',rdi_limit
+            WRITE(numout,*) 'current_rdi', current_rdi
+            CALL flush(numout)
+         ENDIF
+         !-
+
+         IF( current_rdi .LE. rdi_limit)THEN      
+            EXIT thin_out
+         ENDIF
+
+         ! if not, we need to kill some or all of the trees in this class
+         ! this is the maximum number of trees we can kill in this circ class
+         dead_trees=probability(icir)*&
+              (circ_class_n_temp(icir)-circ_class_kill_temp(icir))
+
+         ! if we kill all these trees, can we get the RDI as low as we want?
+         circ_class_kill_pot(:)=circ_class_kill_temp(:)
+         circ_class_kill_pot(icir)=circ_class_kill_temp(icir)+dead_trees
+         potential_rdi=calculate_rdi(diameters_temp(:),&
+              circ_class_n_temp(:)-circ_class_kill_pot(:),ivm)
+
+         ! Debug
+         IF(printlev_loc>=4 .AND. ivm == test_pft .AND. ipts == test_grid)THEN
+            WRITE(numout,*) 'potential_rdi,rdi_limit',potential_rdi,rdi_limit
+            WRITE(numout,*) 'diameters_tmep',diameters_temp(icir)
+            WRITE(numout,*) 'circ_class_n_temp',circ_class_n_temp(icir)
+            WRITE(numout,*) 'circ_class_kill_pot',circ_class_kill_pot(icir)
+            WRITE(numout,*) 'circ_class_kill_temp',circ_class_kill_temp(icir)
+            WRITE(numout,*) 'dead_trees',dead_trees
+            WRITE(numout,*) 'probability',probability(icir)
+            CALL flush(numout)
+         ENDIF
+         !-
+
+         IF(circ_class_kill_pot(icir) .LT. -min_stomate)THEN
+            WRITE(numout,*) 'ERROR: Negative value of circ_class_kill_pot.'
+            WRITE(numout,*) 'ivm: ',ivm,icir
+            WRITE(numout,*) 'pot ',circ_class_kill_pot(icir)
+            WRITE(numout,*) 'kill ',circ_class_kill_temp(icir)
+            WRITE(numout,*) 'n ',circ_class_n_temp(icir)
+            WRITE(numout,*) 'dead_trees ',dead_trees
+            IF (err_act.GT.1) CALL ipslerr_p (3,'forestry', &
+                 'Bad value of circ_class_kill_pot.',&
+                 'Look in the output file for ERROR.',&
+                 '')
+         ENDIF
+
+         IF(potential_rdi .LE. rdi_limit)THEN
+
+            ! yes we can.  How do we know how many trees to kill, though?  
+            ! The problem is that the RDI depends on the diameters of the 
+            ! remaining trees in a non-linear fashion. Let us do a simple 
+            ! bisection search. If we are here, we know that 
+            ! circ_class_kill_pot(icir) is too high. So cut it in half and 
+            ! try again.
+            previous_step=dead_trees/deux
+            circ_class_kill_pot(icir)=circ_class_kill_temp(icir)+previous_step
+            nsteps_tried=0
+            inner_loop:DO
+
+               potential_rdi=calculate_rdi(diameters_temp(:),&
+                    circ_class_n_temp(:)-circ_class_kill_pot(:),ivm)
+               nsteps_tried=nsteps_tried+1
+                
+               !+++CHECK+++
+               ! this value should be externalised
+               ! Our RDI is within our tolerance of the target, so we're good.
+               IF( ABS(potential_rdi - rdi_limit) .LE. 0.001_r_std)THEN
+                  EXIT inner_loop
+               ENDIF
+               !+++++++++++
+
+               ! Is our potential RDI too high or too low?
+               previous_step=previous_step/deux
+               IF(potential_rdi .GT. rdi_limit)THEN
+                  
+                  ! We need to kill more trees, so we add half of our 
+                  ! previous step size back.
+                  circ_class_kill_pot(icir)=circ_class_kill_pot(icir)+&
+                       previous_step
+                                
+               ELSE
+                  
+                  ! We need to kill fewer trees, so we take half of our 
+                  ! previous step size away.
+                  circ_class_kill_pot(icir)=circ_class_kill_pot(icir)-&
+                       previous_step
+
+               ENDIF
+
+               ! Debug
+               IF(ivm == test_pft .AND. ipts == test_grid .AND. &
+                    printlev_loc>=4)THEN
+                  WRITE(numout,*) 'nsteps_tried ',nsteps_tried
+                  WRITE(numout,*) 'pot ',circ_class_kill_pot(:)
+                  WRITE(numout,*) 'kill ',circ_class_kill_temp(:)
+                  WRITE(numout,*) 'n ',circ_class_n_temp(:)
+                  CALL flush(numout)
+               ENDIF
+               !-
+
+               !+++CHECK+++
+               ! this value should be externalised
+               IF(nsteps_tried .GT. 100)THEN
+                  WRITE(numout,*) 'ERROR:Trying too many steps in '&
+                       //'the bisection search in forestry thinning.'
+                  WRITE(numout,*) 'ivm: ',ivm
+                  WRITE(numout,*) 'pot ',circ_class_kill_pot(:)
+                  WRITE(numout,*) 'kill ',circ_class_kill_temp(:)
+                  WRITE(numout,*) 'n ',circ_class_n_temp(:)
+                  IF(err_act.GT.1) CALL ipslerr_p (3,'ERROR: forestry', &
+                       'Too many steps in the bisection.',&
+                       'Look in the output file for ERROR.','')
+               ENDIF
+               !+++++++++++
+               
+            ENDDO inner_loop
+
+            ! Schedule the trees for killing.
+            circ_class_kill_temp(icir)=circ_class_kill_pot(icir)
+            EXIT thin_out
+
+         ELSE
+
+            ! No we can't, so we have to kill all possible trees and 
+            ! move onto the next class
+            circ_class_kill_temp(icir)=circ_class_kill_temp(icir)+dead_trees
+            
+         ENDIF
+
+        
+      ENDDO
+          
+      ! check to see if we have any trees left.  We should!  
+      ! If not, there is a problem, and we need to catch it 
+      ! to avoid an infinite loop.
+      IF( (SUM(circ_class_n_temp(:)) - SUM(circ_class_kill_temp(:))) .LE. &
+           min_stomate)THEN
+         WRITE(numout,*) 'ERROR: We are thinning, but we have no trees left!'
+         WRITE(numout,*) 'ivm ',ivm
+         WRITE(numout,*) 'kill ',circ_class_kill_temp(:)
+         WRITE(numout,*) 'n ',circ_class_n_temp(:)
+         IF(err_act.GT.1) CALL ipslerr_p (3,'ERROR: forestry', &
+              'Thinning, but no trees left.',&
+              'Look in the output file for ERROR.','')
+       ENDIF
+       
+    ENDDO thin_out
+    
+  END SUBROUTINE thinning
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE  species_change
+!!
+!>\BRIEF       When a PFT is harvest a new PFT with another species and management strategy 
+!!             is replanted.
+!!
+!! DESCRIPTION   :   When a PFT is harvest a new PFT with another species and management strategy 
+!!                   is replanted. The routine creates new values for veget_cov_max_new which are then
+!!                   used in sapiens_lccghange to really change the PFTs.
+!!
+!!                   The routine species_change is only used when ::ok_change_species is .TRUE. and 
+!!                   makes use of the information contained in the species_change map and the 
+!!                   desired_fm_map. As an alternative to these maps single values can be specified
+!!                   in the run.def for species_change_force and fm_change_force. Although in
+!!                   species change and management change are more or less independently called in
+!!                   in the code the objective is to call them at the same time. This independence
+!!                   was used a bit for debugging but hasn't been tested.
+!!                   
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::forest_managed, ::veget_cov_max_new
+!!
+!! REFERENCE(S)   : 
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+
+  SUBROUTINE species_change(npts, lpft_replant, veget_cov_max_new_species, forest_managed, &
+       species_change_map, veget_cov_max, fm_change_map)
+
+    IMPLICIT NONE
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                       :: npts                   !! Domain size (unitless)
+    INTEGER(i_std), DIMENSION(:,:), INTENT(in)       :: species_change_map     !! A map which gives the PFT number that each
+                                                                               !! PFT will be replanted as in case of a clearcut.
+                                                                               !! (1-nvm,unitless)
+    INTEGER(i_std), DIMENSION(:,:), INTENT(in)       :: fm_change_map          !! A map which gives the desired FM strategy when
+                                                                               !! the PFT will be replanted after a clearcut.
+                                                                               !! (1-nvm,unitless)
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: veget_cov_max              !! "Maximal" coverage fraction of a PFT (LAI 
+                                                                               !! -> infinity) on ground. Includes
+                                                                               !! the nobio fraction, so may sum to
+                                                                               !! less than unity.
+    REAL(r_std), DIMENSION(:,:),INTENT(inout)        :: veget_cov_max_new_species  !! New "maximal" coverage fraction of a PFT 
+                                                                               !! (LAI -> infinity)  Includes
+                                                                               !! the nobio fraction, so may sum to
+                                                                               !! less than unity. (unitless)
+    LOGICAL, DIMENSION(:,:), INTENT(inout)           :: lpft_replant           !! Set to true if a PFT has been clearcut
+                                                                               !! and needs to be replaced by another species
+    INTEGER(i_std), DIMENSION (:,:), INTENT(inout)   :: forest_managed         !! forest management flag (is the forest 
+                                                                               !! being managed?)
+
+    !! 0.4 Local variables
+    INTEGER                                          :: ipts,ivm,count         !! Indices
+    INTEGER                                          :: ivm_young_new_species  !! Indices
+    INTEGER                                          :: ivm_young_old_species  !! Indices
+    REAL(r_std)                                      :: diff                   !! Difference in surface area before and after 
+                                                                               !! a species change (should be zero!)
+    REAL(r_std)                                      :: temp_veget_cov_max 
+!================================================================================================================================
+    
+    ! Initialize variable(s)
+    veget_cov_max_new_species(:,:)=zero
+    count=zero
+
+    ! Check whether replanting is required and if so update
+    ! the management strategy where needed.
+    DO ipts = 1,npts
+
+       WRITE(numout,*) 'START of routine - values'
+       WRITE(numout,*) 'pixel,PFT,  veget_cov_max, veget_cov_max_new_species'
+       DO ivm=1,nvm
+          WRITE(numout,*) ipts, ivm,veget_cov_max(ipts,ivm),&
+                 veget_cov_max_new_species(ipts,ivm)
+       ENDDO
+
+       ! Search the PFT that needs to be replanted and replant it
+       DO ivm=1,nvm
+
+          IF (is_tree(ivm)) THEN
+
+             ! Was the PFT harvested this year? If so, there is an
+             ! opportunity to replant
+             IF(lpft_replant(ipts,ivm))THEN
+
+                ! Keep track of the number of species changes. In
+                ! case none occur veget_cov_max_new should equal veget_cov_max
+                ! else the mass balance check in LCC will think
+                ! there was a change in PFTs and will generate errors.
+                count = count + 1
+
+                ! Plant the new PFT in the youngest age class. Find
+                ! out which PFT is the youngest member of the group 
+                ! that we want to regrow.
+                ivm_young_new_species = zero
+                DO
+
+                   ! Repeat this loop until the matching age class is found
+                   ! or an error occurs
+                   ivm_young_new_species=ivm_young_new_species+1
+
+                   IF(ivm_young_new_species .GT. nvm)THEN
+                      WRITE(numout,*) "ERROR: Can not find young PFT for this age class."
+                      WRITE(numout,*) "ipts, ivm: ",ipts, ivm
+                      WRITE(numout,*) "species_change_map(ipts,:): ",species_change_map(ipts,:)
+                      CALL ipslerr_p (3,'sapiens_forestry', &
+                           'Could not find the youngest PFT in this age class.',&
+                           'Something may be wrong with the species_change_map.',&
+                           'Check the out_orchidee file for details.')
+                   ENDIF
+
+                   ! It is confirmed that we found ivm_young_new_species for the pft
+                   ! under consideration. This test requires that the age classes are
+                   ! defined such that the youngest age class comes first and that the
+                   ! age classes of the same species are grouped (see sapiens_lcchange.f90
+                   ! where the age classes are defined)
+                   IF(agec_group(ivm_young_new_species) == species_change_map(ipts,ivm))THEN
+                      EXIT
+                   ENDIF
+
+                ENDDO ! Searching youngest age class for this species
+
+                ! The lpft_replant flag is set in sapiens_forestry or stomate_kill.
+                ! Soon after those routines the killing takes place and when
+                ! age classes are used veget_cov_max is updated. This means that
+                ! the veget_cov_max of the oldest age class that was just harvested
+                ! has been moved to the youngest age class of the species that
+                ! was harvested. Possibly there was already something in this youngest
+                ! age class from previous time steps. The veget_cov_max of the youngest
+                ! ages class may thus be larger than the veget_cov_max of the age class 
+                ! that was harvested at this time step.
+                ivm_young_old_species = start_index(agec_group(ivm))
+
+                ! Is there really a species change?
+                IF (ivm .EQ. ivm_young_new_species) THEN
+
+                   ! lpft_replant is true but there is no real species change
+                   ! Changes from PFTs earlier in the list could already have
+                   ! resulted in an increase of veget_cov_max_new_species
+                   !veget_cov_max_new_species(ipts,ivm) = veget_cov_max_new_species(ipts,ivm) + &
+                   !     veget_cov_max(ipts,ivm)
+                   veget_cov_max_new_species(ipts,ivm_young_new_species) = &
+                        veget_cov_max_new_species(ipts,ivm_young_new_species) + &
+                        veget_cov_max(ipts,ivm)
+
+                   !---TEMP---
+                   IF(printlev_loc>=4) THEN
+                      WRITE(numout,*) 'Species change - PFT is the same', ivm
+                      WRITE(numout,*) 'Management type, ', &
+                           forest_managed(ipts,ivm)
+                   ENDIF
+                   !----------
+
+                ELSE
+
+                   ! There is a real species change
+                   ! Add the ground area of the old PFT to the ground area of the new 
+                   ! PFT.
+                   ! +++CHECK+++
+                   ! It seems that in relatively few cases the veget_cov_max of the
+                   ! killed PFT has not been moved to the youngest age class
+                   ! of that PFT - Need to find when this happens and fix the 
+                   ! problem where it occurs (may be it is related to FM3?)
+                   ! but here we added a quick patch. Note that
+                   ! this code is also used in the case where the youngest age
+                   ! class of the PFT was removed. The code moves the whole PFT 
+                   ! at once the old PFT can be set to zero.
+                   IF (veget_cov_max(ipts,ivm) .GT. min_stomate) THEN
+
+                      ! Replant with the new species
+                      veget_cov_max_new_species(ipts,ivm_young_new_species) = &
+                           veget_cov_max_new_species(ipts,ivm_young_new_species) + &
+                           veget_cov_max(ipts,ivm)
+                      veget_cov_max_new_species(ipts,ivm) = zero
+                      
+                      ! Patch the old species - in land cover change 
+                      ! (adjust_delta_veget) we check whether the changes make 
+                      ! sense. Those checks will fail unless we mmake it look
+                      ! as if the the youngest PFT was replanted by another
+                      ! species
+                      IF (ivm .EQ. ivm_young_old_species) THEN
+                        WRITE(numout,*) &
+                        '1 st class of age cant be replaced by himself' , ivm, ivm_young_old_species
+                      ELSE
+                        !veget_cov_max(ipts,ivm_young_old_species) = &
+                        !    veget_cov_max(ipts,ivm_young_old_species) + veget_cov_max(ipts,ivm)
+                        !veget_cov_max(ipts,ivm) = zero
+                      ENDIF
+                      !---TEMP---
+                      IF(printlev_loc>=4) THEN
+                         WRITE(numout,*) 'Species change - patch', ivm
+                         WRITE(numout,*) 'Future PFT',veget_cov_max(ipts,ivm_young_old_species)
+                         WRITE(numout,*) 'current PFT',veget_cov_max(ipts,ivm)
+                         WRITE(numout,*) 'Management type, ', forest_managed(ipts,ivm)
+                      ENDIF
+                      !----------
+
+                   ! Pure case
+                   ELSEIF (veget_cov_max(ipts,ivm_young_old_species) .GT. min_stomate) THEN 
+
+                      ! The PFT with the replant label is for example 47. Because the
+                      ! PFT has been correctly killed it was replanted in PFT 45 but 
+                      ! for PFT 45 the replant flag is FALSE so the surface area will
+                      ! be copied from veget_cov_max(ipts,45) to 
+                      ! veget_cov_max_new_species(ipts,45). We will first undo the copy
+                      ! from 47 to 45. Say that,for example, PFT 45 (young_old) had to 
+                      ! become PFT 13 (young_new). We will then replant the correct
+                      ! surface are with PFT 13.
+                      veget_cov_max_new_species(ipts,ivm_young_old_species) = &
+                           veget_cov_max_new_species(ipts,ivm_young_old_species) - &
+                           veget_cov_max(ipts,ivm_young_old_species)
+                      veget_cov_max_new_species(ipts,ivm_young_new_species) = &
+                           veget_cov_max_new_species(ipts,ivm_young_new_species) + &
+                           veget_cov_max(ipts,ivm_young_old_species)
+
+                      !---TEMP---
+                      IF(printlev_loc>=4) THEN
+                         WRITE(numout,*) 'Species change - pure case', ivm
+                         WRITE(numout,*) 'management type, ', &
+                              forest_managed(ipts,ivm_young_new_species)
+                      ENDIF
+                      !----------
+
+                   ! Unexpected case
+                   ELSE
+
+                      WRITE(numout,*) 'WARNING: species change - unexpected case'
+                      IF(err_act.GT.1)THEN
+                         WRITE(numout,*) "ipts, ivm: ",ipts, ivm
+                         CALL ipslerr_p (3,'sapiens_forestry', &
+                           'Species change','unexpected case in IF-loop','')
+                      ENDIF
+
+                   ENDIF
+                   ! +++++++++++
+
+                ENDIF ! Anthropogenic species change?
+
+                ! Use the new management strategy. The way the desired management
+                ! maps were made follows the species logic. A conifer species will
+                ! never have FM 3 but a deciduous species can. If a conifer is
+                ! changed to a deciduous we need to use the FM of the new deciduous
+                ! species in this example FM3. This is reflected in the code by
+                ! using the index fom ivm_young_new_species in the left and the right 
+                ! hand side. Note that we don't care whether the new PFT has already
+                ! some biomass in it or not. Irrespective of its condition we change
+                ! FM to the desired strategy.
+                forest_managed(ipts,ivm_young_new_species) = &
+                     fm_change_map(ipts,ivm_young_new_species)
+
+                !---TEMP---
+                IF(printlev_loc>=4)THEN
+                   WRITE(numout,*) 'Anthropogenic species change ?'
+                   WRITE(numout,*) 'ipts, ivm, ',ipts, ivm  
+                   WRITE(numout,*) 'ivm_young_old_species',ivm_young_old_species
+                   WRITE(numout,*) 'Species we want to change to, ',species_change_map(ipts,ivm)
+                   WRITE(numout,*) 'youngest age class for that species, ', &
+                        ivm_young_new_species                  
+                   WRITE(numout,*) 'forest_managed, ',forest_managed(ipts,ivm_young_new_species)
+                ENDIF
+                !----------
+
+             ELSE
+
+                ! No replanting !
+                ! veget_cov_max_new will be the same as the old_veget_cov_max.
+                ! We add it here just in case another PFT was added to this one
+                ! above.
+                veget_cov_max_new_species(ipts,ivm) = &
+                     veget_cov_max_new_species(ipts,ivm)+veget_cov_max(ipts,ivm)
+
+                ! Given that forest_managed is an inout variable nothing should
+                ! be done because we just keep the initial management strategy
+
+             ENDIF
+
+          ELSE
+
+             ! Bare soil, grassland and cropland
+             ! veget_cov_max_new will be the same as the old_veget_cov_max.
+             ! We add it here just in case another PFT was added to this one
+             ! above.
+             veget_cov_max_new_species(ipts,ivm) = &
+                  veget_cov_max_new_species(ipts,ivm) + veget_cov_max(ipts,ivm)
+
+          ENDIF
+
+       ENDDO !nvm
+
+       !---TEMP---
+       IF(printlev_loc>=4)THEN
+          WRITE(numout,*) 'End of routine - final values'
+          WRITE(numout,*) 'pixel,PFT,  veget_cov_max, veget_cov_max_new_species'
+          DO ivm=1,nvm
+             WRITE(numout,*) ipts, ivm,veget_cov_max(ipts,ivm),&
+                 veget_cov_max_new_species(ipts,ivm)
+          ENDDO
+
+          ! Write warning
+          diff = SUM(veget_cov_max_new_species(ipts,:)-veget_cov_max(ipts,:)) 
+          IF( ABS(diff) .GT. min_stomate )THEN
+             WRITE(numout,*) 'WARNING: species - change surface area is not preserved'
+             CALL ipslerr_p (2,'sapiens_forestry', &
+                  &          'species_change','surface area is not preserved','')
+          ELSE
+              WRITE(numout,*) 'Losses and gains cancel each other out'
+          ENDIF
+          diff = veget_cov_max_new_species(ipts,1)-veget_cov_max(ipts,1)
+          IF( ABS(diff) .GT. min_stomate )THEN
+             WRITE(numout,*) 'WARNING: species - area of PFT1 is not preserved'
+             CALL ipslerr_p (2,'sapiens_forestry', &
+                  &          'species_change','PFT1 is not preserved','')
+          ELSE
+              WRITE(numout,*) 'No leakage to PFT1'
+          ENDIF
+       ENDIF
+       !-----------
+
+    ENDDO ! npts
+
+    ! Reset this variable
+    lpft_replant(:,:)=.FALSE.
+    
+    ! In case no species changes occured veget_cov_max_new 
+    ! should equal veget_cov_max else the mass balance 
+    ! check in LCC will think there was a change in 
+    ! PFTs and will generate errors.
+    IF (count .LT. min_stomate) THEN
+       veget_cov_max_new_species(:,:) = veget_cov_max(:,:)
+    ENDIF
+
+  END SUBROUTINE species_change
+
+
+!! ================================================================================================================================
+!! SUBROUTINE  : change_species_change
+!!
+!>\BRIEF: Check whether there is an opportunity to replant a different species
+!!
+!! DESCRIPTION : PFTs that died or were harvested should all be empty. This 
+!!               is the information that is used to decide whether there is
+!!               an opportunity to replant.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+SUBROUTINE flag_species_change(npts, veget_cov_max, circ_class_biomass, circ_class_n, &
+     lpft_replant, forest_managed)
+
+ !! 0. Variable and parameter description
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                  :: npts                    !! Number of pixels
+    REAL(r_std), DIMENSION(:,:), INTENT(in)     :: veget_cov_max               !! Veget_max at the moment this routine is checked
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in) :: circ_class_biomass    !! ciconference level biomass @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)     :: circ_class_n          !! Density of individuals    
+    INTEGER(i_std), DIMENSION (:,:), INTENT(in) :: forest_managed          !! forest management flag (is the forest 
+                                                                           !! being managed?)
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+     LOGICAL, DIMENSION(:,:), INTENT(inOUT)     :: lpft_replant            !! Set to true if a PFT has been clearcut
+                                                                           !! and needs to be replaced by another species
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                              :: ipts,ivm                !! Indices
+    INTEGER(i_std)                              :: error                   !! Counter for the numbers of errors
+    REAL(r_std)                                 :: biomass
+    REAL(r_std)                                 :: ind
+
+!===============================================================================================================================
+ 
+    IF(printlev_loc.GT.4) WRITE(numout,*) 'Entering: change forestry'
+
+    !! 1. Initilaze variables
+    error = zero
+    !! 2. Check whether there is an opportunity to change the
+    !     species. If so flag the opportunity so we can deal 
+    !     with the details later.
+    DO ivm = 1,nvm
+
+       ! Only forest PFT can be replanted for the moment
+       IF(is_tree(ivm))THEN
+
+          DO ipts = 2,npts
+            biomass=SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),2))
+            ind=SUM(circ_class_n(ipts,ivm,:))
+             ! If the flag is already true, don't change it
+             IF(.NOT.lpft_replant(ipts,ivm))THEN
+
+                ! There is no veget_cov_max. Check whether these PFTs are indeed
+                ! empty. If not we have a serious problem
+                IF(veget_cov_max(ipts,ivm).LT.min_stomate)THEN
+                   IF(biomass.GT.min_stomate .OR. ind.GT.min_stomate)THEN
+
+                      WRITE(numout,*) 'ERROR - no veget_cov_max but biomass and/or n',ipts,ivm
+                      WRITE(numout,*) 'biomass, ind, fm, ',biomass,&
+                           ind, forest_managed(ipts,ivm)
+                      error = error+1
+
+                   ELSEIF(biomass.LT.min_stomate .AND. ind .LT.min_stomate)THEN
+
+                      ! This is the situation we expect. Do nothing
+                      
+                   ELSE
+
+                      ! May be we overlooked a condition
+                      WRITE(numout,*) 'ERROR - overlooked a possible case 1'
+                      WRITE(numout,*) 'biomass, n, fm, ',biomass,&
+                           ind, forest_managed(ipts,ivm)
+                      error = error+1
+
+                   ENDIF
+                   
+                   ! There is veget_cov_max. This is where the interesting cases should be
+                ELSEIF(veget_cov_max(ipts,ivm).GT.min_stomate)THEN
+
+                   IF(biomass.GT.min_stomate .AND. ind .GT.min_stomate)THEN
+                   
+                      ! This is a simple case: there is still biomass and individuals
+                      ! so the stand is alive and there is no opportunity to change
+                      ! the species. Note that in sapiens_forestry ::forest_managed
+                      ! may already have been changed in case that the desired fm is
+                      ! conservation. It is already done in forestry because if 
+                      ! fm 2 to 4 is changed to conservation we will not harvest but 
+                      ! leave the biomass on site.
+                      lpft_replant(ipts,ivm) = .FALSE.
+           
+                   ELSEIF( biomass .LT.min_stomate .AND. ind .LT.min_stomate)THEN
+                      
+                      ! The stand was killed or harvest so if the PFT is under
+                      ! human management here is an opportunity to replant. 
+                      IF(forest_managed(ipts,ivm).EQ.ifm_none)THEN
+                      
+                         ! If the stand is under a conservation strategy the species will
+                         ! not change. Stands under conservation will switch FM without
+                         ! a loss of biomass. Hence, there is no chance to replant.
+                         ! If the stand is under conservation and dies from natural causes 
+                         ! it will be replanted with the same species
+                         lpft_replant(ipts,ivm) = .FALSE.
+                         WRITE(numout,*) 'Replant - no biomass & no ind, management',ipts,ivm
+                         WRITE(numout,*) 'biomass, ind, fm, ',biomass,ind, forest_managed(ipts,ivm)
+                         WRITE(numout,*) 'lpft_replant, ',lpft_replant(ipts,ivm)
+
+                      ELSEIF(forest_managed(ipts,ivm).NE.ifm_none)THEN
+                      
+                         ! The stand was managed. This is a chance to change the species.
+                         ! May be we wont use the chance but that will only be checked at
+                         ! the end of the year in species_change (sapiens_forestry.f90) 
+                         lpft_replant(ipts,ivm) = .TRUE.
+                         WRITE(numout,*) 'Replant - no biomass & no ind, conservation',ipts,ivm
+                         WRITE(numout,*) 'biomass, ind, fm, ',biomass,ind, forest_managed(ipts,ivm)
+                         WRITE(numout,*) 'lpft_replant, ',lpft_replant(ipts,ivm)
+
+                      ELSE
+
+                         WRITE(numout,*) 'ERROR - overlooked a possible option 1', ipts, ivm
+                         WRITE(numout,*) 'biomass, ind, fm, ',biomass, ind, forest_managed(ipts,ivm)
+                         WRITE(numout,*) 'lpft_replant, ',lpft_replant(ipts,ivm)
+                         error = error+1
+
+                      ENDIF
+
+                   ELSE
+
+                      WRITE(numout,*) 'ERROR - overlooked a possible case 2'
+                      WRITE(numout,*) 'biomass, ind, fm, ',biomass,ind, forest_managed(ipts,ivm)
+                      WRITE(numout,*) 'lpft_replant, ',lpft_replant(ipts,ivm)
+                      error = error+1
+                   ENDIF
+
+                ELSE
+
+                   WRITE(numout,*) 'ERROR - overlooked a possible case 3'
+                   WRITE(numout,*) 'biomass, ind, fm, ',biomass,ind, forest_managed(ipts,ivm)
+                   WRITE(numout,*) 'lpft_replant, ',lpft_replant(ipts,ivm)
+                   error = error+1
+                   
+                ENDIF
+
+             ENDIF ! lpft_replant
+          
+          ENDDO ! ivm
+
+       ENDIF ! is_tree
+       
+    ENDDO ! ipts
+
+    IF(error.GT.zero)THEN
+       CALL ipslerr_p(3,'ERROR flag_species_change did not function as expected','','','')
+    ELSE
+       WRITE(numout,*) 'No ERRORs in flag_species_change'
+    ENDIF
+
+  END SUBROUTINE flag_species_change
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : read_in_fm_map
+!!
+!>\BRIEF        Read in a map that gives the forest management strategy
+!!              for each pixel and each PFT.
+!!
+!! DESCRIPTION   :  
+!!     
+!!
+!! FM = 1 : No human intervention (ORCHIDEE default)
+!!      2 : Thinnings based on the RDI, clearcuts based on tree density,
+!!              annual increment, and tree diameter.  Thinnings from above and
+!!              from below are determined by the sign of thstrat.
+!!      3 : Coppices
+!!      4 : Short rotation coppices
+!!
+!!       NOTE: This routine was mostly copied from slowproc where the PFTmap is read in.
+!!             Grid interpolation is used, but only to look at the nearby pixels to see
+!!             see which management strategy is dominant.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::forest_managed
+!!
+!! REFERENCE(S)   : 
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE read_in_fm_map ( npts, lalo, neighbours, resolution, contfrac, forest_managed )
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                             :: npts            !! Domain size - number of pixels 
+                                                                              !! (dimensionless)
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)             :: lalo            !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), DIMENSION(npts,8), INTENT(in)          :: neighbours     !! 
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)             :: resolution      !! The size in m of each grid-box in X and Y
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: contfrac        !! Fraction of continent in the grid
+
+    !! 0.2 Output
+    INTEGER(i_std), DIMENSION(npts,nvmap), INTENT(out)       :: forest_managed  !! Forest management flag: 0 = orchidee 
+                                                                              !! standard, 1= self-thinning only, 2= 
+                                                                              !! high-stand, 3= high-stand smoothed, 4= 
+                                                                              !! coppices 
+
+    !! 0.3 Modified fields
+
+
+    !! 0.4 Local variables
+    CHARACTER(LEN=80)                                      :: filename        !! A string to hold the file name
+    LOGICAL                                                :: debug=.FALSE.   !! A flag to print out debugging information.
+    INTEGER(i_std)                                         :: fid             !! The ID of the NetCDF file.
+    INTEGER(i_std)                                         :: nb_coord        !! The number of coordinates in the NetCDF file    
+    INTEGER(i_std)                                         :: nb_gat          !!
+    INTEGER(i_std)                                         :: nb_var          !! The number of variables in the NetCDF file
+    INTEGER(i_std)                                         :: nb_dim          !! The number of dimensions in the NetCDF file
+    INTEGER(i_std)                                         :: iml, jml, lml,ivm !! indices
+    INTEGER(i_std)                                         :: ip, inbv, jp    !! indices
+    LOGICAL                                                :: l_ex            !! A flag which indicates if a variable
+                                                                              !! exists in the NetCDF file
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)                 :: lat_lu, lon_lu  !! The latitude and longitude read in from
+                                                                              !! the NetCDF file    
+    INTEGER,DIMENSION(flio_max_var_dims)                   :: l_d_w           !! List of the dimension lengths of the variable
+                                                                              !! in the NetCDF file
+    INTEGER(i_std)                                         :: ipts            !! index
+    INTEGER(i_std)                                         :: ALLOC_ERR       !! A flag tripped if we have an error in allocation
+    REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE               :: fmmap_r         !! The map read in from the NetCDF file
+    INTEGER(i_std),DIMENSION(:,:,:),ALLOCATABLE            :: fmmap_i         !! The integer form of the map read in
+    INTEGER(i_std)                                         :: closest_lat     !! The index of the closest latitude we found.
+    INTEGER(i_std)                                         :: closest_lon     !! The index of the closest longitude we found.
+    REAL(r_std)                                            :: distance        !! The distance from the current point to the 
+                                                                              !! point on the map
+    REAL(r_std)                                            :: closest_dist    !! The distance to the closet point we've found.
+    INTEGER                                                :: large_int       !! A number which indicates that the grid data
+                                                                              !! is not available
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_ful, lon_ful
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: sub_area
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index
+    CHARACTER(LEN=30) :: callsign
+    INTEGER(i_std) :: ibvm, nbvmax,ifm, ivma
+    LOGICAL ::           ok_interpol ! optionnal return of aggregate_2d
+    REAL(r_std)                                            :: sum_fm,sumf
+    REAL(r_std),DIMENSION(nfm_types)                       :: fm_sum
+    LOGICAL ::           ltemp ! temporary logical variable
+  !_ ================================================================================================================================
+
+    IF ( printlev >= 4 ) WRITE(numout,*) 'Entering read_in_fm_map'
+
+    ! This integer has to be large enough that it never shows up on the map, without being
+    ! so large that is causes overflows.  Since none of the points on the map should be
+    ! larger than the number of FM strategies we have (nfm_types), this is sufficiently big.
+    large_int = nvmap*nfm_types+1
+
+   !
+    !Config Key   = FM_FILE
+    !Config Desc  = Name of file from which the forest management map is to be read
+    !Config If    = OK_STOMATE
+    !Config Def   = FMmap.nc
+    !Config Help  = The name of the file to be opened to read a forest management
+    !Config         map (including a layer for every PFT) is given here. 
+    !Config Units = [FILE]
+    !
+    filename = 'FMmap.nc'
+    CALL getin_p('FM_FILE',filename)
+
+    IF (is_root_prc) THEN
+       IF (debug) THEN
+          WRITE(numout,*) "Entering read_in_fm_map. 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)
+
+    ! This finds the number of longitude points in the file.
+    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,*) "FM Map: iml =",iml
+
+    ! This finds the number of latitude points in the file.
+    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,*) "FM Map: jml =",jml
+
+    ! Now find the number of PFTs in the file.  If this is not equal to the number
+    ! of PFTs that we actually have, that's a problem and we'll crash.
+    IF (is_root_prc) &
+         CALL flioinqv (fid,v_n="FM_STRAT",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w) 
+    CALL bcast(l_d_w)
+    lml=l_d_w(3)
+
+    IF (lml /= nvmap) THEN
+       WRITE(numout,*) 'lml = ',lml
+       WRITE(numout,*) 'nvmap = ',nvmap
+       WRITE(numout,*) 'Stopping. '
+       CALL ipslerr_p (3,'sapiens_forestry', &
+            &          'Problem with forest management strategy map.','lml /= nvmap', &
+            &          '(number of pft must be equal)')
+    ENDIF
+    !
+
+    ! Allocate the map that will be read in
+    WRITE(numout,*) 'Reading the Forest Management strategy file'
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(fmmap_r(iml,jml,nvmap), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of fmmap_r : ",ALLOC_ERR
+       
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(fmmap_i(iml,jml,nvmap), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of fmmap_i : ",ALLOC_ERR
+      CALL ipslerr_p (3,'read_in_fm_map', 'error in fmmpap_i','','')
+    ENDIF
+
+    ! This reads in the map that is in the file
+    IF (is_root_prc) THEN
+       fmmap_r(:,:,:)=large_int*2.0
+       CALL fliogetv (fid,"FM_STRAT", fmmap_r, start=(/ 1, 1, 1 /), count=(/ iml, jml, nvmap /))
+       ! Right now the values are all real, but they should be integers.
+       ! Careful, NINT might not work if the precision of fmmap_r is not single.
+       ! In that case, IDNINT should be used.
+       DO ip=1,iml
+          DO jp=1,jml
+             DO ivma=1,nvmap
+                !  There will be some fill values in here.  If we pass
+                ! a large fill value to NINT, it crashes.  So let's 
+                ! test for it
+#ifdef __NAGFOR
+                ltemp=IEEE_IS_NAN(fmmap_r(ip,jp,ivma))    
+#else
+                ltemp=isnan(fmmap_r(ip,jp,ivma))    
+#endif
+                IF(ltemp)THEN
+                   fmmap_i(ip,jp,ivma)=large_int
+
+                ELSE
+                   IF(fmmap_r(ip,jp,ivma) .GE. 0.0 .AND. fmmap_r(ip,jp,ivma) < large_int)THEN
+                      fmmap_i(ip,jp,ivma)=NINT(fmmap_r(ip,jp,ivma))
+                   ELSE
+                      ! This value should be big enough that we don't barl ourselves
+                      ! below.
+                      fmmap_i(ip,jp,ivma)=large_int
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+    CALL bcast(fmmap_i)
+
+    ! Now I need to get the latitude and longitude
+    ! First, get the axes from the map file.
+    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
+      CALL ipslerr_p (3,'read_in_fm_map', 'error in lat_lu','','') 
+    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
+      CALL ipslerr_p (3,'read_in_fm_map', 'error in lon_lu','','') 
+    ENDIF
+    IF (is_root_prc) THEN
+       CALL fliogstc (fid, x_axis=lon_lu,y_axis=lat_lu)
+    ENDIF
+    CALL bcast(lon_lu)
+    CALL bcast(lat_lu)
+
+    ! Now I can interpolate.  Remember that we are dealing with integer
+    ! values and management strategies.  Therefore, we cannot do a strict
+    ! interpolation, since that might gives values of the strategy to be
+    ! 2.3, or something ridiculous.  We cannot just round the number, either,
+    ! since we could have some squares with 1 (no management) and some with
+    ! 3 (coppices);  An average of that would be 2 (high stands), which doesn't
+    ! make any sense.  So we look to see what the most prevalent type of
+    ! management of nearby pixels is, and then just take that.
+    
+    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
+      CALL ipslerr_p (3,'read_in_fm_map', 'error in lat_ful','','')
+    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
+      CALL ipslerr_p (3,'read_in_fm_map', 'error in lon_ful','','')
+    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 FOREST MANAGEMENT file'
+    !
+    !
+
+    !
+    ! 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
+      CALL ipslerr_p (3,'read_in_fm_map', 'error in mask','','')
+    ENDIF
+    !
+    mask(:,:) = 0
+    DO ip=1,iml
+       DO jp=1,jml
+          ! If at least one PFT has a management strategy, we should interpolate
+          ! this grid point.
+          sum_fm=SUM(fmmap_i(ip,jp,:))
+          IF ( sum_fm .GT. min_sechiba .AND. sum_fm .LT. large_int) THEN
+             mask(ip,jp) = 1
+             IF (debug) THEN
+                WRITE(numout,*) "update : SUM(fmmap(",ip,jp,")) = ",sum_fm
+             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="Forest Management 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(npts, nbvmax,2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
+          CALL ipslerr_p (3,'read_in_fm_map', 'error in sub_index','','')
+       ENDIF
+       sub_index(:,:,:)=0
+
+       ALLOC_ERR=-1
+       ALLOCATE(sub_area(npts, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
+          CALL ipslerr_p (3,'read_in_fm_map', 'error in sub_area','','') 
+       ENDIF
+       sub_area(:,:)=zero
+       !
+       CALL aggregate_p(npts, 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
+    !
+    DO ipts = 1, npts
+       ! For this point, we need to see what dominant FM types are
+       ! nearby.
+       sumf=zero
+       ! We need to do this for every PFT
+       DO ivma=1,nvmap
+          ! If it's not a forest, we don't care.
+          IF(.NOT. is_tree(start_index(ivma)))THEN
+             forest_managed(ipts,ivma)=0
+          ELSE
+             fm_sum(:)=0.0
+             DO ibvm=1, nbvmax
+                ! Leave the do loop if all sub areas are treated, sub_area <= 0
+                IF ( sub_area(ipts,ibvm) <= zero ) EXIT
+                ip = sub_index(ipts,ibvm,1)
+                jp = sub_index(ipts,ibvm,2)
+                ifm=fmmap_i(ip,jp,ivma)
+                fm_sum(ifm)=fm_sum(ifm)+sub_area(ipts,ibvm)
+             ENDDO
+             ! Whichever FM type has the most area, we use that one.
+             forest_managed(ipts,ivma)=MAXLOC(fm_sum(:),1)
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    DEALLOCATE(fmmap_i)
+    DEALLOCATE(fmmap_r)
+    DEALLOCATE(lat_lu,lon_lu)
+    DEALLOCATE(lat_ful,lon_ful)
+    DEALLOCATE(mask)
+    IF(ALLOCATED(sub_index)) DEALLOCATE(sub_index)
+    IF(ALLOCATED(sub_area)) DEALLOCATE(sub_area)
+
+
+   IF ( printlev >= 5 ) WRITE(numout,*) 'Leaving read_in_fm_map'
+
+  END SUBROUTINE read_in_fm_map
+
+!! ================================================================================================================================
+!! SUBROUTINE    : read_in_litter_map
+!!
+!>\BRIEF        Read in a map that gives the litter demand for each pixel.
+!!
+!! DESCRIPTION   :  Reads in a map for the litter demand of each pixel and interpolates
+!!                  to find the demand for all pixels that we are interested in.  The map
+!!                  in this case has units of gC/year.  We convert it to be gC/m**2/year, since
+!!                  all the other units in the model are given per square meter.  The litter
+!!                  demand maps can be calculated based on, for example, the demand needed
+!!                  per head of livestock for storing them indoors in the winter.  This practice
+!!                  reached its peak during the 19th century and rapidly declined afterwards
+!!                  in Europe.  If you are not interested in historical simulations or improved 
+!!                  estimation of soil carbon pools during a historical spinup, you probably 
+!!                  don't need this.
+!!     
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::litter_demand
+!!
+!! REFERENCE(S)   : 
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE read_in_litter_map ( npts, lalo, neighbours, resolution, contfrac, litter_demand )
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                             :: npts            !! Domain size - number of pixels 
+                                                                              !! (dimensionless)
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)             :: lalo            !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), DIMENSION(npts,8), INTENT(in)          :: neighbours      !! 
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)             :: resolution      !! The size in m of each grid-box in X and Y
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: contfrac        !! Fraction of continent in the grid
+
+    !! 0.2 Output
+    REAL(r_std), DIMENSION(npts), INTENT(out)              :: litter_demand   !! The litter removed from each pixel due
+                                                                              !! to litter raking at the end of the year.
+                                                                              !! @tex $(gC year^{-1})$ @endtex
+
+    !! 0.3 Modified fields
+
+
+    !! 0.4 Local variables
+    !
+    ! PARAMETERS...taken from grid.f90.  I don't know why this variable is not in constants.f90.
+    ! default resolution (m)
+    REAL(r_std), PARAMETER :: default_resolution = 250000.
+
+    CHARACTER(LEN=80)                                      :: filename        !! A string to hold the file name
+    LOGICAL                                                :: debug=.FALSE.   !! A flag to print out debugging information.
+    INTEGER(i_std)                                         :: fid             !! The ID of the NetCDF file.
+    INTEGER(i_std)                                         :: nb_coord        !! The number of coordinates in the NetCDF file    
+    INTEGER(i_std)                                         :: nb_gat          !!
+    INTEGER(i_std)                                         :: nb_var          !! The number of variables in the NetCDF file
+    INTEGER(i_std)                                         :: nb_dim          !! The number of dimensions in the NetCDF file
+    INTEGER(i_std)                                         :: iml, jml, lml,ivm !! indices
+    INTEGER(i_std)                                         :: ip, inbv, jp    !! indices
+    LOGICAL                                                :: l_ex            !! A flag which indicates if a variable
+                                                                              !! exists in the NetCDF file
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)                 :: lat_lu, lon_lu  !! The latitude and longitude read in from
+                                                                              !! the NetCDF file    
+    INTEGER,DIMENSION(flio_max_var_dims)                   :: l_d_w           !! List of the dimension lengths of the variable
+                                                                              !! in the NetCDF file
+    INTEGER(i_std)                                         :: ipts            !! index
+    INTEGER(i_std)                                         :: ALLOC_ERR       !! A flag tripped if we have an error in allocation
+    REAL(r_std),DIMENSION(:,:),ALLOCATABLE                 :: littermap       !! The map read in from the NetCDF file
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_ful, lon_ful
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: sub_area
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index
+    CHARACTER(LEN=30) :: callsign
+    INTEGER(i_std) :: ibvm, nbvmax,ifm
+    LOGICAL ::           ok_interpol ! optionnal return of aggregate_2d
+    REAL(r_std)                                            :: area_sum, coslat
+    REAL(r_std),DIMENSION(nfm_types)                       :: fm_sum
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)    :: temp_resolution
+    REAL(r_std)                :: fillvalue
+    INTEGER :: i_rc,i_v,no_fill
+    LOGICAL ::           ltemp ! temporary logical variable
+!_ ================================================================================================================================
+
+    IF ( printlev >= 4 ) WRITE(numout,*) 'Entering read_in_litter_map'
+
+    litter_demand(:)=zero
+
+   !
+    !Config Key   = FM_FILE
+    !Config Desc  = Name of file from which the forest management map is to be read
+    !Config If    = OK_STOMATE
+    !Config Def   = FMmap.nc
+    !Config Help  = The name of the file to be opened to read a forest management
+    !Config         map (including a layer for every PFT) is given here. 
+    !Config Units = [FILE]
+    !
+    filename = 'litter_map.nc'
+    CALL getin_p('LITTER_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)
+
+    ! I need the fill value of the map.  This doesn't seem to available through
+    ! the IOISPL routines that I can see.
+    ! NF90_INQ_VAR_FILL seems to be only valid for NetCDF-'?  So I am going to make
+    ! a HUGE assumption here about the fill value of the maps.  I hope that none of the values
+    ! in the maps are above this value.
+    fillvalue=1e20
+    WRITE(numout,*) "WARNING: You are using a litter demand map.  I cannot determine"
+    WRITE(numout,*) "         the fill value of this map.  I am assuming that the fill"
+    WRITE(numout,*) "         value is 1e20 and that all your real values are below that."
+    WRITE(numout,*) "         CONFIRM THIS WITH YOUR LITTER MAP!"
+    
+
+    ! This finds the number of longitude points in the file.
+    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,*) "Litter map: iml =",iml
+
+    ! This finds the number of latitude points in the file.
+    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,*) "Litter map: jml =",jml
+
+    ! Now find the number of PFTs in the file.  If this is not equal to the number
+    ! of PFTs that we actually have, that's a problem and we'll crash.
+    IF (is_root_prc) &
+         CALL flioinqv (fid,v_n="LITTER_DEMAND",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w) 
+    CALL bcast(l_d_w)
+
+    !
+
+    ! Allocate the map that will be read in
+    WRITE(numout,*) 'Reading the litter file',l_d_w
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(littermap(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of littermap : ",ALLOC_ERR
+      CALL ipslerr_p (3,'read_in_litter_map', 'error in littermap','','')
+    ENDIF
+    ALLOC_ERR=-1
+
+    ! This reads in the map that is in the file
+    IF (is_root_prc) THEN
+       CALL fliogetv (fid,"LITTER_DEMAND", littermap, start=(/ 1, 1 /), count=(/ iml, jml /))
+    ENDIF
+
+    CALL bcast(littermap)
+
+    ! Now I need to get the latitude and longitude
+    ! First, get the axes from the map file.
+    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
+      CALL ipslerr_p (3,'read_in_litter_map', 'error in lat_lu','','')
+    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
+      CALL ipslerr_p (3,'read_in_litter_map', 'error in lon_lu','','')
+    ENDIF
+    IF (is_root_prc) THEN
+       CALL fliogstc (fid, x_axis=lon_lu,y_axis=lat_lu)
+    ENDIF
+    CALL bcast(lon_lu)
+    CALL bcast(lat_lu)
+
+    ! Now I can interpolate.  This should be straightforward, since
+    ! we are interpolating real numbers.
+    
+    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
+      CALL ipslerr_p (3,'read_in_litter_map', 'error in lat_ful','','')
+    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
+      CALL ipslerr_p (3,'read_in_litter_map', 'error in lon_ful','','')
+    ENDIF
+    !
+    DO ip=1,iml
+       lon_ful(ip,:)=lon_lu(ip)
+    ENDDO
+    DO jp=1,jml
+       lat_ful(:,jp)=lat_lu(jp)
+    ENDDO
+    
+    ! The map is in absolute numbers.  We cannot interpolate absolute numbers, we want
+    ! to add them together (or subtract them, if we are going to finer resolution).  Therefore,
+    ! let's convert all the map values to per m**2 first, interpolate that, and then
+    ! convert back to absolute numbers.
+    ! This is ugly.  Unfortunately, we had to steal this from grid.f90, since the resolution is
+    ! not passed for every grid square, just those that we are interested in.
+    ALLOC_ERR=-1
+    ALLOCATE(temp_resolution(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of temp_resolution : ",ALLOC_ERR
+      CALL ipslerr_p (3,'read_in_litter_map', 'error in temp_resolution','','')
+    ENDIF
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          ! 2 resolution
+          !
+          
+          !
+          ! 2.1 longitude
+          !
+          
+          ! prevent infinite resolution at the pole
+          coslat = MAX( COS( lat_ful(ip,jp) * pi/180. ), mincos )     
+          IF ( iml .GT. 1 ) THEN
+             
+             IF ( ip .EQ. 1 ) THEN
+                temp_resolution(ip,jp,1) = &
+                     ABS( lon_ful(ip+1,jp) - lon_ful(ip,jp) ) * &
+                     pi/180. * R_Earth * coslat
+             ELSEIF ( ip .EQ. iml ) THEN
+                temp_resolution(ip,jp,1) = &
+                     ABS( lon_ful(ip,jp) - lon_ful(ip-1,jp) ) * &
+                     pi/180. * R_Earth * coslat
+             ELSE
+                temp_resolution(ip,jp,1) = &
+                     ABS( lon_ful(ip+1,jp) - lon_ful(ip-1,jp) )/2. *&
+                     pi/180. * R_Earth * coslat
+             ENDIF
+             
+          ELSE
+             
+             temp_resolution(ip,jp,1) = default_resolution
+             
+          ENDIF
+
+          !
+          ! 2.2 latitude
+          !
+          
+          IF ( jml .GT. 1 ) THEN
+
+             IF ( jp .EQ. 1 ) THEN
+                temp_resolution(ip,jp,2) = &
+                     ABS( lat_ful(ip,jp) - lat_ful(ip,jp+1) ) * &
+                     pi/180. * R_Earth
+             ELSEIF ( jp .EQ. jml ) THEN
+                temp_resolution(ip,jp,2) = &
+                     ABS( lat_ful(ip,jp-1) - lat_ful(ip,jp) ) * &
+                     pi/180. * R_Earth
+             ELSE
+                temp_resolution(ip,jp,2) = &
+                     ABS( lat_ful(ip,jp-1) - lat_ful(ip,jp+1) )/2. *&
+                     pi/180. * R_Earth
+             ENDIF
+             
+          ELSE
+             
+             temp_resolution(ip,jp,2) = default_resolution
+
+          ENDIF
+             
+#ifdef __NAGFOR
+                ltemp=IEEE_IS_NAN(littermap(ip,jp))
+#else
+                ltemp=isnan(littermap(ip,jp))
+#endif
+          IF( .NOT. ltemp)THEN
+
+             IF(littermap(ip,jp) .LT. fillvalue)THEN
+                ! Convert to per square meter for the interpolation if this is a real map value.
+                littermap(ip,jp)=littermap(ip,jp)/temp_resolution(ip,jp,1)/temp_resolution(ip,jp,2)
+             ENDIF
+             
+          ENDIF
+          
+       ENDDO
+
+    ENDDO
+
+    !
+    WRITE(numout,*) 'Reading the LITTER file'
+    !
+    !
+
+    !
+    ! 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
+      CALL ipslerr_p (3,'read_in_litter_map', 'error in mask','','')
+    ENDIF
+    !
+    mask(:,:) = 0
+    DO ip=1,iml
+       DO jp=1,jml
+          ! If the grid has any litter, we should interpolate
+          ! this grid point.
+#ifdef __NAGFOR
+                ltemp=IEEE_IS_NAN(littermap(ip,jp))
+#else
+                ltemp=isnan(littermap(ip,jp))
+#endif
+          IF( .NOT. ltemp)THEN
+             IF ( littermap(ip,jp) .GT. min_sechiba .AND. littermap(ip,jp) .LT. fillvalue ) THEN
+                mask(ip,jp) = 1
+                IF (debug) THEN
+                   WRITE(numout,*) "update : littermap(",ip,jp,")) = ",littermap(ip,jp)
+                ENDIF
+             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="Litter 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(npts, nbvmax,2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
+          CALL ipslerr_p (3,'read_in_litter_map', 'error in sub_index','','')
+       ENDIF
+       sub_index(:,:,:)=0
+
+       ALLOC_ERR=-1
+       ALLOCATE(sub_area(npts, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
+          CALL ipslerr_p (3,'read_in_litter_map', 'error in sub_area','','')
+       ENDIF
+       sub_area(:,:)=zero
+       !
+       CALL aggregate_p(npts, 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
+    !
+    DO ipts = 1, npts
+
+       litter_demand(ipts)=zero
+       area_sum=zero
+
+       DO ibvm=1, nbvmax
+          ! Leave the do loop if all sub areas are treated, sub_area <= 0
+          IF ( sub_area(ipts,ibvm) <= zero ) EXIT
+          ip = sub_index(ipts,ibvm,1)
+          jp = sub_index(ipts,ibvm,2)
+          area_sum=area_sum+sub_area(ipts,ibvm)
+          litter_demand(ipts)=litter_demand(ipts)+sub_area(ipts,ibvm)*littermap(ip,jp)
+       ENDDO
+
+       IF(area_sum .LT. min_stomate)THEN
+          WRITE(numout,*) 'Missing data for the litter map on this land point!'
+          WRITE(numout,*) 'ipts,lalo',ipts,lalo(ipts,:)
+          litter_demand(ipts)=zero
+       ELSE
+          litter_demand(ipts)=litter_demand(ipts)/area_sum
+          ! This is in gC/year/m**2 from the interpolation.  I need to convert it back
+          ! to absolute numbers.
+          litter_demand(ipts)=litter_demand(ipts)*resolution(ipts,1)*resolution(ipts,2)
+       ENDIF
+
+    ENDDO
+
+    !
+    DEALLOCATE(littermap)
+    DEALLOCATE(temp_resolution)
+    DEALLOCATE(lat_lu,lon_lu)
+    DEALLOCATE(lat_ful,lon_ful)
+    DEALLOCATE(mask)
+    IF(ALLOCATED(sub_index)) DEALLOCATE(sub_index)
+    IF(ALLOCATED(sub_area)) DEALLOCATE(sub_area)
+
+
+   IF ( printlev >= 5 ) WRITE(numout,*) 'Leaving read_in_litter_map'
+
+  END SUBROUTINE read_in_litter_map
+
+!! ================================================================================================================================
+!! SUBROUTINE    : litter_raking
+!!
+!>\BRIEF        Read in a map that gives the litter demand for each pixel.
+!!
+!! DESCRIPTION   :  Reads in a map for the litter demand of each pixel and interpolates
+!!                  to find the demand for all pixels that we are interested in.  The map
+!!                  in this case has units of gC/year.  We convert it to be gC/m**2/year, since
+!!                  all the other units in the model are given per square meter.  The litter
+!!                  demand maps can be calculated based on, for example, the demand needed
+!!                  per head of livestock for storing them indoors in the winter.  This practice
+!!                  reached its peak during the 19th century and rapidly declined afterwards
+!!                  in Europe.  If you are not interested in historical simulations or improved 
+!!                  estimation of soil carbon pools during a historical spinup, you probably 
+!!                  don't need this.
+!!     
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::litter_demand
+!!
+!! REFERENCE(S)   : 
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE litter_raking ( npts, veget_cov_max, resolution, litter_demand, litter, lrake_frac )
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: npts            !! Domain size - number of pixels 
+                                                                          !! (dimensionless)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: veget_cov_max       !! "Maximal" coverage fraction of a PFT (LAI 
+                                                                          !! -> infinity) on ground
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)         :: resolution      !! The size in m of each grid-box in X and Y
+    REAL(r_std), DIMENSION(npts), INTENT(in)           :: litter_demand   !! The litter removed from each pixel due
+                                                                          !! to litter raking at the end of the year.
+                                                                          !! @tex $(gC year^{-1})$ @endtex
+
+    !! 0.2 Output
+    REAL(r_std), DIMENSION(:,:), INTENT(out)           :: lrake_frac      !! Relative amount of litter that raked (-)
+
+    !! 0.3 Modified fields
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)   :: litter          !! Metabolic and structural litter, above 
+                                                                          !! and below ground 
+                                                                          !! @tex $(gC m^{-2})$ @endtex 
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                     :: ipts, ivm       !! Indices
+    REAL(r_std)                                        :: total_litter    !! Total amount of aboveground forest litter 
+                                                                          !! on the pixel (gC)
+    REAL(r_std)                                        :: ind_litter      !! ??? how does this differ from total_litter?
+    REAL(r_std)                                        :: crop_frac       !! Fraction of croplands on the pixel (-)
+    REAL(r_std)                                        :: forest_frac     !! Fraction of forests on the pixel (-)
+    REAL(r_std)                                        :: litter_transfer !! Litter that we would like to move (demand)
+                                                                          !! from the forests to the crops
+                                                                          !! @tex $(gC year^{-1})$ @endtex
+    REAL(r_std),DIMENSION(nlitt)                       :: litter_ratio    !! Litter in a PFT as a fraction of all the 
+                                                                          !! forest litter in the pixel (-)
+    REAL(r_std),DIMENSION(nvm)                         :: lfrac           !! ??? how does this differ from litter_ratio
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements) :: check_intern    !! Contains the components of the internal
+                                                                          !! mass balance chech for this routine
+                                                                          !! @tex $(gC m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)         :: closure_intern  !! Check closure of internal mass balance
+                                                                          !! @tex $(gC m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)         :: pool_start      !! Start pool of this routine 
+                                                                          !! @tex $(gC m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)         :: pool_end        !! End pool of this routine 
+                                                                          !! @tex $(gC m^{-2} dt^{-1})$ @endtex
+    REAL(r_std)                                        :: temp_sum        !! Temporary storage
+    INTEGER(i_std)                                     :: iele, ilitt     !! Indices
+    INTEGER(i_std)                                     :: ilevs, imbc     !! Indices
+    REAL(r_std), DIMENSION(npts,nvm)                   :: pft_area        !! The absolute area covered by this PFT
+                                                                          !! @tex $(m^2)$ @endtex
+    REAL(r_std), DIMENSION(npts)                       :: pixel_area      !! The absolute area covered by this PFT
+                                                                          !! @tex $(m^2)$ @endtex
+    REAL(r_std)                                        :: litter_lost     !! Litter removed from the forest PFTs
+    REAL(r_std)                                        :: litter_gained   !! Litter added to the crop PFTs
+    LOGICAL                                            :: lall_litter     !! Flag to catch numerical issues
+    REAL(r_std), DIMENSION(npts,nvm)                   :: veget_cov_max_begin !! temporary storage of veget_cov_max to check area conservation
+!_ ================================================================================================================================
+
+    IF ( printlev >= 3 ) WRITE(numout,*) 'Entering litter_raking'
+
+    !! 1. Initialize biomass at first call
+
+    !! 1.1 Initialize local printlev
+    !printlev_loc=get_printlev('litter_raking')
+    
+    !! 1.2 Initialize check for mass balance closure
+    
+    !  Initial values of litter
+    IF (err_act.GT.1) THEN
+
+       check_intern(:,:,:,:) = zero
+       pool_start(:,:,:) = zero
+    
+       DO iele = 1,nelements
+       
+          ! Litter pool (gC m-2) *  (m2 m-2) 
+          DO ilitt = 1,nlitt
+             DO ilevs = 1,nlevs
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                     litter(:,ilitt,:,ilevs,iele) * veget_cov_max(:,:)
+             ENDDO
+          ENDDO
+       
+       ENDDO ! # nelements
+
+       !! 1.3 Initialize check for area conservation
+       veget_cov_max_begin(:,:) = veget_cov_max(:,:)
+
+    ENDIF ! err_act.GT.1
+
+    !! 1.4 Initialize
+    lrake_frac(:,:)=zero
+
+    !! Surface areas in m2
+    DO ipts=1,npts
+       pft_area(ipts,:)=resolution(ipts,1)*resolution(ipts,2)* veget_cov_max(ipts,:)
+       pixel_area(ipts)=resolution(ipts,1)*resolution(ipts,2)
+    ENDDO
+
+    ! We need to find how much litter we can get from the forests for each 
+    ! grid point.
+    DO ipts=1,npts
+
+       litter_lost=zero
+       litter_gained=zero
+       total_litter=zero
+
+       DO ivm=1,nvm
+          IF(is_tree(ivm))THEN
+             ! We will take all the above ground litter, since that is what 
+             ! a farmer could pick up.  Unlikely they dug into the soil to 
+             ! collect litter. Notice these are in absolute units, not per 
+             ! square meter.
+             total_litter=total_litter+SUM(litter(ipts,:,ivm,iabove,icarbon))&
+                  *pft_area(ipts,ivm)
+          ENDIF
+       ENDDO
+
+       ! If we have no forest litter, we cannot rake anything.
+       IF(total_litter .LT. min_stomate)CYCLE
+
+       ! The forests are tricky. The litter they produce will not 
+       ! necessarily be proportional to the area they take up.  
+       ! We want to reduce the amount of litter in each forest in a 
+       ! way that doesn't leave any litter pools negative.
+       lfrac(:)=zero
+       DO ivm=1,nvm
+          IF(is_tree(ivm))THEN
+             lfrac(ivm)=SUM(litter(ipts,:,ivm,iabove,icarbon))&
+                  *pft_area(ipts,ivm)/total_litter
+          ENDIF
+       ENDDO
+
+       ! Now compute the amount of the litter that we need to take to 
+       ! satisfy our demand.
+       litter_transfer=litter_demand(ipts)
+
+       ! We don't take more litter than we have. Putting in 
+       ! a logical flag to prevent us from having numerical 
+       ! issues.
+       lall_litter=.FALSE.
+       IF(litter_transfer .GT. total_litter) THEN
+          lall_litter=.TRUE.
+          litter_transfer=total_litter
+       ENDIF
+
+       ! How many crop PFTs are present on this grid square?
+       crop_frac=zero
+       DO ivm=1,nvm
+          IF(.NOT. natural(ivm))THEN
+             crop_frac=crop_frac+veget_cov_max(ipts,ivm)
+          ENDIF
+       ENDDO
+
+       IF(crop_frac .GT. min_stomate)THEN
+          DO ivm=1,nvm
+
+             IF(veget_cov_max(ipts,ivm) .LE. min_stomate) CYCLE
+
+             ! If we have a forest, we remove litter.  Keep the ratio of 
+             ! the pools the same.
+             IF(is_tree(ivm))THEN
+                ind_litter=SUM(litter(ipts,:,ivm,iabove,icarbon))*&
+                     pft_area(ipts,ivm)
+
+                ! I guess there is a chance that a forest has no litter.  
+                ! This means there is nothing to take away.
+                IF(ind_litter .LE. min_stomate)CYCLE
+
+                litter_ratio(:)=litter(ipts,:,ivm,iabove,icarbon)*&
+                     pft_area(ipts,ivm)/ind_litter
+                lrake_frac(ipts,ivm)=lfrac(ivm)*litter_transfer/ind_litter
+
+                ! We don't want to have negative litter values
+                IF(lall_litter)THEN
+                   ind_litter=zero
+                ELSE
+                   ind_litter=ind_litter-lfrac(ivm)*litter_transfer
+                ENDIF
+                litter_lost=litter_lost-lfrac(ivm)*litter_transfer
+
+                ! This is a problem.  We are taking differences of numbers
+                ! which are 1e9 or so, which means we could have a negative 
+                ! value that is insignificant. I put the flag to try to 
+                ! prevent that.
+                IF(.NOT. lall_litter .AND. ind_litter .LT. -min_stomate)THEN
+                   WRITE(numout,*) "Took away too much litter!"
+                   WRITE(numout,*) "ipts,ivm:",ipts,ivm
+                   WRITE(numout,*) "lfrac(ivm),ind_litter,litter_transfer: ",&
+                        lfrac(ivm),SUM(litter(ipts,:,ivm,iabove,icarbon))*&
+                        pft_area(ipts,ivm),litter_transfer
+                ENDIF
+                litter(ipts,:,ivm,iabove,icarbon)=litter_ratio(:)*ind_litter&
+                     /pft_area(ipts,ivm)
+
+             ELSEIF( .NOT. natural(ivm))THEN
+
+                ! If we have a crop, we add litter.
+                ind_litter=SUM(litter(ipts,:,ivm,iabove,icarbon))* &
+                     pft_area(ipts,ivm)
+
+                ! Is it possible that we have no crop litter but we 
+                ! have veget_cov_max?  Maybe.
+                IF(ind_litter .LT. min_stomate)THEN
+                   litter_ratio(:)=un/REAL(nlitt)
+                ELSE
+                   litter_ratio(:)=litter(ipts,:,ivm,iabove,icarbon)*&
+                        pft_area(ipts,ivm)/ind_litter
+                ENDIF
+                ! This is the total litter we have for this PFT in 
+                ! this pixel
+                ind_litter=ind_litter+veget_cov_max(ipts,ivm)/crop_frac*&
+                     litter_transfer
+                litter_gained=litter_gained+veget_cov_max(ipts,ivm)/&
+                     crop_frac*litter_transfer
+                litter(ipts,:,ivm,iabove,icarbon)=litter_ratio(:)*&
+                     ind_litter/pft_area(ipts,ivm)
+
+             ENDIF ! checking to see if this PFT is a crop or forest
+
+          ENDDO ! loop over PFTs
+
+       ELSE
+
+          ! We have no agricultural PFTs to move the litter to, so we
+          ! assume that no litter raking was done in this grid square.
+
+       ENDIF ! checking to see if we have crops
+
+    ENDDO ! loop over pixels
+    
+ !! 2. Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 2.2 Check surface area
+       CALL check_surface_area("stomate_prescribe", npts, veget_cov_max_begin, &
+            veget_cov_max,'pft')
+
+       ! 2.3 Mass balance closure 
+       ! 2.3.1 Calculate final biomass
+       pool_end = zero
+       DO iele = 1,nelements
+          DO ilitt = 1,nlitt
+             DO ilevs = 1,nlevs
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                     litter(:,ilitt,:,ilevs,iele) * veget_cov_max(:,:)
+             ENDDO
+          ENDDO
+       ENDDO
+
+       !! 2.3.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(:,:,ipoolchange,iele) = -un * &
+               (pool_end(:,:,iele) - pool_start(:,:,iele))
+       ENDDO
+
+       closure_intern = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) WRITE(numout,*) &
+                  'check_intern, ivm, imbc, iele, ', imbc, &
+                  iele, check_intern(:,test_pft,imbc,iele)
+             !-
+             closure_intern(:,:,iele) = closure_intern(:,:,iele) + &
+                  check_intern(:,:,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 4.3.3 Check mass balance closure
+       CALL check_mass_balance("litter_raking", closure_intern, npts, &
+            pool_end, pool_start, veget_cov_max, 'pixel')
+
+    ENDIF ! err_act.GT.1
+    
+    IF ( printlev >= 4 ) WRITE(numout,*) 'Leaving litter_raking'
+    
+  END SUBROUTINE litter_raking
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : read_in_species_change map
+!!
+!>\BRIEF        Read in a map that gives the PFT that needs to be planted
+!!               when the current s PFT is harvested.
+!!
+!! DESCRIPTION   :  
+!!
+!!       NOTE: This routine was mostly copied from slowproc where the PFTmap is read in.
+!!             Grid interpolation is used, but only to look at the nearby pixels to see
+!!             see which management strategy is dominant.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::species_map
+!!
+!! REFERENCE(S)   : 
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE read_in_species_change_map ( npts, lalo, neighbours, resolution, contfrac, species_map )
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                             :: npts            !! Domain size - number of pixels 
+                                                                              !! (dimensionless)
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)             :: lalo            !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), DIMENSION(npts,8), INTENT(in)          :: neighbours     !! 
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)             :: resolution      !! The size in m of each grid-box in X and Y
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: contfrac        !! Fraction of continent in the grid
+
+    !! 0.2 Output
+    INTEGER(i_std), DIMENSION(npts,nvmap), INTENT(out)       :: species_map   !! The number of a PFT that each PFT will
+                                                                              !! be converted into after death.
+
+    !! 0.3 Modified fields
+
+
+    !! 0.4 Local variables
+    CHARACTER(LEN=80)                                      :: filename        !! A string to hold the file name
+    LOGICAL                                                :: debug=.FALSE.   !! A flag to print out debugging information.
+    INTEGER(i_std)                                         :: fid             !! The ID of the NetCDF file.
+    INTEGER(i_std)                                         :: nb_coord        !! The number of coordinates in the NetCDF file    
+    INTEGER(i_std)                                         :: nb_gat          !!
+    INTEGER(i_std)                                         :: nb_var          !! The number of variables in the NetCDF file
+    INTEGER(i_std)                                         :: nb_dim          !! The number of dimensions in the NetCDF file
+    INTEGER(i_std)                                         :: iml, jml, lml,ivm !! indices
+    INTEGER(i_std)                                         :: ip, inbv, jp    !! indices
+    LOGICAL                                                :: l_ex            !! A flag which indicates if a variable
+                                                                              !! exists in the NetCDF file
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)                 :: lat_lu, lon_lu  !! The latitude and longitude read in from
+                                                                              !! the NetCDF file    
+    INTEGER,DIMENSION(flio_max_var_dims)                   :: l_d_w           !! List of the dimension lengths of the variable
+                                                                              !! in the NetCDF file
+    INTEGER(i_std)                                         :: ipts            !! index
+    INTEGER(i_std)                                         :: ALLOC_ERR       !! A flag tripped if we have an error in allocation
+    REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE               :: scmap_r         !! The map read in from the NetCDF file
+    INTEGER(i_std),DIMENSION(:,:,:),ALLOCATABLE            :: scmap_i         !! The integer form of the map read in
+    INTEGER(i_std)                                         :: closest_lat     !! The index of the closest latitude we found.
+    INTEGER(i_std)                                         :: closest_lon     !! The index of the closest longitude we found.
+    REAL(r_std)                                            :: distance        !! The distance from the current point to the 
+                                                                              !! point on the map
+    REAL(r_std)                                            :: closest_dist    !! The distance to the closet point we've found.
+    INTEGER                                                :: large_int       !! A number which indicates that the grid data
+                                                                              !! is not available
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_ful, lon_ful
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: sub_area
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index
+    CHARACTER(LEN=30) :: callsign
+    INTEGER(i_std) :: ibvm, nbvmax,ifm, ivma
+    LOGICAL ::           ok_interpol ! optionnal return of aggregate_2d
+    REAL(r_std)                                            :: sum_sc,sumf
+    REAL(r_std),DIMENSION(nvmap)                       :: sc_sum
+    LOGICAL ::           ltemp ! temporary logical variable
+  !_ ================================================================================================================================
+
+    !IF ( printlev >= 4 ) 
+    WRITE(numout,*) 'Entering read_in_species_change_map'
+
+    ! This integer has to be large enough that it never shows up on the map, without being
+    ! so large that is causes overflows.  This needs to be larger than the largest possible
+    ! value multiplied by the number of PFTs.  Since each value should never be larger than
+    ! the number of PFTs, this should suffice.
+    large_int = nvmap*nvmap+1
+
+   !
+    !Config Key   = SPECIES_CHANGE_FILE
+    !Config Desc  = Name of file from which the species change map is to be read
+    !Config If    = OK_STOMATE
+    !Config Def   = replant_species.nc
+    !Config Help  = The name of the file to be opened to read the species to replant
+    !Config         for each pixel and PFT.
+    !Config Units = [FILE]
+    !
+    filename = 'replant_species.nc'
+    CALL getin_p('SPECIES_CHANGE_FILE',filename)
+
+    IF (is_root_prc) THEN
+       IF (debug) THEN
+          WRITE(numout,*) "Entering read_in_species_change_map. 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)
+
+    ! This finds the number of longitude points in the file.
+    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,*) "Species change Map: iml =",iml
+
+    ! This finds the number of latitude points in the file.
+    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,*) "Species change Map: jml =",jml
+
+    ! Now find the number of PFTs in the file.  If this is not equal to the number
+    ! of PFTs that we actually have, that's a problem and we'll crash.
+    IF (is_root_prc) &
+         CALL flioinqv (fid,v_n="NEWSPECIES",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w) 
+    CALL bcast(l_d_w)
+    lml=l_d_w(3)
+
+    IF (lml /= nvmap) THEN
+       WRITE(numout,*) 'lml = ',lml
+       WRITE(numout,*) 'nvmap = ',nvmap
+       WRITE(numout,*) 'Stopping. '
+       CALL ipslerr_p (3,'sepians_forestry', &
+            &          'Problem with species change map.','lml /= nvmap', &
+            &          '(number of pft must be equal)')
+    ENDIF
+    !
+
+    ! Allocate the map that will be read in
+    WRITE(numout,*) 'Reading the species change map'
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(scmap_r(iml,jml,nvmap), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of scmap_r : ",ALLOC_ERR
+      CALL ipslerr_p (3,'read_in_species_change_map', 'error in scmap_r','','')
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(scmap_i(iml,jml,nvmap), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of scmap_i : ",ALLOC_ERR
+      CALL ipslerr_p (3,'read_in_species_change_map', 'error in scmap_i','','') 
+    ENDIF
+
+    ! This reads in the map that is in the file
+    IF (is_root_prc) THEN
+       scmap_r(:,:,:)=large_int*2.0
+       CALL fliogetv (fid,"NEWSPECIES", scmap_r, start=(/ 1, 1, 1 /), count=(/ iml, jml, nvmap /))
+       ! Right now the values are all real, but they should be integers.
+       ! Careful, NINT might not work if the precision of scmap_r is not single.
+       ! In that case, IDNINT should be used.
+       DO ip=1,iml
+          DO jp=1,jml
+             DO ivma=1,nvmap
+                !  There will be some fill values in here.  If we pass
+                ! a large fill value to NINT, it crashes.  So let's 
+                ! test for it
+#ifdef __NAGFOR
+                ltemp=IEEE_IS_NAN(scmap_r(ip,jp,ivma))    
+#else
+                ltemp=isnan(scmap_r(ip,jp,ivma))    
+#endif
+                IF(ltemp)THEN
+                   scmap_i(ip,jp,ivma)=large_int
+
+                ELSE
+                   IF(scmap_r(ip,jp,ivma) .GE. 0.0 .AND. scmap_r(ip,jp,ivma) < large_int)THEN
+                      scmap_i(ip,jp,ivma)=NINT(scmap_r(ip,jp,ivma))
+                   ELSE
+                      ! This value should be big enough that we don't barl ourselves
+                      ! below.
+                      scmap_i(ip,jp,ivma)=large_int
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+    CALL bcast(scmap_i)
+
+    ! Now I need to get the latitude and longitude
+    ! First, get the axes from the map file.
+    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
+      CALL ipslerr_p (3,'read_in_species_change_map', 'error in lat_lu','','')
+    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
+      CALL ipslerr_p (3,'read_in_species_change_map', 'error in lon_lu','','')
+    ENDIF
+    IF (is_root_prc) THEN
+       CALL fliogstc (fid, x_axis=lon_lu,y_axis=lat_lu)
+    ENDIF
+    CALL bcast(lon_lu)
+    CALL bcast(lat_lu)
+
+    ! Now I can interpolate.  Remember that we are dealing with integer
+    ! values and PFTs.  Therefore, we cannot do a strict
+    ! interpolation, since that might gives values of the PFT to be
+    ! 2.3, or something ridiculous.  We cannot just round the number, either,
+    ! since we could have some squares with poplar (PFT 15) and oak (PFT 13), 
+    ! rounding would give a completely different PFT (14).  So we look to see what the 
+    ! most prevalent type of PFT of nearby pixels is, and then just take that.
+    
+    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
+      CALL ipslerr_p (3,'read_in_species_change_map', 'error in lat_ful','','')
+    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
+      CALL ipslerr_p (3,'read_in_species_change_map', 'error in lon_ful','','')
+    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 SPECIES CHANGE file'
+    !
+    !
+
+    !
+    ! 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
+      CALL ipslerr_p (3,'read_in_species_change_map', 'error in mask','','')
+    ENDIF
+    !
+    mask(:,:) = 0
+    DO ip=1,iml
+       DO jp=1,jml
+          ! If at least one PFT has a management strategy, we should interpolate
+          ! this grid point.
+          sum_sc=SUM(scmap_i(ip,jp,:))
+          IF ( sum_sc .GT. min_sechiba .AND. sum_sc .LT. large_int) THEN
+             mask(ip,jp) = 1
+             IF (debug) THEN
+                WRITE(numout,*) "update : SUM(scmap(",ip,jp,")) = ",sum_sc
+             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="Species change 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(npts, nbvmax,2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
+          CALL ipslerr_p (3,'read_in_species_change_map', 'error in sub_index','','')
+       ENDIF
+       sub_index(:,:,:)=0
+
+       ALLOC_ERR=-1
+       ALLOCATE(sub_area(npts, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
+          CALL ipslerr_p (3,'read_in_species_change_map', 'error in sub_area','','') 
+       ENDIF
+       sub_area(:,:)=zero
+       !
+       CALL aggregate_p(npts, 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
+    !
+    DO ipts = 1, npts
+       ! For this point, we need to see what dominant new species are
+       ! nearby.
+       sumf=zero
+       ! We need to do this for every PFT
+       DO ivma=1,nvmap
+          ! If it's not a forest, we don't care.  We will
+          ! always replant it as the same PFT.
+          IF(.NOT. is_tree(start_index(ivma)))THEN
+             species_map(ipts,ivma)=ivma
+          ELSE
+             sc_sum(:)=0.0
+             DO ibvm=1, nbvmax
+                ! Leave the do loop if all sub areas are treated, sub_area <= 0
+                IF ( sub_area(ipts,ibvm) <= zero ) EXIT
+                ip = sub_index(ipts,ibvm,1)
+                jp = sub_index(ipts,ibvm,2)
+                ifm=scmap_i(ip,jp,ivma)
+                sc_sum(ifm)=sc_sum(ifm)+sub_area(ipts,ibvm)
+             ENDDO
+             ! Whichever FM type has the most area, we use that one.
+             species_map(ipts,ivma)=MAXLOC(sc_sum(:),1)
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    DEALLOCATE(scmap_i)
+    DEALLOCATE(scmap_r)
+    DEALLOCATE(lat_lu,lon_lu)
+    DEALLOCATE(lat_ful,lon_ful)
+    DEALLOCATE(mask)
+    IF(ALLOCATED(sub_index)) DEALLOCATE(sub_index)
+    IF(ALLOCATED(sub_area)) DEALLOCATE(sub_area)
+
+
+   IF ( printlev >= 5 ) WRITE(numout,*) 'Leaving read_in_species_change_map'
+
+ END SUBROUTINE read_in_species_change_map
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : read_in_desired_fm_map
+!!
+!>\BRIEF        Read in a map that gives the desired forest management strategy
+!!              after a new PFT was planted.
+!!
+!! DESCRIPTION   :  
+!!     
+!!
+!! FM = 1 : No human intervention (ORCHIDEE default)
+!!      2 : Thinnings based on the RDI, clearcuts based on tree density,
+!!              annual increment, and tree diameter.  Thinnings from above and
+!!              from below are determined by the sign of thstrat.
+!!      3 : Coppices
+!!      4 : Short rotation coppices
+!!
+!!       NOTE: This routine was mostly copied from slowproc where the PFTmap is read in.
+!!             Grid interpolation is used, but only to look at the nearby pixels to see
+!!             see which management strategy is dominant.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::forest_managed
+!!
+!! REFERENCE(S)   : 
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE read_in_desired_fm_map ( npts, lalo, neighbours, resolution, &
+       contfrac, desired_managed )
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                             :: npts            !! Domain size - number of pixels 
+                                                                              !! (dimensionless)
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)             :: lalo            !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), DIMENSION(npts,8), INTENT(in)          :: neighbours      !! 
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)             :: resolution      !! The size in m of each grid-box in X and Y
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: contfrac        !! Fraction of continent in the grid
+
+    !! 0.2 Output
+    INTEGER(i_std), DIMENSION(npts,nvmap), INTENT(out)     :: desired_managed !! Forest management flag: 0 = orchidee 
+                                                                              !! standard, 1= self-thinning only, 2= 
+                                                                              !! high-stand, 3= high-stand smoothed, 4= 
+                                                                              !! coppices 
+
+    !! 0.3 Modified fields
+
+
+    !! 0.4 Local variables
+    CHARACTER(LEN=80)                                      :: filename        !! A string to hold the file name
+    LOGICAL                                                :: debug=.FALSE.   !! A flag to print out debugging information.
+    INTEGER(i_std)                                         :: fid             !! The ID of the NetCDF file.
+    INTEGER(i_std)                                         :: nb_coord        !! The number of coordinates in the NetCDF file    
+    INTEGER(i_std)                                         :: nb_gat          !!
+    INTEGER(i_std)                                         :: nb_var          !! The number of variables in the NetCDF file
+    INTEGER(i_std)                                         :: nb_dim          !! The number of dimensions in the NetCDF file
+    INTEGER(i_std)                                         :: iml,jml,lml,ivm !! indices
+    INTEGER(i_std)                                         :: ip, inbv, jp    !! indices
+    LOGICAL                                                :: l_ex            !! A flag which indicates if a variable
+                                                                              !! exists in the NetCDF file
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)                 :: lat_lu, lon_lu  !! The latitude and longitude read in from
+                                                                              !! the NetCDF file    
+    INTEGER,DIMENSION(flio_max_var_dims)                   :: l_d_w           !! List of the dimension lengths of the variable
+                                                                              !! in the NetCDF file
+    INTEGER(i_std)                                         :: ipts            !! index
+    INTEGER(i_std)                                         :: ALLOC_ERR       !! A flag tripped if we have an error in allocation
+    REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE               :: fmmap_r         !! The map read in from the NetCDF file
+    INTEGER(i_std),DIMENSION(:,:,:),ALLOCATABLE            :: fmmap_i         !! The integer form of the map read in
+    INTEGER(i_std)                                         :: closest_lat     !! The index of the closest latitude we found.
+    INTEGER(i_std)                                         :: closest_lon     !! The index of the closest longitude we found.
+    REAL(r_std)                                            :: distance        !! The distance from the current point to the 
+                                                                              !! point on the map
+    REAL(r_std)                                            :: closest_dist    !! The distance to the closet point we've found.
+    INTEGER                                                :: large_int       !! A number which indicates that the grid data
+                                                                              !! is not available
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)               :: lat_ful, lon_ful
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)            :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)               :: sub_area
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)          :: sub_index
+    CHARACTER(LEN=30)                                      :: callsign
+    INTEGER(i_std)                                         :: ibvm, nbvmax,ifm, ivma
+    LOGICAL                                                :: ok_interpol     !! optionnal return of aggregate_2d
+    REAL(r_std)                                            :: sum_fm,sumf
+    REAL(r_std),DIMENSION(nfm_types)                       :: fm_sum
+    LOGICAL                                                :: ltemp           !! temporary logical variable
+  !_ ================================================================================================================================
+
+    IF ( printlev >= 4 ) WRITE(numout,*) 'Entering read_in_desired_fm_map'
+
+    ! This integer has to be large enough that it never shows up on the map, without being
+    ! so large that is causes overflows.  Since none of the points on the map should be
+    ! larger than the number of FM strategies we have (nfm_types), this is sufficiently big.
+    large_int = nvmap*nfm_types+1
+
+    !Config Key   = FM_FILE
+    !Config Desc  = Name of file from which the forest management map is to be read
+    !Config If    = OK_STOMATE
+    !Config Def   = FMmap.nc
+    !Config Help  = The name of the file to be opened to read a forest management
+    !Config         map (including a layer for every PFT) is given here. 
+    !Config Units = [FILE]
+    filename = 'FM_desired.nc'
+    !CALL getin_p('FM_FILE',filename)
+
+    IF (is_root_prc) THEN
+       IF (debug) THEN
+          WRITE(numout,*) "Entering read_in_desired_fm_map. 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)
+
+    ! This finds the number of longitude points in the file.
+    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,*) "FM desired Map: iml =",iml
+
+    ! This finds the number of latitude points in the file.
+    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,*) "FM desired Map: jml =",jml
+
+    ! Now find the number of PFTs in the file.  If this is not equal to the number
+    ! of PFTs that we actually have, that's a problem and we'll crash.
+    IF (is_root_prc) &
+         CALL flioinqv (fid,v_n="FM_STRAT",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w) 
+    CALL bcast(l_d_w)
+    lml=l_d_w(3)
+
+    IF (lml /= nvmap) THEN
+       WRITE(numout,*) 'lml = ',lml
+       WRITE(numout,*) 'nvmap = ',nvmap
+       WRITE(numout,*) 'Stopping. '
+       CALL ipslerr_p (3,'sapiens_forestry', &
+            &          'Problem with the desired forest management strateg map.',&
+            &          'lml /= nvmap', '(number of pft must be equal)')
+    ENDIF
+
+    ! Allocate the map that will be read in
+    WRITE(numout,*) 'Reading the Desired Forest Management strategy file'
+    ALLOC_ERR=-1
+    ALLOCATE(fmmap_r(iml,jml,nvmap), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of fmmap_r : ",ALLOC_ERR
+      CALL ipslerr_p (3,'read_in_desired_fm_map', 'error in fmmap_r','','') 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(fmmap_i(iml,jml,nvmap), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of fmmap_i : ",ALLOC_ERR
+      CALL ipslerr_p (3,'read_in_desired_fm_map', 'error in fmmpap_i','','')
+    ENDIF
+
+    ! This reads in the map that is in the file
+    IF (is_root_prc) THEN
+       fmmap_r(:,:,:)=large_int*2.0
+       CALL fliogetv (fid,"FM_STRAT", fmmap_r, start=(/ 1, 1, 1 /), &
+            count=(/ iml, jml, nvmap /))
+
+       ! Right now the values are all real, but they should be integers.
+       ! Careful, NINT might not work if the precision of fmmap_r is not 
+       ! single. In that case, IDNINT should be used.
+       DO ip=1,iml
+          DO jp=1,jml
+             DO ivma=1,nvmap
+
+                ! There will be some fill values in here.  If we pass
+                ! a large fill value to NINT, it crashes.  So let's 
+                ! test for it
+#ifdef __NAGFOR
+                ltemp=IEEE_IS_NAN(fmmap_r(ip,jp,ivma))    
+#else
+                ltemp=isnan(fmmap_r(ip,jp,ivma))    
+#endif
+                IF(ltemp)THEN
+                   fmmap_i(ip,jp,ivma)=large_int
+                ELSE
+                   IF(fmmap_r(ip,jp,ivma) .GE. 0.0 .AND. fmmap_r(ip,jp,ivma) < large_int) THEN
+                      fmmap_i(ip,jp,ivma) = NINT(fmmap_r(ip,jp,ivma))
+                   ELSE
+
+                      ! This value should be big enough that we don't barl ourselves
+                      ! below.
+                      fmmap_i(ip,jp,ivma)=large_int
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+    CALL bcast(fmmap_i)
+
+    ! Now I need to get the latitude and longitude
+    ! First, get the axes from the map file.
+    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
+      CALL ipslerr_p (3,'read_in_desired_fm_map', 'error in lat_lu','','') 
+    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
+      CALL ipslerr_p (3,'read_in_desired_fm_map', 'error in lon_lu','','') 
+    ENDIF
+    IF (is_root_prc) THEN
+       CALL fliogstc (fid, x_axis=lon_lu,y_axis=lat_lu)
+    ENDIF
+    CALL bcast(lon_lu)
+    CALL bcast(lat_lu)
+
+    ! Now I can interpolate.  Remember that we are dealing with integer
+    ! values and management strategies.  Therefore, we cannot do a strict
+    ! interpolation, since that might gives values of the strategy to be
+    ! 2.3, or something ridiculous.  We cannot just round the number, either,
+    ! since we could have some squares with 1 (no management) and some with
+    ! 3 (coppices);  An average of that would be 2 (high stands), which doesn't
+    ! make any sense.  So we look to see what the most prevalent type of
+    ! management of nearby pixels is, and then just take that.
+    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
+      CALL ipslerr_p (3,'read_in_desired_fm_map', 'error in lat_ful','','')
+    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
+      CALL ipslerr_p (3,'read_in_desired_fm_map', 'error in lon_ful','','')
+    ENDIF
+    
+    DO ip=1,iml
+       lon_ful(ip,:)=lon_lu(ip)
+    ENDDO
+    DO jp=1,jml
+       lat_ful(:,jp)=lat_lu(jp)
+    ENDDO
+    
+    ! Mask of permitted variables.
+    ALLOC_ERR=-1
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR
+      CALL ipslerr_p (3,'read_in_desired_fm_map', 'error in mask','','')
+    ENDIF
+    
+    mask(:,:) = 0
+    DO ip=1,iml
+       DO jp=1,jml
+          ! If at least one PFT has a management strategy, we should interpolate
+          ! this grid point.
+          sum_fm=SUM(fmmap_i(ip,jp,:))
+          IF ( sum_fm .GT. min_sechiba .AND. sum_fm .LT. large_int) THEN
+             mask(ip,jp) = 1
+             IF (debug) THEN
+                WRITE(numout,*) "update : SUM(fmmap(",ip,jp,")) = ",sum_fm
+             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="Desired Forest Management 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(npts, nbvmax,2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
+          CALL ipslerr_p (3,'read_in_desired_fm_map', 'error in sub_index','','')
+       ENDIF
+       sub_index(:,:,:)=0
+
+       ALLOC_ERR=-1
+       ALLOCATE(sub_area(npts, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
+          CALL ipslerr_p (3,'read_in_desired_fm_map', 'error in sub_area','','') 
+       ENDIF
+       sub_area(:,:)=zero
+       
+       CALL aggregate_p(npts, 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
+    
+    DO ipts = 1, npts
+
+       ! For this point, we need to see what dominant FM types are
+       ! nearby.
+       sumf=zero
+
+       ! We need to do this for every PFT
+       DO ivma=1,nvmap
+
+          IF(.NOT. is_tree(start_index(ivma)))THEN
+
+             ! If it's not a forest, we don't care.
+             desired_managed(ipts,ivma)=0
+
+          ELSE
+
+             fm_sum(:)=0.0
+             DO ibvm=1, nbvmax
+                ! Leave the do loop if all sub areas are treated, 
+                ! sub_area <= 0
+                IF ( sub_area(ipts,ibvm) <= zero ) EXIT
+                ip = sub_index(ipts,ibvm,1)
+                jp = sub_index(ipts,ibvm,2)
+                ifm=fmmap_i(ip,jp,ivma)
+                fm_sum(ifm)=fm_sum(ifm)+sub_area(ipts,ibvm)
+             ENDDO
+
+             ! Whichever FM type has the most area, we use that one.
+             desired_managed(ipts,ivma)=MAXLOC(fm_sum(:),1)
+          ENDIF
+       ENDDO
+    ENDDO
+    
+    DEALLOCATE(fmmap_i)
+    DEALLOCATE(fmmap_r)
+    DEALLOCATE(lat_lu,lon_lu)
+    DEALLOCATE(lat_ful,lon_ful)
+    DEALLOCATE(mask)
+    IF(ALLOCATED(sub_index)) DEALLOCATE(sub_index)
+    IF(ALLOCATED(sub_area)) DEALLOCATE(sub_area)
+
+    IF ( printlev >= 5 ) WRITE(numout,*) 'Leaving read_in_desired_fm_map'
+
+  END SUBROUTINE read_in_desired_fm_map
+
+END MODULE sapiens_forestry
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_kill.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_kill.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_kill.f90	(revision 6412)
@@ -0,0 +1,2361 @@
+! =================================================================================================================================
+! MODULE       : sapiens_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       Kill all vegetation scheduled for killing by human activities.
+!!
+!!\n DESCRIPTION : Actually kills biomass.  The biomass is scheduled for killing
+!!       by the variable circ_class_kill in other sapiens routines.  Here the
+!!       biomass is moved to the litter and harvest pools, as appropriate.
+!!
+!! 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 sapiens_kill
+
+  ! modules used:
+
+  USE stomate_data
+  USE pft_parameters
+  USE ioipsl_para
+  USE stomate_mark_kill,      ONLY : distribute_mortality_biomass
+  USE function_library,       ONLY : nmax,  wood_to_dia, check_surface_area, &
+                                     check_mass_balance, cc_to_biomass
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC anthropogenic_mortality, anthropogenic_mortality_clear 
+  
+  ! Variable declaration
+
+  LOGICAL, SAVE             :: firstcall = .TRUE.     !! first call flag
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : anthropogenic_mortality_clear
+!!
+!>\BRIEF        Set the firstcall flag back to .TRUE. to prepare for the next simulation.
+!_ ================================================================================================================================
+  
+  SUBROUTINE anthropogenic_mortality_clear
+     firstcall = .TRUE.
+  END SUBROUTINE anthropogenic_mortality_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : anthropogenic_mortality
+!!
+!>\BRIEF        Transfer dead biomass to litter and update stand density as a result
+!!              of human activities.
+!!
+!! DESCRIPTION  : This routine has a simple purpose: kill individuals by human activities.  
+!!   The variable circ_class_kill indicates how many individuals need to be killed by the 
+!!   various processes in the code, and is calculated in other modules.  anthropogenic_mortality 
+!!   takes this variable and decides on the correct order of which to actually kill the
+!!   trees.  As these are all human activities, some of the biomass may be moved to
+!!   harvest pools, while other parts are moved to litter.
+!!
+!! RECENT CHANGE(S): 
+!!
+!! MAIN OUTPUT VARIABLE(S): ::circ_class_biomass; ::circ_class_n
+!!
+!! 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 anthropogenic_mortality (npts,  &
+       bm_to_litter, circ_class_biomass, circ_class_kill, &
+       circ_class_n, harvest_pool_bound, harvest_pool, harvest_type, &
+       harvest_cut, harvest_area, resolution, &
+       veget_cov_max, age_stand, last_cut, mai_count, circ_class_dist, &
+       coppice_dens, plant_status, biomass_cut)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    ! NOTE: if harvest_pool_bound is not explicitely defined 
+    ! the model uses 1:ndia_harvest+2 as its dimensions. If 
+    ! you like to do so remember to change the counters in
+    ! this routine
+    INTEGER(i_std), INTENT(in)                                   :: npts               !! Domain size (-)
+    REAL(r_std), DIMENSION(0:ndia_harvest+1), INTENT(in)         :: harvest_pool_bound !! The boundaries of the diameter classes
+
+                                                                                       !! in the wood harvest pools
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,2), INTENT(in)                    :: resolution         !! The length of each grid-box in X and Y
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                   :: veget_cov_max          !! Maximum fraction of vegetation type 
+    REAL(r_std), DIMENSION(ncirc), INTENT(in)                    :: circ_class_dist    !! The probability distribution of trees 
+                                                                                       !! in a circ class in case of a 
+                                                                                       !! redistribution (unitless).
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(in)                  :: coppice_dens       !! The density of a coppice at the first
+                                                                                       !! cutting.
+                                                                                       !! @tex $( 1 / m**2 )$ @endtex 
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables   
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), &                         
+                                              INTENT(inout)      :: circ_class_biomass !! Biomass of the components of the model  
+                                                                                       !! tree within a circumference
+                                                                                       !! class @tex $(gC ind^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(inout)        :: circ_class_n       !! Number of individuals in each circ class
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nfm_types,ncut_times),&
+                                                  INTENT(inout)  :: circ_class_kill    !! Number of trees within a circ that needs
+                                                                                       !! to be killed @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), &
+                                                  INTENT(inout)  :: bm_to_litter       !! Biomass transfer to litter 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)               :: harvest_pool       !! The wood and biomass that have been
+                                                                                       !! havested by humans @tex $(gC)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_type       !! Type of management that resulted
+                                                                                       !! in the harvest (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_cut        !! Type of cutting that was used for the harvest
+                                                                                       !! (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_area       !! Harvested area (m^{2})
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(inout)            :: last_cut           !! Years since last thinning or clearcut (years)
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(inout)            :: age_stand          !! Age of stand (years)
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(inout)            :: mai_count          !! The number of times we've
+                                                                                       !! calculated the volume increment
+                                                                                       !! for a stand
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: plant_status       !! Growth and phenological status of the plant
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements,nfm_types,ncut_times), &   
+                                                  INTENT(inout)  :: biomass_cut        !! Biomass change due to  ncut
+
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                               :: ipts,ivm           !! Indices
+    INTEGER(i_std)                                               :: iele, icir         !! Indices
+    INTEGER(i_std)                                               :: ipar, imbc         !! Indices
+    
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)           :: check_intern       !! Contains the components of the internal
+                                                                                       !! mass balance chech for this routine
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: closure_intern     !! Check closure of internal mass balance
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_start         !! Start pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_end           !! End pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                             :: veget_cov_max_begin    !! temporary storage of veget_cov_max to check area conservation
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements)            :: init_biomass       !! Temporary array of the initial biomass
+    REAL(r_std), DIMENSION(nparts,nelements)                     :: actu_biomass       !! Temporary array of the actual biomass
+!_ ================================================================================================================================
+
+    IF (printlev.GE.3) WRITE(numout,*) 'Entering anthropogenic_mortality'
+
+ !! 1. Initialize variables
+
+    !! 1.1 Initialize local printlev
+    !printlev_loc=get_printlev('anthrop_mortality')
+
+    ! 1.2 Initialize check for mass balance closure
+    IF (err_act.GT.1) THEN
+
+       check_intern(:,:,:,:) = zero
+       pool_start = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             DO icir = 1,ncirc
+                !  Initial litter and biomass
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                     (circ_class_biomass(:,:,icir,ipar,iele) * &
+                     circ_class_n(:,:,icir) * veget_cov_max(:,:))
+             ENDDO
+             pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                  (bm_to_litter(:,:,ipar,iele) * veget_cov_max(:,:))
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by 
+          ! veget_cov_max its units are already in gC pixel-1. Right 
+          ! now the harvest pool is in gC.  We will divide by the
+          ! resolution to make it per pixel. 
+          DO ipts = 1, npts
+             pool_start(ipts,:,iele) = pool_start(ipts,:,iele) + &
+                  SUM(harvest_pool(ipts,:,:,iele),2) / &
+                  (resolution(ipts,1) * resolution(ipts,2))
+          ENDDO
+          
+       ENDDO 
+
+       !! 1.3 Initialize check for area conservation
+       veget_cov_max_begin(:,:) = veget_cov_max(:,:)
+       
+    ENDIF ! err_act.GT.1
+
+    ! The total biomass at the start of the routine
+    init_biomass = cc_to_biomass(npts,nvm,circ_class_biomass(:,:,:,:,:),&
+         circ_class_n(:,:,:))
+
+
+ !! 3. Kill plants
+
+    ! All trees marked to die from forest management or salavage 
+    ! logging will be killed here (trees that died under a 
+    ! conservation strategy are dealt with natural_mortality.  
+    DO  ipts = 1,npts ! loop over land_points
+
+       DO ivm = 2,nvm  ! loop over #PFT
+
+          IF(veget_cov_max(ipts,ivm) == zero)THEN
+              ! this vegetation type is not present, so no reason to do the 
+              ! calculation
+              CYCLE
+          ENDIF
+
+          ! Clearcuts, salvage logging and thinning can only happen on trees.
+          IF(is_tree(ivm))THEN
+
+             ! Salvage logging after windthrow  in thin/high stand (managed
+             ! forest)
+             CALL clearcut_harvest_aboveground_dead_roots(npts, ipts, &
+                  ivm, ifm_thin, icut_storm_break, &
+                  bm_to_litter, circ_class_biomass, circ_class_kill, &
+                  circ_class_n, harvest_pool, harvest_type, harvest_cut, &
+                  harvest_area, harvest_pool_bound, resolution, veget_cov_max, &
+                  last_cut, age_stand, mai_count, &
+                  (un - branch_harvest(ivm)*branch_ratio(ivm)))
+
+             ! Store the biomass change of the stand due to storm damage
+             ! Update initial biomass in case there will be more killing
+             actu_biomass = cc_to_biomass(npts,nvm,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:))
+             biomass_cut(ipts,ivm,:,:,ifm_thin,icut_storm_break) = &
+                  init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+             init_biomass(ipts,ivm,:,:) =  actu_biomass(:,:)
+             
+             ! Salvage logging after windthrow in coppice stand (managed
+             ! forest )
+             CALL clearcut_harvest_aboveground_dead_roots(npts, ipts, &
+                  ivm, ifm_cop, icut_storm_break, &
+                  bm_to_litter, circ_class_biomass, circ_class_kill, &
+                  circ_class_n, harvest_pool, harvest_type, harvest_cut, &
+                  harvest_area, harvest_pool_bound, resolution, veget_cov_max, &
+                  last_cut, age_stand, mai_count, &
+                  (un - branch_harvest(ivm)*branch_ratio(ivm)))
+
+             ! Store the biomass change of the stand due to storm damage
+             ! Update initial biomass in case there will be more killing
+             actu_biomass = cc_to_biomass(npts,nvm,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:))
+             biomass_cut(ipts,ivm,:,:,ifm_cop,icut_storm_break) = &
+                  init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+             init_biomass(ipts,ivm,:,:) =  actu_biomass(:,:)
+             
+             ! Salvage logging after windthrow in SRC (Short Rotation Coppice) stand (managed
+             ! forest )
+             CALL clearcut_harvest_aboveground_dead_roots(npts, ipts, &
+                  ivm, ifm_src, icut_storm_break, &
+                  bm_to_litter, circ_class_biomass, circ_class_kill, &
+                  circ_class_n, harvest_pool, harvest_type, harvest_cut, &
+                  harvest_area, harvest_pool_bound, resolution, veget_cov_max, &
+                  last_cut, age_stand, mai_count, &
+                  (un - branch_harvest(ivm)*branch_ratio(ivm)))
+
+             ! Store the biomass change of the stand due to storm damage
+             ! Update initial biomass in case there will be more killing
+             actu_biomass = cc_to_biomass(npts,nvm,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:))
+             biomass_cut(ipts,ivm,:,:,ifm_src,icut_storm_break) = &
+                  init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+             init_biomass(ipts,ivm,:,:) =  actu_biomass(:,:)
+
+             ! Salvage logging after windthrow  in thin/high stand (managed
+             ! forest) 
+             CALL clearcut_harvest_aboveground_dead_roots(npts, ipts, &
+                  ivm, ifm_thin, icut_storm_uproot, &
+                  bm_to_litter, circ_class_biomass, circ_class_kill, &
+                  circ_class_n, harvest_pool, harvest_type, harvest_cut, &
+                  harvest_area, harvest_pool_bound, resolution, veget_cov_max, &
+                  last_cut, age_stand, mai_count, &
+                  (un - branch_harvest(ivm)*branch_ratio(ivm)))
+
+             ! Store the biomass change of the stand due to storm damage
+             ! Update initial biomass in case there will be more killing
+             actu_biomass = cc_to_biomass(npts,nvm,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:))
+             biomass_cut(ipts,ivm,:,:,ifm_thin,icut_storm_uproot) = &
+                  init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+             init_biomass(ipts,ivm,:,:) =  actu_biomass(:,:)
+             
+             ! Salvage logging after windthrow in coppice stand (managed
+             ! forest )                
+             CALL clearcut_harvest_aboveground_dead_roots(npts, ipts, &
+                  ivm, ifm_cop, icut_storm_uproot, &
+                  bm_to_litter, circ_class_biomass, circ_class_kill, &
+                  circ_class_n, harvest_pool, harvest_type, harvest_cut, &
+                  harvest_area, harvest_pool_bound, resolution, veget_cov_max, &
+                  last_cut, age_stand, mai_count, &
+                  (un - branch_harvest(ivm)*branch_ratio(ivm)))
+
+             ! Store the biomass change of the stand due to storm damage
+             ! Update initial biomass in case there will be more killing
+             actu_biomass = cc_to_biomass(npts,nvm,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:))
+             biomass_cut(ipts,ivm,:,:,ifm_cop,icut_storm_uproot) = &
+                  init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+             init_biomass(ipts,ivm,:,:) =  actu_biomass(:,:)
+
+             ! Salvage logging after windthrow in SRC (Short Rotation Coppice) 
+             ! stand (managed forest )
+             CALL clearcut_harvest_aboveground_dead_roots(npts, ipts, &
+                  ivm, ifm_src, icut_storm_uproot, &
+                  bm_to_litter, circ_class_biomass, circ_class_kill, &
+                  circ_class_n, harvest_pool, harvest_type, harvest_cut, &
+                  harvest_area, harvest_pool_bound, resolution, veget_cov_max, &
+                  last_cut, age_stand, mai_count, &
+                  (un - branch_harvest(ivm)*branch_ratio(ivm)))
+
+             ! Store the biomass change of the stand due to storm damage
+             ! Update initial biomass in case there will be more killing
+             actu_biomass = cc_to_biomass(npts,nvm,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:))
+             biomass_cut(ipts,ivm,:,:,ifm_src,icut_storm_uproot) = &
+                  init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+             init_biomass(ipts,ivm,:,:) =  actu_biomass(:,:)
+           
+             ! Now see if there are any plants to be killed by a clearcut.
+             ! Only the stems are harvested. This should be done before
+             ! a thinning so that we don't overcount.
+             CALL clearcut_harvest_aboveground_dead_roots(npts, ipts, &
+                  ivm, ifm_thin, icut_clear, &
+                  bm_to_litter, circ_class_biomass, circ_class_kill, &
+                  circ_class_n, harvest_pool, harvest_type, harvest_cut, &
+                  harvest_area, harvest_pool_bound, resolution, veget_cov_max,&
+                  last_cut, age_stand, mai_count, &
+                  (un - branch_harvest(ivm)*branch_ratio(ivm)))
+
+             ! Store the biomass change of the stand due to storm damage
+             ! Update initial biomass in case there will be more killing
+             actu_biomass = cc_to_biomass(npts,nvm,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:))
+             biomass_cut(ipts,ivm,:,:,ifm_thin,icut_clear) = &
+                  init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+             init_biomass(ipts,ivm,:,:) =  actu_biomass(:,:)
+
+             ! Not only do we harvest stems during thinning, we have to 
+             ! adjust the mortality.  We'll do all this in a subroutine.
+             CALL thinning_harvest_aboveground_dead_roots(npts, ipts, &
+                  ivm, ifm_thin, icut_thin, &
+                  bm_to_litter, circ_class_biomass, circ_class_kill, &
+                  circ_class_n, harvest_pool, harvest_type, harvest_cut, &
+                  harvest_area, harvest_pool_bound, resolution, veget_cov_max, &
+                  last_cut, (un - branch_harvest(ivm)*branch_ratio(ivm)))
+
+             ! Store the biomass change of the stand due to storm damage
+             ! Update initial biomass in case there will be more killing
+             actu_biomass = cc_to_biomass(npts,nvm,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:))
+             biomass_cut(ipts,ivm,:,:,ifm_thin,icut_thin) = &
+                  init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+             init_biomass(ipts,ivm,:,:) =  actu_biomass(:,:)
+
+             ! And the final cut of an SRC, where the underground wood 
+             ! dies. This is exactly the same as the clearcut above, 
+             ! except that we take all of the aboveground biomass.
+             CALL clearcut_harvest_aboveground_dead_roots(npts, ipts, &
+                  ivm, ifm_src, icut_cop3, &
+                  bm_to_litter, circ_class_biomass, circ_class_kill, &
+                  circ_class_n, harvest_pool, harvest_type, harvest_cut, &
+                  harvest_area, harvest_pool_bound, resolution, veget_cov_max,&
+                  last_cut, age_stand, mai_count, un)
+
+             ! Store the biomass change of the stand due to storm damage
+             ! Update initial biomass in case there will be more killing
+             actu_biomass = cc_to_biomass(npts,nvm,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:))
+             biomass_cut(ipts,ivm,:,:,ifm_src,icut_cop3) = &
+                  init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+             init_biomass(ipts,ivm,:,:) =  actu_biomass(:,:)
+             
+             ! Have we cut a coppice system for the first time?
+             CALL first_coppice_cut(npts, ipts, ivm, ifm_cop, &
+                  icut_cop1, harvest_pool_bound, resolution, veget_cov_max,&
+                  circ_class_biomass, circ_class_n, &
+                  circ_class_kill, bm_to_litter, harvest_pool, &
+                  harvest_type, harvest_cut, harvest_area, last_cut)
+
+             ! Store the biomass change of the stand due to storm damage
+             ! Update initial biomass in case there will be more killing
+             actu_biomass = cc_to_biomass(npts,nvm,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:))
+             biomass_cut(ipts,ivm,:,:,ifm_cop,icut_cop1) = &
+                  init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+             init_biomass(ipts,ivm,:,:) =  actu_biomass(:,:)
+
+             CALL first_coppice_cut(npts, ipts, ivm, ifm_src, &
+                  icut_cop1, harvest_pool_bound, resolution, veget_cov_max,&
+                  circ_class_biomass, circ_class_n, &
+                  circ_class_kill, bm_to_litter, harvest_pool, &
+                  harvest_type, harvest_cut, harvest_area, last_cut)
+
+             ! Store the biomass change of the stand due to storm damage
+             ! Update initial biomass in case there will be more killing
+             actu_biomass = cc_to_biomass(npts,nvm,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:))
+             biomass_cut(ipts,ivm,:,:,ifm_src,icut_cop1) = &
+                  init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+             init_biomass(ipts,ivm,:,:) =  actu_biomass(:,:)
+
+             ! What if we coppice for the second (and subsequent) cuts?
+             CALL second_coppice_cut(npts, ipts, ivm, ifm_cop, &
+                  icut_cop2, harvest_pool_bound, resolution, veget_cov_max,&
+                  circ_class_biomass, circ_class_n, &
+                  circ_class_kill, bm_to_litter, harvest_pool, &
+                  harvest_type, harvest_cut, harvest_area, &
+                  circ_class_dist, last_cut, coppice_dens)
+             
+             ! Store the biomass change of the stand due to storm damage
+             ! Update initial biomass in case there will be more killing
+             actu_biomass = cc_to_biomass(npts,nvm,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:))
+             biomass_cut(ipts,ivm,:,:,ifm_cop,icut_cop2) = &
+                  init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+             init_biomass(ipts,ivm,:,:) =  actu_biomass(:,:)
+
+             ! For short rotation coppices
+             CALL second_coppice_cut(npts, ipts, ivm, ifm_src, &
+                  icut_cop2, harvest_pool_bound, resolution, veget_cov_max,&
+                  circ_class_biomass, circ_class_n, &
+                  circ_class_kill, bm_to_litter, harvest_pool, &
+                  harvest_type, harvest_cut, harvest_area, &
+                  circ_class_dist, last_cut, coppice_dens)
+
+             ! Store the biomass change of the stand due to storm damage
+             ! Update initial biomass in case there will be more killing
+             actu_biomass = cc_to_biomass(npts,nvm,&
+                  circ_class_biomass(ipts,ivm,:,:,:),&
+                  circ_class_n(ipts,ivm,:))
+             biomass_cut(ipts,ivm,:,:,ifm_src,icut_cop2) = &
+                  init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+             init_biomass(ipts,ivm,:,:) =  actu_biomass(:,:)
+             
+          ENDIF ! is_tree(ivm)
+
+          ! Here some circ classes may be empty.  We do not want to do
+          ! anything about that yet, since we have not killed the natural
+          ! mortality biomass.  If we redistribute the biomass now we will
+          ! change the circ_class_biomass, but the old values for this
+          ! were used to determine circ_class_kill(inatural) in 
+          ! stomate_mark_kill.  If we change those values we will kill 
+          ! the wrong amount of biomass in stomate_kill.
+
+          ! It is possible that all the biomass was killed. The plant_status
+          ! should then be set to idead. In mortality_clean all the necessary 
+          ! actions will be taken to make sure that the PFT will be prescribed 
+          ! at the start of the year.
+          IF (SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1)).LT.min_stomate)THEN
+ 
+             ! Kill the PFT
+             plant_status(ipts,ivm) = idead
+
+             ! Move the remaining biomass into the proper
+             ! litter pools
+             DO ipar = 1,nparts
+                DO iele = 1,nelements
+                   bm_to_litter(ipts,ivm,ipar,iele) = &
+                        bm_to_litter(ipts,ivm,ipar,iele) + &
+                        SUM(circ_class_biomass(ipts,ivm,:,ipar,iele) * &
+                        circ_class_n(ipts,ivm,:))
+                ENDDO
+             ENDDO
+
+             ! Set the biomass and the number of individuals to zero
+             circ_class_biomass(ipts,ivm,:,:,:) = zero
+             circ_class_n(ipts,ivm,:) = zero
+
+          ENDIF
+
+       ENDDO  ! loop over pfts
+
+    END DO ! loop over land points
+
+ !! 4. Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 4.2 Check surface area
+       CALL check_surface_area("stomate_anthropogenic_mortality", npts, &
+            veget_cov_max_begin, veget_cov_max,'pft')
+
+       ! 4.3 Mass balance closure 
+       pool_end = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             DO icir = 1,ncirc
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                     (circ_class_biomass(:,:,icir,ipar,iele) * &
+                     circ_class_n(:,:,icir) * veget_cov_max(:,:)) 
+             ENDDO
+             pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                     bm_to_litter(:,:,ipar,iele) * veget_cov_max(:,:)
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by veget_cov_max
+          ! its units are already in gC pixel-1. Right now the harvest 
+          ! pool is in gC.  We will divide by the resolution to make it 
+          ! per pixel.
+          DO ipts = 1, npts
+             pool_end(ipts,:,iele) = pool_end(ipts,:,iele) + &
+                  SUM(harvest_pool(ipts,:,:,iele),2) / &
+                  (resolution(ipts,1) * resolution(ipts,2))
+          ENDDO
+       ENDDO ! nelements
+   
+       ! 4.3.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(:,:,ipoolchange,iele) = -un * (pool_end(:,:,iele) - &
+               pool_start(:,:,iele)) 
+       ENDDO
+
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) WRITE(numout,*) &
+                  'check_intern, ivm, imbc, iele, ', imbc, &
+                  iele, check_intern(:,test_pft,imbc,iele)
+             !-
+             closure_intern(:,:,iele) = closure_intern(:,:,iele) + &
+                  check_intern(:,:,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 4.3.3 Check mass balance closure
+       CALL check_mass_balance("stomate_anthropogenic_mortality", closure_intern, &
+            npts, pool_end, pool_start, veget_cov_max, 'pft')
+      
+    ENDIF ! err_act.GT.1
+
+    IF (printlev.GE.4) WRITE(numout,*) 'Leaving anthropogenic_mortality'
+
+  END SUBROUTINE anthropogenic_mortality
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thinning_harvest_aboveground_dead_roots
+!!
+!>\BRIEF        Transfer dead biomass to litter and update stand density due
+!!              to thinning operations
+!!
+!! DESCRIPTION  : Moves dead biomass to the litter pool and the harvest pool
+!!                where appropriate.  Since not all the trees are killed,
+!!                fewer counters have to be reset here than in the clearcut
+!!                case.  In addition, thinning will change the fraction of
+!!                trees killed by mortality, so we account for that as well.
+!!
+!!                NOTE: If harvest_fraction is 1, all the aboveground biomass is
+!!                      harvested.  If it's 1-branch_ratio, only stems are 
+!!                      harvested.  Belowground wood, roots, fruits, and
+!!                      leaves all become litter.  A portion of aboveground
+!!                      wood is put in the harvest pool.  Reserves and labile
+!!                      carbon are assumed to be distributed evenly across
+!!                      all non-heartwood components.
+!!
+!! RECENT CHANGE(S): 
+!!
+!! MAIN OUTPUT VARIABLE(S): ::circ_class_biomass; ::circ_class_n; ::circ_class_kill
+!!
+!! REFERENCE(S)   :
+!!
+!! FLOWCHART    : None
+!!\n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE thinning_harvest_aboveground_dead_roots (npts, ipts, &
+       ivm, ifm, icut, bm_to_litter, &
+       circ_class_biomass, circ_class_kill, circ_class_n, &
+       harvest_pool, harvest_type, harvest_cut, harvest_area, &
+       harvest_pool_bound, resolution, veget_cov_max, last_cut, &
+       harvest_fraction)
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+    ! NOTE: if harvest_pool_bound is not explicitely defined 
+    ! the model uses 1:ndia_harvest+2 as its dimensions. If 
+    ! you like to do so remember to change the counters in
+    ! this routine
+    INTEGER(i_std), INTENT(in)                                   :: npts               !! Domain size (-)
+    INTEGER(i_std), INTENT(in)                                   :: ipts               !! current grid square
+    INTEGER(i_std), INTENT(in)                                   :: ivm                !! current PFT
+    INTEGER(i_std), INTENT(in)                                   :: ifm                !! current fm strategy
+    INTEGER(i_std), INTENT(in)                                   :: icut               !! current cut time
+    REAL(r_std), DIMENSION(0:ndia_harvest+1), INTENT(in)         :: harvest_pool_bound !! The boundaries of the diameter classes
+                                                                                       !! in the wood harvest pools
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,2), INTENT(in)                    :: resolution         !! The length of each grid-box in X and Y
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                   :: veget_cov_max          !! Maximum fraction of vegetation type 
+    REAL(r_std),INTENT(in)                                       :: harvest_fraction   !! The fraction of the aboveground
+                                                                                       !! biomass that is harvested.  This is
+                                                                                       !! generally 1-branch_ratio if you only
+                                                                                       !! want to harvest the stems, and 1 if
+                                                                                       !! you want to harvest everything.
+
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables   
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), &                         
+                                              INTENT(inout)      :: circ_class_biomass !! Biomass of the components of the model  
+                                                                                       !! tree within a circumference
+                                                                                       !! class @tex $(gC ind^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(inout)        :: circ_class_n       !! Number of individuals in each circ class
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nfm_types,ncut_times), &
+                                                  INTENT(inout)  :: circ_class_kill    !! Number of trees within a circ that needs
+                                                                                       !! to be killed @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), &
+                                                  INTENT(inout)  :: bm_to_litter       !! Biomass transfer to litter 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)               :: harvest_pool       !! The wood and biomass that have been
+                                                                                       !! havested by humans @tex $(gC)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_type       !! Type of management that resulted
+                                                                                       !! in the harvest (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_cut        !! Type of cutting that was used for the harvest
+                                                                                       !! (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_area       !! Harvested area (m^{2})
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(inout)            :: last_cut           !! Years since last thinning or clearcut (years)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                               :: icir, imbc, iele   !! Indices
+    INTEGER(i_std)                                               :: ipar               !! Indices
+    REAL(r_std)                                                  :: total_bm
+    REAL(r_std)                                                  :: thinned_bm
+    REAL(r_std)                                                  :: dead_bm
+    REAL(r_std)                                                  :: bm_difference
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)           :: check_intern       !! Contains the components of the internal
+                                                                                       !! mass balance chech for this routine
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: closure_intern     !! Check closure of internal mass balance
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_start         !! Start pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_end           !! End pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    !_ ================================================================================================================================
+
+    IF (printlev.GE.3) WRITE(numout,*) &
+         'Entering thinning_harvest_aboveground_dead_roots sapiens_kill.f90'
+
+    ! 1.2 Initialize check for mass balance closure
+    IF (err_act.GT.1) THEN
+       
+       check_intern(:,:,:,:) = zero
+       pool_start = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             ! Initial litter and biomass. This routine is called
+             ! within an ipts-LOOP and an ivm-LOOP so we test one 
+             ! pixel and one pft at a time. Store in the first position.
+             DO icir = 1,ncirc
+                pool_start(1,1,iele) = pool_start(1,1,iele) + &
+                     (circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                     circ_class_n(ipts,ivm,icir) * veget_cov_max(ipts,ivm))
+             ENDDO
+             pool_start(1,1,iele) = pool_start(1,1,iele) + &
+                  (bm_to_litter(ipts,ivm,ipar,iele) * veget_cov_max(ipts,ivm))
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by 
+          ! veget_cov_max its units are already in gC pixel-1. Right 
+          ! now the harvest pool is in gC.  We will divide by the
+          ! resolution to make it per pixel. 
+          pool_start(1,1,iele) = pool_start(1,1,iele) + &
+               SUM(harvest_pool(ipts,ivm,:,iele)) / &
+               (resolution(ipts,1) * resolution(ipts,2))
+          
+       ENDDO 
+       
+    ENDIF ! err_act.GT.1
+
+
+    IF( SUM(circ_class_kill(ipts,ivm,:,ifm,icut)) .GT. min_stomate ) THEN
+
+       CALL harvest_aboveground_dead_roots(npts, ipts, ivm, &
+            ifm, icut, bm_to_litter, &
+            circ_class_biomass, circ_class_kill, circ_class_n, harvest_pool, &
+            harvest_type, harvest_cut, harvest_area, &
+            harvest_pool_bound, resolution, veget_cov_max, harvest_fraction)
+
+       ! thinning trees generally avoids natural mortality and self-thinning, 
+       ! so let's remove all thinned trees from the pools.  This is tricky 
+       ! because mortality depends on a fraction of the total biomass, which 
+       ! may be spread out over different circ classes than what were killed 
+       ! by thinning.
+       thinned_bm = zero
+       dead_bm = zero
+       DO icir=1,ncirc
+          total_bm=SUM(circ_class_biomass(ipts,ivm,icir,:,icarbon))
+          thinned_bm=thinned_bm+circ_class_kill(ipts,ivm,icir,ifm,icut)*&
+               total_bm
+          dead_bm=dead_bm+circ_class_kill(ipts,ivm,icir,ifm_none,icut_thin)*&
+               total_bm
+       ENDDO
+
+       bm_difference = dead_bm - thinned_bm
+       IF(bm_difference .LE. min_stomate)THEN
+
+          ! if the thinned biomass is more than what would have died from 
+          ! natural causes, we can just assume that thinning killed all 
+          ! these trees. Zero out natural mortality.
+          circ_class_kill(ipts,ivm,:,ifm_none,icut_thin)=zero
+
+       ELSE
+
+          ! if not, we have to reduce the amount of biomass that is 
+          ! killed naturally by what was removed by thinning, 
+          ! redistributing the remainder properly across all circ 
+          ! classes as we did in stomate_mark_kill.
+          circ_class_kill(ipts,ivm,:,ifm_none,icut_thin) = zero
+          CALL distribute_mortality_biomass( bm_difference, &
+               death_distribution_factor(ivm), &
+               circ_class_n(ipts,ivm,:), &
+               circ_class_biomass(ipts,ivm,:,:,icarbon), &
+               circ_class_kill(ipts,ivm,:,ifm_none,icut_thin) )
+       ENDIF ! bm_difference .LE. min_stomate
+
+       ! make sure nothing has gone negative
+       WHERE ( circ_class_kill(ipts,ivm,:,ifm_none,icut_thin) .LT. zero )
+          circ_class_kill(ipts,ivm,:,ifm_none,icut_thin)=zero
+       END WHERE
+
+       ! now zero out this circ_class_kill, since we should never try
+       ! to kill these same trees again.
+       circ_class_kill(ipts,ivm,:,ifm,icut)=zero
+
+       ! Reset the values for the time since the last operation
+       last_cut(ipts,ivm)=0
+       
+    ENDIF ! checking to see if we have biomass to thin
+
+
+ !! Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 4.3 Mass balance closure 
+       pool_end(:,:,:) = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             DO icir = 1,ncirc
+                pool_end(1,1,iele) = pool_end(1,1,iele) + &
+                     (circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                     circ_class_n(ipts,ivm,icir) * veget_cov_max(ipts,ivm))
+             ENDDO
+             pool_end(1,1,iele) = pool_end(1,1,iele) + &
+                  (bm_to_litter(ipts,ivm,ipar,iele) * veget_cov_max(ipts,ivm))
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by veget_cov_max
+          ! its units are already in gC pixel-1. Right now the harvest 
+          ! pool is in gC.  We will divide by the resolution to make it 
+          ! per pixel.
+          pool_end(1,1,iele) = pool_end(1,1,iele) + &
+               SUM(harvest_pool(ipts,ivm,:,iele)) / &
+               (resolution(ipts,1) * resolution(ipts,2))
+       ENDDO ! nelements
+   
+       ! 4.3.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(1,1,ipoolchange,iele) = -un * (pool_end(1,1,iele) - &
+               pool_start(1,1,iele)) 
+       ENDDO
+
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) WRITE(numout,*) &
+                  'check_intern, ivm, imbc, iele, ', imbc, &
+                  iele, check_intern(1,1,imbc,iele)
+             !-
+             closure_intern(1,1,iele) = closure_intern(1,1,iele) + &
+                  check_intern(1,1,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 4.3.3 Check mass balance closure
+       CALL check_mass_balance("thinning_harvest_aboveground_dead_roots", &
+            closure_intern, npts, pool_end, pool_start, veget_cov_max, 'ipts')
+      
+    ENDIF ! err_act.GT.1
+
+    IF (printlev.GE.4) WRITE(numout,*) &
+         'Leaving thinning_harvest_aboveground_dead_roots'
+
+  END SUBROUTINE thinning_harvest_aboveground_dead_roots
+
+!! ================================================================================================================================
+!! SUBROUTINE   : harvest_aboveground_dead_roots
+!!
+!>\BRIEF        Transfer dead biomass to litter and wood to harvest pool.
+!!
+!! DESCRIPTION  : Moves dead biomass to the litter pool and the harvest pool
+!!                where appropriate.  
+!!
+!!                NOTE: If harvest_fraction is 1, all the aboveground biomass is
+!!                      harvested.  If it's 1-branch_ratio, only stems are 
+!!                      harvested.  Belowground wood, roots, fruits, and
+!!                      leaves all become litter.  A portion of aboveground
+!!                      wood is put in the harvest pool.  Reserves and labile
+!!                      carbon are assumed to be distributed evenly across
+!!                      all non-heartwood components.
+!!
+!! RECENT CHANGE(S): 
+!!
+!! MAIN OUTPUT VARIABLE(S): ::bm_to_litter, ::harvest_pool
+!!
+!! REFERENCE(S)   :
+!!
+!! FLOWCHART    : None
+!!\n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE harvest_aboveground_dead_roots (npts, ipts, ivm, &
+       ifm, icut, bm_to_litter, &
+       circ_class_biomass, circ_class_kill, circ_class_n, harvest_pool, &
+       harvest_type, harvest_cut, harvest_area, &
+       harvest_pool_bound, resolution, veget_cov_max, harvest_fraction)
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+    ! NOTE: if harvest_pool_bound is not explicitely defined 
+    ! the model uses 1:ndia_harvest+2 as its dimensions. If 
+    ! you like to do so remember to change the counters in
+    ! this routine
+    INTEGER(i_std), INTENT(in)                                   :: npts               !! Domain size (-)
+    INTEGER(i_std), INTENT(in)                                   :: ipts               !! current grid square
+    INTEGER(i_std), INTENT(in)                                   :: ivm                !! current PFT
+    INTEGER(i_std), INTENT(in)                                   :: ifm                !! current fm strategy
+    INTEGER(i_std), INTENT(in)                                   :: icut               !! current cut time
+    REAL(r_std), DIMENSION(0:ndia_harvest+1), INTENT(in)         :: harvest_pool_bound !! The boundaries of the diameter classes
+                                                                                       !! in the wood harvest pools
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,2), INTENT(in)                    :: resolution         !! The length of each grid-box in X and Y
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                   :: veget_cov_max          !! Maximum fraction of vegetation type 
+    REAL(r_std),INTENT(in)                                       :: harvest_fraction   !! The fraction of the aboveground
+                                                                                       !! biomass that is harvested.  This is
+                                                                                       !! generally 1-branch_ratio if you only
+                                                                                       !! want to harvest the stems, and 1 if
+                                                                                       !! you want to harvest everything.
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables   
+
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), &                         
+                                              INTENT(inout)      :: circ_class_biomass !! Biomass of the components of the model  
+                                                                                       !! tree within a circumference
+                                                                                       !! class @tex $(gC ind^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(inout)        :: circ_class_n       !! Number of individuals in each circ class
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nfm_types,ncut_times), &
+                                                  INTENT(inout)  :: circ_class_kill    !! Number of trees within a circ that needs
+                                                                                       !! to be killed @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), &
+                                                  INTENT(inout)  :: bm_to_litter       !! Biomass transfer to litter 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)               :: harvest_pool       !! The wood and biomass that have been
+                                                                                       !! havested by humans @tex $(gC)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_type       !! Type of management that resulted
+                                                                                       !! in the harvest (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_cut        !! Type of cutting that was used for the harvest
+                                                                                       !! (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_area       !! Harvested area (m^{2})
+
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                               :: idia, icir, imbc   !! Indices
+    INTEGER(i_std)                                               :: iele, ipar         !! Indices
+    REAL(r_std), DIMENSION(nelements)                            :: total_nonheart_biomass_harvest
+    REAL(r_std), DIMENSION(nelements)                            :: total_nonheart_biomass_kill
+    REAL(r_std), DIMENSION(nelements)                            :: harvest_ratio
+    REAL(r_std), DIMENSION(ncirc)                                :: diameters_temp
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)           :: check_intern       !! Contains the components of the internal
+                                                                                       !! mass balance chech for this routine
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: closure_intern     !! Check closure of internal mass balance
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_start         !! Start pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_end           !! End pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+
+    !_ ================================================================================================================================
+
+    IF (printlev.GE.3) WRITE(numout,*) &
+         'Entering harvest_aboveground_dead_roots sapiens_kill.f90'
+
+    !! 1.1 Initialize local printlev
+    !printlev_loc=get_printlev('anthrop_mortality')
+
+    ! 1.2 Initialize check for mass balance closure
+    IF (err_act.GT.1) THEN
+       
+       check_intern(:,:,:,:) = zero
+       pool_start = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             ! Initial litter and biomass. This routine is called
+             ! within an ipts-LOOP and an ivm-LOOP so we test one 
+             ! pixel and one pft at a time. Store in the first position.
+             DO icir = 1,ncirc
+                pool_start(1,1,iele) = pool_start(1,1,iele) + &
+                     (circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                     circ_class_n(ipts,ivm,icir) * veget_cov_max(ipts,ivm))
+             ENDDO
+             pool_start(1,1,iele) = pool_start(1,1,iele) + &
+                  (bm_to_litter(ipts,ivm,ipar,iele) * veget_cov_max(ipts,ivm))
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by 
+          ! veget_cov_max its units are already in gC pixel-1. Right 
+          ! now the harvest pool is in gC.  We will divide by the
+          ! resolution to make it per pixel. 
+          pool_start(1,1,iele) = pool_start(1,1,iele) + &
+               SUM(harvest_pool(ipts,ivm,:,iele)) / &
+               (resolution(ipts,1) * resolution(ipts,2))
+          
+       ENDDO 
+       
+    ENDIF ! err_act.GT.1
+ 
+    ! We will need the trunk diameters for all the circ classes 
+    ! in order to figure out which harvest pool to put them in.
+    diameters_temp(:)=wood_to_dia(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm) 
+
+    DO icir=1,ncirc
+
+       ! It's possible that we only kill individuals in certain circ classes.
+       ! In this case, we need to check for each circ class to make sure
+       ! we don't divide by zero.
+       IF(circ_class_kill(ipts,ivm,icir,ifm,icut) .LT. min_stomate) CYCLE
+
+       ! Debug
+       IF(printlev_loc>=4 .AND. ipts == test_grid .AND. ivm == test_pft)THEN
+          WRITE(numout,*) 'Killing trees in harvest_aboveground_dead_roots'
+          WRITE(numout,*) 'ipts,ivm,icir,ifm,icut: ',ipts,ivm,icir,ifm,icut
+          WRITE(numout,*) 'circ_class_kill,circ_class_n: ',&
+               circ_class_kill(ipts,ivm,icir,ifm,icut),&
+               circ_class_n(ipts,ivm,icir)
+       ENDIF
+       !-
+
+       ! The decision of what to do with the carboyhydrate reserves and the
+       ! labile carbon pool are tricky. In turnover, they are not touched
+       ! when leaves/roots/fruits die, which implies that they are stored
+       ! primarily in the above and belowground sapwood (heartwood is dead). 
+       ! However, here a tree does not know thinning is coming, so it cannot
+       ! move this carbon around.  We will therefore determine where is goes
+       ! based on the total amount of non-heartwood pools and where they go.
+       total_nonheart_biomass_kill(:)=circ_class_kill(ipts,ivm,icir,ifm,icut)*&
+            (circ_class_biomass(ipts,ivm,icir,isapbelow,:)+&
+            circ_class_biomass(ipts,ivm,icir,iroot,:)+&
+            circ_class_biomass(ipts,ivm,icir,ileaf,:)+&
+            circ_class_biomass(ipts,ivm,icir,ifruit,:)+&
+            circ_class_biomass(ipts,ivm,icir,isapabove,:))
+
+       total_nonheart_biomass_harvest(:)=harvest_fraction*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)*&
+            circ_class_biomass(ipts,ivm,icir,isapabove,:)
+
+       ! This is now the fraction of the nonheartwood biomass that will 
+       ! go into the harvest pool.  We will use this to partition the 
+       ! carbohydrate reserve and labile pools into litter and harvest.
+       harvest_ratio(:)=total_nonheart_biomass_harvest(:) / &
+            total_nonheart_biomass_kill(:)
+
+       ! all of the following biomass becomes litter
+       bm_to_litter(ipts,ivm,isapbelow,:) = &
+            bm_to_litter(ipts,ivm,isapbelow,:) + &
+            circ_class_biomass(ipts,ivm,icir,isapbelow,:)*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+       bm_to_litter(ipts,ivm,iheartbelow,:) = &
+            bm_to_litter(ipts,ivm,iheartbelow,:) + &
+            circ_class_biomass(ipts,ivm,icir,iheartbelow,:)*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+       bm_to_litter(ipts,ivm,iroot,:) = bm_to_litter(ipts,ivm,iroot,:) + &
+            circ_class_biomass(ipts,ivm,icir,iroot,:)*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+       bm_to_litter(ipts,ivm,ileaf,:) = bm_to_litter(ipts,ivm,ileaf,:) + &
+            circ_class_biomass(ipts,ivm,icir,ileaf,:)*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+       bm_to_litter(ipts,ivm,ifruit,:) = &
+            bm_to_litter(ipts,ivm,ifruit,:) + &
+            circ_class_biomass(ipts,ivm,icir,ifruit,:)*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+
+       ! Include the branches as litter, if necessary.
+       bm_to_litter(ipts,ivm,isapabove,:) = &
+            bm_to_litter(ipts,ivm,isapabove,:) + &
+            (un - harvest_fraction)*&
+            circ_class_biomass(ipts,ivm,icir,isapabove,:)*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+       bm_to_litter(ipts,ivm,iheartabove,:) = &
+            bm_to_litter(ipts,ivm,iheartabove,:) + &
+            (un - harvest_fraction)*&
+            circ_class_biomass(ipts,ivm,icir,iheartabove,:)*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+
+       ! Don't forget to include the proper proportion of the labile and
+       ! carbres pools.
+       bm_to_litter(ipts,ivm,icarbres,:) = &
+            bm_to_litter(ipts,ivm,icarbres,:) + &
+            (un - harvest_ratio(:))*&
+            circ_class_biomass(ipts,ivm,icir,icarbres,:)*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+       bm_to_litter(ipts,ivm,ilabile,:) = &
+            bm_to_litter(ipts,ivm,ilabile,:) + &
+            (un - harvest_ratio(:))*&
+            circ_class_biomass(ipts,ivm,icir,ilabile,:)*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+
+       ! now we harvest the stems.  These are what we want to save, and we are
+       ! going to classify them by PFT type, location, and diameter so that
+       ! we can compare to FAO statistics and do some more interesting
+       ! post-treatment.
+
+       ! UNITS: The units of the biomass pools are per meter squared.
+       ! It seems to make more sense to store the harvest pool in absolute
+       ! units, which means we have to multiple the result by the fraction of
+       ! this grid cell covered by this PFT (veget_cov_max) and the size of the 
+       ! grid cell.  It seems that the fraction of nobio land does not need 
+       ! to be used here, since frac_nobio and veget_cov_max are summed together 
+       ! in slowproc and they must equal one.  This gives
+       ! us the grams of carbon harvest, which is a big number but that's
+       ! why people invented scientific notation.
+       dia_loop:DO idia=1,ndia_harvest
+
+          ! Move the harvest to the correct diameter class and
+          ! account for the largest diameter class because
+          ! harvest_pool_bound has only ndia_harvest+1 dimensions
+          IF ( (diameters_temp(icir).LE.harvest_pool_bound(idia)).OR.&
+               ((diameters_temp(icir).GT.harvest_pool_bound(ndia_harvest)).AND.&
+               (diameters_temp(icir).LT.harvest_pool_bound(ndia_harvest+1))))& 
+               THEN
+
+             ! this is the correct diameter class 
+             harvest_pool(ipts,ivm,idia,:) = &
+                  harvest_pool(ipts,ivm,idia,:) + &
+                  harvest_fraction*circ_class_kill(ipts,ivm,icir,ifm,icut)*&
+                  (circ_class_biomass(ipts,ivm,icir,isapabove,:)+&
+                  circ_class_biomass(ipts,ivm,icir,iheartabove,:)) * &
+                  veget_cov_max(ipts,ivm) * &
+                  resolution(ipts,1) * resolution(ipts,2)
+
+             ! also add the proper fractions of the labile and carbres pools
+             harvest_pool(ipts,ivm,idia,:) = &
+                  harvest_pool(ipts,ivm,idia,:)+ &
+                  harvest_ratio(:) * circ_class_kill(ipts,ivm,icir,ifm,icut)*&
+                  ( circ_class_biomass(ipts,ivm,icir,ilabile,:) + &
+                  circ_class_biomass(ipts,ivm,icir,icarbres,:) )* &
+                  veget_cov_max(ipts,ivm) * &
+                  resolution(ipts,1) * resolution(ipts,2)
+             
+             ! Associated harvest variables
+             harvest_type(ipts,ivm) = ifm
+             harvest_cut(ipts,ivm) = icut
+             harvest_area(ipts,ivm) = veget_cov_max(ipts,ivm) * &
+                  resolution(ipts,1) * resolution(ipts,2)
+              
+             EXIT dia_loop
+
+          ENDIF ! diameters_temp(icir) .LE. harvest_pool_bound(idia)
+
+          ! If we are here, it means the diameter of this trunk is larger
+          ! than the upper boundary of our harvest bins.  Considering the
+          ! upper boundary is set to be 99999 meters in constants.f90,
+          ! something has gone wrong!
+          IF (diameters_temp(icir).GE.harvest_pool_bound(ndia_harvest+1)) THEN
+
+             WRITE(numout,*) 'ERROR: Our tree is too big to fit '&
+                  // 'into the harvest pools.'
+             WRITE(numout,*) 'ipts, ivm, icir: ',ipts, ivm, icir
+             WRITE(numout,*) 'diameters_temp(icir), harvest_pool_bound(idia)',&
+                  diameters_temp(icir),harvest_pool_bound(ndia_harvest+1)
+             CALL ipslerr_p (3,'harvest_aboveground_dead_roots', &
+                  'Tree too big to fit into the harvest pool.',&
+                  'Look into the output file for details.','')
+          ENDIF
+
+       ENDDO dia_loop
+       
+       ! remove the number of individuals that were harvested
+       circ_class_n(ipts,ivm,icir) = circ_class_n(ipts,ivm,icir) - &
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+
+    ENDDO ! loop over circ classes
+
+
+    !! Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 4.3 Mass balance closure 
+       pool_end(:,:,:) = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             DO icir = 1,ncirc
+                pool_end(1,1,iele) = pool_end(1,1,iele) + &
+                     (circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                     circ_class_n(ipts,ivm,icir) * veget_cov_max(ipts,ivm))
+             ENDDO
+             pool_end(1,1,iele) = pool_end(1,1,iele) + &
+                  (bm_to_litter(ipts,ivm,ipar,iele) * veget_cov_max(ipts,ivm))
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by veget_cov_max
+          ! its units are already in gC pixel-1. Right now the harvest 
+          ! pool is in gC.  We will divide by the resolution to make it 
+          ! per pixel.
+          pool_end(1,1,iele) = pool_end(1,1,iele) + &
+               SUM(harvest_pool(ipts,ivm,:,iele)) / &
+               (resolution(ipts,1) * resolution(ipts,2))
+       ENDDO ! nelements
+   
+       ! 4.3.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(1,1,ipoolchange,iele) = -un * (pool_end(1,1,iele) - &
+               pool_start(1,1,iele)) 
+       ENDDO
+
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) WRITE(numout,*) &
+                  'check_intern, ivm, imbc, iele, ', imbc, &
+                  iele, check_intern(1,1,imbc,iele)
+             !-
+             closure_intern(1,1,iele) = closure_intern(1,1,iele) + &
+                  check_intern(1,1,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 4.3.3 Check mass balance closure
+       CALL check_mass_balance("harvest_aboveground_dead_roots", closure_intern, &
+            npts, pool_end, pool_start, veget_cov_max, 'ipts')
+      
+    ENDIF ! err_act.GT.1
+
+    IF (printlev.GE.4) WRITE(numout,*) &
+         'Leaving harvest_aboveground_dead_roots'
+
+  END SUBROUTINE harvest_aboveground_dead_roots
+
+!! ================================================================================================================================
+!! SUBROUTINE   : harvest_aboveground_wood_living_roots
+!!
+!>\BRIEF        Transfer dead biomass to litter and wood to harvest pool.
+!!
+!! DESCRIPTION  : Moves dead biomass to the litter pool and the harvest pool
+!!                where appropriate.  
+!!
+!!                NOTE: All branches and stems are harvested.  Basically, this means
+!!                      all aboveground woody biomass.  The fine roots
+!!                      are killed and left to litter.  The sapwood and heartwood
+!!                      belowground is left alive.  The leaves are killed, and the
+!!                      labile and carbres pools are left untouched in the living
+!!                      biomass.
+!!
+!! RECENT CHANGE(S): 
+!!
+!! MAIN OUTPUT VARIABLE(S): ::bm_to_litter, ::harvest_pool
+!!
+!! REFERENCE(S)   :
+!! - Bellassen, V., Le Maire, G., Dhote, J.F., Viovy, N., Ciais, P., 2010. 
+!! Modeling forest management within a global vegetation model â Part 1: 
+!! model structure and general behaviour. Ecological Modelling 221, 2458â2474.
+!!
+!! FLOWCHART    : None
+!!\n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE harvest_aboveground_wood_living_roots (npts, ipts, ivm, &
+       ifm, icut, bm_to_litter, circ_class_n, &
+       circ_class_biomass, circ_class_kill, harvest_pool, &
+       harvest_type, harvest_cut, harvest_area, &
+       harvest_pool_bound, resolution, veget_cov_max)
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+    ! NOTE: if harvest_pool_bound is not explicitely defined 
+    ! the model uses 1:ndia_harvest+2 as its dimensions. If 
+    ! you like to do so remember to change the counters in
+    ! this routine
+    INTEGER(i_std), INTENT(in)                                   :: npts               !! Domain size (-)
+    INTEGER(i_std), INTENT(in)                                   :: ipts               !! current grid square
+    INTEGER(i_std), INTENT(in)                                   :: ivm                !! current PFT
+    INTEGER(i_std), INTENT(in)                                   :: ifm                !! current fm strategy
+    INTEGER(i_std), INTENT(in)                                   :: icut               !! current cut time
+    REAL(r_std), DIMENSION(0:ndia_harvest+1), INTENT(in)         :: harvest_pool_bound !! The boundaries of the diameter classes
+                                                                                       !! in the wood harvest pools
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,2), INTENT(in)                    :: resolution         !! The length of each grid-box in X and Y
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                   :: veget_cov_max          !! Maximum fraction of vegetation type 
+
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+   
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(inout)        :: circ_class_n       !! Number of individuals in each circ class
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), &                         
+                                              INTENT(inout)      :: circ_class_biomass !! Biomass of the components of the model  
+                                                                                       !! tree within a circumference
+                                                                                       !! class @tex $(gC ind^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nfm_types,ncut_times), &
+                                                  INTENT(inout)  :: circ_class_kill    !! Number of trees within a circ that needs
+                                                                                       !! to be killed @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), &
+                                                  INTENT(inout)  :: bm_to_litter       !! Biomass transfer to litter 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)               :: harvest_pool       !! The wood and biomass that have been
+                                                                                       !! havested by humans @tex $(gC)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_type       !! Type of management that resulted
+                                                                                       !! in the harvest (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_cut        !! Type of cutting that was used for the harvest
+                                                                                       !! (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_area       !! Harvested area (m^{2})
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                               :: idia, icir,imbc    !! Indices
+    INTEGER(i_std)                                               :: iele, ipar         !! Indices
+    REAL(r_std), DIMENSION(nelements)                            :: total_nonheart_biomass_harvest
+    REAL(r_std), DIMENSION(nelements)                            :: total_nonheart_biomass_living
+    REAL(r_std), DIMENSION(nelements)                            :: total_nonheart_biomass_kill
+    REAL(r_std), DIMENSION(nelements)                            :: harvest_ratio
+    REAL(r_std), DIMENSION(nelements)                            :: living_ratio
+    REAL(r_std), DIMENSION(nelements)                            :: litter_ratio
+    REAL(r_std), DIMENSION(ncirc)                                :: diameters_temp
+    REAL(r_std), DIMENSION(ncirc)                                :: dead_heartwood_be
+    REAL(r_std), DIMENSION(ncirc)                                :: dead_sapwood_be
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)           :: check_intern       !! Contains the components of the internal
+                                                                                       !! mass balance chech for this routine
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: closure_intern     !! Check closure of internal mass balance
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_start         !! Start pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_end           !! End pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+ 
+    !_ ================================================================================================================================
+
+    IF (printlev.GE.3) WRITE(numout,*) &
+         'Entering harvest_aboveground_wood_living_roots sapiens_kill.f90'
+
+        ! 1.2 Initialize check for mass balance closure
+    IF (err_act.GT.1) THEN
+       
+       check_intern(:,:,:,:) = zero
+       pool_start = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             ! Initial litter and biomass. This routine is called
+             ! within an ipts-LOOP and an ivm-LOOP so we test one 
+             ! pixel and one pft at a time. Store in the first position.
+             DO icir = 1,ncirc
+                pool_start(1,1,iele) = pool_start(1,1,iele) + &
+                     (circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                     circ_class_n(ipts,ivm,icir) * veget_cov_max(ipts,ivm))
+             ENDDO
+             pool_start(1,1,iele) = pool_start(1,1,iele) + &
+                  (bm_to_litter(ipts,ivm,ipar,iele) * veget_cov_max(ipts,ivm))
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by 
+          ! veget_cov_max its units are already in gC pixel-1. Right 
+          ! now the harvest pool is in gC.  We will divide by the
+          ! resolution to make it per pixel. 
+          pool_start(1,1,iele) = pool_start(1,1,iele) + &
+               SUM(harvest_pool(ipts,ivm,:,iele)) / &
+               (resolution(ipts,1) * resolution(ipts,2))
+          
+       ENDDO 
+       
+    ENDIF ! err_act.GT.1
+
+    ! we will need the trunk diameters for all the circ classes in 
+    ! order to figure out which harvest pool to put them in.
+    diameters_temp(:)=wood_to_dia(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm) 
+
+    DO icir=1,ncirc
+
+       ! It's possible that we only kill individuals in certain circ classes.
+       ! In this case, we need to check for each circ class to make sure
+       ! we don't divide by zero.
+       IF(circ_class_kill(ipts,ivm,icir,ifm,icut) .LT. min_stomate) CYCLE
+
+       ! Debug
+       IF(printlev_loc>=4 .AND. ipts == test_grid .AND. ivm == test_pft)THEN
+          WRITE(numout,*) 'Killing trees in '&
+               // 'harvest_aboveground_wood_living_roots'
+          WRITE(numout,*) 'ipts,ivm,icir,ifm,icut: ',ipts,ivm,icir,ifm,icut
+          WRITE(numout,*) 'circ_class_kill: ',&
+               circ_class_kill(ipts,ivm,icir,ifm,icut)
+       ENDIF
+       !-
+
+       !+++CHECK+++
+       ! Ratios are calculated but never used. The ratios are typically used
+       ! to decide how to distribute the labile and reserve pools. is there a 
+       ! good reason we it is not done here?
+
+       ! The decision of what to do with the carboyhydrate reserves and the
+       ! labile carbon pool are tricky.  In turnover, they are not touched
+       ! when leaves/roots/fruits die, which implies that they are stored
+       ! primarily in the above and belowground sapwood (heartwood is dead). 
+       ! However, here a tree does not know thinning is coming, so it cannot
+       ! move this carbon around.  In theory, we should remove part of the
+       ! labile and reserve pools to the different product pools, but
+       ! these pools are very sensitive for the allocation.  Therefore
+       ! we don't touch them, which is equivalent to saying the reserve
+       ! and labile carbon are all found in the roots.
+       total_nonheart_biomass_kill(:)=circ_class_kill(ipts,ivm,icir,ifm,icut)*&
+            (circ_class_biomass(ipts,ivm,icir,isapbelow,:)+&
+            circ_class_biomass(ipts,ivm,icir,iroot,:)+&
+            circ_class_biomass(ipts,ivm,icir,ileaf,:)+&
+            circ_class_biomass(ipts,ivm,icir,ifruit,:)+&
+            circ_class_biomass(ipts,ivm,icir,isapabove,:))
+
+       total_nonheart_biomass_harvest(:)=&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)*&
+            (circ_class_biomass(ipts,ivm,icir,isapabove,:))
+
+       total_nonheart_biomass_living(:)=&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)*&
+            (circ_class_biomass(ipts,ivm,icir,isapbelow,:))
+
+       ! This is now the fraction of the nonheartwood biomass that will 
+       ! go into the harvest pool.  We will use this to partition the 
+       ! carbohydrate reserve and labile pools into litter and harvest.
+       harvest_ratio(:)=total_nonheart_biomass_harvest(:)/&
+            total_nonheart_biomass_kill(:)
+       living_ratio(:)=total_nonheart_biomass_living(:)/&
+            total_nonheart_biomass_kill(:)
+       litter_ratio(:)=un-harvest_ratio(:)-living_ratio(:)
+       IF(litter_ratio(icarbon) .LT. -min_stomate .OR. &
+            litter_ratio(initrogen) .LT. -min_stomate)THEN
+
+          WRITE(numout,*) 'We have a problem with coppicing!'
+          WRITE(numout,*) 'ipts,ivm,icir,ifm,icut ',ipts,ivm,icir,ifm,icut
+          WRITE(numout,*) 'harvest_ratio, living_ratio, litter_ratio ',&
+               harvest_ratio(:), living_ratio(:), litter_ratio(:)
+          CALL ipslerr_p (3,'harvest_aboveground_wood_living_roots', &
+               'litter_ratio is negative.',&
+               'Look into the output file for details.','') 
+       ENDIF
+       !+++++++++++
+
+       ! all of the following biomass becomes litter
+       bm_to_litter(ipts,ivm,iroot,:) = bm_to_litter(ipts,ivm,iroot,:) + &
+            circ_class_biomass(ipts,ivm,icir,iroot,:)*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+       bm_to_litter(ipts,ivm,ileaf,:) = bm_to_litter(ipts,ivm,ileaf,:) + &
+            circ_class_biomass(ipts,ivm,icir,ileaf,:)*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+       bm_to_litter(ipts,ivm,ifruit,:) = bm_to_litter(ipts,ivm,ifruit,:) + &
+            circ_class_biomass(ipts,ivm,icir,ifruit,:)*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+
+       ! We also turn part of the belowground wood into litter. The reason
+       ! for this is that some coppiced forests were not being able to 
+       ! regenerate due to the amount of belowground wood, which kept the 
+       ! trees out of balance for the whole next year.  The leaves grew, 
+       ! but never enough to put wood into the stems, and the leaves died 
+       ! at the end of the year. Then everything started over exactly the 
+       ! same the following years. The biomass stayed constant (the 
+       ! belowground mass was two orders of magnitude larger than any
+       ! leaf mass which grew) and it never died.  Killing part of the 
+       ! belowground mass should allow the tree to allometrically allocate 
+       ! faster. At the same time, it's not entirely unrealistic.  Parts of 
+       ! the roots stay alive during coppicing, but do they all?  Unknown.
+       ! This is probably only an issue for full coppicing, not for short 
+       ! rotation coppices, since those stands are much younger.
+       dead_sapwood_be(:)=circ_class_biomass(ipts,ivm,icir,isapbelow,:)*&
+            coppice_kill_be_wood(ivm)
+       bm_to_litter(ipts,ivm,isapbelow,:) = &
+            bm_to_litter(ipts,ivm,isapbelow,:) + dead_sapwood_be*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+       dead_heartwood_be(:)=circ_class_biomass(ipts,ivm,icir,iheartbelow,:)*&
+            coppice_kill_be_wood(ivm)
+       bm_to_litter(ipts,ivm,iheartbelow,:) = &
+            bm_to_litter(ipts,ivm,iheartbelow,:) + dead_heartwood_be*&
+            circ_class_kill(ipts,ivm,icir,ifm,icut)
+
+       ! now we have the stems.  These are what we want to save, and we are
+       ! going to classify them by PFT type, location, and diameter so that
+       ! we can compare to FAO statistics and do some more interesting
+       ! post-treatment.
+
+       ! UNITS: The units of the biomass pools are per meter squared.
+       ! It seems to make more sense to store the harvest pool in absolute
+       ! units, which means we have to multiple the result by the fraction of
+       ! this grid cell covered by this PFT (veget_cov_max) and the size of the 
+       ! grid cell.  It seems that the fraction of nobio land does not need 
+       ! to be used here, since frac_nobio and veget_cov_max are summed together 
+       ! in slowproc and they must equal one.  This gives
+       ! us the grams of carbon harvest, which is a big number but that's
+       ! why people invented scientific notation.
+
+       dia_loop:DO idia=1,ndia_harvest
+
+          ! Move the harvest to the correct diameter class and
+          ! account for the largest diameter class because
+          ! harvest_pool_bound has only ndia_harvest+1 dimensions
+          IF ( (diameters_temp(icir).LE.harvest_pool_bound(idia)) .OR. &
+               ((diameters_temp(icir).GT.harvest_pool_bound(ndia_harvest)).AND.&
+               (diameters_temp(icir).LT.harvest_pool_bound(ndia_harvest+1))) )&
+               THEN
+
+             ! this is the correct diameter class 
+             harvest_pool(ipts,ivm,idia,:)=&
+                  harvest_pool(ipts,ivm,idia,:)+ &
+                  circ_class_kill(ipts,ivm,icir,ifm,icut)*&
+                  (circ_class_biomass(ipts,ivm,icir,isapabove,:)+&
+                  circ_class_biomass(ipts,ivm,icir,iheartabove,:)) * &
+                  veget_cov_max(ipts,ivm) * &
+                  resolution(ipts,1) * resolution(ipts,2)
+             
+             ! Associated harvest variables
+             harvest_type(ipts,ivm) = ifm
+             harvest_cut(ipts,ivm) = icut
+             harvest_area(ipts,ivm) = veget_cov_max(ipts,ivm) * &
+                  resolution(ipts,1) * resolution(ipts,2)
+
+             ! Debug
+             IF(printlev_loc>=4 .AND. ipts == test_grid .AND. &
+                  ivm == test_pft)THEN
+                WRITE(numout,*) 'harvest_aboveground_living_roots 1 ',&
+                     ipts,ivm,icir
+                WRITE(numout,*) 'harvest_area,harvest_type,harvest_cut: ',&
+                     harvest_area(ipts,ivm),harvest_type(ipts,ivm),&
+                     harvest_cut(ipts,ivm)
+                WRITE(numout,*) 'Woody biomass - C: ',&
+                     circ_class_kill(ipts,ivm,icir,ifm,icut)*&
+                     (circ_class_biomass(ipts,ivm,icir,isapabove,icarbon)+&
+                     circ_class_biomass(ipts,ivm,icir,iheartabove,icarbon))
+                WRITE(numout,*) 'Woody biomass - N: ',&
+                     circ_class_kill(ipts,ivm,icir,ifm,icut)*&
+                     (circ_class_biomass(ipts,ivm,icir,isapabove,initrogen)+&
+                     circ_class_biomass(ipts,ivm,icir,iheartabove,initrogen))
+             ENDIF
+             !-
+
+             EXIT dia_loop
+
+          ENDIF ! diameters_temp(icir) .LE. harvest_pool_bound(idia)
+
+          ! If we are here, it means the diameter of this trunk is larger
+          ! than the upper boundary of our harvest bins.  Considering the
+          ! upper boundary is set to be 99999 meters in constants.f90,
+          ! something has gone wrong!
+          IF (diameters_temp(icir).GE.harvest_pool_bound(ndia_harvest+1)) THEN
+
+             WRITE(numout,*) 'Our tree is too big to fit into the harvest pools.'
+             WRITE(numout,*) 'ipts, ivm, icir: ',ipts, ivm, icir
+             WRITE(numout,*) 'diameters_temp(icir), harvest_pool_bound(idia)',&
+                  diameters_temp(icir),harvest_pool_bound(ndia_harvest+1)
+             CALL ipslerr_p (3,'harvest_aboveground_wood_living_roots', &
+                  'Tree is too big for the harvest pool.',&
+                  'Look into the output file for details.','')
+
+          ENDIF
+
+       ENDDO dia_loop
+
+
+       ! No individuals die here since the roots are still alive
+       ! Remove the dead biomass.  This includes everything except
+       ! the belowground biomass.  
+       circ_class_biomass(ipts,ivm,icir,ileaf,:)=zero
+       circ_class_biomass(ipts,ivm,icir,isapabove,:)=zero
+       circ_class_biomass(ipts,ivm,icir,iheartabove,:)=zero
+       circ_class_biomass(ipts,ivm,icir,iroot,:)=zero
+       circ_class_biomass(ipts,ivm,icir,ifruit,:)=zero
+
+       ! Reduce the root biomass.
+       circ_class_biomass(ipts,ivm,icir,isapbelow,:)=&
+            circ_class_biomass(ipts,ivm,icir,isapbelow,:)*&
+            (un-coppice_kill_be_wood(ivm))
+       circ_class_biomass(ipts,ivm,icir,iheartbelow,:)=&
+            circ_class_biomass(ipts,ivm,icir,iheartbelow,:)*&
+            (un-coppice_kill_be_wood(ivm))
+
+    ENDDO ! loop over circ classes
+
+    !! Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 4.3 Mass balance closure 
+       pool_end(:,:,:) = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             DO icir = 1,ncirc
+                pool_end(1,1,iele) = pool_end(1,1,iele) + &
+                     (circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                     circ_class_n(ipts,ivm,icir) * veget_cov_max(ipts,ivm))
+             ENDDO
+             pool_end(1,1,iele) = pool_end(1,1,iele) + &
+                  (bm_to_litter(ipts,ivm,ipar,iele) * veget_cov_max(ipts,ivm))
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by veget_cov_max
+          ! its units are already in gC pixel-1. Right now the harvest 
+          ! pool is in gC.  We will divide by the resolution to make it 
+          ! per pixel.
+          pool_end(1,1,iele) = pool_end(1,1,iele) + &
+               SUM(harvest_pool(ipts,ivm,:,iele)) / &
+               (resolution(ipts,1) * resolution(ipts,2))
+       ENDDO ! nelements
+   
+       ! 4.3.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(1,1,ipoolchange,iele) = -un * (pool_end(1,1,iele) - &
+               pool_start(1,1,iele)) 
+       ENDDO
+
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) WRITE(numout,*) &
+                  'check_intern, ivm, imbc, iele, ', imbc, &
+                  iele, check_intern(1,1,imbc,iele)
+             !-
+             closure_intern(1,1,iele) = closure_intern(1,1,iele) + &
+                  check_intern(1,1,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 4.3.3 Check mass balance closure
+       CALL check_mass_balance("harvest_aboveground_wood_living_roots", &
+            closure_intern, npts, pool_end, pool_start, veget_cov_max, 'ipts')
+      
+    ENDIF ! err_act.GT.1
+
+    IF (printlev.GE.4) WRITE(numout,*) &
+         'Leaving harvest_aboveground_wood_living_roots'
+
+  END SUBROUTINE harvest_aboveground_wood_living_roots
+
+!! ================================================================================================================================
+!! SUBROUTINE   : second_coppice_cut
+!!
+!>\BRIEF        Simulates cutting a coppice between the first cut and the
+!!              final cut.
+!!
+!! DESCRIPTION  : Moves dead biomass to the litter pool and the harvest pool
+!!                where appropriate.  A few counters are reset.  The leftover
+!!                biomass (the woody root system) is patitioned among enough
+!!                individuals to give the same density as is found in coppice_dens,
+!!                which is the density of stumps left after the first cut.
+!!
+!!                NOTE: All branches and stems are harvested.  Basically, this means
+!!                      all aboveground woody biomass.  The fine roots
+!!                      are killed and left to litter.  The sapwood and heartwood
+!!                      belowground is left alive.  The leaves are killed, and the
+!!                      labile and carbres pools are left untouched in the living
+!!                      biomass.
+!!
+!! RECENT CHANGE(S): 
+!!
+!! MAIN OUTPUT VARIABLE(S): ::bm_to_litter, ::harvest_pool
+!!
+!! REFERENCE(S)   :
+!! - Bellassen, V., Le Maire, G., Dhote, J.F., Viovy, N., Ciais, P., 2010. 
+!! Modeling forest management within a global vegetation model â Part 1: 
+!! model structure and general behaviour. Ecological Modelling 221, 2458â2474.
+!!
+!! FLOWCHART    : None
+!!\n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE second_coppice_cut (npts, ipts, ivm, ifm, &
+       icut, harvest_pool_bound, resolution, veget_cov_max, &
+       circ_class_biomass, circ_class_n, circ_class_kill, &
+       bm_to_litter, harvest_pool, harvest_type, harvest_cut, &
+       harvest_area, circ_class_dist, last_cut, coppice_dens)
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+    ! NOTE: if harvest_pool_bound is not explicitely defined 
+    ! the model uses 1:ndia_harvest+2 as its dimensions. If 
+    ! you like to do so remember to change the counters in
+    ! this routine
+    INTEGER(i_std), INTENT(in)                                   :: npts               !! Domain size (-)
+    INTEGER(i_std), INTENT(in)                                   :: ipts               !! current grid square
+    INTEGER(i_std), INTENT(in)                                   :: ivm                !! current PFT
+    INTEGER(i_std), INTENT(in)                                   :: ifm                !! current fm strategy
+    INTEGER(i_std), INTENT(in)                                   :: icut               !! current cut time
+    REAL(r_std), DIMENSION(0:ndia_harvest+1), INTENT(in)         :: harvest_pool_bound !! The boundaries of the diameter classes
+                                                                                       !! in the wood harvest pools
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,2), INTENT(in)                    :: resolution         !! The length of each grid-box in X and Y
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                   :: veget_cov_max          !! Maximum fraction of vegetation type 
+    REAL(r_std), DIMENSION(ncirc), INTENT(in)                    :: circ_class_dist    !! The probability distribution of trees 
+                                                                                       !! in a circ class in case of a 
+                                                                                       !! redistribution (unitless).
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(in)                  :: coppice_dens       !! The density of a coppice at the first
+                                                                                       !! cutting.
+                                                                                       !! @tex $( 1 / m**2 )$ @endtex 
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables   
+    
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), &                         
+                                              INTENT(inout)      :: circ_class_biomass !! Biomass of the components of the model  
+                                                                                       !! tree within a circumference
+                                                                                       !! class @tex $(gC ind^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(inout)        :: circ_class_n       !! Number of individuals in each circ class
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nfm_types,ncut_times), &
+                                                  INTENT(inout)  :: circ_class_kill    !! Number of trees within a circ that needs
+                                                                                       !! to be killed @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), &
+                                                  INTENT(inout)  :: bm_to_litter       !! Biomass transfer to litter 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)               :: harvest_pool       !! The wood and biomass that have been
+                                                                                       !! havested by humans @tex $(gC)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_type       !! Type of management that resulted
+                                                                                       !! in the harvest (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_cut        !! Type of cutting that was used for the harvest
+                                                                                       !! (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_area       !! Harvested area (m^{2})
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(inout)            :: last_cut           !! Years since last thinning or clearcut (years)
+
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(ncirc,nparts,nelements)               :: circ_class_biomass_new !! Biomass of the components of the model  
+                                                                                       !! tree within a circumference
+                                                                                       !! class @tex $(gC ind^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(ncirc)                                :: circ_class_n_new   !! Number of individuals in each circ class
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                                :: old_trees_left
+    REAL(r_std)                                                  :: trees_needed
+    REAL(r_std)                                                  :: scale_factor
+    INTEGER                                                      :: icir, jcir, imbc
+    INTEGER(i_std)                                               :: iele, ipar         !! Indices
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)           :: check_intern       !! Contains the components of the internal
+                                                                                       !! mass balance chech for this routine
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: closure_intern     !! Check closure of internal mass balance
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_start         !! Start pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_end           !! End pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    !_ ================================================================================================================================
+
+    IF (printlev.GE.3) WRITE(numout,*) &
+         'Entering second_coppice_cut sapiens_kill.f90'
+
+        ! 1.2 Initialize check for mass balance closure
+    IF (err_act.GT.1) THEN
+       
+       check_intern(:,:,:,:) = zero
+       pool_start = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             ! Initial litter and biomass. This routine is called
+             ! within an ipts-LOOP and an ivm-LOOP so we test one 
+             ! pixel and one pft at a time. Store in the first position.
+             DO icir = 1,ncirc
+                pool_start(1,1,iele) = pool_start(1,1,iele) + &
+                     (circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                     circ_class_n(ipts,ivm,icir) * veget_cov_max(ipts,ivm))
+             ENDDO
+             pool_start(1,1,iele) = pool_start(1,1,iele) + &
+                  (bm_to_litter(ipts,ivm,ipar,iele) * veget_cov_max(ipts,ivm))
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by 
+          ! veget_cov_max its units are already in gC pixel-1. Right 
+          ! now the harvest pool is in gC.  We will divide by the
+          ! resolution to make it per pixel. 
+          pool_start(1,1,iele) = pool_start(1,1,iele) + &
+               SUM(harvest_pool(ipts,ivm,:,iele)) / &
+               (resolution(ipts,1) * resolution(ipts,2))
+          
+       ENDDO 
+       
+    ENDIF ! err_act.GT.1
+
+    ! Any stands that need to be coppiced for the second time?
+    IF( SUM(circ_class_kill(ipts,ivm,:,ifm, icut))&
+         .GT. min_stomate ) THEN
+
+       ! Debug
+       IF(printlev_loc>=4)THEN
+          WRITE(numout,*) 'Doing a second coppice cut'
+          WRITE(numout,*) 'ipts,ivm,ifm,icut ',ipts,ivm,ifm,icut
+       ENDIF
+       !-
+
+       ! Again, we harvest all aboveground biomass and leave the roots
+       CALL harvest_aboveground_wood_living_roots(npts, ipts, ivm, &
+            ifm, icut, bm_to_litter, circ_class_n, &
+            circ_class_biomass, circ_class_kill, harvest_pool, &
+            harvest_type, harvest_cut, harvest_area, &
+            harvest_pool_bound, resolution, veget_cov_max)
+
+       ! reset the time since the last cut
+       last_cut(ipts,ivm)=0
+
+       ! We also reset circ_class_kill for this grid square, since
+       ! we clearly don't need to do mortality if we have no more
+       ! aboveground biomass left.
+       circ_class_kill(ipts,ivm,:,:,:)=zero
+
+       ! Now we have a certain number density and a certain amount of
+       ! biomass.  We want to have the same number of trees that we had
+       ! during the first cut, since the stumps from the first part aren't
+       ! going to change (maybe a couple will die, but not a large difference).
+       circ_class_n_new(:)=circ_class_dist(:)*SUM(circ_class_n(ipts,ivm,:))
+       circ_class_biomass_new(:,:,:)=zero
+
+       ! now we populate the new classes
+       old_trees_left(:)=circ_class_n(ipts,ivm,:)
+       DO icir=1,ncirc
+
+          trees_needed=circ_class_n_new(icir)
+          DO jcir=1,ncirc
+
+             IF(trees_needed .LE. zero)EXIT
+
+             IF(old_trees_left(jcir) .GE. trees_needed )THEN
+                ! we can get all the trees we need from this class
+                ! and don't have to continue searching
+                circ_class_biomass_new(icir,:,:)=&
+                     circ_class_biomass_new(icir,:,:)+&
+                     circ_class_biomass(ipts,ivm,jcir,:,:)*trees_needed
+                old_trees_left(jcir)=old_trees_left(jcir)-trees_needed
+                trees_needed = zero
+                EXIT
+             ELSE
+
+                ! the trees in this class are not sufficient, so we
+                ! need to move all of them to the new class.
+                circ_class_biomass_new(icir,:,:)=&
+                     circ_class_biomass_new(icir,:,:)+&
+                     circ_class_biomass(ipts,ivm,jcir,:,:)*&
+                     old_trees_left(jcir)
+                trees_needed = trees_needed -old_trees_left(jcir)
+                old_trees_left(jcir)=zero
+
+             ENDIF ! checking if we have enough trees
+
+          ENDDO ! jcir=1,ncirc
+
+       ENDDO ! icir=1,ncirc
+
+       ! right now, circ_class_biomass_new gives the total biomass
+       ! in each class, but it should only be for a model tree. 
+       ! So let's normalize it.
+       DO icir=1,ncirc
+          circ_class_biomass_new(icir,:,:)=circ_class_biomass_new(icir,:,:)/&
+               circ_class_n_new(icir)
+       ENDDO
+
+       ! now update the variables that pass this information around
+       DO icir=1,ncirc
+          circ_class_biomass(ipts,ivm,icir,:,:)=&
+               circ_class_biomass_new(icir,:,:)
+          circ_class_n(ipts,ivm,icir)=circ_class_n_new(icir)
+       ENDDO
+
+       ! reset the time since the last cut
+       last_cut(ipts,ivm)=0
+
+       ! We also reset circ_class_kill for this grid square, since
+       ! we clearly don't need to do mortality if we have no more
+       ! aboveground biomass left.
+       circ_class_kill(ipts,ivm,:,:,:)=zero
+
+       ! After a first coppicing, we will regrow a certain number
+       ! of shoots per stool.  For a second coppice cut, our starting
+       ! density is exactly the same as the first cut.
+       scale_factor=coppice_dens(ipts,ivm)/SUM(circ_class_n(ipts,ivm,:))*&
+            REAL(shoots_per_stool(ivm),r_std)
+       circ_class_n(ipts,ivm,:)=circ_class_n(ipts,ivm,:)*&
+            scale_factor
+
+       ! in order not to change the total biomass, we need to
+       ! make all our model trees smaller.
+       circ_class_biomass(ipts,ivm,:,:,:)=circ_class_biomass(ipts,ivm,:,:,:)/&
+            scale_factor
+
+    ENDIF ! any individuals to second cut coppice?
+
+    !! Check numerical consistency of this routine
+    IF (err_act.GT.1) THEN
+
+       ! 4.3 Mass balance closure 
+       pool_end(:,:,:) = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             DO icir = 1,ncirc
+                pool_end(1,1,iele) = pool_end(1,1,iele) + &
+                     (circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                     circ_class_n(ipts,ivm,icir) * veget_cov_max(ipts,ivm))
+             ENDDO
+             pool_end(1,1,iele) = pool_end(1,1,iele) + &
+                  (bm_to_litter(ipts,ivm,ipar,iele) * veget_cov_max(ipts,ivm))
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by veget_cov_max
+          ! its units are already in gC pixel-1. Right now the harvest 
+          ! pool is in gC.  We will divide by the resolution to make it 
+          ! per pixel.
+          pool_end(1,1,iele) = pool_end(1,1,iele) + &
+               SUM(harvest_pool(ipts,ivm,:,iele)) / &
+               (resolution(ipts,1) * resolution(ipts,2))
+       ENDDO ! nelements
+   
+       ! 4.3.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(1,1,ipoolchange,iele) = -un * (pool_end(1,1,iele) - &
+               pool_start(1,1,iele)) 
+       ENDDO
+
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) WRITE(numout,*) &
+                  'check_intern, ivm, imbc, iele, ', imbc, &
+                  iele, check_intern(1,1,imbc,iele)
+             !-
+             closure_intern(1,1,iele) = closure_intern(1,1,iele) + &
+                  check_intern(1,1,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 4.3.3 Check mass balance closure
+       CALL check_mass_balance("second_coppice_cut", closure_intern, &
+            npts, pool_end, pool_start, veget_cov_max, 'ipts')
+      
+    ENDIF ! err_act.GT.1
+
+    IF (printlev.GE.4) WRITE(numout,*) &
+         'Leaving second_coppice_cut'
+
+  END SUBROUTINE second_coppice_cut
+
+!! ================================================================================================================================
+!! SUBROUTINE   : first_coppice_cut
+!!
+!>\BRIEF        Transfer dead biomass to litter and wood to harvest pool.
+!!
+!! DESCRIPTION  : This is a total harvest of the aboveground biomass of a
+!!                stand in such a way that the belowground wood continues to
+!!                live.  This results in a sprouting in the following year of
+!!                several shoots per stump.  Biomass is turned to litter, harvested,
+!!                and left alive, depending on the pool.  The number of individuals
+!!                goes up and the size of the model tree goes down.
+!!
+!!                NOTE: All branches and stems are harvested.  Basically, 
+!!                      this means all aboveground woody biomass.  The fine roots
+!!                      are killed and left to litter.  The sapwood and heartwood
+!!                      belowground is left alive.  The leaves are killed, and the
+!!                      labile and carbres pools are left untouched in the living
+!!                      biomass.
+!!
+!! RECENT CHANGE(S): 
+!!
+!! MAIN OUTPUT VARIABLE(S): ::bm_to_litter, ::harvest_pool
+!!
+!! REFERENCE(S)   :
+!!
+!! FLOWCHART    : None
+!!\n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE first_coppice_cut (npts, ipts, ivm, ifm, &
+       icut, harvest_pool_bound, resolution, veget_cov_max, &
+       circ_class_biomass, circ_class_n, circ_class_kill, &
+       bm_to_litter, harvest_pool, harvest_type, harvest_cut, &
+       harvest_area, last_cut)
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+    ! NOTE: if harvest_pool_bound is not explicitely defined 
+    ! the model uses 1:ndia_harvest+2 as its dimensions. If 
+    ! you like to do so remember to change the counters in
+    ! this routine
+    INTEGER(i_std), INTENT(in)                                   :: npts               !! Domain size (-)
+    INTEGER(i_std), INTENT(in)                                   :: ipts               !! current grid square
+    INTEGER(i_std), INTENT(in)                                   :: ivm                !! current PFT
+    INTEGER(i_std), INTENT(in)                                   :: ifm                !! current fm strategy
+    INTEGER(i_std), INTENT(in)                                   :: icut               !! current cut time
+    REAL(r_std), DIMENSION(0:ndia_harvest+1), INTENT(in)         :: harvest_pool_bound !! The boundaries of the diameter classes
+                                                                                       !! in the wood harvest pools
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,2), INTENT(in)                    :: resolution         !! The length of each grid-box in X and Y
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                   :: veget_cov_max          !! Maximum fraction of vegetation type 
+
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables   
+
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), &                         
+                                              INTENT(inout)      :: circ_class_biomass !! Biomass of the components of the model  
+                                                                                       !! tree within a circumference
+                                                                                       !! class @tex $(gC ind^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(inout)        :: circ_class_n       !! Number of individuals in each circ class
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nfm_types,ncut_times), &
+                                                  INTENT(inout)  :: circ_class_kill    !! Number of trees within a circ that needs
+                                                                                       !! to be killed @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), &
+                                                  INTENT(inout)  :: bm_to_litter       !! Biomass transfer to litter 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)               :: harvest_pool       !! The wood and biomass that have been
+                                                                                       !! havested by humans @tex $(gC)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_type       !! Type of management that resulted
+                                                                                       !! in the harvest (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_cut        !! Type of cutting that was used for the harvest
+                                                                                       !! (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_area       !! Harvested area (m^{2})
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(inout)            :: last_cut           !! Years since last thinning or clearcut (years)
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                               :: imbc, iele         !! Indices
+    INTEGER(i_std)                                               :: ipar, icir         !! Indices
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)           :: check_intern       !! Contains the components of the internal
+                                                                                       !! mass balance chech for this routine
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: closure_intern     !! Check closure of internal mass balance
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_start         !! Start pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_end           !! End pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+
+    !_ ================================================================================================================================
+
+    IF (printlev.GE.3) WRITE(numout,*) &
+         'Entering first_coppice_cut sapiens_kill.f90'
+
+    ! 1.2 Initialize check for mass balance closure
+    IF (err_act.GT.1) THEN
+       
+       check_intern(:,:,:,:) = zero
+       pool_start = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             ! Initial litter and biomass. This routine is called
+             ! within an ipts-LOOP and an ivm-LOOP so we test one 
+             ! pixel and one pft at a time. Store in the first position.
+             DO icir = 1,ncirc
+                pool_start(1,1,iele) = pool_start(1,1,iele) + &
+                     (circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                     circ_class_n(ipts,ivm,icir) * veget_cov_max(ipts,ivm))
+             ENDDO
+             pool_start(1,1,iele) = pool_start(1,1,iele) + &
+                  (bm_to_litter(ipts,ivm,ipar,iele) * veget_cov_max(ipts,ivm))
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by 
+          ! veget_cov_max its units are already in gC pixel-1. Right 
+          ! now the harvest pool is in gC.  We will divide by the
+          ! resolution to make it per pixel. 
+          pool_start(1,1,iele) = pool_start(1,1,iele) + &
+               SUM(harvest_pool(ipts,ivm,:,iele)) / &
+               (resolution(ipts,1) * resolution(ipts,2))
+          
+       ENDDO 
+       
+    ENDIF ! err_act.GT.1
+
+    ! What if we coppice for the first cut?
+    IF( SUM(circ_class_kill(ipts,ivm,:,ifm, icut))&
+         .GT. min_stomate ) THEN
+       
+       ! Debug
+       IF(printlev>=4)THEN
+          WRITE(numout,*) 'Doing a first coppice cut'
+          WRITE(numout,*) 'ipts,ivm,ifm,icut ',ipts,ivm,ifm,icut
+       ENDIF
+       !-
+
+       CALL harvest_aboveground_wood_living_roots(npts, ipts, ivm, &
+            ifm, icut, bm_to_litter, circ_class_n, &
+            circ_class_biomass, circ_class_kill, harvest_pool, &
+            harvest_type, harvest_cut, harvest_area, &
+            harvest_pool_bound, resolution, veget_cov_max)
+
+       ! reset the time since the last cut
+       last_cut(ipts,ivm)=0
+
+       ! We also reset circ_class_kill for this grid square, since
+       ! we clearly don't need to do mortality if we have no more
+       ! aboveground biomass left.
+       circ_class_kill(ipts,ivm,:,:,:)=zero
+
+       ! After a first coppicing, we will regrow a certain number
+       ! of shoots per stool.  Therefore, our density starting
+       ! next year will be much higher.
+       circ_class_n(ipts,ivm,:)=circ_class_n(ipts,ivm,:)*&
+            REAL(shoots_per_stool(ivm),r_std)
+
+       ! in order not to change the total biomass, we need to
+       ! make all our model trees smaller.
+       circ_class_biomass(ipts,ivm,:,:,:)=circ_class_biomass(ipts,ivm,:,:,:)/&
+            REAL(shoots_per_stool(ivm),r_std)
+
+    ENDIF ! any trees to first cut coppice?
+
+    !! Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 4.3 Mass balance closure 
+       pool_end(:,:,:) = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             DO icir = 1,ncirc
+                pool_end(1,1,iele) = pool_end(1,1,iele) + &
+                     (circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                     circ_class_n(ipts,ivm,icir) * veget_cov_max(ipts,ivm))
+             ENDDO
+             pool_end(1,1,iele) = pool_end(1,1,iele) + &
+                  (bm_to_litter(ipts,ivm,ipar,iele) * veget_cov_max(ipts,ivm))
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by veget_cov_max
+          ! its units are already in gC pixel-1. Right now the harvest 
+          ! pool is in gC.  We will divide by the resolution to make it 
+          ! per pixel.
+          pool_end(1,1,iele) = pool_end(1,1,iele) + &
+               SUM(harvest_pool(ipts,ivm,:,iele)) / &
+               (resolution(ipts,1) * resolution(ipts,2))
+       ENDDO ! nelements
+   
+       ! 4.3.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(1,1,ipoolchange,iele) = -un * (pool_end(1,1,iele) - &
+               pool_start(1,1,iele)) 
+       ENDDO
+
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) WRITE(numout,*) &
+                  'check_intern, ivm, imbc, iele, ', imbc, &
+                  iele, check_intern(1,1,imbc,iele)
+             !-
+             closure_intern(1,1,iele) = closure_intern(1,1,iele) + &
+                  check_intern(1,1,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 4.3.3 Check mass balance closure
+       CALL check_mass_balance("first_coppice_cut", closure_intern, &
+            npts, pool_end, pool_start, veget_cov_max, 'ipts')
+      
+    ENDIF ! err_act.GT.1
+
+    IF (printlev.GE.4) WRITE(numout,*) &
+         'Leaving first_coppice_cut'
+
+  END SUBROUTINE first_coppice_cut
+
+!! ================================================================================================================================
+!! SUBROUTINE   : clearcut_harvest_aboveground_dead_roots
+!!
+!>\BRIEF        Transfer dead biomass to litter and wood to harvest pool 
+!!              for a whole stand.
+!!
+!! DESCRIPTION  : Moves dead biomass to the litter pool and the harvest pool
+!!                where appropriate, assuming the whole stand is harvested.  Various
+!!                counters are reset.
+!!
+!!                NOTE: If harvest_fraction is 1, all the aboveground biomass is
+!!                      harvested.  If it's 1-branch_ratio, only stems are 
+!!                      harvested.  Belowground wood, roots, fruits, and
+!!                      leaves all become litter.  A portion of aboveground
+!!                      wood is put in the harvest pool.  Reserves and labile
+!!                      carbon are assumed to be distributed evenly across
+!!                      all non-heartwood components.
+!!
+!! RECENT CHANGE(S): 
+!!
+!! MAIN OUTPUT VARIABLE(S): ::bm_to_litter, ::harvest_pool
+!!
+!! REFERENCE(S)   :
+!!
+!! FLOWCHART    : None
+!!\n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE clearcut_harvest_aboveground_dead_roots (npts, ipts, ivm, &
+       ifm, icut, bm_to_litter, &
+       circ_class_biomass, circ_class_kill, circ_class_n, harvest_pool, &
+       harvest_type, harvest_cut, harvest_area, &
+       harvest_pool_bound, resolution, veget_cov_max, last_cut, age_stand, &
+       mai_count, harvest_fraction)
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+    ! NOTE: if harvest_pool_bound is not explicitely defined 
+    ! the model uses 1:ndia_harvest+2 as its dimensions. If 
+    ! you like to do so remember to change the counters in
+    ! this routine
+    INTEGER(i_std), INTENT(in)                                   :: npts               !! Domain size (-)
+    INTEGER(i_std), INTENT(in)                                   :: ipts               !! current grid square
+    INTEGER(i_std), INTENT(in)                                   :: ivm                !! current PFT
+    INTEGER(i_std), INTENT(in)                                   :: ifm                !! current fm strategy
+    INTEGER(i_std), INTENT(in)                                   :: icut               !! current cut time
+    REAL(r_std), DIMENSION(0:ndia_harvest+1), INTENT(in)         :: harvest_pool_bound !! The boundaries of the diameter classes
+                                                                                       !! in the wood harvest pools
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,2), INTENT(in)                    :: resolution         !! The length of each grid-box in X and Y
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                   :: veget_cov_max          !! Maximum fraction of vegetation type 
+    REAL(r_std),INTENT(in)                                       :: harvest_fraction   !! The fraction of the aboveground
+                                                                                       !! biomass that is harvested.  This is
+                                                                                       !! generally 1-branch_ratio if you only
+                                                                                       !! want to harvest the stems, and 1 if
+                                                                                       !! you want to harvest everything.
+
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables   
+   
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), &                         
+                                              INTENT(inout)      :: circ_class_biomass !! Biomass of the components of the model  
+                                                                                       !! tree within a circumference
+                                                                                       !! class @tex $(gC ind^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(inout)        :: circ_class_n       !! Number of individuals in each circ class
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nfm_types,ncut_times), &
+                                                  INTENT(inout)  :: circ_class_kill    !! Number of trees within a circ that needs
+                                                                                       !! to be killed @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), &
+                                                  INTENT(inout)  :: bm_to_litter       !! Biomass transfer to litter 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)               :: harvest_pool       !! The wood and biomass that have been
+                                                                                       !! havested by humans @tex $(gC)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_type       !! Type of management that reulted
+                                                                                       !! in the harvest (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_cut        !! Type of cutting that was used for the harvest
+                                                                                       !! (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                   :: harvest_area       !! Harvested area (m^{2})
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(inout)            :: last_cut           !! Years since last thinning or clearcut (years)
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(inout)            :: age_stand          !! Age of stand (years)
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(inout)            :: mai_count          !! The number of times we've
+                                                                                       !! calculated the volume increment
+                                                                                       !! for a stand
+    !! 0.4 Local variables
+    INTEGER(i_std)                                               :: imbc, iele         !! Indices
+    INTEGER(i_std)                                               :: ipar, icir         !! Indices
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)           :: check_intern       !! Contains the components of the internal
+                                                                                       !! mass balance chech for this routine
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: closure_intern     !! Check closure of internal mass balance
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_start         !! Start pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_end           !! End pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    
+    !_ ================================================================================================================================
+
+    IF (printlev.GE.3) WRITE(numout,*) &
+         'Entering clearcut_harvest_aboveground_dead_roots sapiens_kill.f90'
+
+        ! 1.2 Initialize check for mass balance closure
+    IF (err_act.GT.1) THEN
+       
+       check_intern(:,:,:,:) = zero
+       pool_start = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             ! Initial litter and biomass. This routine is called
+             ! within an ipts-LOOP and an ivm-LOOP so we test one 
+             ! pixel and one pft at a time. Store in the first position.
+             DO icir = 1,ncirc
+                pool_start(1,1,iele) = pool_start(1,1,iele) + &
+                     (circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                     circ_class_n(ipts,ivm,icir) * veget_cov_max(ipts,ivm))
+             ENDDO
+             pool_start(1,1,iele) = pool_start(1,1,iele) + &
+                  (bm_to_litter(ipts,ivm,ipar,iele) * veget_cov_max(ipts,ivm))
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by 
+          ! veget_cov_max its units are already in gC pixel-1. Right 
+          ! now the harvest pool is in gC.  We will divide by the
+          ! resolution to make it per pixel. 
+          pool_start(1,1,iele) = pool_start(1,1,iele) + &
+               SUM(harvest_pool(ipts,ivm,:,iele)) / &
+               (resolution(ipts,1) * resolution(ipts,2))
+          
+       ENDDO 
+       
+    ENDIF ! err_act.GT.1
+
+    IF( SUM(circ_class_kill(ipts,ivm,:,ifm, icut))&
+         .GT. min_stomate ) THEN
+
+       CALL harvest_aboveground_dead_roots(npts, ipts, ivm, &
+            ifm, icut, bm_to_litter, &
+            circ_class_biomass, circ_class_kill, circ_class_n, harvest_pool, &
+            harvest_type, harvest_cut, harvest_area, &
+            harvest_pool_bound, resolution, veget_cov_max, &
+            harvest_fraction)
+
+       ! We have to reset the age of the stand and the time since the
+       ! last human intervention.
+       age_stand(ipts,ivm)=0
+       last_cut(ipts,ivm)=0
+       mai_count(ipts,ivm)=0
+
+       ! We also reset circ_class_kill for this grid square, since
+       ! we clearly don't need to do mortality if we have no more
+       ! trees left.
+       circ_class_kill(ipts,ivm,:,:,:)=zero
+
+    ENDIF
+
+    !! Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 4.3 Mass balance closure 
+       pool_end(:,:,:) = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             DO icir = 1,ncirc
+                pool_end(1,1,iele) = pool_end(1,1,iele) + &
+                     (circ_class_biomass(ipts,ivm,icir,ipar,iele) * &
+                     circ_class_n(ipts,ivm,icir) * veget_cov_max(ipts,ivm))
+             ENDDO
+             pool_end(1,1,iele) = pool_end(1,1,iele) + &
+                  (bm_to_litter(ipts,ivm,ipar,iele) * veget_cov_max(ipts,ivm))
+          ENDDO
+
+          ! The biomass harvest pool shouldn't be multiplied by veget_cov_max
+          ! its units are already in gC pixel-1. Right now the harvest 
+          ! pool is in gC.  We will divide by the resolution to make it 
+          ! per pixel.
+          pool_end(1,1,iele) = pool_end(1,1,iele) + &
+               SUM(harvest_pool(ipts,ivm,:,iele)) / &
+               (resolution(ipts,1) * resolution(ipts,2))
+       ENDDO ! nelements
+   
+       ! 4.3.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(1,1,ipoolchange,iele) = -un * (pool_end(1,1,iele) - &
+               pool_start(1,1,iele)) 
+       ENDDO
+
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) WRITE(numout,*) &
+                  'check_intern, ivm, imbc, iele, ', imbc, &
+                  iele, check_intern(1,1,imbc,iele)
+             !-
+             closure_intern(1,1,iele) = closure_intern(1,1,iele) + &
+                  check_intern(1,1,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 4.3.3 Check mass balance closure
+       CALL check_mass_balance("clearcut_harvest_aboveground_dead_roots", &
+            closure_intern, npts, pool_end, pool_start, veget_cov_max, 'ipts')
+      
+    ENDIF ! err_act.GT.1
+
+    IF (printlev.GE.4) WRITE(numout,*) &
+         'Leaving clearcut_harvest_aboveground_dead_roots'
+
+  END SUBROUTINE clearcut_harvest_aboveground_dead_roots
+
+END MODULE sapiens_kill
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_lcchange.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_lcchange.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_lcchange.f90	(revision 6412)
@@ -0,0 +1,3865 @@
+! =================================================================================================================================
+! MODULE       : sapiens_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: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-DOFOCO/ORCHIDEE/src_stomate/stomate_lcchange.f90 $
+!! $Date: 2013-07-03 10:16:15 +0200 (Wed, 03 Jul 2013) $
+!! $Revision: 1356 $
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE sapiens_lcchange
+
+  ! modules used:
+  
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE stomate_prescribe
+  USE function_library,    ONLY: wood_to_dia, wood_to_ba, &
+                                 check_biomass_sync, check_surface_area, &
+                                 check_mass_balance 
+  
+  IMPLICIT NONE
+  
+  PRIVATE
+  PUBLIC land_cover_change_main, age_class_distr, merge_biomass_pfts
+
+CONTAINS
+
+
+! ================================================================================================================================
+!! SUBROUTINE   : land_cover_change_main
+!!
+!>\BRIEF        Impact of land cover change on carbon stocks
+!!
+!! DESCRIPTION  : This subroutine is activated by setting VEGET_UPDATE to 1Y 
+!! in the sechiba.card file. Subsequently, the impact of land cover change on 
+!! in-situ carbon stocks is computed in this subroutine. Fluxes from products are
+!! now dealt with in a separate subroutine CHECK. The land cover change is read from
+!! driver maps containing the new "maximal" coverage fraction of a PFT (::veget_cov_max). 
+!! On the basis of this difference, the amount of 'new establishment'/'biomass export',
+!! and increase/decrease of each component, are estimated. The soil carbon from the
+!! PFT which experienced a decrease in ::veget_cov_max is pooled and used as the initial
+!! soil carbon for the PFTs that experienced an increase in ::veget_cov_max.\n
+!!
+!! RECENT CHANGE(S) : (1) Age-classes were introduced and (2) product use was moved 
+!! to a separate module
+!!
+!! MAIN OUTPUT VARIABLE(S) :  
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE land_cover_change_main (npts, dt_days, veget_cov_max, veget_cov, &
+       harvest_pool, harvest_type, harvest_cut, harvest_area, &
+       litter, som, lignin_struc, lignin_wood, &
+       PFTpresent, everywhere, when_growthinit, & 
+       leaf_frac, circ_class_n, circ_class_biomass, &
+       atm_to_bm, forest_managed, KF, wstress_season, &
+       wstress_month, plant_status, npp_longterm, &
+       age, lm_lastyearmax, harvest_pool_bound, resolution, &
+       bm_to_litter,turnover_daily, leaf_age, circ_class_dist, &
+       tau_eff_leaf, tau_eff_sap, &
+       tau_eff_root, veget_cov_max_new, age_stand, last_cut, &
+       k_latosa_adapt, losses, light_tran_to_level_season,&
+       EndOfYear, lpft_replant, soil_n_min, bact, species_change_map)
+
+    IMPLICIT NONE
+    
+ !! 0. Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+    ! NOTE: if harvest_pool_bound is not explicitely defined 
+    ! the model uses 1:ndia_harvest+2 as its dimensions. If 
+    ! you like to do so, remember to change the counters in 
+    ! this routine
+    INTEGER, INTENT(in)                              :: npts                   !! Domain size - number of pixels (unitless)
+    INTEGER(i_std), DIMENSION (:,:), INTENT(in)      :: forest_managed         !! forest management flag
+    REAL(r_std), INTENT(in)                          :: dt_days                !! Time step of vegetation dynamics for stomate (days)
+    REAL(r_std), DIMENSION(:), INTENT(in)            :: circ_class_dist        !! The probability distribution of trees in a circ
+                                                                               !! class in case of a redistribution (unitless).
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: veget_cov              !! Fraction of vegetation type including 
+                                                                               !! non-biological fraction (unitless)   
+    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(0:ndia_harvest+1), &
+                                       INTENT(in)    :: harvest_pool_bound     !! The boundaries of the diameter classes
+                                                                               !! in the wood harvest pools @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: tau_eff_root           !! Effective root turnover time that accounts
+                                                                               !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: tau_eff_sap            !! Effective sapwood turnover time that accounts
+                                                                               !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: tau_eff_leaf           !! Effective leaf turnover time that accounts
+                                                                               !! waterstress (days)
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(in)      :: veget_cov_max_new          !! new "maximal" coverage fraction of a PFT on the  
+                                                                               !! ground.  May sum to
+                                                                               !! less than unity if the pixel has
+                                                                               !! nobio area. (unitless, 0-1)
+    CHARACTER(15), INTENT(in)                         :: losses                !! Flag that determines how the losses are 
+                                                                               !! distributed. There are currently two options
+                                                                               !! 'proportional' and 'youngest'
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)          :: lpft_replant          !! Set to true if a PFT has been clearcut
+    INTEGER(i_std), DIMENSION (:,:), INTENT(in)       :: species_change_map    !! A map which gives the PFT number that each PFT
+
+    
+    REAL(r_std), DIMENSION(:,:,:),INTENT(in)          :: light_tran_to_level_season !! Mean seasonal fraction of light transmitted
+    LOGICAL, INTENT(in)                               :: EndOfYear             !! Flag set on the last day of the year used 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: soil_n_min          !!mineral nitrogen in the soil (gN/m**2)  
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: bact                !! denitrifier biomass (gC/m**2)
+                                                                              
+    !! 0.3 Modified variables   
+    
+    LOGICAL, DIMENSION(:,:), INTENT(inout)           :: PFTpresent             !! PFT present (0 or 1)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: plant_status           !! Growth and phenological status of the plant
+                                                                               !! istatus = Phases defined in constantes
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: KF                     !! Scaling factor to convert sapwood mass into leaf 
+                                                                               !! mass (m)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: k_latosa_adapt         !! Leaf to sapwood area adapted for long 
+                                                                               !! term water stress (m)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: veget_cov_max              !! "maximal" coverage fraction of a PFT on the ground
+                                                                               !! May sum to
+                                                                               !! less than unity if the pixel has
+                                                                               !! nobio area. (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: atm_to_bm              !! C and N taken from the atmosphere to get C and N to  
+                                                                               !! create the seedlings @tex (gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: everywhere             !! is the PFT everywhere in the grid box or 
+                                                                               !! very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: when_growthinit        !! how many days ago was the beginning of 
+                                                                               !! the growing season (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: wstress_season         !! Water stress factor, based on hum_rel_daily
+                                                                               !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: wstress_month          !! Water stress factor, based on hum_rel_daily
+                                                                               !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: npp_longterm           !! "long term" net primary productivity
+                                                                               !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: age                    !! mean age (years)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: lm_lastyearmax         !! last year's maximum leaf mass for each PFT 
+                                                                               !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: lignin_struc           !! ratio Lignine/Carbon in structural litter,
+                                                                               !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: lignin_wood            !! ratio Lignine/Carbon in woody litter,
+                                                                               !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: som                  !! carbon pool: active, slow, or passive 
+                                                                               !! @tex ($gC m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: litter                 !! metabolic and structural litter, above and 
+                                                                               !! below ground @tex ($gC m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: circ_class_n           !! Number of individuals in each circ class
+                                                                               !! @tex $(ind m^{-2})$ @endtex   
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: leaf_frac              !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: leaf_age               !! Leaf age (days)
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)   :: bm_to_litter           !! Transfer of biomass to litter 
+                                                                               !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     ::turnover_daily          !! Turnover rates            
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: circ_class_biomass     !! Biomass components of the model tree within a 
+                                                                               !! circumference class @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)   :: harvest_pool           !! The wood and biomass that have been
+                                                                               !! havested by humans @tex $(gC)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: harvest_type           !! Type of management that resulted
+                                                                               !! in the harvest (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: harvest_cut            !! Type of cutting that was used for the harvest
+                                                                               !! (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: harvest_area           !! Harvested area (m^{2})
+    INTEGER(i_std), DIMENSION(:,:), INTENT(inout)    :: age_stand              !! Age of the forest stand (years)  
+    INTEGER(i_std), DIMENSION(:,:), INTENT(inout)    :: last_cut               !! Years since last thinning (years)
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                   :: ipts,ivm, imbc         !! Indices (unitless)
+    INTEGER(i_std)                                   :: igroup,ifm             !! Indices (unitless)
+    INTEGER(i_std)                                   :: idia,icir,ilage        !! Indices (unitless)
+    INTEGER(i_std)                                   :: jcir,ilit,ilev         !! Indices (unitless)
+    INTEGER(i_std)                                   :: ipar,iele,icarb        !! Indices (unitless)
+    INTEGER(i_std)                                   :: ivma,iyoung,jvma       !! Indices (unitless)
+    INTEGER(i_std)                                   :: nagec_temp,ispec       !! Temporary counter
+    LOGICAL                                          :: lsync                  !! returns false if the biomass is not synced
+    REAL(r_std)                                      :: total_losses           !! Sum of losses only in delta_veget_cov (unitless, 0-1)
+    REAL(r_std)                                      :: share_expanded         !! Share of the veget_cov_max of the existing vegetation
+                                                                               !! within a PFT over the total veget_cov_max following 
+                                                                               !! expansion of that PFT (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts)                     :: pixel_area             !! surface area of the pixel @tex ($m^{2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvmap)               :: veget_cov_max_group        !! Total veget_cov_max of all age clases within a PFT group 
+                                                                               !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvmap)               :: veget_cov_max_new_group    !! Total veget_cov_max_new of all age clases within a PFT group 
+                                                                               !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvmap)               :: delta_veget_cov            !! Change in veget_cov_max due to LCC restricted to the
+                                                                               !! PFT groups thus not accounting for the age-classes
+                                                                               !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: loss_gain              !! The same as delta_veget_cov but distributed of all
+                                                                               !! age classes and thus taking the age-classes into 
+                                                                               !! account (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts)                     :: loss_gain_nobio        !! The change in nobio fraction during the LCC.  Right
+                                                                               !! now we only take into account a single nobio type.
+                                                                               !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(nlitt,nlevs,nelements)    :: litter_bank            !! Bank to store the litter that becomes available when
+                                                                               !! part of a PFT is removed @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(ncarb,nelements)          :: soil_bank              !! Bank to store soil carbon that becomes available when
+                                                                               !! part of a PFT is removed  @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nlevs)                    :: struct_ltr_bank        !! Bank to store the lignin in structural litter that 
+                                                                               !! becomes available when part of a PFT is removed 
+                                                                               !! (0-1,unitless)
+    REAL(r_std),DIMENSION(nlevs)                     :: woody_ltr_bank         !! Bank to store the lignin in woody litter that 
+                                                                               !! becomes available when part of a PFT is removed 
+                                                                               !! (0-1,unitless)
+    REAL(r_std),DIMENSION(nvm,nparts,nelements)      :: fresh_litter           !! Pool of fresh litter that is being released during 
+    REAL(r_std),DIMENSION(nvm,nparts,nelements)      :: fresh_som              !! Pool of fresh som that is being released during
+                                                                               !! LCC @tex ($gC m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION(nparts,nelements)          :: fresh_ltr_bank         !! Bank to store all the fresh litter from site
+    REAL(r_std),DIMENSION(nparts,nelements)          :: fresh_som_bank         !! Bank to store all the fresh som from site 
+    REAL(r_std)                                      :: bact_bank              !! Bank to
+    REAL(r_std), DIMENSION(nnspec)                   :: soil_n_min_bank        !! Bank to 
+                                                                               !! clearing during LCC. Weighted value of fresh_litter
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: atm_to_bm_old          !!
+
+                                                                               !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std)                                      :: moi_bank_season        !! bank to store moiavail_growingseason of the cleared
+                                                                               !! PFT's (unitless; 0-1)
+    REAL(r_std)                                      :: moi_bank_month         !! bank to store moiavail_monthly of the cleared
+                                                                               !! PFT's (unitless; 0-1)
+    REAL(r_std)                                      :: trees_needed           !! Number of trees leftthat should be present in a 
+                                                                               !! circumference class when merging the available and 
+                                                                               !! newly established vegetation
+                                                                               !! @tex $(ind m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(ncirc)                    :: diameters_temp         !! Temporary variable to store the diameters of the
+                                                                               !! different diameter classes (m)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements):: new_biomass            !! Temporary variable for biomass 
+                                                                               !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages)       :: new_leaf_frac          !! Temporary variable for leaf_frac (unitless;0-1)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: new_ind                !! Temporary variable for ind @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                    :: est_circ_class_n       !! Temporary variable for circ_class_n of the 
+                                                                               !! established vegetation @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                    :: tmp_circ_class_n       !! Temporary variable for circ_class_n of the 
+                                                                               !! established vegetation @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)           :: new_circ_class_n       !! Temporary variable for circ_class_n of the
+                                                                               !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc,nparts,nelements)   :: est_circ_class_biomass !! Temporary variable for circ_class_biomass of the
+                                                                               !! established vegetation @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc,nparts,nelements)   :: tmp_circ_class_biomass !! Temporary variable for circ_class_biomass of the
+                                                                               !! established vegetation @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements) &
+                                                     :: new_circ_class_biomass !! Temporary variable for circ_class_biomass of the
+                                                                               !! new vegetation @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                    :: est_circ_class_dia     !! Variable to store temporary values for 
+                                                                               !! circ_class (m)
+    REAL(r_std), DIMENSION(ncirc)                    :: tmp_circ_class_dia     !! Variable to store temporary values for 
+                                                                               !! circ_class (m)
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)           :: new_circ               !! Temporary variable for circ (m)
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: new_atm_to_bm          !! Temporary variable for atm_to_bm 
+                                                                               !! @tex (gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                 :: new_age                !! Temporary variable for age (years)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: new_lm_lastyearmax     !! Temporary variable for lm_last_year 
+                                                                               !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                 :: new_everywhere         !! Temporary variable for everywhere (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: dum_when_growthinit    !! Dummy for when_growthinit (days)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: dum_npp_longterm       !! Dummy for npp_long_term
+                                                                               !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements) &
+                                                     :: check_intern           !! Contains the components of the internal
+                                                                               !! mass balance chech for this routine
+                                                                               !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: closure_intern         !! Check closure of internal mass balance
+                                                                               !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: pool_start             !! Start and end pool of this routine 
+                                                                               !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: pool_end               !! Start and end pool of this routine 
+                                                                               !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    LOGICAL, DIMENSION(npts,nvm)                     :: dum_PFTpresent         !! Dummy for PFTpresent (0 or 1)
+    REAL, DIMENSION(npts,nvm)                        :: dum_plant_status       !! Dummy for plant_status
+    REAL(r_std)                                      :: harvest_ratio_stem     !! The fraction of the reserve pools which are
+                                                                               !! located in the stem (unitless, 0-1)
+    REAL(r_std)                                      :: harvest_ratio_branch   !! The fraction of the reserve pools which are
+                                                                               !! located in the branches/roots (unitless, 0-1)
+    REAL(r_std)                                      :: harvest_ratio_litter   !! The fraction of the reserve pools which are
+                                                                               !! moved to the litter (unitless, 0-1)
+    REAL(r_std)                                      :: total_nonheart_biomass !! The total amount of non-heartwood biomass
+                                                                               !! in a model tree
+                                                                               !! @tex $(gC tree^{-1})$ @endtex
+    REAL(r_std)                                      :: total_nonheart_biomass_stem !! The total amount of non-heartwood biomass
+                                                                               !! in a model tree stem
+                                                                               !! @tex $(gC tree^{-1})$ @endtex
+    REAL(r_std)                                      :: total_nonheart_biomass_branch !! The total amount of non-heartwood biomass
+                                                                               !! in a model tree branches/roots
+                                                                               !! @tex $(gC tree^{-1})$ @endtex
+    REAL(r_std)                                      :: temp_sum,temp_total
+    REAL(r_std), DIMENSION(npts)                     :: change_bio             !! The overall change in vegetative fraction for
+                                                                               !! this pixel (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                     :: change_nobio           !! The overall change in non-vegetative fraction for
+                                                                               !! this pixel (0-1, unitless)
+    REAL(r_std), DIMENSION(nlitt,nlevs)              :: litter_weight_expanded !! The fraction of litter on the expanded
+                                                                               !! PFT.
+                                                                               !! @tex $-$ @endtex
+    REAL(r_std), DIMENSION(nlevs)                    :: litter_weight_struc    !! A weighting factor for the structural litter.
+                                                                               !! (unitless)
+    REAL(r_std), DIMENSION(nlevs)                    :: litter_weight_woody    !! A weighting factor for the woody litter.
+                                                                               !! (unitless)
+    LOGICAL                                          :: lconverged             !! A flag for loop convergence
+    INTEGER(i_std)                                   :: max_pft                !! The number of the PFT with the largest addition
+                                                                               !! in land area.
+    INTEGER(i_std)                                   :: min_pft                !! The number of the PFT with the largest reduction
+                                                                               !! in land area (most negative value).
+    INTEGER(i_std)                                   :: nsteps                 !! The number of convergence steps tried.
+    INTEGER(i_std)                                   :: ncount                 !! The number of PFTs with significant changes
+                                                                               !! in vegetation.
+    INTEGER(i_std)                                   :: nagec_local            !! The number of age classes in this map PFT.
+    REAL(r_std)                                      :: difference             !! How much leftover veget_cov_max we have
+    REAL(r_std)                                      :: temp_sum_old           !! 
+    REAL(r_std)                                      :: temp_sum_new           !! 
+    REAL(r_std), DIMENSION(npts,nvm)                 :: veget_cov_max_new_adj      !! new "maximal" coverage fraction of a PFT on the  
+                                                                               !! ground adjusted for numerical precision.  
+                                                                               !! May sum to
+                                                                               !! less than unity if the pixel has
+                                                                               !! nobio area. (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: veget_cov_max_begin    !! Temporary variable to check area conservation 
+    REAL(r_std), DIMENSION(npts,nvm,ndia_harvest+1,nelements) &
+                                                     :: harvest_pool_old       !! Temporary variable to check mass conservation 
+  
+    !+++ TEMP++++
+    REAL(r_std), DIMENSION(npts,nnobio)              :: frac_nobio_start,frac_nobio_end
+    REAL(r_std)                                      :: min_delta_veget_cov
+    REAL(r_std), DIMENSION(nelements,2)              :: test_mass              !! Temporary variable to check mass conservation 
+    REAL(r_std), DIMENSION(nelements)                :: test_mass_bank         !! Temporary variable to check mass conservation
+    REAL(r_std), DIMENSION(3,nelements,2)            :: test_bank              !! Temporary variable to check mass conservation
+!_ ================================================================================================================================
+
+    IF (printlev.GE.3) WRITE(numout,*) 'Entering land cover change main'
+
+    !  +++COMMENT+++
+    !  This part is poorly coded as it uses the externalisation to
+    !  implement the age classes. The advanatage of this approach is
+    !  that is rather simple to implement. The alternative requires
+    !  that a dimension for age classes is added to almost all fluxes
+    !  and pool in sechiba and stomate. Also the externalisation would
+    !  need to be adjusted as the parameters are now used for the
+    !  different age classes.
+    !
+    !  The coding is considered poor because it is : (1) sensitive to 
+    !  the order in which the PFTs are defined and (2) inconsistent as
+    !  cohorts (within a stand got an own dimension) and age classes
+    !  (across stands) are implemented through the externalisation.
+    !  An example for 2 age classes and 8 tree PFTs
+    !  PFT_1: bare soil
+    !  PFT_2: PFT2_1 age class 1 (youngest)
+    !  PFT_3: PFT2_2 age class 2 (youngest + 1)
+    !  PFT_4: PFT3_1 age class 1
+    !  PFT_5: PFT3_2 age class 2
+    !  ...
+    !  PFT_18: PFT 10 agricultural PFTs don't have age classes
+    !  PFT_19: PFT 11 agricultural PFTs don't have age classes
+    !  PFT_20: PFT 11 agricultural PFTs don't have age classes
+    !  PFT_21: PFT 11 agricultural PFTs don't have age classes
+    !  
+    !  A PFT group are all age classes a a certain PFT/species
+    !
+    !  Some of this complexity could be avoided by preparing the maps
+    !  for the exact number of age classes we want to deal with
+    !  but that just shifts the complexity. It also means that we have
+    !  to prescribe the age classes, which is not our goal. 
+    !  For now it is assumed the maps only consider the PFTs without 
+    !  age classes. So part of this code needs to conver the maps
+    !  without age classes into variables in ORCHIDEE with age classes.
+    !  +++++++++++
+
+ !! 1. initial checks
+
+    !! 1.1 Initialize local printlev
+    !printlev_loc=get_printlev('land_cover')
+
+    ! Check for problematic situations in which the frac_nobio
+    ! in a pixel is larger than the pixel itself.
+    frac_nobio_start(:,:) = zero
+    frac_nobio_end(:,:) = zero
+
+    DO ipts=1,npts
+
+       frac_nobio_start(ipts,1)=un-SUM(veget_cov_max(ipts,:))
+
+       IF(frac_nobio_start(ipts,1) .GT. un)THEN
+
+          WRITE(numout,*) 'ERROR: nobio fraction greater than one in LCC!'
+          WRITE(numout,*) 'ipts, frac_nobio_start(ipts,1): ',ipts, &
+               frac_nobio_start(ipts,1)
+          DO ivm=1,nvm
+             WRITE(numout,*) ivm,veget_cov_max(ipts,ivm)
+          ENDDO
+          CALL ipslerr (3,'land_cover_change_main', &
+               'nobio fraction greater than one',&
+               'Check the PFT maps you are using!','')
+
+       ENDIF
+
+    ENDDO
+    
+    ! Sometimes maps are read-in which are created in single
+    ! precision.  Values in the code may be double precision,
+    ! however.  min_stomate is usually set to 1e-8, which is
+    ! similar to single precision.  Depending on the maps
+    ! used, this can frequently cause mass balance errors
+    ! on the order of 1e-5 to 1e-8 as the old veget_cov_max
+    ! and the new veget_cov_max sum to a value just less
+    ! than min_stomate, which when multiplied by the pools
+    ! used gives a value greater than min_stomate of carbon
+    ! which is considered lost.  This first loop corrects for
+    ! that and closes the mass balance.
+    DO ipts=1,npts
+       temp_sum_new=zero
+       temp_sum_old=zero
+       DO ivm=1,nvm
+          temp_sum_new=temp_sum_new+veget_cov_max_new(ipts,ivm)
+          temp_sum_old=temp_sum_old+veget_cov_max(ipts,ivm)
+       ENDDO
+
+       ! Debug
+       IF(printlev_loc>=4 .AND. ipts == test_grid)THEN
+          WRITE(numout,*) 'temp_sum_old: ',temp_sum_old
+          WRITE(numout,*) 'temp_sum_new: ',temp_sum_new
+       ENDIF
+       !-
+
+       difference=ABS(temp_sum_old-temp_sum_new)
+       ! If the difference is too big, there is a significant difference
+       ! in the nobio fraction, which has to be specially taken
+       ! care of.  We let a check below deal with that. This code only
+       ! deals with the single/double precision issue
+       IF(difference .NE. zero .AND. difference .LT. min_stomate)THEN          
+          ! Rescale veget_cov_max such that the veget_cov_max is now stored in
+          ! double precision
+          DO ivm=1,nvm
+             veget_cov_max_new_adj(ipts,ivm)=veget_cov_max_new(ipts,ivm)*&
+                  temp_sum_old/temp_sum_new
+          ENDDO
+       ! Nothing to change.   
+       ELSE        
+          DO ivm=1,nvm
+             veget_cov_max_new_adj(ipts,ivm)=veget_cov_max_new(ipts,ivm)
+          ENDDO
+       ENDIF
+    ENDDO
+       
+ !! 2. Initialization
+    
+    !! 2.1 Initialize variables
+    delta_veget_cov(:,:) = zero 
+    loss_gain(:,:) = zero
+    veget_cov_max_group(:,:) = zero
+    veget_cov_max_new_group(:,:) = zero
+
+    ! Surface area (m2) of the pixel
+    pixel_area(:) = resolution(:,1) * resolution(:,2)
+
+    !! 2.2 Initialize check for mass balance closure
+    IF (err_act.GT.1) THEN
+
+       check_intern(:,:,:,:) = zero
+       pool_start(:,:,:) = zero
+       DO iele = 1,nelements
+
+          ! Biomass pool + bm_to_litter
+          DO ipar = 1,nparts
+            DO icir=1, ncirc
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                    circ_class_biomass(:,:,icir,ipar,iele) * &
+                    circ_class_n(:,:,icir) * veget_cov_max(:,:)
+            ENDDO
+            pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                (bm_to_litter(:,:,ipar,iele) + turnover_daily(:,:,ipar,iele)) * &
+                veget_cov_max(:,:)
+          ENDDO
+
+          ! Litter pool (gC m-2) *  (m2 m-2) 
+          DO ilit = 1,nlitt
+             DO ilev = 1,nlevs
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                     litter(:,ilit,:,ilev,iele) * veget_cov_max(:,:)
+             ENDDO
+          ENDDO
+
+          ! Soil carbon (gC m-2) *  (m2 m-2)
+          DO icarb = 1,ncarb
+             pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                  som(:,icarb,:,iele) * veget_cov_max(:,:)
+          ENDDO
+
+          ! The biomass harvest pool is expressed in gC pixel-1 So, it 
+          ! shouldn't be multiplied by veget_cov_max but it should be divided
+          ! by pixel_area to obtain gC m-2.
+          DO ipts = 1,npts
+             pool_start(ipts,:,iele) = pool_start(ipts,:,iele) + &
+                  SUM(harvest_pool(ipts,:,:,iele),2) / &
+                  pixel_area(ipts)
+          ENDDO
+
+       ENDDO
+
+       !Denitrifying bacteria (only C)
+       pool_start(:,:,icarbon) = pool_start(:,:,icarbon) + &
+               bact(:,:) * veget_cov_max(:,:)
+
+       !Nitrogen only
+       DO ispec = 1,nnspec
+          pool_start(:,:,initrogen) = pool_start(:,:,initrogen) + &
+                  soil_n_min(:,:,ispec) * veget_cov_max(:,:)
+       ENDDO
+  
+       ! Initialize area check and intermediate mass balance checks
+       veget_cov_max_begin(:,:) = veget_cov_max(:,:)
+       atm_to_bm_old(:,:,:) = atm_to_bm(:,:,:)
+       pool_end(:,:,:) = zero
+
+    ENDIF ! ld_stop .OR. ld_warn
+    
+
+!! 3. Calculate common variables 
+ 
+    !  Remember that when age classes are being used the maps have
+    !  fewer PFTs (::nvmap) than the simulation (::nvm). For several 
+    !  calculations the total cover of all age class within its group 
+    !  (::veget_cov_max_group) is required.  We also need the vegetation 
+    !  fraction of the PFT map arranged into groups.  Notice that this 
+    !  number is already given in terms of groups, but it is stored 
+    !  on a grid using all nvm pfts, i.e. only nvmap values of
+    !  veget_cov_max_new(ipts,:) are non-zero.
+    DO ipts = 1,npts
+       DO ivm=1,nvm
+          igroup=agec_group(ivm)
+          veget_cov_max_group(ipts,igroup) = veget_cov_max_group(ipts,igroup) + &
+                        veget_cov_max(ipts,ivm)
+          veget_cov_max_new_group(ipts,igroup) = veget_cov_max_new_group(ipts,igroup) + &
+                        veget_cov_max_new_adj(ipts,ivm)
+       ENDDO ! loop over PFTs
+    ENDDO ! loop over #pixels - domain size
+
+    ! Debug
+    IF (printlev_loc>=4) THEN
+       DO ipts=1,npts
+          IF(ipts == test_grid)THEN
+             WRITE(numout,*) 'Finished computing veget_cov_max_group.'
+             CALL print_lcc_error_message(npts,ipts,veget_cov_max_new_adj,&
+                  veget_cov_max,veget_cov_max_new_group,&
+                  veget_cov_max_group,delta_veget_cov,loss_gain,1)
+             CALL print_lcc_error_message(npts,ipts,veget_cov_max_new_adj,&
+                  veget_cov_max,veget_cov_max_new_group,&
+                  veget_cov_max_group,delta_veget_cov,loss_gain,2)
+             CALL print_lcc_error_message(npts,ipts,veget_cov_max_new_adj,&
+                  veget_cov_max,veget_cov_max_new_group,&
+                  veget_cov_max_group,delta_veget_cov,loss_gain,5)
+          ENDIF
+       ENDDO
+    ENDIF
+    !-
+
+
+ !! 4. Check consistency of the LCC maps
+
+    ! Within each pixel the fraction of losses should equal the fraction 
+    ! of gains. The soil carbon avaible from the losses is averaged and 
+    ! used as the initial soil carbon for the gains. This assumption is 
+    ! acceptable when the fraction of none biological land uses remains 
+    ! constant. If this fraction is changing i.e. following glacier 
+    ! retreat, the current approach will need to be checked and most 
+    ! likely adjusted. The same applies in case vegetation is removed 
+    ! for urban sprawing. This routine will need to decide whether the 
+    ! soil carbon is simply buried under the hard surfaces or whether it 
+    ! decomposes?
+
+    !! 4.1 Calculate the change in vegetation cover
+    delta_veget_cov(:,:) =  veget_cov_max_new_group(:,:) - veget_cov_max_group(:,:)
+    ! Debug  
+    IF (printlev_loc>=4) THEN
+       DO ipts=1,npts
+          IF(ipts == test_grid)THEN
+             WRITE(numout,*) 'Change in vegetation cover - before QC, ', &
+                  SUM(delta_veget_cov(test_grid,:))
+             WRITE(numout,*) 'Before normalization of delta_veget_cov'
+             CALL print_lcc_error_message(npts,test_grid,veget_cov_max_new_adj,&
+                  veget_cov_max,veget_cov_max_new_group,&
+                  veget_cov_max_group,delta_veget_cov,loss_gain,3)
+          ENDIF
+       ENDDO
+    ENDIF
+    !-
+
+    !! 4.2 Adjust all changes to be within bounds
+    
+    ! Read just the change in vegetation cover for the PFTs so that
+    ! no change is less than min_vegfrac and that no change leads
+    ! to PFTs values which are too high or too low.
+    CALL adjust_delta_veget_cov(npts, veget_cov_max, veget_cov_max_group,&
+         veget_cov_max_new_adj, veget_cov_max_new_group, loss_gain,&
+         delta_veget_cov, losses)
+
+    !Debug
+    IF (printlev_loc>=4) THEN
+       DO ipts=1,npts
+          IF(ipts == test_grid)THEN
+             WRITE(numout,*) 'After normalization of delta_veget_cov and loss_gain'
+             CALL print_lcc_error_message(npts,test_grid,veget_cov_max_new_adj,&
+                  veget_cov_max,veget_cov_max_new_group,&
+                  veget_cov_max_group,delta_veget_cov,loss_gain,3)
+             CALL print_lcc_error_message(npts,test_grid,veget_cov_max_new_adj,&
+                  veget_cov_max,veget_cov_max_new_group,&
+                  veget_cov_max_group,delta_veget_cov,loss_gain,4)
+          ENDIF
+       ENDDO
+    ENDIF
+
+    ! Check whether gains equal losses. If not, it is unlikely that the C-balance
+    ! will be closed.
+    DO ipts = 1,npts
+
+       ! Changes in the vegetation classes (including bare soil)
+       change_bio(ipts) = SUM(delta_veget_cov(ipts,:))
+
+       ! The nobio fractions are the leftover fractions when all the vegetation
+       ! fractions are summed up.
+       change_nobio(ipts)=(un-SUM(veget_cov_max_new_group(ipts,:)))-&
+            (un-SUM(veget_cov_max_group(ipts,:)))
+
+       IF ( ABS(change_bio(ipts)+change_nobio(ipts)) .GE. min_stomate) THEN
+
+          ! Losses and gains don't cancel each other out
+          WRITE(numout,*) "Error: LCC losses and gains don't cancel each &
+               & other out in pixel, ",ipts             
+          WRITE(numout,*) 'species change-veget_cov_max, veget_cov_max_new_group,'
+          DO ivm = 1,nvm
+             WRITE(numout,*) veget_cov_max(ipts,ivm), &
+                  veget_cov_max_new_group(ipts,ivm)
+          ENDDO
+          WRITE(numout,*) 'Mismatch: ',change_bio(ipts)+change_nobio(ipts)
+          WRITE(numout,*) 'change_bio: ',change_bio(ipts)
+          WRITE(numout,*) 'change_nobio: ',change_nobio(ipts)
+          WRITE(numout,*) 'sum of delta_veget_cov: ',SUM(delta_veget_cov(ipts,:))
+          WRITE(numout,*) 'sum of veget_cov_max_new_group: ', &
+               SUM(veget_cov_max_new_group(ipts,:))
+          WRITE(numout,*) 'sum of veget_cov_max_new_adj: ',&
+               SUM(veget_cov_max_new_adj(ipts,:))
+          WRITE(numout,*) 'sum of veget_cov_max_group: ',&
+               SUM(veget_cov_max_group(ipts,:))
+          CALL ipslerr (2,'land_cover_main', &
+               'Losses and gains do not cancel in land_cover_change.',&
+               'Look for Error in out_orchidee file for details','')
+
+       ELSE
+
+          ! Losses and gains cancel each other out
+          ! Debug
+          IF (printlev_loc>=4) THEN
+             WRITE(numout,*) "LCC losses and gains cancel each other out ", ipts
+             WRITE(numout,*) 'OK: ',change_bio(ipts),change_nobio(ipts)
+          ENDIF
+          !-
+
+       ENDIF
+
+       ! All this accounting does not change the fact that we are only
+       ! confident if there are no changes in the nobio fraction or if the
+       ! changes or so small that they can be considered as a nummerical
+       ! issue. If this is not the case, print a warning, since someone 
+       ! should think this through more clearly.  This check should
+       ! be taken care of already in slowproc_update.
+       IF(ABS(change_nobio(ipts)) .GT. min_vegfrac)THEN
+
+          WRITE(numout,*) 'LCC1 WARNING: Large change in nobio fraction in LCC!'
+          WRITE(numout,*) 'ipts: ',ipts
+          WRITE(numout,*) 'change_nobio: ',change_nobio(ipts)
+          WRITE(numout,*) 'ivm veget_cov_max_new_adj veget_cov_max'
+          DO ivm=1,nvm
+             WRITE(numout,'(I7,2F12.8)') ivm,veget_cov_max_new_adj(ipts,ivm),&
+                  veget_cov_max(ipts,ivm)
+          ENDDO
+          CALL ipslerr (2,'land_cover_main', 'Large change in nobio fraction',&
+               'Look for LCC1 WARNING in out_orchidee file for details','')
+       ENDIF
+
+    ENDDO ! npts
+
+    ! Debug
+    IF (printlev_loc>=4) THEN
+       WRITE(numout,*) 'veget_cov_max, veget_cov_max_new_adj, ',test_grid
+       DO ipts = 1,npts
+          DO ivm = 1,nvm
+             WRITE(numout,*) ivm, veget_cov_max(test_grid,ivm), &
+                  veget_cov_max_new_adj(test_grid,ivm)
+          ENDDO
+          WRITE(numout,*) 'SUM, ',SUM(veget_cov_max(test_grid,:)),&
+               SUM(veget_cov_max_new_adj(test_grid,:))
+          WRITE(numout,*) 'END of LCC'
+          WRITE(numout,*) 'no frac bio veget_cov, ', &
+               un-SUM(veget_cov_max(test_grid,:))
+          WRITE(numout,*) 'no frac bio veget_cov_max_new, ',&
+               un-SUM(veget_cov_max_new(test_grid,:))
+          WRITE(numout,*) 'no frac bio veget_cov_max_new_adj, ',&
+               un-SUM(veget_cov_max_new_adj(test_grid,:))
+       ENDDO
+    ENDIF 
+    !-
+
+
+ !! 5. Calculate in-situ land cover changes
+
+    !  NOTE: within the model framework there is large conceptual
+    !  difference between management and clear cuts on the one
+    !  hand and LCC on the other hand. Within the model LCC
+    !  DOES NOT change the biomass, ind, ... of the PFTs that
+    !  experience a loss (because we store those in gC m-2). LCC 
+    !  only changes the values of veget_cov_max for those PFTs. For
+    !  this reason it was decided not to make use of lpj_kill.f90
+    !  and sapiens_gap.f90 (as is done for forest management) 
+    !  because this would be in conflict with the meaning of the 
+    !  variable ::circ_class_kill. It is not impossible to work 
+    !  around this issues but it could result in difficulties with
+    !  the order of code in more complex cases were part of the PFT 
+    !  experiences a surface loss and at the same time is ready to
+    !  get thinned or clear cut. It appears cleaner to deal with
+    !  LCC up front in a self-contained module.
+
+    !! 5.1 Land cover losses within a pixel
+    !  The losses need to be calculated first such that the soil
+    !  carbon (and other elements) can be put in the soil&litter-bank. 
+    !  Subsequently, the soil&litter-bank is used to initialize the 
+    !  soil carbon of the new PFTs. The biomass is moved into a 
+    !  harvest pool.
+    !  NOTE: make sure that all variables for PFT1 are initialized!
+    !  If not LCC won't properly work.
+    DO ipts = 1, npts ! Loop over # pixels - domain size    
+
+       !! 5.1.1 Initialize the soil&litter-bank
+       !  NOTE Some of these variables have a dimension for ::nelements
+       !  others don't. Make sure ::nelements is accounted for when 
+       !  N is added to the model.
+       soil_bank(:,:) = zero
+       litter_bank(:,:,:) = zero
+       struct_ltr_bank(:) = zero
+       woody_ltr_bank(:) = zero
+       fresh_ltr_bank(:,:) = zero
+       fresh_som_bank(:,:) = zero
+       moi_bank_season = zero
+       moi_bank_month = zero
+       bact_bank = zero
+       soil_n_min_bank(:) = zero
+       fresh_litter(:,:,:) = bm_to_litter(ipts,:,:,:)
+       fresh_som(:,:,:) = turnover_daily(ipts,:,:,:)
+
+       !! 5.5.2 Initialize debugging
+       IF (printlev_loc>=4) THEN
+          harvest_pool_old(ipts,:,:,:) = harvest_pool(ipts,:,:,:)
+          test_mass(:,:) = zero
+
+          ! Litter, som, bact and soil_n_min may get moved from one PFT
+          ! but the pools are never mixed with other pools. If there is
+          ! a mass balance problem, these pools can be easily checked 
+          ! for mass conservation. This check which is only useful during
+          ! debugging, is initialized here.
+          DO iele = 1,nelements
+             test_bank(1,iele,istart) = SUM(SUM(SUM(litter(ipts,:,:,:,iele),3),1) * &
+                  veget_cov_max(ipts,:))
+             test_bank(2,iele,istart) = SUM(SUM(som(ipts,:,:,iele),1) * &
+                  veget_cov_max(ipts,:))
+          ENDDO
+          test_bank(3,icarbon,istart) = SUM(bact(ipts,:) * veget_cov_max(ipts,:))
+          test_bank(3,initrogen,istart) = SUM(SUM(soil_n_min(ipts,:,:),2) * &
+               veget_cov_max(ipts,:))
+       ENDIF
+       
+       !! 5.1.3 Loss in PFT cover, update harvest and soil&litter-C-bank
+       !  To calculate the relative change in cover fraction, PFT-specific 
+       !  changes need to be normalized by the total change which is in 
+       !  this case the total loss. Total losses includes losses in PFT1
+       
+       !+++CHECK+++
+       ! the change in no_frac_bio could/should also be added in this 
+       ! calculation. What happens to the carbon if a PFT is converted
+       ! into a no_bio land use? There is already a ::c_buried variable
+       ! but it is not used.
+       total_losses = SUM(loss_gain(ipts,:), MASK = loss_gain(ipts,:) .LT. zero)
+       !+++++++++++
+       
+       ! Calculate the factor to weight the lignin ratios by when merging.
+       ! This depends on the amount of litter on the PFTs where vegetation
+       ! is being cut.
+       litter_weight_struc(:)=zero
+       litter_weight_woody(:)=zero
+       DO ivm = 1, nvm
+          IF ( loss_gain(ipts,ivm) .LE. -min_stomate ) THEN
+             DO ilev=1,nlevs
+                litter_weight_struc(ilev)=litter_weight_struc(ilev)+&
+                     litter(ipts,istructural,ivm,ilev,icarbon) * &
+                     ABS(loss_gain(ipts,ivm))
+                litter_weight_woody(ilev)=litter_weight_woody(ilev)+&
+                     litter(ipts,iwoody,ivm,ilev,icarbon) * &
+                     ABS(loss_gain(ipts,ivm))
+             ENDDO
+          ENDIF
+       ENDDO
+       
+       DO ivm = 1, nvm
+
+          ! Initialize intermediate mass balance check
+          test_mass_bank(:) = zero
+
+          ! The PFT cover decreases, move wood into the harvest pool, the 
+          ! stumps and branches are supposed to be exported from the site 
+          ! so they go into the harvest pool as well but a separated pool
+          ! was introduced for separate treatment in the product use module
+          ! Leaves, fine roots and fruits are deposited on the soil&litter
+          ! bank and will be attributed to the new PFT. This order of 
+          ! calculations ensures that the litter ends up in the right PFT
+          ! and that it is only decomposed once.         
+          IF ( loss_gain(ipts,ivm) .LE. -min_stomate ) THEN
+             
+             !! 5.1.2.1 Biomass losses of trees
+             IF (is_tree(ivm)) THEN
+                
+                ! We will need the trunk diameters for all the circ classes in 
+                ! order to figure out which harvest pool to put them in.
+                diameters_temp(:) = &
+                     wood_to_dia(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+
+                ! Store the management stategy of the pixel and PFT
+                ifm = forest_managed(ipts,ivm)                
+
+                ! Now we have the stems diameters.  These are what we want to
+                ! save, and we are going to classify them by PFT type, location, 
+                ! and diameter so that we can compare to FAO statistics and do 
+                ! some more interesting post-treatment (sapiens_product_use.f90).
+                DO icir = 1,ncirc
+                   DO iele = 1,nelements
+                    ! We want to make sure we divide up the labile and carbohydrate
+                    ! reserve pools in the same was as in other management.  We
+                    ! assume that when a tree is cut down, it cannot rearrange 
+                    ! these pools, and therefore the amount that is harvested
+                    !  is the ratio that is stored in the harvest wood.  We assume
+                    ! that the reserve pools are stored equally in all non-heart
+                    ! tissue.  The harvest right now goes into three different
+                    ! places: two harvest pools and litter.  We need the fractions
+                    !  for the reserve pools going into each place.
+                    total_nonheart_biomass = &
+                        circ_class_biomass(ipts,ivm,icir,isapbelow,iele)+&
+                        circ_class_biomass(ipts,ivm,icir,iroot,iele)+&
+                        circ_class_biomass(ipts,ivm,icir,ileaf,iele)+&
+                        circ_class_biomass(ipts,ivm,icir,ifruit,iele)+&
+                        circ_class_biomass(ipts,ivm,icir,isapabove,iele)
+                    ! This includes the roots and the branches, since it goes into
+                    ! a different pool.
+                    total_nonheart_biomass_branch=branch_ratio(ivm)*&
+                        circ_class_biomass(ipts,ivm,icir,isapabove,iele)+&
+                        circ_class_biomass(ipts,ivm,icir,isapbelow,iele)
+                    total_nonheart_biomass_stem=(un-branch_ratio(ivm))*&
+                        circ_class_biomass(ipts,ivm,icir,isapabove,iele)
+
+                    ! These are the three ratios we need to move the reserve 
+                    ! pools around. When dealing with standard land cover change 
+                    ! the harvest_ratios are always defined. However, when 
+                    ! dealing with a species change we try to harvest an empty 
+                    ! age class, hence, the code to capture the undefined case. 
+                    ! Why is the age class empty. Well in forestry we just 
+                    ! harvested an older age class, in kill we replace that 
+                    ! older age class by a younger age class but here we harvest 
+                    ! it again before it was ever replanted.
+                    IF (total_nonheart_biomass .GT. min_stomate) THEN
+                      harvest_ratio_branch=total_nonheart_biomass_branch/&
+                           total_nonheart_biomass
+                      harvest_ratio_stem=total_nonheart_biomass_stem/&
+                           total_nonheart_biomass
+                      harvest_ratio_litter=un - harvest_ratio_stem - &
+                           harvest_ratio_branch
+                    ELSE
+                      harvest_ratio_branch=zero
+                      harvest_ratio_stem=zero
+                      harvest_ratio_litter=un - harvest_ratio_stem - &
+                           harvest_ratio_branch 
+                    END IF
+
+                    dia_loop:DO idia=1,ndia_harvest
+
+                      ! Move the harvest to the correct diameter class and
+                      ! account for the largest diameter class because
+                      ! harvest_pool_bound has only ndia_harvest+1 dimensions
+                      IF ( (diameters_temp(icir).LE.harvest_pool_bound(idia)).OR. &
+                         ((diameters_temp(icir).GT.harvest_pool_bound(ndia_harvest)) .AND. &
+                         (diameters_temp(icir).LT.harvest_pool_bound(ndia_harvest+1))) ) THEN
+
+                         ! This is the correct diameter class
+                         ! Move wood (excluding the branches) and the carbres 
+                         ! and labile C contained in the wood into the harvest 
+                         ! pool. Note that the unit of circ_class_biomass is gC 
+                         ! tree-1, so multiply with the number of trees to obtain 
+                         ! gC m-2. To avoid complexities when dealing with the 
+                         ! product pool multiply with the cover change 
+                         ! and the surface area of the pixel to obtain a weighted 
+                         ! mean expressed in gC.
+                         harvest_pool(ipts,ivm,idia,iele) = &
+                              harvest_pool(ipts,ivm,idia,iele) + &  
+                              ABS(loss_gain(ipts,ivm)) * pixel_area(ipts) * & 
+                              ( (un - branch_ratio(ivm)) * circ_class_n(ipts,ivm,icir) * &
+                              ( circ_class_biomass(ipts,ivm,icir,isapabove,iele) + &
+                              circ_class_biomass(ipts,ivm,icir,iheartabove,iele)) +&
+                              ! reserves
+                              harvest_ratio_stem * circ_class_n(ipts,ivm,icir) * &
+                              (circ_class_biomass(ipts,ivm,icir,icarbres,iele) + &
+                              circ_class_biomass(ipts,ivm,icir,ilabile,iele) ) )
+
+                         ! Associated harvest variables
+                         harvest_type(ipts,ivm) = ifm
+                         harvest_cut(ipts,ivm) = icut_lcc_wood
+                         harvest_area(ipts,ivm) = ABS(loss_gain(ipts,ivm) * &
+                              pixel_area(ipts))
+
+                         ! Move stumps and branches and the carbres and labile C 
+                         ! contained in them into the harvest pool with the 
+                         ! smallest dimenisons. Stumps and branches are removed 
+                         ! from the site but can now be treated separately from 
+                         ! stem wood in the product use module (sapiens_product_use.f90)       
+                         harvest_pool(ipts,ivm,1,iele) = &
+                              harvest_pool(ipts,ivm,1,iele) + &
+                              ABS(loss_gain(ipts,ivm)) * pixel_area(ipts) * &
+                              ! branches
+                              ( branch_ratio(ivm) * circ_class_n(ipts,ivm,icir) * &
+                              ( circ_class_biomass(ipts,ivm,icir,isapabove,iele) + &
+                              circ_class_biomass(ipts,ivm,icir,iheartabove,iele)) + &
+                              ! reserves
+                              harvest_ratio_branch * circ_class_n(ipts,ivm,icir) * &
+                              (circ_class_biomass(ipts,ivm,icir,icarbres,iele) + &
+                              circ_class_biomass(ipts,ivm,icir,ilabile,iele) )  + &
+                              ! stumps (all icarbres and ilabile is distributed
+                              ! over the stems and branches)
+                              circ_class_n( ipts,ivm,icir) * &
+                              ( circ_class_biomass(ipts,ivm,icir,isapbelow,iele) + &
+                              circ_class_biomass(ipts,ivm,icir,iheartbelow,iele) ) )
+                         
+                         !+++CHECK+++
+                         ! previous values of harvest_type and harvest_cut will 
+                         ! always be overwritten. Storing just a single value is 
+                         ! OK but it should be the value representing the largest 
+                         ! share of the biomass.
+                         ! Associated harvest variables
+                         harvest_type(ipts,ivm) = ifm
+                         harvest_cut(ipts,ivm) = icut_lcc_res
+                         harvest_area(ipts,ivm) = ABS(loss_gain(ipts,ivm) * &
+                              pixel_area(ipts))
+                         !+++++++++++
+                        
+                         ! Deposit the leaves, roots and fruit into a temporary 
+                         ! litter pool and place it in the soil and litter bank
+                         fresh_litter(ivm,ileaf,iele) = &
+                              fresh_litter(ivm,ileaf,iele) + &
+                              circ_class_biomass(ipts,ivm,icir,ileaf,iele) * &
+                              circ_class_n(ipts,ivm,icir)
+                         fresh_litter(ivm,iroot,iele) = &
+                              fresh_litter(ivm,iroot,iele) + &
+                              circ_class_biomass(ipts,ivm,icir,iroot,iele) * &
+                              circ_class_n(ipts,ivm,icir)
+                         fresh_litter(ivm,ifruit,iele) = &
+                              fresh_litter(ivm,ifruit,iele) + &
+                              circ_class_biomass(ipts,ivm,icir,ifruit,iele) * &
+                              circ_class_n(ipts,ivm,icir)
+                         fresh_litter(ivm,icarbres,iele) = &
+                              fresh_litter(ivm,icarbres,iele) + &
+                              harvest_ratio_litter*&
+                              circ_class_biomass(ipts,ivm,icir,icarbres,iele) * &
+                              circ_class_n(ipts,ivm,icir)
+                         fresh_litter(ivm,ilabile,iele) = &
+                              fresh_litter(ivm,ilabile,iele) + &
+                              harvest_ratio_litter*&
+                              circ_class_biomass(ipts,ivm,icir,ilabile,iele) * &
+                              circ_class_n(ipts,ivm,icir)
+
+                         EXIT dia_loop
+
+                      ENDIF ! correct diameter class
+
+                      ! If we are here, it means the diameter of this trunk is larger 
+                      ! than the upper boundary of our harvest bins.  Considering the 
+                      ! upper boundary is set to be 99999 meters in constants.f90, 
+                      ! something has gone wrong!
+                      IF(diameters_temp(icir) .GE. harvest_pool_bound(ndia_harvest+1))THEN
+
+                         WRITE(numout,*) 'Our tree is too big to fit into the harvest pools.'
+                         WRITE(numout,*) 'ipts, ivm, icir: ',ipts, ivm, icir
+                         WRITE(numout,*) 'diameters_temp(icir), harvest_pool_bound(idia)',&
+                              diameters_temp(icir),harvest_pool_bound(ndia_harvest+1)
+                         CALL ipslerr (3,'land_cover_main', &
+                              'harvest pool error (see output file)','','')
+
+                      ENDIF
+
+                    ENDDO dia_loop
+
+                   ENDDO ! nelements
+
+                ENDDO ! ncirc
+
+             !! 5.1.2.2 Biomass losses of grasses and crops
+             !  During LCC grasses and crops are simply plowed under 
+             !  and should thus be move into ::fresh_litter which is
+             !  moved later on into the litter bank ::fresh_ltr_bank
+             !  and finally into ::bm_to_litter. The bank is needed
+             !  to take a weighted average.
+             ELSE
+
+                DO iele = 1,nelements
+                    DO icir=1,ncirc
+                        fresh_litter(ivm,:,iele) = fresh_litter(ivm,:,iele) + &
+                            circ_class_biomass(ipts,ivm,icir,:,iele)* &
+                            circ_class_n(ipts,ivm,icir)
+                    ENDDO
+                ENDDO
+ 
+             ENDIF ! is_tree(ivm)
+
+             !! 5.1.2.3 Deposit soil and litter and soil&litter bank
+             ! Deposit the released soil&litter pools on the soil&litter-bank. 
+             ! The units of the C-pools are in gC m-2, hence, they need to be 
+             ! weighted by their relative change in cover fraction to obtain 
+             ! the C-pool (gC pixel-2) of the soil&litter-C-bank.
+             ! Mass_removed (g C) = x1*X1 + x2*X2 + x3*X3 where x1, x2, and x3 
+             ! are the change in veget_cov_max and X1, X2 and X3 are the 
+             ! C density of a given variable (g C m-2). Mass_removed will have
+             ! to be redistributed over the PFTs that increased their surface
+             ! area. Because we deal with net land cover changes we don't know 
+             ! the bi-directional changes and so the maxss_removed will be 
+             ! averaged and this average will be redistributed. In other words,
+             ! Mass_redistributed = y1*Y + y2*Y + y3*Y Where y1, y2 and y3 are 
+             ! the increases in veget_max for PFT that gained cover fraction and
+             ! Y is the average C-density. Mass conservation dictates that
+             ! Mass_removed = Mass_distributed so Y (g C m-2) can de calculated
+             ! as (x1*X1+x2*X2+x3*X3)/(y1+y2+y3). Note that y1+y2+y3 = total gain 
+             ! and by definition total_gain = total_loss. This is the approach
+             ! implemented below.
+             litter_bank(:,:,:) = litter_bank(:,:,:) + &
+                  loss_gain(ipts,ivm) * litter(ipts,:,ivm,:,:) / total_losses
+             soil_bank(:,:) =  soil_bank(:,:) + &
+                  loss_gain(ipts,ivm) * som(ipts,:,ivm,:) / total_losses
+             fresh_ltr_bank(:,:) = fresh_ltr_bank(:,:) + &
+                  loss_gain(ipts,ivm) * fresh_litter(ivm,:,:) / total_losses
+             fresh_som_bank(:,:) = fresh_som_bank(:,:) + &
+                  loss_gain(ipts,ivm) * fresh_som(ivm,:,:) / total_losses
+             bact_bank = bact_bank + &
+                  loss_gain(ipts,ivm) * bact(ipts,ivm) / total_losses
+             soil_n_min_bank(:) = soil_n_min_bank(:) + &
+                  loss_gain(ipts,ivm) * soil_n_min(ipts,ivm,:) / total_losses
+             DO ilev=1,nlevs
+
+                IF(litter_weight_struc(ilev) .GE. min_stomate)THEN
+           
+                   struct_ltr_bank(ilev) = struct_ltr_bank(ilev) + &
+                        lignin_struc(ipts,ivm,ilev) * &
+                        (litter(ipts,istructural,ivm,ilev,icarbon) * &
+                        ABS(loss_gain(ipts,ivm))) / &
+                        litter_weight_struc(ilev)
+                ENDIF
+
+                IF(litter_weight_woody(ilev) .GE. min_stomate)THEN
+                   
+                   woody_ltr_bank(ilev) = woody_ltr_bank(ilev) + &
+                        lignin_wood(ipts,ivm,ilev) * &
+                        (litter(ipts,iwoody,ivm,ilev,icarbon) * &
+                        ABS(loss_gain(ipts,ivm))) / &
+                        litter_weight_woody(ilev)
+                ENDIF
+
+             ENDDO
+
+             ! In stomate_season.f90 this variable is only calculated if 
+             ! the biomass(ileaf) > 0. As long as veget_cov_max is 0, this 
+             ! variable does not get a value. We need a value
+             ! to calculate ::KF which in turn is needed to calculate the biomass
+             ! of the seedlings we will prescribe. At this point in the calculation
+             ! the moiavail_growingseason from PFT1 is still zero so it is not 
+             ! accounted for yet. Its exact value depends on the PFT that will
+             ! be established on PFT1 and it will be accounted for later in the 
+             ! code
+             IF (ivm .GT. 1) THEN
+
+                moi_bank_season = moi_bank_season + loss_gain(ipts,ivm) / &
+                     total_losses * ( un - wstress_season(ipts,ivm))
+                moi_bank_month = moi_bank_month + loss_gain(ipts,ivm) / &
+                     total_losses * (un - wstress_month(ipts,ivm))
+
+             ENDIF
+
+             ! Intermediate error checking for losses only
+             IF (printlev_loc>=4) THEN
+
+                ! We are only interested in the PFTs that lost part 
+                ! of their share in the pixel, So we use a temporary
+                ! variable for pool_start. To keep things simple
+                ! the same is done for pool_end
+                test_mass(:,istart) = test_mass(:,istart) + &
+                     pool_start(ipts,ivm,:)
+
+                !! 6.1 Account for the carbon & nitrogen left on-site
+                !  The amount of carbon/nitrogen per tree or per m-2 has
+                !  not changed but the surface area covered by the PFT
+                !  has decreased. Don use the PFT dimension in pool_end
+                !  because the banks no longer have PFT dimenions either
+                DO iele = 1,nelements
+
+                   ! Biomass pool
+                   DO icir = 1,ncirc
+                      test_mass(iele,iend) = test_mass(iele,iend) + &
+                           SUM(circ_class_biomass(ipts,ivm,icir,:,iele))*&
+                           circ_class_n(ipts,ivm,icir) * &
+                           (veget_cov_max(ipts,ivm)+loss_gain(ipts,ivm))
+                   ENDDO
+
+                   ! bm_to_litter and turnover_daily
+                   test_mass(iele,iend) = test_mass(iele,iend) + &
+                        SUM(bm_to_litter(ipts,ivm,:,iele) + &
+                        turnover_daily(ipts,ivm,:,iele)) * &
+                        (veget_cov_max(ipts,ivm)+loss_gain(ipts,ivm))
+
+                   ! Litter pool (gC m-2) *  (m2 m-2) 
+                   test_mass(iele,iend) = test_mass(iele,iend) + &
+                        SUM(SUM(litter(ipts,:,ivm,:,iele),2)) * &
+                        (veget_cov_max(ipts,ivm)+loss_gain(ipts,ivm))
+
+                   ! Soil carbon (gC m-2) *  (m2 m-2)
+                   test_mass(iele,iend) = test_mass(iele,iend) + &
+                        SUM(som(ipts,:,ivm,iele)) * &
+                        (veget_cov_max(ipts,ivm)+loss_gain(ipts,ivm))
+
+                ENDDO !nelements
+
+                !Denitrifying bacteria (only C)
+                test_mass(icarbon,iend) = test_mass(icarbon,iend) + &
+                     bact(ipts,ivm) * &
+                     (veget_cov_max(ipts,ivm)+loss_gain(ipts,ivm))
+
+                ! Nitrogen only
+                test_mass(initrogen,iend) = test_mass(initrogen,iend) + &
+                     SUM(soil_n_min(ipts,ivm,:)) * & 
+                     (veget_cov_max(ipts,ivm)+loss_gain(ipts,ivm))
+                
+                !! 6.2 Account for the pools where the C and N was moved to
+                !  When the total surface area of a PFT was decreased, the 
+                !  carbon and nitrogen that was removed was moved into several
+                !  so called "banks" and the harvest pool. 
+                DO iele = 1,nelements
+
+                   ! The biomass harvest pool is expressed in gC pixel-1 So, it 
+                   ! shouldn't be multiplied by veget_cov_max but it should be 
+                   ! divided by pixel_area to obtain gC m-2.
+                   test_mass(iele,iend) = test_mass(iele,iend) + &
+                        SUM(harvest_pool(ipts,ivm,:,iele) - &
+                        harvest_pool_old(ipts,ivm,:,iele)) / &
+                        pixel_area(ipts)
+                   test_mass_bank(iele) = test_mass_bank(iele) - &
+                        SUM(fresh_ltr_bank(:,iele) + fresh_som_bank(:,iele)) * &
+                        total_losses
+                   test_mass_bank(iele) = test_mass_bank(iele) - &
+                        SUM(soil_bank(:,iele)) * total_losses
+                   test_mass_bank(iele) = test_mass_bank(iele) - &
+                        SUM(SUM(litter_bank(:,:,iele),2)) * &
+                        total_losses
+
+                ENDDO
+
+                ! Pool with only carbon
+                test_mass_bank(icarbon) = test_mass_bank(icarbon) - &
+                     bact_bank * total_losses
+
+                ! Pools with only nitrogen
+                test_mass_bank(initrogen) = test_mass_bank(initrogen) - &
+                     SUM(soil_n_min_bank(:)) * total_losses
+                
+                DO iele = 1,nelements
+                   IF (ABS(test_mass(iele,iend)-test_mass(iele,istart) + &
+                        test_mass_bank(iele)).GT.min_stomate) THEN
+                      WRITE(numout,*) 'ivm, iele, test_mass(istart), test_mass(iend), &
+                           & test_mass_bank, diff'
+                      WRITE(numout,'(2I3,4F20.10)') ivm, iele, &
+                           test_mass(iele,istart), test_mass(iele,iend), &
+                           test_mass_bank(iele), test_mass(iele,iend) - &
+                           test_mass(iele,istart) + test_mass_bank(iele)
+                      CALL ipslerr(3,'sapiens_lcchange','When accounting &
+                           & for the C and N due to decreases in PFTs', &
+                           'the C/N is not conserved','')
+                   ELSE
+                      ! Debug
+                      IF (printlev_loc>=4) THEN
+                         WRITE(numout,'(A,2I3)') 'OK intermediate mass balance &
+                              & check',ivm,iele
+                      ENDIF
+                      !-
+                   ENDIF ! diff is zero
+                ENDDO ! nelements
+
+             ENDIF !printlev_loc
+
+          ENDIF ! IF (loss_gain(ivm,ipts) < -min_stomate)
+
+       ENDDO ! Loop over # PFT's
+
+       !! 5.2 Land cover gains within a pixel
+       !  The consecutive loops over nvm cannot be merged because we first
+       !  need to deposit all the available pools on the bank before we
+       !  can withdraw the deposits to initialize new PFTs with the weighted
+       !  mean of the deposits
+
+       !! 5.2.1 There is no land cover change or there is a loss      
+       DO ivm = 1,nvm
+
+          ! Debug
+          IF (printlev_loc>=4) THEN
+             ! Initialize intermediate mass conservation checks
+             test_mass(:,istart) = zero
+          ENDIF
+          !-
+
+          IF ( loss_gain(ipts,ivm) .LE. -min_stomate ) THEN
+             
+             ! There is no land cover change or there is a loss. In case there 
+             ! is no land cover change nothing should be done. The case in which 
+             ! there is a loss is already dealt with above - see comment 
+             ! below Â§5.2 to learn why the case of a loss is not integrated in 
+             ! this IF-statement. Basically we need to put all the lost C/N on 
+             ! the bank first before we can redistribute it. 
+ 
+          ! Increase in the extent of a PFT
+          ELSEIF ( loss_gain(ipts,ivm) .GE. min_stomate ) THEN
+
+             !! 5.2.1 Check wether this is the youngest age class
+             !  If the redistribution of the LCC map in age classes is correctly 
+             !  implemented a new age class should always be established in the 
+             !  youngest age class which should be the first of the group. This 
+             !  implies that in this case ::ivm is the first of the group and 
+             !  ivm + nagec - 1 is the last age class of the group
+             IF (is_tree(ivm)) THEN
+
+                igroup = INT(agec_group(ivm))
+                nagec_temp = nagec_pft(igroup)
+
+                IF (agec_group(ivm+nagec_temp-1) .NE. igroup) THEN
+                   
+                   ! ::ivm and ivm+nagec-1 are in a different ::igroup 
+                   ! apparently ::ivm is not the youngest age class
+                   WRITE(numout,*) 'Error: problem with the redistribution of the LCC maps'
+                   WRITE(numout,*) 'ipts, ivm, nagec_temp:  ',ipts, ivm
+                   WRITE(numout,*) 'veget_cov_max, loss_gain: ',veget_cov_max(ipts,ivm),&
+                        loss_gain(ipts,ivm)
+                   WRITE(numout,*) 'nagec_temp, igroup:  ',nagec_temp,igroup
+                   WRITE(numout,*) 'agec_group(ivm), agec_group(ivm+nagec_temp-1):  ',&
+                        agec_group(ivm), agec_group(ivm+nagec_temp-1)
+                   CALL ipslerr (3,'land_cover_main','Cannot find proper age classes!','','')
+
+                ENDIF
+
+             ENDIF
+
+             !! 5.2.2 The new PFT does not exist yet
+             IF (veget_cov_max(ipts,ivm) .LT. min_stomate) THEN
+
+                !! 5.2.2.1 Initialize new and dummy variables
+                new_circ_class_biomass(:,:,:,:,:) = zero
+                new_circ_class_n(:,:,:) = zero
+                new_lm_lastyearmax(:,:) = zero
+                new_age(:,:) = zero
+                new_leaf_frac(:,:,:) = zero
+                new_atm_to_bm(:,:,:) = zero
+                new_everywhere(:,:) = zero 
+                dum_when_growthinit(:,:) = large_value
+                dum_npp_longterm(:,:) = zero
+                dum_PFTpresent(:,:) = .TRUE.
+                plant_status(ipts,ivm) = iprescribe
+               
+                !! 5.2.2.2 Assign value to moiavail_growingseason
+                !  Remember to add the moisture from PFT1 that will be present 
+                !  if PFT1 is planted with PFT ivm. Note ::loss_gain is here for
+                !  PFT1 but ::vir_moiavail_growingseason is for PFT ivm.
+                !moiavail_growingseason(ipts,ivm) = moi_bank + &
+                !     vir_moiavail_growingseason(ipts,ivm) * &
+                !     loss_gain(ipts,1) / total_losses
+                ! k_latosa_adapt is adjusted every day. wstress is no longer
+                ! used in prescribe
+                !wstress_season(ipts,ivm) = moi_bank + &
+                !     vir_wstress_fac(ipts,ivm) * &
+                !     loss_gain(ipts,1) / total_losses 
+
+                !! 5.2.2.3 Prescribe values for newly established PFTs
+                ! Initialize density of individuals, biomass, allocation factors,
+                ! leaf age distribution, ... to some reasonable value
+                ! ::veget_cov_max is not updated yet, therefore loss_gain is passed in 
+                ! the argument list. As ::veget_cov_max is used in the IF-THEN-statements
+                ! we won't update it until the end of this routine. If we would
+                ! update before that, the same PFT may be subject to conflicting actions
+                ! i.e. prescribe a new PFT and then merge it with the other age-classes
+                ! in the PFT-group.
+                CALL prescribe(npts, loss_gain, dt_days, dum_PFTpresent, &
+                     new_everywhere, dum_when_growthinit, new_leaf_frac, circ_class_dist, &
+                     new_circ_class_n, new_circ_class_biomass, new_atm_to_bm, &
+                     forest_managed, KF, &
+                     plant_status, new_age, dum_npp_longterm, new_lm_lastyearmax, &
+                     tau_eff_leaf, tau_eff_sap, tau_eff_root, k_latosa_adapt, &
+                     light_tran_to_level_season, EndOfYear,lpft_replant, species_change_map)
+
+                circ_class_biomass(ipts,ivm,:,:,:) = new_circ_class_biomass(ipts,ivm,:,:,:)
+                circ_class_n(ipts,ivm,:) = new_circ_class_n(ipts,ivm,:)
+                lm_lastyearmax(ipts,ivm) = new_lm_lastyearmax(ipts,ivm)
+                age(ipts,ivm) = new_age(ipts,ivm)
+                leaf_frac(ipts,ivm,:) = new_leaf_frac(ipts,ivm,:)
+                atm_to_bm(ipts,ivm,:) = new_atm_to_bm(ipts,ivm,:)
+                everywhere(ipts,ivm) = new_everywhere(ipts,ivm)
+                PFTpresent(ipts,ivm) = .TRUE.
+
+                ! Update a couple forestry parameters.  I initialize these to
+                ! one instead of zero since forestry is called after this
+                ! routine, and it looks at last_cut.  This is not a real
+                ! problem since the trees we prescribe generally are the height of
+                ! saplings and not seeds.
+                age_stand(ipts,ivm) = 1
+                last_cut(ipts,ivm) = 1
+
+                ! Initialize the soil and litter carbon pools. When PFTs were removed
+                ! their soil and litter carbon was deposited on the bank. It is assumed
+                ! that the newly established PFT are established uniformly on all the
+                ! removed PFTs. Hence there is no preferential LCC sequence. For example
+                ! we deforest a needle and broadleaved PFT and replace it by a crop and
+                ! a grassland the crop and grassland are both established on the former
+                ! needle and broadleaved PFT rather than the crop being entirely on the 
+                ! former needleleaved PFT and grassland on the former broadleaved PFT.
+                ! Further, the LCC-maps should guarantee that the losses equal the gains
+                ! which ensures mass preservation. For these reasons we can simply use the
+                ! mean soil and litter carbon on the bank (gC m-2) to initialize the soil
+                ! and litter crabon of the newly established PFT's. 
+                litter(ipts,:,ivm,:,:) = litter_bank(:,:,:)
+                som(ipts,:,ivm,:) =  soil_bank(:,:)
+                lignin_struc(ipts,ivm,:) = struct_ltr_bank(:)
+                lignin_wood(ipts,ivm,:) = woody_ltr_bank(:)
+                bm_to_litter(ipts,ivm,:,:) = fresh_ltr_bank(:,:)
+                turnover_daily(ipts,ivm,:,:) = fresh_som_bank(:,:)
+                soil_n_min(ipts,ivm,:) = soil_n_min_bank(:)
+                bact(ipts,ivm) = bact_bank
+
+
+             !! 5.2.3 The new PFT does already exist 
+             ELSEIF (veget_cov_max(ipts,ivm) .GE. min_stomate) THEN
+
+                !  We want to make use of prescribe_prognostic but it should be noted
+                !  that this PFT already contains biomass. Therefore we will create a
+                !  temporary PFT without biomass which can be used to establish the
+                !  new vegetation within this PFT. For most of the INTENT(inout)
+                !  variables of prescribe_prognostic we receive temporary variables 
+                !  back this helps us to calculate the weighted mean of the newly 
+                !  established vegetation and the vegetation that is already there.
+                !  For some other variables we receive dummies as we are simply not
+                !  going to use these values but will continue using the values of the
+                !  vegetation that is already there.
+
+                !! 5.2.3.1 Initialize new and dummy variables
+                new_circ_class_biomass(:,:,:,:,:) = zero
+                new_circ_class_n(:,:,:) = zero
+                new_lm_lastyearmax(:,:) = zero
+                new_age(:,:) = zero
+                new_leaf_frac(:,:,:) = zero
+                new_atm_to_bm(:,:,:) = zero
+                new_everywhere(:,:) = zero 
+                dum_when_growthinit(:,:) = large_value
+                dum_npp_longterm(:,:) = zero
+                dum_PFTpresent(:,:) = .TRUE.
+                plant_status(ipts,ivm) = iprescribe
+                
+                !! 5.2.3.2 Merge the new and already available vegetation
+                !  Veget_max after PFT expansion. As ::veget_cov_max is used in the 
+                !  IF-statements we won't update it until the end of this routine. If 
+                !  we would updatebefore that, the same PFT may be subject to 
+                !  conflicting actions.
+                share_expanded = veget_cov_max(ipts,ivm) / &
+                     ( veget_cov_max(ipts,ivm) + loss_gain(ipts,ivm) )
+
+                ! We also need a scaling factor which includes the litter. This is for growing
+                ! a new PFT on the soil mixture left from all the land we cleared.
+                DO ilev=1,nlevs
+
+                   DO ilit=1,nlitt
+
+                      IF(litter(ipts,ilit,ivm,ilev,icarbon) .GE. min_stomate)THEN
+                        
+                         litter_weight_expanded(ilit,ilev) = &
+                              litter(ipts,ilit,ivm,ilev,icarbon) * &
+                              veget_cov_max(ipts,ivm)/ &
+                              (litter(ipts,ilit,ivm,ilev,icarbon) * veget_cov_max(ipts,ivm) + &
+                              litter_bank(ilit,ilev,icarbon) * loss_gain(ipts,ivm))
+
+                      ELSE
+                         
+                         litter_weight_expanded(ilit,ilev)=zero
+
+                      ENDIF
+
+                   END DO
+
+                ENDDO
+
+                ! Remember to add the moisture from PFT1 that will be present 
+                ! if PFT1 is planted with PFT ivm. Note ::loss_gain is here for
+                ! PFT1 but ::vir_wstress_fac is for PFT ivm.
+                ! Here we need to be careful.  loss_gain(ipts,ivm) will always be
+                ! negative, but we are using loss_gain(ipts,1) which may be negative 
+                ! or positive. So we have to take absolute values.
+                IF(ABS(total_losses) .GT. min_stomate)THEN
+
+                   wstress_season(ipts,ivm) = un - ( (un - wstress_season(ipts,ivm)) * &
+                        share_expanded + (moi_bank_season  * &
+                        ABS(loss_gain(ipts,1)) / ABS(total_losses) ) * (un - share_expanded))
+                   wstress_month(ipts,ivm) = un - ( (un - wstress_month(ipts,ivm)) * &
+                        share_expanded + (moi_bank_month  * &
+                        ABS(loss_gain(ipts,1)) / ABS(total_losses) ) * (un - share_expanded))
+
+                ! In this case, we expect the nobio fraction to change and we're okay
+                ! with it.  So just leave the long-term water stresses at their
+                ! previous values.
+                ELSEIF(err_act .EQ. 2)THEN
+
+                   WRITE(numout,*) 'WARNING: ipts,ivm: ',ipts,ivm
+                   WRITE(numout,*) 'total_losses: ',total_losses
+                   CALL ipslerr (2,'land_cover_main', &
+                        'We have no losses on this pixel, which causes a divide by zero, but ',&
+                        'you have indicated that you understand the situation so we continue.',&
+                        'Look for Error in out_orchidee file for details')
+
+                ! We are not okay with this situation.  Stop with an error.
+                ELSEIF(err_act .EQ. 3)THEN
+                  
+                   WRITE(numout,*) 'ERROR: ipts,ivm: ',ipts,ivm
+                   WRITE(numout,*) 'total_losses: ',total_losses
+                   CALL ipslerr (3,'land_cover_main', &
+                        'We have no losses on this pixel, which causes a divide by zero, and ',&
+                        'you have not indicated that you understand the situation.',&
+                        'Look for Error in out_orchidee file for details')
+                   
+                ENDIF
+
+                !! 5.2.3.3 Initialize the newly established vegetation: 
+                !  Initialize the newly established vegetation: density of 
+                !  individuals, biomass, allocation factors, leaf age distribution, 
+                !  etc to some reasonable value ::veget_cov_max is not updated yet, 
+                !  therefore loss_gain is passed in the argument list.
+                CALL prescribe (npts, loss_gain, dt_days, dum_PFTpresent, &
+                     new_everywhere, dum_when_growthinit, new_leaf_frac, circ_class_dist, &
+                     new_circ_class_n, new_circ_class_biomass, new_atm_to_bm, &
+                     forest_managed, KF, &
+                     plant_status, new_age, dum_npp_longterm, new_lm_lastyearmax, &
+                     tau_eff_leaf, tau_eff_sap, tau_eff_root, k_latosa_adapt, &
+                     light_tran_to_level_season, EndOfYear, lpft_replant, species_change_map)
+
+                !! 5.2.3.3.1 Merge biomass of new and already available trees
+                IF (is_tree(ivm)) THEN
+
+                   ! Copy the number of individuals and the biomass of the established 
+                   ! vegetation to a temporary variable. In the subroutine ::circ_class_n
+                   ! and ::circ_class_biomass will be overwritten with the characteristics
+                   ! of the merged vegetation
+                   est_circ_class_n(:) = circ_class_n(ipts,ivm,:)
+                   est_circ_class_biomass(:,:,:) = circ_class_biomass(ipts,ivm,:,:,:)
+                   tmp_circ_class_n(:) = new_circ_class_n(ipts,ivm,:)
+                   tmp_circ_class_biomass(:,:,:) = new_circ_class_biomass(ipts,ivm,:,:,:)
+
+                   ! Store circumference (m) in a temporary variable that can be 
+                   ! sorted from small to large - note that the dimension of these
+                   ! variables are 2*ncirc
+                   est_circ_class_dia(:) = wood_to_dia(est_circ_class_biomass(:,:,icarbon),ivm)
+                   tmp_circ_class_dia(:) = wood_to_dia(tmp_circ_class_biomass(:,:,icarbon),ivm)
+
+                   ! Merge the biomass        
+                   CALL merge_biomass_pfts(npts, share_expanded, circ_class_n, &
+                        est_circ_class_n, tmp_circ_class_n, circ_class_biomass, &
+                        est_circ_class_biomass, &
+                        tmp_circ_class_biomass, circ_class_dist, &
+                        ipts, ivm, est_circ_class_dia, tmp_circ_class_dia)
+
+                !! 5.2.3.3.2 Merge biomass of new and already available grass or cropland
+                ELSE
+                                  
+                   ! Dilute the existing biomass pools and number of individuals
+                   circ_class_biomass(ipts,ivm,1,:,:) = share_expanded * &
+                        circ_class_biomass(ipts,ivm,1,:,:) + &
+                        (un - share_expanded) * new_circ_class_biomass(ipts,ivm,1,:,:)
+                   circ_class_n(ipts,ivm,1) = share_expanded * circ_class_n(ipts,ivm,1)+ &
+                        (un - share_expanded) * new_circ_class_n(ipts,ivm,1)
+
+                ENDIF
+               
+                !! 5.2.3.4 Calculate the PFT characteristics of the merged PFT
+                !  Take the weighted mean of the existing vegetation and the new 
+                !  vegetation in this PFT. Note that co2_to_bm is in gC. m-2 dt-1 
+                !  so we should also take the weighted mean (rather than sum if
+                !  this where absolute values).
+                lm_lastyearmax(ipts,ivm) = share_expanded * lm_lastyearmax(ipts,ivm) + &
+                     (un - share_expanded) * new_lm_lastyearmax(ipts,ivm)
+                age(ipts,ivm) = share_expanded * age(ipts,ivm) + &
+                     (un - share_expanded) * new_age(ipts,ivm)
+                leaf_frac(ipts,ivm,:) = share_expanded * leaf_frac(ipts,ivm,:) + &
+                     (un - share_expanded) * new_leaf_frac(ipts,ivm,:)
+                atm_to_bm(ipts,ivm,:) = share_expanded * atm_to_bm(ipts,ivm,:) + &
+                     (un - share_expanded) * new_atm_to_bm(ipts,ivm,:)
+
+                ! Everywhere deals with the migration of vegetation. Copy the
+                ! status of the most migrated vegetation for the whole PFT
+                everywhere(ipts,ivm) = MAX(everywhere(ipts,ivm), new_everywhere(ipts,ivm))
+
+                ! The new soil&litter pools are the weighted mean of the newly 
+                ! established vegetation for that PFT (as deposited on the bank) 
+                ! and the vegetation that already exists in that PFT.
+                ! NOTE that in case veget_cov_max of PFT1 (bare soil) is increasing
+                ! we will also move litter to the bare soil. stomate_litter.f90
+                ! was adjusted such that decomposition also happens in PFT
+                litter(ipts,:,ivm,:,:) = share_expanded * litter(ipts,:,ivm,:,:) + &
+                        (un - share_expanded) * litter_bank(:,:,:)
+                som(ipts,:,ivm,:) =  share_expanded * som(ipts,:,ivm,:) + &
+                     (un - share_expanded) * soil_bank(:,:)
+                lignin_struc(ipts,ivm,:) = litter_weight_expanded(istructural,:) * &
+                     lignin_struc(ipts,ivm,:) + &
+                     (un - litter_weight_expanded(istructural,:)) * struct_ltr_bank(:)
+                lignin_wood(ipts,ivm,:) = litter_weight_expanded(iwoody,:) * &
+                     lignin_wood(ipts,ivm,:) + &
+                     (un - litter_weight_expanded(iwoody,:)) * woody_ltr_bank(:)
+                bm_to_litter(ipts,ivm,:,:) = share_expanded * bm_to_litter(ipts,ivm,:,:) + & 
+                     (un - share_expanded) * fresh_ltr_bank(:,:)
+                turnover_daily(ipts,ivm,:,:) = share_expanded * turnover_daily(ipts,ivm,:,:) + &
+                     (un - share_expanded) * fresh_som_bank(:,:)
+                soil_n_min(ipts,ivm,:) = share_expanded * soil_n_min(ipts,ivm,:) + & 
+                     (un - share_expanded) * soil_n_min_bank(:)
+                bact(ipts,ivm) = share_expanded * bact(ipts,ivm) + &
+                     (un - share_expanded) * bact_bank
+
+                ! These next two variables are integers, so we use CEILING to make sure
+                ! they stay integers.  FLOOR or INT would also be fine.  The use of
+                ! CEILING is arbitrary.
+                age_stand(ipts,ivm)  = CEILING(share_expanded * age_stand(ipts,ivm) + &
+                     (un - share_expanded) * 1)
+                last_cut(ipts,ivm)  = CEILING(share_expanded * last_cut(ipts,ivm) + &
+                     (un - share_expanded) * 1)
+
+             ELSE
+               
+                WRITE(numout,*) 'Error 1: logic of the IF-statements in land_cover_change'
+   
+             ENDIF ! New PFT
+
+          ELSEIF(ABS(loss_gain(ipts,ivm)) .LE. 1e-15)THEN
+
+             ! Do nothing.  This is okay, as far as I can tell.
+             ! This seems to be the double precision limit.
+
+          ELSE
+
+             WRITE(numout,*) 'ipts, ivm: ',ipts,ivm
+             WRITE(numout,*) 'loss_gain: ',loss_gain(ipts,ivm)
+             CALL ipslerr(3, 'Logic of IF-statement in land_cover_change',&
+                  'Second IF-statement where this could happen','','')
+
+          ENDIF ! Land cover change?
+
+       ENDDO  ! Loop over # PFT's
+
+       ! Debug
+       IF (printlev_loc>=4) THEN
+
+          ! This part of an additional mass balance check for variables
+          ! that pass through the bank. Litter, som, bact and soil_n_min
+          ! may be moved from one PFT to another but they are not mixed.
+          ! For each of the variables their value at the start of this
+          ! subroutine should equal their value at the end
+          DO iele = 1,nelements
+             test_bank(1,iele,iend) = SUM(SUM(SUM(litter(ipts,:,:,:,iele),3),1) * &
+                  (veget_cov_max(ipts,:)+loss_gain(ipts,:)))
+             test_bank(2,iele,iend) = SUM(SUM(som(ipts,:,:,iele),1) * &
+                  (veget_cov_max(ipts,:)+loss_gain(ipts,:)))
+          ENDDO
+          test_bank(3,icarbon,iend) = SUM(bact(ipts,:) * &
+                  (veget_cov_max(ipts,:)+loss_gain(ipts,:)))
+          test_bank(3,initrogen,iend) = SUM(SUM(soil_n_min(ipts,:,:),2) * &
+                  (veget_cov_max(ipts,:)+loss_gain(ipts,:)))
+
+          ! Test mass conservation
+          DO iele = 1,nelements
+
+             IF (ABS(test_bank(1,iele,iend)-test_bank(1,iele,istart)).GT.min_stomate) THEN
+                WRITE(numout,*) 'iele, test_bank(istart), test_bank(iend), diff'
+                WRITE(numout,'(I3,3F20.10)'),iele,test_bank(1,iele,iend), test_bank(1,iele,istart),&
+                     test_bank(1,iele,iend)-test_bank(1,iele,istart)
+                CALL ipslerr(2,'sapiens_lcchange','Mass balance error for litter','','')
+             ELSE
+                WRITE(numout,'(A,I3)') 'OK intermediate mass balance check for litter',iele
+             ENDIF
+             IF (ABS(test_bank(2,iele,iend)-test_bank(2,iele,istart)).GT.min_stomate) THEN
+                WRITE(numout,*) 'iele, test_bank(istart), test_bank(iend), diff'
+                WRITE(numout,'(I3,3F20.10)'),iele,test_bank(2,iele,iend), test_bank(2,iele,istart),&
+                     test_bank(2,iele,iend)-test_bank(2,iele,istart)
+                CALL ipslerr(2,'sapiens_lcchange','Mass balance error for som','','')
+             ELSE
+                WRITE(numout,'(A,I3)') 'OK intermediate mass balance check for som',iele
+             ENDIF
+
+             IF (ABS(test_bank(3,iele,iend)-test_bank(3,iele,istart)).GT.min_stomate) THEN
+                WRITE(numout,*) 'iele, test_bank(istart), test_bank(iend), diff'
+                WRITE(numout,'(I3,3F20.10)'),iele,test_bank(3,iele,iend), test_bank(3,iele,istart),&
+                     test_bank(3,iele,iend)-test_bank(3,iele,istart)
+                IF (iele.EQ.1) CALL ipslerr(2,'sapiens_lcchange','Mass balance error for bact','','')
+                IF (iele.EQ.2) CALL ipslerr(2,'sapiens_lcchange','Mass balance error for soil_n_min','','')
+             ELSE
+                IF (iele.EQ.1) WRITE(numout,*) 'OK intermediate mass balance check for bact'
+                IF (iele.EQ.2) WRITE(numout,*) 'OK intermediate mass balance check for soil_n_min'
+             
+             ENDIF ! test diff
+
+          ENDDO ! iele
+
+       ENDIF ! prinlev_loc
+       !-
+
+    ENDDO ! Loop over npts
+    
+ !! 6. Calculate new veget_cov_max values and update variables if PFT was removed 
+       
+    veget_cov_max(:,:) = veget_cov_max(:,:) + loss_gain(:,:)
+
+    ! Error checking
+    IF (SUM(veget_cov_max - veget_cov_max_new_adj).GT.min_stomate) THEN
+       CALL ipslerr(3,'Error after updating veget_cov_max','','','')
+    ENDIF
+
+    ! Update the variables if veget_cov_max is below threshold
+    ! +++CHECK+++
+    ! This looks like something that will result in mass balance problems
+    DO ipts = 1,npts
+       
+       DO ivm = 1,nvm
+
+          IF (veget_cov_max(ipts,ivm) .LT. min_vegfrac) THEN
+
+             !Debug
+!!$             IF(printlev_loc>=4)THEN
+                IF (veget_cov_max(ipts,ivm) .GT. zero) THEN
+                   WRITE(numout,*) 'Cleaning PFTs below threshold', ipts, ivm
+                   WRITE(numout,*) 'Vegetation lost',veget_cov_max(ipts,ivm)
+                ENDIF
+!!$             ENDIF
+             !
+
+             veget_cov_max(ipts,ivm) = zero
+             lm_lastyearmax(ipts,ivm) = zero
+             age(ipts,ivm) = zero
+             leaf_frac(ipts,ivm,:) = zero
+             atm_to_bm(ipts,ivm,:) = zero
+             everywhere(ipts,ivm) = zero
+             litter(ipts,:,ivm,:,:) = zero
+             som(ipts,:,ivm,:) = zero
+             lignin_struc(ipts,ivm,:) = zero
+             lignin_wood(ipts,ivm,:) = zero
+             bm_to_litter(ipts,ivm,:,:) = zero
+             turnover_daily(ipts,ivm,:,:) = zero
+             soil_n_min(ipts,ivm,:) = zero
+             bact(ipts,ivm) = zero
+             PFTpresent(ipts,ivm) = .FALSE.
+             circ_class_biomass(ipts,ivm,:,:,:) = zero
+             circ_class_n(ipts,ivm,:) = zero
+             age_stand(ipts,ivm)=0
+             last_cut(ipts,ivm)=0
+             plant_status(ipts,ivm)= 1
+
+          ENDIF
+
+       ENDDO
+
+    ENDDO
+    !+++++++++++
+
+    IF (printlev_loc>=4) THEN
+       DO ipts=1,npts
+ !          IF(ipts == test_grid)THEN
+             WRITE(numout,*) 'Final values before mass balance'
+             CALL print_lcc_error_message(npts,ipts,veget_cov_max_new_adj,&
+                  veget_cov_max,veget_cov_max_new_group,&
+                  veget_cov_max_group,delta_veget_cov,loss_gain,4)
+ !          ENDIF
+       ENDDO
+    ENDIF
+
+    ! Debug
+    IF (printlev_loc>=4) THEN
+       ! We don want to see C/N values for PFTs without veget_cov_max. That
+       ! would indicate a problem with reading and/or processing the land
+       ! cover change maps.
+       WRITE(numout,*) 'Checking whether biomass and veget_cov_max are aligned'
+       DO ipts = 1,npts
+          WRITE(numout,*) 'ivm, veget_max, biomass'
+          DO ivm = 1,nvm
+             WRITE(numout,'(I2,2F20.10)') ivm, veget_cov_max(ipts,ivm),&
+                  SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),2))
+          ENDDO
+          WRITE(numout,*) 'ivm, veget_max, bm_to_litter'  
+          DO ivm = 1,nvm
+             WRITE(numout,'(I2,2F20.10)') ivm, veget_cov_max(ipts,ivm),&
+                  SUM(bm_to_litter(ipts,ivm,:,icarbon))
+          ENDDO
+          WRITE(numout,*) 'ivm, veget_max, turnover_daily'
+          DO ivm = 1,nvm
+             WRITE(numout,'(I2,2F20.10)') ivm, veget_cov_max(ipts,ivm),&
+                  SUM(turnover_daily(ipts,ivm,:,icarbon))
+          ENDDO
+          WRITE(numout,*) 'ivm, veget_max, litter'
+          DO ivm = 1,nvm
+             WRITE(numout,'(I2,2F20.10)') ivm, veget_cov_max(ipts,ivm),&
+                  SUM(SUM(litter(ipts,:,ivm,:,icarbon),2))
+          ENDDO
+          WRITE(numout,*) 'ivm, veget_max, som'
+          DO ivm = 1,nvm
+             WRITE(numout,'(I2,2F20.10)') ivm, veget_cov_max(ipts,ivm),&
+                  SUM(som(ipts,:,ivm,icarbon))
+          ENDDO
+       ENDDO
+    ENDIF
+    !-
+
+!! 7. Mass balance closure
+   
+    IF (err_act.GT.1) THEN
+
+       ! 7.1 Check surface area
+       CALL check_surface_area("sapiens_lccchange", npts, veget_cov_max_begin, &
+            veget_cov_max,'pixel')
+
+       !! 7.2 Calculate components of the mass balance
+       pool_end(:,:,:) = zero
+       DO iele = 1,nelements
+
+          ! Biomass pool + bm_to_litter
+          DO ipar = 1,nparts
+            DO icir=1, ncirc
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                    circ_class_biomass(:,:,icir,ipar,iele)*&
+                    circ_class_n(:,:,icir) *veget_cov_max(:,:)
+            ENDDO
+            pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                (bm_to_litter(:,:,ipar,iele) + turnover_daily(:,:,ipar,iele))* veget_cov_max(:,:)
+          ENDDO
+
+          ! Litter pool (gC m-2) *  (m2 m-2) 
+          DO ilit = 1,nlitt
+             DO ilev = 1,nlevs
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                     litter(:,ilit,:,ilev,iele) * veget_cov_max(:,:)
+             ENDDO
+          ENDDO
+
+          ! Soil carbon (gC m-2) *  (m2 m-2)
+          DO icarb = 1,ncarb
+             pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                  som(:,icarb,:,iele) * veget_cov_max(:,:)
+          ENDDO
+
+          ! The biomass harvest pool is expressed in gC pixel-1 So, it 
+          ! shouldn't be multiplied by veget_cov_max but it should be divided
+          ! by pixel_area to obtain gC m-2. The difference between 
+          ! pool_start and pool_end was accumulated over dt, therefore, 
+          ! the units of ipoolchange are gC m-2 dt-1.
+          DO ipts = 1,npts
+             pool_end(ipts,:,iele) = pool_end(ipts,:,iele) + &
+                  SUM(harvest_pool(ipts,:,:,iele),2) / &
+                  pixel_area(ipts)
+          ENDDO
+
+       ENDDO
+
+       !Denitrifying bacteria (only C)
+       pool_end(:,:,icarbon) = pool_end(:,:,icarbon) + &
+               bact(:,:) * veget_cov_max(:,:)
+ 
+       ! Nitrogen only
+       DO ispec = 1,nnspec
+          pool_end(:,:,initrogen) = pool_end(:,:,initrogen) + &
+              soil_n_min(:,:,ispec) * veget_cov_max(:,:)
+       ENDDO
+
+       !! 7.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(:,:,iatm2land,iele) = &
+               check_intern(:,:,iatm2land,iele) + &
+               atm_to_bm(:,:,iele) * veget_cov_max(:,:) * dt_days
+          check_intern(:,:,ipoolchange,iele) = -un * (pool_end(:,:,iele) - &
+               pool_start(:,:,iele)) 
+       ENDDO
+
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+            DO ivm=1, nvm
+             ! Debug
+             IF (printlev_loc>=4) THEN              
+                IF(iele .EQ. 1) WRITE(numout,"(9999(G12.5,:,','))") &
+                    'imbc, ivm, check_intern', test_grid , imbc, &
+                    ivm, check_intern(test_grid,ivm,imbc,iele)
+             ENDIF
+             !-
+            ENDDO
+             closure_intern(:,:,iele) = closure_intern(:,:,iele) + &
+                  check_intern(:,:,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 7.3 Check mass balance closure
+       CALL check_mass_balance("sapiens_lccchange", closure_intern, npts, &
+            pool_end, pool_start, veget_cov_max, 'pixel')
+    
+    ENDIF ! err_act.GT.1    
+
+    !Debug
+    ! Check to see if the nobio fraction has changed
+    DO ipts=1,npts
+       frac_nobio_end(ipts,1)=un-SUM(veget_cov_max(ipts,:))
+       IF(abs(frac_nobio_start(ipts,1) - frac_nobio_end(ipts,1)) .GT. min_stomate)THEN
+          IF(hack_lcc)THEN
+             WRITE(numout,*) 'ERROR: nobio fraction changed during LCC!'
+             WRITE(numout,*) 'ipts, frac_nobio_start(ipts,1): ',ipts, frac_nobio_start(ipts,1)
+             WRITE(numout,*) 'ipts, frac_nobio_end(ipts,1): ',ipts, frac_nobio_end(ipts,1)
+             CALL ipslerr (3,'land_cover_main', 'nbio fraction error.',&
+                  'Check output file for details.','')
+          ELSE
+             WRITE(numout,*) 'WARNING: nobio fraction changed during LCC!'
+             WRITE(numout,*) 'ipts, frac_nobio_start(ipts,1): ',ipts, frac_nobio_start(ipts,1)
+             WRITE(numout,*) 'ipts, frac_nobio_end(ipts,1): ',ipts, frac_nobio_end(ipts,1)
+             CALL ipslerr (2,'land_cover_main', 'nbio fraction error.',&
+                  'Check output file for details.','')
+          ENDIF
+
+       ENDIF
+    ENDDO
+    !
+
+    IF (printlev.GE.4) WRITE(numout,*) 'Leaving land_cover_change_main'
+
+  END SUBROUTINE land_cover_change_main
+
+! ================================================================================================================================
+!! SUBROUTINE   : age_class_distr
+!!
+!>\BRIEF        Redistribute biomass, litter, soilcarbon and water across
+!!              the age classes
+!!
+!! DESCRIPTION  : Following growth, the trees from an age class may have become
+!! too big to belong to this age class. The biomass, litter, soilcarbon and
+!! soil water then need to be moved from one age class to the next age class.
+!!
+!! RECENT CHANGE(S) : 
+!!
+!! MAIN OUTPUT VARIABLE(S) :  
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+  
+  SUBROUTINE age_class_distr(npts, circ_class_n, circ_class_biomass, &
+       veget_cov_max, circ_class_dist, wstress_season, &
+       lm_lastyearmax, age, leaf_frac, atm_to_bm, &
+       everywhere, litter, som, lignin_struc, &
+       lignin_wood, bm_to_litter, turnover_daily,PFTpresent, when_growthinit,&
+       forest_managed, KF, plant_status, &
+       npp_longterm, gpp_daily, leaf_age, lab_fac, &
+       gdd_from_growthinit, gdd_midwinter, time_hum_min, &
+       hum_min_dormance, gdd_m5_dormance, ncd_dormance, &
+       moiavail_month, moiavail_week, ngd_minus5, &
+       resp_maint, resp_growth, npp_daily, &
+       use_reserve, rue_longterm, mai, pai, &
+       mai_count, previous_wood_volume, moiavail_growingseason, &
+       MatrixA, MatrixV, VectorB, VectorU, age_stand, last_cut, &
+       k_latosa_adapt, fm_change_map, lpft_replant, cn_leaf_min_season,&
+       nstress_season, soil_n_min, p_O2, bact, store_sum_delta_ba,&
+       CN_som_litter_longterm,nbp_pool_start )
+
+    IMPLICIT NONE
+    
+  !! 0. Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                :: npts                !! Domain size - number of pixels (unitless)
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: circ_class_dist     !! The probability distribution of trees in a circ
+                                                                              !! class in case of a redistribution (unitless).
+    INTEGER(i_std), DIMENSION(:,:), INTENT(in)         :: fm_change_map       !! A map which gives the desired FM strategy when
+                                                                              !! the PFT will be replanted after a clearcut.
+                                                                              !! (1-nvm,unitless)
+  LOGICAL, DIMENSION(npts,nvm), INTENT(in)             :: lpft_replant        !! Set to true if a PFT has been clearcut
+                                                                               !! and needs to be replaced by another species
+
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+
+    LOGICAL, DIMENSION(:,:), INTENT(inout)             :: PFTpresent          !! Tab indicating which PFTs are present in 
+                                                                              !! each pixel
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: plant_status        !! Growth and phenological status of the plant
+                                                                              !! istatus = Phases defined in constantes
+    INTEGER(i_std), DIMENSION (:,:), INTENT(inout)     :: forest_managed      !! forest management flag (is the forest 
+                                                                              !! being managed?)
+     REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: moiavail_month      !! "Monthly" moisture availability (0 to 1, 
+                                                                              !! unitless) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: moiavail_week       !! "Weekly" moisture availability 
+                                                                              !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ngd_minus5          !! Number of growing days (days), threshold 
+                                                                              !! -5 deg C (for phenology)   
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_maint          !! Maintenance respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_growth         !! Growth respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: npp_daily           !! Net primary productivity 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: use_reserve         !! Mass taken from carbohydrate reserve 
+                                                                              !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: rue_longterm        !! Longterm radiation use efficiency 
+                                                                              !! (??units??) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: when_growthinit     !! How many days ago was the beginning of 
+                                                                              !! the growing season (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: lab_fac             !! Activity of labile pool factor (??units??)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: KF                  !! Scaling factor to convert sapwood mass
+                                                                              !! into leaf mass (m)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: k_latosa_adapt      !! Leaf to sapwood area adapted for long 
+                                                                              !! term water stress (m)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: npp_longterm        !! "Long term" mean yearly primary productivity
+                                                                              !! @tex $(m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: veget_cov_max           !! "maximal" coverage fraction of a PFT on the ground
+                                                                              !! May sum to
+                                                                              !! less than unity if the pixel has
+                                                                              !! nobio area. (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: wstress_season      !! Water stress factor, based on hum_rel_daily
+                                                                              !! (unitless, 0-1)   
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: lm_lastyearmax      !! last year's maximum leaf mass for each PFT 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: everywhere          !! is the PFT everywhere in the grid box or 
+                                                                              !! very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: age                 !! mean age (years)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: atm_to_bm           !! CO2 and N taken from the atmosphere to get C to create  
+                                                                              !! the seedlings @tex (gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gpp_daily           !! Daily gross primary productivity  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: time_hum_min        !! Time elapsed since strongest moisture 
+                                                                              !! availability (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)    :: hum_min_dormance    !! minimum moisture during dormance 
+                                                                              !! (0-1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_midwinter       !! Growing degree days (K), since midwinter 
+                                                                              !! (for phenology) - this is written to the
+                                                                              !!  history files 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_from_growthinit !! growing degree days, since growthinit 
+                                                                              !! for crops
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_m5_dormance     !! Growing degree days (K), threshold -5 deg 
+                                                                              !! C (for phenology)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ncd_dormance        !! Number of chilling days (days), since 
+                                                                              !! leaves were lost (for phenology) 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: circ_class_n        !! Number of individuals in each circ class
+                                                                              !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: lignin_struc        !! ratio Lignine/Carbon in structural litter,
+                                                                              !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: lignin_wood         !! ratio Lignine/Carbon in woody litter,
+                                                                              !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: som                 !! carbon pool: active, slow, or passive 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: leaf_frac           !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: leaf_age            !! Leaf age (days)
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: bm_to_litter        !! Transfer of biomass to litter 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: turnover_daily        !! Transfer of litter to som 
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)   :: circ_class_biomass  !! Biomass components of the model tree within a 
+                                                                              !! circumference class
+                                                                              !! class @tex $(g C ind^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)   :: litter              !! metabolic and structural litter, above and 
+                                                                              !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: mai                 !! The mean annual increment
+                                                                              !! @tex $(m**3 / m**2 / year)$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: pai                 !! The period annual increment
+                                                                              !! @tex $(m**3 / m**2 / year)$ @endtex          
+    INTEGER(i_std), DIMENSION(:,:),INTENT(inout)       :: mai_count           !! The number of times we've
+                                                                              !! calculated the volume increment
+                                                                              !! for a stand 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: previous_wood_volume!! The volume of the tree trunks
+                                                                              !! in a stand for the previous year.
+                                                                              !! @tex $(m**3 / m**2 )$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: moiavail_growingseason  !! Mean growingseason moisture 
+                                                                              !! availability (0 to 1, unitless)
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: MatrixA             !! Matrix containing the fluxes between the
+                                                                              !! carbon pools per sechiba time step 
+                                                                              !! @tex $(gC.m^2.day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: VectorB             !! Vector containing the litter increase per
+                                                                              !! sechiba time step
+                                                                              !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: MatrixV             !!
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: VectorU             !!
+    INTEGER(i_std), DIMENSION(:,:), INTENT(inout)      :: age_stand           !! Age of the forest stand (years)  
+    INTEGER(i_std), DIMENSION(:,:), INTENT(inout)      :: last_cut            !! Years since last thinning (years)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: cn_leaf_min_season  !! Seasonal min CN ratio of leaves 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: nstress_season      !! N-related seasonal stress (used for allocation) 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: soil_n_min          !! mineral nitrogen in the soil (gN/m**2)  
+                                                                              !! (first index=npts, second index=nvm, third index=nnspec) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: p_O2                !! partial pressure of oxygen in the soil (hPa)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: bact                !! denitrifier biomass (gC/m**2)
+    REAL(r_std), DIMENSION(:,:,:),INTENT(inout)        :: CN_som_litter_longterm !! Longterm CN ratio of litter and som pools (gC/gN)
+    REAL(r_std), DIMENSION(:,:),INTENT(inout)          :: nbp_pool_start
+ 
+    !! 0.4 Local variables
+
+    ! +++CHECK+++
+    ! Externalize
+     REAL(r_std), DIMENSION(nagec)                     :: age_class_bound     !! Boundaries of the age classes (m)
+    ! +++++++++++
+     
+    INTEGER(i_std)                                     :: ipts,ivm,igroup     !! Indeces(unitless)
+    INTEGER(i_std)                                     :: iele,ipar,ipft      !! Indeces(unitless)
+    INTEGER(i_std)                                     :: iagec,imbc,icir     !! Indeces(unitless)
+    INTEGER(i_std)                                     :: ilit,ilev,icarb     !! Indeces(unitless)
+    INTEGER(i_std)                                     :: ivma,ispec          !! Indeces(unitless)
+    INTEGER(i_std)                                     :: old_pft             !! pft number before merge
+    INTEGER(i_std)                                     :: new_pft             !! pft number to merge with
+    REAL(r_std)                                        :: share_expanded      !! Share of the veget_cov_max of the existing vegetation
+                                                                              !! within a PFT over the total veget_cov_max following 
+                                                                              !! expansion of that PFT (unitless, 0-1)
+    REAL(r_std), DIMENSION(ncirc)                      :: circ_class_ba       !! basal area of the model tree in each
+                                                                              !! circ class @tex $(m^{2} m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)             :: store_sum_delta_ba  !! Sum of basal area increment (m^2)
+    REAL(r_std), DIMENSION(npts,nvm)                   :: qm_dia              !! Quadratic mean diameter of the stand (m)
+    REAL(r_std), DIMENSION(ncirc)                      :: est_circ_class_n    !! Temporary variable for circ_class_n of the 
+                                                                              !! established vegetation 
+                                                                              !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                      :: tmp_circ_class_n    !! Temporary variable for circ_class_n of the 
+                                                                              !! established vegetation 
+                                                                              !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc,nparts,nelements)     :: est_circ_class_biomass !! Temporary variable for circ_class_biomass 
+                                                                              !! of the established vegetation 
+                                                                              !! @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc,nparts,nelements)     :: tmp_circ_class_biomass !! Temporary variable for circ_class_biomass 
+                                                                              !! of the established vegetation
+                                                                              !! @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                      :: est_circ_class_dia  !! Variable to store temporary values for 
+                                                                              !! circ_class (m)
+    REAL(r_std), DIMENSION(ncirc)                      :: tmp_circ_class_dia  !! Variable to store temporary values for 
+                                                                              !! circ_class (m)
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements) :: check_intern        !! Contains the components of the internal
+                                                                              !! mass balance chech for this routine
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)         :: closure_intern      !! Check closure of internal mass balance
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)         :: pool_start          !! Start and end pool of this routine 
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)         :: pool_end            !! Start and end pool of this routine 
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nelements)                  :: temp_start          !! Start and end pool of this routine 
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nelements)                  :: temp_end            !! Start and end pool of this routine 
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nlitt,nlevs)                :: litter_weight_expanded !! The fraction of litter on the expanded
+                                                                              !! PFT. @tex $-$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                   :: veget_cov_max_begin     !! Temporairy variable to check area conservation
+
+!_ ================================================================================================================================
+  
+    IF (printlev.GE.3) WRITE(numout,*) 'Entering age class distribution'
+
+ !! 1. Initialize
+    
+    !! 1.1 Initialize local printlev
+    !printlev_loc=get_printlev('age_class_distr')
+
+    !! 1.1 Initialize variables
+    !+++CHECK++++
+    !Externalize
+    IF(nagec == 4)THEN
+       age_class_bound(1) = 0.07
+       age_class_bound(2) = 0.20
+       age_class_bound(3) = 0.40
+       age_class_bound(4) = 5.
+    ELSEIF(nagec == 1)THEN
+       age_class_bound(1) = 5.0
+    ELSE
+       WRITE(numout,*) 'You need to externalize age_class_bound, or come up with a case '
+       WRITE(numout,*) 'for this number of age classes.'
+       WRITE(numout,*) 'nagec = ',nagec
+       CALL ipslerr_p (3,'age_class_distr', 'Redefine age class bounds','','')
+    ENDIF
+    !++++++++++++
+
+    !! 1.2 Initialize check for mass balance closure
+    !  The mass balance is calculated at the end of this routine
+    !  in section 3. Initial biomass and harvest pool all other
+    !  relevant pools were just set to zero.
+    IF (err_act.GT.1) THEN
+
+       check_intern(:,:,:,:) = zero
+       pool_start(:,:,:) = zero
+       DO iele = 1,nelements
+
+          ! atm_to_bm
+          pool_start(:,:,iele) = pool_start(:,:,iele) + &
+               atm_to_bm(:,:,iele)
+          
+          !  Initial biomass + bm_to_litter
+          DO ipar = 1,nparts
+
+             DO icir = 1,ncirc
+
+                ! Initial biomass pool
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                     circ_class_biomass(:,:,icir,ipar,iele) * &
+                     circ_class_n(:,:,icir) * veget_cov_max(:,:)
+
+             ENDDO
+
+             ! Add bm_to_litter to the initial biomass pool
+             pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                  ((bm_to_litter(:,:,ipar,iele)+ &
+                  turnover_daily(:,:,ipar,iele)) * veget_cov_max(:,:))
+
+          ENDDO
+
+          ! Litter pool (gC m-2) *  (m2 m-2) 
+          DO ilit = 1,nlitt
+             DO ilev = 1,nlevs
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                     litter(:,ilit,:,ilev,iele) * veget_cov_max(:,:)
+             ENDDO
+          ENDDO
+       
+          ! Soil carbon (gC m-2) *  (m2 m-2)
+          DO icarb = 1,ncarb
+             pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                  som(:,icarb,:,iele) * veget_cov_max(:,:)
+          ENDDO
+          
+          ! Denitrifying bacteria (only C)
+          pool_start(:,:,icarbon) = pool_start(:,:,icarbon) + &
+                  bact(:,:) * veget_cov_max(:,:)
+
+          ! Nitrogen only
+          DO ispec = 1,nnspec
+             pool_start(:,:,initrogen) = pool_start(:,:,initrogen) + &
+                  soil_n_min(:,:,ispec) * veget_cov_max(:,:)
+          ENDDO
+
+          
+
+       ENDDO
+
+       !! 1.3 Initialize check for area conservation
+       veget_cov_max_begin(:,:) = veget_cov_max(:,:)
+       
+    ENDIF ! err_act.GT.1
+
+
+ !! 2. Redistribute the biomass across the age classes
+
+    !  Following growth, the trees from an age class may have become too big to 
+    !  belong to this age class. The biomass, litter, soilcarbon and soil
+    !  water then need to be moved from one age class to the next age class.
+    DO ipts = 1,npts
+
+       ! The agec_group lets us know which PFTs belong in which age class groups.
+       !  I assume that the structure is linear, that is, if PFTs 16, 17, and 18 all
+       ! below to group 10, PFT 16 is the youngest, PFT 17 is the second-youngest, and
+       ! PFT 18 is the oldest (largest diameter).  I also assume that all PFTs in 
+       ! an age class are grouped together in the input file.  In the example above,
+       ! this means that PFT 19 cannot be in group 10 unless PFT 18 is also in group 10.       
+
+       ! This loops over all the PFTs that we have while ignoring age classes
+       DO ivma=1,nvmap
+
+          ! start_index is an array with nvmap values wich gives the pft number
+          ! of the youngest age class for the nvmap groups. Say we have 28 nvmap
+          ! but run with a total of 64 pfts because some of the 28 groups have
+          ! age class. then start_index will have 28 dimensions and the value of
+          ! start_index will vary between 1 and 64.
+          ivm=start_index(ivma)
+
+          ! If we only have a single age class for this
+          ! PFT, we can skip it. nagec_pft contains for each group either 1 
+          ! (no age classes) or the number of age classes.
+          IF(nagec_pft(ivma) .EQ. 1)CYCLE
+
+          ! Only forest PFTs have age classes
+          IF (is_tree(ivm)) THEN
+
+             !! 2.1 Check if the trees still belong to this age class
+             !  Note that the term age class is used but that the classes used in the
+             !  code are not defined on an age criterion. Instead a diameter criterion
+             !  is used. The reason to do so is that growth depends on the rule of
+             !  Deleuze and Dhote that in turn is based on basal area. More stable
+             !  model behaviour is therefore expected when the diameter range within an
+             !  age class is controlled. Also different PFTs grow at different speeds.
+             !  If age would have been used to define the classes, the diameter range
+             !  within the first age class would have been much larger in the 
+             !  tropics compared to the boreal zone. When Deleuze and Dhote is then
+             !  applied the model could start to behave differently in the tropics and
+             !  boreal zone. These differences in behaviour are thought to be better 
+             !  controlled by implementing a diameter criterion.
+             !  As a reminder age classes (::nagec) control the diameter/height
+             !  variation across stands, ::ncirc controls the diameter/height variation
+             !  within a stand
+             DO iagec = nagec_pft(ivma),1,-1
+
+                ipft = ivm+iagec-1
+
+                ! If there are no trees, there is no need to merge
+                IF (veget_cov_max(ipts,ipft).LT.min_stomate) CYCLE
+
+                !! 2.1.1 Basal area at the tree level (m2 tree-1)
+                circ_class_ba(:) = &
+                     wood_to_ba(circ_class_biomass(ipts,ipft,:,:,icarbon),ipft)
+
+                ! Convert basal area in quadratic mean stand diameter (m)
+                IF (SUM(circ_class_n(ipts,ipft,:)) .NE. zero) THEN
+
+                   qm_dia(ipts,ipft) = SQRT( 4/pi * SUM(circ_class_ba(:) * &
+                        circ_class_n(ipts,ipft,:)) / &
+                        SUM(circ_class_n(ipts,ipft,:)) )
+
+                ELSE
+
+                   qm_dia(ipts,ipft) = zero
+
+                ENDIF
+
+                !! 2.2.2 Check whether quadratic mean diameter exceeds boundaries 
+                !  Check whether quadratic mean diameter exceeds boundaries of
+                !  the age class.
+
+                !Debug
+                IF(printlev_loc>=4)THEN
+                   WRITE(numout,*) 'Checking to merge for: '
+                   WRITE(numout,*) 'ipft,ivm,iagec,ipts: ',ipft,ivm,iagec,ipts
+                   WRITE(numout,*) 'nagec_pft,qm_dia,age_class_bound: ',nagec_pft(ivma),&
+                        qm_dia(ipts,ipft),age_class_bound(iagec)
+                ENDIF
+                !-
+                
+                ! If we flagged a species to be replanted the biomass
+                ! pools of both the new and the old pft can be empty.
+                ! Redistributing empty pools doesn't make too much sense.
+                ! Replanting is taken care of in species_change.
+                IF(.NOT.lpft_replant(ipts,ipft))THEN
+
+                   ! Debug
+                   IF(printlev_loc>=4) WRITE(numout,*) 'Ready to redistribute'
+                   !-
+
+                   IF ( (iagec .EQ. nagec_pft(ivma)) .AND. &
+                        qm_dia(ipts,ipft) .GT. age_class_bound(iagec) ) THEN
+                      
+                      ! If these conditions are satisfied our tree diameter is
+                      ! very unrealist
+                      WRITE(numout,*) 'WARNING: tree diameter exceeds (m): ', &
+                           age_class_bound(iagec)
+                      CALL ipslerr_p (3,'ERROR: age_class_distr',&
+                           'tree diameter exceeds the threshold','','')
+
+                      old_pft = ipft
+                      new_pft = ipft
+  
+                   ELSEIF ( (iagec .NE. nagec_pft(ivma)) .AND. &
+                        qm_dia(ipts,ipft) .GT. age_class_bound(iagec) ) THEN
+                   
+                      ! If this condition is satisfied, the trees are too
+                      ! big for the current age class. They will be moved
+                      ! one age class up
+                      old_pft = ipft
+                      new_pft = ipft+1
+
+                   ELSEIF ( (iagec .NE. start_index(ivma)) .AND. &
+                        qm_dia(ipts,ipft) .LT. age_class_bound(1) ) THEN
+
+                      ! If this condition is satisfied, the trees are too
+                      ! small for the current age class (after a harvest)
+                      ! and they will be moved to the first age class. We 
+                      ! don't want this to happen if we are in the first 
+                      ! age class.
+                      old_pft = ipft
+                      new_pft = start_index(ivma)
+                  
+                      ! Debug
+                      IF(printlev_loc>=4)THEN
+                         WRITE(numout,*) 'age classes going down'
+                         WRITE(numout,*) 'iagec, ipft, start_index, ', &
+                              iagec, ipft, start_index(ivma)
+                         WRITE(numout,*) 'qm_dia, ', qm_dia(ipts,ipft)
+                         WRITE(numout,*) 'age_class_bound, ', age_class_bound(1)
+                         WRITE(numout,*) 'old_pft, new_pft, ',old_pft, new_pft
+                      ENDIF
+                      !-
+
+                   ELSE
+
+                      ! There is no need to change the age class. Set 
+                      ! old and new pft to the same value. That way
+                      ! the next IF-loop is skipped.
+                      old_pft = zero
+                      new_pft = zero
+                      
+                   ENDIF ! age_class_bounds
+
+                ELSE
+
+                   ! lpft_replant is TRUE. Don't change the age class. 
+                   ! Set old and new pft to the same value. That way
+                   ! the next IF-loop is skipped.
+                   old_pft = zero
+                   new_pft = zero
+
+                ENDIF !lpft_replant
+
+                ! Debug
+                IF(printlev_loc>=4 .AND. old_pft .NE. new_pft)THEN
+                   WRITE(numout,*) 'Merging biomass'
+                   WRITE(numout,*) 'ipts,ipft,iagec: ',ipts,ipft,iagec
+                   WRITE(numout,*) 'age_class_bound(:): ',age_class_bound(:)
+                   WRITE(numout,*) 'qm_dia: ',qm_dia(ipts,ipft)
+                   WRITE(numout,*) 'old_pft, new_pft, ',old_pft, new_pft
+                ENDIF
+                !-
+
+                IF (old_pft .NE. new_pft) THEN
+
+                   !! 2.2.3 Merge biomass
+                   !  Biomass of two age classes needs to be merged. The established
+                   !  vegetation is stored in new_pft, the new vegetation is stored in
+                   !  old_pft
+                   share_expanded = veget_cov_max(ipts,new_pft) / &
+                        ( veget_cov_max(ipts,new_pft) + veget_cov_max(ipts,old_pft) )
+
+                   ! We also need a scaling factor which includes the litter
+                   DO ilev=1,nlevs
+
+                      DO ilit=1,nlitt
+
+                         IF(litter(ipts,ilit,old_pft,ilev,icarbon).GE.min_stomate) THEN
+
+                            ! There is C and N in the litter. Calculate a weighted
+                            ! mean
+                            litter_weight_expanded(ilit,ilev) = &
+                                 litter(ipts,ilit,new_pft,ilev,icarbon) * &
+                                 veget_cov_max(ipts,new_pft)/ &
+                                 (litter(ipts,ilit,new_pft,ilev,icarbon) * &
+                                 veget_cov_max(ipts,new_pft) + &
+                                 litter(ipts,ilit,old_pft,ilev,icarbon) * &
+                                 veget_cov_max(ipts,old_pft))
+
+                         ELSEIF (litter(ipts,ilit,old_pft,ilev,icarbon).LT.min_stomate) THEN
+
+                            ! The litter pools are empty
+                            litter_weight_expanded(ilit,ilev) = zero
+
+                         ELSE
+
+                            ! There is either no carbon or no nitrogen in the
+                            ! litter. This is strange as one should always come
+                            ! with the other.
+                            WRITE(numout,*) 'ERROR: age_class_distr'
+                            WRITE(numout,*) 'There is litter but the C/N ratio'
+                            WRITE(numout,*) 'does not make any sense'
+                            WRITE(numout,*) 'C in the litter', ipts, ilit, old_pft, ilev, &
+                                 litter(ipts,ilit,old_pft,ilev,icarbon)
+                            WRITE(numout,*) 'N in the litter', ipts, ilit, old_pft, ilev, &
+                                 litter(ipts,ilit,old_pft,ilev,initrogen)
+                            CALL ipslerr_p(3,'ERROR: age_class_distr',&
+                                 'There is litter but the C/N ratio',&
+                                 'does not make any sense','')
+
+                         ENDIF
+
+                      END DO !nlitt
+
+                   ENDDO ! nlevs
+     
+                   ! Assign value to moiavail_growingseason, this value needs to be 
+                   ! copied because it is only calculated when there is leaf mass present 
+                   moiavail_growingseason(ipts,new_pft) = &
+                        moiavail_growingseason(ipts,new_pft) * &
+                        share_expanded + moiavail_growingseason(ipts,old_pft) * &
+                        (un - share_expanded)
+
+                   ! I'm not sure if wstress_season needs to be 
+                   ! here since it is recalculated from
+                   ! moiavail_growingseason every day.
+                   wstress_season(ipts,new_pft) = wstress_season(ipts,new_pft) * &
+                          share_expanded + wstress_season(ipts,old_pft) * (un - share_expanded)
+
+                   ! Copy the number of individuals and the biomass of the established 
+                   ! vegetation to a temporary variable. In the subroutine ::circ_class_n
+                   ! and ::circ_class_biomass will be overwritten with the characteristics
+                   ! of the merged vegetation
+                   est_circ_class_n(:) = circ_class_n(ipts,new_pft,:)
+                   est_circ_class_biomass(:,:,:) = circ_class_biomass(ipts,new_pft,:,:,:)
+                   tmp_circ_class_n(:) = circ_class_n(ipts,old_pft,:)
+                   tmp_circ_class_biomass(:,:,:) = circ_class_biomass(ipts,old_pft,:,:,:)
+ 
+                   ! Store circumference (m) in a temporary variable that can be 
+                   ! sorted from small to large - note that the dimension of these
+                   ! variables are 2*ncirc
+                   est_circ_class_dia(:) = wood_to_dia(est_circ_class_biomass(:,:,icarbon),&
+                        new_pft)
+                   tmp_circ_class_dia(:) = wood_to_dia(tmp_circ_class_biomass(:,:,icarbon),&
+                        old_pft)
+
+
+                   ! Debug
+                   ! Initiliaze mass balance of the merging procedure
+                   ! MB was calculated outside the subroutine merge_biomass_pfts
+                   ! because veget_cov_max needs to be updated. Veget_max cannot be 
+                   ! updated in the subroutine because the way it is called from 
+                   ! the subroutine land_cover_change (where veget_cov_max can only be
+                   ! updated at the end of the whole subroutine. Therefore, this
+                   ! check was included here.
+                   IF (printlev_loc>=4) THEN
+                      temp_start(:) = zero
+                      DO ipar = 1,nparts
+                         DO iele = 1,nelements
+                            DO icir = 1,ncirc
+                               temp_start(iele) = temp_start(iele) + &
+                                    SUM(circ_class_biomass(ipts,:,icir,ipar,iele) * &
+                                    circ_class_n(ipts,:,icir) * veget_cov_max(ipts,:))
+                            ENDDO
+                         ENDDO
+                      ENDDO
+                      ! Some output - unrelated to the mass balance
+                      WRITE(numout,*) 'age distribution share_expanded, ',ipts, ivm, &
+                           share_expanded
+                      WRITE(numout,*) 'rest, ', SUM(circ_class_n(ipts,ivm,:)), &
+                           SUM(est_circ_class_n), SUM(tmp_circ_class_n), &
+                           SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),2),1), &
+                           SUM(est_circ_class_biomass), &
+                           SUM(tmp_circ_class_biomass), &
+                           ipts, new_pft, SUM(est_circ_class_dia), SUM(tmp_circ_class_dia), &
+                           lpft_replant(ipts,ivm)
+                      WRITE(numout,*) 'old_pft, new_pft, ',old_pft, new_pft
+                   ENDIF
+                   !-
+                   
+                   ! Merge the biomass of the two age classes
+                   CALL merge_biomass_pfts(npts, share_expanded, circ_class_n, &
+                        est_circ_class_n, tmp_circ_class_n, circ_class_biomass, &
+                        est_circ_class_biomass, &
+                        tmp_circ_class_biomass, circ_class_dist, ipts, &
+                        new_pft, est_circ_class_dia, tmp_circ_class_dia)
+
+                   !! 2.2.4 Empty the age class that was merged and update veget_cov_max
+                   circ_class_n(ipts,old_pft,:) = zero
+                   circ_class_biomass(ipts,old_pft,:,:,:) = zero
+                   veget_cov_max(ipts,new_pft) = veget_cov_max(ipts,new_pft) + &
+                        veget_cov_max(ipts,old_pft)
+                   veget_cov_max(ipts,old_pft) = zero
+
+                   ! Debug
+                   IF (printlev_loc>=4) THEN
+                      ! Mass balance of the merging procedure
+                      temp_end(:) = zero
+                      DO ipar = 1,nparts
+                         DO iele = 1,nelements
+                            DO icir = 1,ncirc
+                               temp_end(iele) = temp_end(iele) + &
+                                    SUM(circ_class_biomass(ipts,:,icir,ipar,iele) * &
+                                    circ_class_n(ipts,:,icir) * veget_cov_max(ipts,:))
+                            ENDDO
+                         ENDDO
+                      ENDDO
+ 
+                      DO iele = 1,nelements
+                         IF (temp_end(iele) - temp_start(iele) .LT. min_stomate .AND. &
+                              temp_end(iele) - temp_start(iele) .GT. -min_stomate) THEN
+                            WRITE(numout,*) 'Mass balance closure merge_biomass_pfts', iele
+                         ELSE
+                            WRITE(numout,*) 'Error: mass balance is not closed in merge_biomass_pfts'
+                            WRITE(numout,*) '   Difference is, ',iele, temp_end(iele) - &
+                                 temp_start(iele), temp_end(iele), &
+                                 temp_start(iele) 
+                            WRITE(numout,*) 'carbon ', &
+                                 SUM(SUM(circ_class_biomass(ipts,:,:,:,icarbon),3),2)
+                            WRITE(numout,*) 'nitrogen ', &
+                                 SUM(SUM(circ_class_biomass(ipts,:,:,:,initrogen),3),2)
+                            WRITE(numout,*) 'veget_cov_max, ',veget_cov_max(ipts,:)
+                            IF (err_act.GT.1) THEN
+                               CALL ipslerr_p(3,'ERROR:mass balance not closed',&
+                                    'after merge biomass in age_class_distr','','')
+                            ENDIF
+                         ENDIF
+                      ENDDO !nelements
+                   ENDIF
+                   !-
+
+                   !! 2.3 Calculate the PFT characteristics of the merged PFT
+                   !  Take the weighted mean of the existing vegetation and the new 
+                   !  vegetation in this PFT. Note that atm_to_bm is in gC. m-2 dt-1 
+                   !  so we should also take the weighted mean (rather than the sum if
+                   !  this where absolute values).
+                   lm_lastyearmax(ipts,new_pft) = share_expanded * &
+                        lm_lastyearmax(ipts,new_pft) + &
+                        (un - share_expanded) * lm_lastyearmax(ipts,old_pft)
+                   lm_lastyearmax(ipts,old_pft) = zero
+                   age(ipts,new_pft) = share_expanded * age(ipts,new_pft) + &
+                        (un - share_expanded) * age(ipts,old_pft)
+                   age(ipts,old_pft) = zero
+                   leaf_frac(ipts,new_pft,:) = share_expanded * leaf_frac(ipts,new_pft,:) + &
+                        (un - share_expanded) * leaf_frac(ipts,old_pft,:)
+                   leaf_frac(ipts,old_pft,:) = zero
+                   leaf_age(ipts,new_pft,:) = share_expanded * leaf_age(ipts,new_pft,:) + &
+                        (un - share_expanded) * leaf_age(ipts,old_pft,:)
+                   leaf_age(ipts,old_pft,:) = zero
+                   lab_fac(ipts,new_pft) = share_expanded * lab_fac(ipts,new_pft) + &
+                        (un - share_expanded) * lab_fac(ipts,old_pft)
+                   lab_fac(ipts,old_pft) = zero
+                   atm_to_bm(ipts,new_pft,:) = share_expanded * atm_to_bm(ipts,new_pft,:) + &
+                        (un - share_expanded) * atm_to_bm(ipts,old_pft,:)
+                   atm_to_bm(ipts,old_pft,:) = zero
+                   everywhere(ipts,new_pft) = MAX(everywhere(ipts,old_pft), &
+                        everywhere(ipts,new_pft))
+                   everywhere(ipts,old_pft) = zero
+                   nstress_season(ipts,new_pft) = share_expanded * &
+                        nstress_season(ipts,new_pft) + &
+                        (un - share_expanded) * nstress_season(ipts,old_pft)
+                   nstress_season(ipts,old_pft) = zero
+                   cn_leaf_min_season(ipts,new_pft) = share_expanded * &
+                        cn_leaf_min_season(ipts,new_pft) + &
+                        (un - share_expanded) * cn_leaf_min_season(ipts,old_pft)
+                   cn_leaf_min_season(ipts,old_pft) = zero
+
+                   ! The new soil&litter pools are the weighted mean of the newly 
+                   ! established vegetation for that PFT and the soil&litter pools
+                   ! of the vegetation that already exists in that PFT.
+                   ! Since it is not only the amount of vegetation present (veget_cov_max) but also
+                   ! the amount of structural litter (litter) that is important, we have to 
+                   ! weight by both items here.
+                   DO ilev=1,nlevs
+                      lignin_struc(ipts,new_pft,ilev) = &
+                           litter_weight_expanded(istructural,ilev) * &
+                           lignin_struc(ipts,new_pft,ilev) + &
+                           (un - litter_weight_expanded(istructural,ilev)) * &
+                           lignin_struc(ipts,old_pft,ilev) 
+                      lignin_struc(ipts,old_pft,ilev) = zero
+                      lignin_wood(ipts,new_pft,ilev) = &
+                           litter_weight_expanded(iwoody,ilev) * &
+                           lignin_wood(ipts,new_pft,ilev) + &
+                           (un - litter_weight_expanded(iwoody,ilev) ) * &
+                           lignin_wood(ipts,old_pft,ilev) 
+                      lignin_wood(ipts,old_pft,ilev) = zero 
+                   ENDDO
+                   
+                   litter(ipts,:,new_pft,:,:) = share_expanded * litter(ipts,:,new_pft,:,:) + &
+                        (un - share_expanded) * litter(ipts,:,old_pft,:,:)
+                   litter(ipts,:,old_pft,:,:) = zero
+                   som(ipts,:,new_pft,:) =  share_expanded * som(ipts,:,new_pft,:) + &
+                        (un - share_expanded) * som(ipts,:,old_pft,:)
+                   som(ipts,:,old_pft,:) = zero 
+                   bm_to_litter(ipts,new_pft,:,:) = share_expanded * &
+                        bm_to_litter(ipts,new_pft,:,:) + & 
+                        (un - share_expanded) * bm_to_litter(ipts,old_pft,:,:)
+                   bm_to_litter(ipts,old_pft,:,:) = zero
+                   turnover_daily(ipts,new_pft,:,:) = share_expanded * &
+                        turnover_daily(ipts,new_pft,:,:) + &
+                        (un - share_expanded) * turnover_daily(ipts,old_pft,:,:)
+                   turnover_daily(ipts,old_pft,:,:) = zero
+                   soil_n_min(ipts,new_pft,:) = share_expanded * &
+                        soil_n_min(ipts,new_pft,:) + & 
+                        (un - share_expanded) * soil_n_min(ipts,old_pft,:)
+                   soil_n_min(ipts,old_pft,:) = zero
+                   p_O2(ipts,new_pft) = share_expanded * p_O2(ipts,new_pft) + & 
+                        (un - share_expanded) * p_O2(ipts,old_pft)
+                   p_O2(ipts,old_pft) = zero
+                   bact(ipts,new_pft) = share_expanded * bact(ipts,new_pft) + & 
+                        (un - share_expanded) * bact(ipts,old_pft)
+                   bact(ipts,old_pft) = zero
+                   CN_som_litter_longterm(ipts,new_pft,:) = &
+                        share_expanded * CN_som_litter_longterm(ipts,new_pft,:) + &
+                        (un - share_expanded) * CN_som_litter_longterm(ipts,old_pft,:)
+                   CN_som_litter_longterm(ipts,old_pft,:) = zero
+                   nbp_pool_start(ipts,new_pft) = &
+                        share_expanded * nbp_pool_start(ipts,new_pft)+ &
+                        (un - share_expanded) *nbp_pool_start(ipts,old_pft)
+                   nbp_pool_start(ipts,old_pft) = zero
+
+
+
+                   ! Copy variables that depend on ::when_growthinit
+                   when_growthinit(ipts,new_pft) = share_expanded * &
+                        when_growthinit(ipts,new_pft) + &
+                        (un - share_expanded) * when_growthinit(ipts,old_pft)
+                   when_growthinit(ipts,old_pft) = zero
+                   gdd_from_growthinit(ipts,new_pft) = share_expanded * &
+                        gdd_from_growthinit(ipts,new_pft) + &
+                        (un - share_expanded) * gdd_from_growthinit(ipts,old_pft)
+                   gdd_from_growthinit(ipts,old_pft) = zero
+                   gdd_midwinter(ipts,new_pft) = share_expanded * &
+                        gdd_midwinter(ipts,new_pft) + &
+                        (un - share_expanded) * gdd_midwinter(ipts,old_pft)
+                   gdd_midwinter(ipts,old_pft) = zero
+                   time_hum_min(ipts,new_pft) = share_expanded * time_hum_min(ipts,new_pft) + &
+                        (un - share_expanded) * time_hum_min(ipts,old_pft)
+                   time_hum_min(ipts,old_pft) = zero
+                   hum_min_dormance(ipts,new_pft) = share_expanded * hum_min_dormance(ipts,new_pft) + &
+                        (un - share_expanded) * hum_min_dormance(ipts,old_pft)
+                   hum_min_dormance(ipts,old_pft) = zero
+                   gdd_m5_dormance(ipts,new_pft) = share_expanded * &
+                        gdd_m5_dormance(ipts,new_pft) + &
+                        (un - share_expanded) * gdd_m5_dormance(ipts,old_pft)
+                   gdd_m5_dormance(ipts,old_pft) = zero
+                   ncd_dormance(ipts,new_pft) = share_expanded * &
+                        ncd_dormance(ipts,new_pft) + &
+                        (un - share_expanded) * ncd_dormance(ipts,old_pft)
+                   ncd_dormance(ipts,old_pft) = zero
+                   moiavail_month(ipts,new_pft) = share_expanded * & 
+                        moiavail_month(ipts,new_pft) + &
+                        (un - share_expanded) * moiavail_month(ipts,old_pft)
+                   moiavail_month(ipts,old_pft) = zero
+                   moiavail_week(ipts,new_pft) = share_expanded * &
+                        moiavail_week(ipts,new_pft) + &
+                        (un - share_expanded) * moiavail_week(ipts,old_pft)
+                   moiavail_week(ipts,old_pft) = zero
+                   ngd_minus5(ipts,new_pft) = share_expanded * ngd_minus5(ipts,new_pft) + &
+                        (un - share_expanded) * ngd_minus5(ipts,old_pft)
+                   ngd_minus5(ipts,old_pft) = zero
+
+                   ! When merging age classes and accounting for management 
+                   ! changes, the merged pft is managed the same way as the new
+                   ! pft. If not, prescribed changes in forest management (as 
+                   ! part of the species change code) would not be consistently
+                   ! implemented. However, when simply merging age classes without
+                   ! species/management changes a conservative approach is
+                   ! taken and the forest management strategy of the oldest age
+                   ! class in the merge is used. 
+                   IF(ok_change_species)THEN
+
+                      ! If the old and new pft have a different management 
+                      ! strategy we will have to decide which strategy we 
+                      ! follow
+                      IF (forest_managed(ipts,new_pft) .NE. &
+                           forest_managed(ipts,old_pft)) THEN
+                         
+                         IF ((forest_managed(ipts,new_pft).EQ.ifm_none) .OR. &
+                              (forest_managed(ipts,old_pft)).EQ.ifm_none) THEN
+
+                            ! We assume that unmanaged sites are well 
+                            ! protected. Actually they will even increase
+                            ! in surface area even if the desired fm
+                            ! strategy is not ifm_none.
+                            forest_managed(ipts,new_pft) = ifm_none 
+                            forest_managed(ipts,old_pft) = ifm_none
+
+                         ELSE
+                            
+                            ! If the new old fm type are not equal we will 
+                            ! use the new prescribed forest management as prepared
+                            ! in fm_change_map. This should ensure that we can
+                            ! get the old management back.
+                            forest_managed(ipts,new_pft) = fm_change_map(ipts,new_pft) 
+                            forest_managed(ipts,old_pft) = forest_managed(ipts,old_pft)
+
+                            ! Debug
+                            IF(printlev_loc>=4)THEN
+                               WRITE(numout,*) 'species change - age class distr'
+                               WRITE(numout,*) 'fm - old PFT, ',old_pft, &
+                                    forest_managed(ipts,old_pft)
+                               WRITE(numout,*) 'fm - new PFT, ',new_pft, &
+                                    fm_change_map(ipts,new_pft)
+                            ENDIF
+                            !-
+                            
+                         ENDIF
+                         
+                      ELSE
+                         
+                         ! fm type for the new and old PFT are the same so nothing
+                         ! should be done. The code was written to make it explicit
+                         forest_managed(ipts,new_pft) = forest_managed(ipts,new_pft)
+                         forest_managed(ipts,old_pft) = forest_managed(ipts,old_pft)
+
+                      ENDIF
+
+                    
+                   ELSE ! no species change 
+
+                      ! Preserve the prescribed forest management.
+                      ! Do nothing but the code was written to make it explicit
+                      forest_managed(ipts,new_pft) = forest_managed(ipts,new_pft)
+                      forest_managed(ipts,old_pft) = forest_managed(ipts,old_pft)
+
+                   END IF ! species change (through replant)?
+                   
+                   ! Copy remaining properties 
+                   PFTpresent(ipts,new_pft) = PFTpresent(ipts,old_pft)
+                   PFTpresent(ipts,old_pft) = .FALSE.
+                   KF(ipts,new_pft) = share_expanded * KF(ipts,new_pft) + &
+                        (un - share_expanded) * KF(ipts,old_pft)
+                   KF(ipts,old_pft) = zero
+                   k_latosa_adapt(ipts,new_pft) = share_expanded * &
+                        k_latosa_adapt(ipts,new_pft) + &
+                        (un - share_expanded) * k_latosa_adapt(ipts,old_pft)
+                   k_latosa_adapt(ipts,old_pft) = zero
+                   plant_status(ipts,new_pft) = plant_status(ipts,old_pft)
+                   plant_status(ipts,old_pft) = iprescribe
+                   npp_longterm(ipts,new_pft) = share_expanded * npp_longterm(ipts,new_pft) + &
+                        (un - share_expanded) * npp_longterm(ipts,old_pft)
+                   npp_longterm(ipts,old_pft) = zero
+                   gpp_daily(ipts,new_pft) = share_expanded * gpp_daily(ipts,new_pft) + &
+                        (un - share_expanded) * gpp_daily(ipts,old_pft)
+                   gpp_daily(ipts,old_pft) = zero 
+                   resp_maint(ipts,new_pft) = share_expanded * resp_maint(ipts,new_pft) + &
+                        (un - share_expanded) * resp_maint(ipts,old_pft) 
+                   resp_maint(ipts,old_pft) = zero
+                   resp_growth(ipts,new_pft) = share_expanded * resp_growth(ipts,new_pft) + &
+                        (un - share_expanded) * resp_growth(ipts,old_pft) 
+                   resp_growth(ipts,old_pft) = zero
+                   npp_daily(ipts,new_pft) = share_expanded * npp_daily(ipts,new_pft) + &
+                        (un - share_expanded) * npp_daily(ipts,old_pft) 
+                   npp_daily(ipts,old_pft) = zero
+                   use_reserve(ipts,new_pft) = share_expanded * use_reserve(ipts,new_pft) + &
+                        (un - share_expanded) * use_reserve(ipts,old_pft) 
+                   use_reserve(ipts,old_pft) = zero
+                   rue_longterm(ipts,new_pft)  = share_expanded * rue_longterm(ipts,new_pft) + &
+                        (un - share_expanded) * rue_longterm(ipts,old_pft)
+                   rue_longterm(ipts,old_pft) = zero
+                   DO icir=1,ncirc
+                        store_sum_delta_ba(ipts,new_pft,icir) = & 
+                                share_expanded * store_sum_delta_ba(ipts,new_pft,icir) + &
+                                (un - share_expanded) * store_sum_delta_ba(ipts,old_pft,icir)
+                   ENDDO
+
+                   ! Some things for forestry
+                   mai(ipts,new_pft)  = share_expanded * mai(ipts,new_pft) + &
+                        (un - share_expanded) * mai(ipts,old_pft)
+                   mai(ipts,old_pft) = zero
+                   pai(ipts,new_pft)  = share_expanded * pai(ipts,new_pft) + &
+                        (un - share_expanded) * pai(ipts,old_pft)
+                   pai(ipts,old_pft) = zero
+
+                   ! We need an integer for mai_count.  The use of CEILING here is
+                   ! arbitrary.  Maybe FLOOR would work better in some cases.
+                   mai_count(ipts,new_pft)  = CEILING(share_expanded * &
+                        mai_count(ipts,new_pft) + &
+                        (un - share_expanded) * mai_count(ipts,old_pft))
+                   mai_count(ipts,old_pft) = 0
+                   previous_wood_volume(ipts,new_pft)  = share_expanded * &
+                        previous_wood_volume(ipts,new_pft) + &
+                        (un - share_expanded) * previous_wood_volume(ipts,old_pft)
+                   previous_wood_volume(ipts,old_pft) = zero
+                   
+                   ! These next two variables are integers, so we use CEILING to make sure
+                   ! they stay integers.  FLOOR or INT would also be fine.  The use of
+                   ! CEILING is arbitrary.
+                   age_stand(ipts,new_pft)  = CEILING(share_expanded * &
+                        age_stand(ipts,new_pft) + &
+                        (un - share_expanded) * age_stand(ipts,old_pft))
+                   age_stand(ipts,old_pft) = zero
+                   last_cut(ipts,new_pft)  = CEILING(share_expanded * last_cut(ipts,new_pft) + &
+                        (un - share_expanded) * last_cut(ipts,old_pft))
+                   last_cut(ipts,old_pft) = zero
+
+                   ! If we are doing an analytical spinup, we need to merge
+                   ! the matrices.  During our spinup, only one age class in a given
+                   ! PFT will be populated.  Therefore, we just need to move
+                   ! the matrix from one PFT to the next.  If there is a chance that
+                   ! there is already biomass in the new PFT and things need to be merged,
+                   ! you should rethink this!
+                   IF (spinup_analytic) THEN
+                      IF(share_expanded .LT. min_stomate)THEN
+                         MatrixV(ipts,new_pft,:,:)=MatrixV(ipts,old_pft,:,:)
+                         MatrixA(ipts,new_pft,:,:)=MatrixA(ipts,old_pft,:,:)
+                         VectorU(ipts,new_pft,:)=VectorU(ipts,old_pft,:)
+                         VectorB(ipts,new_pft,:)=VectorB(ipts,old_pft,:)
+                         MatrixV(ipts,old_pft,:,:)=zero
+                         MatrixA(ipts,old_pft,:,:)=zero
+                         VectorU(ipts,old_pft,:)=zero
+                         VectorB(ipts,old_pft,:)=zero
+                      ELSE
+                         WRITE(numout,*) 'Merge problem with spinup.'
+                         WRITE(numout,*) 'ipts,ipft: ',ipts,old_pft
+                         WRITE(numout,*) 'share_expanded: ',share_expanded
+                         CALL ipslerr (3,'age_class_distr', &
+                              'Trying to merge spinup matrices into a PFT with existing',&
+                              'biomass. Stopping because we are not sure what to do.','')
+                      ENDIF
+                   ENDIF
+
+                ELSE
+
+                   ! Debug
+                   IF (printlev_loc>=4) WRITE(numout,*) 'old and new pft are the same'
+                   !-
+
+                ENDIF
+
+             ENDDO ! loop over nagec_pft(ivma)
+
+          ELSE ! Grasses and croplands
+
+             ! Don't have to do anything
+
+             ! Debug
+             IF (printlev_loc>=4) WRITE(numout,*) 'Grass or cropland ',&
+                  'no age classes', ivm
+             !-
+
+          ENDIF ! is_tree(ivm)
+
+       ENDDO ! Looping over real PFTs
+
+    ENDDO ! loop over #pixels - domain size
+
+
+!! 3. Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 4.2 Check surface area
+       CALL check_surface_area("age class distr", npts, veget_cov_max_begin, &
+            veget_cov_max,'ageclass')
+
+       ! 4.3 Mass balance closure 
+       pool_end = zero
+       DO iele = 1,nelements
+
+          ! atm_to_bm
+          pool_end(:,:,iele) = pool_end(:,:,iele) + &
+               atm_to_bm(:,:,iele)
+
+          ! Biomass pool + bm_to_litter
+          DO ipar = 1,nparts
+
+             DO icir = 1,ncirc
+
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                     circ_class_biomass(:,:,icir,ipar,iele) * &
+                     circ_class_n(:,:,icir) * veget_cov_max(:,:)
+
+             ENDDO
+
+             ! Add bm_to_litter to the biomass pool
+             pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                  ((bm_to_litter(:,:,ipar,iele)+ &
+                  turnover_daily(:,:,ipar,iele)) * veget_cov_max(:,:))
+
+          ENDDO
+          
+          ! Litter pool (gC m-2) *  (m2 m-2) 
+          DO ilit = 1,nlitt
+             DO ilev = 1,nlevs
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                     litter(:,ilit,:,ilev,iele) * veget_cov_max(:,:)
+             ENDDO
+          ENDDO
+
+          ! Soil carbon (gC m-2) *  (m2 m-2)
+          DO icarb = 1,ncarb
+             pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                  som(:,icarb,:,iele) * veget_cov_max(:,:)
+          ENDDO
+
+          ! Denitrifying bacteria (only C)
+          pool_end(:,:,icarbon) = pool_end(:,:,icarbon) + &
+                  bact(:,:) * veget_cov_max(:,:)
+
+          ! Nitrogen only
+          DO ispec = 1,nnspec
+             pool_end(:,:,initrogen) = pool_end(:,:,initrogen) + &
+                  soil_n_min(:,:,ispec) * veget_cov_max(:,:)
+          ENDDO
+
+       ENDDO
+       
+       ! 4.3.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(:,:,ipoolchange,iele) = -un * (pool_end(:,:,iele) - &
+               pool_start(:,:,iele)) 
+       ENDDO
+
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) &
+                   WRITE(numout,*) &
+                  'check_intern, ivm, imbc, iele, ', imbc, &
+                  iele, check_intern(:,test_pft,imbc,iele)
+             !-
+             closure_intern(:,:,iele) = closure_intern(:,:,iele) + &
+                  check_intern(:,:,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 4.3.3 Check mass balance closure
+       CALL check_mass_balance("age class distr", &
+            closure_intern, npts, pool_end, pool_start, veget_cov_max, &
+            'ageclass')
+      
+    ENDIF ! err_act.GT.1
+
+    IF(printlev.GE.4) WRITE(numout,*) 'Leaving age class distribution'
+    
+  END SUBROUTINE age_class_distr
+
+
+! ================================================================================================================================
+!! SUBROUTINE   : merge_biomass_pfts
+!!
+!>\BRIEF        Redistribute biomass, litter, soilcarbon and water across
+!!              the age classes
+!!
+!! DESCRIPTION  : Following growth, the trees from an age class may have too
+!! big to still belong to this age class. The biomass, litter, soilcarbon and
+!! soil water then need to be moved from one age class to the next age class.
+!!
+!! RECENT CHANGE(S) : 
+!!
+!! MAIN OUTPUT VARIABLE(S) :  
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE merge_biomass_pfts(npts, share_expanded, circ_class_n, est_circ_class_n, &
+       tmp_circ_class_n, circ_class_biomass, est_circ_class_biomass, &
+       tmp_circ_class_biomass, circ_class_dist, ipts, &
+       ivm, est_circ_class_dia, tmp_circ_class_dia)
+
+    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)                          :: share_expanded        !! Share of the veget_cov_max of the existing vegetation
+                                                                              !! within a PFT over the total veget_cov_max following 
+                                                                              !! expansion of that PFT (unitless, 0-1)
+    REAL(r_std), DIMENSION(:), INTENT(in)            :: circ_class_dist       !! The probability distribution of trees in a circ
+                                                                              !! class in case of a redistribution (unitless). 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)        :: est_circ_class_biomass!! Temporary variable for circ_class_biomass 
+                                                                              !! of the established vegetation
+                                                                              !! @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)        :: tmp_circ_class_biomass!! Temporary variable for circ_class_biomass 
+                                                                              !! of the new vegetation 
+                                                                              !! @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:), INTENT(in)            :: est_circ_class_n      !! Temporary variable for circ_class_n
+                                                                              !! of the established vegetation
+                                                                              !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:), INTENT(in)            :: tmp_circ_class_n      !! Temporary variable for circ_class_n
+                                                                              !! of the new vegetation
+                                                                              !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:), INTENT(in)            :: est_circ_class_dia    !! Variable to store temporary values for 
+                                                                              !! circ_class (m)
+    REAL(r_std), DIMENSION(:), INTENT(in)            :: tmp_circ_class_dia    !! Variable to store temporary values for 
+                                                                              !! circ_class (m)
+    INTEGER(i_std), INTENT(IN)                       :: ipts, ivm             !! Indices for point and PFT (unitless)
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: circ_class_biomass    !! circ_class_biomass of the merged vegetation 
+                                                                              !! @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: circ_class_n          !! circ_class_n of the merged vegetation
+                                                                              !! @tex $(ind m^{-2})$ @endtex
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                   :: ipart                 !! Indices (unitless)
+    INTEGER(i_std)                                   :: icir, jcir, iele      !! Indices (unitless)
+    REAL(r_std)                                      :: trees_needed          !! Number of trees leftthat should be present in a 
+                                                                              !! circumference class when merging the established
+                                                                              !! and newly established vegetation
+                                                                              !! @tex $(ind m^{-2})$ @endtex 
+    REAL(r_std)                                      :: tempa, tempb          !! Variable to store a temporary value (unit varies)
+    REAL(r_std), DIMENSION(nparts,nelements)         :: tempc                 !! Variable to store a temporary value of
+                                                                              !! circ_class_biomass  
+    REAL(r_std), DIMENSION(ncirc)                    :: exp_circ_class_n      !! Temporary variable for circ_class_n of the
+                                                                              !! expanded PFT @tex $(ind m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(2*ncirc)                  :: trees_left            !! Number of trees left in a circumference class when
+                                                                              !! merging the available and newly established 
+                                                                              !! vegetation @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(2*ncirc)                  :: temp_circ_class       !! Temporary variable for circ_class of the expanded
+                                                                              !! PFT for sorting the availble and newly established
+                                                                              !! circumference classes (m)
+    REAL(r_std), DIMENSION(2*ncirc)                  :: temp_circ_class_n     !! Temporary variable for circ_class_n of the expanded
+                                                                              !! PFT for sorting the availble and newly established
+                                                                              !! circumference classes @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(2*ncirc,nparts,nelements) :: temp_circ_class_biomass !! Temporary variable for sorting circ_class_biomass
+                                                                              !! @tex $(g C ind^{-1})$ @endtex
+
+!_ ================================================================================================================================
+
+ IF (printlev.GE.3) WRITE(numout,*) 'Entering merging biomass of pfts'
+
+ !! 1. Initialize
+
+ !! 2. Merge biomass, litter, soilcarbon and soil water
+
+    !  We have already ::ncirc classes in this PFT and we add another 
+    !  ::ncirc through calling stomate_prescribe. What we want to 
+    !  do is to merge these 2*ncirc into ncirc circumference classes.     
+    !  We need to populate the new distribution of trees among
+    !  the circumference classes, and move the heartwood and sap masses 
+    !  to the new distributions. We also need to move the other pools.  
+    !  This is more tricky because the allometric relations for the 
+    !  new tree sizes will NOT give the same amount of biomass for
+    !  the non-woody pools. Let us first try it just distributing
+    !  everything equally, and then if that doesn't work we can
+    !  redistribute the non-woody pools more cleverly, even if that 
+    !  means we change the total amount of biomass we have in this
+    !  stand.  I want to try it this way because we conserve biomass 
+    !  this way, and I hope that the stress on the trees will be
+    !  small enough that it doesn't cause problems. Redistribution
+    !  is not expected to de-stabilize the allocation too much if the
+    !  diameter range within an age-class is not too big (or in other
+    !  words if we define a sufficiently large number of age classes).
+ 
+    !! 2.1 Calculate new distribution
+    !  The first step is to decide of the distribution of individuals 
+    !  that we want in each class, for example, a uniform or exponential 
+    !  distribution (::circ_class_dist). The total number of individuals
+    !  that needs to be distributed is the weighted sum of the number of 
+    !  individuals (#/m-2) that is already available the the 
+    !  individuals that are newly established.  
+    IF (share_expanded .LT. min_stomate) THEN
+
+       ! The new PFT is still empty so simply copy the current tree 
+       ! distribution into the new PFT
+       exp_circ_class_n(:) = tmp_circ_class_n(:)
+
+    ELSE
+
+       ! The new PFT contains trees, merge the tree distributions. The
+       ! new tree distribution follows a prescribed distribution
+       exp_circ_class_n(:) = circ_class_dist(:) * &
+            SUM( share_expanded * est_circ_class_n(:) + &
+            (un-share_expanded) * tmp_circ_class_n(:) )
+
+    ENDIF   
+
+
+    !! 2.2 Copy both distributions into a single variable
+    DO icir = 1,2*ncirc
+
+       IF (icir .LE. ncirc) THEN
+
+          ! Circumference classes, number of individuals and biomass
+          ! of the available vegetation (m). Weight by the area share
+          ! such that we don't need to do this further down. Don't
+          ! weight the circumference and biomass as those variables are
+          ! expressed per tree. This helps to simplify the equations.
+          temp_circ_class(icir) = pi * est_circ_class_dia(icir)
+          temp_circ_class_n(icir) = share_expanded * &
+               est_circ_class_n(icir)
+          temp_circ_class_biomass(icir,:,:) = &
+               est_circ_class_biomass(icir,:,:)  
+
+       ELSEIF ( (icir .GT. ncirc) .AND. (icir .LE. 2*ncirc) ) THEN
+
+          ! Circumference classes, number of individuals and biomass
+          ! of the newly established vegetation (m). Weight by the area 
+          ! share such that we don't need to do this further down. Don't
+          ! weight the circumference and biomass as those variables are
+          ! expressed per tree. This helps to simplify the equations.
+          temp_circ_class(icir) = pi * tmp_circ_class_dia(icir-ncirc)
+          temp_circ_class_n(icir) = (un - share_expanded) * &
+               tmp_circ_class_n(icir-ncirc)
+          temp_circ_class_biomass(icir,:,:) = &
+               tmp_circ_class_biomass(icir-ncirc,:,:)
+
+       ELSE
+
+          WRITE(numout,*) 'Error - problem with the dimensions of a do-loop '
+
+       ENDIF
+
+    ENDDO !loop over 2*ncirc
+
+
+    !! 2.3 Sort the biomass and number of trees according to their 
+    !  circumference 
+    DO jcir = 2,2*ncirc
+
+       tempa = temp_circ_class(jcir)
+       tempb = temp_circ_class_n(jcir)
+       tempc(:,:) = temp_circ_class_biomass(jcir,:,:)
+
+       DO icir = jcir-1,1,-1
+
+          IF (temp_circ_class(icir) .LE. tempa) EXIT
+          temp_circ_class(icir+1) = temp_circ_class(icir)
+          temp_circ_class_n(icir+1) = temp_circ_class_n(icir)
+          temp_circ_class_biomass(icir+1,:,:) = &
+               temp_circ_class_biomass(icir,:,:)
+
+       ENDDO
+
+       temp_circ_class(icir+1) = tempa
+       temp_circ_class_n(icir+1) = tempb
+       temp_circ_class_biomass(icir+1,:,:) = tempc(:,:)
+
+    ENDDO
+   
+
+    !! 2.4 Merge into a single distribution with ncirc classes
+    !  Merge the 2*ncirc classes in ncirc classes. Empty one circ class
+    !  after the other going from the smallest to the biggest. Here we
+    !  still have 2*ncirc dimensions
+    circ_class_biomass(ipts,ivm,:,:,:) = zero
+    trees_left(:) = temp_circ_class_n(:)
+    DO icir=1,ncirc
+
+       ! This is the number of trees in the ncirc circ classes thus
+       ! AFTER the merge happened 
+       trees_needed = exp_circ_class_n(icir)
+       DO jcir = 1,2*ncirc
+
+          IF (trees_needed .LT. min_stomate) EXIT
+
+          IF (trees_left(jcir) .GE. trees_needed) THEN
+
+             ! We can get all the trees we need from this class
+             ! and don't have to continue searching. Note that
+             ! the units of circ_class_biomass have temporarly 
+             ! changed to gC m-2
+             circ_class_biomass(ipts,ivm,icir,:,:) = &
+                  circ_class_biomass(ipts,ivm,icir,:,:) + &
+                  temp_circ_class_biomass(jcir,:,:) * &
+                  trees_needed
+             trees_left(jcir) = trees_left(jcir) - trees_needed
+             trees_needed = zero
+
+             EXIT
+
+          ELSE
+
+             ! The number of trees in this class are not sufficient, so
+             ! we need to move all of them to the new class. Note that
+             ! the units of circ_class_biomass have temporarly changed 
+             ! to gC m-2
+             circ_class_biomass(ipts,ivm,icir,:,:) = &
+                  circ_class_biomass(ipts,ivm,icir,:,:) + &
+                  temp_circ_class_biomass(jcir,:,:) * &
+                  trees_left(jcir)
+             trees_needed = trees_needed - trees_left(jcir)
+             trees_left(jcir) = zero
+
+          ENDIF
+
+       ENDDO ! jcir=1,ncirc   
+
+    ENDDO ! icir=1,ncirc
+
+
+    !! 2.5 convert units back to the original units (gC tree-1) 
+    !  Right now, circ_class_biomass gives the total biomass
+    !  in each class, but it should only be for a model tree. 
+    !  So let's normalize it. And, update the variables that 
+    !  pass this information around
+    DO icir=1,ncirc
+
+       circ_class_biomass(ipts,ivm,icir,:,:) = &
+            circ_class_biomass(ipts,ivm,icir,:,:) / &
+            exp_circ_class_n(icir)
+       circ_class_n(ipts,ivm,icir) = exp_circ_class_n(icir)         
+
+    ENDDO
+ 
+    IF (printlev.GE.4) WRITE(numout,*) 'Leaving merging biomass of pfts'
+    
+  END SUBROUTINE merge_biomass_pfts
+
+! ================================================================================================================================
+!! SUBROUTINE   : print_lcc_error_message
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S) : 
+!!
+!! MAIN OUTPUT VARIABLE(S) :  
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+  
+  SUBROUTINE print_lcc_error_message(npts,ipts,veget_cov_max_new,veget_cov_max,&
+       veget_cov_max_new_group,veget_cov_max_group,delta_veget_cov,loss_gain,flag)
+
+    IMPLICIT NONE
+    
+  !! 0. Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                :: npts                 !! Domain size - number of pixels (unitless)
+    INTEGER, INTENT(in)                                :: ipts                 !! Location of current gridsquare
+    INTEGER, INTENT(in)                                :: flag                 !! Indicates what to print
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)       :: veget_cov_max            !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                               !! infinity) on ground.  (unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)       :: veget_cov_max_new        !! new "maximal" coverage fraction of a PFT (LAI
+                                                                               !! -> infinity) on ground. 
+    REAL(r_std),DIMENSION(npts,nvmap), INTENT(in)      :: delta_veget_cov          !! changes in "maximal" coverage fraction of PFT 
+    REAL(r_std), DIMENSION(npts,nvmap) , INTENT(in)    :: veget_cov_max_new_group  !! Total veget_cov_max_new of all age clases within a PFT group 
+                                                                               !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvmap) , INTENT(in)    :: veget_cov_max_group      !! Total veget_cov_max of all age clases within a PFT group 
+                                                                               !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvm)                   :: loss_gain            !! The same as delta_veget_cov but distributed of all
+                                                                               !! age classes and thus taking the age-classes into 
+                                                                               !! account (unitless, 0-1)
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                    :: ivm,ivma  !! Indices
+!_ ================================================================================================================================
+
+    IF(ipts .LT. 1)THEN
+       WRITE(numout,*) 'ERROR: Passing a bad point to print_lcc_error_message.'
+       WRITE(numout,*) 'ipts, test_grid: ',ipts,test_grid
+       RETURN
+    ENDIF
+
+    SELECT CASE(flag)
+    CASE(1)
+
+       ! Case 1
+       WRITE(numout,*) 'ipts ivma veget_cov_max_group veget_cov_max_new_group'
+       DO ivma=1,nvmap
+          WRITE(numout,'(2I7,2F14.10)') ipts,ivma,veget_cov_max_group(ipts,ivma),&
+               veget_cov_max_new_group(ipts,ivma)
+       ENDDO
+       WRITE(numout,*) 'SUMS: ',SUM(veget_cov_max_group(ipts,:)),&
+            SUM(veget_cov_max_new_group(ipts,:))
+
+    CASE(2)
+
+       ! Case 2
+       WRITE(numout,*) 'ivm veget_cov_max veget_cov_max_new'
+       DO ivm=1,nvm
+          WRITE(numout,'(2I7,2F14.10)') ipts,ivm,veget_cov_max(ipts,ivm),&
+               veget_cov_max_new(ipts,ivm)
+       ENDDO
+       WRITE(numout,*) 'SUMS: ',SUM(veget_cov_max(ipts,:)),&
+            SUM(veget_cov_max_new(ipts,:))
+
+    CASE(3)
+
+       ! Case 3
+       WRITE(numout,*) 'ivm veget_cov_max_group delta_veget_cov'
+       DO ivma=1,nvmap
+          WRITE(numout,'(2I7,3F14.10)') ipts,ivma,veget_cov_max_group(ipts,ivma),&
+               delta_veget_cov(ipts,ivma)
+       ENDDO
+       WRITE(numout,*) 'SUMS: ',SUM(veget_cov_max_group(ipts,:)),&
+            SUM(delta_veget_cov(ipts,:))
+    CASE(4)
+
+       !Case 4
+       WRITE(numout,*) 'ipts ivm veget_cov_max loss_gain'
+       DO ivm=1,nvm
+         WRITE(numout,'(2I7,3F14.10)') ipts,ivm,&
+               veget_cov_max(ipts,ivm),loss_gain(ipts,ivm)
+       ENDDO
+       WRITE(numout,*) 'SUMS: ',SUM(veget_cov_max(ipts,:)),&
+            SUM(loss_gain(ipts,:))
+
+   CASE(5)
+
+       ! Case 5
+       WRITE(numout,*) 'ivm agec_group'
+       DO ivm=1,nvm
+          WRITE(numout,'(2I8)') ivm,agec_group(ivm)
+       ENDDO
+
+    CASE default
+
+       ! Default case
+       WRITE(numout,*) 'ERROR: Not sure what you want me to print in LCC.'
+    END SELECT
+    
+     
+  END SUBROUTINE print_lcc_error_message
+
+
+! ================================================================================================================================
+!! SUBROUTINE   : adjust_delta_veget_cov
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  :  Check whether the initially proposed changes in veget_cov_max make sense
+!! If they do so accept this change. If the change brings the remaining veget_cov_max below
+!! the minimal threshold remove the whole PFT. Further the maps only prescribe the change
+!! in nvmap and do not contain any information about the changes in age classes. If a PFT 
+!! looses surface area we assumed that each age classes looses the same relative amount 
+!! of its surface area.
+!!
+!! RECENT CHANGE(S) : 
+!!
+!! MAIN OUTPUT VARIABLE(S) :  
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE adjust_delta_veget_cov(npts,veget_cov_max,veget_cov_max_group,veget_cov_max_new,&
+       veget_cov_max_new_group,loss_gain,delta_veget_cov,losses)
+
+  !! 0. Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                               :: npts                  !! Domain size - number of pixels (unitless)
+    REAL(r_std), DIMENSION(npts,nvmap),INTENT(in)     :: veget_cov_max_group       !! Total veget_cov_max of all age clases within a PFT group 
+                                                                               !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)      :: veget_cov_max_new         !! new "maximal" coverage fraction of a PFT (LAI
+                                                                               !! -> infinity) on ground. 
+    REAL(r_std), DIMENSION(npts,nvmap), INTENT(in)    :: veget_cov_max_new_group   !! Total veget_cov_max_new of all age clases within a PFT group 
+                                                                               !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)      :: veget_cov_max             !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                               !! infinity) on ground.  (unitless)
+    CHARACTER(15), INTENT(in)                         :: losses                !! Flag that determines how the losses are 
+                                                                               !! distributed. There are currently two options
+                                                                               !! 'proportional' and 'youngest'
+    
+    
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)     :: loss_gain             !! The same as delta_veget_cov but distributed of all
+                                                                               !! age classes and thus taking the age-classes into 
+
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION(npts,nvmap), INTENT(inout) :: delta_veget_cov            !! changes in "maximal" coverage fraction of PFT 
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts,nvmap)               :: delta_veget_cov_old        !! A temporary copy of delta_veget_cov.
+    INTEGER(i_std)                                   :: ivm,ivma,ipts          !! Indices
+    INTEGER(i_std)                                   :: jvma,igroup,iyoung     !! Indices
+    REAL(r_std)                                      :: excess_veg_add         !! 
+    REAL(r_std)                                      :: excess_veg_rem         !! 
+    REAL(r_std)                                      :: veg_add_tot            !! 
+    REAL(r_std)                                      :: difference             !! How much leftover veget_cov_max we have
+    INTEGER(i_std)                                   :: ncount                 !! The number of PFTs with significant changes
+                                                                               !! in vegetation.
+    INTEGER(i_std)                                   :: nagec_local            !! The number of age classes in this map PFT.
+    REAL(r_std), DIMENSION(npts,nvmap)               :: temp_delta_veget_cov       !! temporary variable to handle losses and gains
+                                                                               !! when there is a species change
+
+!_ ================================================================================================================================
+
+    !! Distribute delta_veget_cov over all age-classes
+    loss_gain(:,:)=zero
+
+    ! Here we have to be careful.  There is a variable, min_vegfrac, which checks some things
+    ! below to make sure we do not end up with land that is below a certain size.  This seems to be
+    ! mainly for the DGVM, but it affects us here, too.  If our final veget_cov_max is too low,
+    ! this will cause problems.  Therefore, adjust them beforehand.  
+    delta_veget_cov_old(:,:)=delta_veget_cov(:,:)
+
+    DO ipts=1,npts
+       
+       IF(printlev.GE.4)THEN
+!          IF(test_grid == ipts)THEN
+             WRITE(numout,*) 'Readjusting LCC fluxes for grid: ',ipts
+!          ENDIF
+       ENDIF
+       !  ::delta_veget_cov has been calculated for the sum of the age classes
+       !  within a PFT. ::delta_veget_cov thus needs to be distributed over 
+       !  all the age classes. This distribution requires a rule which 
+       !  in the absence of better information is based on the assumption
+       !  that a land cover change does not care about the age classes.
+       !  Following a forestry logic, one would change an old forest into 
+       !  a grassland because that would result in an income from the wood
+       !  harvest. However, here we assume that LCC follows a spatialized 
+       !  economic need and therefore does not respect the forestry logic.
+       !  In other words, when a farmer needs more land, he will not cut
+       !  spatialy distributed old stands but will target a block of land
+       !  bordering his current agricultural lands. By doing so forest
+       !  of all age classes will be cut when LCC is the underlying 
+       !  motivation. The reasoning applies for deforestation driven by 
+       !  urbanisation. This assumption translates in that the land cover
+       !  fraction of all age classes will decrease proportionally to their
+       !  share when the PFT experiences a loss. When the PFT experiences an
+       !  increase in the PFT cover this only happens in the youngest age
+       !  class.
+
+       ! There is one more constraint.  The new vegetation fraction at
+       ! the end of the calculation must be larger than min_vegfrac.  It might
+       ! not be if we remove the wrong amount of vegetation.  If veget_cov_max
+       ! is greater than zero but less than min_vegfrac after accounting
+       ! for loss_gain, we kill the whole PFT and move the leftover to
+       ! bare soil.  This leftover should be a small number.
+ 
+       ! This is a clean up case.  We should not have absolute values of loss_gain
+       ! or delta_veget_cov which are less than min_stomate.  This carbon will get
+       ! lost otherwise.  First let's do delta_veget_cov.  We will have to do something
+       ! at the end to be sure nothing has gone wrong with loss_gain, too.
+       excess_veg_add=zero
+       excess_veg_rem=zero
+
+       DO ivma=1,nvmap
+
+          IF ((delta_veget_cov(ipts,ivma) .LT. min_stomate) .AND. &
+               (delta_veget_cov(ipts,ivma) .GT. zero)) THEN
+
+             IF(printlev.GE.4 .AND. ipts == test_grid)THEN
+                WRITE(numout,*) 'delta_veget_cov between zero and min_stomate, adding ',&
+                     ivma,delta_veget_cov(ipts,ivma)
+             ENDIF
+
+             ! We want to add just a tiny amount of land. We will not do this as
+             ! as most likely it is just a precision issue. Add the land cover 
+             ! change to a temporary variable which will be dealt with later.
+             excess_veg_add=excess_veg_add+delta_veget_cov(ipts,ivma)
+             delta_veget_cov(ipts,ivma)=zero
+
+          ELSEIF((delta_veget_cov(ipts,ivma) .LT. zero) .AND. &
+               (delta_veget_cov(ipts,ivma) .GT. -min_stomate))THEN
+             
+             IF(printlev.GE.4 .AND. ipts == test_grid)THEN
+                WRITE(numout,*) 'delta_veget_cov between zero and -min_stomate, removing ',&
+                     ivma,delta_veget_cov(ipts,ivma)
+             ENDIF
+
+             ! We want to remove just a tiny amount of land. We will not do this as
+             ! as most likely it is just a precision issue. Remove the land cover 
+             ! change from a temporary variable which will be dealt with later.
+             excess_veg_rem=excess_veg_rem+delta_veget_cov(ipts,ivma)
+             delta_veget_cov(ipts,ivma)=zero
+
+          ENDIF
+
+       ENDDO
+
+
+       ! Make use of temporary variable so that the values can be overwritten
+       temp_delta_veget_cov = delta_veget_cov
+
+       ! From here on, we are only concerned with loss_gain.  We will ignore
+       ! delta_veget_cov after creating loss_gain, and then we will reconstruct
+       ! delta_veget_cov at the end from the changes we have made to loss_gain.
+       ! Note that loss_gain has the dimensions of the simulation (::nvm) 
+       ! whereas delta_veget_cov has the dimension of the maps (::nvma)
+       DO ivm=1,nvm
+
+          igroup=agec_group(ivm)
+          iyoung=start_index(igroup)
+
+          ! Only forest PFTs have age classes
+          IF (is_tree(ivm)) THEN
+
+             ! PFT cover area decreases (loss)
+             IF (temp_delta_veget_cov(ipts,igroup) .LE. -min_stomate) THEN
+
+                SELECT CASE(losses)
+                CASE('proportional')
+
+                   ! When there is a loss in veget_cov_max the standard code
+                   ! will distribute this loss proportionaly to the populated
+                   ! age classes of the species group. This reflects the
+                   ! fact that a land cover change does not necessarily 
+                   ! happens at the end of a forest rotation. All, young, 
+                   ! medium and old forest will be deforested.
+                   loss_gain(ipts,ivm) = veget_cov_max(ipts,ivm) / &
+                        veget_cov_max_group(ipts,igroup) * temp_delta_veget_cov(ipts,igroup)
+
+                CASE('youngest')
+
+                   ! This option is intended for species change only.
+                   ! A species change only happens at the end of a 
+                   ! rotation. So it is an old age class that will be
+                   ! replaced by a young one. Note that in forestry the
+                   ! old age class is marked for killing. In kill the
+                   ! surface of the harvested age class is moved to
+                   ! the youngest age class and here we move it 
+                   ! from the youngest age class of the previous species
+                   ! to the youngest age class of the new species.
+                   IF(veget_cov_max(ipts,ivm) .GT. min_stomate) Then
+                    loss_gain(ipts,ivm) = temp_delta_veget_cov(ipts,igroup)
+                    temp_delta_veget_cov(ipts,igroup) = zero
+                   ENDIF
+
+                CASE DEFAULT
+
+                   ! Stop the simulation
+                   CALL ipslerr_p (3,'land_cover_main', 'No information on',&
+                     'how the losses in veget_cov_max should be distributed','')
+
+                END SELECT
+
+             ! PFT cover area increases (gain)
+             ELSE
+
+                ! The first age-class in a PFT group is the youngest
+                ! and that is the age-class were the change in cover
+                ! fraction takes place
+                IF(ivm == iyoung)THEN
+
+                   loss_gain(ipts,ivm) = temp_delta_veget_cov(ipts,igroup)
+
+                ELSE
+
+                   ! The remaining age-classes in that PFT don't experience a
+                   ! change in cover fraction  
+                   loss_gain(ipts,ivm) = zero
+
+                ENDIF ! looking for youngest age class
+
+             ENDIF
+
+          ! Grasses and croplands
+          ELSE
+
+             ! There are no age-classes for grasses and crops, hence, 
+             ! delta_veget_cov should not be distributed over the age classes
+             loss_gain(ipts,ivm) = temp_delta_veget_cov(ipts,igroup)
+
+          ENDIF ! is_tree(ivm)
+
+       ENDDO ! looping over PFTs
+
+       IF (printlev.GE.4) THEN
+!          IF(ipts == test_grid)THEN
+             WRITE(numout,*) 'First estimate of loss_gain '
+             CALL print_lcc_error_message(npts,ipts,veget_cov_max_new,&
+                  veget_cov_max,veget_cov_max_new_group,&
+                  veget_cov_max_group,delta_veget_cov,loss_gain,4)
+!          ENDIF
+       ENDIF
+
+       ! It is possible that we try to add a very small amount to a PFT
+       ! which does not exist.  We cannot have a veget_cov_max between
+       ! min_stomate and min_vegfrac.  We will remove such small
+       ! changes here, but we need to be sure to add them somewhere else.
+       DO ivm=1,nvm
+
+          IF(veget_cov_max(ipts,ivm) .LT. min_stomate)THEN
+
+             IF((loss_gain(ipts,ivm) .GT. zero) .AND. &
+                  (loss_gain(ipts,ivm) .LE. min_vegfrac))THEN
+
+                IF(printlev.GE.4)THEN
+
+                   WRITE(numout,*) 'Trying to add too small of loss_gain to a PFT ' // &
+                        'which does not exist.  Correcting.'
+                   WRITE(numout,*) 'ipts, ivm, min_vegfrac: ',ipts, ivm, min_vegfrac
+                   WRITE(numout,*) 'veget_cov_max,loss_gain (before): ',&
+                        veget_cov_max(ipts,ivm),loss_gain(ipts,ivm)
+                ENDIF
+
+                ! Loss_gain is too small. Ignore it but make
+                ! sure to account for it somewhere else. If
+                ! not the C balance will not be closed.
+                excess_veg_add = excess_veg_add+loss_gain(ipts,ivm)
+                loss_gain(ipts,ivm)=zero
+
+             ENDIF
+                
+          ENDIF
+
+       ENDDO ! looping over all PFTs
+
+       ! This is a first readjustment due to the fact that creating
+       ! loss_gain proportational to veget_cov_max might generate a
+       ! new veget_cov_max for a given PFT which is below min_fracveg.
+       DO ivma=1,nvmap
+
+          iyoung=start_index(ivma)
+          nagec_local=nagec_pft(ivma)
+
+          ! Only a concern if we have age classes
+          IF (nagec_local .GT. 1) THEN
+
+             ! Will any veget_cov_maxes created by these loss_gains
+             ! be below the minimum vegetation fraction?
+             DO ivm=iyoung,iyoung+nagec_local-1
+
+                IF(loss_gain(ipts,ivm) .LT. zero)THEN
+
+                   ! We also need to check if it's greater than zero, 
+                   ! since we might want to remove the whole PFT, 
+                   ! which is perfectly okay.
+                   IF(veget_cov_max(ipts,ivm)-ABS(loss_gain(ipts,ivm)) .LE. min_vegfrac .AND. &
+                        (veget_cov_max(ipts,ivm)-ABS(loss_gain(ipts,ivm)) .NE. zero))THEN
+
+                      IF(printlev.GE.4)THEN
+                         WRITE(numout,*) 'Results in a veget_cov_max below min_vegfrac!  Correcting.'
+                         WRITE(numout,*) 'ipts, ivm, min_vegfrac: ',ipts, ivm, min_vegfrac
+                         WRITE(numout,*) 'veget_cov_max,loss_gain (before): ',&
+                              veget_cov_max(ipts,ivm),loss_gain(ipts,ivm)
+                      ENDIF
+
+                      ! We kill the whole PFT.  This means we have to add a gain somewhere
+                      ! to compensate, probably bare soil.
+                      excess_veg_add = excess_veg_add + &
+                           (veget_cov_max(ipts,ivm)-ABS(loss_gain(ipts,ivm)))
+                      loss_gain(ipts,ivm)=-veget_cov_max(ipts,ivm)
+
+                   ENDIF
+
+                ENDIF ! loss_gain .LT.zero
+
+             ENDDO ! ivm
+
+          ENDIF ! checking if we have age classes 
+
+       ENDDO ! looping over the map PFTs
+
+       ! Now we do one final check to make sure that our loss_gain isn't too small.
+       ! It should be fairly rare that we actually do something here.  We have
+       ! already done the same check above for delta_veget_cov, so if we don't have
+       ! age classes there will be nothing to do here.  This is required because
+       ! some of the actions in LCC are not done if loss_gain is below min_stomate,
+       ! so we would have a mass balance error otherwise.
+       DO ivma=1,nvmap
+
+          iyoung=start_index(ivma)
+          nagec_local=nagec_pft(ivma)
+
+          ! Only a concern if we have age classes
+          IF (nagec_local .GT. 1) THEN
+
+             ! Will any veget_cov_maxes created by these loss_gains
+             ! be below the minmum vegetation fraction?
+             DO ivm=iyoung,iyoung+nagec_local-1
+
+                IF ((loss_gain(ipts,ivm) .LT. min_stomate) .AND. &
+                     (loss_gain(ipts,ivm) .GT. zero)) THEN
+                   
+                   IF(printlev.GE.4)THEN
+                      WRITE(numout,*) 'loss_gain between zero and min_stomate, adding ',&
+                           ivm,ivma,delta_veget_cov(ipts,ivma),loss_gain(ipts,ivm)
+                   ENDIF
+
+                   ! We want to add just a tiny amount of land.  
+                   ! Add it somewhere else.
+                   excess_veg_add=excess_veg_add+loss_gain(ipts,ivm)
+                   loss_gain(ipts,ivm)=zero
+                   
+                ELSEIF((loss_gain(ipts,ivm) .LT. zero) .AND. &
+                     (loss_gain(ipts,ivm) .GT. -min_stomate))THEN
+                   
+                   IF(printlev.GE.4)THEN
+                      WRITE(numout,*) 'loss_gain between zero and -min_stomate, removing ',&
+                           ivm,ivma,delta_veget_cov(ipts,ivma),loss_gain(ipts,ivm)
+                   ENDIF
+
+                   ! We want to add just a tiny amount of land.  
+                   ! Add it somewhere else.
+                   excess_veg_rem=excess_veg_rem+loss_gain(ipts,ivm)
+                   loss_gain(ipts,ivm)=zero
+                   
+                ENDIF
+
+             ENDDO ! loop over the age classes for this PFT
+
+          ENDIF ! checking if we have age classes 
+
+       ENDDO ! looping over the map PFTs
+
+
+       ! If we have extra land to add/remove, let's change the loss_gain of bare soil.
+       ! This should, in general, be a small number.
+       IF (printlev.GE.4) THEN
+!          IF(ipts == test_grid)THEN
+             WRITE(numout,*) 'Extra vegetation to add: '
+             WRITE(numout,*) 'excess_veg_add: ',excess_veg_add
+             WRITE(numout,*) 'Extra vegetation to remove: '
+             WRITE(numout,*) 'excess_veg_rem: ',excess_veg_rem
+
+             WRITE(numout,*) 'Readjusting loss_gain to make sure an age class does not fall too low.'
+
+             CALL print_lcc_error_message(npts,ipts,veget_cov_max_new,veget_cov_max,veget_cov_max_new_group,&
+                  veget_cov_max_group,delta_veget_cov,loss_gain,4)
+
+!          ENDIF
+
+       ENDIF
+
+       ! Our loss_gain should not lead to a bare soil fraction below min_vegfrac.
+       ! Start with PFT 1 (bare soil) and try to put all the excess into a single PFT.
+       ! If we cannot do that, throw an error. It's possible that we can flip the sign
+       ! of the loss_gain by doing this, but that should not cause any
+       ! serious problem.  We just won't be 100% inline with the maps, but as long
+       ! as min_vegfrac exists, we won't be anyways.
+
+       ! We loop over the map PFTs here.  We don't want to loop over all the PFTs
+       ! and check, because we might end up adding area to an age class which
+       ! is not the youngest that way, which would be bad.
+       excess:DO ivma=1,nvmap
+
+          ! Do we have vegetation?
+          ivm=start_index(ivma)
+
+          IF(veget_cov_max(ipts,ivm) .GE. min_stomate)THEN
+
+             ! Can we add the difference without falling below min_vegfrac?
+             IF((veget_cov_max(ipts,ivm)+(loss_gain(ipts,ivm)+&
+                  excess_veg_add+excess_veg_rem)) .GT. min_vegfrac)THEN
+
+                ! Also, our total loss_gain needs to be above min_stomate
+                IF(ABS(loss_gain(ipts,ivm)+&
+                     excess_veg_add+excess_veg_rem) .GT. min_stomate)THEN
+                   
+                   IF(printlev.GE.4)THEN
+                      WRITE(numout,*) 'Dumping excess vegetation'
+                      WRITE(numout,*) 'ipts,ivm,ivma: ',ipts,ivm,ivma
+                      WRITE(numout,*) 'Correction: ',&
+                           excess_veg_add+excess_veg_rem
+                      WRITE(numout,*) 'veget_cov_max: ',veget_cov_max(ipts,ivm)
+                      WRITE(numout,*) 'veget_cov_max corrected: ',veget_cov_max(ipts,ivm)+&
+                           (loss_gain(ipts,ivm)+excess_veg_add+excess_veg_rem)
+                      WRITE(numout,*) 'loss_gain: ',loss_gain(ipts,ivm)
+                      WRITE(numout,*) 'loss_gain corrected: ',loss_gain(ipts,ivm)+&
+                           excess_veg_add+excess_veg_rem
+                   ENDIF
+
+                   ! Let's do it.
+                   loss_gain(ipts,ivm)=loss_gain(ipts,ivm)+&
+                        excess_veg_add+excess_veg_rem
+                   excess_veg_add=zero
+                   excess_veg_rem=zero
+
+                   EXIT excess
+                ENDIF
+             ENDIF
+          ENDIF
+       ENDDO excess
+
+       ! If we still have excess vegetation, our method did not work.
+       IF((excess_veg_add .GE. min_stomate) .OR. &
+            (ABS(excess_veg_rem) .GE. min_stomate))THEN
+
+          ! It is possible that the excess amount we have to add 
+          ! and that which we have to remove cancel each other 
+          ! out.  In which case, we don't actually have a problem.
+          IF(ABS(excess_veg_add+excess_veg_rem) .GE. min_stomate)THEN
+
+             WRITE(numout,*) 'We were not able to redistribute all the extra vegetation in LCC.'
+             WRITE(numout,*) 'excess_veg_add: ',excess_veg_add
+             WRITE(numout,*) 'excess_veg_rem: ',excess_veg_rem
+             WRITE(numout,*) 'ipts: ',ipts
+             CALL print_lcc_error_message(npts,ipts,veget_cov_max_new,veget_cov_max,veget_cov_max_new_group,&
+                  veget_cov_max_group,delta_veget_cov,loss_gain,4)
+
+             ! Ignore this problem (which is a useful flag when
+             ! going from the spin-up to a transient simulation
+             IF(err_act.GT.1)THEN
+                CALL ipslerr_p (2,'land_cover_main', 'Not stopping here.',&
+                     'Only ignore me if you know what you are doing!','Place 2')
+                excess_veg_add=zero
+                excess_veg_rem=zero
+
+             ELSE
+
+                CALL ipslerr_p (3,'land_cover_main', &
+                     'Unable to redistribute vegetation (see output file)','','')
+             ENDIF
+
+             
+          ELSE ! Success redistribution
+
+             IF(printlev.GE.4)THEN
+                WRITE(numout,*) 'All extra vegetation successfully redistributed in LCC.'
+                WRITE(numout,*) 'excess_veg_add: ',excess_veg_add
+                WRITE(numout,*) 'excess_veg_rem: ',excess_veg_rem
+             ENDIF
+
+             excess_veg_add=zero
+             excess_veg_rem=zero
+
+          ENDIF
+
+       ENDIF
+
+       ! Reconstruct the delta_veget_cov from the adjusted loss_gain array.
+       delta_veget_cov(ipts,:)=zero
+       DO ivma=1,nvmap
+
+          iyoung=start_index(ivma)
+          nagec_local=nagec_pft(ivma)
+
+          ! Add all these age classes to this map PFT
+          DO ivm=iyoung,iyoung+nagec_local-1
+
+             delta_veget_cov(ipts,ivma)=delta_veget_cov(ipts,ivma)+loss_gain(ipts,ivm)
+
+          ENDDO
+
+       ENDDO ! done looping over map PFTs
+
+
+       ! Now one final sanity check.  We should never try to remove more
+       ! vegetation than we actually have.  
+       DO ivm=1,nvm
+
+          ! Notice here that loss_gain is negative for pixels
+          ! which remove veget_cov_max.
+          difference=veget_cov_max(ipts,ivm)+loss_gain(ipts,ivm)
+
+          IF(difference .LT. -min_stomate)THEN
+
+             ! This is a problem.
+             WRITE(numout,*) 'We are trying to remove too much vegetation in LCC.'
+             WRITE(numout,*) 'ipts, ivm: ',ipts, ivm
+             WRITE(numout,*) 'veget_cov_max, loss_gain: ',&
+                  veget_cov_max(ipts,ivm),loss_gain(ipts,ivm)
+             CALL ipslerr_p (3,'land_cover_main', &
+                  'Removing too much vegetation (see output file)','','')
+             
+          ELSEIF((difference .LE. min_vegfrac) .AND. &
+               (difference .GT. min_stomate))THEN
+
+             ! We should have accounted for this above.
+             WRITE(numout,*) 'We are left with an awkward amount of vegetation in LCC.'
+             WRITE(numout,*) 'This should have been taken care of above.'
+             WRITE(numout,*) 'ipts, ivm: ',ipts, ivm
+             CALL print_lcc_error_message(npts,ipts,veget_cov_max_new,&
+                  veget_cov_max,veget_cov_max_new_group,&
+                  veget_cov_max_group,delta_veget_cov,loss_gain,4)
+             CALL ipslerr_p (3,'land_cover_main', &
+                  'Awkward amoutn of vegetation (see output file)','','')
+          
+          ELSEIF(difference .LT. zero)THEN
+          
+             ! Technically not a problem since it could be -1e-17, but it might provoke
+             ! a mass balance error so we warn about it.  The serious case of
+             ! a difference less than -min_stomate was handled above.
+             WRITE(numout,*) 'WARNING: A small amount of leftover vegatation in LCC.'
+             WRITE(numout,*) 'Should not cause a problem, but watch for a mass balance error.'
+             WRITE(numout,*) 'ipts, ivm: ',ipts, ivm
+             WRITE(numout,*) 'veget_cov_max, loss_gain: ',&
+                  veget_cov_max(ipts,ivm),loss_gain(ipts,ivm)
+             CALL ipslerr_p (2,'land_cover_main', &
+                  'Small amount of leftover vegetation (see output file)','','')
+          ENDIF
+
+       ENDDO ! loop over PFTs
+
+    ENDDO ! loop over #pixels - domain size
+
+  END SUBROUTINE adjust_delta_veget_cov
+
+END MODULE sapiens_lcchange
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_product_use.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_product_use.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_product_use.f90	(revision 6412)
@@ -0,0 +1,1171 @@
+! =================================================================================================================================
+! MODULE       : sapiens_product_use
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Following lateral transport, calculate C-stored in the product pools
+!!             and the CO2-release from product decomposition  
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-DOFOCO/ORCHIDEE/src_stomate/stomate_lcchange.f90 $
+!! $Date: 2013-07-03 10:16:15 +0200 (Wed, 03 Jul 2013) $
+!! $Revision: 1356 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE sapiens_product_use
+
+! modules used:
+  
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE function_library,    ONLY: check_mass_balance
+  
+  IMPLICIT NONE
+  
+  PRIVATE
+  PUBLIC basic_product_use, product_init, dim_product_use
+
+CONTAINS 
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : basic_product_use
+!!
+!>\BRIEF        Calculate the C stored in biomass-based products and the 
+!!              CO2 release through their decomposition 
+!!
+!! DESCRIPTION  : The basic approach distinguished 3 pools (as introduced by
+!! Shilong Piao based on Houghton. This module does NOT make use of the 
+!! dimensions of the woody harvest or of the management and cutting flags.
+!! All wood is distributed across the short, medium and long product pools. 
+!! This basically means that wood use in ..., 1600, 1700, 1800, 1900 and 2000 
+!! was identical.\n
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : prod_s, prod_m, prod_l, flux_s, flux_m, flux_l,
+!!   flux_prod_s flux_prod_m and flux_prod1_l 
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!!
+!_ ================================================================================================================================
+
+ SUBROUTINE basic_product_use(npts, dt_days, harvest_pool_bound, harvest_pool, &
+            harvest_type, harvest_cut, harvest_area, &
+            flux_prod_s, flux_prod_m, flux_prod_l, prod_s, &
+            prod_m, prod_l, prod_s_total, prod_m_total, &
+            prod_l_total, flux_prod_total, flux_s, flux_m, &
+            flux_l, resolution, veget_cov_max)
+
+   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(:,:), INTENT(in)               :: resolution        !! The length in m of each grid-box in X and Y
+    REAL(r_std), DIMENSION(:), INTENT(in)                :: harvest_pool_bound!! The boundaries of the diameter classes
+                                                                              !! in the wood harvest pools @tex $(m)$ @endtex
+     REAL(r_std), DIMENSION(:,:), INTENT(in)             :: veget_cov_max         !! Passed so we can check_mass_balance 
+                                                                              !! Making it OPTIONAL would have been nicer.
+
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: flux_prod_s       !! C-released during first years (short term) 
+                                                                              !! following land cover change 
+                                                                              !! @tex ($gC m^{-1} dt^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: flux_prod_m       !! Total annual release from decomposition of 
+                                                                              !! the medium-lived product pool 
+                                                                              !! @tex ($gC m^{-1} dt^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: flux_prod_l       !! Total annual release from decomposition of 
+                                                                              !! the long-lived product pool 
+                                                                              !! @tex ($gC m^{-1} dt^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: prod_s_total      !! Total products remaining in the short-lived  
+                                                                              !! pool after the annual decomposition 
+                                                                              !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: prod_m_total      !! Total products remaining in the medium-lived
+                                                                              !! pool after the annual decomposition 
+                                                                              !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: prod_l_total      !! Total products remaining in the long-lived
+                                                                              !! pool after the annual release 
+                                                                              !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: flux_prod_total   !! Total flux from decomposition of the short,
+                                                                              !! medium and long lived product pools 
+                                                                              !! @tex $(gC m^{-1} dt^{-1})$ @endtex
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(:,0:,:), INTENT(inout)        :: prod_s            !! Short-lived product pool after the annual 
+                                                                              !! release of each compartment (short + 1 : 
+                                                                              !! input from year of land cover change) 
+                                                                              !! @tex ($gC pixel^{-1}$) @endtex    
+    REAL(r_std), DIMENSION(:,0:,:), INTENT(inout)        :: prod_m            !! Medium-lived product pool after the annual 
+                                                                              !! release of each compartment (medium + 1 : 
+                                                                              !! input from year of land cover change) 
+                                                                              !! @tex ($gC pixel^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(:,0:,:), INTENT(inout)        :: prod_l            !! long-lived product pool after the annual 
+                                                                              !! release of each compartment (long + 1 : 
+                                                                              !! input from year of land cover change) 
+                                                                              !! @tex ($gC pixel^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: flux_s            !! Annual release from the short-lived product 
+                                                                              !! pool @tex $(gC) pixel^{-1} year^{-1}$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: flux_m            !! Annual release from the medium-lived product  
+                                                                              !! pool @tex $(gC) pixel^{-1} year^{-1}$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: flux_l            !! Annual release from the long-lived product
+                                                                              !! pool @tex $(gC) pixel^{-1} year^{-1}$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: harvest_pool      !! The wood and biomass that have been
+                                                                              !! havested by humans @tex $(gC)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: harvest_type      !! Type of management that resulted
+                                                                              !! in the harvest (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: harvest_cut       !! Type of cutting that was used for the harvest
+                                                                              !! (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: harvest_area      !! Harvested area (m^{2})
+   
+
+    !! 0.4 Local variables
+ 
+    INTEGER(i_std)                                       :: ipts, ivm, iage   !! Indices (unitless)
+    INTEGER(i_std)                                       :: imbc, iele        !! Indices (unitless)
+    REAL(r_std), DIMENSION(nelements)                    :: exported_biomass  !! Total biomass exported from the PFT (gC)
+    REAL(r_std), DIMENSION(nelements)                    :: residual          !! Residual @tex $(gC m^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)   :: check_intern      !! Contains the components of the internal
+                                                                              !! mass balance chech for this routine
+                                                                              !! @tex $(gC m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)           :: closure_intern    !! Check closure of internal mass balance
+                                                                              !! @tex $(gC m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)           :: pool_start        !! Start pool of this routine 
+                                                                              !! @tex $(gC m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)           :: pool_end          !! End pool of this routine 
+                                                                              !! @tex $(gC m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts)                         :: pixel_area        !! surface area of the pixel @tex ($m^{2}$) @endtex
+    
+!_ ================================================================================================================================    
+
+    IF(printlev.GE.3) WRITE(numout,*) 'Entering basic product use'
+ 
+
+ !! 1. initialization
+
+    !! 1.1 Fluxes and pools
+    prod_s(:,0,:) = zero
+    prod_m(:,0,:) = zero
+    prod_l(:,0,:) = zero
+    prod_s_total(:,:) = zero
+    prod_m_total(:,:) = zero
+    prod_l_total(:,:) = zero   
+    flux_prod_s(:,:) = zero
+    flux_prod_m(:,:) = zero
+    flux_prod_l(:,:) = zero
+    flux_prod_total(:,:) = zero
+
+    !! 1.2 Pixel area
+    !  Surface area (m2) of the pixel
+    pixel_area(:) = resolution(:,1) * resolution(:,2)
+
+    !! 1.3 Initialize local printlev
+    !printlev_loc=get_printlev('product_use')
+
+    !! 1.4 Initialize check for mass balance closure 
+    IF (err_act.GT.1) THEN
+
+       ! The biomass harvest pool shouldn't be multiplied by veget_cov_max
+       ! its units are already in gC pixel-1. The total amount for the 
+       ! pixel was stored in harvest_pool. Account for the harvest and
+       ! wood product pools. There are no longer PFTs
+       check_intern(:,:,:,:) = zero
+       pool_start(:,:,:) = zero
+       DO iele = 1,nelements
+          pool_start(:,1,iele) = &
+               ( SUM(SUM(harvest_pool(:,:,:,iele),3),2) + &
+               SUM(prod_l(:,:,iele),2) + SUM(prod_m(:,:,iele),2) + &
+               SUM(prod_s(:,:,iele),2) )/pixel_area(:)
+       ENDDO
+       
+    ENDIF ! err_act.GT.1
+
+    !! 1.5 Logical check of coeff_lcchange
+    !  Within a PFT the coeff_lcchange should add up to one. Else the 
+    !  carbon balance will not be closed! Do not include PFT 1 in this 
+    !  check because its coeff_lcchange were set to undef (-9999).
+    DO ivm = 2,nvm
+
+       IF ( (coeff_lcchange_s(ivm) + coeff_lcchange_m(ivm) + &
+            coeff_lcchange_l(ivm) .LT. un - min_stomate) .OR. &
+            (coeff_lcchange_s(ivm) + coeff_lcchange_m(ivm) + &
+            coeff_lcchange_l(ivm) .GT. un + min_stomate) ) THEN
+
+          WRITE(numout,*) 'Error: coeff_lcchange in sapiens_product_use.f90 ' //&
+               'do not add up to 1 in PFT - cannot close the mass balance, ',ivm
+          CALL ipslerr_p (3,'sapiens_product_use', &
+               'basic_product_use','coeff_lcchange do not add up to 1 ','')
+       ENDIF
+
+    ENDDO
+
+
+ !! 2. Partition harvest in a short, medium and long-lived product pool
+
+    DO ipts = 1,npts
+
+       !! 2.1 Calculate the initial mass of the product pool (gC)
+       DO ivm = 2,nvm
+  
+          !+++NOTE+++
+          ! For the moment all harvest is lumped together and we don't 
+          ! make use of harvest_type and harvest_cut to refine the product
+          ! use. If these variables are to be used be aware that for the
+          ! moment these values can be overwritten within a simulation.
+          ! Although the sequence of the calls in stomate_lpj is believed
+          ! to protect against this, it is not enforced by the code. For
+          ! example, if we first thin and then harvest, wood of both
+          ! actions will be stored in the harvest pool but it will be 
+          ! recored as just harvest (thinning will be overwritten by harvest)
+          exported_biomass(:) = SUM(harvest_pool(ipts,ivm,:,:),1)
+          !+++++++++++
+
+          ! Attribute the harvested biomass to pools with a different 
+          ! turnover time. The turnover times are PFT depend which 
+          ! accounts for the different uses different PFT's are put to i.e. 
+          ! wood from forests vs grass or crops. The values stored in 
+          ! harvest_pool are absolute numbers gC (for that pixel), hence, 
+          ! the spatial extent of the LCC change, harvest or thinning has 
+          ! already been accounted for.
+          prod_s(ipts,0,:) = prod_s(ipts,0,:) + &
+               (coeff_lcchange_s(ivm) * exported_biomass(:))
+          prod_m(ipts,0,:) = prod_m(ipts,0,:) + &
+               (coeff_lcchange_m(ivm) * exported_biomass(:))
+          prod_l(ipts,0,:) = prod_l(ipts,0,:) + &
+               (coeff_lcchange_l(ivm) * exported_biomass(:))
+
+       ENDDO
+
+       !! 2.2 Check whether all the harvest was used as is to be expected
+       !  The precision we are aiming for is 10-8 per m-2. The harvest pool
+       !  is expressed for the whole pixel
+       residual(:) = SUM(SUM(harvest_pool(ipts,:,:,:),2),1) - &
+            prod_s(ipts,0,:) - prod_m(ipts,0,:) - &
+            prod_l(ipts,0,:)
+       
+       DO iele = 1,nelements
+
+          IF (residual(iele)/pixel_area(ipts) .GT. min_stomate .OR. &
+               residual(iele)/pixel_area(ipts) .LT. - min_stomate) THEN
+             
+             WRITE (numout,*) 'Error: some harvest in '//&
+                  'sapiens_product_use has not been attributed'
+             WRITE (numout,*) 'Residual in pixel, iele, ', &
+                  iele, ipts, residual
+             CALL ipslerr_p (3,'sapiens_product_use', &
+                  'basic_product_use','some harvest has not been attributed',&
+                  '')
+
+          ELSE
+
+             ! We could still have residual within the precision at the 
+             ! m2 level but outside the precision at the pixel level. 
+             ! Move the residual to the short lived pool
+             prod_s(ipts,0,iele) = prod_s(ipts,0,iele) + residual(iele)
+
+             ! All the carbon in the harvest pool was allocated to the product 
+             ! pools the harvest pool can be set to zero so we can us it with 
+             ! confidence in the mass balance calculation
+             harvest_pool(ipts,:,:,iele) = zero
+             harvest_type(ipts,:) = zero
+             harvest_cut(ipts,:) = zero
+             harvest_area(ipts,:) = zero
+
+          ENDIF 
+
+       ENDDO
+    
+       !! 2.3 Update the long-turnover pool content
+       !  Update the long-turnover pool content following flux emission
+       !  of a linear decay (1/longivety) of the initial carbon input.
+       !  This must be implemented with a counter going from ::nlong to 
+       !  zero because this way it takes ::nlong years before the intial 
+       !  pool has been entirely consumed. If a more intuitive approach 
+       !  would have been used in which the counter goes from zero to
+       !  ::nlong, the pool would be depleted in the first year.
+       !  Update the long-turnover pool content following flux emission.
+       DO iage = nlong,2,-1
+
+          ! flux and prod are large numbers. At the last time step 10-5
+          ! gC remains which is outside the precision. Therefore, this 
+          ! carbon is moved to the flux 
+          IF (iage .EQ. nlong) THEN
+              
+              flux_prod_l(ipts,:) = flux_prod_l(ipts,:) + prod_l(ipts,iage-1,:)
+              flux_l(ipts,iage,:) = prod_l(ipts,iage-1,:)
+              prod_l(ipts,iage,:) = zero
+
+          ELSE
+          
+             ! ::flux_l has INTENT(inout), it thus has the value from the 
+             ! previuous year at the start of these calculations. Copy
+             ! the flux from the previous year to this year and update
+             ! the product pool
+             flux_prod_l(ipts,:) = flux_prod_l(ipts,:) + flux_l(ipts,iage,:)
+             prod_l(ipts,iage,:) = prod_l(ipts,iage-1,:) - flux_l(ipts,iage-1,:)
+             flux_l(ipts,iage,:) = flux_l(ipts,iage-1,:)
+ 
+          ENDIF
+          
+       ENDDO
+
+       ! Treat the first year separately because it is not included in 
+       ! the loop above
+       flux_prod_l(ipts,:) = flux_prod_l(ipts,:) + flux_l(ipts,1,:)
+
+       ! Each year 1/::nlong of the initial pool is decomposed. This fixed
+       ! amount of decomposition is moved to a higher age class each year. 
+       ! The units of ::flux_m are gC (absolute number as is the product 
+       ! pool). At this point in the calculation, the flux is NOT a flux 
+       ! yet but is also a pool 
+       flux_l(ipts,1,:) = (un/nlong) * prod_l(ipts,0,:)
+       prod_l(ipts,1,:) = prod_l(ipts,0,:) - flux_l(ipts,1,:)
+       prod_l(ipts,0,:) = zero
+
+       !! 2.4 Update the medium-turnover pool content 
+       !  Update the medium-turnover pool content following flux emission.
+       !  For comments see the section above. The concept is identical. 
+       DO iage = nmedium,2,-1
+
+          IF (iage .EQ. nmedium) THEN
+              
+              flux_prod_m(ipts,:) = flux_prod_m(ipts,:) + prod_m(ipts,iage-1,:)
+              flux_m(ipts,iage,:) = prod_m(ipts,iage-1,:)
+              prod_m(ipts,iage,:) = zero
+
+          ELSE
+
+             flux_prod_m(ipts,:) = flux_prod_m(ipts,:) + flux_m(ipts,iage,:)
+             prod_m(ipts,iage,:) = prod_m(ipts,iage-1,:) - flux_m(ipts,iage-1,:)
+             flux_m(ipts,iage,:) = flux_m(ipts,iage-1,:)
+         
+          ENDIF
+
+       ENDDO
+     
+       flux_prod_m(ipts,:) = flux_prod_m(ipts,:) + flux_m(ipts,1,:)
+       flux_m(ipts,1,:) = (un/nmedium) * prod_m(ipts,0,:)
+       prod_m(ipts,1,:) = prod_m(ipts,0,:) - flux_m(ipts,1,:)
+       prod_m(ipts,0,:) = zero
+
+       !! 2.5 Update the short-turnover pool
+       !  The length of the short-turnover pool will most likely be
+       !  less than length of the regular loop. The regular loop is
+       !  now conditional. 
+       !  NOTE: this code has only been tested for nshort = 1 and 
+       !  nshort = 2
+       IF (nshort .GE. 4) THEN
+
+          DO iage = nshort,2,-1
+
+             IF (iage .EQ. nshort) THEN
+              
+                flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + &
+                     prod_s(ipts,iage-1,:)
+                flux_s(ipts,iage,:) = prod_s(ipts,iage-1,:)
+                prod_s(ipts,iage,:) = zero
+
+             ELSE
+  
+                flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + &
+                     flux_s(ipts,iage,:)
+                prod_s(ipts,iage,:) = prod_s(ipts,iage-1,:) - &
+                     flux_s(ipts,iage-1,:)
+                flux_s(ipts,iage,:) = flux_s(ipts,iage-1,:)
+
+             ENDIF
+
+          ENDDO
+
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + flux_s(ipts,1,:) 
+          flux_s(ipts,1,:) = (un/nshort) * prod_s(ipts,0,:)
+          prod_s(ipts,1,:) = prod_s(ipts,0,:) - flux_s(ipts,1,:)
+          prod_s(ipts,0,:) = zero
+
+       ELSEIF (nshort .EQ. 3) THEN
+
+          ! Decompose the product pool from the last year
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + prod_s(ipts,2,:)
+          flux_s(ipts,3,:) = prod_s(ipts,2,:)
+          prod_s(ipts,3,:) = zero
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + flux_s(ipts,2,:)
+          prod_s(ipts,2,:) = prod_s(ipts,1,:) - flux_s(ipts,1,:)
+          flux_s(ipts,2,:) = flux_s(ipts,1,:)
+
+          ! Calculate the linear product decomposition for this
+          ! year's harvest
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + flux_s(ipts,1,:) 
+          flux_s(ipts,1,:) = (un/nshort) * prod_s(ipts,0,:)
+          prod_s(ipts,1,:) = prod_s(ipts,0,:) - flux_s(ipts,1,:)
+          prod_s(ipts,0,:) = zero
+
+       ELSEIF (nshort .EQ. 2) THEN
+
+          ! Decompose the product pool from last year
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + prod_s(ipts,1,:)
+          flux_s(ipts,2,:) = prod_s(ipts,1,:)
+          prod_s(ipts,2,:) = zero
+
+          ! Calculate the linear product decomposition for this
+          ! year's harvest
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + flux_s(ipts,1,:) 
+          flux_s(ipts,1,:) = (un/nshort) * prod_s(ipts,0,:)
+          prod_s(ipts,1,:) = prod_s(ipts,0,:) - flux_s(ipts,1,:)
+          prod_s(ipts,0,:) = zero
+
+       ELSEIF (nshort .EQ. 1) THEN
+
+          ! Everything decomposes in a single year. The short product
+          ! pool remains empty.
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + prod_s(ipts,0,:) 
+          flux_s(ipts,1,:) = prod_s(ipts,0,:)
+          prod_s(ipts,1,:) = zero
+          prod_s(ipts,0,:) = zero
+
+       ELSE
+
+          WRITE(numout,*) 'Error: flaw in the logic of IF-construct '//&
+               '(basic_product_use in sapiens_product_use.f90)'
+          CALL ipslerr_p(3,'ERROR: product_use',&
+               'Logic flaw in if-construct','','')
+          
+       ENDIF ! number of ages in short-turnover product pool
+
+    ENDDO ! #pixels - spatial domain  
+
+
+ !! 3. Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 3.1 Mass balance closure 
+       ! 3.1.1 Calculate final biomass
+       ! The biomass harvest pool shouldn't be multiplied by veget_cov_max
+       ! its in gC pixel-1 so divide by pixel_area to get a value in
+       ! gC m-2. Account for the harvest and wood product pools. The harvest 
+       ! pool should be empty, it was added for completeness.
+       pool_end = zero
+       DO iele=1,nelements
+          pool_end(:,1,iele) = &
+               ( SUM(SUM(harvest_pool(:,:,:,iele),3),2) + &
+               SUM(prod_l(:,:,iele),2) + SUM(prod_m(:,:,iele),2) + &
+               SUM(prod_s(:,:,iele),2) ) / pixel_area(:)
+       ENDDO
+
+       !! 3.1.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(:,1,iland2atm,iele) = &
+               -un * ( SUM(flux_s(:,:,iele),2) + &
+               SUM(flux_m(:,:,iele),2) + SUM(flux_l(:,:,iele),2) ) / &
+               pixel_area(:)
+          check_intern(:,1,ipoolchange,iele) = &
+               -un * (pool_end(:,1,iele) - &
+               pool_start(:,1,iele))
+       ENDDO
+
+       closure_intern = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             closure_intern(:,1,iele) = closure_intern(:,1,iele) + &
+                  check_intern(:,1,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 3.1.3 Check mass balance closure
+       CALL check_mass_balance("basic_product_use", closure_intern, npts, &
+            pool_end, pool_start, veget_cov_max, 'products')
+      
+    ENDIF ! err_act.GT.1
+
+ !! 4. Convert the pools into fluxes and aggregate
+
+    !  Convert pools into fluxes
+    !  The pools are given in the absolute amount of carbon for the 
+    !  whole pixel and the harvest was accumulated over the year. 
+    !  The unit is thus gc pixel-1 year-1. These fluxes should be 
+    !  expressed as gC m-2 dt-1. Therefore, divide by the resolution 
+    !  of the pixel and the number of time steps within a year
+    DO iele = 1,nelements
+       flux_prod_s(:,iele) = flux_prod_s(:,iele) / one_year * &
+            dt_days / pixel_area(:) 
+       flux_prod_m(:,iele) = flux_prod_m(:,iele) / one_year * &
+            dt_days / pixel_area(:) 
+       flux_prod_l(:,iele) = flux_prod_l(:,iele) / one_year * &
+            dt_days / pixel_area(:) 
+
+       ! Calculate aggregate values
+       ! flux_prod_total is now in gC m-2 dt-1. The prod_x_total 
+       ! are in gC m-2 
+       flux_prod_total(:,iele) = flux_prod_s(:,iele) + &
+            flux_prod_m(:,iele) + flux_prod_l(:,iele)
+       prod_s_total(:,iele) = SUM(prod_s(:,:,iele),2) / pixel_area(:)
+       prod_m_total(:,iele) = SUM(prod_m(:,:,iele),2) / pixel_area(:) 
+       prod_l_total(:,iele) = SUM(prod_l(:,:,iele),2) / pixel_area(:) 
+       
+    ENDDO
+
+    IF(printlev.GE.4) WRITE(numout,*) 'Leaving basic product use'
+
+  END SUBROUTINE basic_product_use
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : dim_product_use
+!!
+!>\BRIEF        Calculate the C stored in biomass-based products and the 
+!!              CO2 release through their decomposition. 
+!!
+!! DESCRIPTION  : The basic approach distinguished 3 pools (as introduced by
+!! Shilong Piao based on Houghton. Wood harvest with small dimensions is being 
+!! used as fire wood the remaining wood goes into the short, medium and long 
+!! product pools. This implies that when the dimensions of the harvest change, 
+!! the product pools will change as well.\n
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : prod_s, prod_m, prod_l, flux_s, flux_m, flux_l,
+!!   flux_prod_s flux_prod_m and flux_prod1_l 
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!!
+!_ ================================================================================================================================
+
+ SUBROUTINE dim_product_use(npts, dt_days, harvest_pool_bound, harvest_pool, &
+            harvest_type, harvest_cut, harvest_area, &
+            flux_prod_s, flux_prod_m, flux_prod_l, prod_s, &
+            prod_m, prod_l, prod_s_total, prod_m_total, &
+            prod_l_total, flux_prod_total, flux_s, flux_m, &
+            flux_l, resolution,veget_cov_max)
+
+   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(:,:), INTENT(in)               :: resolution        !! The length in m of each grid-box in X and Y
+    REAL(r_std), DIMENSION(:), INTENT(in)                :: harvest_pool_bound!! The boundaries of the diameter classes
+                                                                              !! in the wood harvest pools @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)              :: veget_cov_max         !! Passed so we can check_mass_balance 
+                                                                              !! Making it OPTIONAL would have been nicer.
+
+
+ !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: flux_prod_s       !! C-released during first years (short term) 
+                                                                              !! following land cover change 
+                                                                              !! @tex ($gC m^{-1} dt^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: flux_prod_m       !! Total annual release from decomposition of 
+                                                                              !! the medium-lived product pool 
+                                                                              !! @tex ($gC m^{-1} dt^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: flux_prod_l       !! Total annual release from decomposition of 
+                                                                              !! the long-lived product pool 
+                                                                              !! @tex ($gC m^{-1} dt^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: prod_s_total      !! Total products remaining in the short-lived  
+                                                                              !! pool after the annual decomposition 
+                                                                              !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: prod_m_total      !! Total products remaining in the medium-lived
+                                                                              !! pool after the annual decomposition 
+                                                                              !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: prod_l_total      !! Total products remaining in the long-lived
+                                                                              !! pool after the annual release 
+                                                                              !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: flux_prod_total   !! Total flux from decomposition of the short,
+                                                                              !! medium and long lived product pools 
+                                                                              !! @tex $(gC m^{-1} dt^{-1})$ @endtex
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(:,0:,:), INTENT(inout)        :: prod_s            !! Short-lived product pool after the annual 
+                                                                              !! release of each compartment (short + 1 : 
+                                                                              !! input from year of land cover change) 
+                                                                              !! @tex ($gC pixel^{-1}$) @endtex    
+    REAL(r_std), DIMENSION(:,0:,:), INTENT(inout)        :: prod_m            !! Medium-lived product pool after the annual 
+                                                                              !! release of each compartment (medium + 1 : 
+                                                                              !! input from year of land cover change) 
+                                                                              !! @tex ($gC pixel^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(:,0:,:), INTENT(inout)        :: prod_l            !! long-lived product pool after the annual 
+                                                                              !! release of each compartment (long + 1 : 
+                                                                              !! input from year of land cover change) 
+                                                                              !! @tex ($gC pixel^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: flux_s            !! Annual release from the short-lived product 
+                                                                              !! pool @tex $(gC) pixel^{-1} year^{-1}$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: flux_m            !! Annual release from the medium-lived product  
+                                                                              !! pool @tex $(gC) pixel^{-1} year^{-1}$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: flux_l            !! Annual release from the long-lived product
+                                                                              !! pool @tex $(gC) pixel^{-1} year^{-1}$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: harvest_pool      !! The wood and biomass that have been
+                                                                              !! havested by humans @tex $(gC)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: harvest_type      !! Type of management that resulted
+                                                                              !! in the harvest (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: harvest_cut       !! Type of cutting that was used for the harvest
+                                                                              !! (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: harvest_area      !! Harvested area (m^{2})
+   
+
+    !! 0.4 Local variables
+ 
+    INTEGER(i_std)                                       :: ipts, ivm, iage   !! Indices (unitless)
+    INTEGER(i_std)                                       :: imbc, idia, iele  !! Indices (unitless)
+    REAL(r_std), DIMENSION(nelements)                    :: exported_biomass  !! Total biomass exported from the PFT (gC)
+    REAL(r_std), DIMENSION(nelements)                    :: fuelwood_biomass  !! Harvest with small dimensions that will
+                                                                              !! be used as fire wood (gC)
+    REAL(r_std), DIMENSION(nelements)                    :: timber_biomass    !! Harvest with larger dimensions that will
+                                                                              !! be used for all kinds of uses (gC)
+    REAL(r_std), DIMENSION(nelements)                    :: residual          !! Residual @tex $(gC m^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)   :: check_intern      !! Contains the components of the internal
+                                                                              !! mass balance chech for this routine
+                                                                              !! @tex $(gC m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)           :: closure_intern    !! Check closure of internal mass balance
+                                                                              !! @tex $(gC m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)           :: pool_start        !! Start pool of this routine 
+                                                                              !! @tex $(gC m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)           :: pool_end          !! End pool of this routine 
+                                                                              !! @tex $(gC m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts)                         :: pixel_area        !! surface area of the pixel @tex ($m^{2}$) @endtex
+!_ ================================================================================================================================    
+
+    IF (printlev.GE.3) WRITE(numout,*) 'Entering dimensional product use'
+ 
+
+ !! 1. initialization
+
+    !! 1.1 Fluxes and pools
+    prod_s(:,0,:) = zero
+    prod_m(:,0,:) = zero
+    prod_l(:,0,:) = zero
+    prod_s_total(:,:) = zero
+    prod_m_total(:,:) = zero
+    prod_l_total(:,:) = zero   
+    flux_prod_s(:,:) = zero
+    flux_prod_m(:,:) = zero
+    flux_prod_l(:,:) = zero
+    flux_prod_total(:,:) = zero
+
+    !! 1.2 Pixel area
+    !  Surface area (m2) of the pixel
+    pixel_area(:) = resolution(:,1) * resolution(:,2)
+
+    !! 1.3 Initialize local printlev
+    !printlev_loc=get_printlev('product_use')
+
+    !! 1.4 Initialize check for mass balance closure 
+    IF (err_act.GT.1) THEN
+
+       ! The biomass harvest pool shouldn't be multiplied by veget_cov_max
+       ! its units are already in gC pixel-1. The total amount for the 
+       ! pixel was stored in harvest_pool. Account for the harvest and
+       ! wood product pools. There are no longer PFTs
+       check_intern(:,:,:,:) = zero
+       pool_start(:,:,:) = zero
+       DO iele = 1,nelements
+          pool_start(:,1,iele) = &
+               ( SUM(SUM(harvest_pool(:,:,:,iele),3),2) + &
+               SUM(prod_l(:,:,iele),2) + SUM(prod_m(:,:,iele),2) + &
+               SUM(prod_s(:,:,iele),2) )/pixel_area(:)
+       ENDDO
+       
+    ENDIF ! err_act.GT.1
+
+    !! 1.4 Logical check of coeff_lcchange
+    !  Within a PFT the coeff_lcchange should add up to one. Else the 
+    !  carbon balance will not be closed! Do not include PFT 1 in this 
+    !  check because its coeff_lcchange were set to undef (-9999).
+    DO ivm = 2,nvm
+
+       IF ( (coeff_lcchange_s(ivm) + coeff_lcchange_m(ivm) + &
+            coeff_lcchange_l(ivm) .LT. un - min_stomate) .OR. &
+            (coeff_lcchange_s(ivm) + coeff_lcchange_m(ivm) + &
+            coeff_lcchange_l(ivm) .GT. un + min_stomate) ) THEN
+
+          WRITE(numout,*) 'Error: coeff_lcchange in sapiens_product_use.f90 ' //&
+               'do not add up to 1 in PFT - cannot close the mass balance, ',ivm
+          CALL ipslerr_p (3,'sapiens_product_use', &
+               'dim_product_use','coeff_lcchange do not add up to 1 ','')
+         
+       ENDIF
+
+    ENDDO
+
+
+ !! 2. Partition harvest in a short, medium and long-lived product pool
+
+    DO ipts = 1,npts
+
+       !! 2.1 Calculate the initial mass of the product pool (gC)
+       DO ivm = 2,nvm
+
+          !+++NOTE+++
+          ! For the moment all harvest is lumped together and we don't 
+          ! make use of harvest_type and harvest_cut to refine the product
+          ! use. If these variables are to be used be aware that for the
+          ! moment these values can be overwritten within a simulation.
+          ! Although the sequence of the calls in stomate_lpj is believed
+          ! to protect against this, it is not enforced by the code. For
+          ! example, if we first thin and then harvest, wood of both
+          ! actions will be stored in the harvest pool but it will be 
+          ! recored as just harvest (thinning will be overwritten by 
+          ! harvest and no warning will be given)
+          !++++++++++
+          fuelwood_biomass(:) = zero
+          timber_biomass(:) = zero
+ 
+          ! Grasses and crops
+          IF (fuelwood_diameter(ivm) .LT. min_stomate) THEN
+
+             !Grasses and crops do not provide fuelwood. They do have
+             ! a very short turnover time. The values stored in 
+             ! harvest_pool are absolute numbers gC (for that pixel), hence, 
+             ! the spatial extent of the LCC change, harvest or thinning has 
+             ! already been accounted for.
+             exported_biomass(:) = SUM(harvest_pool(ipts,ivm,:,:),1)
+             prod_s(ipts,0,:) = prod_s(ipts,0,:) + &
+               (coeff_lcchange_s(ivm) * exported_biomass(:))
+             prod_m(ipts,0,:) = prod_m(ipts,0,:) + &
+               (coeff_lcchange_m(ivm) * exported_biomass(:))
+             prod_l(ipts,0,:) = prod_l(ipts,0,:) + &
+               (coeff_lcchange_l(ivm) * exported_biomass(:))
+
+          ! Forests
+          ELSE
+
+             ! This is a woody PFT, check the diameter of the harvested wood
+             timber_biomass(:) = SUM(harvest_pool(ipts,ivm,:,:),1)
+             DO idia = 1,ndia_harvest
+
+                IF (harvest_pool_bound(idia) .LT. fuelwood_diameter(ivm)) THEN
+
+                   ! If the diameter of the harvest pool is below the treshold
+                   ! the wood is used as fuelwood and will end up in the short
+                   ! lived pool
+                   fuelwood_biomass(:) = fuelwood_biomass(:) + & 
+                        harvest_pool(ipts,ivm,idia,:)
+
+                ENDIF
+
+             ENDDO ! harvest diameter
+
+             ! Calculate the long lived pools as the residual of all
+             ! wood mines the fuel wood.
+             timber_biomass(:) = timber_biomass(:) - fuelwood_biomass(:)
+
+             ! Attribute the harvested biomass to pools with a different 
+             ! turnover time. The turnover times are PFT depend which 
+             ! accounts for the different uses different PFT's are put to i.e. 
+             ! wood from forests vs grass or crops. The values stored in 
+             ! harvest_pool are absolute numbers gC (for that pixel), hence, 
+             ! the spatial extent of the LCC change, harvest or thinning has 
+             ! already been accounted for.
+             prod_s(ipts,0,:) = prod_s(ipts,0,:) + fuelwood_biomass(:)
+             IF  (coeff_lcchange_m(ivm) + coeff_lcchange_l(ivm) .GT. &
+                  min_stomate) THEN
+
+                ! If the condition is satisfied, calculate the fractions
+                ! if it is not satisfied there is no medium and long lived
+                ! pool for the products. Nothing should then be done. Avoid
+                ! divide by zero
+                prod_m(ipts,0,:) = prod_m(ipts,0,:) + &
+                     (coeff_lcchange_m(ivm)/ &
+                     (coeff_lcchange_m(ivm)+coeff_lcchange_l(ivm)) * &
+                     timber_biomass(:))
+                prod_l(ipts,0,:) = prod_l(ipts,0,:) + &
+                     (coeff_lcchange_l(ivm)/ &
+                     (coeff_lcchange_m(ivm)+coeff_lcchange_l(ivm)) * &
+                     timber_biomass(:))
+
+             ENDIF ! Check coeff_lcchange
+
+          ENDIF ! grasses/crops vs forests
+
+       ENDDO ! loop over PFTs 
+
+       !! 2.2 Check whether all the harvest was used as is to be expected
+       !  The precision we are aiming for is 10-8 per m-2. The harvest pool
+       !  is expressed for the whole pixel
+       residual(:) = SUM(SUM(harvest_pool(ipts,:,:,:),2),1) - &
+            prod_s(ipts,0,:) - prod_m(ipts,0,:) - &
+            prod_l(ipts,0,:)
+      
+       DO iele = 1,nelements
+
+          IF (residual(iele)/pixel_area(ipts) .GT. min_stomate .OR. &
+               residual(iele)/pixel_area(ipts) .LT. - min_stomate) THEN
+             
+             WRITE (numout,*) 'Error: some harvest in '//&
+                  'sapiens_product_use has not been attributed'
+             WRITE (numout,*) 'Residual in pixel, iele, ', &
+                  iele, ipts, residual
+             CALL ipslerr_p (3,'sapiens_product_use', &
+                  'basic_product_use','some harvest has not been attributed',&
+                  '')
+        
+          ELSE
+
+             ! We could still have residual within the precision at the 
+             ! m2 level but outside the precision at the pixel level. 
+             ! Move the residual to the short lived pool
+             prod_s(ipts,0,iele) = prod_s(ipts,0,iele) + residual(iele)
+
+             ! All the carbon in the harvest pool was allocated to the product 
+             ! pools the harvest pool can be set to zero so we can us it with 
+             ! confidence in the mass balance calculation
+             harvest_pool(ipts,:,:,iele) = zero
+             harvest_type(ipts,:) = zero
+             harvest_cut(ipts,:) = zero
+             harvest_area(ipts,:) = zero
+
+          ENDIF 
+
+       ENDDO
+
+              !! 2.3 Update the long-turnover pool content
+       !  Update the long-turnover pool content following flux emission
+       !  of a linear decay (1/longivety) of the initial carbon input.
+       !  This must be implemented with a counter going from ::nlong to 
+       !  zero because this way it takes ::nlong years before the intial 
+       !  pool has been entirely consumed. If a more intuitive approach 
+       !  would have been used in which the counter goes from zero to
+       !  ::nlong, the pool would be depleted in the first year.
+       !  Update the long-turnover pool content following flux emission.
+       DO iage = nlong,2,-1
+
+          ! flux and prod are large numbers. At the last time step 10-5
+          ! gC remains which is outside the precision. Therefore, this 
+          ! carbon is moved to the flux 
+          IF (iage .EQ. nlong) THEN
+              
+              flux_prod_l(ipts,:) = flux_prod_l(ipts,:) + prod_l(ipts,iage-1,:)
+              flux_l(ipts,iage,:) = prod_l(ipts,iage-1,:)
+              prod_l(ipts,iage,:) = zero
+
+          ELSE
+          
+             ! ::flux_l has INTENT(inout), it thus has the value from the 
+             ! previuous year at the start of these calculations. Copy
+             ! the flux from the previous year to this year and update
+             ! the product pool
+             flux_prod_l(ipts,:) = flux_prod_l(ipts,:) + flux_l(ipts,iage,:)
+             prod_l(ipts,iage,:) = prod_l(ipts,iage-1,:) - flux_l(ipts,iage-1,:)
+             flux_l(ipts,iage,:) = flux_l(ipts,iage-1,:)
+ 
+          ENDIF
+          
+       ENDDO
+
+       ! Treat the first year separately because it is not included in 
+       ! the loop above
+       flux_prod_l(ipts,:) = flux_prod_l(ipts,:) + flux_l(ipts,1,:)
+
+       ! Each year 1/::nlong of the initial pool is decomposed. This fixed
+       ! amount of decomposition is moved to a higher age class each year. 
+       ! The units of ::flux_m are gC (absolute number as is the product 
+       ! pool). At this point in the calculation, the flux is NOT a flux 
+       ! yet but is also a pool 
+       flux_l(ipts,1,:) = (un/nlong) * prod_l(ipts,0,:)
+       prod_l(ipts,1,:) = prod_l(ipts,0,:) - flux_l(ipts,1,:)
+       prod_l(ipts,0,:) = zero
+
+       !! 2.4 Update the medium-turnover pool content 
+       !  Update the medium-turnover pool content following flux emission.
+       !  For comments see the section above. The concept is identical. 
+       DO iage = nmedium,2,-1
+
+          IF (iage .EQ. nmedium) THEN
+              
+              flux_prod_m(ipts,:) = flux_prod_m(ipts,:) + prod_m(ipts,iage-1,:)
+              flux_m(ipts,iage,:) = prod_m(ipts,iage-1,:)
+              prod_m(ipts,iage,:) = zero
+
+          ELSE
+
+             flux_prod_m(ipts,:) = flux_prod_m(ipts,:) + flux_m(ipts,iage,:)
+             prod_m(ipts,iage,:) = prod_m(ipts,iage-1,:) - flux_m(ipts,iage-1,:)
+             flux_m(ipts,iage,:) = flux_m(ipts,iage-1,:)
+         
+          ENDIF
+
+       ENDDO
+     
+       flux_prod_m(ipts,:) = flux_prod_m(ipts,:) + flux_m(ipts,1,:)
+       flux_m(ipts,1,:) = (un/nmedium) * prod_m(ipts,0,:)
+       prod_m(ipts,1,:) = prod_m(ipts,0,:) - flux_m(ipts,1,:)
+       prod_m(ipts,0,:) = zero
+
+       !! 2.5 Update the short-turnover pool
+       !  The length of the short-turnover pool will most likely be
+       !  less than length of the regular loop. The regular loop is
+       !  now conditional. 
+       !  NOTE: this code has only been tested for nshort = 1 and 
+       !  nshort = 2
+       IF (nshort .GE. 4) THEN
+
+          DO iage = nshort,2,-1
+
+             IF (iage .EQ. nshort) THEN
+              
+                flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + &
+                     prod_s(ipts,iage-1,:)
+                flux_s(ipts,iage,:) = prod_s(ipts,iage-1,:)
+                prod_s(ipts,iage,:) = zero
+
+             ELSE
+  
+                flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + &
+                     flux_s(ipts,iage,:)
+                prod_s(ipts,iage,:) = prod_s(ipts,iage-1,:) - &
+                     flux_s(ipts,iage-1,:)
+                flux_s(ipts,iage,:) = flux_s(ipts,iage-1,:)
+
+             ENDIF
+
+          ENDDO
+
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + flux_s(ipts,1,:) 
+          flux_s(ipts,1,:) = (un/nshort) * prod_s(ipts,0,:)
+          prod_s(ipts,1,:) = prod_s(ipts,0,:) - flux_s(ipts,1,:)
+          prod_s(ipts,0,:) = zero
+
+       ELSEIF (nshort .EQ. 3) THEN
+
+          ! Decompose the product pool from the last year
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + prod_s(ipts,2,:)
+          flux_s(ipts,3,:) = prod_s(ipts,2,:)
+          prod_s(ipts,3,:) = zero
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + flux_s(ipts,2,:)
+          prod_s(ipts,2,:) = prod_s(ipts,1,:) - flux_s(ipts,1,:)
+          flux_s(ipts,2,:) = flux_s(ipts,1,:)
+
+          ! Calculate the linear product decomposition for this
+          ! year's harvest
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + flux_s(ipts,1,:) 
+          flux_s(ipts,1,:) = (un/nshort) * prod_s(ipts,0,:)
+          prod_s(ipts,1,:) = prod_s(ipts,0,:) - flux_s(ipts,1,:)
+          prod_s(ipts,0,:) = zero
+
+       ELSEIF (nshort .EQ. 2) THEN
+
+          ! Decompose the product pool from last year
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + prod_s(ipts,1,:)
+          flux_s(ipts,2,:) = prod_s(ipts,1,:)
+          prod_s(ipts,2,:) = zero
+
+          ! Calculate the linear product decomposition for this
+          ! year's harvest
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + flux_s(ipts,1,:) 
+          flux_s(ipts,1,:) = (un/nshort) * prod_s(ipts,0,:)
+          prod_s(ipts,1,:) = prod_s(ipts,0,:) - flux_s(ipts,1,:)
+          prod_s(ipts,0,:) = zero
+
+       ELSEIF (nshort .EQ. 1) THEN
+
+          ! Everything decomposes in a single year. The short product
+          ! pool remains empty.
+          flux_prod_s(ipts,:) = flux_prod_s(ipts,:) + prod_s(ipts,0,:) 
+          flux_s(ipts,1,:) = prod_s(ipts,0,:)
+          prod_s(ipts,1,:) = zero
+          prod_s(ipts,0,:) = zero
+
+       ELSE
+
+          WRITE(numout,*) 'Error: flaw in the logic of IF-construct '//&
+               '(basic_product_use in sapiens_product_use.f90)'
+          CALL ipslerr_p(3,'ERROR: product_use',&
+               'Logic flaw in if-construct','','')
+          
+       ENDIF ! number of ages in short-turnover product pool
+
+    ENDDO ! #pixels - spatial domain  
+
+
+ !! 3. Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 3.1 Mass balance closure 
+       ! 3.1.1 Calculate final biomass
+       ! The biomass harvest pool shouldn't be multiplied by veget_cov_max
+       ! its in gC pixel-1 so divide by pixel_area to get a value in
+       ! gC m-2. Account for the harvest and wood product pools. The harvest 
+       ! pool should be empty, it was added for completeness.
+       pool_end = zero
+       DO iele=1,nelements
+          pool_end(:,1,iele) = &
+               ( SUM(SUM(harvest_pool(:,:,:,iele),3),2) + &
+               SUM(prod_l(:,:,iele),2) + SUM(prod_m(:,:,iele),2) + &
+               SUM(prod_s(:,:,iele),2) ) / pixel_area(:)
+       ENDDO
+
+       !! 3.1.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(:,1,iland2atm,iele) = &
+               -un * ( SUM(flux_s(:,:,iele),2) + &
+               SUM(flux_m(:,:,iele),2) + SUM(flux_l(:,:,iele),2) ) / &
+               pixel_area(:)
+          check_intern(:,1,ipoolchange,iele) = &
+               -un * (pool_end(:,1,iele) - &
+               pool_start(:,1,iele))
+       ENDDO
+
+       closure_intern = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             closure_intern(:,1,iele) = closure_intern(:,1,iele) + &
+                  check_intern(:,1,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 3.1.3 Check mass balance closure
+       CALL check_mass_balance("dimensional_product_use", closure_intern, &
+            npts, pool_end, pool_start, veget_cov_max, 'products')
+      
+    ENDIF ! err_act.GT.1
+
+ !! 4. Convert the pools into fluxes and aggregate
+
+    !  Convert pools into fluxes
+    !  The pools are given in the absolute amount of carbon for the 
+    !  whole pixel and the harvest was accumulated over the year. 
+    !  The unit is thus gc pixel-1 year-1. These fluxes should be 
+    !  expressed as gC m-2 dt-1. Therefore, divide by the resolution 
+    !  of the pixel and the number of time steps within a year
+    DO iele = 1,nelements
+       flux_prod_s(:,iele) = flux_prod_s(:,iele) / one_year * &
+            dt_days / pixel_area(:) 
+       flux_prod_m(:,iele) = flux_prod_m(:,iele) / one_year * &
+            dt_days / pixel_area(:) 
+       flux_prod_l(:,iele) = flux_prod_l(:,iele) / one_year * &
+            dt_days / pixel_area(:) 
+
+       ! Calculate aggregate values
+       ! flux_prod_total is now in gC m-2 dt-1. The prod_x_total 
+       ! are in gC m-2 
+       flux_prod_total(:,iele) = flux_prod_s(:,iele) + &
+            flux_prod_m(:,iele) + flux_prod_l(:,iele)
+       prod_s_total(:,iele) = SUM(prod_s(:,:,iele),2) / pixel_area(:)
+       prod_m_total(:,iele) = SUM(prod_m(:,:,iele),2) / pixel_area(:) 
+       prod_l_total(:,iele) = SUM(prod_l(:,:,iele),2) / pixel_area(:) 
+       
+    ENDDO
+
+    IF (printlev.GE.4) WRITE(numout,*) 'Leaving dimensional product use'
+
+
+  END SUBROUTINE dim_product_use
+
+!! ================================================================================================================================
+!! SUBROUTINE   : product_init
+!!
+!>\BRIEF        Initialize the product use variables when product use is not
+!!              calculated 
+!!
+!! DESCRIPTION  : Initialize the product use variables when product use is not
+!! calculated
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : prod_s, prod_m, prod_l, flux_s, flux_m, flux_l,
+!!   flux_prod_s flux_prod_m and flux_prod1_l 
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!!
+!_ ================================================================================================================================
+
+ SUBROUTINE product_init(flux_prod_s, flux_prod_m, flux_prod_l, &
+               prod_s_total, prod_m_total, prod_l_total, flux_s, &
+               flux_m, flux_l, flux_prod_total)
+
+   IMPLICIT NONE
+
+
+ !! 0. Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(:,:), INTENT(out)              :: flux_prod_s      !! C-released during first years (short term) 
+                                                                              !! following land cover change 
+                                                                              !! @tex ($gC m^{-1} dt^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(out)              :: flux_prod_m      !! Total annual release from decomposition of 
+                                                                              !! the medium-lived product pool 
+                                                                              !! @tex ($gC m^{-1} dt^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(out)              :: flux_prod_l      !! Total annual release from decomposition of 
+                                                                              !! the long-lived product pool 
+                                                                              !! @tex ($gC m^{-1} dt^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: prod_s_total      !! Total products remaining in the short-lived  
+                                                                              !! pool after the annual decomposition 
+                                                                              !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: prod_m_total      !! Total products remaining in the medium-lived
+                                                                              !! pool after the annual decomposition 
+                                                                              !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: prod_l_total      !! Total products remaining in the long-lived
+                                                                              !! pool after the annual release 
+                                                                              !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(out)              :: flux_prod_total  !! Total flux from decomposition of the short,
+                                                                              !! medium and long lived product pools 
+                                                                              !! @tex $(gC m^{-1} dt^{-1})$ @endtex
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: flux_s            !! Annual release from the short-lived product 
+                                                                              !! pool @tex $(gC) pixel^{-1} year^{-1}$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: flux_m            !! Annual release from the medium-lived product  
+                                                                              !! pool @tex $(gC) pixel^{-1} year^{-1}$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: flux_l            !! Annual release from the long-lived product
+                                                                              !! pool @tex $(gC) pixel^{-1} year^{-1}$ @endtex
+
+    !! 0.4 Local variables
+
+!_ ================================================================================================================================    
+
+    IF (printlev.GE.3) WRITE(numout,*) 'Entering basic product init'
+ 
+ !! 1. initialization
+
+    flux_prod_s(:,:) = zero
+    flux_prod_m(:,:) = zero
+    flux_prod_l(:,:) = zero
+    prod_s_total(:,:) = zero
+    prod_m_total(:,:) = zero
+    prod_l_total(:,:) = zero
+    flux_s(:,:,:) = zero
+    flux_m(:,:,:) = zero
+    flux_l(:,:,:) = zero
+    flux_prod_total(:,:) = zero
+
+    IF (printlev.GE.4) WRITE(numout,*) 'Leaving basic product init'
+
+  END SUBROUTINE product_init
+
+END MODULE sapiens_product_use
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate.f90	(revision 6412)
@@ -0,0 +1,6870 @@
+! =================================================================================================================================
+! MODULE       : stomate
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Groups the subroutines that: (1) initialize all variables in 
+!! stomate, (2) read and write forcing files of stomate and the soil component,
+!! (3) aggregates and convert variables to handle the different time steps 
+!! between sechiba and stomate, (4) call subroutines that govern major stomate
+!! processes (litter,\ soil, and vegetation dynamics) and (5) structures these tasks 
+!! in stomate_main
+!!
+!!\n DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate
+
+  ! Modules used:
+  USE netcdf
+  USE defprec
+  USE grid
+  USE constantes
+  USE constantes_soil
+  USE vertical_soil_var
+  USE pft_parameters
+  USE structures
+  USE sapiens_forestry,   ONLY : read_in_fm_map, read_in_litter_map, &
+                                 read_in_species_change_map, &
+                                 read_in_desired_fm_map
+  USE stomate_io
+  USE stomate_data
+  USE stomate_season
+  USE stomate_lpj
+  USE stomate_litter
+  USE stomate_vmax
+  USE stomate_som_dynamics
+  USE stomate_resp
+  USE mod_orchidee_para
+  USE ioipsl_para 
+  USE xios_orchidee
+  USE function_library,   ONLY : check_biomass_sync, cc_to_lai, &
+                                 check_surface_area, check_mass_balance
+  USE matrix_resolution
+  
+  IMPLICIT NONE
+
+  ! Private & public routines
+
+  PRIVATE
+  PUBLIC stomate_main,stomate_clear,init_forcing, stomate_forcing_read, stomate_initialize, stomate_finalize, stomate_veget_update
+
+  INTERFACE stomate_accu 
+     MODULE PROCEDURE stomate_accu_r1d, stomate_accu_r2d, stomate_accu_r3d, stomate_accu_r4d
+  END INTERFACE
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: veget_cov_max        !! Maximal fractional coverage: maximum share of a pixel
+                                                                         !! taken by a PFT. Excluding no_bio fraction 
+!$OMP THREADPRIVATE(veget_cov_max)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: age                  !! Age of PFT it normalized by biomass - can increase and
+                                                                         !! decrease - (years)
+!$OMP THREADPRIVATE(age)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: adapted              !! Winter too cold for PFT to survive (0-1, unitless)
+!$OMP THREADPRIVATE(adapted)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: regenerate           !! Winter sufficiently cold to produce viable seeds 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(regenerate)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: everywhere           !! Is the PFT everywhere in the grid box or very localized 
+                                                                         !! (after its intoduction)
+!$OMP THREADPRIVATE(everywhere)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: fireindex            !! Probability of fire (unitless)
+!$OMP THREADPRIVATE(fireindex)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: veget_lastlight      !! Vegetation fractions (on ground) after last light 
+                                                                         !! competition (unitless) 
+!$OMP THREADPRIVATE(veget_lastlight)
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:)   :: fpc_max              !! "maximal" coverage fraction of a grid box (LAI -> 
+                                                                         !! infinity) on ground. [??CHECK??] It's set to zero here, 
+                                                                         !! and then is used once in lpj_light.f90 to test if 
+                                                                         !! fpc_nat is greater than it. Something seems missing
+!$OMP THREADPRIVATE(fpc_max)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: PFTpresent           !! PFT exists (equivalent to veget > 0 for natural PFTs)
+!$OMP THREADPRIVA\TE(PFTpresent)
+  REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)           :: plant_status         !! Growth and phenological status of the plant
+                                                                         !! Different stati defined in constantes
+!$OMP THREADPRIVATE(plant_status)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: need_adjacent        !! This PFT needs to be in present in an adjacent gridbox 
+                                                                         !! if it is to be introduced in a new gridbox
+!$OMP THREADPRIVATE(need_adjacent)
+!--
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_daily         !! Daily plant available water -root profile weighted 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(humrel_daily)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: vir_humrel_daily     !! Virtual daily plant available water -root profile weighted 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(vir_humrel_daily)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: stressed_daily       !! Accumulated proxy for stressed ecosystem functioning
+                                                                         !! see variable stressed defined in sechiba
+!$OMP THREADPRIVATE(stressed_daily)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: unstressed_daily     !! Accumulated proxy for unstressed ecosystem functioning
+                                                                         !! see variable stressed defined in sechiba 
+!$OMP THREADPRIVATE(unstressed_daily)
+ 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: daylight             !! Time steps dt_radia during daylight
+!$OMP THREADPRIVATE(daylight)
+
+ REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)     :: daylight_count    !! Time steps dt_radia during daylight and when there is growth (gpp>0)
+!$OMP THREADPRIVATE(daylight_count)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: transpir_supply_daily !! Daily supply of water for transpiration @tex $(mm dt^{-1})$ @endtex
+! $OMP THREADPRIVATE(transpir_supply_daily)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: vir_transpir_supply_daily !! Daily supply of water for transpiration 
+                                                                         !! @tex $(mm dt^{-1})$ @endtex
+! $OMP THREADPRIVATE(vir_transpir_supply_daily)                                                                        
+  
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: transpir_daily       !! Daily demand of water for transpiration @tex $(mm dt^{-1})$ @endtex
+! $OMP THREADPRIVATE(transpir_daily) 
+
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_week          !! "Weekly" plant available water -root profile weighted
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(humrel_week)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_month         !! "Monthly" plant available water -root profile weighted
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(humrel_month)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_growingseason !! Mean growing season moisture availability (used for 
+                                                                         !! allocation response)
+!$OMP THREADPRIVATE(humrel_growingseason)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: vir_humrel_growingseason !! Mean growing season moisture availability (used for 
+                                                                         !! allocation response)
+!$OMP THREADPRIVATE(vir_humrel_growingseason)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxhumrel_lastyear   !! Last year's max plant available water -root profile 
+                                                                         !! weighted (0-1, unitless)
+!$OMP THREADPRIVATE(maxhumrel_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxhumrel_thisyear   !! This year's max plant available water -root profile 
+                                                                         !! weighted (0-1, unitless) 
+!$OMP THREADPRIVATE(maxhumrel_thisyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: minhumrel_lastyear   !! Last year's min plant available water -root profile 
+                                                                         !! weighted (0-1, unitless)  
+!$OMP THREADPRIVATE(minhumrel_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: minhumrel_thisyear   !! This year's minimum plant available water -root profile
+                                                                         !! weighted (0-1, unitless)
+!$OMP THREADPRIVATE(minhumrel_thisyear)
+!---  
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_daily            !! Daily air temperature at 2 meter (K)
+!$OMP THREADPRIVATE(t2m_daily)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: Tseason              !! "seasonal" 2 meter temperatures (K)
+!$OMP THREADPRIVATE(Tseason)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: Tseason_length       !! temporary variable to calculate Tseason
+!$OMP THREADPRIVATE(Tseason_length)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: Tseason_tmp          !! temporary variable to calculate Tseason
+!$OMP THREADPRIVATE(Tseason_tmp)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: Tmin_spring_time
+!$OMP THREADPRIVATE(Tmin_spring_time)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: onset_date           !! Date in the year at when the leaves started to grow(begin_leaves), only for diagnostics.
+!$OMP THREADPRIVATE(onset_date)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_week             !! Mean "weekly" (default 7 days) air temperature at 2 
+                                                                         !! meter (K)  
+!$OMP THREADPRIVATE(t2m_week)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_month            !! Mean "monthly" (default 20 days) air temperature at 2 
+                                                                         !! meter (K)
+!$OMP THREADPRIVATE(t2m_month)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_longterm         !! Mean "Long term" (default 3 years) air temperature at 
+                                                                         !! 2 meter (K) 
+!$OMP THREADPRIVATE(t2m_longterm)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_min_daily        !! Daily minimum air temperature at 2 meter (K)
+!$OMP THREADPRIVATE(t2m_min_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: tsurf_daily          !! Daily surface temperatures (K)
+!$OMP THREADPRIVATE(tsurf_daily)
+
+!---
+! variables added for windthrow module  ---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)       :: wind_speed_daily    !! Daily maximum wind speed at 2 meter (ms-1)
+!$OMP THREADPRIVATE(wind_speed_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)       :: wind_max_daily      !! Temporary daily maximum speed used to calculate wind_speed_daily (ms-1)
+!$OMP THREADPRIVATE(wind_max_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)       :: soil_temp_daily     !! Daily maximum soil temperature at 0.8 meter below ground(K)
+!$OMP THREADPRIVATE(soil_temp_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)       :: soil_max_daily      !! Temporary daily maximum soil temperature used to calculate soil_temp_speed_daily (ms-1)
+!$OMP THREADPRIVATE(soil_max_daily)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_daily         !! Daily precipitations sum @tex $(mm day^{-1})$ @endtex
+!$OMP THREADPRIVATE(precip_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_lastyear      !! Last year's annual precipitation sum 
+                                                                         !! @tex $??(mm year^{-1})$ @endtex
+!$OMP THREADPRIVATE(precip_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_thisyear      !! This year's annual precipitation sum 
+                                                                         !! @tex $??(mm year^{-1})$ @endtex 
+!$OMP THREADPRIVATE(precip_thisyear)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: soilhum_daily        !! Daily soil humidity (0-1, unitless)
+!$OMP THREADPRIVATE(soilhum_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: soilhum_month        !! Soil humidity - integrated over a month (0-1, unitless) 
+!$OMP THREADPRIVATE(soilhum_month)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: tsoil_daily          !! Daily soil temperatures (K)
+!$OMP THREADPRIVATE(tsoil_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: tsoil_month          !! Soil temperatures at each soil layer integrated over a
+                                                                         !! month (K) 
+!$OMP THREADPRIVATE(tsoil_month)
+!--- 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: litterhum_daily      !! Daily litter humidity (0-1, unitless)
+!$OMP THREADPRIVATE(litterhum_daily)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: control_moist        !! Moisture control of heterotrophic respiration 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(control_moist)
+ REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)   :: drainage             !! Fraction of water lost from the soil column by leaching (-)  
+!$OMP THREADPRIVATE(drainage) 
+ REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)     :: drainage_daily       !! Daily Fraction of water lost from the soil column by leaching (-)  
+!$OMP THREADPRIVATE(drainage_daily) 
+ REAL(r_std),ALLOCATABLE,SAVE, DIMENSION(:,:)    :: n_mineralisation_d   !! net nitrogen mineralisation of decomposing SOM 	                                                                                         !! (gN/m**2/day), supposed to be NH4  
+!$OMP THREADPRIVATE(n_mineralisation_d) 
+ REAL(r_std),ALLOCATABLE,SAVE, DIMENSION(:,:,:)  :: plant_n_uptake_daily   !! Uptake of soil N by plants    
+                                                                         !! (gN/m**2/day)  
+!$OMP THREADPRIVATE(plant_n_uptake_daily) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: control_temp         !! Temperature control of heterotrophic respiration at the
+                                                                         !! different soil levels (0-1, unitless)
+!$OMP THREADPRIVATE(control_temp)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: control_moist_daily  !! Moisture control of heterotrophic respiration daily 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(control_moist_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: control_temp_daily   !! Temperature control of heterotrophic respiration, above
+                                                                         !! and below daily (0-1, unitless)
+!$OMP THREADPRIVATE(control_temp_daily)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_init_date        !! inital date for gdd count 
+!$OMP THREADPRIVATE(gdd_init_date)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_from_growthinit  !! gdd from beginning of season (C)
+!$OMP THREADPRIVATE(gdd_from_growthinit)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: gdd0_lastyear        !! Last year's annual Growing Degree Days,
+                                                                         !! threshold 0 deg C (K) 
+!$OMP THREADPRIVATE(gdd0_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: gdd0_thisyear        !! This year's annual Growing Degree Days,
+                                                                         !! threshold 0 deg C (K)
+!$OMP THREADPRIVATE(gdd0_thisyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_m5_dormance      !! Growing degree days for onset of growing season, 
+                                                                         !! threshold -5 deg C (K)
+!$OMP THREADPRIVATE(gdd_m5_dormance)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_midwinter        !! Growing degree days for onset of growing season, 
+                                                                         !! since midwinter (K)
+!$OMP THREADPRIVATE(gdd_midwinter)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: ncd_dormance         !! Number of chilling days since leaves were lost (days) 
+!$OMP THREADPRIVATE(ncd_dormance)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: ngd_minus5           !! Number of growing days, threshold -5 deg C (days)
+!$OMP THREADPRIVATE(ngd_minus5)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: hum_min_dormance     !! Minimum moisture during dormance (0-1, unitless) 
+!$OMP THREADPRIVATE(hum_min_dormance)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gpp_daily            !! Daily gross primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(gpp_daily) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gpp_week             !! Mean "weekly" (default 7 days) GPP  
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(gpp_week)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxgppweek_lastyear  !! Last year's maximum "weekly" GPP  
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex 
+!$OMP THREADPRIVATE(maxgppweek_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxgppweek_thisyear  !! This year's maximum "weekly" GPP  
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex  
+!$OMP THREADPRIVATE(maxgppweek_thisyear)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: npp_daily            !! Daily net primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex 
+!$OMP THREADPRIVATE(npp_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: npp_longterm         !! "Long term" (default 3 years) net primary productivity 
+                                                                         !! per ground area  
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex   
+!$OMP THREADPRIVATE(npp_longterm)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: npp_equil            !! Equilibrium NPP written to forcesoil 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(npp_equil)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: npp_tot              !! Total NPP written to forcesoil 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+!$OMP THREADPRIVATE(npp_tot)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: resp_maint_part_radia!! Maintenance respiration of different plant parts per 
+                                                                         !! total ground area at Sechiba time step  
+                                                                         !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_maint_part_radia)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: resp_maint_part      !! Maintenance respiration of different plant parts per
+                                                                         !! total ground area at Stomate time step 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_maint_part)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_maint_radia     !! Maintenance respiration per ground area at Sechiba time
+                                                                         !! step   
+                                                                         !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_maint_radia)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_maint_d         !! Maintenance respiration per ground area at Stomate time 
+                                                                         !! step  
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_maint_d)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_growth_d        !! Growth respiration per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_growth_d)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_hetero_d        !! Heterotrophic respiration per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_hetero_d)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_hetero_radia    !! Heterothrophic respiration per ground area at Sechiba
+                                                                         !! time step 
+                                                                         !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex 
+!$OMP THREADPRIVATE(resp_hetero_radia)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)     :: turnover_time       !! Turnover time of grasses 
+                                                                         !! @tex $(dt_stomate^{-1})$ @endtex 
+!$OMP THREADPRIVATE(turnover_time)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: turnover_daily      !! Senescence-driven turnover (better: mortality) of 
+                                                                         !! leaves and roots  
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(turnover_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: turnover_littercalc !! Senescence-driven turnover (better: mortality) of 
+                                                                         !! leaves and roots at Sechiba time step 
+                                                                         !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex 
+!$OMP THREADPRIVATE(turnover_littercalc)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: turnover_longterm   !! "Long term" (default 3 years) senescence-driven 
+                                                                         !! turnover (better: mortality) of leaves and roots 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(turnover_longterm)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: bm_to_litter        !! Background (not senescence-driven) mortality of biomass
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(bm_to_litter)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: bm_to_littercalc    !! conversion of biomass to litter per ground area at 
+                                                                         !! Sechiba time step 
+                                                                         !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex 
+!$OMP THREADPRIVATE(bm_to_littercalc)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: dead_leaves          !! Metabolic and structural pools of dead leaves on ground
+                                                                         !! per PFT @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(dead_leaves)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:):: litter             !! Above and below ground metabolic and structural litter 
+                                                                         !! per ground area 
+                                                                         !! @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(litter)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: firelitter           !! Total litter above the ground that could potentially 
+                                                                         !! burn @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(firelitter)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: carbon_input     !! Quantity of carbon going into carbon pools from litter
+                                                                         !! decomposition per ground area  at Sechiba time step 
+                                                                         !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex 
+!$OMP THREADPRIVATE(carbon_input)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: nitrogen_input       !! Quantity of nitrogen going into nitrogen pools from litter 
+                                                                         !! decomposition per ground area  at Sechiba time step  
+                                                                         !! @tex $(gC m^{-2} dtradia^{-1})$ @endtex  
+!$OMP THREADPRIVATE(nitrogen_input) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:)  :: som_input_daily !! Daily quantity of carbon going into carbon pools from
+                                                                           !! litter decomposition per ground area 
+                                                                           !! @tex $(gC m^{-2} day^{-1})$ @endtex 
+!$OMP THREADPRIVATE(som_input_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:)  :: som                !! Soil organic matter  pools per ground area: active, slow, or 
+                                                                         !! passive, @tex $(gC or N m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(som)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: lignin_struc         !! Ratio Lignine/Carbon in structural litter for above and
+                                                                         !! below ground compartments (unitless)
+!$OMP THREADPRIVATE(lignin_struc)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: lignin_wood          !! Ratio Lignine/Carbon in woody litter for above and
+                                                                         !! below ground compartments (unitless)	
+!$OMP THREADPRIVATE(lignin_wood)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: lm_lastyearmax       !! Last year's maximum leaf mass per ground area for each
+                                                                         !! PFT @tex $(gC m^{-2})$ @endtex  
+!$OMP THREADPRIVATE(lm_lastyearmax)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: lm_thisyearmax       !! This year's maximum leaf mass per ground area for each
+                                                                         !! PFT @tex $(gC m^{-2})$ @endtex  
+!$OMP THREADPRIVATE(lm_thisyearmax)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxfpc_lastyear      !! Last year's maximum fpc for each natural PFT, on ground
+                                                                         !! [??CHECK] fpc but this ones look ok (computed in 
+                                                                         !! season, used in light)?? 
+!$OMP THREADPRIVATE(maxfpc_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxfpc_thisyear      !! This year's maximum fpc for each PFT, on ground (see 
+                                                                         !! stomate_season), [??CHECK] fpc but this ones look ok 
+                                                                         !! (computed in season, used in light)??
+!$OMP THREADPRIVATE(maxfpc_thisyear)
+!---
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: leaf_age             !! Age of different leaf classes (days)
+!$OMP THREADPRIVATE(leaf_age)
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: leaf_frac            !! PFT fraction of leaf mass in leaf age class (0-1, 
+                                                                         !! unitless) 
+!$OMP THREADPRIVATE(leaf_frac)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: when_growthinit      !! Days since beginning of growing season (days)
+!$OMP THREADPRIVATE(when_growthinit)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: herbivores           !! Time constant of probability of a leaf to be eaten by a
+                                                                         !! herbivore (days)
+!$OMP THREADPRIVATE(herbivores)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: RIP_time             !! How much time ago was the PFT eliminated for the last 
+                                                                         !! time (year)
+!$OMP THREADPRIVATE(RIP_time)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: time_hum_min         !! Time elapsed since strongest moisture limitation (days) 
+!$OMP THREADPRIVATE(time_hum_min)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: drain_daily          !! daily fraction of water lost from the soil column by leaching (-)  
+!$OMP THREADPRIVATE(drain_daily)
+
+!---
+  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(:,:)         :: silt_fm              !! Soil silt content (0-1, unitless), parallel computing 
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: silt_fm_g            !! Soil silt content (0-1, unitless), parallel computing 
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: bulk_fm              !! Bulk density (kg/m**3), parallel computing    
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: bulk_fm_g            !! Bulk density (kg/m**3), parallel computing 
+
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: precip_fm            !! Daily precipitations sum @tex $(mm day^{-1})$ @endtex,
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: precip_fm_g          !! Daily precipitations sum @tex $(mm day^{-1})$ @endtex,
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: litterhum_daily_fm   !! Daily relative humidity of litter (0-1, unitless), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: litterhum_daily_fm_g !! Daily relative humidity of litter (0-1, unitless), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: t2m_daily_fm         !! Daily air temperature at 2 meter (K), parallel 
+                                                                         !! computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: t2m_daily_fm_g       !! Daily air temperature at 2 meter (K), parallel 
+                                                                         !! computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: t2m_min_daily_fm     !! Daily minimum air temperature at 2 meter (K), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: t2m_min_daily_fm_g   !! Daily minimum air temperature at 2 meter (K), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: tsurf_daily_fm       !! Daily surface temperatures (K), parallel 
+                                                                         !! computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: tsurf_daily_fm_g     !! Daily surface temperatures (K), parallel 
+                                                                         !! computing 
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: tsoil_daily_fm       !! Daily soil temperatures (K), parallel computing 
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: tsoil_daily_fm_g     !! Daily soil temperatures (K), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: soilhum_daily_fm     !! Daily soil humidity (0-1, unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: soilhum_daily_fm_g   !! Daily soil humidity (0-1, unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: humrel_daily_fm      !! Daily relative humidity of atmosphere (0-1, unitless), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: humrel_daily_fm_g    !! Daily relative humidity of atmosphere (0-1, unitless), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: gpp_daily_fm         !! Daily gross primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex, 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: gpp_daily_fm_g       !! Daily gross primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} day^{-1})$ @endtex, 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: veget_fm             !! Vegetation coverage taking into account non-biological
+                                                                         !! coverage (unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: veget_fm_g           !! Vegetation coverage taking into account non-biological
+                                                                         !! coverage (unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: veget_max_fm         !! Maximum vegetation coverage taking into account 
+                                                                         !! non-biological coverage (unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: veget_max_fm_g       !! Maximum vegetation coverage taking into account none 
+                                                                         !! biological coverage (unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: lai_fm               !! Leaf area index @tex $@tex $(m^2 m^{-2})$ @endtex$ @endtex, 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: lai_fm_g             !! Leaf area index @tex $@tex $(m^2 m^{-2})$ @endtex$ @endtex, 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: drainage_fm           !! daily fraction of water lost from the soil column by leaching (-)                                                                           
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: drainage_fm_g         !! drain 
+                                                                         !! parallel computing 
+ REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:)   :: cn_leaf_min_season    !! Seasonal min CN ratio of leaves 
+!$OMP THREADPRIVATE(cn_leaf_min_season)
+ REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:)   :: nstress_season        !! N-related seasonal stress (used for allocation) 
+!$OMP THREADPRIVATE(nstress_season)
+ REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: soil_n_min            !! mineral nitrogen in the soil (gN/m**2)   
+                                                                         !! (first index=kjpindex, second index=nvm, third index=nnspec)   
+!$OMP THREADPRIVATE(soil_n_min)
+ REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:) :: p_O2                  !! partial pressure of oxigen in the soil (hPa)(first index=kjpindex, second index=nvm)
+!$OMP THREADPRIVATE(p_O2)
+                      
+ REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:) :: bact                  !! denitrifier biomass (gC/m**2)
+                                                                         !! (first index=kjpindex, second index=nvm)
+!$OMP THREADPRIVATE(bact)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)   :: co2_fire              !! Carbon emitted to the atmosphere by burning living 
+                                                                         !! and dead biomass 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex 
+!$OMP THREADPRIVATE(co2_fire)
+!!$  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: co2_to_bm_dgvm       !! Psuedo-photosynthesis,C used to provide seedlings with
+!!$                                                                         !! an initial biomass, arbitrarily removed from the 
+!!$                                                                         !! atmosphere  
+!!$                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex 
+!!$!$OMP THREADPRIVATE(co2_to_bm_dgvm)
+!!$  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: n_to_bm              !! N taken from ?? to provide seedlings with
+!!$                                                                         !! an initial N biomass
+!!$                                                                         !! @tex $(gN m^{-2} dt_stomate^{-1})$ @endtex 
+!!$!$OMP THREADPRIVATE(n_to_bm)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: atm_to_bm            !! C and N taken from the atmosphere to provide seedlings 
+                                                                         !! with an initial N biomass
+                                                                         !! @tex $(gN m^{-2} dt_stomate^{-1})$ @endtex 
+!$OMP THREADPRIVATE(atm_to_bm)
+
+!!$  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: co2_flux_daily       !! Daily net CO2 flux between atmosphere and biosphere 
+!!$                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!!$                                                                         !! [??CHECK] sign convention?
+!!$!$OMP THREADPRIVATE(co2_flux_daily)
+!!$  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: co2_flux_monthly     !! Monthly net CO2 flux between atmosphere and biosphere 
+!!$                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!!$                                                                         !! [??CHECK] sign convention? 
+!!$!$OMP THREADPRIVATE(co2_flux_monthly)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: prod_s               !! Wood products remaining in the 1 year-turnover pool 
+                                                                         !! after the annual release for each compartment 
+                                                                         !! @tex $(gC m^{-2})$ @endtex    
+                                                                         !! (0:1 input from year of land cover change),
+                                                                         !! dimension(#pixels,0:1 years
+!$OMP THREADPRIVATE(prod_s)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: prod_m               !! Wood products remaining in the 10 year-turnover pool 
+                                                                         !! after the annual release for each compartment 
+                                                                         !! @tex $(gC m^{-2})$ @endtex    
+                                                                         !! (0:10 input from year of land cover change),
+                                                                         !! dimension(#pixels,0:10 years
+!$OMP THREADPRIVATE(prod_m)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: prod_l               !! Wood products remaining in the 100 year-turnover pool
+                                                                         !! after the annual release for each compartment
+                                                                         !! @tex $(gC m^{-2})$ @endtex  
+                                                                         !! (0:100 input from year of land cover change), 
+                                                                         !! dimension(#pixels,0:100 years)
+!$OMP THREADPRIVATE(prod_l)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: flux_s               !! Wood decomposition from the 1 year-turnover pool 
+                                                                         !! compartments 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+                                                                         !! dimension(#pixels,0:1)  
+!$OMP THREADPRIVATE(flux_s)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: flux_m               !! Wood decomposition from the 10 year-turnover pool 
+                                                                         !! compartments 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+                                                                         !! dimension(#pixels,0:10)  
+!$OMP THREADPRIVATE(flux_m)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: flux_l              !! Wood decomposition from the 100 year-turnover pool 
+                                                                         !! compartments 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+                                                                         !! dimension(#pixels,0:100)
+!$OMP THREADPRIVATE(flux_l)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: flux_prod_s         !! Release during first year following land cover change 
+                                                                         !! (paper, burned, etc...) 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex  
+!$OMP THREADPRIVATE(flux_prod_s)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: flux_prod_m         !! Total annual release from the 10 year-turnover pool
+                                                                         !! sum of flux_m  
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(flux_prod_m)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: flux_prod_l         !! Total annual release from the 100 year-turnover pool 
+                                                                         !! sum of flux_l 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(flux_prod_l)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: carb_mass_total      !! Total on-site and off-site C pool 
+                                                                         !! @tex $(??gC m^{-2})$ @endtex                        
+!$OMP THREADPRIVATE(carb_mass_total)
+!---
+  REAL(r_std), SAVE                              :: tau_longterm
+!$OMP THREADPRIVATE(tau_longterm)
+  REAL(r_std),SAVE                               :: dt_days=zero         !! Time step of STOMATE (days) 
+!$OMP THREADPRIVATE(dt_days)
+  INTEGER(i_std),SAVE                            :: date=0               !! Date (days) 
+!$OMP THREADPRIVATE(date)
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:)   :: nforce               !! Number of states calculated for the soil forcing 
+                                                                         !! variables (unitless), dimension(::nparan*::nbyear) both 
+                                                                         !! given in the run definition file    
+!$OMP THREADPRIVATE(nforce)
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:)   :: isf                  !! Index for number of time steps that can be stored in 
+                                                                         !! memory (unitless), dimension (#nsfm)
+!$OMP THREADPRIVATE(isf)
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:)   :: nf_cumul             !! Number of years over which the average is calculated in
+                                                                         !! forcesoil when cumul flag is set, dimension (#nsft)
+                                                                         !! [??CHECK] definition the dimension is number of 
+                                                                         !! timesteps in a year?
+!$OMP THREADPRIVATE(nf_cumul)
+  INTEGER(i_std), SAVE                           :: spinup_period        !! Period of years used to calculate the resolution of the system for spinup analytic. 
+                                                                         !! This period correspond in most cases to the period of years of forcing data used
+  INTEGER,PARAMETER                              :: r_typ = nf90_real4   !! Specify data format (server dependent)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:)          :: nf_written           !! Flag indicating whether the forcing data have been 
+                                                                         !! written
+!$OMP THREADPRIVATE(nf_written)
+!---
+  LOGICAL, SAVE                                  :: do_slow=.FALSE.      !! Flag that determines whether stomate_accu calculates
+                                                                         !! the sum(do_slow=.FALSE.) or the mean 
+                                                                         !! (do_slow=.TRUE.)
+!$OMP THREADPRIVATE(do_slow)
+  LOGICAL, SAVE                                  :: EndOfYear=.FALSE.    !! Update annual variables? This variable must be 
+                                                                         !! .TRUE. once a year
+!$OMP THREADPRIVATE(EndOfYear)
+  LOGICAL, SAVE                                  :: EndOfMonth=.FALSE.   !! Update monthly variables? This variable must be 
+                                                                         !!.TRUE. once a month 
+!$OMP THREADPRIVATE(EndOfMonth)
+  LOGICAL, SAVE                                  :: l_first_stomate = .TRUE.!! Is this the first call of stomate?
+!$OMP THREADPRIVATE(l_first_stomate)
+  LOGICAL, SAVE                                  :: cumul_forcing=.FALSE.!! flag for cumul of forcing if teststomate
+!$OMP THREADPRIVATE(cumul_forcing)
+  LOGICAL, SAVE                                  :: cumul_Cforcing=.FALSE.  !! Flag, if internal parameter cumul_Cforcing is 
+                                                                            !! TRUE then ::nbyear (defined in run definition 
+                                                                            !! file will be forced to 1 later in this module. If 
+                                                                            !! FALSE the mean over ::nbyear is written in forcesoil
+!$OMP THREADPRIVATE(cumul_Cforcing)
+!--- 
+
+  REAL(r_std),DIMENSION(:),ALLOCATABLE,SAVE      :: circ_class_dist   !! When the circumference class distribution
+                                                                      !! is redone due to empty classes, this is the
+                                                                      !! tree distribution used.  Notice that this distribution
+                                                                      !! is normalized after being read in.
+!$OMP THREADPRIVATE(circ_class_dist)
+  REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE,SAVE  :: store_sum_delta_ba!! Sum of increase of basal area (m^2) which does not pass
+                                                                      !! through gap clean
+!$OMP THREADPRIVATE(store_sum_delta_ba)
+  REAL(r_std),DIMENSION(:),ALLOCATABLE,SAVE      :: st_dist           !! During self-thinning, we need to decide which
+                                                                      !! circumference classes to kill trees in.  This
+                                                                      !! is the distribution that tells us this.  Notice that 
+                                                                      !! it is normalized after being read in.
+!$OMP THREADPRIVATE(st_dist)
+  
+!!$  !+++CHECK+++
+!!$  ! replaced by harvest_xxx. Seems like post processing for xios
+!!$  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: harvest_above_monthly   !! [??CHECK] post-processing - should be removed?
+!!$!$OMP THREADPRIVATE(harvest_above_monthly)
+!!$  !+++++++++++
+!!$
+!!$  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: flux_prod_monthly      !! [??CHECK] post-processing - should be removed?
+!!$!$OMP THREADPRIVATE(flux_prod_monthly)
+!---
+  INTEGER(i_std), SAVE                               :: global_years        !! Global counter of years (year)
+!$OMP THREADPRIVATE(global_years)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)           :: ok_equilibrium      !! Logical array marking the points where the resolution is ok 
+                                                                            !! (true/false)
+!$OMP THREADPRIVATE(ok_equilibrium)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)           :: carbon_eq           !! Logical array to mark the carbon pools at equilibrium ? 
+                                                                            !! If true, the job stops. (true/false)
+!$OMP THREADPRIVATE(carbon_eq)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)       :: nbp_accu            !! Accumulated Net Biospheric Production over the year (gC.m^2 )
+!$OMP THREADPRIVATE(nbp_accu)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)     :: nbp_accu_pool       !! Accumulated pool-basaed Net Biospheric Production over the year (gC.m^2 )
+!$OMP THREADPRIVATE(nbp_accu_pool)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)       :: nbp_flux            !! Net Biospheric Production (gC.m^2.day^{-1})
+!$OMP THREADPRIVATE(nbp_flux)
+  REAL(r_std), ALLOCATABLE, SAVE,DIMENSION(:,:)      :: nbp_pool            !! Pool-based Net Biospheric Production (gC.m^2.day^{-1})
+!$OMP THREADPRIVATE(nbp_pool)
+  REAL(r_std), ALLOCATABLE, SAVe,DIMENSION(:,:)      :: nbp_pool_start      !! Biomass pool as calculated from the 
+                                                                            !! previous time step
+!$OMP THREADPRIVATE(nbp_pool_start)
+  REAL(r_std), ALLOCATABLE, SAVE,DIMENSION(:,:)      :: nbp_pool_end        !! Biomass pool calculated at the end 
+                                                                            !! current time step
+!$OMP THREADPRIVATE(nbp_pool_end)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:)       :: matrixA             !! matrix containing the fluxes between the carbon pools
+                                                                            !! per sechiba time step 
+                                                                            !! @tex $(gC.m^2.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(matrixA)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)         :: vectorB             !! vector containing the litter increase per sechiba time step
+                                                                            !! @tex $(gC m^{-2})$ @endtex
+!$OMP THREADPRIVATE(vectorB)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: matrixV             !! matrix containing the accumulated values of matrixA 
+!$OMP THREADPRIVATE(matrixV)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: vectorU             !! matrix containing the accumulated values of vectorB
+!$OMP THREADPRIVATE(vectorU)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: matrixW             !! matrix containing the opposite of matrixA
+!$OMP THREADPRIVATE(matrixW)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: previous_stock      !! Array containing the carbon stock calculated by the analytical
+                                                                            !! method in the previous resolution
+!$OMP THREADPRIVATE(previous_stock)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: current_stock       !! Array containing the carbon stock calculated by the analytical
+                                                                            !! method in the current resolution 
+!$OMP THREADPRIVATE(current_stock)
+  REAL(r_std), SAVE                                  :: eps_carbon          !! Stopping criterion for carbon pools (unitless,0-1)
+!$OMP THREADPRIVATE(eps_carbon)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)           :: sigma            !! Threshold for indivudal tree growth (m, trees whose
+                                                                         !! circumference is smaller than sigma don't grow much)
+!$OMP THREADPRIVATE(sigma)
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: age_stand        !! Age of stand (years)
+!$OMP THREADPRIVATE(age_stand)
+  
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: rotation_n       !! Rotation number (number of rotation since pft is managed)
+!$OMP THREADPRIVATE(rotation_n)
+  
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: last_cut         !! Years since last thinning (years)
+!$OMP THREADPRIVATE(last_cut)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: CN_som_litter_longterm !! Longterm CN ratio of litter and som pools (gC/gN)
+
+  REAL(r_std), SAVE                                 :: tau_CN_longterm      !! Counter used for calculating the longterm CN ratio of SOM and litter pools (seconds)    
+
+  ! Functional Allocation
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)     :: KF               !! Scaling factor to convert sapwood mass
+                                                                         !! into leaf mass (m). The initial value is calculated
+                                                                         !! in prescribe and updated during allocation
+!$OMP THREADPRIVATE(KF)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)     :: k_latosa_adapt   !! Leaf to sapwood area adapted for waterstress. 
+                                                                         !! Adaptation takes place at the end of the year
+                                                                         !! (m)
+!$OMP THREADPRIVATE(k_latosa_adapt)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: harvest_pool     !! The pool which records the quantity of
+                                                                         !! wood harvested and thinned due to forest
+                                                                         !! management and LCC.  
+                                                                         !! @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(harvest_pool)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)     :: harvest_type     !! Type of management that resulted
+                                                                         !! in the harvest (unitless)
+!$OMP THREADPRIVATE(harvest_type)  
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)     :: harvest_cut      !! Type of cutting that was used for the harvest
+                                                                         !! (unitless)
+!$OMP THREADPRIVATE(harvest_cut)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)     :: harvest_area     !! Harvested area (m^{2})
+!$OMP THREADPRIVATE(harvest_area)  
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: harvest_5y_area  !!Total harvested area in the last 5 years (m^{2})
+!$OMP THREADPRIVATE(harvest_5y_area)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)       :: harvest_pool_bound       !! The boundaries of the diameter classes
+                                                                                 !! in the wood harvest pools
+                                                                                 !! @tex $(m)$ @endtex 
+!$OMP THREADPRIVATE(harvest_pool_bound)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)     :: mai              !! The mean annual increment used in
+                                                                         !! forestry.  It is the average change
+                                                                         !! in the wood volume of of the trunk
+                                                                         !! over the lifetime of the forest.
+                                                                         !! @tex $(m**3 / m**2 / year)$ @endtex 
+!$OMP THREADPRIVATE(mai)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)     :: pai              !! The period annual increment used in
+                                                                         !! forestry.  It is the average change
+                                                                         !! in the wood volume of of the trunk
+                                                                         !! over the past n_pai years of the forest,
+                                                                         !! where n_pai is defined in constants.f90.
+                                                                         !! @tex $(m**3 / m**2 / year)$ @endtex 
+!$OMP THREADPRIVATE(pai)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)     :: previous_wood_volume !! The volume of the tree trunks
+                                                                         !! in a stand for the previous year.
+                                                                         !! @tex $(m**3 / m**2 )$ @endtex 
+!$OMP THREADPRIVATE(previous_wood_volume)
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: mai_count        !! The number of times we've
+                                                                         !! calculated the volume increment
+                                                                         !! for a stand
+!$OMP THREADPRIVATE(mai_count)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)     :: coppice_dens     !! The density of a coppice at the first
+                                                                         !! cutting.
+                                                                         !! @tex $( 1 / m**2 )$ @endtex 
+!$OMP THREADPRIVATE(coppice_dens)
+
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:)   :: rue_longterm         !! Longterm radiation use efficiency (??units??)
+!$OMP THREADPRIVATE(rue_longterm)
+
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:)   :: lab_fac              !! Activity of labile pool factor (??units??)
+
+  REAL(r_std),SAVE                                   :: dt_forcesoil        !! Time step of soil forcing file (days)
+!$OMP THREADPRIVATE(dt_forcesoil)
+  INTEGER(i_std),PARAMETER                           :: nparanmax=366       !! Maximum number of time steps per year for forcesoil
+  INTEGER(i_std),SAVE                                :: nparan              !! Number of time steps per year for forcesoil read from run definition (unitless) 
+!$OMP THREADPRIVATE(nparan)
+  INTEGER(i_std),SAVE                                :: nbyear=1            !! Number of years saved for forcesoil (unitless) 
+!$OMP THREADPRIVATE(nbyear)
+  INTEGER(i_std),SAVE                                :: iatt                !! Time step of forcing of soil processes (iatt = 1 to ::nparan*::nbyear) 
+!$OMP THREADPRIVATE(iatt)
+  INTEGER(i_std),SAVE                                :: iatt_old=1          !! Previous ::iatt
+!$OMP THREADPRIVATE(iatt_old)
+  INTEGER(i_std),SAVE                                :: nsfm                !! Number of time steps that can be stored in memory (unitless) 
+!$OMP THREADPRIVATE(nsfm)
+  INTEGER(i_std),SAVE                                :: nsft                !! Number of time steps in a year (unitless)
+!$OMP THREADPRIVATE(nsft)
+  INTEGER(i_std),SAVE                                :: iisf                !! Current pointer for teststomate (unitless)
+!$OMP THREADPRIVATE(iisf)
+  CHARACTER(LEN=100), SAVE                           :: forcing_name        !! Name of forcing file 1
+!$OMP THREADPRIVATE(forcing_name)
+  CHARACTER(LEN=100), SAVE                           :: Cforcing_name       !! Name of forcing file 2
+!$OMP THREADPRIVATE(Cforcing_name)
+  INTEGER(i_std),SAVE                                :: Cforcing_id         !! File identifer of file 2
+!$OMP THREADPRIVATE(Cforcing_id)    
+  INTEGER(i_std),PARAMETER                           :: ndm = 10            !! Maximum number of dimensions (unitless)
+
+INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: forest_managed   !! forest management flag (is the forest being managed?)
+                                                                         !! (0-4,unitless)
+!$OMP THREADPRIVATE(forest_managed)
+  
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: forest_managed_lastyear !! forest management flag for the previous year
+                                                                         !! (0-4,unitless)
+!$OMP THREADPRIVATE(forest_managed_lastyear)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: species_change_map   !! A map which gives the PFT number that each
+                                                                         !! PFT will be replanted as in case of a clearcut.
+                                                                         !! (1-nvm,unitless)
+!$OMP THREADPRIVATE(species_change_map)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: fm_change_map    !! A map which gives the desired FM strategy when
+                                                                         !! the PFT will be replanted after a clearcut.
+                                                                         !! (1-nvm,unitless)
+!$OMP THREADPRIVATE(fm_change_map)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:)         :: lpft_replant     !! Indicates if this PFT has either died this year
+                                                                         !! or been clearcut/coppiced.  If it has, it is not
+                                                                         !! replanted until the end of the year.
+!$OMP THREADPRIVATE(lpft_replant)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)       :: litter_demand    !! The amount of litter which will
+                                                                         !! be moved from forest to crop pools
+                                                                         !! at the end of the year.
+                                                                         !! @tex $( gC / year )$ @endtex 
+!$OMP THREADPRIVATE(litter_demand)
+
+REAL(r_std), ALLOCATABLE, SAVE,DIMENSION(:,:)      :: wstress_season   !! Water stress factor, based on hum_rel_daily
+                                                                         !! (unitless, 0-1)
+!$OMP THREADPRIVATE(wstress_season)
+
+  REAL(r_std), ALLOCATABLE, SAVE,DIMENSION(:,:)     :: wstress_month    !! Water stress factor, based on hum_rel_daily
+                                                                         !! (unitless, 0-1)
+!$OMP THREADPRIVATE(wstress_month)
+
+REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)    :: light_tran_to_level_season  !! Mean seasonal fraction of light transmitted 
+                                                                                  !! to canopy levels
+!$OMP THREADPRIVATE(light_tran_to_level_season)
+
+ 
+PUBLIC clay_fm, silt_fm, bulk_fm, humrel_daily_fm, litterhum_daily_fm, t2m_daily_fm, &
+   & t2m_min_daily_fm, tsurf_daily_fm, tsoil_daily_fm, soilhum_daily_fm, &
+   & precip_fm, gpp_daily_fm, veget_fm, veget_max_fm, lai_fm
+PUBLIC  dt_days, date, do_slow, EndOfYear
+PUBLIC isf, nf_written
+
+CONTAINS
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_initialize
+!!
+!>\BRIEF        Initialization routine for stomate module. 
+!!
+!! DESCRIPTION  : Initialization routine for stomate module. Read options from parameter file, allocate variables, read variables 
+!!                from restart file and initialize variables if necessary. 
+!!                
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE stomate_initialize &
+        (kjit,           kjpij,             kjpindex,                        &
+         rest_id_stom,   hist_id_stom,      hist_id_stom_IPCC,               &
+         index,          lalo,              neighbours,   resolution,        &
+         contfrac,       totfrac_nobio,     clay,         silt,              &
+         bulk,           t2m,                                                &
+         veget,          veget_max,                                          &
+         co2_flux,       fco2_lu,           deadleaf_cover,  assim_param,    &
+         circ_class_biomass, circ_class_n,&
+         lai_per_level,  laieff_fit)
+
+    IMPLICIT NONE
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in)                       :: kjit              !! Time step number (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpij             !! Total size of the un-compressed grid (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpindex          !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std),INTENT(in)                       :: rest_id_stom      !! STOMATE's _Restart_ file identifier (unitless)
+    INTEGER(i_std),INTENT(in)                       :: hist_id_stom      !! STOMATE's _history_ file identifier (unitless)
+    INTEGER(i_std),INTENT(in)                       :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file identifier(unitless) 
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)   :: index             !! The indices of the terrestrial pixels only (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)    :: lalo              !! Geographical coordinates (latitude,longitude) for pixels (degrees) 
+    INTEGER(i_std),DIMENSION(kjpindex,8),INTENT(in) :: neighbours        !! Neighoring grid points if land for the DGVM (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)    :: resolution        !! Size in x an y of the grid (m) - surface area of the gridbox 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)   :: contfrac          !! Fraction of continent in the grid cell (unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: totfrac_nobio     !! Fraction of grid cell covered by lakes, land ice, cities, ... (unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: clay              !! Clay fraction of soil (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: silt              !! Silt fraction of soil (0-1, unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: bulk              !! Bulk density (kg/m**3) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: t2m               !! 2 m air temperature (K)
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: veget             !! Fraction of vegetation type including 
+                                                                         !! non-biological fraction (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: veget_max         !! Maximum fraction of vegetation type including 
+                                                                         !! non-biological fraction (unitless) 
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: co2_flux          !! CO2 flux between atmosphere and biosphere
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)     :: fco2_lu           !! CO2 flux between atmosphere and biosphere from land-use (without forest management)  
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)     :: deadleaf_cover    !! Fraction of soil covered by dead leaves (unitless)
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(out) :: assim_param !! min+max+opt temperatures (K) & vmax for photosynthesis  
+    
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION(:,:,:,:,:),INTENT(inout)  :: circ_class_biomass!! Biomass per circumference class @tex $(gC tree^{-1})$ @endtex
+    REAL(r_std),DIMENSION(:,:,:),INTENT(inout)      :: circ_class_n      !! Number of trees within each circumference
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)    :: lai_per_level     !! This is the LAI per vertical level
+                                                                         !! @tex $(m^{2} m^{-2})$ @endtex
+    TYPE(laieff_type),DIMENSION (:,:,:),INTENT(inout) &
+                                                    :: laieff_fit        !! Fitted parameters for the effective LAI
+
+    !! 0.4 Local variables
+    REAL(r_std)                                   :: dt_days_read         !! STOMATE time step read in restart file (days)
+    INTEGER(i_std)                                :: l,k,ji, jv, i, j, m  !! indices     
+    REAL(r_std),PARAMETER                         :: max_dt_days = 5.     !! Maximum STOMATE time step (days)
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: rprof                !! Coefficient of the exponential functions that 
+                                                                          !! relates root density to soil depth (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_daily_x          !! "Daily" gpp for teststomate  
+                                                                          !! @tex $(??gC m^{-2} dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: veget_cov            !! Fractional coverage: actually share of the pixel 
+                                                                          !! covered by a PFT (fraction of ground area covered), 
+                                                                          !! taking into account LAI
+    INTEGER(i_std)                                :: ier                  !! Check errors in netcdf call (unitless)
+
+    INTEGER(i_std)                                :: max_totsize          !! Memory management - maximum memory size (Mb)
+    INTEGER(i_std)                                :: totsize_1step        !! Memory management - memory required to store one 
+                                                                          !! time step on one processor (Mb) 
+    INTEGER(i_std)                                :: totsize_tmp          !! Memory management - memory required to store one 
+                                                                          !! time step on all processors(Mb) 
+    INTEGER(i_std)                                :: vid                  !! Variable identifer of netCDF (unitless)
+    INTEGER(i_std)                                :: nneigh               !! Number of neighbouring pixels
+    INTEGER(i_std)                                :: direct               !! 
+    INTEGER(i_std),DIMENSION(ndm)                 :: d_id                 !! 
+    LOGICAL                                       :: l_error              !! error flag
+    REAL(r_std)                                   :: temp_total           !! Used for renormalizing
+    INTEGER(i_std),ALLOCATABLE, DIMENSION(:,:)    :: fm_map_temp          !! A temporary variable to hold the forest
+                                                                          !! management map which is read in from a file
+                                                                          !! (0-4,unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: species_map_temp     !! A temporary variable to hold the species
+                                                                          !! change map which is read in from a file
+                                                                          !! (1-nvm,unitless)
+    INTEGER(i_std)                                :: forest_managed_temp  !! Temporary variable to affect forest_managed(1,6)
+ !================================================================================================================================
+    
+    !! 1. Initialize variable
+
+    ! Initialize local printlev
+    !printlev_loc=get_printlev('stomate')
+
+    !! Update flag
+    l_first_stomate = .FALSE.
+    
+    !! 1.1 Store current time step in a common variable
+    itime = kjit
+    
+    !![DISPENSABLE] 1.2 Copy the depth of the different soil layers from diaglev specified in slow_proc
+    
+    !! 1.3 PFT rooting depth across pixels, humescte is pre-defined 
+    ! (constantes_veg.f90). It is defined as the coefficient of an exponential 
+    ! function relating root density to depth 
+    DO j=1,nvm
+       rprof(:,j) = 1./humcste(j)
+    ENDDO
+    
+!!$    !! 1.3.1 Set lai 
+!!$    lai(:,ibare_sechiba) = zero
+!!$    DO i = 1, kjpindex
+!!$       DO j = 2,nvm
+!!$          lai(i,j) = cc_to_lai(circ_class_biomass(i,j,:,ileaf,icarbon),circ_class_n(i,j,:),j)
+!!$       ENDDO
+!!$    ENDDO
+
+    !! 1.4.0 Parameters for spinup
+    !
+    eps_carbon = 0.01
+    !Config Key   = EPS_CARBON
+    !Config Desc  = Allowed error on carbon stock
+    !Config If    = SPINUP_ANALYTIC
+    !Config Def   = 0.01
+    !Config Help  = 
+    !Config Units = [%]   
+    CALL getin_p('EPS_CARBON',eps_carbon)       
+    
+    
+    !Config Key   = SPINUP_PERIOD
+    !Config Desc  = Period to calulcate equilibrium during spinup analytic
+    !Config If    = SPINUP_ANALYTIC
+    !Config Def   = -1
+    !Config Help  = Period corresponds in most cases to the number of years of forcing data used in the spinup.
+    !Config Units = [years]   
+    spinup_period = -1
+    CALL getin_p('SPINUP_PERIOD',spinup_period)       
+    
+    ! Check spinup_period values. 
+    ! For periods uptil 6 years, to obtain equilibrium, a bigger period have to be used 
+    ! and therefore spinup_period is adjusted to 10 years. 
+    IF (spinup_analytic) THEN
+       IF (spinup_period <= 0) THEN
+          WRITE(numout,*) 'Error in parameter spinup_period. This parameter must be > 0 : spinup_period=',spinup_period
+          CALL ipslerr_p (3,'stomate_initialize', &
+               'Parameter spinup_period must be set to a positive integer.', &
+               'Set this parameter to the number of years of forcing data used for the spinup.', &
+               '')
+       ELSE IF (spinup_period <= 6) THEN
+          ! Adjust to bigger period. The period must be a multiple of the original period.
+          WRITE(numout,*) 'Initial spinup_period =',spinup_period,' will be adjusted.'
+          spinup_period = spinup_period*(INT(9/spinup_period)+1)
+       END IF
+       WRITE(numout,*) 'Spinup analytic is activated using eps_carbon=',eps_carbon, ' and spinup_period=',spinup_period
+    END IF
+    
+    !! 1.4.0 Initialization of PFT specific parameters 
+    ! Initialization of PFT specific parameters that have no value
+    ! for the bare soil PFT i.e. fire resistance, flamability, maximum lai,
+    ! settings for growing degree days (GDD), settings for senescence, 
+    ! respiration coefficients, photosynthesis, etc.
+    ! [DISPENSABLE]
+    
+    !! 1.4.1 Allocate memory for all variables in stomate
+    ! Allocate memory for all variables in stomate, build new index
+    ! tables accounting for the PFTs, read and check flags and set file
+    ! identifier for restart and history files.
+    CALL stomate_init (kjpij, kjpindex, index, 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
+    
+    !! 1.4.3.2 Read the management status   
+    !  This is the first call in this loop, It should just
+    !  be initialised.
+    forest_managed_lastyear(:,:) = 0
+    
+    !Config Key   = FOREST_MANAGED
+    !Config Desc  = Forest management flag
+    !Config If    = OK_STOMATE
+    !Config Def   = 1: unmanaged, 2: high stand, 3: coppice, 
+    !               4: short rotation coppice
+    !Config Help  =
+    !Config Units = [-]
+    ! forest management is always activated but a setting 
+    ! of ifm_none means don't do any human management.
+    forest_managed(:,:) = ifm_none
+    ! We need to things this was, instead of passing the whole array,
+    ! since the domains of different processers will sometimes have
+    ! different sizes, and calling MPI_BCAST with arrays of different
+    ! sizes causes an error.  So we just read a single integer, BCAST
+    ! that, and then change the arrays here.
+    CALL getin_p('FOREST_MANAGED_FORCED',forest_managed_temp)
+    IF(forest_managed_temp .NE. ifm_none)THEN
+       forest_managed(:,:)=forest_managed_temp
+    ENDIF
+    
+    ! We need to have the option to read the forest management
+    ! strategy from a map (NetCDF file).  If this option is
+    ! equal to Y, we will overwrite the forest_managed_forced 
+    ! option above, so you should be careful to only use one
+    ! or the other.
+    ! If we prescribe a species change we will also overwrite
+    ! forest_managed so we don't want to read it from a file
+    ! but we want to use the restart values
+    IF(ok_read_fm_map)THEN
+
+       ! If we are using age classes, we read in the map in the same
+       ! way but then we change it a bit to account for age classes.
+       l_error = .FALSE.
+       ALLOCATE(fm_map_temp(kjpindex,nvmap),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: ' ,&
+               'temporary FM map ',kjpindex,nvmap
+          CALL ipslerr_p (3,'stomate_main', &
+               'Problem with memory allocation','','')
+       ENDIF
+       
+       CALL read_in_fm_map(kjpindex, lalo, neighbours, resolution, &
+            contfrac, fm_map_temp)
+       IF(nagec .GT. 1)THEN
+          ! All age classes of the same PFT will have the same
+          ! management
+          DO jv = 1,nvm
+             forest_managed(:,jv)=fm_map_temp(:,agec_group(jv))
+          ENDDO
+          
+       ELSE
+          forest_managed(:,:)=fm_map_temp(:,:)
+          
+       ENDIF
+       
+       DEALLOCATE(fm_map_temp)
+       
+    ENDIF
+   
+    ! Get values from _restart_ file. Note that only ::kjpindex, ::index, ::lalo 
+    ! and ::resolution are input variables, all others are output variables.
+    CALL readstart &
+         (kjpindex, index, lalo, resolution, t2m, &
+         dt_days_read, date, &
+         adapted, regenerate, &
+         humrel_daily, gdd_init_date, litterhum_daily, &
+         t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+         soilhum_daily, precip_daily, &
+         gpp_daily, npp_daily, turnover_daily, &
+         humrel_month, humrel_week, humrel_growingseason,&
+         t2m_longterm, tau_longterm, t2m_month, t2m_week, &
+         tsoil_month, soilhum_month, fireindex, firelitter, &
+         maxhumrel_lastyear, maxhumrel_thisyear, &
+         minhumrel_lastyear, minhumrel_thisyear, &
+         maxgppweek_lastyear, maxgppweek_thisyear, &
+         gdd0_lastyear, gdd0_thisyear, &
+         precip_lastyear, precip_thisyear, &
+         gdd_m5_dormance,  gdd_from_growthinit, gdd_midwinter, &
+         ncd_dormance, ngd_minus5, &
+         PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+         maxfpc_lastyear, maxfpc_thisyear, &
+         turnover_longterm, gpp_week, resp_maint_part, &
+         leaf_age, leaf_frac, plant_status, when_growthinit, age, &
+         resp_hetero_d, resp_maint_d, resp_growth_d, co2_fire, atm_to_bm, &
+         veget_lastlight, everywhere, need_adjacent, RIP_time, &
+         time_hum_min, hum_min_dormance, &
+         litter, dead_leaves, &
+         som, lignin_struc, lignin_wood, turnover_time,&
+         prod_s, prod_m, prod_l, flux_s, flux_m, flux_l, &
+         flux_prod_s, flux_prod_m, flux_prod_l, &
+         bm_to_litter, carb_mass_total, &
+         Tseason, Tseason_length, Tseason_tmp, &
+         Tmin_spring_time, onset_date, &
+         global_years, ok_equilibrium, nbp_accu, nbp_flux, &
+         nbp_accu_pool, nbp_pool, nbp_pool_start, &
+         matrixV, vectorU, previous_stock, current_stock, &
+         assim_param, CN_som_litter_longterm, &
+         tau_CN_longterm, KF, k_latosa_adapt, &
+         rue_longterm, cn_leaf_min_season, nstress_season, &
+         soil_n_min, p_O2, bact, &
+         circ_class_biomass, circ_class_n, store_sum_delta_ba, &
+         forest_managed, forest_managed_lastyear, &
+         species_change_map, fm_change_map, lpft_replant, lai_per_level, &
+         laieff_fit, wstress_season, wstress_month, &
+         age_stand, rotation_n, last_cut, mai, pai, &
+         previous_wood_volume, mai_count, coppice_dens, &
+         light_tran_to_level_season,veget_max, harvest_5y_area)
+
+    !! 1.4.3.4 Read litter raking map
+    !  If we are doing litter raking, we need a map which
+    !  tells us how much litter is required at every pixel.
+    !  This number is independent of the PFTs.  
+    IF(ok_litter_raking)THEN
+       
+       CALL read_in_litter_map(kjpindex, lalo, neighbours, resolution, &
+            contfrac, litter_demand)
+       
+    ENDIF
+
+    
+    !! 1.4.3.5 Read species with which to replant
+    !  If we are doing species change, we need to read in the map or force
+    !  the PFT values.  We do this after the restart because otherwise our
+    !  values are overwritten. When we implement the species change we
+    !  usually want to change FM as well (and sometime we even need it, i.e.,
+    !  when the current FM strategy is to coppice and we change the species
+    !  to a conifer tree than we will need to change FM because conifers are
+    !  typically not coppiced). Species change and FM change were implemented
+    !  separatly because that was easier to test and debug but not all 
+    !  combinations were tested. The recommended setting is read de FM_desired
+    !  map when using species change.
+    IF(ok_change_species)THEN
+       
+       IF(printlev_loc>=4) WRITE(numout,*) 'Use the species change code'
+       
+       ! Read species change map
+       IF(ok_read_species_change_map)THEN
+          
+          WRITE(numout,*) 'Reading species change map'
+          
+          ! Allocate
+          l_error = .FALSE.
+          ALLOCATE(species_map_temp(kjpindex,nvmap),stat=ier)
+          l_error = l_error .OR. (ier /= 0)
+          IF (l_error) THEN
+             WRITE(numout,*) 'Problem with memory allocation: ', &
+                  kjpindex,nvmap
+             CALL ipslerr_p (3,'stomate_main', &
+                  'Problem with memory allocation',&
+                  'temporary species change map','')
+          ENDIF
+          
+          CALL read_in_species_change_map(kjpindex, lalo, neighbours, &
+               resolution, contfrac, species_map_temp)
+             
+          ! If we are using age classes, we read in the map in the same
+          ! way but then we change it a bit to account for age classes.
+          IF(nagec .GT. 1)THEN
+             
+             ! All age classes of the same PFT will have the same
+             ! management
+             DO jv = 1,nvm
+                species_change_map(:,jv)=species_map_temp(:,agec_group(jv))
+             ENDDO
+             
+          ELSE
+
+             ! The number of pfts on the map is identical
+             ! to the number of PFTs used in the simulation
+             WRITE(numout,*) 'Reading single value for species change'
+             species_change_map(:,:)=species_map_temp(:,:)
+             
+          ENDIF
+
+          DEALLOCATE(species_map_temp)
+          
+       ELSE
+          
+          IF(printlev_loc>=4) WRITE(numout,*) 'Species change map NOT read'
+          IF(printlev_loc>=4) WRITE(numout,*) 'species_change_force, ', &
+               species_change_force
+          IF (species_change_force .EQ. -9999) THEN
+
+             ! If we end-up here the user has set-up the model
+             ! such that we use the species_change code but only
+             ! to change the management. To keep the code simple
+             ! we will use a dummy species_change_map
+             IF(printlev_loc>=4) WRITE(numout,*) 'Use veget_cov_max instead'
+             
+             ! All age classes of the same PFT will have the same
+             ! management
+             DO jv = 1,nvm
+                species_change_map(:,jv) = agec_group(jv)
+             ENDDO
+             
+          ELSE
+             
+             ! Use a single value (::species_change_force) instead 
+             ! of the information from a map. This was implemented
+             ! as a feature for testing and/or debugging. It allows
+             ! to test on a single pixel without reading maps.
+             IF(printlev_loc>=4) WRITE(numout,*) 'Use ::species_change_force'
+             species_change_map(:,:)=species_change_force
+             
+          ENDIF
+          
+       ENDIF
+
+       ! If we apply a species change we will also prescribe a new 
+       ! management strategy but we need to decide whether we will
+       ! read the desired management from a map or use a single 
+       ! prescribed value instead
+       
+       ! Read species change map
+       IF(ok_read_desired_fm_map)THEN
+          
+          WRITE(numout,*) 'Reading desired FM map'
+          ! Allocate
+          l_error = .FALSE.
+          ALLOCATE(fm_map_temp(kjpindex,nvmap),stat=ier)
+          l_error = l_error .OR. (ier /= 0)
+          IF (l_error) THEN
+             WRITE(numout,*) 'Problem with memory allocation: ', &
+                  kjpindex,nvmap
+             CALL ipslerr_p (3,'stomate_main', &
+                  'Problem with memory allocation',&
+                  'temporary fm change map','')
+          ENDIF
+          
+          ! If we are using age classes, we read in the map in the same
+          ! way but then we change it a bit to account for age classes.
+          CALL read_in_desired_fm_map(kjpindex, lalo, neighbours, &
+               resolution, contfrac, fm_map_temp)
+          
+          IF(nagec .GT. 1)THEN
+             
+             ! All age classes of the same PFT will have the same
+             ! management
+             DO jv = 1,nvm
+                fm_change_map(:,jv)=fm_map_temp(:,agec_group(jv))
+             ENDDO
+             
+          ELSE
+             
+             ! The number of pfts on the map is identical
+             ! to the number of PFTs used in the simulation
+             fm_change_map(:,:)=fm_map_temp(:,:)
+             
+          ENDIF
+          
+          DEALLOCATE(fm_map_temp)
+          
+       ELSE
+          
+          IF(printlev_loc>=4) WRITE(numout,*) 'fm change map NOT read'
+          IF(printlev_loc>=4) WRITE(numout,*) 'fm_change_force, ',fm_change_force
+          IF(fm_change_force .EQ. -9999) THEN
+             
+             ! If we end-up here the user has set-up the model
+             ! such that we use the species_change code but only
+             ! to change the species while keeping the management
+             ! constant. To keep the code simple we will use a 
+             ! dummy fm_change_map
+             IF(printlev_loc>=4) WRITE(numout,*) 'Use forest_managed instead'
+             fm_change_map(:,:)=forest_managed(:,:)
+             
+          ELSE
+             
+             ! Use a single value (::species_change_force) instead 
+             ! of the information from a map. This was implemented
+             ! as a feature for testing and/or debugging. It allows
+             ! to test on a single pixel without reading maps.
+             IF(printlev_loc>=4) WRITE(numout,*) 'Use ::fm_change_force'
+             fm_change_map(:,:)=fm_change_force
+             
+          ENDIF
+          
+       ENDIF
+       
+    ENDIF
+    
+    !! 1.4.5 Check time step
+       
+    !! 1.4.5.1 Allow STOMATE's time step to change although this is dangerous
+    IF (dt_days /= dt_days_read) THEN
+       WRITE(numout,*) 'slow_processes: STOMATE time step changes:', &
+            & dt_days_read,' -> ',dt_days
+    ENDIF
+    
+    !! 1.4.5.2 Time step has to be a multiple of a full day
+    IF ( ( dt_days-REAL(NINT(dt_days),r_std) ) > min_stomate ) THEN
+       WRITE(numout,*) 'slow_processes: STOMATE time step is not a mutiple of a full day:', &
+            & dt_days,' days.'
+       STOP
+    ENDIF
+    
+    !! 1.4.5.3 upper limit to STOMATE's time step
+    IF ( dt_days > max_dt_days ) THEN
+       WRITE(numout,*) 'slow_processes: STOMATE time step exceeds the maximum value:', &
+            & dt_days,' days > ', max_dt_days, ' days.'  
+       STOP
+    ENDIF
+    
+    !! 1.4.5.4 STOMATE time step must not be less than the forcing time step
+    IF ( dt_sechiba > dt_days*one_day ) THEN
+       WRITE(numout,*) &
+            & 'slow_processes: STOMATE time step ::dt_days smaller than forcing time step ::dt_sechiba'
+       STOP
+    ENDIF
+    
+    !! 1.4.5.6 Final message on time step
+    WRITE(numout,*) 'Slow_processes, STOMATE time step (days): ', dt_days
+    
+    !! 1.4.6 Write forcing file for teststomate
+    IF (allow_forcing_write) THEN
+       
+       !Config Key   = STOMATE_FORCING_NAME
+       !Config Desc  = Name of STOMATE's forcing file
+       !Config If    = OK_STOMATE
+       !Config Def   = NONE
+       !Config Help  = Name that will be given
+       !Config         to STOMATE's offline forcing file
+       !Config         Compatible with Nicolas Viovy's driver
+       !Config Units = [FILE]
+       forcing_name = stomate_forcing_name
+       CALL getin_p('STOMATE_FORCING_NAME',forcing_name)
+       
+       IF ( TRIM(forcing_name) /= 'NONE' ) THEN
+          
+          !! 1.4.6.1 Calculate steps that can be stored in memory
+          ! Action for the root processor only (parallel computing)  
+          IF (is_root_prc) CALL SYSTEM ('rm -f '//TRIM(forcing_name))
+          WRITE(numout,*) 'writing a forcing file for STOMATE.'
+          
+          !Config Key   = STOMATE_FORCING_MEMSIZE
+          !Config Desc  = Size of STOMATE forcing data in memory 
+          !Config If    = OK_STOMATE
+          !Config Def   = 50
+          !Config Help  = This variable determines how many
+          !Config         forcing states will be kept in memory.
+          !Config         Must be a compromise between memory
+          !Config         use and frequeny of disk access.
+          !Config Units = [MegaBytes]
+          max_totsize = 50
+          CALL getin_p('STOMATE_FORCING_MEMSIZE', max_totsize)      
+          max_totsize = max_totsize*1000000
+          
+          totsize_1step = &
+               SIZE(clay)*KIND(clay) &
+               +SIZE(silt)*KIND(silt) &
+               +SIZE(bulk)*KIND(bulk) &
+               +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) &    
+               +SIZE(drainage_daily)*KIND(drainage_daily) 
+          
+          ! Totsize_1step is the size on a single processor, sum
+          ! all processors and send to all processors
+          CALL reduce_sum(totsize_1step,totsize_tmp)
+          CALL bcast(totsize_tmp)
+          totsize_1step=totsize_tmp
+          
+          ! Total number of forcing steps
+          nsft = INT(one_year/(dt_stomate/one_day))
+          
+          ! Number of forcing steps in memory
+          nsfm = MIN(nsft, &
+               MAX(1,NINT( REAL(max_totsize,r_std) &
+               /REAL(totsize_1step,r_std))))
+            
+             
+          !! 1.6.4.2 Allocate memory for variables containing forcing data  
+          ! and initialize variables (set to zero).
+          CALL init_forcing (kjpindex,nsfm,nsft)
+          
+          ! Indexing for writing forcing file
+          isf(:) = (/ (i,i=1,nsfm) /)
+          nf_written(:) = .FALSE.
+          nf_cumul(:) = 0
+          iisf = 0
+          
+          !! 1.6.4.3 Create netcdf file
+          ! Create, define and populate a netcdf file containing the forcing data.
+          ! For the root processor only (parallel computing). NF90_ are functions
+          ! from and external library.  
+          IF (is_root_prc) THEN
+             
+             ! Create new netCDF dataset
+             ier = NF90_CREATE (TRIM(forcing_name),NF90_SHARE,forcing_id)
+             
+             ! Add variable attribute
+             ! Note ::iim_g and ::jjm_g are dimensions of the global field and 
+             ! ::nbp_glo is the number of global continental points
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL,'dt_sechiba',dt_sechiba)
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL,'dt_stomate',dt_stomate)
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, &
+                  'nsft',REAL(nsft,r_std))
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, &
+                  'kjpij',REAL(iim_g*jjm_g,r_std))
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, &
+                  'kjpindex',REAL(nbp_glo,r_std))
+             
+             ! Add new dimension
+             ier = NF90_DEF_DIM (forcing_id,'points',nbp_glo,d_id(1))
+             ier = NF90_DEF_DIM (forcing_id,'layers',nbdl,d_id(2))
+             ier = NF90_DEF_DIM (forcing_id,'pft',nvm,d_id(3))
+             direct=2
+             ier = NF90_DEF_DIM (forcing_id,'direction',direct,d_id(4))
+             nneigh=8
+             ier = NF90_DEF_DIM (forcing_id,'nneigh',nneigh,d_id(5))
+             ier = NF90_DEF_DIM (forcing_id,'time',NF90_UNLIMITED,d_id(6))
+             ier = NF90_DEF_DIM (forcing_id,'nbparts',nparts,d_id(7))
+             
+             ! Add new variable
+             ier = NF90_DEF_VAR (forcing_id,'points',    r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (forcing_id,'layers',    r_typ,d_id(2),vid)
+             ier = NF90_DEF_VAR (forcing_id,'pft',       r_typ,d_id(3),vid)
+             ier = NF90_DEF_VAR (forcing_id,'direction', r_typ,d_id(4),vid)
+             ier = NF90_DEF_VAR (forcing_id,'nneigh',    r_typ,d_id(5),vid)
+             ier = NF90_DEF_VAR (forcing_id,'time',      r_typ,d_id(6),vid)
+             ier = NF90_DEF_VAR (forcing_id,'nbparts',   r_typ,d_id(7),vid)
+             ier = NF90_DEF_VAR (forcing_id,'index',     r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (forcing_id,'contfrac',  r_typ,d_id(1),vid) 
+             ier = NF90_DEF_VAR (forcing_id,'lalo', &
+                  r_typ,(/ d_id(1),d_id(4) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'neighbours', &
+                  r_typ,(/ d_id(1),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'resolution', &
+                  r_typ,(/ d_id(1),d_id(4) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'clay', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'silt', & 
+                  r_typ,(/ d_id(1),d_id(6) /),vid) 
+             ier = NF90_DEF_VAR (forcing_id,'bulk', & 
+                  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_DEF_VAR (forcing_id,'drainage', & 
+                  r_typ,(/ d_id(1),d_id(6),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 
+    
+    !! 1.4.7 write forcing file for forcesoil
+    !! 1.4.7.1 Initialize
+    !Config Key   = STOMATE_CFORCING_NAME
+    !Config Desc  = Name of STOMATE's carbon forcing file
+    !Config If    = OK_STOMATE
+    !Config Def   = NONE
+    !Config Help  = Name that will be given to STOMATE's carbon
+    !Config         offline forcing file
+    !Config         Compatible with Nicolas Viovy's driver
+    !Config Units = [FILE]
+    Cforcing_name = stomate_Cforcing_name
+    CALL getin_p('STOMATE_CFORCING_NAME',Cforcing_name)
+    
+    IF ( TRIM(Cforcing_name) /= 'NONE' ) THEN
+       
+       ! Time step of forcesoil
+       !Config Key   = FORCESOIL_STEP_PER_YEAR
+       !Config Desc  = Number of time steps per year for carbon spinup.
+       !Config If    = OK_STOMATE
+       !Config Def   = 365
+       !Config Help  = Number of time steps per year for carbon spinup.
+       !Config Units = [days, months, year]
+       nparan = 365
+       CALL getin_p('FORCESOIL_STEP_PER_YEAR', nparan)
+       
+       ! Correct if setting is out of bounds 
+       IF ( nparan < 1 ) nparan = 1
+       
+       !Config Key   = FORCESOIL_NB_YEAR
+       !Config Desc  = Number of years saved for carbon spinup.
+       !Config If    = OK_STOMATE
+       !Config Def   = 1
+       !Config Help  = Number of years saved for carbon spinup. If internal parameter cumul_Cforcing is TRUE in stomate.f90
+       !Config         Then this parameter is forced to one.
+       !Config Units = [years]
+       CALL getin_p('FORCESOIL_NB_YEAR', nbyear)
+       
+       ! Set ::nbyear to 1. if ::cumul_Cforcing=.TRUE.
+       IF ( cumul_Cforcing ) THEN
+          CALL ipslerr_p (1,'stomate', &
+               'Internal parameter cumul_Cforcing is TRUE in stomate.f90', &
+               'Parameter FORCESOIL_NB_YEAR is therefore forced to 1.', &
+               '::nbyear is thus set to 1.')
+          nbyear=1
+       ENDIF
+       
+       ! Make use of ::nparan to calculate ::dt_forcesoil
+       dt_forcesoil = zero
+       nparan = nparan+1
+       DO WHILE ( dt_forcesoil < dt_stomate/one_day )
+          nparan = nparan-1
+          IF ( nparan < 1 ) THEN
+             STOP 'Problem with number of soil forcing time steps ::nparan < 1.'
+          ENDIF
+          dt_forcesoil = one_year/REAL(nparan,r_std)
+       ENDDO
+       IF ( nparan > nparanmax ) THEN
+          STOP 'Problem with number of soil forcing time steps ::nparan > ::nparanmax'
+       ENDIF
+       WRITE(numout,*) 'Time step of soil forcing (d): ',dt_forcesoil
+       
+       ! Allocate memory for the forcing variables of soil dynamics
+       ALLOCATE( nforce(nparan*nbyear))
+       nforce(:) = 0
+       ALLOCATE(control_moist(kjpindex,nlevs,nparan*nbyear))
+       ALLOCATE(npp_equil(kjpindex,nparan*nbyear))
+       ALLOCATE(npp_tot(kjpindex))
+       ALLOCATE(control_temp(kjpindex,nlevs,nparan*nbyear))
+       ALLOCATE(carbon_input(kjpindex,ncarb,nvm,nparan*nbyear)) 
+       ALLOCATE(nitrogen_input(kjpindex,ncarb,nvm,nparan*nbyear)) 
+       ALLOCATE(drainage(kjpindex,nvm,nparan*nbyear))         
+
+       ! Initialize variables, set to zero
+       control_moist(:,:,:) = zero
+       npp_equil(:,:) = zero
+       npp_tot(:) = zero
+       control_temp(:,:,:) = zero
+       carbon_input(:,:,:,:) = zero
+       nitrogen_input(:,:,:,:) = zero
+       drainage(:,:,:) = zero 
+    ENDIF ! Cforcing_name) /= 'NONE'
+    
+    !! 1.4.8 Calculate STOMATE's vegetation fractions from veget, veget_max
+    DO j=1,nvm
+       WHERE ((1.-totfrac_nobio(:)) > min_sechiba)       
+          ! Pixels with vegetation
+          veget_cov(:,j) = veget(:,j)/( 1.-totfrac_nobio(:) )
+          veget_cov_max(:,j) = veget_max(:,j)/( 1.-totfrac_nobio(:) )
+       ELSEWHERE
+          ! Pixels without vegetation
+          veget_cov(:,j) = zero
+          veget_cov_max(:,j) = zero
+       ENDWHERE
+    ENDDO ! Loop over PFTs
+
+    !! 1.4.9 Initialize non-zero variables
+    CALL stomate_var_init &
+         (kjpindex, veget_cov_max, leaf_age, leaf_frac, &
+         dead_leaves, &
+         veget_cov, deadleaf_cover, assim_param, &
+         circ_class_biomass, circ_class_n)
+    
+    l_error =.FALSE.
+    ALLOCATE(circ_class_dist(ncirc),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for circ_class_dist. ' // &
+            'We need ncirc words = ',ncirc
+       CALL ipslerr_p (3,'stomate_main', &
+            'Memory allocation error for circ_class_dist','','')
+    END IF
+    !Config Key   = CIRC_CLASS_DIST
+    !Config Desc  = The tree distribution to target if we have to redistribute.
+    !Config if    = OK_STOMATE
+    !Config Def   = 1
+    !Config Help  =
+    !Config Units = [-]
+    circ_class_dist(:)=un
+    CALL getin_p('CIRC_CLASS_DIST',circ_class_dist)
+    
+    ! Now we normalize the distribution
+    temp_total=SUM(circ_class_dist(:))
+    circ_class_dist(:)=circ_class_dist(:)/temp_total
+    WRITE(numout,*) 'Target distribution for renormalization: ',circ_class_dist(:)
+
+    ALLOCATE(st_dist(ncirc),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for st_dist. ' // &
+            'We need ncirc words = ',ncirc
+       CALL ipslerr_p (3,'stomate_main', &
+            ' Memory allocation error for st_dist.','','')
+    END IF
+    !Config Key   = ST_DIST
+    !Config Desc  = The distribution for killing trees in self-thinning.
+    !Config if    = OK_STOMATE
+    !Config Def   = circ_class_dist
+    !Config Help  =
+    !Config Units = [-]
+    st_dist(:)=circ_class_dist(:)
+    CALL getin_p('ST_DIST',st_dist)
+    
+    ! Now we normalize the distribution
+    temp_total=SUM(st_dist(:))
+    st_dist(:)=st_dist(:)/temp_total
+    WRITE(numout,*) 'Target distribution for self-thinning: ',st_dist(:)
+    
+  END SUBROUTINE stomate_initialize
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_main
+!!
+!>\BRIEF        Manages variable initialisation, reading and writing forcing 
+!! files, aggregating data at stomate's time step (dt_stomate), aggregating data
+!! at longer time scale (i.e. for phenology) and uses these forcing to calculate
+!! CO2 fluxes (NPP and respirations) and C-pools (litter, soil, biomass, ...)
+!!
+!! DESCRIPTION  : The subroutine manages 
+!! divers tasks:
+!! (1) Initializing all variables of stomate (first call)
+!! (2) Reading and writing forcing data (last call)
+!! (3) Adding CO2 fluxes to the IPCC history files
+!! (4) Converting the time steps of variables to maintain consistency between
+!! sechiba and stomate
+!! (5) Use these variables to call stomate_lpj, maint_respiration, littercalc,
+!! som. The called subroutines handle: climate constraints 
+!! for PFTs, PFT dynamics, Phenology, Allocation, NPP (based on GPP and
+!! authothropic respiration), fire, mortality, vmax, assimilation temperatures,
+!! all turnover processes, light competition, sapling establishment, lai,  
+!! land cover change and litter and soil dynamics.
+!! (6) Use the spin-up method developed by Lardy (2011)(only if SPINUP_ANALYTIC 
+!! is set to TRUE).
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): deadleaf_cover, assim_param, lai, height, veget_cov, 
+!! veget_cov_max, resp_maint, 
+!! resp_hetero,resp_growth, co2_flux, fco2_lu.
+!!
+!! REFERENCES	: 
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!! \includegraphics[scale=0.5]{stomatemainflow.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE stomate_main &
+       & (kjit, kjpij, kjpindex, &
+       &  index, lalo, neighbours, resolution, contfrac, &
+       &  totfrac_nobio, clay, silt, bulk, &
+       &  t2m, temp_sol, stempdiag, &
+       &  humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, &
+       &  tmc_pft, drainage_pft, swc_pft, gpp, &
+       &  deadleaf_cover, assim_param, &
+       &  frac_age, height, veget, veget_max, &
+       &  veget_max_new, totfrac_nobio_new, &
+       &  hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+       &  co2_flux, fco2_lu, resp_maint, resp_hetero, &
+       &  resp_growth, temp_growth, &
+       &  soil_pH, pb, n_input, circ_class_biomass, &
+       &  circ_class_n, lai_per_level, &
+       &  laieff_fit, h_array_out, z_array_out, max_height_store, &
+       &  transpir, transpir_mod, transpir_supply, vir_transpir_supply, &
+       &  coszang, stressed, unstressed, Isotrop_Tran_Tot_p, &
+       &  u, v)  
+
+    IMPLICIT NONE
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                       :: kjit              !! Time step number (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpindex          !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpij             !! Total size of the un-compressed grid (unitless)
+    INTEGER(i_std),INTENT(in)                       :: rest_id_stom      !! STOMATE's _Restart_ file identifier (unitless)
+    INTEGER(i_std),INTENT(in)                       :: hist_id_stom      !! STOMATE's _history_ file identifier (unitless)
+    INTEGER(i_std),INTENT(in)                       :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file identifier 
+    !! (unitless) 
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)   :: index             !! Indices of the pixels on the map. Stomate uses a 
+    !! reduced grid excluding oceans. ::index contains 
+    !! the indices of the terrestrial pixels only 
+    !! (unitless) 
+    INTEGER(i_std),DIMENSION(kjpindex,8),INTENT(in) :: neighbours        !! Neighoring grid points if land for the DGVM 
+    !! (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)    :: lalo              !! Geographical coordinates (latitude,longitude) 
+    !! for pixels (degrees) 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)    :: resolution        !! Size in x an y of the grid (m) - surface area of 
+    !! the gridbox 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)   :: contfrac          !! Fraction of continent in the grid cell (unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: totfrac_nobio     !! Fraction of grid cell covered by lakes, land 
+    !! ice, cities, ... (unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: clay              !! Clay fraction of soil (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: silt              !! Silt fraction of soil (0-1, unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: bulk              !! Bulk density (kg/m**3) 
+    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)      :: 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,nvm),INTENT(in)  :: transpir          !! transpiration @tex $(kg m^{-2} timestep^{-1})$
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: transpir_mod      !! transpir divided by veget_cov_max
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: transpir_supply   !! Supply of water for transpiration @tex $(mm dt^{-1})$ @endtex
+    REAL(r_std),DIMENSION(:,:),INTENT(in)           :: vir_transpir_supply !! Virtual supply of water for transpiration to deal
+    !! with water stress when PFT1 becomes vegetated in LCC
+    !! @tex $(mm dt^{-1})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: precip_rain       !! Rain precipitation  
+    !! @tex $(mm dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: precip_snow       !! Snow precipitation  
+    !! @tex $(mm dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: tmc_pft           !! Total soil water per PFT (mm/m2) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: drainage_pft      !! Drainage per PFT (mm/m2)   
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: swc_pft           !! Relative Soil water content [tmcr:tmcs] per pft (-)   
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: gpp               !! GPP of total ground area  
+    
+! Import wind speed from stomate_main via slowproc
+    REAL(r_std),DIMENSION(kjpindex),INTENT (in)     :: u                 !! Lowest level wind speed in direction u (m/s)
+    REAL(r_std),DIMENSION(kjpindex),INTENT (in)     :: v                 !! Lowest level wind speed in direction v (m/s)
+  
+
+!! @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(inout)  :: veget_max_new  !! New "maximal" coverage fraction of a PFT: only if 
+    !! vegetation is updated in slowproc
+
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: totfrac_nobio_new !! Old fraction of nobio per gridcell
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: soil_pH           !! soil pH 	 
+    REAL(r_std),DIMENSION(kjpindex), INTENT(in)     :: pb                !! Air pressure (hPa) 
+    REAL(r_std),DIMENSION(:,:,:),INTENT(inout)      :: n_input           !! Nitrogen inputs into the soil  (gN/m**2/timestep) 
+
+    INTEGER(i_std),INTENT(in)                       :: hist_id           !! ?? [DISPENSABLE] SECHIBA's _history_ file 
+    !! identifier 
+    INTEGER(i_std),INTENT(in)                       :: hist2_id          !! ?? [DISPENSABLE] SECHIBA's _history_ file 2 
+    !! identifier 
+    REAL(r_std),DIMENSION(kjpindex), INTENT(in)     :: coszang           !! the cosine of the zenith angle   
+    REAL(r_std),DIMENSION (:,:,:), INTENT (in)      :: Isotrop_Tran_Tot_p!! Transmitted radiation per level (unitless)
+
+
+    !! 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_stomate^{-1})$ @endtex  
+    !! [??CHECK] sign convention? 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)     :: fco2_lu           !! CO2 flux between atmosphere and biosphere from 
+    !! land-use (without forest management)  
+    !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex  
+    !! [??CHECK] sign convention? 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: resp_maint        !! Maitenance component of autotrophic respiration in 
+    !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: resp_growth       !! Growth component of autotrophic respiration in 
+    !! @tex ($gC m^{-2} dt_stomate^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: resp_hetero       !! Heterotrophic respiration in  
+    !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)     :: temp_growth       !! Growth temperature (ÃÂ°C)  
+    !! Is equal to t2m_month 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: max_height_store  !! ???
+
+
+    !! 0.3 Modified
+
+!!$    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: lai            !! Leaf area inex @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)          :: veget          !! Fraction of vegetation type including 
+    !! non-biological fraction (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: veget_max      !! Maximum fraction of vegetation type including 
+    !! non-biological fraction (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: height         !! Height of vegetation (m)
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(inout) :: assim_param    !! min+max+opt temperatures (K) & vmax, nue and leaf N for 
+    !! photosynthesis  
+    !! @tex $(\mu mol m^{-2}s^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex),INTENT(inout)           :: deadleaf_cover !! Fraction of soil covered by dead leaves 
+    !! (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages), &                          !! Age efficacity from STOMATE
+         INTENT(inout)         :: frac_age        
+    REAL(r_std), DIMENSION(kjpindex,nvm,ncirc,nparts,nelements), &            !! Biomass per circumference class @tex $(gC tree^{-1})$ @endtex
+         INTENT(inout)                                      :: circ_class_biomass  
+    REAL(r_std), DIMENSION(kjpindex,nvm,ncirc), &                             !! Number of trees within each circumference
+         INTENT(inout)         :: circ_class_n   !! Biomass per PFT
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)            :: lai_per_level  !! This is the LAI per vertical level
+    !! @tex $(m^{2} m^{-2})$ @endtex
+    TYPE(laieff_type),DIMENSION (:,:,:), INTENT(inout)      :: laieff_fit     !! Fitted parameters for the effective LAI
+
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: stressed       !! adjusted ecosystem functioning. Takes the unit of the variable
+    !! used as a proxy for waterstress (assigned in sechiba).
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: unstressed     !! initial ecosystem functioning after the first calculation and 
+    !! before any recalculations. Takes the unit of the variable used
+    !! as a proxy for unstressed (assigned in sechiba).
+    REAL(r_std),DIMENSION(:,:,:,:), INTENT(inout)           :: h_array_out    !! An output of h_array, to use in sechiba
+    REAL(r_std),DIMENSION(:,:,:,:), INTENT(inout)           :: z_array_out    !! An output of h_array, to use in sechiba
+
+
+    !! 0.4 local variables
+
+    CHARACTER(LEN=2), DIMENSION(nelements)        :: element_str              !! string suffix indicating element    
+    REAL(r_std)                                   :: dt_days_read             !! STOMATE time step read in restart file (days)
+    INTEGER(i_std)                                :: l,k,ji, jv, i, j, m      !! indices    
+    REAL(r_std),PARAMETER                         :: max_dt_days = 5.         !! Maximum STOMATE time step (days)
+    REAL(r_std)                                   :: hist_days                !! Writing frequency for history file (days)
+    REAL(r_std),DIMENSION(0:nbdl)                 :: z_soil                   !! Variable to store depth of the different soil 
+    !! layers (m) 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: rprof                    !! Coefficient of the exponential functions that 
+    !! relates root density to soil depth (unitless) 
+    REAL(r_std),DIMENSION(kjpindex)               :: cvegtot                  !! Total "vegetation" cover (unitless)
+    REAL(r_std),DIMENSION(kjpindex)               :: precip                   !! Total liquid and solid precipitation  
+    !! @tex $(??mm dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_d                    !! Gross primary productivity per ground area 
+    !! @tex $(??gC m^{-2} dt_stomate^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_daily_x              !! "Daily" gpp for teststomate  
+    !! @tex $(??gC m^{-2} dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: resp_hetero_litter       !! Litter heterotrophic respiration per ground area 
+    !! @tex $(gC m^{-2} day^{-1})$ @endtex  
+    !! ??Same variable is also used to 
+    !! store heterotrophic respiration per ground area 
+    !! over ::dt_sechiba?? 
+    REAL(r_std),DIMENSION(nvm)                    :: ld_redistribute          !! logical set to redistribute som and litter
+    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)           :: veget_cov_max_new        !! Old value for maximal fractional coverage (unitless)
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: vcmax                    !! Maximum rate of carboxylation
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: nue                      !! Nitrogen use Efficiency with impact of leaf age (umol CO2 (gN)-1 s-1)
+    !! @tex $(\mumol m^{-2} s^{-1})$ @endtex
+    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,nelements) :: som_input_inst     !! Quantity of carbon going into carbon pools from 
+    !! litter decomposition 
+    !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    !    REAL(r_std),DIMENSION(kjpindex,nvm,nnspec)    :: soil_n_min               !! Mineral nitrogen in the soil 
+    !                                                                              !! @tex $(gN m^{-2})$ @endtex
+    INTEGER(i_std)                                :: ier                      !! Check errors in netcdf call (unitless)
+    REAL(r_std)                                   :: sf_time                  !! Intermediate variable to calculate current time 
+    !! step 
+    INTEGER(i_std)                                :: max_totsize              !! Memory management - maximum memory size (Mb)
+    INTEGER(i_std)                                :: totsize_1step            !! Memory management - memory required to store one 
+    !! time step on one processor (Mb) 
+    INTEGER(i_std)                                :: totsize_tmp              !! Memory management - memory required to store one 
+    !! time step on all processors(Mb) 
+    REAL(r_std)                                   :: xn                       !! How many times have we treated in this forcing 
+    REAL(r_std), DIMENSION(kjpindex)              :: vartmp                   !! Temporary variable
+    INTEGER(i_std)                                :: vid                      !! Variable identifer of netCDF (unitless)
+    INTEGER(i_std)                                :: nneigh                   !! Number of neighbouring pixels
+    INTEGER(i_std)                                :: direct                   !! ??
+    INTEGER(i_std),DIMENSION(ndm)                 :: d_id                     !! ??
+!!$    REAL(r_std)                                   :: net_co2_flux_monthly     !! ??[DISPENSABLE]
+!!$    REAL(r_std)                                   :: net_co2_flux_monthly_sum !! ??[DISPENSABLE]
+!!$    REAL(r_std)                                   :: net_cflux_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+!!$                                                                                   !! reduce_sum and one for bcast??), parallel 
+!!$                                                                                   !! computing 
+!!$    REAL(r_std)                                   :: net_cflux_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+!!$                                                                                   !! reduce_sum and one for bcast??), parallel 
+!!$                                                                                   !! computing 
+!!$    REAL(r_std)                                   :: net_harvest_above_monthly_sum !! AR5 output?? gC m2 month-1 (one variable for 
+!!$                                                                                   !! reduce_sum and one for bcast??), parallel 
+!!$                                                                                   !! computing 
+!!$    REAL(r_std)                                   :: net_harvest_above_monthly_tot !! AR5 output?? gC m2 month-1 (one variable for 
+!!$                                                                                   !! reduce_sum and one for bcast??), parallel 
+!!$                                                                                   !! computing 
+!!$    REAL(r_std)                                   :: net_biosp_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+!!$                                                                                   !! reduce_sum and one for bcast??), parallel 
+!!$                                                                                   !! computing 
+!!$    REAL(r_std)                                   :: net_biosp_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+!!$                                                                                   !! reduce_sum and one for bcast??), parallel 
+!!$                                                                                   !! computing 
+    REAL(r_std), DIMENSION(kjpindex,nvm,nbpools)   :: carbon_stock                 !! Array containing the carbon stock for each pool
+    !! used by ORCHIDEE
+    REAL(r_std), DIMENSION(kjpindex,nvm,nionspec)  :: plant_n_uptake                 !! Uptake of soil N by plants  
+    !! (gN/m**2/timestep)  
+    REAL(r_std), DIMENSION(kjpindex,nvm)           :: n_mineralisation             !! net nitrogen mineralisation of decomposing SOM 
+    !! (gN/m**2/day), supposed to be NH4
+    REAL(r_std), DIMENSION(kjpindex,nvm)           :: n_fungivores                 !! Fraction of N released for plant uptake due to 
+    !! fungivore consumption.
+    REAL(r_std), DIMENSION(kjpindex,nvm)           :: resp_total_soil              !! soil heterotrophic respiration (gC/day/m**2 by PFT) 
+    REAL(r_std), DIMENSION(kjpindex,nvm,ncarb)     :: CN_target                    !! C to N ratio of SOM flux from one pool to another (gN m-2 dt-1)
+    REAL(r_std), DIMENSION(kjpindex,nvm)           :: tau_eff_root                 !! Effective root turnover time that accounts
+    !! waterstress (days)
+    REAL(r_std), DIMENSION(kjpindex,nvm)           :: tau_eff_sap                  !! Effective sapwood turnover time that accounts
+    !! waterstress (days)
+    REAL(r_std), DIMENSION(kjpindex,nvm)           :: tau_eff_leaf                 !! Effective leaf turnover time that accounts
+    !! waterstress (days)
+    REAL(r_std), DIMENSION(kjpindex,nvm)           :: wstress_adapt                !! Factor to account for a long acclimation of
+    !! of the PFT to the long-term waterstress in
+    !! the pixel
+    REAL(r_std), DIMENSION(kjpindex,nvm,ninput)    :: input_dt_sechiba             !! Used to add pft index to N inputs
+    REAL(r_std), DIMENSION(kjpindex,nvm,nionspec)  :: leaching                     !! mineral nitrogen leached from the soil
+    REAL(r_std), DIMENSION(kjpindex,nvm,nnspec)    :: emission                     !! volatile losses of nitrogen (gN/m**2/timestep)
+    REAL(r_std), DIMENSION(kjpindex,nvm,nmbcomp,nelements) &
+         :: check_intern                 !! Contains the components of the internal
+    !! mass balance chech for this routine
+    !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nelements) :: closure_intern               !! Check closure of internal mass balance
+                                                                                   !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nelements) :: pool_start                   !! Start and end pool of this routine 
+                                                                                   !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nelements) :: pool_end                     !! Start and end pool of this routine 
+                                                                                   !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: pixel_area                   !! surface area of the pixel @tex ($m^{2}$)
+    REAL(r_std), DIMENSION(kjpindex,nvm)           :: veget_cov_max_begin              !! veget_max at the start of the routine.
+                                                                                   !! Used for consistency checks
+    REAL(r_std), DIMENSION(kjpindex,nelements)     :: mass_balance_closure         !! Missing mass in the carbon balance 
+                                                                                   !! @tex $(gC(N) pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm)           :: nbp                          !! Pool-based Net Biome production for each 
+                                                                                   !! time step
+    INTEGER(i_std)                                 :: inspec, ininput, inionspec   !! Indices
+    INTEGER(i_std)                                 :: ipts, ivm, ilitt, ilev, icir !! Indices
+    INTEGER(i_std)                                 :: icarb, ipar, iele, imbc      !! Indices
+
+    ! Light for recruitment
+    REAL(r_std),DIMENSION (kjpindex,nvm,nlevels_tot) &
+         :: light_tran_to_level  !! Fraction of light transmitted to a given canopy level
+    REAL(r_std),DIMENSION(kjpindex,nvm)            :: count_daylight       !! Time steps dt_radia during daylight
+    
+    ! Harvest area and wind speed for Windthrow 
+    REAL(r_std), DIMENSION(kjpindex,nvm,wind_years)    :: harvest_5y_area      !! total harvested area in the last 5 years
+    REAL(r_std), DIMENSION(kjpindex)                   :: wind_speed_actual    !! Actualwind speed calculated from the actual half hourly
+                                                                               !! values u and v as given in the driver (ms-1)
+  
+    !_ ================================================================================================================================
+
+    !! 1. Initialize variables
+
+    !! 1.1 Store current time step in a common variable
+    itime = kjit
+
+    !![DISPENSABLE] 1.2 Copy the depth of the different soil layers from diaglev specified in slow_proc
+
+    !printlev=get_printlev('stomate')
+
+    !! 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
+    atm_to_bm(:,:,:) = zero
+    plant_n_uptake(:,:,:) = zero
+    n_mineralisation(:,:) = zero
+    mass_balance_closure(:,:) = zero 
+
+
+    ! Check that initialization is done
+    IF (l_first_stomate) CALL ipslerr_p(3,'stomate_main','Initialization not yet done.','','')
+
+     IF (printlev_loc >= 2) THEN
+       IF(do_slow)THEN
+          WRITE(numout,*) 'stomate_main: date=',date,' ymds=', year, month, day, sec, ' itime=', itime, ' do_slow=',do_slow
+       ENDIF
+     ENDIF
+
+    !! 3. Special treatment for some input arrays.
+
+    !! 3.1 Sum of liquid and solid precipitation
+    precip(:) = ( precip_rain(:) + precip_snow(:) )*one_day/dt_sechiba
+
+    !! 3.2 Calculate STOMATE's vegetation fractions from veget and veget_max
+    DO j=1,nvm 
+       WHERE ((1.-totfrac_nobio(:)) > min_sechiba)
+          ! Pixels with vegetation
+          veget_cov(:,j) = veget(:,j)/( 1.-totfrac_nobio(:) )
+          veget_cov_max(:,j) = veget_max(:,j)/( 1.-totfrac_nobio(:) )
+       ELSEWHERE
+          ! Pixels without vegetation
+          veget_cov(:,j) = zero
+          veget_cov_max(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    IF ( do_now_stomate_lcchange ) THEN
+       DO j=1,nvm
+          WHERE ((1.-totfrac_nobio_new(:)) > min_sechiba)
+             ! Pixels with vegetation
+             veget_cov_max_new(:,j) = veget_max_new(:,j)/( 1.-totfrac_nobio_new(:) )
+          ELSEWHERE
+             ! Pixels without vegetation
+             veget_cov_max_new(:,j) = zero
+          ENDWHERE
+       ENDDO
+    ENDIF
+
+    !! 3.3 Adjust time step of GPP 
+    ! No GPP for bare soil
+    gpp_d(:,1) = zero
+    ! GPP per PFT
+    DO j = 2,nvm   
+       WHERE (veget_cov_max(:,j) > min_stomate)
+          ! The PFT is available on the pixel
+          gpp_d(:,j) =  gpp(:,j)/ veget_cov_max(:,j)* one_day/dt_sechiba  
+       ELSEWHERE
+          ! The PFT is absent on the pixel
+          gpp_d(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !! 3.4 The first time step of the first day of the month  
+    ! implies that the month is over
+    IF ( day == 1 .AND. sec .LT. dt_sechiba ) THEN
+       EndOfMonth=.TRUE.
+    ELSE
+       EndOfMonth=.FALSE.
+    ENDIF
+
+
+    !! 4. Calculate variables for dt_stomate (i.e. "daily")
+
+    ! Note: If dt_days /= 1, then variables 'xx_daily' (eg. half-daily or bi-daily) are by definition
+    ! not expressed on a daily basis. This is not a problem but could be
+    ! confusing
+
+    !! 4.1. Calculate water stress accounting for hydraulic architecture
+    !  If hydraulic architecture is used, humrel_daily (water stress) for use in stomate is 
+    !  not determined from humrel as calculated in hydrol.f90, but it is calculated as the 
+    !  ratio between a proxy for stressed and unstressed ecosystem functioning. 
+    !  Nightvalues are exclude. On the first day of the simulation (no biomass)
+    !  the stressed and unstressed proxies are probably both equal to the initilazed value (=zero, 
+    !  initialized in sechiba.f90), to avoid numerical issues in this case we set humrel_daily 
+    !  to 1. If hydraulic architecture is not used humrel_daily is calculated from humrel as 
+    !  determined in hydrol. 
+    IF (ok_hydrol_arch) THEN
+       ! Accumulate the half hourly values into a daily value. Accumulate the
+       ! stressed and unstressed proxy first and then take the average. We 
+       ! first accumulate and then take the ratio because that way we better 
+       ! account for the night time values. If we do it in the other order 
+       ! we need to assign a value to the ratio during the night. Whether we
+       ! take zero or one, this will bias our waterstress number because 
+       ! the number of half hours during the night is different for the 
+       ! different pixels. So although water stress could be higher in the 
+       ! south than in the north. During the growing season, day are shorter
+       ! in the south so if we set the ratio to 1 during the night, our daily 
+       ! water stress in the south may be less than in the north because we
+       ! more 1's in the daily time series.
+
+       ! The order of the calculation may depend on the proxy used. For example, 
+       ! Accumulate transpir_supply and transpir first and then calculate ratio
+       ! By doing this water stress is buffered (it is assumed that if 
+       ! ::transpir_supply is larger than ::transpir at one timestep it can buffer 
+       ! potential water stress in the next timestep. In reality this is not the 
+       ! case: transpir_supply is a potential value not a realized one.
+       DO ipts = 1,kjpindex
+
+          ! The cosine of the zenith angle, is used to 
+          ! identify night values.
+          IF (coszang(ipts) .LT. min_stomate) THEN
+
+             ! Redundant because the value will never be used
+             ! For all pixels
+             stressed(ipts,:) = zero
+             unstressed(ipts,:) = zero
+
+             ! For PFT1 under LCC
+             ! vir_stressed = zero
+             ! vir_unstressed = zero
+
+          ELSE
+
+             ! No vegetation present so ecosystem functioning
+             ! was not defined
+             WHERE (veget_cov_max(ipts,:) .LT. min_stomate)
+
+                ! To avoid uninitialized values
+                stressed(ipts,:) = zero
+                unstressed(ipts,:) = zero
+
+                ! Update the values to avoid uninitialized fields
+                ! in ::stressed_daily and ::unstressed_daily
+                stressed_daily(ipts,:) = stressed_daily(ipts,:) + &
+                     stressed(ipts,:)
+                unstressed_daily(ipts,:) = unstressed_daily(ipts,:) + &
+                     unstressed(ipts,:)
+                daylight(ipts,:) = daylight(ipts,:) + 1
+
+                ! For PFT1 under LCC
+                ! vir_stressed = zero
+                ! vir_unstressed = zero
+
+             ELSEWHERE
+
+                ! The pixel and pft contain vegetation and their
+                ! is daylight, store values to calculate the stress
+                stressed_daily(ipts,:) = stressed_daily(ipts,:) + &
+                     stressed(ipts,:)
+                unstressed_daily(ipts,:) = unstressed_daily(ipts,:) + &
+                     unstressed(ipts,:)
+                daylight(ipts,:) = daylight(ipts,:) + 1
+
+
+                ! For PFT1 under LCC
+                ! vir_stressed = zero
+                ! vir_unstressed = zero
+
+             ENDWHERE
+
+          ENDIF
+
+       ENDDO
+
+
+       ! Calculate the mean waterstress value at the end of each day
+       IF (do_slow) THEN
+
+          ! Calculate the ratio
+          WHERE (unstressed_daily(:,:) .LT. min_stomate &
+               .OR. stressed_daily(:,:) .LT. min_stomate)
+
+             ! No ecosystem function thus no data, we assume
+             ! there is no water stress
+             humrel_daily(:,:) = un
+
+          ELSEWHERE
+
+             ! Calculate water stress. If we first calculate
+             ! the daily sum and then the ratio there is no need
+             ! to divide by daylight. If we accumulate ratios
+             ! we will have to divide by daylight. This is
+             ! arbitrary. To do this properly we should calculate
+             ! the turgor in the cells and calculate growth
+             ! based on that see i.e. Fatichi et al 2013, New
+             ! Phytologist. We use a simple numerical construct
+             ! (the sqrt of the ratio) to overcome that complexity.
+             humrel_daily(:,:) = stressed_daily(:,:) / &
+                  unstressed_daily(:,:)
+
+          ENDWHERE
+
+          !+++CHECK+++
+          ! This needs to be done outside the where loop so that
+          ! all PFTs have vir_humrel_daily set.
+          ! vir_humrel_daily will be needed when accounting for the 
+          ! water columns following a land cover change. It is partly 
+          ! calculated in sechiba hydrol_arch but it is not passed all
+          ! the way to here. Check and fix. For the moment LCC does
+          ! not account for the water columns so ::humrel_daily and
+          ! ::vir_humrel_daily are equal to each other
+          vir_humrel_daily(:,:) = humrel_daily(:,:)
+          ! We have a problem.  wstress is no longer calculated in a way
+          ! that allows for a virtual quantity, since it's the ratio of the
+          ! stressed and unstressed GPPs...which cannot be calculated if there
+          ! is no vegetation.  Therefore, for any PFTs which are not
+          ! currently present we give the daily virtual waterstress to be
+          ! equal to one.
+          !+++++++++++
+          !---TEMP---
+          IF(printlev_loc>=4)THEN 
+             DO ipts=1,kjpindex
+                DO ivm=1,nvm
+                   IF( humrel_daily(ipts,ivm) .lt. 1.) THEN
+                      WRITE(numout,*)'ivm,stressed_daily,unstressed_daily,diff,humrel_daily'
+
+                      WRITE(numout,*) ivm, stressed_daily(ipts,ivm),unstressed_daily(ipts,ivm),&
+                           & stressed_daily(ipts,ivm)-unstressed_daily(ipts,ivm), humrel_daily(ipts,ivm) 
+                   ENDIF
+                ENDDO
+             ENDDO
+          ENDIF
+          !----------
+          ! Set to zero to start accumulating for the next day
+          stressed_daily(:,:) = zero
+          unstressed_daily(:,:) = zero
+          daylight(:,:) = zero
+
+       ELSE
+
+          ! Set to a large value so that it is easy to detect problems
+          ! This value should never be used. It should only be passed
+          ! to other routine at the end of the day when do_slow is false
+          humrel_daily(:,:) = large_value
+          vir_humrel_daily(:,:) = large_value
+
+       ENDIF !(do_slow)
+
+    ELSE
+       ! No hydrological architecture
+       CALL stomate_accu (do_slow, humrel, humrel_daily)
+
+       ! The variable ::vir_humrel_arch was not defined for this case
+       ! Assume no stress
+       vir_humrel_daily = un
+
+    ENDIF ! (ok_hydrol_arch)
+
+
+    ! Here we add some calculations for daily max/min for windthrow module 
+    IF (ok_windthrow) THEN
+
+       ! Accumulate the half hourly values into a daily value. Accumulate the
+       ! daily wind speed first and then take the average. grnd_80 is the index 
+       ! of ngrnd closest to 80 cm depth.
+       wind_speed_actual(:) = SQRT (u(:) * u(:) + v(:) * v(:))
+       wind_max_daily(:) = MAX (wind_speed_actual(:),wind_max_daily(:) )
+       soil_max_daily(:) = MAX (stempdiag(:,grnd_80),soil_max_daily(:) )
+
+       IF (do_slow) THEN
+
+          ! wind_speed_daily/soil_temp_daily will be passed to the wind_damage
+          ! module. wind_max_daily/soil_max_daily reset to zero so they can be 
+          ! used again for the next day
+          wind_speed_daily(:) = wind_max_daily(:)
+          wind_max_daily(:) = zero
+          soil_temp_daily(:) = soil_max_daily(:)
+          soil_max_daily(:) = zero
+
+       ENDIF
+
+    ENDIF
+
+
+    ! Debug
+    IF (printlev_loc>=4) THEN
+       IF(do_slow) THEN
+          WRITE(numout,*) 'CHECK: humrel_daily after stomate_accu',&
+               humrel_daily(:,:)
+          WRITE(numout,*) 'CHECK: vir_humrel_daily after stomate_accu',&
+               vir_humrel_daily(:,:)
+       ENDIF
+    ENDIF
+    !-
+
+    !! Calculate the light that reaches each canopy layer
+    !  Compute seasonal daytime transmitted light to canopy levels 
+    !  This quantity is used to calculate how much recruitment can occur
+    !  underneath the canopy. Recruitment is simulated in stomate_prescribe.f90
+    light_tran_to_level(:,:,:) = un
+
+    DO ipts=1,kjpindex
+
+       DO ivm=1,nvm
+
+          ! If we are at a daytime time step and there is growth (gpp>0) then
+          ! accumulate instantaneous transmitted light to each canopy level
+          IF ( coszang(ipts) .GT. min_stomate .AND. &
+               gpp(ipts,ivm) .GT. min_stomate ) THEN
+
+             daylight_count(ipts,ivm) = daylight_count(ipts,ivm) + 1
+
+             DO ilev = nlevels_tot-1,1,-1
+
+                light_tran_to_level(ipts,ivm,ilev) = &
+                     light_tran_to_level(ipts,ivm,ilev+1) * &
+                     Isotrop_Tran_Tot_p(ipts,ivm,ilev+1)
+
+             ENDDO
+
+             ! Accumulate over the growing season
+             light_tran_to_level_season(ipts,ivm,:) = &
+                  light_tran_to_level_season(ipts,ivm,:) + &
+                  light_tran_to_level(ipts,ivm,:)
+
+             ! Debug
+             IF (printlev_loc.GT.4)THEN
+                WRITE(numout,*) 'It is daytime and growth occurs, '&
+                     &'daylight_count(ipts,ivm)= ', daylight_count(ipts,ivm)
+                WRITE(numout,*) 'gpp(ipts,ivm)= ', gpp(ipts,ivm)
+                WRITE(numout,*) 'fine resolution Absolute transmitted light '&
+                     &'to each level (ivm,ipts,nlevels_tot) ',&
+                     ivm,ipts,nlevels_tot
+                DO ilev = nlevels_tot,1,-1
+                   WRITE(numout,*) ilev,light_tran_to_level(ipts,ivm,ilev),&
+                        Isotrop_Tran_Tot_p(ipts,ivm,ilev)
+                ENDDO
+             ENDIF
+             !-
+
+          ENDIF   ! daytime and growing season
+
+       ENDDO
+
+       ! Calculate average transmitted light at the end of the year
+       IF (EndOfYear) THEN
+
+          ! Calculate average transmitted light at the end of the year
+          ! Only account for days during the growing season
+          DO ivm=2,nvm
+
+             IF (daylight_count(ipts,ivm) .GT. zero) THEN
+
+                DO ilev=1,nlevels_tot
+
+                   light_tran_to_level_season(ipts,ivm,ilev) = &
+                        light_tran_to_level_season(ipts,ivm,ilev) / &
+                        daylight_count(ipts,ivm)
+
+                ENDDO
+
+             ELSE
+
+                ! There was no GPP during this year in this PFT. Most
+                ! likely this implies that there is no vegetation. So,
+                ! all the light is transmitted to the ground level.
+                ! The fraction of transmitted light is thus set to 1.
+                light_tran_to_level_season(ipts,ivm,:) = un
+
+             ENDIF
+
+             ! Debug
+             IF(printlev_loc>=4)THEN
+                WRITE(numout,*) 'DEBUG in stomate.f90 it is end of the ', &
+                     'year in stomate.f90'
+                WRITE(numout,*) 'daylight_count to divide by here is, ', &
+                     daylight_count(ipts,:)
+                WRITE(numout,*) 'transmitted light, ',&
+                     light_tran_to_level_season(ipts,ivm,1),&
+                     light_tran_to_level_season(ipts,ivm,10)
+             ENDIF
+             !- 
+          ENDDO
+          ! Reset the counter for the next year
+          daylight_count(:,:)=zero
+
+       ENDIF ! EndOfYear
+
+    ENDDO ! ipts=1,kjpindex
+
+    ! Debug
+    IF(printlev_loc>=5)THEN
+       IF (EndOfYear) THEN
+          DO ipts=1,kjpindex              
+             DO ivm=1,nvm
+                WRITE(numout,*) 'Average absolute transmitted light &
+                     & during the growing season to each canopy &
+                     & level in stomate.f90 ', &
+                     ivm,ipts,nlevels_tot
+                DO ilev = nlevels_tot,1,-1
+                   WRITE(numout,*) ilev,light_tran_to_level_season(ipts,ivm,ilev)
+                ENDDO
+             ENDDO
+          ENDDO
+       ENDIF
+    ENDIF
+    !-
+    ! Write trans_to_light to output file. It is calculated at each subdaily
+    ! timestep
+    CALL xios_orchidee_send_field("LIGHT_TRAN_TO_LEVEL",light_tran_to_level(:,:,:))
+
+    !! 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 (do_slow, litterhumdiag, litterhum_daily)
+    CALL stomate_accu (do_slow, t2m,           t2m_daily)
+    CALL stomate_accu (do_slow, temp_sol,      tsurf_daily)
+    CALL stomate_accu (do_slow, stempdiag,     tsoil_daily)
+    CALL stomate_accu (do_slow, shumdiag,      soilhum_daily)
+    CALL stomate_accu (do_slow, precip,        precip_daily)
+    CALL stomate_accu (do_slow, gpp_d,         gpp_daily)
+    CALL stomate_accu (do_slow, drainage_pft, drainage_daily) 
+
+    !! 4.2 Daily minimum temperature
+    t2m_min_daily(:) = MIN( t2m(:), t2m_min_daily(:) )
+
+    !! 4.3 Calculate maintenance respiration
+    ! Note: lai is passed as output argument to overcome previous problems with 
+    ! natural and agricultural vegetation types. 
+    CALL maint_respiration (kjpindex, dt_sechiba, t2m, t2m_longterm, &
+         stempdiag, gpp, gpp_week, lab_fac, &
+         veget_cov_max, rprof, resp_maint_part_radia, &
+         circ_class_n, circ_class_biomass)
+
+    ! 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 Initialize check for mass balance closure
+    !  Mass balance closure for the half-hourly (dt_sechiba)
+    !  processes in stomate.f90. This test is always performed.
+    !  If err_act.EQ.1 then the value of the mass balance error
+    !  -if any- is written to the history file. 
+!!$    printlev_loc=get_printlev('stomate')
+    check_intern(:,:,:,:) = zero
+    pool_start(:,:,:) = zero
+    DO iele = 1,nelements
+
+       ! atm_to_bm has as intent inout, the variable 
+       ! accumulates carbon over the course of a day. 
+       ! Use the difference between the start and end of 
+       ! this routine to account for the change in 
+       ! atm_to_bm
+       check_intern(:,:,iatm2land,iele) = - un * &
+            atm_to_bm(:,:,iele) * veget_cov_max(:,:) * dt_sechiba
+
+       ! Biomass pool (gC m-2)*(m2 m-2) 
+       DO ipar = 1,nparts
+          pool_start(:,:,iele) = pool_start(:,:,iele) + &
+               (turnover_daily(:,:,ipar,iele) + &
+               bm_to_litter(:,:,ipar,iele)) * veget_cov_max(:,:) / &
+               one_day * dt_sechiba
+       ENDDO
+
+       ! Litter pool (gC m-2)*(m2 m-2) 
+       DO ilitt = 1,nlitt
+          DO ilev = 1,nlevs
+             pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                  litter(:,ilitt,:,ilev,iele) * veget_cov_max(:,:)
+          ENDDO
+       ENDDO
+
+       ! Soil carbon (gC m-2)*(m2 m-2)
+       DO icarb = 1,ncarb
+          pool_start(:,:,iele) = pool_start(:,:,iele) + &
+               som(:,icarb,:,iele) * veget_cov_max(:,:)
+       ENDDO
+
+    ENDDO ! # nelements
+
+    ! Account for the N-pool in the soil 
+    DO inspec = 1,nnspec
+       pool_start(:,:,initrogen) = pool_start(:,:,initrogen) + &
+            soil_n_min(:,:,inspec) * veget_cov_max(:,:)
+    ENDDO
+
+    ! Initialize check for area conservation
+    veget_cov_max_begin(:,:) = veget_cov_max(:,:)
+   
+    !! 4.5 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.
+    n_mineralisation(:,:) = zero
+    turnover_littercalc(:,:,:,:) = turnover_daily(:,:,:,:) * dt_sechiba/one_day
+    bm_to_littercalc(:,:,:,:) = bm_to_litter(:,:,:,:) * dt_sechiba/one_day
+
+    CALL littercalc (kjpindex, &
+         turnover_littercalc, bm_to_littercalc, &
+         veget_cov_max, temp_sol, stempdiag, shumdiag, litterhumdiag, som, &
+         clay, silt, soil_n_min, litter, dead_leaves, lignin_struc, &
+         lignin_wood, n_mineralisation, deadleaf_cover, resp_hetero_litter, &
+         som_input_inst, control_temp_inst, control_moist_inst, n_fungivores, &
+         matrixA, vectorB, CN_target, CN_som_litter_longterm, tau_CN_longterm, &
+         ld_redistribute, circ_class_biomass, circ_class_n)
+
+    !--- TEMP---!
+    IF(printlev_loc>=4) THEN
+       WRITE(numout,*) 'between litter and soil ' 
+       WRITE(numout,*) 'n_mineralisation ', n_mineralisation(:,:)
+       WRITE(numout,*) 'drainage_pft ', drainage_pft(:,:)
+       WRITE(numout,*) 'control_temp_inst, ',control_temp_inst(:,:)
+       WRITE(numout,*) 'control_moist_inst, ',control_moist_inst(:,:)
+    ENDIF
+
+    !! 4.6 Soil carbon dynamics and soil heterotrophic respiration
+    ! Note: there is no vertical discretisation in the soil for litter decay.
+    CALL som_dynamics (kjpindex, clay, silt, veget_cov_max, &
+         som_input_inst, control_temp_inst, control_moist_inst, drainage_pft,&
+         CN_target, som, soil_n_min, resp_hetero_soil, matrixA, &
+         n_mineralisation, CN_som_litter_longterm, tau_CN_longterm)
+
+    ! Heterothropic soil respiration during time step ::dt_sechiba
+    ! @tex $(gC m^{-2})$ @endtex
+    IF(printlev_loc >= 4) THEN
+       WRITE(numout,*)'betweem som_dynamics and nitrogen_dynamics'
+       WRITE(numout,*)'n_mineralisation ', n_mineralisation(:,:)       
+       WRITE(numout,*)'resp_hetero_soil',resp_hetero_soil(:,:)
+       WRITE(numout,*)'dt_sechiba',dt_sechiba 
+       WRITE(numout,*)'one_day',one_day 
+    ENDIF
+
+    ! Heterothropic litter respiration during time step ::dt_sechiba 
+    ! @tex $(gC m^{-2})$ @endtex
+    resp_hetero_litter(:,:) = resp_hetero_litter(:,:) * dt_sechiba/one_day
+
+    !! resp_hetero_soil(:,1)=zero
+    resp_hetero_soil(:,:) = resp_hetero_soil(:,:) * dt_sechiba/one_day
+
+    ! Total heterothrophic respiration during time step ::dt_sechiba 
+    ! @tex $(gC m^{-2})$ @endtex
+    resp_hetero_radia(:,:) = resp_hetero_litter(:,:) + resp_hetero_soil(:,:)
+    resp_hetero_d(:,:) = resp_hetero_d(:,:) + resp_hetero_radia(:,:)
+
+    ! Sum heterotrophic and autotrophic respiration in soil 
+    resp_total_soil(:,:) = resp_hetero_radia(:,:) + & 
+         resp_maint_part_radia(:,:,isapbelow) + resp_maint_part_radia(:,:,iroot)
+
+    IF(ok_ncycle) THEN
+
+       CALL nitrogen_dynamics(kjpindex, clay, MAX(zero, un - silt - clay), & 
+            stempdiag-tp_00, tmc_pft, drainage_pft, swc_pft, veget_cov_max, &
+            resp_total_soil, som, &  
+            n_input, soil_ph, n_mineralisation, pb, n_fungivores, &  
+            plant_n_uptake, bulk, soil_n_min, p_O2, bact, atm_to_bm, &
+            leaching, emission, input_dt_sechiba, ld_redistribute, circ_class_biomass, &
+            circ_class_n)  
+
+    ENDIF
+
+    ! Accumulate over the day
+    plant_n_uptake_daily(:,:,:) = plant_n_uptake_daily(:,:,:) + plant_n_uptake(:,:,:)
+    n_mineralisation_d(:,:) = n_mineralisation_d(:,:) + n_mineralisation(:,:)  
+
+    !! 4.7 Accumulate instantaneous variables (do_slow=.FALSE.) 
+    ! Accumulate instantaneous variables (do_slow=.FALSE.) and eventually 
+    ! calculate daily mean value (do_slow=.TRUE.) 
+    CALL stomate_accu (do_slow, control_moist_inst, control_moist_daily)
+    CALL stomate_accu (do_slow, control_temp_inst, control_temp_daily)
+    CALL stomate_accu (do_slow, som_input_inst, som_input_daily)
+
+    !! 4.8 Check numerical consistency of this routine
+    !  These checks only check the processes that happen
+    !  every half-hour (dt_radia). This test is always 
+    !  performed. If err_act.EQ.1 then the value of the 
+    !  mass balance error -if any- is written to the 
+    !  history file.
+!!$    printlev_loc=get_printlev('stomate')
+
+    !  Check surface area
+    CALL check_surface_area("stomate dt_sechiba", kjpindex, veget_cov_max_begin, &
+         veget_cov_max,'pixel')
+
+    ! 4.8.2 Mass balance closure (dt_radia)
+    ! Calculate final carbon and nitrogen pools
+    pool_end(:,:,:) = zero
+    DO iele = 1,nelements
+
+       ! Litter pool
+       DO ilitt = 1,nlitt
+          DO ilev = 1,nlevs
+             pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                  litter(:,ilitt,:,ilev,iele) * veget_cov_max(:,:)
+          ENDDO
+       ENDDO
+
+       ! Soil carbon and nitrogen
+       DO icarb = 1,ncarb
+          pool_end(:,:,iele) = pool_end(:,:,iele) + &
+               som(:,icarb,:,iele) * veget_cov_max(:,:)
+       ENDDO
+
+    ENDDO ! # nelements
+
+    ! The nitrogen pool in the soil may have changed
+    DO inspec = 1,nnspec
+       pool_end(:,:,initrogen) = pool_end(:,:,initrogen) + &
+            soil_n_min(:,:,inspec) * veget_cov_max(:,:)
+    ENDDO
+
+    DO ivm = 1,nvm
+       pool_end(:,ivm,initrogen) = pool_end(:,ivm,initrogen) + &
+            n_fungivores(:,ivm) * veget_cov_max(:,ivm)
+    ENDDO
+
+    ! Calculate mass balance
+    ! Specific processes
+    check_intern(:,:,iland2atm,icarbon) = -un * (resp_hetero_litter(:,:) + &
+         resp_hetero_soil(:,:)) * veget_cov_max(:,:)
+
+    DO ininput = 1,ninput
+       check_intern(:,:,iatm2land,initrogen) = &
+            check_intern(:,:,iatm2land,initrogen) + &
+            input_dt_sechiba(:,:,ininput) * veget_cov_max(:,:)
+    ENDDO
+
+    DO inspec= 1, nnspec
+       check_intern(:,:,iland2atm,initrogen) = &
+            check_intern(:,:,iland2atm,initrogen) &
+            -un * (emission(:,:,inspec) * veget_cov_max(:,:))
+    ENDDO
+
+    DO inionspec = 1, nionspec
+       check_intern(:,:,ilat2out,initrogen) = &
+            check_intern(:,:,ilat2out,initrogen) &
+            -un * ( plant_n_uptake(:,:,inionspec) + &
+            leaching(:,:,inionspec) ) * veget_cov_max(:,:)
+    ENDDO
+
+    ! Common processes
+    DO iele = 1,nelements
+       check_intern(:,:,iatm2land,iele) = check_intern(:,:,iatm2land,iele) + &
+            atm_to_bm(:,:,iele) * dt_sechiba * veget_cov_max(:,:)
+       check_intern(:,:,ipoolchange,iele) = &
+            -un * (pool_end(:,:,iele) - pool_start(:,:,iele))
+    ENDDO
+
+    closure_intern(:,:,:) = zero
+    DO imbc = 1,nmbcomp
+       DO iele = 1,nelements
+          ! Debug
+          IF (printlev_loc>=4) WRITE(numout,*) &
+               'check_intern, ivm, imbc, iele, ', imbc, &
+               iele, SUM(check_intern(:,:,imbc,iele),2)
+          !-
+          closure_intern(:,:,iele) = closure_intern(:,:,iele) + &
+               check_intern(:,:,imbc,iele)
+       ENDDO
+    ENDDO
+
+    CALL check_mass_balance("stomate dt_sechiba", closure_intern, kjpindex, &
+         pool_end, pool_start, veget_cov_max, 'pft')
+
+    ! Accumulate the mass balance error over the course of the day
+    ! If all is well the mass balance error is zero (.LT. min_stomate)
+    DO iele = 1,nelements
+       mass_balance_closure(:,iele) = mass_balance_closure(:,iele) + &
+            SUM((closure_intern(:,:,iele) * veget_cov_max(:,:)),2)
+    ENDDO
+
+    !! 5. Daily processes - performed at the end of the day
+
+    IF (do_slow) THEN
+
+       !+++CHECK+++
+       ! No longer needed. lai is no longer passed
+       ! circ_class_biomass and circ_class_n are now the
+       ! prognostic variables.
+!!$       !! 5.1 Update lai
+!!$       ! Use lai from stomate
+!!$       ! ?? check if this is the only time ok_pheno is used??
+!!$       ! ?? Looks like it is the only time. But this variables probably is defined 
+!!$       ! in stomate_constants or something, in which case, it is difficult to track.
+!!$       IF (ok_pheno) THEN
+!!$          !! 5.1.1 Update LAI 
+!!$          ! Set lai of bare soil to zero
+!!$          lai(:,ibare_sechiba) = zero
+!!$          ! lai for all PFTs
+!!$          DO ipts = 1, kjpindex
+!!$             DO j = 2, nvm
+!!$                lai(ipts,j) = cc_to_lai(circ_class_biomass(ipts,j,:,ileaf,icarbon),&
+!!$                     circ_class_n(ipts,j,:),j)
+!!$             ENDDO
+!!$          ENDDO
+!!$          frac_age(:,:,:) = leaf_frac(:,:,:)
+!!$       ELSE 
+!!$          ! 5.1.2 Use a prescribed lai
+!!$          ! WARNING: code in setlai is effectively the same as the lines above
+!!$          ! Update subroutine if LAI should be prescribed. This is a bit an optimistic
+!!$          ! function. It is rather difficult to force an lai with a dynamic allocation 
+!!$          ! and a dynamic nitrogen cycle. This will quickly result in inconsistencies. 
+!!$          CALL  setlai(kjpindex, lai, circ_class_biomass,circ_class_n) 
+!!$          frac_age(:,:,:) = zero
+!!$       ENDIF
+       !++++++++++++
+
+       !! 5.2 Calculate long-term "meteorological" and biological parameters
+       ! mainly in support of calculating phenology. If ::EndOfYear=.TRUE.
+       ! annual values are update (i.e. xx_lastyear).
+       CALL season &
+            &          (kjpindex, dt_days, EndOfYear, &
+            &           veget_cov, veget_cov_max, &
+            &           humrel_daily, t2m_daily, tsoil_daily, soilhum_daily, lalo, &
+            &           precip_daily, npp_daily, circ_class_biomass, circ_class_n, &
+            &           turnover_daily, gpp_daily, when_growthinit, &
+            &           maxhumrel_lastyear, maxhumrel_thisyear, &
+            &           minhumrel_lastyear, minhumrel_thisyear, &
+            &           maxgppweek_lastyear, maxgppweek_thisyear, &
+            &           gdd0_lastyear, gdd0_thisyear, &
+            &           precip_lastyear, precip_thisyear, &
+            &           lm_lastyearmax, lm_thisyearmax, &
+            &           maxfpc_lastyear, maxfpc_thisyear, &
+            &           humrel_month, humrel_week, t2m_longterm, tau_longterm, &
+            &           t2m_month, t2m_week, tsoil_month, soilhum_month, &
+            &           npp_longterm, turnover_longterm, gpp_week, plant_status, &
+            &           gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+            &           time_hum_min, hum_min_dormance, gdd_init_date, &
+            &           gdd_from_growthinit, herbivores, &
+            &           Tseason, Tseason_length, Tseason_tmp, &
+            &           Tmin_spring_time, t2m_min_daily, onset_date, &
+            &           cn_leaf_min_season,nstress_season, &
+            &           humrel_growingseason,rue_longterm, harvest_area, &
+            &           harvest_5y_area)
+
+       !! 5.4 Waterstress
+
+       !  The waterstress factor varies between 0.1 and 1 and is calculated
+       !  from ::humrel_growingseason. The latter is only used in the allometric 
+       !  allocation and its time integral is determined by tau_sap for trees
+       !  (see constantes_mtc.f90 for tau_sap and see pft_constantes.f90 for 
+       !  the definition of tau_hum_growingseason). The time integral for 
+       !  grasses and crops is a prescribed constant (see constantes.f90). By
+       !  having ::wstress_fac working on the turnover, water stress is progated
+       !  into LF.
+       !  Because the calculated values for ::wstress_fac are too low for this purpose
+       !  Sonke Zhaele multiply it by two in the N-branch. This approach maintains
+       !  the physiological basis of KF while combining it with a simple 
+       !  multiplicative factor for water stress. Clearly after multiplication with 
+       !  2, wstress is closer to 1 and will thus result in a KF values closer to 
+       !  the physiologically expected KF. 
+       !  In this implementation we take the sqrt (this is done in stomate where 
+       !  ::humrel_daily is calculated from ::stressed and ::unstressed. The
+       !  transformation from the ratio between stressed an unstressed gpp into a 
+       !  numerical value that is used in the allocation and turnover is arbitrairy.
+       !  A more physiological approach accounting for turgor would be needed to de
+       !  fundamentally better.
+       !  Note that the current implementation allows for the plants to adapt to drought 
+       !  by adjusting its allocation. This is a long-term effect and it is long-term
+       !  because ::humrel_growingseason integrates over ::tau_sap. For the moment no
+       !  short term effects to drought are implemented. Short-term effects should be 
+       !  implmented on mortality (through loss of turgor, heat stress, carbon starvation).
+
+       wstress_season(:,1) = zero
+       wstress_month(:,1) = zero
+!!$       vir_wstress_fac(:,1) = zero
+
+       DO jv = 2,nvm
+
+          ! Calculate waterstress
+          ! Water stress used in stomate
+          ! Set wstress to 1-humrel so that the value is consistent with its
+          ! meaning. wstress=0 indicates no stress, wstress=1 indicates stress 
+          wstress_season(:,jv) = un - MAX(humrel_growingseason(:,jv), min_water_stress)
+          wstress_month(:,jv) = un - MAX(humrel_month(:,jv), min_water_stress)
+!!$          vir_wstress_fac(:,jv) = MAX(vir_humrel_growingseason(:,jv), min_water_stress)
+
+          !+++CHECK+++
+          ! The reduction of the leaf longevity should probably depend on
+          ! the leaf skin temperature that will become available through
+          ! the multi-layer energy budget. For the moment we don't have
+          ! water stress on the leaves. A long term adaption could be 
+          ! through ::sla
+          tau_eff_leaf(:,jv) = tau_leaf(jv) * un
+
+          ! The reduction of the root longevity depends on the soil moisture
+          ! stress which we believe is reasonably well captured by our 
+          ! proxy for wstress. We need to produce more roots to take the water
+          ! from those layers that have water.
+          ! feedback to c-allocation has been switched off
+          tau_eff_root(:,jv) = tau_root(jv) *  un
+
+          ! The reduction of sapwood longevity should depend on the cavitation
+          ! which is calculated in hydrol_architecture. Should be linked
+          ! once the memory of cavitation is calculated
+          tau_eff_sap(:,jv) = tau_sap(jv) *  un
+          !+++++++++
+
+       ENDDO
+
+       ! Add to history file
+       CALL histwrite_p (hist_id_stomate, 'WSTRESS_SEASON', itime, &
+            wstress_season(:,:), kjpindex*nvm, horipft_index)
+       CALL histwrite_p (hist_id_stomate, 'WSTRESS_MONTH', itime, &
+            wstress_month(:,:), kjpindex*nvm, horipft_index)
+       CALL xios_orchidee_send_field("WSTRESS_SEASON",wstress_season(:,:))
+       CALL xios_orchidee_send_field("WSTRESS_MONTH",wstress_month(:,:))
+
+       !! 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 stomate_lpj_vegetation (kjpindex, dt_days, EndOfYear, &
+            &             neighbours, resolution, &
+            &             herbivores, &
+            &             tsurf_daily, tsoil_daily, t2m_daily, t2m_min_daily, &
+            &             litterhum_daily, soilhum_daily, &
+            &             maxhumrel_lastyear, minhumrel_lastyear, &
+            &             gdd0_lastyear, precip_lastyear, &
+            &             humrel_month, humrel_week, &
+            &             t2m_longterm, t2m_month, t2m_week, &
+            &             tsoil_month, soilhum_month, &
+            &             gdd_m5_dormance,  gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+            &             turnover_longterm, gpp_daily, &
+            &             time_hum_min, hum_min_dormance, maxfpc_lastyear, resp_maint_part,&
+            &             PFTpresent, age, fireindex, firelitter, &
+            &             leaf_age, leaf_frac, adapted, regenerate, &
+            &             plant_status, when_growthinit, litter, &
+            &             dead_leaves, som, lignin_struc, lignin_wood, &
+            &             veget_cov_max, veget_cov, veget_cov_max_new, npp_longterm, lm_lastyearmax, &
+            &             veget_lastlight, everywhere, need_adjacent, RIP_time, &
+            &             rprof, npp_daily, turnover_daily, turnover_time,&
+            &             control_moist_inst, control_temp_inst, som_input_daily, &
+            &             atm_to_bm, co2_fire, &
+            &             resp_hetero_d, resp_maint_d, resp_growth_d, &
+            &             height, deadleaf_cover, vcmax, nue, &
+            &             bm_to_litter,&
+            &             prod_s, prod_m, prod_l, flux_s, flux_m, flux_l, &
+            &             flux_prod_s, flux_prod_m, flux_prod_l, carb_mass_total, &
+            &             fpc_max, MatrixA, MatrixV, VectorB, VectorU, &
+            &             Tseason, Tmin_spring_time, onset_date, KF, k_latosa_adapt,&
+            &             cn_leaf_min_season, nstress_season, humrel_growingseason, soil_n_min, &
+            &             rue_longterm, plant_n_uptake_daily, &
+            &             circ_class_n, circ_class_biomass, forest_managed, forest_managed_lastyear, &
+            &             tau_eff_leaf, tau_eff_sap, tau_eff_root, &
+            &             species_change_map, fm_change_map, lpft_replant, &
+            &             age_stand, rotation_n, last_cut, mai, pai, &
+            &             previous_wood_volume, mai_count, coppice_dens, &
+            &             lab_fac, circ_class_dist, store_sum_delta_ba, &
+            &             harvest_pool_bound, harvest_pool, harvest_type, harvest_cut, harvest_area, &
+            &             lai_per_level, laieff_fit, h_array_out, z_array_out, &
+            &             max_height_store, &
+            &             wstress_month, wstress_season, st_dist, litter_demand,&
+            &             mass_balance_closure, light_tran_to_level_season, p_O2, bact, &
+            &             CN_som_litter_longterm, nbp_pool_start,&
+            &             wind_speed_daily, soil_temp_daily, harvest_5y_area)
+
+       ! Write the mass balance error accumulated over the course of day
+       ! to the history file
+       ! If err_act = 3  the model should stop as soon as there is an 
+       ! imbalance. Hence, when this block of code is reached it means 
+       ! there is no mass balanc error. In case err_act is 1 or 2, the
+       ! model will not be stopped. It is thus possible to end up here
+       ! and to write a mass balance error.
+       DO iele = 1,nelements
+          IF (iele == icarbon) THEN
+             element_str(iele) = '_c'
+          ELSEIF (iele == initrogen) THEN
+             element_str(iele) = '_n'
+          ELSE
+             CALL ipslerr_p(3,'stomate.f90','Define label for iele','','')
+          ENDIF
+
+          CALL histwrite_p (hist_id_stomate,'MB_CLOSURE'//TRIM(element_str(iele)), itime, &
+               mass_balance_closure(:,iele), kjpindex, horipft_index)
+          CALL xios_orchidee_send_field("MB_CLOSURE"//TRIM(element_str(iele)), &
+               mass_balance_closure(:,iele)) 
+       ENDDO
+
+       !! 5.5.2 Long term adaptation of allocation to water stress
+       !  ::wstress season is calculated as the seasonal mean of the
+       !  ratio between the stressed and unstressed GPP. If the plant
+       !  experiences a short spell of drought, leaves will be killed
+       !  (see stomate_turnover). However, when the drought stress is 
+       !  maintained during the season, it is assumed that the plant 
+       !  will economise its canopy and therefore adjust its allocation
+       ! factors to grow less leaves. To avoid that the canopy can only
+       ! shrink the plants will try to grow more leaves when they do
+       ! not experience any water stress. Extending the LAI, however,
+       ! increases the chances that the plant will experience drough 
+       ! stress in the future. These feedbacks should stabilize the LAI.
+       wstress_adapt(:,:) = zero
+       WHERE (wstress_season(:,:) .LT. 0.01)
+
+          ! Increase the leaf allocation by 5% over the whole
+          ! year. If there was no water stress during the whole 
+          ! year, the following year more C will be allocated
+          ! to the leaves.
+          wstress_adapt(:,:) = 1.05
+
+       ELSEWHERE
+
+          wstress_adapt(:,:) = wstress_season(:,:)
+
+       ENDWHERE
+
+       !+++CHECK+++
+       ! Don't use this adaptation
+!!$       k_latosa_adapt(:,:) = k_latosa_adapt(:,:) * &
+!!$            (wstress_adapt(:,:)**(un/365))
+       !+++++++++++
+
+       DO j = 2,nvm
+
+          WHERE ( k_latosa_adapt(:,j) .GE. k_latosa_max(j) )
+
+             k_latosa_adapt(:,j) = k_latosa_max(j)
+
+          ENDWHERE
+
+       ENDDO
+
+       CALL histwrite_p (hist_id_stomate, 'K_LATOSA_ADAPT', itime, &
+            k_latosa_adapt(:,:), kjpindex*nvm, horipft_index)
+       CALL xios_orchidee_send_field("K_LATOSA_ADAPT",k_latosa_adapt)
+
+       !+++CHECK+++
+       ! check units and variable names for new lcchange and product use
+       !! 5.3.2 Calculate the total CO2 flux from land use change
+       !fco2_lu(:) = convflux(:) &
+       !     &             + flux_prod10(:)  &
+       !     &             + flux_prod100(:) &
+       !     &             + harvest_above(:)
+       ! It is an output variable so we just gave it a value
+       ! when looking at the history files the value zero should
+       ! ring a bell that there is something wrong.
+       !fco2_lu(:) = 0
+       !+++++++++++
+
+       !! 5.4 Calculate veget_max
+       veget_max(:,:) = zero 
+       DO j = 1, nvm
+          veget_max(:,j) = veget_max(:,j) + &
+               & veget_cov_max(:,j) * ( 1.-totfrac_nobio(:) )
+       ENDDO
+
+       !! 5.5 Photosynthesis parameters
+       assim_param(:,:,ivcmax) = zero
+       assim_param(:,:,inue)   = zero
+       assim_param(:,:,ileafn) = zero
+       DO j = 2,nvm
+          assim_param(:,j,ivcmax) = vcmax(:,j)
+          assim_param(:,j,inue)   = nue(:,j)
+          assim_param(:,j,ileafn) = SUM(circ_class_biomass(:,j,:,ileaf,initrogen)*circ_class_n(:,j,:),2)
+       ENDDO
+
+       !! 5.6 Update forcing variables for soil carbon
+       IF (TRIM(Cforcing_name) /= 'NONE') THEN
+          npp_tot(:) = 0
+          DO j=2,nvm
+             npp_tot(:) = npp_tot(:) + npp_daily(:,j)
+          ENDDO
+          ! ::nbyear Number of years saved for carbon spinup
+          sf_time = MODULO(REAL(date,r_std)-1,one_year*REAL(nbyear,r_std))
+          iatt=FLOOR(sf_time/dt_forcesoil) + 1
+          IF (iatt == 0) iatt = iatt_old + 1
+          IF ((iatt<iatt_old) .and. (.not. cumul_Cforcing)) THEN
+             nforce(:)=0
+             carbon_input(:,:,:,:) = zero
+             nitrogen_input(:,:,:,:) = zero
+             control_moist(:,:,:) = zero
+             control_temp(:,:,:) = zero
+             npp_equil(:,:) = zero
+             drainage(:,:,:) = zero
+          ENDIF
+          iatt_old = iatt
+          ! Update forcing
+          nforce(iatt) = nforce(iatt)+1
+          carbon_input(:,:,:,iatt) = carbon_input(:,:,:,iatt) + som_input_daily(:,:,:,icarbon)
+          nitrogen_input(:,:,:,iatt) = nitrogen_input(:,:,:,iatt) + som_input_daily(:,:,:,initrogen)
+          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(:)
+          drainage(:,:,iatt) = drainage(:,:,iatt) + drainage_daily(:,:)
+       ENDIF
+
+       !! 5.8 Write forcing file
+       ! 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 ( TRIM(forcing_name) /= 'NONE' ) THEN
+
+          !! 5.8.1 Convert GPP to sechiba time steps
+          ! GPP is multiplied by coverage to obtain forcing @tex $(gC m^{-2} dt_stomate^{-1})$\f \end@tex $(m^2 m^{-2})$ @endtexonly
+          ! @tex$ m^{-2}$ @endtex remains in the units because ::veget_cov_max is a fraction, not a 
+          ! surface area. In sechiba values are ponderated by surface and frac_no_bio. 
+          ! At the beginning of stomate, the units are converted. 
+          ! When we use forcesoil we call sechiba_main and so we need the have the same units as in sechiba.
+          gpp_daily_x(:,:) = zero
+          DO j = 2, nvm             
+             gpp_daily_x(:,j) = gpp_daily_x(:,j) + &
+                  & gpp_daily(:,j) * dt_stomate / one_day * veget_cov_max(:,j)
+          ENDDO
+
+          ! Bare soil moisture availability has not been treated
+          ! in STOMATE, update it here
+          humrel_daily(:,ibare_sechiba) = humrel(:,ibare_sechiba)   
+
+          ! Update index to store the next forcing step in memory
+          iisf = iisf+1
+
+          ! How many times have we treated this forcing state
+          xn = REAL(nf_cumul(isf(iisf)),r_std)
+
+          !! 5.8.2 Cumulate forcing variables
+          ! Cumulate forcing variables (calculate average)
+          ! Note: precipitation is multiplied by dt_stomate/one_day to be consistent with 
+          ! the units in sechiba
+          IF (cumul_forcing) THEN
+             clay_fm(:,iisf) = (xn*clay_fm(:,iisf)+clay(:))/(xn+1.)
+             silt_fm(:,iisf) = (xn*silt_fm(:,iisf)+silt(:))/(xn+1.) 
+             bulk_fm(:,iisf) = (xn*bulk_fm(:,iisf)+bulk(:))/(xn+1.) 
+             humrel_daily_fm(:,:,iisf) = &
+                  & (xn*humrel_daily_fm(:,:,iisf) + humrel_daily(:,:))/(xn+1.)
+             litterhum_daily_fm(:,iisf) = &
+                  & (xn*litterhum_daily_fm(:,iisf)+litterhum_daily(:))/(xn+1.)
+             t2m_daily_fm(:,iisf) = &
+                  & (xn*t2m_daily_fm(:,iisf)+t2m_daily(:))/(xn+1.)
+             t2m_min_daily_fm(:,iisf) = &
+                  & (xn*t2m_min_daily_fm(:,iisf)+t2m_min_daily(:))/(xn+1.)
+             tsurf_daily_fm(:,iisf) = &
+                  & (xn*tsurf_daily_fm(:,iisf)+tsurf_daily(:))/(xn+1.)
+             tsoil_daily_fm(:,:,iisf) = &
+                  & (xn*tsoil_daily_fm(:,:,iisf)+tsoil_daily(:,:))/(xn+1.)
+             soilhum_daily_fm(:,:,iisf) = &
+                  & (xn*soilhum_daily_fm(:,:,iisf)+soilhum_daily(:,:))/(xn+1.)
+             precip_fm(:,iisf) = &
+                  & (xn*precip_fm(:,iisf)+precip_daily(:)*dt_stomate/one_day)/(xn+1.)
+             gpp_daily_fm(:,:,iisf) = &
+                  & (xn*gpp_daily_fm(:,:,iisf) + gpp_daily_x(:,:))/(xn+1.)
+             veget_fm(:,:,iisf) = &
+                  & (xn*veget_fm(:,:,iisf) + veget(:,:) )/(xn+1.)
+             veget_max_fm(:,:,iisf) = &
+                  & (xn*veget_max_fm(:,:,iisf) + veget_max(:,:) )/(xn+1.)
+!!$             lai_fm(:,:,iisf) = &
+!!$                  & (xn*lai_fm(:,:,iisf) + lai(:,:) )/(xn+1.)
+             drainage_fm(:,:,iisf) = & 
+                  & (xn*drainage_fm(:,:,iisf) + drainage_daily(:,:) )/(xn+1.) 
+          ELSE
+             ! Here we just calculate the values
+             clay_fm(:,iisf) = clay(:)
+             silt_fm(:,iisf) = silt(:) 
+             bulk_fm(:,iisf) = bulk(:) 
+             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(:,:)
+             drainage_fm(:,:,iisf) =drainage_daily(:,:) 
+          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(:,:) - atm_to_bm(:,:,icarbon) - gpp_daily(:,:)
+!!$
+!!$     CALL xios_orchidee_send_field("nep",SUM(co2_flux_daily*veget_cov_max,dim=2)/1e3/one_day)
+!!$
+!!$       IF ( hist_id_stom_IPCC > 0 ) THEN
+!!$          vartmp(:) = SUM(co2_flux_daily*veget_cov_max,dim=2)/1e3/one_day*contfrac
+!!$          CALL histwrite_p (hist_id_stom_IPCC, "nep", itime, &
+!!$               vartmp, kjpindex, hori_index)
+!!$       ENDIF
+!!$
+!!$       ! See 5.9 for details on NEP + fire. At the monthly time step also 
+!!$       ! harvest and land use change are calculated
+!!$       co2_flux_monthly(:,:) = co2_flux_monthly(:,:) + co2_flux_daily(:,:)
+!!$       harvest_above_monthly(:) = harvest_above_monthly(:) + harvest_above(:)
+!!$       flux_prod_monthly(:) = flux_prod_monthly(:) + convflux(:) + & 
+!!$        & flux_prod10(:) + flux_prod100(:)
+!!$      
+!!$       !! 5.10 Compute monthly CO2 fluxes 
+!!$       IF ( EndOfMonth ) THEN
+!!$          !! 5.10.1 Write history file for monthly fluxes
+!!$          CALL histwrite_p (hist_id_stomate, 'CO2FLUX', itime, &
+!!$               co2_flux_monthly, kjpindex*nvm, horipft_index)
+!!$          
+!!$          !?? I (=VB) translated the French, but the whole stuff does not make sense to me.
+!!$          ! If one deletes the montly cumulation,
+!!$          ! one should not forget this change in resolution(:,1)*resolution(:,2)*contfrac(:)
+!!$          ! Si on supprimer le cumul par mois, 
+!!$          ! il ne faut pas oublier cette modif resolution(:,1)*resolution(:,2)*contfrac(:)
+!!$          ! Should be supressed, this is post-processing 
+!!$          DO j=2, nvm
+!!$             co2_flux_monthly(:,j) = co2_flux_monthly(:,j)* &
+!!$                  resolution(:,1)*resolution(:,2)*contfrac(:)
+!!$          ENDDO
+!!$
+!!$          ! Should be supressed, this is post-processing
+!!$          ! ?? How does it differ from co2_flux_monthly??
+!!$          net_co2_flux_monthly = zero
+!!$          DO ji=1,kjpindex
+!!$             DO j=2,nvm
+!!$                net_co2_flux_monthly = net_co2_flux_monthly + &
+!!$                     &  co2_flux_monthly(ji,j)*veget_cov_max(ji,j)
+!!$             ENDDO
+!!$          ENDDO
+!!$
+!!$     
+!!$          !! 5.10.2 Cumulative fluxes of land use cover change, harvest and net biosphere production
+!!$          ! Parallel processing, gather the information from different processors. first argument is the lo
+!!$          ! local variable, the second argument is the global variable. bcast send it to all processors.
+!!$          net_flux_prod_monthly_sum = &
+!!$              &  SUM(flux_prod_monthly(:)*resolution(:,1)*resolution(:,2)*contfrac(:))*1e-15
+!!$          CALL reduce_sum(net_flux_prod_monthly_sum,net_flux_prod_monthly_tot)
+!!$          CALL bcast(net_flux_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_flux_prod_monthly_tot + &
+!!$             & net_harvest_above_monthly_tot )
+!!$          
+!!$          WRITE(numout,9010) 'GLOBAL net_flux_prod_monthly    (Peta gC/month)  = ',net_flux_prod_monthly_tot
+!!$          WRITE(numout,9010) 'GLOBAL net_harvest_above_monthly (Peta gC/month)  = ',net_harvest_above_monthly_tot
+!!$          WRITE(numout,9010) 'GLOBAL net_co2_flux_monthly      (Peta gC/month)  = ',net_co2_flux_monthly_sum
+!!$          WRITE(numout,9010) 'GLOBAL net_biosp_prod_monthly    (Peta gC/month)  = ',net_biosp_prod_monthly_tot
+!!$
+!!$9010  FORMAT(A52,F17.14)
+!!$
+!!$          ! Reset Monthly values
+!!$          co2_flux_monthly(:,:) = zero
+!!$          harvest_above_monthly(:) = zero
+!!$          flux_prod_monthly(:)    = zero
+!!$
+!!$       ENDIF ! Monthly processes - at the end of the month
+
+    !   IF (spinup_analytic) THEN
+    !   I (ASLA) Do not think we have to include the below calculations of
+    !   nbp_accu. It is only used to calculate nbp_flux, but this variable is
+    !   use for nothing except being written to the restart/being read from the
+    !   restart. It is still included on CN, but there I do not see the use of
+    !   it either.  
+    !  
+    !      WRITE(numout,*) 'ERROR:check the code. There was nothing defined yet'
+    !      CALL ipslerr_p(3,'ERROR:check the code', &
+    !           'there was nothing defined yet','','')
+
+!!$       CALL xios_orchidee_send_field("nep",SUM(co2_flux_daily*veget_cov_max,dim=2)/1e3/one_day)
+
+          !+++CHECK+++
+    !      nbp_accu(:) = nbp_accu(:) + (-SUM(co2_flux_daily(:,:) * &
+    !           veget_cov_max(:,:),dim=2) - (convflux(:) + flux_prod10(:) + &
+    !           flux_prod100(:))  - harvest_above(:))/1e3 
+
+          ! Daily NBP is used in the spin-up. Rather than starting from 
+          ! all the initial components as done previously we prefer to 
+          ! make use of the aggregated components calculated to check the 
+          ! mass balance closure. NBP is then the change in all
+          ! biomass pools.
+
+          !+++CHECK+++
+          ! pool_end and pool_begin need to be defined
+!!$          nbp_accu(:) = nbp_accu(:) + &
+!!$               SUM((pool_end(:,:,icarbon) - pool_start(:,:,icarbon)),2)
+          !+++++++++++
+
+      ! ENDIF (spinup_analytic)
+       !! 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
+       drainage_daily(:,:) = zero 
+       plant_n_uptake_daily(:,:,:)=zero 
+       n_mineralisation_d(:,:)=zero 
+       IF (printlev_loc >= 3) THEN
+          WRITE(numout,*) 'stomate_main: daily processes done'
+       ENDIF
+
+
+       ! 5.12 pool-based NBP. 
+       ! Calculate the end pool for the pool-based NBP estimate
+       IF( SPINUP_ANALYTIC ) THEN
+          DO ipar = 1,nparts
+             DO icir=1, ncirc
+                nbp_pool_end(:,:) = nbp_pool_end(:,:) + &
+                   (circ_class_biomass(:,:,icir,ipar,icarbon) * &
+                   circ_class_n(:,:,icir)*veget_cov_max(:,:))
+             ENDDO
+          ENDDO
+          ! To make sure we the carbon that leaves the ecosystem via heterotropic
+          ! respiration 
+          ! in to account, the soil and litter pools are summed
+          DO icarb = 1, ncarb
+             nbp_pool_end(:,:) = nbp_pool_end(:,:) + &
+               som(:,icarb,:,icarbon)*veget_cov_max(:,:)
+          ENDDO
+
+          DO ilitt = 1,nlitt
+             DO ilev =1,nlevs
+                nbp_pool_end(:,:) = nbp_pool_end(:,:) + &
+                   litter(:,ilitt,:,ilev,icarbon)*veget_cov_max(:,:)
+             ENDDO
+          ENDDO
+
+          ! Calculate nbp for each time step
+          nbp(:,:)=nbp_pool_end(:,:) - nbp_pool_start(:,:)
+          ! Calculate an accumulated pool-based NBP
+          nbp_accu_pool(:,:) = nbp_accu_pool(:,:) + nbp(:,:)
+    
+          ! reset the nbp_pool_start and nbp_pool_end
+          nbp_pool_start(:,:) = nbp_pool_end
+          nbp_pool_end(:,:) = zero 
+
+          ! Write to output
+          CALL xios_orchidee_send_field("NBP_pool",nbp)
+       ENDIF ! SPINUP_ANALYTIC
+ 
+    ENDIF  ! Daily processes - at the end of the day
+
+    !! 6. Outputs from Stomate
+
+    ! co2_flux receives a value from STOMATE only if STOMATE is activated.
+    ! Otherwise, the calling hydrological module must do this itself.
+
+    !! 6.1 Respiration and fluxes
+    resp_maint(:,:) = resp_maint_radia(:,:)*veget_cov_max(:,:)
+    resp_maint(:,ibare_sechiba) = zero
+    resp_growth(:,:)= resp_growth_d(:,:)*veget_cov_max(:,:)*dt_sechiba/one_day
+    resp_hetero(:,:) = 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(:,:)-atm_to_bm(:,:,icarbon))*veget_cov_max(:,:)/one_day &
+         & - gpp(:,:)
+
+    temp_growth(:)=t2m_month(:)-tp_00 
+
+    !! 7. Analytical spinup
+
+    IF (spinup_analytic) THEN
+
+       tau_CN_longterm = tau_CN_longterm + dt_sechiba/one_day
+
+       !! 7.1. Update V and U at sechiba time step
+       DO m = 2,nvm
+          DO j = 1,kjpindex 
+             ! V <- A * V
+             matrixV(j,m,:,:) = MATMUL(matrixA(j,m,:,:),matrixV(j,m,:,:))
+             ! U <- A*U + B
+             vectorU(j,m,:) = MATMUL(matrixA(j,m,:,:),vectorU(j,m,:)) + vectorB(j,m,:)
+          ENDDO ! loop pixels
+       ENDDO ! loop PFTS
+
+
+       !! 7.2. What happened at the end of the year ?
+       IF (EndOfYear) THEN
+
+          !
+          ! 7.2.1 Increase the years counter every EndOfyear
+          !
+          global_years = global_years + 1 
+
+
+          !
+          ! 7.2.3 Is global_years is a multiple of the period time ?
+          !
+
+          !
+          ! 3.2.1 When global_years is a multiple of the spinup_period, we calculate :
+          !       1) the mean nbp flux over the period. This value is restarted
+          !       2) we solve the matrix system by Gauss Jordan method
+          !       3) We test if a point is at equilibrium : if yes, we mark the point (ok_equilibrium array)
+          !       4) Then we reset the matrix 
+          !       5) We erase the carbon_stock calculated by ORCHIDEE by the one found by the method
+          IF( MOD(global_years, spinup_period) == 0 ) THEN
+             WRITE(numout,*) 'Spinup analytic : Calculate if system is in equlibrium. global_years=',global_years
+             ! The number total of days during the forcing period is given by :
+             !    spinup_period*365 (we consider only the noleap calendar)
+             nbp_flux(:) = nbp_accu(:) / ( spinup_period * 365.)
+             nbp_pool(:,:) = nbp_accu_pool(:,:) / ( spinup_period * 365.)
+             ! write to output
+             CALL xios_orchidee_send_field("NBP_pool_spinup",nbp_pool)
+
+             ! Reset the values
+             nbp_accu(:) = zero
+             nbp_accu_pool(:,:) = zero
+
+             carbon_stock(:,ibare_sechiba,:) = zero
+             ! Prepare the matrix for the resolution
+             ! Add a temporary matrix W which contains I-matrixV
+             ! we should take the opposite of matrixV and add the identitiy : we solve (I-matrixV)*C = vectorU
+             matrixW(:,:,:,:) = moins_un * matrixV(:,:,:,:)
+             DO jv = 1,nbpools
+                matrixW(:,:,jv,jv) =  matrixW(:,:,jv,jv) + un
+             ENDDO
+             carbon_stock(:,:,:) = vectorU(:,:,:)
+
+             !
+             !  Solve the linear system
+             !
+             DO m = 2,nvm
+                DO j = 1,kjpindex
+                   ! the solution will be stored in vectorU : so it should be restarted before
+                   ! loop over kjpindex and nvm, so we solved kjpindex*(nvm-1) (7,7) linear systems
+                   CALL gauss_jordan_method(nbpools,matrixW(j,m,:,:),carbon_stock(j,m,:))
+                ENDDO ! loop pixels
+             ENDDO ! loop PFTS
+
+             ! Reset temporary matrixW
+             matrixW(:,:,:,:) = zero 
+
+
+             previous_stock(:,:,:) = current_stock(:,:,:)
+             current_stock(:,:,:) = carbon_stock(:,:,:)
+  
+             ! The relative error is calculated over the passive carbon pool 
+             ! (sum over the pfts) over the pixel.
+             CALL error_L1_passive(kjpindex,nvm, nbpools, current_stock, &
+                  previous_stock, veget_cov_max, eps_carbon, carbon_eq)   
+
+             !! ok_equilibrium is saved,
+             WHERE( carbon_eq(:) .AND. .NOT.(ok_equilibrium(:)) )
+                ok_equilibrium(:) = .TRUE.  
+             ENDWHERE
+
+             WRITE(numout,*) 'current_stock actif:',current_stock(test_grid,test_pft,iactive)
+             WRITE(numout,*) 'current_stock slow:',current_stock(test_grid,test_pft,islow)
+             WRITE(numout,*) 'current_stock passif:',current_stock(test_grid,test_pft,ipassive)
+             WRITE(numout,*) 'current_stock surface:',current_stock(test_grid,test_pft,isurface)
+
+             ! Reset matrixV for the pixel to the identity matrix and vectorU to zero
+             matrixV(:,:,:,:) = zero
+             vectorU(:,:,:) = zero
+             DO jv = 1,nbpools
+                matrixV(:,:,jv,jv) = un
+             END DO
+             WRITE(numout,*) 'Reset for matrixV and vectorU done'    
+
+             !! Write the values found in the standard outputs of ORCHIDEE
+             litter(:,istructural,:,iabove,icarbon) = carbon_stock(:,:,istructural_above)
+             litter(:,istructural,:,ibelow,icarbon) = carbon_stock(:,:,istructural_below)
+             litter(:,imetabolic,:,iabove,icarbon) = carbon_stock(:,:,imetabolic_above)
+             litter(:,imetabolic,:,ibelow,icarbon) = carbon_stock(:,:,imetabolic_below)
+             litter(:,iwoody,:,iabove,icarbon) = carbon_stock(:,:,iwoody_above)
+             litter(:,iwoody,:,ibelow,icarbon) = carbon_stock(:,:,iwoody_below)
+             som(:,iactive,:,icarbon) = carbon_stock(:,:,iactive_pool)
+             som(:,isurface,:,icarbon) = carbon_stock(:,:,isurface_pool)
+             som(:,islow,:,icarbon) = carbon_stock(:,:,islow_pool)
+             som(:,ipassive,:,icarbon) = carbon_stock(:,:,ipassive_pool) 
+
+             litter(:,:,:,:,initrogen) = zero
+             som(:,:,:,initrogen) = zero
+
+             WHERE( CN_som_litter_longterm(:,:,istructural_above) .GT. min_stomate)
+                litter(:,istructural,:,iabove,initrogen) = carbon_stock(:,:,istructural_above) &
+                     / CN_som_litter_longterm(:,:,istructural_above)
+             ENDWHERE
+
+             WHERE( CN_som_litter_longterm(:,:,istructural_below) .GT. min_stomate)
+                litter(:,istructural,:,ibelow,initrogen) = carbon_stock(:,:,istructural_below) &
+                     / CN_som_litter_longterm(:,:,istructural_below)
+             ENDWHERE
+
+             WHERE( CN_som_litter_longterm(:,:,imetabolic_above) .GT. min_stomate)
+                litter(:,imetabolic,:,iabove,initrogen)  = carbon_stock(:,:,imetabolic_above)  &
+                     / CN_som_litter_longterm(:,:,imetabolic_above)
+             ENDWHERE
+
+             WHERE( CN_som_litter_longterm(:,:,imetabolic_below) .GT. min_stomate)
+                litter(:,imetabolic,:,ibelow,initrogen)  = carbon_stock(:,:,imetabolic_below)  &
+                     / CN_som_litter_longterm(:,:,imetabolic_below)
+             ENDWHERE
+
+             WHERE( CN_som_litter_longterm(:,:,iwoody_above) .GT. min_stomate)
+                litter(:,iwoody,:,iabove,initrogen)      = carbon_stock(:,:,iwoody_above)      &
+                     / CN_som_litter_longterm(:,:,iwoody_above)    
+             ENDWHERE
+
+             WHERE( CN_som_litter_longterm(:,:,iwoody_below) .GT. min_stomate)
+                litter(:,iwoody,:,ibelow,initrogen)      = carbon_stock(:,:,iwoody_below)      &
+                     / CN_som_litter_longterm(:,:,iwoody_below)    
+             ENDWHERE
+
+             WHERE(CN_som_litter_longterm(:,:,iactive_pool) .GT. min_stomate)
+                som(:,iactive,:,initrogen)               = carbon_stock(:,:,iactive_pool)      &
+                     / CN_som_litter_longterm(:,:,iactive_pool)    
+             ENDWHERE
+
+             WHERE(CN_som_litter_longterm(:,:,isurface_pool) .GT. min_stomate)
+                som(:,isurface,:,initrogen)              = carbon_stock(:,:,isurface_pool)     &
+                     / CN_som_litter_longterm(:,:,isurface_pool)   
+             ENDWHERE
+
+             WHERE(CN_som_litter_longterm(:,:,islow_pool) .GT. min_stomate)
+                som(:,islow,:,initrogen)                 = carbon_stock(:,:,islow_pool)        &
+                     / CN_som_litter_longterm(:,:,islow_pool)      
+             ENDWHERE
+
+             WHERE(CN_som_litter_longterm(:,:,ipassive_pool) .GT. min_stomate)
+                som(:,ipassive,:,initrogen)              = carbon_stock(:,:,ipassive_pool)     &
+                     / CN_som_litter_longterm(:,:,ipassive_pool)     
+             ENDWHERE
+
+             CN_som_litter_longterm(:,:,:) = zero
+             tau_CN_longterm = dt_sechiba/one_day
+             ! Final step, test if all points at the local domain are at equilibrium
+             ! The simulation can be stopped when all local domains have reached the equilibrium
+             IF(ALL(ok_equilibrium)) THEN
+                WRITE(numout,*) 'Spinup analytic : Equilibrium for carbon pools is reached for current local domain'
+             ELSE
+                WRITE(numout,*) 'Spinup analytic : Equilibrium for carbon pools is not yet reached for current local domain'
+             END IF
+          ENDIF ! ( MOD(global_years,spinup_period) == 0)
+       ENDIF ! (EndOfYear)
+
+    ENDIF !(spinup_analytic)
+
+    IF (printlev >= 4) WRITE(numout,*) 'Leaving stomate_main'
+
+  END SUBROUTINE stomate_main
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_finalize
+!!
+!>\BRIEF        Write variables to restart file
+!!
+!! DESCRIPTION  : Write variables to restart file
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCES	: 
+!!
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE stomate_finalize (kjit, kjpindex, index, clay, assim_param, silt, bulk, &
+       circ_class_biomass, circ_class_n, lai_per_level, laieff_fit) 
+    
+    IMPLICIT NONE
+    
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in)                       :: kjit              !! Time step number (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpindex          !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)   :: index             !! Indices of the terrestrial pixels only (unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: clay              !! Clay fraction of soil (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: silt              !! Silt fraction of soil (0-1, unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: bulk              !! Bulk density (kg/m**3)
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(in) :: assim_param  !! min+max+opt temperatures (K) & vmax for 
+                                                                         !! photosynthesis   
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)   :: circ_class_biomass !!  Biomass components of the model tree  
+                                                                         !! within a circumference class
+                                                                         !! class @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)       :: circ_class_n      !! Number of trees within each circumference
+                                                                         !! class @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)       :: lai_per_level     !! This is the LAI per vertical level
+                                                                         !! @tex $(m^{2} m^{-2})$
+    TYPE(laieff_type),DIMENSION (:,:,:),INTENT(in) &
+                                                   :: laieff_fit         !! Fitted parameters for the effective LAI
+
+!! 0.2 Output variables 
+
+    !! 0.4 Local variables
+    REAL(r_std)                                   :: dt_days_read             !! STOMATE time step read in restart file (days)
+    INTEGER(i_std)                                :: l,k,ji, jv, i, j, m      !! indices    
+    REAL(r_std),PARAMETER                         :: max_dt_days = 5.         !! Maximum STOMATE time step (days)
+    REAL(r_std)                                   :: hist_days                !! Writing frequency for history file (days)
+    REAL(r_std),DIMENSION(0:nbdl)                 :: z_soil                   !! Variable to store depth of the different soil layers (m)
+    REAL(r_std),DIMENSION(kjpindex)               :: cvegtot                  !! Total "vegetation" cover (unitless)
+    REAL(r_std),DIMENSION(kjpindex)               :: precip                   !! Total liquid and solid precipitation  
+                                                                              !! @tex $(??mm dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_d                    !! Gross primary productivity per ground area 
+                                                                              !! @tex $(??gC m^{-2} dt_stomate^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_daily_x              !! "Daily" gpp for teststomate  
+                                                                              !! @tex $(??gC m^{-2} dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: resp_hetero_litter       !! Litter heterotrophic respiration per ground area 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex  
+                                                                              !! ??Same variable is also used to 
+                                                                              !! store heterotrophic respiration per ground area 
+                                                                              !! over ::dt_sechiba?? 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: 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,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,nelements)   :: som_input_inst   !! Quantity of carbon going into carbon pools from 
+                                                                              !! litter decomposition 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex 
+    
+    INTEGER(i_std)                                :: ier                      !! Check errors in netcdf call (unitless)
+    REAL(r_std)                                   :: sf_time                  !! Intermediate variable to calculate current time 
+                                                                              !! step 
+    INTEGER(i_std)                                :: max_totsize              !! Memory management - maximum memory size (Mb)
+    INTEGER(i_std)                                :: totsize_1step            !! Memory management - memory required to store one 
+                                                                              !! time step on one processor (Mb) 
+    INTEGER(i_std)                                :: totsize_tmp              !! Memory management - memory required to store one 
+                                                                              !! time step on all processors(Mb) 
+    REAL(r_std)                                   :: xn                       !! How many times have we treated in this forcing 
+    REAL(r_std), DIMENSION(kjpindex)              :: vartmp                   !! Temporary variable
+    INTEGER(i_std)                                :: vid                      !! Variable identifer of netCDF (unitless)
+    INTEGER(i_std)                                :: nneigh                   !! Number of neighbouring pixels
+    INTEGER(i_std)                                :: direct                   !! ??
+    INTEGER(i_std),DIMENSION(ndm)                 :: d_id                     !! ??
+    REAL(r_std),DIMENSION(nbp_glo)                :: clay_g                   !! Clay fraction of soil (0-1, unitless), parallel 
+                                                                              !! computing 
+    REAL(r_std),DIMENSION(nbp_glo)                :: silt_g                   !! Silt fraction of soil (0-1, unitless), parallel  
+                                                                              !! computing 
+    REAL(r_std),DIMENSION(nbp_glo)                :: bulk_g                   !! Bulk density (kg/m**3), parallel                                                                                                                                                                 !! computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: carbon_input_g           !! Quantity of carbon going into carbon pools from 
+                                                                              !! litter decomposition  
+                                                                              !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex, parallel 
+                                                                              !! computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: nitrogen_input_g         !! Quantity of nitrogen going into nitrogen pools from  
+                                                                              !! litter decomposition   
+                                                                              !! @tex $(gC m^{-2} dtradia^{-1})$ @endtex, parallel  
+    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_flux_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+!!$                                                                                   !! reduce_sum and one for bcast??), parallel 
+!!$                                                                                   !! computing 
+!!$    REAL(r_std)                                   :: net_flux_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+!!$                                                                                   !! reduce_sum and one for bcast??), parallel 
+!!$                                                                                   !! computing 
+!!$    REAL(r_std)                                   :: net_harvest_above_monthly_sum !! AR5 output?? gC m2 month-1 (one variable for 
+!!$                                                                                   !! reduce_sum and one for bcast??), parallel 
+!!$                                                                                   !! computing 
+!!$    REAL(r_std)                                   :: net_harvest_above_monthly_tot !! AR5 output?? gC m2 month-1 (one variable for 
+!!$                                                                                   !! reduce_sum and one for bcast??), parallel 
+!!$                                                                                   !! computing 
+!!$    REAL(r_std)                                   :: net_biosp_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+!!$                                                                                   !! reduce_sum and one for bcast??), parallel 
+!!$                                                                                   !! computing 
+!!$    REAL(r_std)                                   :: net_biosp_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+!!$                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std), DIMENSION(kjpindex,nvm,nbpools)  :: carbon_stock                  !! Array containing the carbon stock for each pool
+                                                                                   !! used by ORCHIDEE
+    
+
+!_ ================================================================================================================================
+    
+    !! 1. Write restart file for stomate
+    IF (printlev>=3) WRITE (numout,*) 'Write restart file for STOMATE' 
+   
+    CALL writerestart &
+         (kjpindex, index, &
+         dt_days, date, &
+         adapted, regenerate, &
+         humrel_daily, gdd_init_date, litterhum_daily, &
+         t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+         soilhum_daily, precip_daily, &
+         gpp_daily, npp_daily, turnover_daily, &
+         humrel_month, humrel_week, humrel_growingseason, &
+         t2m_longterm, tau_longterm, t2m_month, t2m_week, &
+         tsoil_month, soilhum_month, fireindex, firelitter, &
+         maxhumrel_lastyear, maxhumrel_thisyear, &
+         minhumrel_lastyear, minhumrel_thisyear, &
+         maxgppweek_lastyear, maxgppweek_thisyear, &
+         gdd0_lastyear, gdd0_thisyear, &
+         precip_lastyear, precip_thisyear, &
+         gdd_m5_dormance, gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+         PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+         maxfpc_lastyear, maxfpc_thisyear, &
+         turnover_longterm, gpp_week, resp_maint_part, &
+         leaf_age, leaf_frac, &
+         plant_status, when_growthinit, age, &
+         resp_hetero_d, resp_maint_d, resp_growth_d, co2_fire, atm_to_bm, &
+         veget_lastlight, everywhere, need_adjacent, &
+         RIP_time, &
+         time_hum_min, hum_min_dormance, &
+         litter, dead_leaves, &
+         som, lignin_struc, lignin_wood,turnover_time,&
+         prod_s, prod_m, prod_l, &
+         flux_s, flux_m, flux_l, flux_prod_s, flux_prod_m, &
+         flux_prod_l, bm_to_litter, carb_mass_total, &
+         Tseason, Tseason_length, Tseason_tmp, &
+         Tmin_spring_time, onset_date, &
+         global_years, ok_equilibrium, nbp_accu, nbp_flux, &
+         nbp_accu_pool, nbp_pool, nbp_pool_start, &
+         matrixV, vectorU, previous_stock, current_stock, &
+         assim_param, CN_som_litter_longterm, &
+         tau_CN_longterm, KF, k_latosa_adapt, rue_longterm, &
+         cn_leaf_min_season, &
+         nstress_season, soil_n_min, p_O2, bact, &
+         circ_class_biomass, circ_class_n, store_sum_delta_ba, &
+         forest_managed, forest_managed_lastyear, &
+         species_change_map, fm_change_map, lpft_replant, lai_per_level, &
+         laieff_fit, wstress_season, wstress_month, &
+         age_stand, rotation_n, last_cut, mai, pai, &
+         previous_wood_volume, mai_count, coppice_dens, &
+         light_tran_to_level_season, harvest_5y_area)
+    
+    !! 2. Write file with variables that force general processes in stomate
+    IF ( allow_forcing_write ) THEN
+       IF ( TRIM(forcing_name) /= 'NONE' ) THEN  
+          CALL forcing_write(forcing_id,1,iisf)
+          ! Close forcing file
+          IF (is_root_prc) ier = NF90_CLOSE (forcing_id)
+          forcing_id=-1
+       END IF
+    END IF
+    
+    !! 3. Collect variables that force the soil processes in stomate
+    IF (TRIM(Cforcing_name) /= 'NONE' ) THEN 
+       
+       !! Collet variables 
+       WRITE(numout,*) &
+            &      'stomate: writing the forcing file for carbon spinup'
+       DO iatt = 1, nparan*nbyear
+          IF ( nforce(iatt) > 0 ) THEN
+             carbon_input(:,:,:,iatt) = &
+                  & carbon_input(:,:,:,iatt)/REAL(nforce(iatt),r_std)
+             nitrogen_input(:,:,:,iatt) = &
+                  & nitrogen_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)
+             drainage(:,:,iatt) = & 
+                  &  drainage(:,:,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'
+             carbon_input(:,:,:,iatt) = zero
+             nitrogen_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(carbon_input_g(nbp_glo,ncarb,nvm,nparan*nbyear))
+          ALLOCATE(nitrogen_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(silt,silt_g) 
+       CALL gather(bulk,bulk_g) 
+       CALL gather(carbon_input,carbon_input_g)
+       CALL gather(nitrogen_input,nitrogen_input_g)
+       CALL gather(control_moist,control_moist_g)
+       CALL gather(control_temp,control_temp_g)
+       CALL gather(npp_equil,npp_equil_g)
+       
+       !! Create netcdf
+       ! Create, define and populate a netcdf file containing the forcing data.
+       ! For the root processor only (parallel computing). NF90_ are functions
+       ! from and external library.  
+       IF (is_root_prc) THEN
+          WRITE (numout,*) 'Create Cforcing file : ',TRIM(Cforcing_name)
+          ! Create new netCDF dataset
+          ier = NF90_CREATE (TRIM(Cforcing_name),NF90_64BIT_OFFSET ,Cforcing_id)
+          IF (ier /= NF90_NOERR) THEN
+             WRITE (numout,*) 'Error in creating Cforcing file : ',TRIM(Cforcing_name)
+             CALL ipslerr_p (3,'stomate_finalize', &
+                  &        'PROBLEM creating Cforcing file', &
+                  &        NF90_STRERROR(ier),'')
+          END IF
+          
+          ! Add variable attribute
+          ! Note ::nbp_glo is the number of global continental points
+          ier = NF90_PUT_ATT (Cforcing_id,NF90_GLOBAL, &
+               &                        'kjpindex',REAL(nbp_glo,r_std))
+          ier = NF90_PUT_ATT (Cforcing_id,NF90_GLOBAL, &
+               &                        'nparan',REAL(nparan,r_std))
+          ier = NF90_PUT_ATT (Cforcing_id,NF90_GLOBAL, &
+               &                        'nbyear',REAL(nbyear,r_std))
+          
+          ! Add new dimension
+          ier = NF90_DEF_DIM (Cforcing_id,'points',nbp_glo,d_id(1))
+          ier = NF90_DEF_DIM (Cforcing_id,'carbtype',ncarb,d_id(2))
+          ier = NF90_DEF_DIM (Cforcing_id,'vegtype',nvm,d_id(3))
+          ier = NF90_DEF_DIM (Cforcing_id,'level',nlevs,d_id(4))
+          ier = NF90_DEF_DIM (Cforcing_id,'time_step',NF90_UNLIMITED,d_id(5))
+          
+          ! 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,'silt',      r_typ,d_id(1),vid) 
+          ier = NF90_DEF_VAR (Cforcing_id,'bulk',      r_typ,d_id(1),vid) 
+          ier = NF90_DEF_VAR (Cforcing_id,'carbon_input',r_typ, &
+               &                        (/ d_id(1),d_id(2),d_id(3),d_id(5) /),vid)
+          ier = NF90_DEF_VAR (Cforcing_id,'nitrogen_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_DEF_VAR (Cforcing_id,'drainage',r_typ, & 
+               &                        (/ d_id(1),d_id(6),d_id(6) /),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,'silt',vid) 
+          ier = NF90_PUT_VAR (Cforcing_id,vid, silt_g ) 
+          ier = NF90_INQ_VARID (Cforcing_id,'bulk',vid) 
+          ier = NF90_PUT_VAR (Cforcing_id,vid, bulk_g ) 
+          ier = NF90_INQ_VARID (Cforcing_id,'carbon_input',vid)
+          ier = NF90_PUT_VAR (Cforcing_id,vid, carbon_input_g )
+          ier = NF90_INQ_VARID (Cforcing_id,'nitrogen_input',vid)
+          ier = NF90_PUT_VAR (Cforcing_id,vid, nitrogen_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)
+          IF (ier /= NF90_NOERR) THEN
+             CALL ipslerr_p (3,'stomate_finalize', &
+                  &        'PROBLEM in closing Cforcing file', &
+                  &        NF90_STRERROR(ier),'')
+          END IF
+          
+          Cforcing_id = -1
+       ENDIF
+
+       ! Clear memory
+       IF (is_root_prc) THEN
+          DEALLOCATE(carbon_input_g)
+          DEALLOCATE(nitrogen_input_g)
+          DEALLOCATE(control_moist_g)
+          DEALLOCATE(control_temp_g)
+          DEALLOCATE(npp_equil_g)
+       ENDIF
+       
+    ENDIF
+  
+  END SUBROUTINE stomate_finalize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_init
+!!
+!>\BRIEF        The routine is called only at the first simulation. At that 
+!! time settings and flags are read and checked for internal consistency and 
+!! memory is allocated for the variables in stomate.
+!!
+!! DESCRIPTION  : The routine reads the 
+!! following flags from the run definition file:
+!! -ipd (index of grid point for online diagnostics)\n
+!! -ok_herbivores (flag to activate herbivores)\n
+!! -treat_expansion (flag to activate PFT expansion across a pixel\n
+!! -harvest_agri (flag to harvest aboveground biomass from agricultural PFTs)\n
+!! \n
+!! Check for inconsistent setting between the following flags:
+!! -ok_stomate\n
+!! -ok_dgvm\n
+!! \n
+!! Memory is allocated for all the variables of stomate and new indexing tables 
+!! are build. New indexing tables are needed because a single pixel can conatin 
+!! several PFTs. The new indexing tables have separate indices for the different 
+!! PFTs. Similar index tables are build for land use cover change.\n
+!! \n
+!! Several global variables and land cover change variables are initialized to 
+!! zero.\n
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): Strictly speaking the subroutine has no output 
+!! variables. However, the routine allocates memory and builds new indexing 
+!! variables for later use.\n 
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE stomate_init &
+       &  (kjpij, kjpindex, index, lalo, &
+       &   rest_id_stom, hist_id_stom, hist_id_stom_IPCC)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                    :: kjpij             !! Total size of the un-compressed grid, including 
+                                                                      !! oceans (unitless) 
+    INTEGER(i_std),INTENT(in)                    :: kjpindex          !! Domain size - number of terrestrial pixels 
+                                                                      !! (unitless) 
+    INTEGER(i_std),INTENT(in)                    :: rest_id_stom      !! STOMATE's _Restart_ file identifier
+    INTEGER(i_std),INTENT(in)                    :: hist_id_stom      !! STOMATE's _history_ file identifier
+    INTEGER(i_std),INTENT(in)                    :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file identifier 
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in):: index             !! Indices of the terrestrial pixels on the global 
+                                                                      !! map 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in) :: lalo              !! Geogr. coordinates (latitude,longitude) (degrees)
+   
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    LOGICAL                                      :: l_error           !! Check errors in netcdf call
+    INTEGER(i_std)                               :: ier               !! Check errors in netcdf call
+    INTEGER(i_std)                               :: ji,j,ipd,l        !! Indices
+    INTEGER(i_std)                               :: idia              !! indices
+!_ ================================================================================================================================
+    
+  !! 1. Online diagnostics
+
+    IF ( kjpindex > 0 ) THEN
+       !Config  Key  = STOMATE_DIAGPT
+       !Config  Desc = Index of grid point for online diagnostics
+       !Config If    = OK_STOMATE
+       !Config  Def  = 1
+       !Config  Help = This is the index of the grid point which
+       !               will be used for online diagnostics.
+       !Config Units = [-]
+       ! By default ::ipd is set to 1
+       ipd = 1
+       ! Get ::ipd from run definition file
+       CALL getin_p('STOMATE_DIAGPT',ipd)
+       ipd = MIN( ipd, kjpindex )
+       WRITE(numout,*) 'Stomate: '
+       WRITE(numout,*) '  Index of grid point for online diagnostics: ',ipd
+       WRITE(numout,*) '  Lon, lat:',lalo(ipd,2),lalo(ipd,1)
+       WRITE(numout,*) '  Index of this point on GCM grid: ',index(ipd)
+       !
+    ENDIF
+    
+  !! 2. Check consistency of flags
+
+    IF ( ( .NOT. ok_stomate ) .AND. ok_dgvm ) THEN
+       WRITE(numout,*) 'Cannot do dynamical vegetation without STOMATE.'
+       WRITE(numout,*) 'Inconsistency between ::ok_stomate and ::ok_dgvm'
+       WRITE(numout,*) 'Stop: fatal error'
+       STOP
+    ENDIF
+
+  !! 3. Communicate settings
+
+    WRITE(numout,*) 'stomate first call - overview of the activated flags:'
+    WRITE(numout,*) '  STOMATE: ', ok_stomate
+    WRITE(numout,*) '  LPJ: ', ok_dgvm
+    
+  !! 4. Allocate memory for STOMATE's variables
+
+    l_error = .FALSE.
+
+    ALLOCATE(veget_cov_max(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for veget_cov_max. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(adapted(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for adapted. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(regenerate(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for regenerate. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(humrel_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for humrel_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(vir_humrel_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for vir_humrel_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    vir_humrel_daily(:,:)=zero
+
+    ALLOCATE(stressed_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for stressed_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    stressed_daily = zero
+
+    ALLOCATE(unstressed_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for unstressed_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    unstressed_daily(:,:) = zero
+
+    ALLOCATE(daylight(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for daylight. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    daylight(:,:) = zero
+
+    ALLOCATE(light_tran_to_level_season(kjpindex,nvm,nlevels_tot),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for light_tran_to_level_season. We stop. We need kjpindex*nvm*nlevels_tot words', &
+            kjpindex,nvm,nlevels_tot
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    light_tran_to_level_season = zero
+
+    ALLOCATE(daylight_count(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for daylight_count. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    daylight_count(:,:) = zero
+
+    ALLOCATE(transpir_supply_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for transpir_supply_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    transpir_supply_daily=zero
+
+    ALLOCATE(vir_transpir_supply_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for vir_transpir_supply_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    vir_transpir_supply_daily=zero
+
+    ALLOCATE(transpir_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for transpir_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    transpir_daily=zero
+
+
+    ALLOCATE(litterhum_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for litterhum_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_min_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_min_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(wind_speed_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for wind_speed_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(wind_max_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for wind_max_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(soil_temp_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for soil_temp_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(soil_max_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for soil_max_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(tsurf_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for tsurf_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(tsoil_daily(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for tsoil_daily. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(soilhum_daily(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for soilhum_daily. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(precip_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for precip_daily. We stop. We need kjpindex words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gpp_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gpp_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(npp_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for npp_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(turnover_daily(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_daily. We stop. We need kjpindex*nvm*nparts*nelements words', &
+       &   kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(turnover_littercalc(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_littercalc. We stop. We need kjpindex*nvm*nparts*nelements words', & 
+        &  kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(humrel_month(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for humrel_month. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(humrel_week(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for humrel_week. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(humrel_growingseason(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for humrel_growingseason. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(vir_humrel_growingseason(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+
+    ALLOCATE(t2m_longterm(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_longterm. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_month(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_month. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(Tseason(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for Tseason. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(Tseason_length(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for Tseason_length. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(Tseason_tmp(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for Tseason_tmp. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(Tmin_spring_time(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for Tmin_spring_time. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(onset_date(kjpindex,nvm,2),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for onset_date. We stop. We need kjpindex*nvm*nparts words',kjpindex,nvm,2
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_week(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_week. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(tsoil_month(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for tsoil_month. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(soilhum_month(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for soilhum_month. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(fireindex(kjpindex,nvm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for fireindex. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(firelitter(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for firelitter. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxhumrel_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxhumrel_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxhumrel_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxhumrel_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(minhumrel_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for minhumrel_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(minhumrel_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for minhumrel_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxgppweek_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxgppweek_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxgppweek_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxgppweek_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd0_lastyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd0_lastyear. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd0_thisyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd0_thisyear. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_init_date(kjpindex,2),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_init_date. We stop. We need kjpindex*2 words',kjpindex,2
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_from_growthinit(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_from_growthinit. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(precip_lastyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for precip_lastyear. We stop. We need kjpindex*nvm words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(precip_thisyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for precip_thisyear. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_m5_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_m5_dormance. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_midwinter(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_midwinter. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(ncd_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ncd_dormance. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(ngd_minus5(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ngd_minus5. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(PFTpresent(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for PFTpresent. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(npp_longterm(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for npp_longterm. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lm_lastyearmax(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lm_lastyearmax. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lm_thisyearmax(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lm_thisyearmax. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxfpc_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxfpc_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxfpc_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxfpc_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(turnover_longterm(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_longterm. We stop. We need kjpindex*nvm*nparts*nelements words', & 
+       &    kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gpp_week(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gpp_week. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(plant_status(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for plant_status. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(when_growthinit(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for when_growthinit. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(age(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for age. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_hetero_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_hetero_d. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_hetero_radia(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_hetero_radia. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_d. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_growth_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_growth_d. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(co2_fire(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for co2_fire. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(atm_to_bm(kjpindex,nvm,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for atm_to_bm. We stop. We need kjpindex*nvm words',kjpindex,nvm,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(veget_lastlight(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for veget_lastlight. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(everywhere(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for everywhere. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(need_adjacent(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for need_adjacent. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(leaf_age(kjpindex,nvm,nleafages),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for leaf_age. We stop. We need kjpindex*nvm*nleafages words', & 
+       &      kjpindex,nvm,nleafages
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(leaf_frac(kjpindex,nvm,nleafages),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for leaf_frac. We stop. We need kjpindex*nvm*nleafages words', & 
+       &      kjpindex,nvm,nleafages
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(RIP_time(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for RIP_time. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(time_hum_min(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for time_hum_min. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(hum_min_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for hum_min_dormance. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+
+    ALLOCATE(litter(kjpindex,nlitt,nvm,nlevs,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for litter. We stop. We need kjpindex*nlitt*nvm*nlevs*nelements words', & 
+       &    kjpindex,nlitt,nvm,nlevs,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(dead_leaves(kjpindex,nvm,nlitt),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for dead_leaves. We stop. We need kjpindex*nvm*nlitt words', & 
+       &   kjpindex,nvm,nlitt
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(som(kjpindex,ncarb,nvm,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for som. We stop. We need kjpindex*ncarb*nvm*nelements words', &
+            kjpindex,ncarb,nvm,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lignin_struc(kjpindex,nvm,nlevs),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lignin_struc. We stop. We need kjpindex*nvm*nlevs words', &
+            kjpindex,nvm,nlevs
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lignin_wood(kjpindex,nvm,nlevs),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lignin_wood. We stop. We need kjpindex*nvm*nlevs words', &
+            kjpindex,nvm,nlevs
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(turnover_time(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_time. We stop. We need kjpindex*nvm words', &
+            kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+!!$    ALLOCATE(co2_flux_daily(kjpindex,nvm),stat=ier)
+!!$    l_error = l_error .OR. (ier /= 0)
+!!$    IF (l_error) THEN
+!!$       WRITE(numout,*) 'Memory allocation error for co2_flux_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+!!$       STOP 'stomate_init'
+!!$    ENDIF
+
+!!$    ALLOCATE(co2_flux_monthly(kjpindex,nvm),stat=ier)
+!!$    l_error = l_error .OR. (ier /= 0)
+!!$    IF (l_error) THEN
+!!$       WRITE(numout,*) 'Memory allocation error for co2_flux_monthly. We stop. We need kjpindex*nvm words',kjpindex,nvm
+!!$       STOP 'stomate_init'
+!!$    ENDIF
+!!$
+!!$    ALLOCATE (flux_prod_monthly(kjpindex), stat=ier)
+!!$    l_error = l_error .OR. (ier /= 0)
+!!$    IF (l_error) THEN
+!!$       WRITE(numout,*) 'Memory allocation error for flux_prod_monthly. We stop. We need kjpindex words',kjpindex
+!!$       STOP 'stomate_init'
+!!$    ENDIF
+!!$ 
+!!$    ALLOCATE (harvest_above_monthly(kjpindex), stat=ier)
+!!$    l_error = l_error .OR. (ier /= 0)
+!!$    IF (l_error) THEN
+!!$       WRITE(numout,*) 'Memory allocation error for harvest_above_monthly. We stop. We need kjpindex words',kjpindex
+!!$       STOP 'stomate_init'
+!!$    ENDIF
+
+    ALLOCATE(bm_to_litter(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for bm_to_litter. We stop. We need kjpindex*nvm*nparts*nelements words', & 
+       &    kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(bm_to_littercalc(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for bm_to_littercalc. We stop. We need kjpindex*nvm*nparts*nelements words', &
+       &   kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(herbivores(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for herbivores. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+        ALLOCATE(resp_maint_part_radia(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_part_radia. We stop. We need kjpindex*nvm*nparts words', &
+       &  kjpindex,nvm,nparts
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_radia(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_radia. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_part(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_part. We stop. We need kjpindex*nvm*nparts words', &
+       &    kjpindex,nvm,nparts
+       STOP 'stomate_init'
+    ENDIF
+    resp_maint_part(:,:,:) = zero
+
+    ALLOCATE(hori_index(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for hori_index. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(horipft_index(kjpindex*nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horipft_index. We stop. We need kjpindex*nvm words',kjpindex*nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(horican_index(kjpindex*nlevels_tot),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horican_index. We stop. We need kjpindex*nlevels_tot words',&
+            kjpindex*nlevels_tot
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(horicut_index(kjpindex*ncut_times),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horicut_index. We stop. We need kjpindex*ncut_times words',&
+            kjpindex*ncut_times
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE (horip_s_index(kjpindex*nshort), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip_s_index. We stop. We need kjpindex*10 words',kjpindex,nshort
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE (horip_m_index(kjpindex*nmedium), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip_m_index. We stop. We need kjpindex*10 words',kjpindex,nmedium
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE (horip_l_index(kjpindex*100), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip_l_index. We stop. We need kjpindex*100 words',kjpindex,nlong
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+ 
+    ALLOCATE (horip_ss_index(kjpindex*(nshort+1)), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip_ss_index. We stop. We need kjpindex*11 words',kjpindex,nshort+1
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF 
+
+    ALLOCATE (horip_mm_index(kjpindex*(nmedium+1)), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip_mm_index. We stop. We need kjpindex*11 words',kjpindex,nmedium+1
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE (horip_ll_index(kjpindex*(nlong+1)), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip_ll_index. We stop. We need kjpindex*101 words',kjpindex,nlong+1
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE (prod_s(kjpindex,0:nshort,nelements), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for prod_s. We stop. We need kjpindex*(nshort+1)*nelements words', &
+            kjpindex,nshort+1,nelements
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF  
+
+    ALLOCATE (prod_m(kjpindex,0:nmedium,nelements), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for prod_m. We stop. We need kjpindex*(nmedium+1)*nelements words', &
+            kjpindex,nmedium+1,nelements
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF 
+
+    ALLOCATE (prod_l(kjpindex,0:nlong,nelements), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for prod_l. We stop. We need kjpindex*(nlong+1)*nelements words', &
+            kjpindex,nlong+1,nelements
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE (flux_s(kjpindex,nshort,nelements), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux_s. We stop. We need kjpindex*nshort*nelements words', &
+            kjpindex,nshort,nelements
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE (flux_m(kjpindex,nmedium,nelements), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux_m. We stop. We need kjpindex*nmedium words', &
+            kjpindex,nmedium,nelements
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE (flux_l(kjpindex,nlong,nelements), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux_l. We stop. We need kjpindex*nlong*nelements words', &
+            kjpindex,nlong,nelements
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE (flux_prod_s(kjpindex,nelements), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux_prod_s. We stop. We need kjpindex*nelements words',kjpindex,nelements
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE (flux_prod_m(kjpindex,nelements), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux_prod_m. We stop. We need kjpindex*nelements words',kjpindex,nelements
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE (flux_prod_l(kjpindex,nelements), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux_prod_l. We stop. We need kjpindex*nelements words',kjpindex,nelements
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE (carb_mass_total(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for carb_mass_total. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (som_input_daily(kjpindex,ncarb,nvm,nelements), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for som_input_daily. We stop. We need kjpindex*ncarb*nvm*nelements words', & 
+       &    kjpindex,ncarb,nvm,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (control_temp_daily(kjpindex,nlevs), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for control_temp_daily. We stop. We need kjpindex*nlevs words',kjpindex,nlevs
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (control_moist_daily(kjpindex,nlevs), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for control_moist_daily. We stop. We need kjpindex*nlevs words',kjpindex,nlevs
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (fpc_max(kjpindex,nvm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for fpc_max. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(cn_leaf_min_season(kjpindex,nvm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) 'Memory allocation error for cn_leaf_min_season. We stop. We need kjpindex*nvm words',kjpindex,nvm 
+       STOP 'stomate_init' 
+    ENDIF 
+ 
+    ALLOCATE(nstress_season(kjpindex,nvm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) 'Memory allocation error for nstress_season. We stop. We need kjpindex*nvm words',kjpindex,nvm 
+       STOP 'stomate_init' 
+    ENDIF 
+ 
+    ALLOCATE(soil_n_min(kjpindex,nvm,nnspec),stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) 'Memory allocation error for soil_n_min. We stop. We need kjpindex*nvm words',kjpindex,nvm,nnspec 
+       STOP 'stomate_init' 
+    ENDIF 
+
+    ALLOCATE(p_O2(kjpindex,nvm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) 'Memory allocation error for p_O2. We stop. We need kjpindex*nvm words',kjpindex,nvm 
+       STOP 'stomate_init' 
+    ENDIF 
+
+    ALLOCATE(bact(kjpindex,nvm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) 'Memory allocation error for bact. We stop. We need kjpindex*nvm words',kjpindex,nvm 
+       STOP 'stomate_init' 
+    ENDIF 
+
+    ALLOCATE(ok_equilibrium(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ok_equilibrium. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(drainage_daily(kjpindex,nvm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) ' Memory allocation error for drainage_daily. We stop. We need kjpindex words = ',kjpindex,nvm 
+       STOP 'drainage_daily' 
+    ENDIF 
+ 
+    ALLOCATE (plant_n_uptake_daily(kjpindex,nvm,nionspec), stat=ier) 
+    l_error = l_error .OR. (ier.NE.0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) ' Memory allocation error for plant_n_uptake_daily. We stop. We need kjpindex words = ',kjpindex*nvm*nionspec 
+       STOP 'plant_n_uptake_daily' 
+    ENDIF 
+ 
+    ALLOCATE (n_mineralisation_d(kjpindex,nvm), stat=ier) 
+    l_error = l_error .OR. (ier.NE.0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) ' Memory allocation error for n_mineralisation_d. We stop. We need kjpindex words = ',kjpindex*nvm 
+       STOP 'n_mineralisation_d' 
+    ENDIF 
+
+    ALLOCATE(carbon_eq(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for carbon_eq. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(nbp_accu(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for nbp_accu. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(nbp_accu_pool(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for nbp_accu_pool. We stop. We need kjpindex*nvm words',kjpindex*nvm
+       STOP 'stomate_init'
+    ENDIF
+
+
+    ALLOCATE(nbp_flux(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for nbp_flux. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(nbp_pool(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for nbp_pool. We stop. We need kjpindex*nvm words',kjpindex*nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(nbp_pool_start(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for nbp_pool_start. We stop. We need kjpindex*nvm words',kjpindex*nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(nbp_pool_end(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for nbp_pool_end. We stop. We need kjpindex*nvm words',kjpindex*nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(matrixA(kjpindex,nvm,nbpools,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for matrixA. We stop. We need kjpindex*nvm*nbpools*nbpools words',  & 
+       &     kjpindex, nvm, nbpools, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(vectorB(kjpindex,nvm,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for vectorB. We stop. We need kjpindex*nvm*nbpools words',  & 
+       &     kjpindex, nvm, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(vectorU(kjpindex,nvm,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for vectorU. We stop. We need kjpindex*nvm*nbpools words',  & 
+       &     kjpindex, nvm, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(matrixV(kjpindex,nvm,nbpools,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for matrixV. We stop. We need kjpindex*nvm*nbpools*nbpools words',  & 
+       &     kjpindex, nvm, nbpools, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(matrixW(kjpindex,nvm,nbpools,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for matrixW. We stop. We need kjpindex*nvm*nbpools*nbpools words',  & 
+       &     kjpindex, nvm, nbpools, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(previous_stock(kjpindex,nvm,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for previous_stock. We stop. We need kjpindex*nvm*nbpools words',  & 
+       &     kjpindex, nvm, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(current_stock(kjpindex,nvm,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for current_stock. We stop. We need kjpindex*nvm*nbpools words',  & 
+       &     kjpindex, nvm, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(CN_som_litter_longterm(kjpindex,nvm,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for CN_som_litter_longterm. We stop. We need kjpindex*nvm*nbpools words',  & 
+       &     kjpindex, nvm, nbpools
+       STOP 'stomate_init'
+    ENDIF
+    
+    ALLOCATE(KF(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for KF. We stop. We need nvm words = ',kjpindex*nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    KF(:,:) = zero ! Is there a better place in the code for this?
+
+    ALLOCATE(k_latosa_adapt(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for k_latosa_adapt. We stop. We need nvm words = ',kjpindex*nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(harvest_pool(kjpindex,nvm,ndia_harvest+1,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for harvest_pool. We stop. We need many words = ',&
+            kjpindex*nvm*(ndia_harvest+1)*nelements
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    harvest_pool(:,:,:,:) = zero
+
+    ALLOCATE(harvest_type(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for harvest_type. We stop. We need many words = ',&
+            kjpindex*nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    harvest_type(:,:) = zero
+
+    ALLOCATE(harvest_cut(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for harvest_cut. We stop. We need many words = ',&
+            kjpindex*nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    harvest_cut(:,:) = zero
+
+    ALLOCATE(harvest_area(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for harvest_area. We stop. We need many words = ',&
+            kjpindex*nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    harvest_area(:,:) = zero
+
+    ALLOCATE(harvest_5y_area(kjpindex,nvm,wind_years),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for harvest_5y_area. We stop. We need many words = ',&
+            kjpindex*nvm*wind_years
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    harvest_5y_area(:,:,:)=zero
+
+    ALLOCATE(harvest_pool_bound(0:ndia_harvest+1),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for harvest_pool_bound. ' // &
+            'We stop. We need ndia_harvest+2 words = ',&
+            ndia_harvest+2
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ! Here we can initialize the values of this array, too. They 
+    ! should never change over the course of the simulation.
+    harvest_pool_bound(ndia_harvest+1) = val_exp
+    DO idia = 0,ndia_harvest
+       harvest_pool_bound(idia) = max_harvest_dia * &
+            REAL(idia,r_std) / REAL(ndia_harvest,r_std)
+    ENDDO
+
+    ALLOCATE(mai(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for mai. ' // &
+            'We stop. We need kjpindex*nvm words = ',&
+            kjpindex*nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(pai(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for pai. ' // &
+            'We stop. We need kjpindex*nvm words = ',&
+            kjpindex*nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(previous_wood_volume(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for previous_wood_volume. ' // &
+            'We stop. We need kjpindex*nvm words = ',&
+            kjpindex*nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    
+    ALLOCATE(mai_count(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for mai_count. We stop. We need kjpindex*nvm words',  & 
+       &     kjpindex, nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(coppice_dens(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for coppice_dens. ' // &
+            'We stop. We need kjpindex*nvm words = ',&
+            kjpindex*nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE (rue_longterm(kjpindex,nvm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for rue_longterm. We stop. We need kjpindex*nlevs words',kjpindex,nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    rue_longterm(:,:) = un
+
+    ALLOCATE (lab_fac(kjpindex,nvm), stat=ier)
+    ! temp fix, initializing it here...the values get set in stomate_growth_fun_all,
+    ! but they get used in stomate_resp beforehand, so maybe a code flow problem?
+    lab_fac(:,:)=zero
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lab_fac. We stop. We need kjpindex*nlevs words',kjpindex,nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(forest_managed(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for forest_managed. We stop. We need kjpindex*nvm words',  & 
+       &     kjpindex, nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(forest_managed_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for forest_managed_lastyear. We stop. We need kjpindex*nvm words',  & 
+       &     kjpindex, nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(species_change_map(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for species_change_map. We stop. We need kjpindex*nvm words',  & 
+       &     kjpindex, nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    species_change_map(:,:)=0
+
+    ALLOCATE(fm_change_map(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for fm_change_map. We stop. We need kjpindex*nvm words',  & 
+       &     kjpindex, nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    fm_change_map(:,:)=0
+
+    ALLOCATE(lpft_replant(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lpft_replant. We stop. We need kjpindex*nvm words',  & 
+       &     kjpindex, nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+    lpft_replant(:,:)=.FALSE.
+
+        ALLOCATE(age_stand(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for age_stand. We stop. We need kjpindex*nvm words',  & 
+       &     kjpindex, nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(rotation_n(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for rotation_n. We stop. We need kjpindex*nvm words',  & 
+       &     kjpindex, nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(last_cut(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for last_cut. We stop. We need kjpindex*nvm words',  & 
+       &     kjpindex, nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(sigma(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for sigma. We stop. We need kjpindex*nvm words',  & 
+       &     kjpindex, nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(litter_demand(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for litter_demand. ' // &
+            'We stop. We need kjpindex words = ',&
+            kjpindex
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(wstress_season(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for wstress_season. ' // &
+            'We stop. We need kjpindex*nvm words = ',&
+            kjpindex, nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(wstress_month(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for wstress_month. ' // &
+            'We stop. We need kjpindex*nvm words = ',&
+            kjpindex, nvm
+       CALL ipslerr_p (3,'stomate_init', 'Memory allocation issue','','')
+    ENDIF
+
+    ALLOCATE(store_sum_delta_ba(kjpindex,nvm,ncirc),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for st_dist. ' // &
+            'We need kjpindex*nvm*ncirc words = ',kjpindex,nvm,ncirc
+       CALL ipslerr_p (3,'stomate_main', &
+            ' Memory allocation error for store_sum_delta_ba.','','')
+    END IF
+
+  !! 5. File definitions
+
+    ! Store history and restart files in common variables
+    hist_id_stomate = hist_id_stom
+    hist_id_stomate_IPCC = hist_id_stom_IPCC
+    rest_id_stomate = rest_id_stom
+    
+    ! In STOMATE reduced grids are used containing only terrestrial pixels.
+    ! Build a new indexing table for the vegetation fields separating 
+    ! between the different PFTs. Note that ::index has dimension (kjpindex) 
+    ! wheras ::indexpft has dimension (kjpindex*nvm). 
+
+    hori_index(:) = index(:)
+
+    DO j = 1, nvm
+       DO ji = 1, kjpindex
+          horipft_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+     DO j = 1, nlevels_tot
+       DO ji = 1, kjpindex
+          horican_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, ncut_times
+       DO ji = 1, kjpindex
+          horicut_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    ! Similar index tables are build for the wood use
+    DO j = 1, nshort
+       DO ji = 1, kjpindex
+          horip_s_index((j-1)*kjpindex+ji) = &
+               index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, nmedium
+       DO ji = 1, kjpindex
+          horip_m_index((j-1)*kjpindex+ji) = &
+               index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+    
+    DO j = 1, nlong
+       DO ji = 1, kjpindex
+          horip_l_index((j-1)*kjpindex+ji) = &
+               index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, nshort+1
+       DO ji = 1, kjpindex
+          horip_ss_index((j-1)*kjpindex+ji) = &
+               index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, nmedium+1
+       DO ji = 1, kjpindex
+          horip_mm_index((j-1)*kjpindex+ji) = &
+               index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, nlong+1
+       DO ji = 1, kjpindex
+          horip_ll_index((j-1)*kjpindex+ji) = &
+               index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+  
+
+  !! 6. Initialization of global and land cover change variables. 
+
+    ! All variables are cumulative variables. bm_to_litter is not and is therefore
+    ! excluded
+    ! bm_to_litter(:,:,:) = zero
+    turnover_daily(:,:,:,:) = zero
+    resp_hetero_d(:,:) = zero
+!!$    co2_flux_daily(:,:) = zero
+!!$    co2_flux_monthly(:,:) = zero
+!!$    flux_prod_monthly(:) = zero
+!!$    harvest_above_monthly(:) = zero
+    control_moist_daily(:,:) = zero
+    control_temp_daily(:,:) = zero
+    som_input_daily(:,:,:,:) = zero
+    drainage_daily(:,:) = zero
+    fpc_max(:,:)=zero
+
+    ! Land cover change variables
+    prod_s(:,:,:)  = zero
+    prod_m(:,:,:)  = zero
+    prod_l(:,:,:) = zero
+    flux_s(:,:,:)  = zero
+    flux_m(:,:,:)  = zero
+    flux_l(:,:,:) = zero
+    flux_prod_s(:,:)  = zero
+    flux_prod_m(:,:) = zero
+    flux_prod_l(:,:) = zero
+   
+    ! n variables
+    nstress_season(:,:) = zero 
+    soil_n_min(:,:,:) = zero
+    plant_n_uptake_daily(:,:,:)=zero 
+    n_mineralisation_d(:,:)=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(adapted)) DEALLOCATE(adapted)
+    IF (ALLOCATED(regenerate)) DEALLOCATE(regenerate)
+    IF (ALLOCATED(humrel_daily)) DEALLOCATE(humrel_daily)
+    IF (ALLOCATED(vir_humrel_daily)) DEALLOCATE(vir_humrel_daily)
+    IF (ALLOCATED(transpir_supply_daily)) DEALLOCATE(transpir_supply_daily)
+    IF (ALLOCATED(vir_transpir_supply_daily)) DEALLOCATE(vir_transpir_supply_daily)
+    IF (ALLOCATED(transpir_daily)) DEALLOCATE(transpir_daily)
+    IF (ALLOCATED(gdd_init_date)) DEALLOCATE(gdd_init_date)
+    IF (ALLOCATED(litterhum_daily)) DEALLOCATE(litterhum_daily)
+    IF (ALLOCATED(t2m_daily))  DEALLOCATE(t2m_daily)
+    IF (ALLOCATED(t2m_min_daily))  DEALLOCATE(t2m_min_daily)
+    IF (ALLOCATED(tsurf_daily))  DEALLOCATE(tsurf_daily)
+    IF (ALLOCATED(tsoil_daily)) DEALLOCATE(tsoil_daily)
+    IF (ALLOCATED(soilhum_daily)) DEALLOCATE(soilhum_daily)
+    IF (ALLOCATED(precip_daily)) DEALLOCATE(precip_daily)
+    IF (ALLOCATED(gpp_daily)) DEALLOCATE(gpp_daily)
+    IF (ALLOCATED(npp_daily)) DEALLOCATE(npp_daily)
+    IF (ALLOCATED(turnover_daily)) DEALLOCATE(turnover_daily)
+    IF (ALLOCATED(turnover_littercalc)) DEALLOCATE(turnover_littercalc)
+    IF (ALLOCATED(humrel_month)) DEALLOCATE(humrel_month)
+    IF (ALLOCATED(humrel_week)) DEALLOCATE(humrel_week)
+    IF (ALLOCATED(humrel_growingseason)) DEALLOCATE(humrel_growingseason)
+    IF (ALLOCATED(vir_humrel_growingseason)) DEALLOCATE(vir_humrel_growingseason)
+    IF (ALLOCATED(t2m_longterm)) DEALLOCATE(t2m_longterm)
+    IF (ALLOCATED(t2m_month)) DEALLOCATE(t2m_month)
+    IF (ALLOCATED(Tseason)) DEALLOCATE(Tseason)
+    IF (ALLOCATED(Tseason_length)) DEALLOCATE(Tseason_length)
+    IF (ALLOCATED(Tseason_tmp)) DEALLOCATE(Tseason_tmp)
+    IF (ALLOCATED(Tmin_spring_time)) DEALLOCATE(Tmin_spring_time)
+    IF (ALLOCATED(onset_date)) DEALLOCATE(onset_date)
+!!$    IF (ALLOCATED(begin_leaves)) DEALLOCATE(begin_leaves)
+    IF (ALLOCATED(t2m_week)) DEALLOCATE(t2m_week)
+    IF (ALLOCATED(tsoil_month)) DEALLOCATE(tsoil_month)
+    IF (ALLOCATED(soilhum_month)) DEALLOCATE(soilhum_month)
+    IF (ALLOCATED(fireindex)) DEALLOCATE(fireindex)
+    IF (ALLOCATED(firelitter)) DEALLOCATE(firelitter)
+    IF (ALLOCATED(maxhumrel_lastyear)) DEALLOCATE(maxhumrel_lastyear)
+    IF (ALLOCATED(maxhumrel_thisyear)) DEALLOCATE(maxhumrel_thisyear)
+    IF (ALLOCATED(minhumrel_lastyear)) DEALLOCATE(minhumrel_lastyear)
+    IF (ALLOCATED(minhumrel_thisyear)) DEALLOCATE(minhumrel_thisyear)
+    IF (ALLOCATED(maxgppweek_lastyear)) DEALLOCATE(maxgppweek_lastyear)
+    IF (ALLOCATED(maxgppweek_thisyear)) DEALLOCATE(maxgppweek_thisyear)
+    IF (ALLOCATED(gdd0_lastyear)) DEALLOCATE(gdd0_lastyear)
+    IF (ALLOCATED(gdd0_thisyear)) DEALLOCATE(gdd0_thisyear)
+    IF (ALLOCATED(precip_lastyear)) DEALLOCATE(precip_lastyear)
+    IF (ALLOCATED(precip_thisyear)) DEALLOCATE(precip_thisyear)
+    IF (ALLOCATED(gdd_m5_dormance)) DEALLOCATE(gdd_m5_dormance)
+    IF (ALLOCATED(gdd_from_growthinit)) DEALLOCATE(gdd_from_growthinit)
+    IF (ALLOCATED(gdd_midwinter)) DEALLOCATE(gdd_midwinter)
+    IF (ALLOCATED(ncd_dormance)) DEALLOCATE(ncd_dormance)
+    IF (ALLOCATED(ngd_minus5))  DEALLOCATE(ngd_minus5)
+    IF (ALLOCATED(PFTpresent)) DEALLOCATE(PFTpresent)
+    IF (ALLOCATED(npp_longterm)) DEALLOCATE(npp_longterm)
+    IF (ALLOCATED(lm_lastyearmax)) DEALLOCATE(lm_lastyearmax)
+    IF (ALLOCATED(lm_thisyearmax)) DEALLOCATE(lm_thisyearmax)
+    IF (ALLOCATED(maxfpc_lastyear)) DEALLOCATE(maxfpc_lastyear)
+    IF (ALLOCATED(maxfpc_thisyear)) DEALLOCATE(maxfpc_thisyear)
+    IF (ALLOCATED(turnover_longterm)) DEALLOCATE(turnover_longterm)
+    IF (ALLOCATED(gpp_week)) DEALLOCATE(gpp_week)
+    IF (ALLOCATED(plant_status)) DEALLOCATE(plant_status)
+    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(n_to_bm)) DEALLOCATE(n_to_bm)
+    IF (ALLOCATED(atm_to_bm)) DEALLOCATE(atm_to_bm)
+    IF (ALLOCATED(veget_lastlight)) DEALLOCATE(veget_lastlight)
+    IF (ALLOCATED(everywhere)) DEALLOCATE(everywhere)
+    IF (ALLOCATED(need_adjacent)) DEALLOCATE(need_adjacent)
+    IF (ALLOCATED(leaf_age)) DEALLOCATE(leaf_age)
+    IF (ALLOCATED(leaf_frac)) DEALLOCATE(leaf_frac)
+    IF (ALLOCATED(RIP_time)) DEALLOCATE(RIP_time)
+    IF (ALLOCATED(time_hum_min)) DEALLOCATE(time_hum_min)
+    IF (ALLOCATED(hum_min_dormance)) DEALLOCATE(hum_min_dormance)
+    IF (ALLOCATED(litter)) DEALLOCATE(litter)
+    IF (ALLOCATED(dead_leaves)) DEALLOCATE(dead_leaves)
+    IF (ALLOCATED(som)) DEALLOCATE(som)
+    IF (ALLOCATED(lignin_struc)) DEALLOCATE(lignin_struc)
+    IF (ALLOCATED(lignin_wood)) DEALLOCATE(lignin_wood)
+    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(flux_prod_monthly)) DEALLOCATE (flux_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(horican_index)) DEALLOCATE(horican_index)
+    IF (ALLOCATED(horicut_index)) DEALLOCATE(horicut_index)
+    IF (ALLOCATED(horip_s_index)) DEALLOCATE (horip_s_index)
+    IF (ALLOCATED(horip_m_index)) DEALLOCATE (horip_m_index)
+    IF (ALLOCATED(horip_l_index)) DEALLOCATE (horip_l_index)
+    IF (ALLOCATED(horip_ss_index)) DEALLOCATE (horip_ss_index)
+    IF (ALLOCATED(horip_mm_index)) DEALLOCATE (horip_mm_index)
+    IF (ALLOCATED(horip_ll_index)) DEALLOCATE (horip_ll_index)
+    IF (ALLOCATED(clay_fm)) DEALLOCATE(clay_fm)
+    IF (ALLOCATED(silt_fm)) DEALLOCATE(silt_fm) 
+    IF (ALLOCATED(bulk_fm)) DEALLOCATE(bulk_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(drainage_fm)) DEALLOCATE(drainage_fm) 
+    !
+    IF (ALLOCATED(ok_equilibrium)) DEALLOCATE(ok_equilibrium)
+    IF (ALLOCATED(carbon_eq)) DEALLOCATE(carbon_eq)
+    IF (ALLOCATED(matrixA)) DEALLOCATE(matrixA)
+    IF (ALLOCATED(vectorB)) DEALLOCATE(vectorB)
+    IF (ALLOCATED(matrixV)) DEALLOCATE(matrixV)
+    IF (ALLOCATED(vectorU)) DEALLOCATE(vectorU)
+    IF (ALLOCATED(matrixW)) DEALLOCATE(matrixW)
+    IF (ALLOCATED(previous_stock)) DEALLOCATE(previous_stock)
+    IF (ALLOCATED(current_stock)) DEALLOCATE(current_stock)
+    IF (ALLOCATED(sigma)) DEALLOCATE (sigma) 
+    IF (ALLOCATED(age_stand)) DEALLOCATE (age_stand)
+    IF (ALLOCATED(rotation_n)) DEALLOCATE (rotation_n)
+    IF (ALLOCATED(last_cut)) DEALLOCATE (last_cut)
+    IF (ALLOCATED(CN_som_litter_longterm)) DEALLOCATE(CN_som_litter_longterm) 
+    IF (ALLOCATED(KF)) DEALLOCATE (KF)
+    IF (ALLOCATED(k_latosa_adapt)) DEALLOCATE (k_latosa_adapt)
+    IF (ALLOCATED(harvest_pool)) DEALLOCATE (harvest_pool)
+    IF (ALLOCATED(harvest_type)) DEALLOCATE (harvest_type)
+    IF (ALLOCATED(harvest_cut)) DEALLOCATE (harvest_cut)
+    IF (ALLOCATED(harvest_area)) DEALLOCATE (harvest_area)
+    IF (ALLOCATED(harvest_5y_area)) DEALLOCATE (harvest_5y_area)
+    IF (ALLOCATED(harvest_pool_bound)) DEALLOCATE (harvest_pool_bound)
+    IF (ALLOCATED(prod_s)) DEALLOCATE (prod_s)
+    IF (ALLOCATED(prod_m)) DEALLOCATE (prod_m)
+    IF (ALLOCATED(prod_l)) DEALLOCATE (prod_l)
+    IF (ALLOCATED(flux_s)) DEALLOCATE (flux_s)
+    IF (ALLOCATED(flux_m)) DEALLOCATE (flux_m)
+    IF (ALLOCATED(flux_l)) DEALLOCATE (flux_l)
+    IF (ALLOCATED(flux_prod_s)) DEALLOCATE (flux_prod_s)
+    IF (ALLOCATED(flux_prod_m)) DEALLOCATE (flux_prod_m)
+    IF (ALLOCATED(flux_prod_l)) DEALLOCATE (flux_prod_l)
+
+    IF (ALLOCATED(mai)) DEALLOCATE (mai)
+    IF (ALLOCATED(pai)) DEALLOCATE (pai)
+    IF (ALLOCATED(previous_wood_volume)) DEALLOCATE (previous_wood_volume)
+    IF (ALLOCATED(mai_count)) DEALLOCATE (mai_count)
+    IF (ALLOCATED(coppice_dens)) DEALLOCATE (coppice_dens)
+    IF (ALLOCATED(litter_demand)) DEALLOCATE (litter_demand)
+    IF (ALLOCATED(wstress_season)) DEALLOCATE (wstress_season)
+    IF (ALLOCATED(wstress_month)) DEALLOCATE (wstress_month)
+    IF (ALLOCATED(rue_longterm)) DEALLOCATE (rue_longterm)
+    IF (ALLOCATED(nbp_accu)) DEALLOCATE(nbp_accu)
+    IF (ALLOCATED(nbp_accu_pool)) DEALLOCATE(nbp_accu_pool)
+    IF (ALLOCATED(nbp_flux)) DEALLOCATE(nbp_flux)
+    IF (ALLOCATED(nbp_pool)) DEALLOCATE(nbp_pool)
+    IF (ALLOCATED(nbp_pool_start)) DEALLOCATE(nbp_pool_start)
+    IF (ALLOCATED(nbp_pool_end)) DEALLOCATE(nbp_pool_end)
+
+    IF (ALLOCATED(clay_fm_g)) DEALLOCATE(clay_fm_g)
+    IF (ALLOCATED(silt_fm_g)) DEALLOCATE(silt_fm_g) 
+    IF (ALLOCATED(bulk_fm_g)) DEALLOCATE(bulk_fm_g) 
+    IF (ALLOCATED(humrel_daily_fm_g)) DEALLOCATE(humrel_daily_fm_g)
+    IF (ALLOCATED(litterhum_daily_fm_g))  DEALLOCATE(litterhum_daily_fm_g)
+    IF (ALLOCATED(t2m_daily_fm_g))  DEALLOCATE(t2m_daily_fm_g)
+    IF (ALLOCATED(t2m_min_daily_fm_g))  DEALLOCATE(t2m_min_daily_fm_g)
+    IF (ALLOCATED(tsurf_daily_fm_g)) DEALLOCATE(tsurf_daily_fm_g)
+    IF (ALLOCATED(tsoil_daily_fm_g)) DEALLOCATE(tsoil_daily_fm_g)
+    IF (ALLOCATED(soilhum_daily_fm_g))  DEALLOCATE(soilhum_daily_fm_g)
+    IF (ALLOCATED(precip_fm_g)) DEALLOCATE(precip_fm_g)
+    IF (ALLOCATED(gpp_daily_fm_g))  DEALLOCATE(gpp_daily_fm_g)
+    IF (ALLOCATED(veget_fm_g)) DEALLOCATE(veget_fm_g)
+    IF (ALLOCATED(veget_max_fm_g)) DEALLOCATE(veget_max_fm_g)
+!!$    IF (ALLOCATED(lai_fm_g))  DEALLOCATE(lai_fm_g)
+    IF (ALLOCATED(drainage_fm_g))  DEALLOCATE(drainage_fm_g)    
+ 
+    IF (ALLOCATED(isf)) DEALLOCATE(isf)
+    IF (ALLOCATED(nf_written)) DEALLOCATE(nf_written)
+    IF (ALLOCATED(nf_cumul)) DEALLOCATE(nf_cumul)
+    IF (ALLOCATED(nforce)) DEALLOCATE(nforce)
+    IF (ALLOCATED(control_moist)) DEALLOCATE(control_moist)
+    IF (ALLOCATED(control_temp)) DEALLOCATE(control_temp)
+    IF (ALLOCATED(carbon_input)) DEALLOCATE(carbon_input)
+    IF (ALLOCATED(nitrogen_input)) DEALLOCATE(nitrogen_input)
+    IF ( ALLOCATED (som_input_daily)) DEALLOCATE (som_input_daily)
+    IF ( ALLOCATED (control_temp_daily)) DEALLOCATE (control_temp_daily)
+    IF ( ALLOCATED (control_moist_daily)) DEALLOCATE (control_moist_daily)
+
+    IF ( ALLOCATED (drainage_daily)) DEALLOCATE(drainage_daily) 
+    IF ( ALLOCATED (plant_n_uptake_daily)) DEALLOCATE(plant_n_uptake_daily) 
+    IF ( ALLOCATED (n_mineralisation_d)) DEALLOCATE(n_mineralisation_d) 
+    IF ( ALLOCATED (cn_leaf_min_season)) DEALLOCATE (cn_leaf_min_season) 
+    IF ( ALLOCATED (nstress_season)) DEALLOCATE (nstress_season) 
+    IF ( ALLOCATED (soil_n_min)) DEALLOCATE (soil_n_min) 
+    IF ( ALLOCATED (p_O2)) DEALLOCATE (p_O2) 
+    IF ( ALLOCATED (bact)) DEALLOCATE (bact) 
+    IF ( ALLOCATED (fpc_max)) DEALLOCATE (fpc_max)
+
+    IF (ALLOCATED(forest_managed)) DEALLOCATE (forest_managed)
+    IF (ALLOCATED(forest_managed_lastyear)) DEALLOCATE (forest_managed_lastyear)
+    IF (ALLOCATED(species_change_map)) DEALLOCATE (species_change_map)
+    IF (ALLOCATED(fm_change_map)) DEALLOCATE (fm_change_map) 
+    IF (ALLOCATED(lpft_replant)) DEALLOCATE (lpft_replant)
+
+ !! 2. reset l_first
+
+    l_first_stomate=.TRUE.
+
+ !! 3. call to clear functions
+
+!!$    CALL get_reftemp_clear
+    CALL season_clear
+    CALL stomate_lpj_clear
+    CALL littercalc_clear
+    CALL vmax_clear
+ 
+  END SUBROUTINE stomate_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_var_init
+!!
+!>\BRIEF        Initialize variables of stomate with a none-zero initial value.
+!! Subroutine is called only if ::ok_stomate = .TRUE. STOMATE diagnoses some 
+!! variables for SECHIBA : assim_param, deadleaf_cover, etc. These variables can 
+!! be recalculated from STOMATE's prognostic variables. Note that height is
+!! saved in SECHIBA.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): leaf age (::leaf_age) and fraction of leaves in leaf 
+!! age class (::leaf_frac). The maximum water on vegetation available for 
+!! interception, fraction of soil covered by dead leaves
+!! (::deadleaf_cover) and assimilation parameters (:: assim_param).
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE stomate_var_init &
+       &  (kjpindex, veget_cov_max, leaf_age, leaf_frac, &
+       &   dead_leaves, &
+       &   veget_cov, deadleaf_cover, assim_param, &
+       &   circ_class_biomass, circ_class_n)
+
+
+  !! 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_cov           !! Fraction of pixel covered by PFT. Fraction 
+                                                                             !! accounts for none-biological land covers 
+                                                                             !! (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)        :: veget_cov_max   !! Fractional coverage: maximum share of the pixel 
+                                                                             !! covered by a PFT (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nlitt),INTENT(in)  :: dead_leaves     !! Metabolic and structural fraction of dead leaves 
+                                                                             !! per ground area 
+                                                                             !! @tex $(gC m^{-2})$ @endtex  
+    REAL(r_std), DIMENSION(kjpindex,nvm,ncirc,nparts,nelements),INTENT(in)       :: circ_class_biomass         !! @tex $(gC m^{-2})$ @endtex
+
+    REAL(r_std), DIMENSION(kjpindex,nvm,ncirc),INTENT(in)        :: circ_class_n !! @tex $(gC 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), 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)                   :: nue             !! Nitrogen use Efficiency with impact of leaf age (umol CO2 (gN)-1 s-1) 
+                                                                             !! @tex $(\mu mol m^{-2} s^{-1})$ @endtex 
+    INTEGER(i_std)                                        :: j               !! Index (untiless)
+    
+!_ ================================================================================================================================   
+
+    ! Only if stomate is activated
+    IF (printlev>=4) WRITE(numout,*) 'Entering stomate_var_init'
+ 
+    !! 1. photosynthesis parameters
+
+    !! 1.1 vcmax (stomate_vmax.f90)
+    CALL vmax (kjpindex, dt_0, leaf_age, leaf_frac, vcmax, nue )
+
+    IF (printlev_loc>=4) THEN
+       WRITE(numout,*) 'vcmax, ', vcmax
+       WRITE(numout,*) 'nue, ', nue
+    ENDIF
+    
+    !! 1.3 transform into nvm vegetation types
+    assim_param(:,:,ivcmax) = zero
+    assim_param(:,:,inue) = zero 
+    assim_param(:,:,ileafN) = zero 
+    DO j = 2, nvm
+       assim_param(:,j,ivcmax)=vcmax(:,j)
+       assim_param(:,j,inue)=nue(:,j) 
+       assim_param(:,j,ileafN)=SUM(circ_class_biomass(:,j,:,ileaf,initrogen)*circ_class_n(:,j,:),2)
+    ENDDO
+    
+    !! 2. Dead leaf cover (stomate_litter.f90)
+    
+    CALL deadleaf (kjpindex, veget_cov_max, dead_leaves, deadleaf_cover)     
+    
+  END SUBROUTINE stomate_var_init
+
+
+!! ================================================================================================================================
+!! INTERFACE  	: stomate_accu
+!!
+!>\BRIEF        Accumulate a variable for the time period specified by 
+!! dt_sechiba or calculate the mean value over the period of dt_stomate.
+!! 
+!! DESCRIPTION  : Accumulate a variable for the time period specified by  
+!! dt_sechiba or calculate the mean value over the period of dt_stomate. 
+!! stomate_accu interface can be used for variables having 1, 2 or 3 dimensions. 
+!! The corresponding subruoutine stomate_accu_r1d, stomate_accu_r2d or 
+!! stomate_accu_r3d will be selected through the interface depending on the number of dimensions.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): accumulated or mean variable ::field_out:: 
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE stomate_accu_r1d (ldmean, field_in, field_out)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    LOGICAL,INTENT(in)                     :: ldmean    !! Flag to calculate the mean over
+    REAL(r_std),DIMENSION(:),INTENT(in)    :: field_in  !! Field that needs to be accumulated
+    
+    !! 0.2 Modified variables
+    REAL(r_std),DIMENSION(:),INTENT(inout) :: field_out !! Accumulated or mean field
+
+!_ ================================================================================================================================
+
+  !! 1. Accumulate field
+
+    field_out(:) = field_out(:)+field_in(:)*dt_sechiba
+   
+  !! 2. Mean fields
+    IF (ldmean) THEN
+       field_out(:) = field_out(:)/dt_stomate
+    ENDIF
+
+  END SUBROUTINE stomate_accu_r1d
+
+  SUBROUTINE stomate_accu_r2d (ldmean, field_in, field_out)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    LOGICAL,INTENT(in)                       :: ldmean    !! Flag to calculate the mean over
+    REAL(r_std),DIMENSION(:,:),INTENT(in)    :: field_in  !! Field that needs to be accumulated
+    
+    !! 0.2 Modified variables
+    REAL(r_std),DIMENSION(:,:),INTENT(inout) :: field_out !! Accumulated or mean field
+
+!_ ================================================================================================================================
+
+  !! 1. Accumulate field
+  
+    field_out(:,:) = field_out(:,:)+field_in(:,:)*dt_sechiba
+   
+  !! 2. Mean fields
+    IF (ldmean) THEN
+       field_out(:,:) = field_out(:,:)/dt_stomate
+    ENDIF
+  
+  END SUBROUTINE stomate_accu_r2d
+
+  SUBROUTINE stomate_accu_r3d (ldmean, field_in, field_out)
+   
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    LOGICAL,INTENT(in)                         :: ldmean    !! Flag to calculate the mean over
+    REAL(r_std),DIMENSION(:,:,:),INTENT(in)    :: field_in  !! Field that needs to be accumulated
+   
+    !! 0.2 Modified variables
+    REAL(r_std),DIMENSION(:,:,:),INTENT(inout) :: field_out !! Accumulated or mean field
+
+!_ ================================================================================================================================
+
+  !! 1. Accumulate field
+
+    field_out(:,:,:) = field_out(:,:,:)+field_in(:,:,:)*dt_sechiba
+   
+  !! 2. Mean fields
+
+    IF (ldmean) THEN
+       field_out(:,:,:) = field_out(:,:,:)/dt_stomate
+    ENDIF
+
+  END SUBROUTINE stomate_accu_r3d
+
+  SUBROUTINE stomate_accu_r4d (ldmean, field_in, field_out)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    LOGICAL,INTENT(in)                           :: ldmean    !! Flag to calculate the mean over  
+    REAL(r_std),DIMENSION(:,:,:,:),INTENT(in)    :: field_in  !! Field that needs to be accumulated
+
+    !! 0.2 Modified variables
+    REAL(r_std),DIMENSION(:,:,:,:),INTENT(inout) :: field_out !! Accumulated or mean field
+
+!_ ================================================================================================================================
+
+  !! 1. Accumulate field
+
+    field_out(:,:,:,:) = field_out(:,:,:,:)+field_in(:,:,:,:)*dt_sechiba
+
+  !! 2. Mean fields
+
+    IF (ldmean) THEN
+       field_out(:,:,:,:) = field_out(:,:,:,:)/dt_stomate
+    ENDIF
+
+  END SUBROUTINE stomate_accu_r4d
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_veget_update
+!!
+!>\BRIEF        After the vegetation has been updated some variables needs to be reinitialized for too small fractions
+!! 
+!! DESCRIPTION :  After the vegetation has been updated some variables needs to be reinitialized for too small fractions.
+!!                This subroutine is called from slowproc_veget after removing to small fractions.
+!!
+!! RECENT CHANGE(S) : These calculations were previously done in stomate_lcchange
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE stomate_veget_update(kjpindex, veget_max)
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in)                       :: kjpindex          !! Local domain size - terrestrial pixels only (unitless)
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: veget_max         !! Maximum fraction of vegetation type including
+                                                                         !! non-biological fraction (unitless) 
+    !! 0.3 Local variables
+    INTEGER(i_std)                                  :: i, j              !! Indices
+
+    ! Only proceed if the initalization of stomate has been done
+    IF (.NOT. l_first_stomate) THEN
+
+       ! Loop over all points on all pft's
+       ! If the fraction is too small, reset the depending variables
+       ! veget_max will be changed in slowproc_veget after this subroutine has been done. 
+       DO i = 1, kjpindex
+          DO j=1, nvm
+             IF ( veget_max(i,j) < min_vegfrac ) THEN 
+                PFTpresent(i,j) = .FALSE.
+                plant_status(i,j) = idormant
+                age(i,j) = zero
+                when_growthinit(i,j) = undef
+                everywhere(i,j) = zero
+                som(i,:,j,:) = zero
+                litter(i,:,j,:,:) = zero
+                bm_to_litter(i,j,:,:) = zero
+                turnover_daily(i,j,:,:) = zero
+             ENDIF
+          END DO
+       END DO
+    END IF
+
+  END SUBROUTINE stomate_veget_update
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: init_forcing
+!!
+!>\BRIEF        Allocate memory for the variables containing the forcing data.
+!! The maximum size of the allocated memory is specified in run definition file
+!! (::max_totsize) and needs to be a compromise between charging the memory and 
+!! accessing disks to get the forcing data.
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): Strictly speaking the subroutine has no output 
+!! variables. However, the routine allocates memory for later use. 
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE init_forcing (kjpindex,nsfm,nsft_loc)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in) :: kjpindex !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std),INTENT(in) :: nsfm     !! Number of time steps that can be stored in memory (unitless)
+    INTEGER(i_std),INTENT(in) :: nsft_loc !! Number of time steps in a year (unitless)
+
+   !! 0.2 Output variables
+
+   !! 0.3 Modified variables
+
+   !! 0.4 Local variables
+
+    LOGICAL                   :: l_error  !! Check errors in netcdf call
+    INTEGER(i_std)            :: ier      !! Check errors in netcdf call
+!_ ================================================================================================================================
+    
+  !! 1. Allocate memory
+
+    ! Note ::nvm is number of PFTs and ::nbdl is number of soil layers
+    l_error = .FALSE.
+    ALLOCATE(clay_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables clay_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+
+    ALLOCATE(silt_fm(kjpindex,nsfm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables silt_fm ',kjpindex,nsfm 
+       STOP 'init_forcing' 
+    ENDIF 
+    ALLOCATE(bulk_fm(kjpindex,nsfm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables bulk_fm ',kjpindex,nsfm 
+       STOP 'init_forcing' 
+    ENDIF 
+
+    ALLOCATE(humrel_daily_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables humrel_daily_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(litterhum_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables litterhum_daily_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(t2m_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables t2m_daily_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(t2m_min_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables t2m_min_daily_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(tsurf_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables tsurf_daily_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(tsoil_daily_fm(kjpindex,nbdl,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables tsoil_daily_fm ',kjpindex,nbdl,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(soilhum_daily_fm(kjpindex,nbdl,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables soilhum_daily_fm ',kjpindex,nbdl,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(precip_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables precip_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(gpp_daily_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables gpp_daily_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(veget_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(veget_max_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_max_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+!!$    ALLOCATE(lai_fm(kjpindex,nvm,nsfm),stat=ier)
+!!$    l_error = l_error .OR. (ier /= 0)
+!!$    IF (l_error) THEN
+!!$       WRITE(numout,*) 'Problem with memory allocation: forcing variables lai_fm ',kjpindex,nvm,nsfm
+!!$       STOP 'init_forcing'
+!!$    ENDIF
+    ALLOCATE(drainage_fm(kjpindex,nvm,nsfm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables drainage_fm ',kjpindex,nvm,nsfm 
+       STOP 'init_forcing' 
+    ENDIF 
+    ALLOCATE(isf(nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables isf ',nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(nf_written(nsft_loc),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables nf_written ',nsft_loc
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(nf_cumul(nsft_loc),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables nf_cumul ',nsft_loc
+       STOP 'init_forcing'
+    ENDIF
+    
+  !! 2. Allocate memory for the root processor only (parallel computing)
+
+    ! Where, ::nbp_glo is the number of global continental points
+    IF (is_root_prc) THEN
+       ALLOCATE(clay_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables clay_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(silt_fm_g(nbp_glo,nsfm),stat=ier) 
+       l_error = l_error .OR. (ier /= 0) 
+       IF (l_error) THEN 
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables silt_fm_g ',nbp_glo,nsfm 
+          STOP 'init_forcing' 
+       ENDIF
+       ALLOCATE(bulk_fm_g(nbp_glo,nsfm),stat=ier) 
+       l_error = l_error .OR. (ier /= 0) 
+       IF (l_error) THEN 
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables bulk_fm_g ',nbp_glo,nsfm 
+          STOP 'init_forcing' 
+       ENDIF
+       ALLOCATE(humrel_daily_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables humrel_daily_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(litterhum_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables litterhum_daily_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(t2m_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables t2m_daily_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(t2m_min_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables t2m_min_daily_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(tsurf_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables tsurf_daily_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(tsoil_daily_fm_g(nbp_glo,nbdl,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables tsoil_daily_fm_g ',nbp_glo,nbdl,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(soilhum_daily_fm_g(nbp_glo,nbdl,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables soilhum_daily_fm_g ',nbp_glo,nbdl,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(precip_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables precip_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(gpp_daily_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables gpp_daily_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(veget_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(veget_max_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_max_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+!!$       ALLOCATE(lai_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+!!$       l_error = l_error .OR. (ier /= 0)
+!!$       IF (l_error) THEN
+!!$          WRITE(numout,*) 'Problem with memory allocation: forcing variables lai_fm_g ',nbp_glo,nvm,nsfm
+!!$          STOP 'init_forcing'
+!!$       ENDIF
+       ALLOCATE(drainage_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 drainage_fm_g ',nbp_glo,nvm,nsfm 
+          STOP 'init_forcing' 
+       ENDIF
+    ELSE
+       ! Allocate memory for co-processors
+       ALLOCATE(clay_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(silt_fm_g(0,nsfm),stat=ier) 
+       ALLOCATE(bulk_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)
+       ALLOCATE(drainage_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. Initialize 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
+    silt_fm(:,:) = zero 
+    bulk_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
+    drainage_fm(:,:,:) = zero     
+  END SUBROUTINE forcing_zero
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: forcing_write
+!!
+!>\BRIEF        Appends data values to a netCDF file containing the forcing 
+!! variables of the general processes in stomate.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): netCDF file
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE forcing_write(forcing_id,ibeg,iend)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)      :: forcing_id  !! File identifer of forcing file, assigned when netcdf is created
+    INTEGER(i_std),INTENT(in)      :: ibeg, iend  !! First and last time step to be written
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                 :: ii          !! Index of isf where isf is the number of time steps that can be 
+                                                  !! stored in memory 
+    INTEGER(i_std)                 :: iblocks     !! Index of block that is written
+    INTEGER(i_std)                 :: nblocks     !! Number of blocks that needs to be written
+    INTEGER(i_std)                 :: ier         !! Check errors in netcdf call
+    INTEGER(i_std),DIMENSION(0:2)  :: ifirst      !! First block in memory - changes with iblocks
+    INTEGER(i_std),DIMENSION(0:2)  :: ilast       !! Last block in memory - changes with iblocks
+    INTEGER(i_std),PARAMETER       :: ndm = 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 ii = ibeg, iend
+       IF (     (nblocks /= 0) &
+            &      .AND.(isf(ii) == isf(ilast(nblocks))+1)) THEN
+          ! Last block found
+          ilast(nblocks) = ii
+       ELSE
+          ! First block found
+          nblocks = nblocks+1
+          IF (nblocks > 2)  STOP 'Problem in forcing_write'
+          ifirst(nblocks) = ii
+          ilast(nblocks) = ii
+       ENDIF
+    ENDDO
+
+  !! 2. Gather distributed variables (parallel computing)
+
+    CALL gather(clay_fm,clay_fm_g)
+    CALL gather(silt_fm,silt_fm_g) 
+    CALL gather(bulk_fm,bulk_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)
+    CALL gather(drainage_fm,drainage_fm_g)  
+ !! 3. Append data to netCDF file
+   
+    IF (is_root_prc) THEN
+       ! The netCDF file has been created earlier in this module, a file ID is available 
+       ! and variables and dimensions have already been defined
+       DO iblocks = 1, nblocks
+          IF (ifirst(iblocks) /= ilast(iblocks)) THEN
+             ndim = 2
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(clay_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'clay',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid, &
+                  &              clay_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2 
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
+             count_force(1:ndim) = SHAPE(silt_fm_g) 
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
+             ier = NF90_INQ_VARID (forcing_id,'silt',vid) 
+             ier = NF90_PUT_VAR (forcing_id,vid, & 
+                  &              silt_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 
+                  & start=start(1:ndim), count=count_force(1:ndim)) 
+             ndim = 2 
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
+             count_force(1:ndim) = SHAPE(bulk_fm_g) 
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
+             ier = NF90_INQ_VARID (forcing_id,'bulk',vid) 
+             ier = NF90_PUT_VAR (forcing_id,vid, & 
+                  &              bulk_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))
+             ndim = 2; 
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
+             count_force(1:ndim) = SHAPE(drainage_fm_g) 
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
+             ier = NF90_INQ_VARID (forcing_id,'drainage',vid) 
+             ier = NF90_PUT_VAR (forcing_id, vid, & 
+                  &            drainage_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 
+                  &            start=start(1:ndim), count=count_force(1:ndim)) 
+          ENDIF
+       ENDDO
+    ENDIF
+    
+  !! 4. Adjust flag of forcing file
+    nf_written(isf(:)) = .TRUE.
+
+  END SUBROUTINE forcing_write
+
+  
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_forcing_read
+!!
+!>\BRIEF        Read forcing file.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE stomate_forcing_read(forcing_id,nsfm)
+   
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)  :: forcing_id           !! File identifer of forcing file, assigned when netcdf is created
+    INTEGER(i_std),INTENT(in)  :: nsfm                 !! Number of time steps stored in memory        
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                 :: ii                !! Index of isf where isf is the number of time steps that can be stored in 
+                                                        !! memory 
+    INTEGER(i_std)                 :: iblocks           !! Index of block that is written
+    INTEGER(i_std)                 :: nblocks           !! Number of blocks that needs to be written
+    INTEGER(i_std)                 :: ier               !! Check error of netcdf call
+    INTEGER(i_std),DIMENSION(0:2)  :: ifirst            !! First block in memory - changes with iblocks
+    INTEGER(i_std),DIMENSION(0:2)  :: ilast             !! Last block in memory - changes with iblocks
+    INTEGER(i_std),PARAMETER       :: ndm = 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,*) "stomate_forcing_read "
+    
+  !! 1. Set to zero if the corresponding forcing state
+
+    ! has not yet been written into the file  
+    DO ii = 1, nsfm
+       IF (.NOT.nf_written(isf(ii))) THEN
+          clay_fm(:,ii) = zero
+          silt_fm(:,iisf) = zero 
+          bulk_fm(:,iisf) = zero 
+          humrel_daily_fm(:,:,ii) = zero
+          litterhum_daily_fm(:,ii) = zero
+          t2m_daily_fm(:,ii) = zero
+          t2m_min_daily_fm(:,ii) = zero
+          tsurf_daily_fm(:,ii) = zero
+          tsoil_daily_fm(:,:,ii) = zero
+          soilhum_daily_fm(:,:,ii) = zero
+          precip_fm(:,ii) = zero
+          gpp_daily_fm(:,:,ii) = zero
+          veget_fm(:,:,ii) = zero
+          veget_max_fm(:,:,ii) = zero
+!!$          lai_fm(:,:,ii) = zero
+          drainage_fm(:,:,iisf) = zero 
+       ENDIF
+    ENDDO
+    
+  !! 2. determine blocks of forcing states that are contiguous in memory
+
+    nblocks = 0
+    ifirst(:) = 1
+    ilast(:) = 1
+    
+    DO ii = 1, nsfm
+       IF (nf_written(isf(ii))) THEN
+          IF (     (nblocks /= 0) &
+               &        .AND.(isf(ii) == isf(ilast(nblocks))+1)) THEN
+
+             ! element is contiguous with last element found
+             ilast(nblocks) = ii
+          ELSE
+
+             ! found first element of new block
+             nblocks = nblocks+1
+             IF (nblocks > 2)  STOP 'Problem in stomate_forcing_read'
+             
+             ifirst(nblocks) = ii
+             ilast(nblocks) = ii
+          ENDIF
+       ENDIF
+    ENDDO
+    IF (check) WRITE(numout,*) "stomate_forcing_read nblocks, ifirst, ilast",nblocks, ifirst, ilast
+    
+  !! 3. Read variable values
+
+    IF (is_root_prc) THEN
+       DO iblocks = 1, nblocks
+          IF (check) WRITE(numout,*) "stomate_forcing_read iblocks, ifirst(iblocks), ilast(iblocks)",iblocks, &
+               ifirst(iblocks), ilast(iblocks)
+          IF (ifirst(iblocks) /= ilast(iblocks)) THEN
+             a_er=.FALSE.
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(clay_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'clay',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            clay_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+
+             ndim = 2; 
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
+             count_force(1:ndim) = SHAPE(silt_fm_g) 
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
+             ier = NF90_INQ_VARID (forcing_id,'silt',vid) 
+             a_er = a_er.OR.(ier /= 0) 
+             ier = NF90_GET_VAR (forcing_id, vid, & 
+                  &            silt_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 
+                  &            start=start(1:ndim), count=count_force(1:ndim)) 
+             a_er = a_er.OR.(ier /= 0) 
+             
+             ndim = 2; 
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
+             count_force(1:ndim) = SHAPE(bulk_fm_g) 
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
+             ier = NF90_INQ_VARID (forcing_id,'bulk',vid) 
+             a_er = a_er.OR.(ier /= 0) 
+             ier = NF90_GET_VAR (forcing_id, vid, & 
+                  &            bulk_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 
+                  &            start=start(1:ndim), count=count_force(1:ndim)) 
+             a_er = a_er.OR.(ier /= 0) 
+             
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(humrel_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'humrel',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            humrel_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(litterhum_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'litterhum',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              litterhum_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(t2m_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'t2m',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              t2m_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(t2m_min_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'t2m_min',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              t2m_min_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(tsurf_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'tsurf',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              tsurf_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(tsoil_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'tsoil',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              tsoil_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(soilhum_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'soilhum',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              soilhum_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(precip_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'precip',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              precip_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(gpp_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'gpp',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            gpp_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(veget_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'veget',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            veget_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(veget_max_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'veget_max',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            veget_max_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+!!$             ndim = 3;
+!!$             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+!!$             count_force(1:ndim) = SHAPE(lai_fm_g)
+!!$             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+!!$             ier = NF90_INQ_VARID (forcing_id,'lai',vid)
+!!$             a_er = a_er.OR.(ier /= 0)
+!!$             ier = NF90_GET_VAR (forcing_id, vid, &
+!!$                  &            lai_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+!!$                  &            start=start(1:ndim), count=count_force(1:ndim))
+!!$             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2; 
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
+             count_force(1:ndim) = SHAPE(drainage_fm_g) 
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
+             ier = NF90_INQ_VARID (forcing_id,'drainage',vid) 
+             a_er = a_er.OR.(ier /= 0) 
+             ier = NF90_GET_VAR (forcing_id, vid, & 
+                  &            drainage_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 
+                  &            start=start(1:ndim), count=count_force(1:ndim)) 
+             a_er = a_er.OR.(ier /= 0) 
+             IF (a_er) THEN
+                CALL ipslerr_p (3,'stomate_forcing_read', &
+                     &        'PROBLEM when read forcing file', &
+                     &        '','')
+             ENDIF
+
+          ENDIF ! (ifirst(iblocks) /= ilast(iblocks))
+       ENDDO ! iblocks
+    ENDIF ! is_root_prc
+
+  !! 4. Distribute the variable over several processors
+
+    CALL scatter(clay_fm_g,clay_fm)
+    CALL scatter(silt_fm_g,silt_fm) 
+    CALL scatter(bulk_fm_g,bulk_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)
+    CALL scatter(drainage_fm_g,drainage_fm) 
+  END SUBROUTINE stomate_forcing_read
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: setlai
+!!
+!>\BRIEF        Routine to force the lai in STOMATE. The code in this routine
+!! simply CALCULATES lai and is therefore not functional. The routine should be 
+!! rewritten if one wants to force lai. Forcing lai with the new allocation is
+!! not straightforward and would quickly (after 5 years ?) result in serious
+!! inconsistencies
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lai
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+!!$  SUBROUTINE setlai(kjpindex,lai, circ_class_biomass, circ_class_n)
+!!$
+!!$  !! 0 Variable and parameter declaration 
+!!$  
+!!$    !! 0.1 Input variables
+!!$
+!!$    INTEGER(i_std),INTENT(in)                    :: kjpindex      !! Domain size - number of pixels (unitless)
+!!$    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)  :: circ_class_biomass   !! Biomass per PFT @tex $(gC m^{-2})$ @endtex
+!!$    REAL(r_std), DIMENSION(:,:,:), INTENT(in)  :: circ_class_n   !! Biomass per PFT @tex $(gC m^{-2})$ @endtex
+!!$    !! 0.2 Output variables
+!!$
+!!$    REAL(r_std),DIMENSION(kjpindex,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,i         !! 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 i=1, kjpindex
+!!$        DO j=2,nvm
+!!$            lai(i,j) = cc_to_lai(circ_class_biomass(i,j,:,ileaf,icarbon),circ_class_n(i,j,:),j)
+!!$        ENDDO
+!!$    ENDDO
+!!$  END SUBROUTINE setlai
+
+
+END MODULE stomate
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_data.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_data.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_data.f90	(revision 6412)
@@ -0,0 +1,688 @@
+! =================================================================================================================================
+! MODULE 	: stomate_data
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         "stomate_data" module defines the values about the PFT parameters. It will print
+!! the values of the parameters for STOMATE in the standard outputs. 
+!!
+!!\n DESCRIPTION: None 
+!!
+!! RECENT CHANGE(S): Sonke Zaehle: Reich et al, 1992 find no statistically significant differences 
+!!                  between broadleaved and coniferous forests, specifically, the assumption that grasses grow 
+!!                  needles is not justified. Replacing the function with the one based on Reich et al. 1997. 
+!!                  Given that sla=100cm2/gDW at 9 months, sla is:
+!!                  sla=exp(5.615-0.46*ln(leaflon in months))
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_data
+
+  ! modules used:
+
+  USE constantes
+  USE pft_parameters
+  USE defprec
+  
+
+  IMPLICIT NONE
+
+ ! INTEGER(i_std), SAVE                         :: printlev_loc   !! local printlev for this module
+!!$OMP THREADPRIVATE(printlev_loc)
+
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: hori_index     !! Move to Horizontal indices
+!$OMP THREADPRIVATE(hori_index)
+
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: horipft_index  !! Horizontal + PFT indices
+!$OMP THREADPRIVATE(horipft_index)
+
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: horican_index  !! Horizontal + canopy levels indices
+!$OMP THREADPRIVATE(horican_index)
+  
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: horicut_index  !! Horizontal + cut times indices
+!$OMP THREADPRIVATE(horicut_index)
+
+  !
+  ! Land cover change
+  !
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip_s_index   !! Horizontal + P short indices
+!$OMP THREADPRIVATE(horip_s_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip_m_index   !! Horizontal + P medium indices
+!$OMP THREADPRIVATE(horip_m_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip_l_index   !! Horizontal + P long indice
+!$OMP THREADPRIVATE(horip_l_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip_ss_index  !! Horizontal + P short indices
+!$OMP THREADPRIVATE(horip_ss_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip_mm_index  !! Horizontal + P medium indices
+!$OMP THREADPRIVATE(horip_mm_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip_ll_index  !! Horizontal + P long indices
+!$OMP THREADPRIVATE(horip_ll_index)
+
+  INTEGER(i_std),SAVE :: itime                 !! time step
+!$OMP THREADPRIVATE(itime)
+  INTEGER(i_std),SAVE :: hist_id_stomate       !! STOMATE history file ID
+!$OMP THREADPRIVATE(hist_id_stomate)
+  INTEGER(i_std),SAVE :: hist_id_stomate_IPCC  !! STOMATE history file ID for IPCC output
+!$OMP THREADPRIVATE(hist_id_stomate_IPCC)
+  INTEGER(i_std),SAVE :: rest_id_stomate       !! STOMATE restart file ID
+!$OMP THREADPRIVATE(rest_id_stomate)
+
+  REAL(r_std),PARAMETER :: adapted_crit = 1. - ( 1. / euler ) !! critical value for being adapted (1-1/e) (unitless)
+  REAL(r_std),PARAMETER :: regenerate_crit = 1. / euler       !! critical value for being regenerative (1/e) (unitless)
+
+
+  ! private & public routines
+
+  PUBLIC data
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: data
+!!
+!>\BRIEF         This routine defines the values of the PFT parameters. It will print the values of the parameters for STOMATE
+!!               in the standard outputs of ORCHIDEE. 
+!!
+!! DESCRIPTION : This routine defines PFT parameters. It initializes the pheno_crit structure by tabulated parameters.\n
+!!               Some initializations are done for parameters. The SLA is calculated according *to* Reich et al (1992).\n
+!!               Another formulation by Reich et al(1997) could be used for the computation of the SLA.
+!!               The geographical coordinates might be used for defining some additional parameters
+!!               (e.g. frequency of anthropogenic fires, irrigation of agricultural surfaces, etc.). \n
+!!               For the moment, this possibility is not used. \n
+!!               The specifc leaf area (SLA) is calculated according Reich et al, 1992 by :
+!!               \latexonly
+!!               \input{stomate_data_SLA.tex}
+!!               \endlatexonly
+!!               The sapling (young) biomass for trees and for each compartment of biomass is calculated by :
+!!               \latexonly
+!!               \input{stomate_data_sapl_tree.tex}
+!!               \endlatexonly
+!!               The sapling biomass for grasses and for each compartment of biomass is calculated by :
+!!               \latexonly
+!!               \input{stomate_data_sapl_grass.tex}
+!!               \endlatexonly
+!!               The critical stem diameter is given by the following formula :
+!!               \latexonly
+!!               \input{stomate_data_stem_diameter.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): Sonke Zaehle: Reich et al, 1992 find no statistically significant differences 
+!!                  between broadleaved and coniferous forests, specifically, the assumption that grasses grow 
+!!                  needles is not justified. Replacing the function with the one based on Reich et al. 1997. 
+!!                  Given that sla=100cm2/gDW at 9 months, sla is:
+!!                  sla=exp(5.615-0.46*ln(leaflon in months)) 
+!!                   \latexonly
+!!                   \input{stomate_data_SLA_Reich_97.tex}
+!!                   \endlatexonly
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!! - Reich PB, Walters MB, Ellsworth DS, (1992), Leaf life-span in relation to leaf, plant and 
+!! stand characteristics among diverse ecosystems. Ecological Monographs, Vol 62, pp 365-392.
+!! - Reich PB, Walters MB, Ellsworth DS (1997) From tropics to tundra: global convergence in plant 
+!!  functioning. Proc Natl Acad Sci USA, 94:13730 13734
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE data (npts, lalo)
+
+
+    !! 0. Variables and parameter declaration
+
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                   :: npts    !! [DISPENSABLE] Domain size (unitless)
+    REAL(r_std),DIMENSION (npts,2), INTENT (in)  :: lalo    !! [DISPENSABLE] Geographical coordinates (latitude,longitude)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                               :: i,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
+    REAL(r_std)                                  :: cn_leaf         !! C to N ratio of Leaf pool (gC per gN) 
+    REAL(r_std)                                  :: cn_wood         !! C to N ratio of Woody pools (gC per gN) 
+    REAL(r_std)                                  :: cn_root         !! C to N ratio of Root pool (gC per gN) 
+
+!_ ================================================================================================================================
+
+    IF ( printlev>=1 ) WRITE(numout,*) 'data: PFT characteristics'
+
+    ! Initialize local printlev
+    !printlev_loc=get_printlev('data')
+
+    !- pheno_gdd_crit
+    pheno_gdd_crit(:,1) = pheno_gdd_crit_c(:)
+    pheno_gdd_crit(:,2) = pheno_gdd_crit_b(:)         
+    pheno_gdd_crit(:,3) = pheno_gdd_crit_a(:) 
+    !
+    !- senescence_temp
+    senescence_temp(:,1) = senescence_temp_c(:)
+    senescence_temp(:,2) = senescence_temp_b(:)
+    senescence_temp(:,3) = senescence_temp_a(:)
+
+    !- maint_resp_slope
+    maint_resp_slope(:,1) = maint_resp_slope_c(:)
+    maint_resp_slope(:,2) = maint_resp_slope_b(:)
+    maint_resp_slope(:,3) = maint_resp_slope_a(:)
+
+    ! 
+    !-LC 
+    LC(:,ileaf) = LC_leaf(:) 
+    LC(:,isapabove) = LC_sapabove(:) 
+    LC(:,isapbelow) = LC_sapbelow(:) 
+    LC(:,iheartabove) = LC_heartabove(:) 
+    LC(:,iheartbelow) = LC_heartbelow(:) 
+    LC(:,iroot) = LC_root(:) 
+    LC(:,ifruit) = LC_fruit(:) 
+    LC(:,icarbres) = LC_carbres(:) 
+    LC(:,ilabile) = LC_labile(:) 
+
+
+    DO j = 2,nvm ! Loop over # PFTS 
+
+       IF ( printlev_loc >= 2 ) WRITE(numout,'(a,i3,a,a)') '    > PFT#',j,': ', PFT_name(j)
+
+       !
+       ! 1 tree? (true/false)
+       !
+       IF ( printlev_loc >= 2 ) WRITE(numout,*) '       tree: (::is_tree) ', is_tree(j)
+
+       !
+       ! 2 flamability (0-1, unitless)
+       !
+
+       IF ( printlev_loc >= 2 ) WRITE(numout,*) '       litter flamability (::flam) :', flam(j)
+
+       !
+       ! 3 fire resistance (unitless)
+       !
+
+       IF ( printlev_loc >= 2 ) WRITE(numout,*) '       fire resistance (::resist) :', resist(j)
+
+       !
+       ! 4 specific leaf area per mass carbon = 2 * sla / dry mass (m^2.gC^{-1})
+       !
+
+       ! S. Zaehle: Reich et al, 1992 find no statistically significant differences between broadleaved and coniferous
+       ! forests, specifically, the assumption that grasses grow needles is not justified. Replacing the function
+       ! with the one based on Reich et al. 1997. Given that sla=100cm2/gDW at 9 months, sla is:
+       ! sla=exp(5.615-0.46*ln(leaflon in months))
+
+       ! Oct 2010 : sla values are prescribed by values given by N.Viovy 
+
+       ! includes conversion from 
+       !!       sla(j) = 2. * 1e-4 * EXP(5.615 - 0.46 * log(12./leaflife_tab(j)))
+       !!\latexonly
+       !!\input{stomate_data_SLA.tex}
+       !!\endlatexonly
+!       IF ( leaf_tab(j) .EQ. 2 ) THEN
+!
+!          ! needle leaved tree
+!          sla(j) = 2. * ( 10. ** ( 2.29 - 0.4 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
+!
+!       ELSE
+!
+!          ! broad leaved tree or grass (Reich et al 1992)
+!          sla(j) = 2. * ( 10. ** ( 2.41 - 0.38 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
+!
+!       ENDIF
+
+!!!$      IF ( leaf_tab(j) .EQ. 1 ) THEN
+!!!$
+!!!$        ! broad leaved tree
+!!!$
+!!!$        sla(j) = 2. * ( 10. ** ( 2.41 - 0.38 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
+!!!$
+!!!$      ELSE
+!!!$
+!!!$        ! needle leaved or grass (Reich et al 1992)
+!!!$
+!!!$        sla(j) = 2. * ( 10. ** ( 2.29 - 0.4 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
+!!!$
+!!!$      ENDIF
+!!!$
+!!!$      IF ( ( leaf_tab(j) .EQ. 2 ) .AND. ( pheno_type_tab(j) .EQ. 2 ) ) THEN
+!!!$
+!!!$        ! summergreen needle leaf
+!!!$
+!!!$        sla(j) = 1.25 * sla(j)
+!!!$
+!!!$      ENDIF
+
+       IF ( printlev_loc >= 2 ) WRITE(numout,*) '       specific leaf area (m**2/gC) (::sla):', sla(j), 12./leaflife_tab(j)
+
+       !
+       ! 5 sapling characteristics
+       !
+
+       IF ( is_tree(j) ) THEN
+
+          !> 5.1 trees
+
+          !!\latexonly
+          !!\input{stomate_data_sapl_tree.tex}
+          !!\endlatexonly
+
+          alpha = alpha_tree
+
+          bm_sapl(j,ileaf,icarbon) = &
+               &     ((bm_sapl_leaf(1)*pipe_tune1(j)*(mass_ratio_heart_sap(j) *bm_sapl_leaf(2)*sla(j)/(pi*pipe_k1(j))) & 
+               &     **bm_sapl_leaf(3))/sla(j))**bm_sapl_leaf(4)
+
+          IF ( pheno_type(j) .NE. 1 ) THEN
+             ! not evergreen
+             bm_sapl(j,icarbres,icarbon) = bm_sapl_carbres * bm_sapl(j,ileaf,icarbon)
+             bm_sapl(j,ilabile,icarbon) = bm_sapl_labile * bm_sapl(j,ileaf,icarbon)
+          ELSE
+             bm_sapl(j,icarbres,icarbon) = zero
+             bm_sapl(j,ilabile,icarbon) = zero
+          ENDIF ! (pheno_type_tab(j) .NE. 1 )
+
+          csa_sap = bm_sapl(j,ileaf,icarbon) / ( pipe_k1(j) / sla(j) )
+
+          dia = (mass_ratio_heart_sap(j) * csa_sap * dia_coeff(1) / pi ) ** dia_coeff(2)
+
+          bm_sapl(j,isapabove,icarbon) = &
+               bm_sapl_sapabove * pipe_density(j) * csa_sap * pipe_tune2(j) * dia ** pipe_tune3(j)
+          bm_sapl(j,isapbelow,icarbon) = bm_sapl(j,isapabove,icarbon)
+
+          bm_sapl(j,iheartabove,icarbon) = bm_sapl_heartabove * bm_sapl(j,isapabove,icarbon)
+          bm_sapl(j,iheartbelow,icarbon) = bm_sapl_heartbelow * bm_sapl(j,isapbelow,icarbon)
+
+       ELSE
+
+          !> 5.2 grasses
+
+          !!\latexonly
+          !!\input{stomate_data_sapl_grass.tex}
+          !!\endlatexonly
+
+          alpha = alpha_grass
+
+          IF ( natural(j) ) THEN
+             bm_sapl(j,ileaf,icarbon) = init_sapl_mass_leaf_nat / sla(j)
+          ELSE
+             bm_sapl(j,ileaf,icarbon) = init_sapl_mass_leaf_agri / sla(j)
+          ENDIF
+
+          bm_sapl(j,icarbres,icarbon) = init_sapl_mass_carbres *bm_sapl(j,ileaf,icarbon)
+          bm_sapl(j,ilabile,icarbon) = init_sapl_mass_labile *bm_sapl(j,ileaf,icarbon)
+
+          bm_sapl(j,isapabove,icarbon) = zero
+          bm_sapl(j,isapbelow,icarbon) = zero
+
+          bm_sapl(j,iheartabove,icarbon) = zero
+          bm_sapl(j,iheartbelow,icarbon) = zero
+
+       ENDIF !( is_tree(j) )
+
+       bm_sapl(j,iroot,icarbon) = init_sapl_mass_root * (1./alpha) * bm_sapl(j,ileaf,icarbon)
+
+       bm_sapl(j,ifruit,icarbon) = init_sapl_mass_fruit  * bm_sapl(j,ileaf,icarbon)
+
+
+       cn_leaf=cn_leaf_init(j)
+       cn_wood=cn_leaf/fcn_wood(j)
+       cn_root=cn_leaf/fcn_root(j)
+       
+       DO i=1,nparts
+          IF (i.EQ.1) THEN
+             bm_sapl(j,i,initrogen) = bm_sapl(j,i,icarbon) / cn_leaf
+          ELSE IF (i.LT.iroot) THEN
+             bm_sapl(j,i,initrogen) = bm_sapl(j,i,icarbon) / cn_wood
+          ELSE
+             bm_sapl(j,i,initrogen) = bm_sapl(j,i,icarbon) / cn_root
+          ENDIF
+       ENDDO
+
+       IF ( printlev_loc >= 2 ) THEN
+          WRITE(numout,*) '       sapling biomass (gC):'
+          WRITE(numout,*) '         leaves: (::bm_sapl(j,ileaf,icarbon))',bm_sapl(j,ileaf,icarbon)
+          WRITE(numout,*) '         sap above ground: (::bm_sapl(j,ispabove,icarbon)):',bm_sapl(j,isapabove,icarbon)
+          WRITE(numout,*) '         sap below ground: (::bm_sapl(j,isapbelow,icarbon))',bm_sapl(j,isapbelow,icarbon)
+          WRITE(numout,*) '         heartwood above ground: (::bm_sapl(j,iheartabove,icarbon))',bm_sapl(j,iheartabove,icarbon)
+          WRITE(numout,*) '         heartwood below ground: (::bm_sapl(j,iheartbelow,icarbon))',bm_sapl(j,iheartbelow,icarbon)
+          WRITE(numout,*) '         roots: (::bm_sapl(j,iroot,icarbon))',bm_sapl(j,iroot,icarbon)
+          WRITE(numout,*) '         fruits: (::bm_sapl(j,ifruit,icarbon))',bm_sapl(j,ifruit,icarbon)
+          WRITE(numout,*) '         carbohydrate reserve: (::bm_sapl(j,icarbres,icarbon))',bm_sapl(j,icarbres,icarbon)
+          WRITE(numout,*) '         labile reserve: (::bm_sapl(j,ilabile,icarbon))',bm_sapl(j,ilabile,icarbon)
+       ENDIF
+
+       !
+       ! 6 migration speed (m/year)
+       !
+
+       IF ( is_tree(j) ) THEN
+
+          migrate(j) = migrate_tree
+
+       ELSE
+
+          ! can be any value as grasses are, per *definition*, everywhere (big leaf).
+          migrate(j) = migrate_grass
+
+       ENDIF !( is_tree(j) )
+
+       IF ( printlev_loc >= 2 ) WRITE(numout,*) '       migration speed (m/year): (::migrate(j))', migrate(j)
+
+       !
+       ! 7 critical stem diameter: beyond this diameter, the crown area no longer
+       !     increases (m)
+       !
+
+       IF ( is_tree(j) ) THEN
+
+          !!\latexonly
+          !!\input{stomate_data_stem_diameter.tex}
+          !!\endlatexonly
+
+          maxdia(j) = ( ( pipe_tune4(j) / ((pipe_tune2(j)*pipe_tune3(j))/(maxdia_coeff(1)**pipe_tune3(j))) ) &
+               ** ( un / ( pipe_tune3(j) - un ) ) ) * maxdia_coeff(2)
+          cn_sapl(j) = cn_sapl_init !crown of individual tree, first year
+
+       ELSE
+
+          maxdia(j) = undef
+          cn_sapl(j)=1
+
+       ENDIF !( is_tree(j) )
+
+       IF ( printlev_loc >= 2 ) WRITE(numout,*) '       critical stem diameter (m): (::maxdia(j))', maxdia(j)
+
+       !
+       ! 8 Coldest tolerable temperature (K)
+       !
+
+       IF ( ABS( tmin_crit(j) - undef ) .GT. min_stomate ) THEN
+          tmin_crit(j) = tmin_crit(j) + ZeroCelsius
+       ELSE
+          tmin_crit(j) = undef
+       ENDIF 
+
+       IF ( printlev_loc >= 2 ) &
+            WRITE(numout,*) '       coldest tolerable temperature (K): (::tmin_crit(j))', tmin_crit(j)
+
+       !
+       ! 9 Maximum temperature of the coldest month: need to be below this temperature
+       !      for a certain time to regrow leaves next spring *(vernalization)* (K)
+       !
+
+       IF ( ABS ( tcm_crit(j) - undef ) .GT. min_stomate ) THEN
+          tcm_crit(j) = tcm_crit(j) + ZeroCelsius
+       ELSE
+          tcm_crit(j) = undef
+       ENDIF
+
+       IF ( printlev_loc >= 2 ) &
+            WRITE(numout,*) '       vernalization temperature (K): (::tcm_crit(j))', tcm_crit(j)
+
+       !
+       ! 10 critical values for phenology
+       !
+
+       ! 10.1 model used
+
+       IF ( printlev_loc >= 2 ) &
+            WRITE(numout,*) '       phenology model used: (::pheno_model(j)) ',pheno_model(j)
+
+       ! 10.2 growing degree days. What kind of gdd is meant (i.e. threshold 0 or -5 deg C
+       !        or whatever), depends on how this is used in stomate_phenology.
+
+
+       IF ( ( printlev_loc >= 2 ) .AND. ( ALL(pheno_gdd_crit(j,:) .NE. undef) ) ) THEN
+          WRITE(numout,*) '         critical GDD is a function of long term T (C): (::gdd)'
+          WRITE(numout,*) '          ',pheno_gdd_crit(j,1), &
+               ' + T *',pheno_gdd_crit(j,2), &
+               ' + T^2 *',pheno_gdd_crit(j,3)
+       ENDIF
+
+       ! consistency check
+
+       IF ( ( ( pheno_model(j) .EQ. 'moigdd' ) .OR. &
+            ( pheno_model(j) .EQ. 'humgdd' )       ) .AND. &
+            ( ANY(pheno_gdd_crit(j,:) .EQ. undef) )                      ) THEN
+          CALL ipslerr_p(3,'stomate_data','problem with phenology parameters, critical GDD. (::pheno_model)','','')
+       ENDIF
+
+       ! 10.3 number of growing days
+
+       IF ( ( printlev_loc >= 2 ) .AND. ( ngd_crit(j) .NE. undef ) ) &
+            WRITE(numout,*) '         critical NGD: (::ngd_crit(j))', ngd_crit(j)
+
+       ! 10.4 critical temperature for ncd vs. gdd function in phenology (C)
+
+       IF ( ( printlev_loc >= 2 ) .AND. ( ncdgdd_temp(j) .NE. undef ) ) &
+            WRITE(numout,*) '         critical temperature for NCD vs. GDD (C): (::ncdgdd_temp(j))', &
+            ncdgdd_temp(j)
+
+       ! 10.5 humidity fractions (0-1, unitless)
+
+       IF ( ( printlev_loc >= 2 ) .AND. ( hum_frac(j) .NE. undef ) ) &
+            WRITE(numout,*) '         critical humidity fraction: (::hum_frac(j))', &
+            &  hum_frac(j)
+
+
+       ! 10.6 minimum time elapsed since moisture minimum (days)
+
+       IF ( ( printlev_loc >= 2 ) .AND. ( hum_min_time(j) .NE. undef ) ) &
+            WRITE(numout,*) '         time to wait after moisture min (d): (::hum_min_time(j))', &
+        &    hum_min_time(j)
+
+       !
+       ! 11 critical values for senescence
+       !
+
+       ! 11.1 type of senescence
+
+       IF ( printlev_loc >= 2 ) WRITE(numout,*) '       type of senescence: (::senescence_type(j))',&
+            senescence_type(j)
+
+       ! 11.2 critical temperature for senescence (C)
+
+       IF ( ( printlev_loc >= 2 ) .AND. ( ALL(senescence_temp(j,:) .NE. undef) ) ) THEN
+          WRITE(numout,*) '         critical temperature for senescence (C) is'
+          WRITE(numout,*) '          a function of long term T (C): (::senescence_temp)'
+          WRITE(numout,*) '          ',senescence_temp(j,1), &
+               ' + T *',senescence_temp(j,2), &
+               ' + T^2 *',senescence_temp(j,3)
+       ENDIF
+
+       ! consistency check
+
+       IF ( ( ( senescence_type(j) .EQ. 'cold' ) .OR. &
+            ( senescence_type(j) .EQ. 'mixed' )      ) .AND. &
+            ( ANY(senescence_temp(j,:) .EQ. undef ) )           ) THEN
+          CALL ipslerr_p(3,'stomate_data','Problem with senescence parameters, temperature. (::senescence_type)','','')
+       ENDIF
+
+       ! 11.3 critical relative moisture availability for senescence
+
+       IF ( ( printlev_loc >= 2 ) .AND. ( senescence_hum(j) .NE. undef ) ) THEN
+          WRITE(numout,*)  ' max. critical relative moisture availability for' 
+          WRITE(numout,*)  ' senescence: (::senescence_hum(j))',  &
+               & senescence_hum(j)
+       ENDIF
+
+       ! consistency check
+
+       IF ( ( ( senescence_type(j) .EQ. 'dry' ) .OR. &
+            ( senescence_type(j) .EQ. 'mixed' )     ) .AND. &
+            ( senescence_hum(j) .EQ. undef )                   ) THEN
+          CALL ipslerr_p(3,'stomate_data','Problem with senescence parameters, humidity.(::senescence_type)','','')
+       ENDIF
+
+       ! 14.3 relative moisture availability above which there is no moisture-related
+       !      senescence (0-1, unitless)
+
+       IF ( ( printlev_loc >= 2 ) .AND. ( nosenescence_hum(j) .NE. undef ) ) THEN
+          WRITE(numout,*) '         relative moisture availability above which there is' 
+          WRITE(numout,*) '             no moisture-related senescence: (::nosenescence_hum(j))', &
+               &  nosenescence_hum(j)
+       ENDIF
+
+       ! consistency check
+
+       IF ( ( ( senescence_type(j) .EQ. 'dry' ) .OR. &
+            ( senescence_type(j) .EQ. 'mixed' )     ) .AND. &
+            ( nosenescence_hum(j) .EQ. undef )                   ) THEN
+          CALL ipslerr_p(3,'stomate_data','Problem with senescence parameters, humidity. (::senescence_type)','','')
+       ENDIF
+
+       !
+       ! 12 sapwood -> heartwood conversion time (days)
+       !
+
+       IF ( printlev_loc >= 2 ) &
+            WRITE(numout,*) '       sapwood -> heartwood conversion time (d): (::tau_sap(j))', tau_sap(j)
+
+       !
+       ! 13 fruit lifetime (days)
+       !
+
+       IF ( printlev_loc >= 2 ) WRITE(numout,*) '       fruit lifetime (d): (::tau_fruit(j))', tau_fruit(j)
+
+       !
+       ! 14 length of leaf death (days)
+       !      For evergreen trees, this variable determines the lifetime of the leaves.
+       !      Note that it is different from the value given in leaflife_tab.
+       !
+
+       IF ( printlev_loc >= 2 ) &
+            WRITE(numout,*) '       length of leaf death (d): (::leaffall(j))', leaffall(j)
+
+       !
+       ! 15 maximum lifetime of leaves (days)
+       !
+
+       IF ( ( printlev_loc >= 2 ) .AND. ( leafagecrit(j) .NE. undef ) ) &
+            WRITE(numout,*) '       critical leaf age (d): (::leafagecrit(j))', leafagecrit(j)
+
+       !
+       ! 16 time constant for leaf age discretisation (days)
+       !
+
+       leaf_timecst(j) = leafagecrit(j) / REAL( nleafages,r_std )
+
+       IF ( printlev_loc >= 2 ) &
+            WRITE(numout,*) '       time constant for leaf age discretisation (d): (::leaf_timecst(j))', &
+            leaf_timecst(j)
+
+       !
+       ! 17 minimum lai, initial (m^2.m^{-2})
+       !
+
+       IF ( is_tree(j) ) THEN
+          lai_initmin(j) = lai_initmin_tree
+       ELSE
+          lai_initmin(j) = lai_initmin_grass
+       ENDIF !( is_tree(j) )
+
+       IF ( printlev_loc >= 2 ) &
+            WRITE(numout,*) '       initial LAI: (::lai_initmin(j))', lai_initmin(j)
+
+       !
+       ! 19 maximum LAI (m^2.m^{-2})
+       !
+
+       IF ( printlev_loc >= 2 ) &
+            WRITE(numout,*) '       critical LAI above which no leaf allocation: (::lai_max(j))', lai_max(j)
+
+       !
+       ! 20 fraction of primary leaf and root allocation put into reserve (0-1, unitless)
+       !
+
+       IF ( printlev_loc >= 2 ) &
+            WRITE(numout,*) '       reserve allocation factor: (::ecureuil(j))', ecureuil(j)
+
+
+       !
+       ! 23 natural ?
+       !
+
+       IF ( printlev_loc >= 2 ) &
+            WRITE(numout,*) '       Natural: (::natural(j))', natural(j)
+
+       !
+       ! 24 Vcmax et Vjmax (umol.m^{-2}.s^{-1}) 
+       !
+
+       IF ( printlev_loc >= 2 ) &
+            WRITE(numout,*) '       Maximum rate of carboxylation: (::Vcmax_25(j))', vcmax25(j)
+       !
+       ! 25 constants for photosynthesis temperatures
+       !
+
+       IF ( printlev_loc >= 2 ) THEN
+
+
+          !
+          ! 26 Properties
+          !
+
+          WRITE(numout,*) '       C4 photosynthesis: (::is_c4(j))', is_c4(j)
+          WRITE(numout,*) '       Depth constant for root profile (m): (::1./humcste(j))', 1./humcste(j)
+
+       ENDIF
+
+       !
+       ! 27 extinction coefficient of the Monsi and Saeki (1953) relationship 
+       !
+       IF ( printlev_loc >= 2 ) THEN
+          WRITE(numout,*) '       extinction coefficient: (::ext_coeff(j))', ext_coeff(j)
+       ENDIF
+
+       !
+       ! 30 fraction of allocatable biomass which is lost as growth respiration (0-1, unitless)
+       !
+       IF ( printlev_loc >= 2 ) &
+            WRITE(numout,*) '       growth respiration fraction: (::frac_growthresp(j))', frac_growthresp(j)
+
+    ENDDO ! Loop over # PFTS 
+
+    !
+    ! 29 time scales for phenology and other processes (in days)
+    !
+
+    tau_longterm_max = coeff_tau_longterm * one_year
+
+    IF ( printlev_loc >= 2 ) THEN
+
+       WRITE(numout,*) '   > time scale for ''monthly'' moisture availability (d): (::tau_hum_month)', &
+            tau_hum_month
+       WRITE(numout,*) '   > time scale for ''weekly'' moisture availability (d): (::tau_hum_week)', &
+           tau_hum_week
+       WRITE(numout,*) '   > time scale for ''monthly'' 2 meter temperature (d): (::tau_t2m_month)', &
+            tau_t2m_month
+       WRITE(numout,*) '   > time scale for ''weekly'' 2 meter temperature (d): (::tau_t2m_week)', &
+            tau_t2m_week
+       WRITE(numout,*) '   > time scale for ''weekly'' GPP (d): (::tau_gpp_week)', &
+            tau_gpp_week
+       WRITE(numout,*) '   > time scale for ''monthly'' soil temperature (d): (::tau_tsoil_month)', &
+            tau_tsoil_month
+       WRITE(numout,*) '   > time scale for ''monthly'' soil humidity (d): (::tau_soilhum_month)', &
+            tau_soilhum_month
+       WRITE(numout,*) '   > time scale for vigour calculations (y): (::tau_longterm_max / one_year)', &
+            tau_longterm_max / one_year
+
+    ENDIF
+
+    IF (printlev >= 4) WRITE(numout,*) 'Leaving data'
+
+  END SUBROUTINE data
+
+END MODULE stomate_data
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_growth_fun_all.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_growth_fun_all.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_growth_fun_all.f90	(revision 6412)
@@ -0,0 +1,6420 @@
+!=================================================================================================================================
+! MODULE       : stomate_allocation
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Plant growth and C-allocation among the biomass components (leaves, wood, roots, fruit, reserves, labile) 
+!!               is calculated making use of functional allocation which combines the pipe model and allometric relationships 
+!!               proposed by Sitch et al 2003 and adjusted by Zaehle et al 2010.
+!!
+!!\n DESCRIPTION: This module calculates three processes: (1) daily maintenance respiration based on the half-hourly
+!!               respiration calculated in stomate_resp.f90, (2) the absolute allocation to the different biomass
+!!               components based on functional allocation approach and (3) the allocatable biomass as the residual
+!!               of GPP-Ra. Multiplication of the allocation fractions and allocatable biomass given the changes in
+!!               biomass pools.
+!!
+!! RECENT CHANGE(S): Until 1.9.6 only one allocation scheme was available (now contained in stomate_grwoth_res_lim.f90). 
+!!               This module consists of an alternative formalization of plant growth.
+!!                             
+!! REFERENCE(S)	: - Sitch, S., Smith, B., Prentice, I.C., Arneth, A., Bondeau, A., Cramer, W.,
+!!               Kaplan, J.O., Levis, S., Lucht, W., Sykes, M.T., Thonicke, K., Venevsky, S. (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 
+!!               - Zaehle, S. and Friend, A.D. (2010), Carbon and nitrogen cycle dynamics in the O-CN land surface model: 1. 
+!!               Model description, site-scale evaluation, and sensitivity to parameter estimates, Global Biogeochemical 
+!!               Cycles, 24, GB1005.\n
+!!               - Magnani F., Mencuccini M. & Grace J. 2000. Age-related decline in stand productivity: the role of 
+!!               structural acclimation under hydraulic constraints Plant, Cell and Environment 23, 251â263.\n
+!!               - Bloom A.J., Chapin F.S. & Mooney H.A. (1985) Resource limitation in plants. An economic analogy.  
+!!               Annual Review Ecology Systematics 16, 363â392.\n
+!!               - Case K.E. & Fair R.C. (1989) Principles of Economics. Prentice Hall, London.\n
+!!               - McDowell, N., Barnard, H., Bond, B.J., Hinckley, T., Hubbard, R.M., Ishii, H., KÃ¶stner, B., 
+!!               Magnani, F. Marshall, J.D., Meinzer, F.C., Phillips, N., Ryan, M.G., Whitehead D. 2002. The 
+!!               relationship between tree height and leaf area: sapwood area ratio. Oecologia, 132:12â20.\n
+!!               - Novick, K., Oren, R., Stoy, P., Juang, F.-Y., Siqueira, M., Katul, G. 2009. The relationship between
+!!               reference canopy conductance and simplified hydraulic architecture. Advances in water resources 32,
+!!               809-819.     
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ===============================================================================================================================
+
+MODULE stomate_growth_fun_all
+
+  ! Modules used:
+  USE ioipsl_para
+  USE xios_orchidee
+  USE pft_parameters
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE function_library,    ONLY: wood_to_qmdia, wood_to_qmheight, &
+       wood_to_ba_eff, cc_to_lai, lai_to_biomass, &
+       cc_to_biomass, biomass_to_cc, &
+       biomass_to_lai, &
+       calculate_c0_alloc, wood_to_volume, wood_to_ba, &
+       check_biomass_sync, check_surface_area, &
+       check_mass_balance, wood_to_height
+
+  IMPLICIT NONE
+
+  ! Private & public routines
+
+  PRIVATE
+  PUBLIC growth_fun_all_clear, growth_fun_all
+
+ ! Variables shared by all subroutines in this module
+
+  LOGICAL, SAVE        :: firstcall = .TRUE.  !! Is this the first call? (true/false)
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : growth_fun_all_clear
+!!
+!>\BRIEF          Set the flag ::firstcall to .TRUE. and as such activate section 
+!! 1.1 of the subroutine alloc (see below).\n
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE growth_fun_all_clear
+    firstcall = .TRUE.
+  END SUBROUTINE growth_fun_all_clear
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: growth_fun_all
+!!
+!>\BRIEF          Allocate net primary production (= photosynthesis
+!!                minus autothrophic respiration) to: labile carbon pool carbon reserves, aboveground sapwood,
+!!                belowground sapwood, root, fruits and leaves following the pipe model and allometric constraints.
+!!
+!! DESCRIPTION  : Total maintenance respiration for the whole plant is calculated by summing maintenance 
+!!                respiration of the different plant compartments. Maintenance respiration is subtracted 
+!!                from whole-plant allocatable biomass (up to a maximum fraction of the total allocatable biomass). 
+!!                Growth respiration is then calculated as a prescribed (0.75) fraction of the allocatable
+!!                biomass. Subsequently NPP is calculated by substracting total autotrophic  respiration from GPP 
+!!                i.e. NPP = GPP - maintenance resp - growth resp.
+!!
+!!                The pipe model assumes that one unit of leaf mass requires a proportional amount of sapwood to 
+!!                transport water from the roots to the leaves. Also a proportional fraction of roots is needed to 
+!!                take up the water from the soil. The proportional amounts between leaves, sapwood and roots are 
+!!                given by allocation factors. These allocation factors are PFT specific and depend on a parameter 
+!!                quantifying the leaf to sapwood area (::k_latosa_target), the specific leaf area (::sla), wood 
+!!                density (::pipe_density) and a scaling parameter between leaf and root mass.
+!! 
+!!                Lai is optimised for mean annual radiation use efficiency and the C cost for producing the 
+!!                canopy. The cost-benefit ratio is optimised when the marginal gain / marginal cost = 1 lai target 
+!!                is used to calculate whether the reserves are used. This approach allows plants to get out of 
+!!                senescence and to start developping a canopy in early spring. 
+!!                  
+!!                As soon as a canopy has emerged, C (b_inc_tot) becomes available at the stand level through 
+!!                photosynthesis and, C is allocated at the tree level (b_inc) following both the pipe model and 
+!!                allometric constraints. Mass conservation requires:
+!!                (1) Cs_inc + Cr_inc + Cl_inc = b_inc
+!!                (2) sum(b_inc) = b_inc_tot
+!!
+!!                Wood allocation depends on tree basal area following the rule of Deleuze & Dhote
+!!                delta_ba = gammas*(circ - m*sigmas + sqrt((m*sigmas + circ).^2 - (4*sigmas*circ)))/2
+!!                (3) <=> delta_ba = circ_class_dba*gammas
+!!                Where circ_class_dba = (circ - m*sigmas + sqrt((m*sigmas + circ).^2 - (4*sigmas*circ)))/2
+!! 
+!!                Allometric relationships
+!!                height = pipe_tune2*(dia.^pipe_tune3)
+!!                Re-write this relationship as a function of ba 
+!!                (4) height = pipe_tune2 * (4/pi*ba)^(pipe_tune3/2)
+!!                (5a) Cl/Cs = KF/height for trees
+!!                (5b) Cs = Cl / KF
+!!                (6) Cl = Cr * LF
+!!
+!!                Use a linear approximation to avoid iterations. Given that allocation is calculated daily, a 
+!!                local lineair assumption is fair. Eq (4) can thus be rewritten as:
+!!                s = step/(pipe_tune2*(4/pi*(ba+step)).^(pipe_tune3/2)-pipe_tune2*(4/pi*ba).^(pipe_tune3/2))
+!!                Where step is a small but realistic (for the time step) change in ba
+!!                (7)  <=> delta_height = delta_ba/s
+!!
+!!                Calculate Cs_inc from allometric relationships
+!!                Cs_inc = tree_ff*pipe_density*(ba+delta_ba)*(height+delta_height) - Cs - Ch         
+!!                Cs_inc = tree_ff*pipe_density*(ba+delta_ba)*(height+delta_ba/s) - Cs - Ch
+!!                (8)  <=> Cs_inc = tree_ff*pipe_density*(ba+a*gammas)*(height+(a/s*gammas)) - Cs - Ch
+!!
+!!                Rewrite (5) as 
+!!                Cl_inc = KF*(Cs_inc+Cs)/(height+delta_height) - Cl
+!!                Substitute (7) in (4) and solve for Cl_inc
+!!                Cl_inc = KF*(tree_ff*pipe_density*(ba+circ_class_dba*gammas)*(height+(circ_class_dba/s*gammas)) - Ch)/ & 
+!!                   (height+(circ_class_dba/s*gammas)) - Cl  
+!!                (9)  <=> Cl_inc = KF*tree_ff*pipe_density*(ba+circ_class_dba*gammas) - &
+!!                            (KF*Ch)/(height+(circ_class_dba/s*gammas)) - Cl
+!!
+!!                Rewrite (6) as 
+!!                Cr_inc = (Cl_inc+Cl)/LF - Cr
+!!                Substitute (9) in (6)
+!!                (10)  <=> Cr_inc = KF/LF*tree_ff*pipe_density*(ba+circ_class_dba*gammas) - &
+!!                            (KF*Ch/LF)/(height+(circ_class_dba/s*gammas)) - Cr
+!!
+!!                Depending on the specific case that needs to be solved equations (1) takes one of the following forms:
+!!                (a) b_inc = Cl_inc + Cr_inc + Cs_inc, (b) b_inc = Cl_inc + Cr_inc, (c) b_inc = Cl_inc + Cs_inc or 
+!!                (d) b_inc = Cr_inc + Cs_inc. One of these alternative forms of eq. 1 are then combined with 
+!!                eqs 8, 9 and 10 and solved for gammas. The details for the solution of these four cases are given in the
+!!                code. Once gammas is know, eqs 6 - 10 are used to calculate the allocation to leaves (Cl_inc), 
+!!                roots (Cr_inc) and sapwood (Cs_inc).
+!!
+!!                Because of turnover, biomass pools are not all the time in balance according to rules prescribed
+!!                by the pipe model. To test whether biomass pools are balanced, the target biomasses are calculated 
+!!                and balance is restored whenever needed up to the level that the biomass pools for leaves, sapwood
+!!                and roots are balanced according to the pipe model. Once the balance is restored C is allocated to
+!!                fruits, leaves, sapwood and roots by making use of the pipe model (below this called ordinary 
+!!                allocation).
+!!
+!!                Although strictly speaking allocation factors are not necessary in this scheme (Cl_inc could simply 
+!!                be added to biomass(:,:,ileaf,icarbon), Cr_inc to biomass(:,:,iroot,icarbon), etc.), they are 
+!!                nevertheless calculated because using allocation factors facilitates comparison to the resource 
+!!                limited allocation scheme (stomate_growth_res_lim.f90) and it comes in handy for model-data comparison.
+!!
+!!                Effective basal area, height and circumferences are use in the allocation scheme because their 
+!!                calculations make use of the total (above and belowground) biomass. In forestry the same measures
+!!                exist (and they are also calculated in ORCHIDEE) but only account for the aboverground biomass.
+!! 
+!!
+!! RECENT CHANGE(S): - The code by Sonke Zaehle made use of ::Cl_target that was derived from ::lai_target which in turn 
+!!                was a function of ::rue_longterm. Cl_target was then used as a threshold value to decide whether there 
+!!                was only phenological growth (just leaves and roots) or whether there was full allometric growth to the 
+!!                leaves, roots and sapwood. This approach was inconsistent with the pipe model because full allometric 
+!!                growth can only occur if all three biomass pools are in balance. ::lai_target is no longer used as a 
+!!                criterion to switch between phenological and full allometric growth. Its use is now restricted to trigger
+!!                the use of reserves in spring. 
+!!
+!! MAIN OUTPUT VARIABLE(S): ::npp and :: biomass. Seven different biomass compartments (leaves, roots, above and 
+!!                belowground wood, carbohydrate reserves, labile and fruits).
+!!
+!! REFERENCE(S)	:- Sitch, S., Smith, B., Prentice, I.C., Arneth, A., Bondeau, A., Cramer, W.,
+!!                Kaplan, J.O., Levis, S., Lucht, W., Sykes, M.T., Thonicke, K., Venevsky, S. (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 
+!!                - Zaehle, S. and Friend, A.D. (2010), Carbon and nitrogen cycle dynamics in the O-CN land surface model: 1. 
+!!                Model description, site-scale evaluation, and sensitivity to parameter estimates, Global Biogeochemical 
+!!                Cycles, 24, GB1005.\n
+!!                - Magnani F., Mencuccini M. & Grace J. 2000. Age-related decline in stand productivity: the role of 
+!!                structural acclimation under hydraulic constraints Plant, Cell and Environment 23, 251â263.
+!!                - Bloom A.J., Chapin F.S. & Mooney H.A. (1985) Resource limitation in plants. An economic analogy. Annual 
+!!                Review Ecology Systematics 16, 363â392.
+!!                - Case K.E. & Fair R.C. (1989) Principles of Economics. Prentice Hall, London.
+!!                - McDowell, N., Barnard, H., Bond, B.J., Hinckley, T., Hubbard, R.M., Ishii, H., KÃ¶stner, B., 
+!!                Magnani, F. Marshall, J.D., Meinzer, F.C., Phillips, N., Ryan, M.G., Whitehead D. 2002. The 
+!!                relationship between tree height and leaf area: sapwood area ratio. Oecologia, 132:12â20
+!!                - Novick, K., Oren, R., Stoy, P., Juang, F.-Y., Siqueira, M., Katul, G. 2009. The relationship between
+!!                reference canopy conductance and simplified hydraulic architecture. Advances in water resources 32,
+!!                809-819.   
+!!
+!! +++++++++++++++++++++
+!! MAKE A NEW FLOW CHART
+!! +++++++++++++++++++++
+!! FLOWCHART    : 
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE growth_fun_all (npts, dt, veget_cov_max, veget_cov, &
+       PFTpresent, plant_status, when_growthinit, t2m, &
+       nstress_season, moiavail_growingseason, &
+       gpp_daily, resp_maint_part, resp_maint, &
+       resp_growth, npp, bm_alloc, age, &
+       leaf_age, leaf_frac, use_reserve, &
+       lab_fac, rue_longterm, circ_class_n, &
+       circ_class_biomass, KF, sigma, &
+       gammas, tau_eff_leaf, tau_eff_sap, tau_eff_root, &
+       k_latosa_adapt, forest_managed, circ_class_dist, &
+       cn_leaf_min_season, atm_to_bm, store_sum_delta_ba)       
+
+
+ !! 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(:), INTENT(in)             :: t2m                    !! Temperature at 2 meter (K)   
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: veget_cov_max          !! PFT "Maximal" coverage fraction of a PFT 
+                                                                                !! (= ind*cn_ind) 
+                                                                                !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: veget_cov              !! Fraction of vegetation type including 
+                                                                                !! non-biological fraction (unitless)   
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: when_growthinit        !! Days since beginning of growing season 
+                                                                                !! (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: rue_longterm           !! Longterm "radiation use efficicency"
+                                                                                !! calculated as the ratio of GPP over 
+                                                                                !! the fraction of radiation absorbed
+                                                                                !! by the canopy 
+                                                                                !! @tex $(gC.m^{-2}day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: tau_eff_root           !! Effective root turnover time that accounts
+                                                                                !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: tau_eff_sap            !! Effective sapwood turnover time that accounts
+                                                                                !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: tau_eff_leaf           !! Effective leaf turnover time that accounts
+                                                                                !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)      :: circ_class_n           !! Number of individuals in each circ class
+    REAL(r_std), DIMENSION(:), INTENT(in)             :: circ_class_dist        !! The probability distribution of trees 
+                                                                                !! in a circ class in case of a 
+                                                                                !! redistribution (unitless).
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)         :: resp_maint_part        !! Maintenance respiration of different  
+                                                                                !! plant parts
+                                                                                !! @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: plant_status           !! Growth and phenological status of the plant
+                                                                                !! Different stati are listed in constantes_var 
+    LOGICAL, DIMENSION(:,:), INTENT(in)               :: PFTpresent             !! PFT exists (true/false)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)      :: nstress_season         !! N-related seasonal stress (used for allocation)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)      :: moiavail_growingseason !! mean growing season moisture availability
+    INTEGER(i_std), DIMENSION(:,:), INTENT(in)        :: forest_managed         !! Forest management flag: 0 = orchidee 
+                                                                                !! standard, 1= self-thinning only, 2= 
+                                                                                !! high-stand, 3= high-stand smoothed, 4= 
+                                                                                !! coppices
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(:,:), INTENT(out)          :: resp_maint             !! PFT maintenance respiration 
+                                                                                !! @tex $(gC.m^{-2}dt^{-1})$ @endtex    
+    REAL(r_std), DIMENSION(:,:), INTENT(out)          :: resp_growth            !! PFT growth respiration 
+                                                                                !! @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                  :: temp_resp_growth       !! PFT growth respiration
+                                                                                !! @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(out)          :: npp                    !! PFT net primary productivity 
+                                                                                !! @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements) :: bm_alloc               !! PFT biomass increase, i.e. NPP per plant  
+                                                                                !! part @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(out)          :: lab_fac                !! Activity of labile pool factor (units??)
+    REAL(r_std), DIMENSION(:,:), INTENT(out)          :: sigma                  !! Threshold for indivudal tree growth in 
+                                                                                !! the equation of Deleuze & Dhote (2004)(m).
+                                                                                !! Trees whose circumference is smaller than 
+                                                                                !! sigma don't grow much
+    REAL(r_std), DIMENSION(:,:), INTENT(out)          :: gammas                 !! Slope for individual tree growth in the 
+                                                                                !! equation of Deleuze & Dhote (2004) (m)
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: gpp_daily              !! PFT gross primary productivity 
+                                                                                !! @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: use_reserve            !! Flag to use the reserves to support
+                                                                                !! phenological growth (0 or 1)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: age                    !! PFT age (days)      
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)      :: leaf_age               !! PFT age of different leaf classes 
+                                                                                !! (days)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)      :: leaf_frac              !! PFT fraction of leaves in leaf age class
+                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)  :: circ_class_biomass     !! Biomass components of the model tree  
+                                                                                !! within a circumference class
+                                                                                !! class @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: KF                     !! Scaling factor to convert sapwood mass
+                                                                                !! into leaf mass (m)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: k_latosa_adapt         !! Leaf to sapwood area adapted for long 
+                                                                                !! term water stress (m)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: cn_leaf_min_season         !! Min leaf nitrogen concentration (C:N) of the growing season  
+ 	                                                                        !! (gC/gN)  
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)      :: atm_to_bm              !! Nitrogen and carbon which is added to the ecosystem to 
+                                                                                !! support vegetation growth (gC or gN/m2/day)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)      :: store_sum_delta_ba     !! Sum of increase of basal area(m^2) which doesn't pass through 
+                                                                                !! gap clean unlike store-circ_class_ba
+
+    !! 0.4 Local variables
+
+    CHARACTER(30)                                     :: var_name               !! To store variable names for I/O
+    REAL(r_std), DIMENSION(npts,nvm)                  :: c0_alloc               !! Root to sapwood tradeoff parameter
+    LOGICAL                                           :: grow_wood=.TRUE.       !! Flag to grow wood
+    INTEGER(i_std)                                    :: ipts,j,k,l,m           !! Indices(unitless)
+    INTEGER(i_std)                                    :: icir,imed,ipool        !! Indices(unitless)
+    INTEGER(i_std)                                    :: ifm,icut               !! Indices
+    INTEGER(i_std), SAVE                              :: ipar,iele,imbc         !! Indices(unitless)
+    INTEGER(i_std)                                    :: ilev                   !! Indices(unitless)
+    REAL(r_std)                                       :: frac                   !! No idea??
+    REAL(r_std)                                       :: a,b,c                  !! Temporary variables to solve a
+                                                                                !! quadratic equation (unitless)
+    ! Stand level
+    REAL(r_std)                                       :: gtemp                  !! Turnover coefficient of labile C pool
+                                                                                !! (0-1??, units??)
+    REAL(r_std)                                       :: reserve_pool           !! Intentional size of the reserve pool
+                                                                                !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std)                                       :: labile_pool            !! Intentional size of the labile pool
+                                                                                !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm)                   :: reserve_pool_write     !! Intentional size of the reserve pool
+                                                                                !! to write to output file, just a copy of 
+                                                                                !! reserve_pool, but over all grids and PFTSs
+                                                                                !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm)                   :: labile_pool_write      !! Intentional size of the labile pool
+                                                                                !! to write to output file, just a copy of
+                                                                                !! labile_pool, but over all grids and PTFs
+                                                                                !! @tex $(gC.m^{-2})$@endtex
+    REAL(r_std)                                       :: labile_pool_n          !! Intentional size of the labile pool
+                                                                                !! @tex $(gN.m^{-2})$ @endtex
+    REAL(r_std)                                       :: reserve_scal           !! Protection of the reserve against 
+                                                                                !! overuse (unitless)
+    REAL(r_std)                                       :: use_lab                !! Availability of labile biomass 
+                                                                                !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std)                                       :: use_res                !! Availability of resource biomass 
+                                                                                !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std)                                       :: use_max                !! Maximum use of labile and resource pool 
+                                                                                !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(nvm)                       :: root_reserve           !! Fraction of max root biomass which are 
+                                                                                !! covered by carbon reserve
+    REAL(r_std)                                       :: leaf_meanage           !! Mean age of the leaves (days?)
+    REAL(r_std)                                       :: reserve_time           !! Maximum number of days during which 
+                                                                                !! carbohydrate reserve may be used (days)
+    REAL(r_std)                                       :: b_inc_tot              !! Carbon that needs to allocated in the
+                                                                                !! fixed number of trees (gC)
+    REAL(r_std)                                       :: b_inc_temp             !! Temporary b_inc at the stand-level
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                  :: scal                   !! Scaling factor between average 
+                                                                                !! individual and individual plant
+                                                                                !! @tex $(plant.m^{-2})$ @endtex
+    REAL(r_std)                                       :: total_inc              !! Total biomass increase
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex
+    REAL(r_std)                                       :: KF_old                 !! Scaling factor to convert sapwood mass
+                                                                                !! into leaf mass (m) at the previous
+                                                                                !! time step
+    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(nvm)                       :: deleuze_p              !! Percentile of trees that will receive 
+                                                                                !! photosynthates. The proxy for intra stand
+                                                                                !! competition. Depends on the management
+                                                                                !! strategy when ncirc < 6
+    REAL(r_std), DIMENSION(npts)                      :: tl                     !! Long term annual mean temperature (C)
+    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)                                       :: alloc_sap_above        !! Fraction allocated to sapwood above 
+                                                                                !! ground
+    REAL(r_std), DIMENSION(npts,nvm)                  :: residual               !! Copy of b_inc_tot after all C has been
+                                                                                !! allocated @tex $(gC.m^{-2})$ @endtex
+                                                                                !! if all went well the value should be zero
+    REAL(r_std), DIMENSION(npts,nvm)                  :: residual_write         !! Copy of b_inc_tot after all C has been
+                                                                                !! allocated @tex $(gC.m^{-2})$ @endtex
+                                                                                !! if all went well the value should be zero. This
+                                                                                !! value is written to the history file to better
+                                                                                !! monitor the residuals
+    REAL(r_std), DIMENSION(npts,nvm)                  :: lai_target             !! Target LAI @tex $(m^{2}m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                  :: ltor                   !! Leaf to root ratio (unitless)   
+    REAL(r_std), DIMENSION(npts,nvm)                  :: lstress_fac            !! Light stress factor, based on total
+                                                                                !! transmitted light (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvm)                  :: k_latosa               !! Target leaf to sapwood area ratio
+    REAL(r_std), DIMENSION(npts,nvm)                  :: LF                     !! Scaling factor to convert sapwood mass
+                                                                                !! into root mass (unitless)
+    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), DIMENSION(npts,nvm)                  :: bm_alloc_tot           !! Allocatable biomass for the whole plant
+                                                                                !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                  :: temp_bm_alloc_tot      !! Allocatable biomass for the whole plant
+                                                                                !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                  :: resid_bm_alloc_tot     !! Allocatable biomass for the whole plant
+                                                                                !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                  :: leaf_mass_young        !! Leaf biomass in youngest leaf age class 
+                                                                                !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                  :: lai                    !! PFT leaf area index 
+                                                                                !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                  :: qm_dia                 !! Quadratic mean diameter of the stand (m)
+    REAL(r_std), DIMENSION(npts,nvm)                  :: qm_height              !! Height of a tree with the quadratic mean
+                                                                                !! diameter (m)
+    REAL(r_std), DIMENSION(npts,nvm)                  :: ba                     !! Basal area. variable for histwrite only (m2)
+    REAL(r_std), DIMENSION(npts,nvm)                  :: wood_volume            !! wood_volume (m3 m-2)
+    REAL(r_std), DIMENSION(npts,nvm,nparts)           :: f_alloc                !! PFT fraction of NPP that is allocated to
+                                                                                !! the different components (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,ncirc,nparts)         :: f_alloc_circ           !! Fraction of that is allocated to each circc_class
+                                                                                !! the different components (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements) :: tmp_bm                 !! temporary variable to use site-level biomass 
+                                                                                !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements) :: tmp_init_bm            !! temporary variable to use site-level biomass 
+                                                                                !! @tex $(gC m^{-2})$ @endtex
+
+    ! Tree level	
+    REAL(r_std), DIMENSION(ncirc)                     :: step                   !! Temporary variables to solve a
+                                                                                !! quadratic equation (unitless)
+    REAL(r_std), DIMENSION(ncirc)                     :: s                      !! tree-level linear relationship between
+                                                                                !! basal area and height. This variable is
+                                                                                !! used to linearize the allocation scheme
+    REAL(r_std), DIMENSION(ncirc)                     :: Cs_inc_est             !! Initial value estimate for Cs_inc. The 
+                                                                                !! value is used to linearize the ba~height
+                                                                                !! relationship 
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                     :: Cl                     !! Individual plant, leaf compartment
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                     :: Cr                     !! Individual plant, root compartment
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                     :: Cs                     !! Individual plant, sapwood compartment
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                     :: Ch                     !! Individual plant, heartwood compartment
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                     :: Cl_inc                 !! Individual plant increase in leaf 
+                                                                                !! compartment
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(ncirc)                     :: Cr_inc                 !! Individual plant increase in root
+                                                                                !! compartment
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(ncirc)                     :: Cs_inc                 !! Individual plant increase in sapwood
+                                                                                !! compartment
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(ncirc)                     :: Cf_inc                 !! Individual plant increase in fruit
+                                                                                !! compartment
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                     :: Cl_incp                !! Phenology related individual plant 
+                                                                                !! increase in leaf compartment
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                     :: Cr_incp                !! Phenology related individual plant 
+                                                                                !! increase in leaf compartment
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                     :: Cs_incp                !! Phenology related individual plant 
+                                                                                !! increase in sapwood compartment
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                     :: Cl_target              !! Individual plant maximum leaf mass given 
+                                                                                !! its current sapwood mass
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                     :: Cr_target              !! Individual plant maximum root mass given 
+                                                                                !! its current sapwood mass
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                     :: Cs_target              !! Individual plant maximum sapwood mass 
+                                                                                !! given its current leaf mass or root mass
+                                                                                !! @tex $(gC.plant^{-1})$ @endtex     
+    REAL(r_std), DIMENSION(ncirc)                     :: delta_ba               !! Change in basal area for a unit
+                                                                                !! investment into sapwood mass (m)
+    REAL(r_std), DIMENSION(ncirc)                     :: delta_height           !! Change in height for a unit
+                                                                                !! investment into sapwood mass (m)
+    REAL(r_std), DIMENSION(ncirc)                     :: circ_class_ba          !! Basal area (forestry definition) of the model 
+                                                                                !! tree in each circ class 
+                                                                                !! @tex $(m^{2} m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(ncirc)                     :: circ_class_ba_eff      !! Effective basal area of the model tree in each
+                                                                                !! circ class @tex $(m^{2} m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(ncirc)                     :: circ_class_dba         !! Share of an individual tree in delta_ba
+                                                                                !! thus, circ_class_dba*gammas = delta_ba
+    REAL(r_std), DIMENSION(ncirc)                     :: circ_class_height_eff  !! Effective tree height calculated from allometric 
+                                                                                !! relationships (m)
+    REAL(r_std), DIMENSION(ncirc)                     :: circ_class_circ_eff    !! Effective circumference of individual trees (m)
+    REAL(r_std)                                       :: woody_biomass          !! Woody biomass. Temporary variable to 
+                                                                                !! calculate wood volume (gC m-2)
+    REAL(r_std), DIMENSION(ncirc)                     :: share_ncirc            !! Temporary variable to store the share
+                                                                                !! of biomass of each circumference class
+                                                                                !! to the total biomass
+    REAL(r_std)                                       :: temp_share             !! Temporary variable to store the share
+                                                                                !! of biomass of each circumference class
+                                                                                !! to the total biomass        
+    REAL(r_std)                                       :: temp_class_biomass     !! Biomass across parts for a single circ
+                                                                                !! class @tex $(gC m^{-2})$ @endtex
+    REAL(r_std)                                       :: temp_total_biomass     !! Biomass across parts and circ classes
+                                                                                !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)            :: store_delta_ba         !! Store delta_ba in this variable before writing
+                                                                                !! to the output file (m). Adding this variable
+                                                                                !! was faster than changing the dimensions
+                                                                                !! of delta_ba which would have been the same
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)            :: store_circ_class_ba    !! Store circ_class_ba in this variable before
+                                                                                !! writing to the output file (m). Adding this
+                                                                                !! variable was faster than changing the 
+                                                                                !! dimensions of circ_class_ba_ba which would 
+                                                                                !! have been the same
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)            :: sum_delta_ba           !! Temporary value for calculating tree-ring width
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)            :: ring_width             !! Increase of radius of trunk. Calculated using
+                                                                                !! store_delta_ba which is always positive
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)            :: circ_height            !! Height of trees per diameter class
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements):: check_intern           !! Contains the components of the internal
+                                                                                !! mass balance chech for this routine
+                                                                                !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)        :: closure_intern         !! Check closure of internal mass balance
+                                                                                !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)        :: pool_start, pool_end   !! Start and end pool of this routine 
+                                                                                !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std)                                       :: median_circ            !! Median circumference (m)
+    REAL(r_std)                                       :: deficit                !! Carbon that needs to be respired in 
+                                                                                !! excess of todays gpp  
+                                                                                !! @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std)                                       :: excess                 !! Carbon that needs to be re-allocated
+                                                                                !! after the needs of the reserve and 
+                                                                                !! labile pool are satisfied  
+                                                                                !! @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std)                                       :: shortage               !! Shortage in the reserves that needs to 
+                                                                                !! be re-allocated after to minimise the
+                                                                                !! tension between required and available
+                                                                                !! reserves
+                                                                                !! @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    INTEGER                                           :: i,tempi
+
+!   (temp variables for impose intraseasonal LAI dynamic)   
+
+    INTEGER                                           :: month_id               !! index of month 
+    REAL(r_std)                                       :: ratio_move             !! temperal variable to move the allocatable carbon
+                                                                                !! from leaf to sapwood
+    REAL(r_std), DIMENSION(13)                        :: lai_scale              !! monthly lai scaling facter    
+    REAL(r_std)                                       :: daily_lai              !! Daily LAI value interpolated by impose lai & lai_scale 
+    CHARACTER(len=256)                                :: temp_text              !! dummy text variable exchange
+
+    ! Nitrogen cycle 
+    REAL(r_std), DIMENSION(npts,nvm)                  :: n_alloc_tot            !! nitrogen growth (gN/m2/dt) 
+    REAL(r_std) , DIMENSION(npts,nvm)                 :: cn_leaf                !! nitrogen concentration in leaves (gC/gN) 
+    REAL(r_std) , DIMENSION(npts,nvm)                 :: transloc               !! Transloc variables 
+    REAL(r_std), DIMENSION(npts)                      :: alloc_c,alloc_d,alloc_e                  !! allocation coefficients of nitrogen to leaves, roots and wood 
+    REAL(r_std), DIMENSION(npts)                      :: sum_sap,sum_oth        !! carbon growth of wood and root+fruits (gC/m2) 
+    REAL(r_std)                                       :: costf                  !! nitrogen cost of a unit carbon growth given current C partitioning and nitrogen concentration 
+    REAL(r_std)                                       :: deltacn,deltacnmax     !! (maximum) change in leaf nitrogen concentration 
+    REAL(r_std)                                       :: n_avail                !! nitrogen available for growth (dummy) 
+    REAL(r_std)                                       :: bm_supply_n            !! carbon growth sustainable by n_avail, considering costf 
+    ! Functional allocation scheme
+    ! water stress factor, based on water potential gradient in plant relative to max
+!!$    REAL(r_std), DIMENSION(npts,nvm)                  :: wstress_fac
+    CHARACTER(LEN=2), DIMENSION(nelements)            :: element_str            !! string suffix indicating element 
+    REAL(r_std)                                       :: frac_growthresp_dyn    !! Fraction of gpp used for growth respiration (-)
+                                                                                !! considers the special case at the leaf onset : frac_growthresp_dyn=0
+    REAL(r_std), DIMENSION(npts,nvm)                  :: veget_cov_max_begin        !! temporary storage of veget_cov_max to check area conservation
+    REAL(r_std), DIMENSION(npts,nvm)                  :: temp
+    REAL(r_std), DIMENSION(ncirc)                     :: ba1                    !! for calculating basal area after phenological
+    REAL(r_std), DIMENSION(ncirc)                     :: ba2                    !! growth
+    REAL(r_std), DIMENSION(ncirc,nparts)              :: temp_mass              !! same with ba1, ba2
+
+!_ ================================================================================================================================
+
+    IF (printlev.GE.2) WRITE(numout,*) 'Entering functional allocation growth'
+
+!! 1. Initialize
+
+    !! 1.1 First call only
+    IF ( firstcall ) THEN
+      
+       firstcall = .FALSE.
+
+    ENDIF ! first call
+
+    !! 1.2 Initialize local printlev
+    !printlev_loc=get_printlev('growth')
+
+    !! 1.3 Initialize variables at every call
+    bm_alloc(:,:,:,:) = zero 
+    n_alloc_tot(:,:) = zero 
+    qm_height(:,:) = zero
+    delta_ba = zero
+    lai_target(:,:) = zero
+    resp_maint(:,:) = zero
+    resp_growth(:,:) = zero
+    lstress_fac(:,:) = zero
+    sigma(:,:) = zero
+    gammas(:,:) = zero
+    bm_alloc_tot(:,:) = zero
+    k_latosa(:,:) = zero
+    store_circ_class_ba(:,:,:) = zero
+    store_delta_ba(:,:,:) = zero
+    check_intern(:,:,:,:) = zero
+    excess = zero
+    residual(:,:) = zero
+    residual_write(:,:) = zero
+    reserve_pool_write(:,:) = zero
+    labile_pool_write(:,:) = zero 
+
+    ! Allow plants to fully cover next year's roots in their reserves
+    root_reserve(:)           = 1.0
+
+    ! If npp is not initialized, bare soil value is never set.
+    npp(:,:) = zero 
+
+    ! bare soil never gets set here
+    lab_fac(:,1) = zero
+
+    !! 1.4 Initialize check for mass balance closure
+    !  The mass balance is calculated at the end of this routine
+    !  in section 8
+    IF (err_act.GT.1) THEN
+
+       check_intern(:,:,:,:) = zero
+       pool_start = zero
+       DO iele = 1,nelements
+
+          ! atm_to_bm has as intent inout, the variable 
+          ! accumulates carbon over the course of a day. 
+          ! Use the difference between start and the end of 
+          ! this routine
+          check_intern(:,:,iatm2land,iele) = - un * &
+               atm_to_bm(:,:,iele) * veget_cov_max(:,:) * dt
+
+          DO ipar = 1,nparts
+             DO icir = 1,ncirc
+                ! Initial biomass pool
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                     (circ_class_biomass(:,:,icir,ipar,iele) * &
+                     circ_class_n(:,:,icir) * veget_cov_max(:,:))
+             ENDDO
+          ENDDO
+       
+       ENDDO      
+ 
+       !! 1.5 Initialize check for surface area conservation
+       !  Veget_max is a INTENT(in) variable and can therefore
+       !  not be changed during the course of this subroutine
+       !  Check it anyway, in case the intent get changed.
+       veget_cov_max_begin(:,:) = veget_cov_max(:,:)
+
+    ENDIF ! err_act.GT.1
+
+    !! 1.6 Calculate LAI threshold below which carbohydrate reserve is used.
+    !  Lai_max is a PFT-dependent parameter specified in stomate_constants.f90
+    ! +++CHECK+++
+    ! Can we make this a function of Cs or rue_longterm? this double prescribed 
+    ! value does not make too much sense to me. It is not really dynamic.
+    lai_happy(:) = lai_max(:) * lai_max_to_happy(:)
+    ! +++++++++++
+   
+    !! 1.7 Store the biomass pools at the beginning of allocation
+    !  These values will be used to calculate the increment in each pool
+    !  at the end of the code. tmp_init_bm should be changed, updated,
+    !  or overwritten in this subroutine
+    tmp_init_bm(:,:,:,:) = cc_to_biomass(npts,nvm,&
+         circ_class_biomass(:,:,:,:,:),&
+         circ_class_n(:,:,:))
+
+    !! 1.8 Calculate C/N ratio of the leaves 
+    !  Nitrogen concentration in leaves as CN. First calculate biomass at the 
+    !  stand level as that seems quicker than doing these calculations on
+    ! circ_class_biomass.
+    tmp_bm = tmp_init_bm
+    WHERE( tmp_bm(:,:,ileaf,initrogen).GT.min_stomate )
+
+       ! Calculate the C:N ratio
+       cn_leaf(:,:)=tmp_bm(:,:,ileaf,icarbon)/tmp_bm(:,:,ileaf,initrogen) 
+
+    ELSEWHERE
+ 
+       ! Prescribe the C:N ratio
+       cn_leaf(:,:)=cn_leaf_min_season(:,:) 
+
+    ENDWHERE
+
+   !! 1.8 Save old leaf mass
+    !  biomass got last updated in stomate_phenology.f90
+    lm_old(:,:)=SUM(circ_class_biomass(:,:,:,ileaf,icarbon)*&
+         circ_class_n(:,:,:),3)
+
+    !! 1.9 Lai for bare soil is by definition zero
+    lai(:,ibare_sechiba) = zero
+
+
+    !! 2. Use carbohydrate reserve to support growth
+
+    DO j = 2, nvm ! Loop over # PFTs 
+
+       !! 2.1 Calculate demand for carbohydrate reserve to support leaf and root growth.
+       !  Maximum time (days) since start of the growing season during which carbohydrate 
+       !  may be used
+       IF ( is_tree(j) ) THEN
+
+          reserve_time = reserve_time_tree    
+
+       ELSE
+
+          reserve_time = reserve_time_grass
+
+       ENDIF
+
+       !! 2.2 Calculate lai and c0_alloc
+       !  The current functions require a loop over npts
+       !  Calculate lai
+
+       DO ipts = 1,npts
+ 
+          lai(ipts,j) = cc_to_lai(circ_class_biomass(ipts,j,:,ileaf,icarbon),&
+               circ_class_n(ipts,j,:),j)
+
+          ! We might need the c0_alloc factor, so let's calculate it.
+          c0_alloc(ipts,j) = calculate_c0_alloc(ipts, j, tau_eff_root(ipts,j), &
+               tau_eff_sap(ipts,j))
+       ENDDO
+
+       !! 2.3 Can the carbohydrate reserves be used?
+       ! 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 ( ( SUM(circ_class_biomass(:,j,:,ileaf,icarbon),2) .GT. min_stomate ) .AND. & 
+             ( plant_status(:,j) .EQ. ibudbreak .OR. &
+             plant_status(:,j) .EQ. icanopy ).AND. &
+             ( lai(:,j) .LT. lai_happy(j) ) .AND. &
+             ( when_growthinit(:,j) .LT. reserve_time ) )
+           ! Tell the labile and resource pool to use its reserve
+             use_reserve(:,j) = 1.0
+
+        ENDWHERE
+
+    ENDDO ! loop over # PFTs
+
+
+ !! 3. Initialize allocation
+
+    DO j = 2, nvm ! Loop over # PFTs 
+       
+       !! 3.1 Calculate scaling factors, temperature sensitivity, target 
+       !  lai to decide on reserve use, labile fraction, labile biomass 
+       !  and total allocatable biomass. Convert long term temperature 
+       !  from K to C
+       tl(:) = t2m(:) - ZeroCelsius
+
+       DO ipts = 1, npts
+
+          IF (veget_cov_max(ipts,j) .LE. min_stomate .OR. &
+               SUM(circ_class_n(ipts,j,:)) .LE. min_stomate) THEN
+
+              ! this vegetation type is not present, so no reason to do the 
+              ! calculation. CYCLE will take us out of the innermost DO loop
+               CYCLE
+
+          ENDIF
+
+          !! 3.1 Water stress
+          !  The waterstress factor varies between 0.1 and 1 and is calculated
+          !  from ::moiavail_growingseason. The latter is only used in the allometric 
+          !  allocation and its time integral is determined by tau_sap for trees
+          !  (see constantes_mtc.f90 for tau_sap and see pft_constantes.f90 for 
+          !  the definition of tau_hum_growingseason). The time integral for 
+          !  grasses and crops is a prescribed constant (see constantes.f90). For
+          !  trees KF (and indirecrtly LF) and for grasses LF are multiplied
+          !  by wstress. Because the calculated values are too low for its purpose
+          !  Sonke Zhaele multiply it by two in the N-branch (see stomate_season.f90). 
+          !  This approach maintains the physiological basis of KF while combining it 
+          !  with a simple multiplicative factor for water stress. Clearly after 
+          !  multiplication with 2, wstress is closer to 1 and will thus result in a 
+          !  KF values closer to the physiologically expected KF. We did not see the 
+          !  need to multiply by 2 because the way we now calculate ::moiavail_growingseason
+          !  is less volatile than before. Before it ranged between 0 and 1, now the 
+          !  range is more like 0.4 to 0.9.
+
+          ! Veget is now calculated from Pgap to be fully consistent within the model. Hence
+          ! dividing by veget_cov_max gives a value between 0 and 1 that denotes the amount of 
+          ! light reaching the forest floor.
+          IF (veget_cov_max(ipts,j) .GT. min_stomate) THEN
+
+             lstress_fac(ipts,j) = un - (veget_cov(ipts,j) / veget_cov_max(ipts,j))
+             
+             ! +++CHECK+++
+             ! This is not rocket science so there are a couple
+             ! of alternative functions. Some of these functions
+             ! try to account for the gaps in the canopy which  has
+             ! already been taken care of in Pgap and is reflected
+             ! in the ORCHIDEE-CAN way of calculating ::veget. I did
+             ! follow these changes.
+             ! Alternative 1
+             ! lstress_fac(ipts,j) = (un - (veget_cov(ipts,j) / veget_cov_max(ipts,j)))**(0.5)
+             ! Alternative 2
+             ! lai_temp=-LOG(1-veget_cov(ipts,j))/0.5
+             ! veget_temp=1-exp(-0.5*(lai_temp**1.5))
+             ! lstress_fac(ipts,j) = (un - (veget_temp ))**(0.3)
+             ! Alternative 3
+             ! veget_temp=1-exp(-0.5*(lai_temp**3.0))
+             ! lstress_fac(ipts,j) = (un - (veget_temp ))**(0.05)
+             ! ++++++++++
+
+          ELSE
+
+             lstress_fac(ipts,j) = zero
+
+          ENDIF
+
+          !! 3.2 Initialize scaling factors
+          ! Stand level scaling factors
+          LF(ipts,j) = 1._r_std
+
+          ! Tree level scaling factors
+          ltor(ipts,j) = 1._r_std
+          circ_class_height_eff(:) = 1._r_std
+
+
+          !! 3.3 Calculate structural characteristics
+          !  Target lai is calculated at the stand level for the tree 
+          !  height of a virtual tree with the mean basal area or the 
+          !  so called quadratic mean diameter
+          qm_dia(ipts,j) = &
+               wood_to_qmdia(circ_class_biomass(ipts,j,:,:,icarbon), &
+               circ_class_n(ipts,j,:), j)
+          qm_height(ipts,j) = &
+               wood_to_qmheight(circ_class_biomass(ipts,j,:,:,icarbon), &
+               circ_class_n(ipts,j,:), j)
+
+          !! 3.4 Calculate allocation factors for trees and grasses 
+          IF ( SUM(SUM(circ_class_biomass(ipts,j,:,:,icarbon),1)) .GT. min_stomate ) THEN
+
+             ! Trees
+             IF (is_tree(j)) THEN
+
+                ! Note that KF may already be calculated in stomate_prescribe.f90 (if called)
+                ! it is recalculated because the biomass pools for grasses and crops
+                ! may have been changed in stomate_phenology.f90. Trees were added to this
+                ! calculation just to be consistent.
+                
+                ! To be fully consistent with the hydraulic limitations and pipe theory,
+                ! k_latosa_zero should be calculated from equation (18) in Magnani et al.
+                ! To do so, total hydraulic resistance and tree height need to known. This
+                ! poses a problem as the resistance depends on the leaf area and the leaf 
+                ! area on the resistance. There is no independent equation and equations 12
+                ! and 18 depend on each other and substitution would be circular. Hence 
+                ! prescribed k_latosa_zero values were obtained from observational records 
+                ! and are given in mtc_parameters.f90.
+
+                ! The relationship between height and k_latosa as reported in McDowell 
+                ! et al 2002 and Novick et al 2009 is implemented to adjust k_latosa for 
+                ! the height of the stand.  The slope of the relationship is calculated in 
+                ! stomate_data.f90 This did NOT result in a realistic model behavior.
+                !!$ k_latosa(ipts,j) = wstress_fac(ipts,j) * & 
+                !!$     (k_latosa_max(j) - latosa_height(j) * qm_height(ipts,j))
+
+                ! Alternatively, k_latosa is also reported to be a function of diameter 
+                ! (i.e. stand thinning, Simonin et al 2006, Tree Physiology, 26:493-503).
+                ! Here the relationship with thinning was interpreted as a realtionship with
+                ! light stress.
+
+                ! +++CHECK+++
+                ! How dow we want to account for waterstress?
+                !!$ k_latosa(ipts,j) = k_latosa_min(j) + (wstress_fac(ipts,j) * &
+                !!$     lstress_fac(ipts,j) * &
+                !!$     (k_latosa_max(j)-k_latosa_min(j)))
+                !!$ k_latosa(ipts,j) = wstress_fac(ipts,j) * (k_latosa_min(j) + &
+                !!$     (lstress_fac(ipts,j) * &
+                !!$     (k_latosa_max(j)-k_latosa_min(j))))
+                ! +++++++++++
+                k_latosa(ipts,j) = (k_latosa_adapt(ipts,j) + &
+                     (lstress_fac(ipts,j) * &
+                     (k_latosa_max(j)-k_latosa_min(j))))
+                ! +++++++++++
+
+                ! Also k_latosa has been reported to be a function of CO2 concentration 
+                ! (Atwell et al. 2003, Tree Physiology, 23:13-21 and Pakati et al. 2000, 
+                ! Global Change Biology, 6:889-897). This effect is not accounted for in 
+                ! the current code
+
+                ! Scaling factor to convert sapwood mass into leaf mass (KF)
+                ! derived from
+                ! LA_ind = k1 * SA_ind, k1=latosa (pipe-model)
+                ! <=> Cl * vm/ind * sla = k1 * Cs * vm/ind / wooddens / tree_ff / height_new
+                ! <=> Cl = Cs * k1 / wooddens / tree_ff/ height_new /sla
+                ! <=> Cl = Cs * KF / height_new, where KF = k1 / (wooddens * sla * tree_ff)
+                ! (1) Cl = Cs * KF / height_new
+                KF_old = KF(ipts,j) 
+                KF(ipts,j) = k_latosa(ipts,j) / &
+                     (sla(j) * pipe_density(j) * tree_ff(j))
+
+                ! KF of the previous time step was stored in ::KF_old to check its absolute 
+                ! change. If this absolute change is too big the whole allocation will crash
+                ! because it will calculate negative increments which are compensated by 
+                ! positive increments that exceed the available carbon for allocation. This 
+                ! would suggest that for example the plant destroys leaves and uses the 
+                ! available carbon to produce more roots. This would represent an unwanted 
+                ! outcome. Large changes from one time step to another makes it difficult for 
+                ! the scheme to ever reach allometric balance. This balance is needed for the
+                ! allocation scheme to allow 'ordinary allocation', which in turn is needed
+                ! to make use of the allocation rule of Dhote and Deleuze. It needs to be 
+                ! avoided that the code spends too much time in phenological growth and the 
+                ! if-then statements that help to restore allometric balance. For this reason
+                ! the absolute changes in KF from one time step to another are truncated.
+                IF (KF_old - KF(ipts,j) .GT. max_delta_KF ) THEN
+        
+                   IF(printlev_loc>=4)THEN
+                      WRITE(numout,*) 'WARNING 2: KF was truncated'
+                      WRITE(numout,*) 'WARNING 2: PFT, ipts: ',j,ipts
+                      WRITE(numout,'(A,3F20.10)') 'WARNING 2: KF_old, KF(ipts,j), '//&
+                           'max_delta_KF: ', KF_old, KF(ipts,j), max_delta_KF
+                   ENDIF
+
+                   ! Add maximum absolute change
+                   KF(ipts,j) = KF_old - max_delta_KF
+                   
+                   IF(printlev_loc>=4)THEN
+                      WRITE(numout,'(A,3F20.10)') 'WARNING 2: Reset, KF_old, KF(ipts,j): ',&
+                           KF_old, KF(ipts,j)
+                   ENDIF
+
+                ELSEIF (KF_old - KF(ipts,j) .LT. -max_delta_KF) THEN
+                   
+                   IF(printlev_loc>=4)THEN
+                      WRITE(numout,*) 'WARNING 3: KF was truncated'
+                      WRITE(numout,*) 'WARNING 3: PFT, ipts: ',j,ipts
+                      WRITE(numout,'(A,3F20.10)') 'WARNING 3: KF_old, KF(ipts,j), '//&
+                           'max_delta_KF: ', KF_old, KF(ipts,j), -max_delta_KF
+                   ENDIF
+
+                   ! Remove maximum absolute change
+                   KF(ipts,j) = KF_old + max_delta_KF
+                   
+                   IF(printlev_loc>=4)THEN
+                      WRITE(numout,'(A,3F20.10)') 'WARNING 3: Reset, KF_old, KF(ipts,j): ',&
+                        KF_old, KF(ipts,j)
+                   ENDIF
+
+                ELSE
+
+                   ! The change in KF is acceptable no action required
+
+                ENDIF
+    
+                ! Scaling factor to convert sapwood mass into root mass  (LF) 
+                ! derived from 
+                ! Cs = c0 * height * Cr (Magnani 2000)
+                ! Cr = Cs / c0 / height_new
+                ! scaling parameter between leaf and root mass, derived from
+                ! Cr = Cs / c0 / height_new
+                ! let Cs = Cl / KF * height_new
+                ! <=> Cr = ( Cl * height_new / KF ) / ( c0 * height_new )
+                ! <=> Cl = Cr * KF * c0
+                ! <=> Cl = Cr * LF, where LF = KF * c0
+                ! (2) Cl = Cr * LF
+
+                ! +++CHECK+++
+                ! How do we want to account for waterstress? wstress is accounted 
+                ! for in c0_alloc
+                LF(ipts,j) = c0_alloc(ipts,j) * KF(ipts,j) 
+                !!$ LF(ipts,j) = c0_alloc(ipts,j) * KF(ipts,j) * wstress_fac(ipts,j)
+                ! +++++++++++
+
+                ! Calculate non-nitrogen stressed leaf to root ratio to calculate the
+                ! allocation to the reserves. Should be multiplied by a nitrogen stress
+                ! have a look in OCN. This code should be considered as a placeholder
+                ltor(ipts,j) = c0_alloc(ipts,j) * KF(ipts,j)
+
+                ! Debug
+                IF (j.EQ.test_pft .AND. printlev_loc.GE.4 .AND. ipts == test_grid) THEN
+                   WRITE(numout,*) 'KF, LF, ', KF(ipts,j), LF(ipts,j)
+                   WRITE(numout,*) 'c0_alloc, ', c0_alloc(ipts,j)
+                   WRITE(numout,*) 'tau_root, tau_sap, ', tau_eff_root(ipts,j), &
+                        tau_eff_sap(ipts,j)
+                   WRITE(numout,*) 'k_root, k_sap, ', k_root(j), k_sap(j)
+                   WRITE(numout,*) 'ltor, ', ltor(ipts,j)
+                ENDIF
+                !-
+
+             ! Grasses and crops
+             ELSEIF (.NOT. is_tree(j)) THEN
+                
+                !+++CHECK+++
+                ! Similar to ::k_latosa for trees we defined it for grasses. Note 
+                ! that for trees the definition is supported by some observations. 
+                ! For grasses we didn't try very hard to check the literature. 
+                ! Someone interested in grasses should invest some time in this 
+                ! issue and replace this code by a parameter that can be derived
+                ! from observations. In the end it was decided to use the same 
+                ! variable name for grasses, crops and trees as that allowed us 
+                ! to optimize this parameter.
+                k_latosa(ipts,j) = (k_latosa_adapt(ipts,j) + (lstress_fac(ipts,j) * &
+                     (k_latosa_max(j)-k_latosa_min(j))))
+
+                ! The mass of the structural carbon relates to the mass of the leaves 
+                ! through a prescribed parameter ::k_latosa
+                KF(ipts,j) = k_latosa(ipts,j) 
+                !++++++++++
+               
+                ! Stressed root allocation, wstress is accounted for in c0_alloc  
+                LF(ipts,j) = c0_alloc(ipts,j) * KF(ipts,j)
+        
+                ! Calculate non-nitrogen stressed leaf to root ratio to calculate the
+                ! allocation to the reserves 
+                ltor(ipts,j) = c0_alloc(ipts,j) * KF(ipts,j)
+
+                ! Debug
+                IF (j.EQ.test_pft .AND. printlev_loc.GE.4 .AND. ipts == test_grid) THEN
+                   WRITE(numout,*) 'KF, LF, ', KF(ipts,j), LF(ipts,j)
+                   WRITE(numout,*) 'c0_alloc, ', c0_alloc(ipts,j)
+                   WRITE(numout,*) 'tau_root, tau_sap, ', tau_eff_root(ipts,j), &
+                        tau_eff_sap(ipts,j)
+                   WRITE(numout,*) 'k_root, k_sap, ', k_root(j), k_sap(j)
+                   WRITE(numout,*) 'ltor, ', ltor(ipts,j)
+                   
+                ENDIF
+                !-
+
+             ENDIF ! grasses and crops
+
+          ENDIF ! SUM(circ_class_biomass) .gt. zero
+
+          !+++CHECK+++
+          !! 3.5 Calculate optimal LAI
+          !  The calculation of the optimal LAI was copied and adjusted from O-CN. 
+          !  In O-CN it was also used in the allocation but that seems to be 
+          !  inconsistent with the allometric rules that are implemented. Say that 
+          !  the actual LAI is below the optimal LAI. Then the O-CN approach will 
+          !  keep pumping carbon to grow the optimal LAI. If we would apply
+          !  the same method it means that during this phase the rule of Deleuze 
+          !  and Dhote would not be used. For that reason we dropped the use of 
+          !  LAI_optimal and replaced it by an allometric-based Cl_target value. 
+          !  Initially, lai_target was still calculated as described below and used 
+          !  in the calculation of the reserves. Further testing showed that for 
+          !  some parameter sets lai_target was over 8 whereas the realized lai was 
+          !  close to 4. This leaves us with a frustrated plant that will invest a
+          !  lot in its reserves but can never use them because it is constrained by 
+          !  the allometric rules. To grow an LAI of 8 it would need to have a crazy 
+          !  sapwoodmass. At a more fundamental level it is clear why the plant's 
+          !  LAI should not exceed lai_target because then it costs more to produce 
+          !  and maintain the leaf than what the new leaf can produce but there is no 
+          !  reason why the plant should try to reach lai_target. For these
+          !  reasons it was decided to abandon this approach to lai_target and simply 
+          !  replace lai_target by Cl_target * sla
+
+          !! 3.5.1 Scaling factor
+          !  Scaling factor to convert variables to the individual plant
+          !  Different approach between the DGVM and statitic approach
+          IF (ok_dgvm) THEN
+
+             ! The DGVM does currently NOT work with the new allocation, consider this as
+             ! placeholder. The original code had two different transformations to 
+             ! calculate the scalars. Both could be used but the units will differ.
+             ! When fixing the DGVM check which quantities need to be multiplied by scal 
+             ! scal = ind(ipts,j) * cn_ind(ipts,j) / veget_cov_max(ipts,j)
+             scal(ipts,j) = veget_cov_max(ipts,j) / SUM(circ_class_n(ipts,j,:)) 
+ 
+          ELSE
+
+             ! circ_class_biomass contain the data at the tree level
+             ! no conversion required
+             scal(ipts,j) = 1.
+
+          ENDIF
+
+          !! 3.5.2 Calculate lai_target based on the allometric rules
+          IF ( SUM(SUM(circ_class_biomass(ipts,j,:,:,icarbon),1)) .GT. min_stomate ) THEN
+             
+             IF ( is_tree(j)) THEN
+
+                ! Basal area at the tree level (m2 tree-1)
+                circ_class_ba_eff(:) = wood_to_ba_eff(circ_class_biomass(ipts,j,:,:,icarbon),j)
+
+                ! Current biomass pools per tree (gC tree^-1) 
+                ! We will have different trees so this has to be calculated from the 
+                ! diameter relationships            
+                Cs(:) = ( circ_class_biomass(ipts,j,:,isapabove,icarbon) + &
+                     circ_class_biomass(ipts,j,:,isapbelow,icarbon) ) * scal(ipts,j)
+                Cr(:) = circ_class_biomass(ipts,j,:,iroot,icarbon) * scal(ipts,j)
+                Cl(:) = circ_class_biomass(ipts,j,:,ileaf,icarbon) * scal(ipts,j)
+                Ch(:) = ( circ_class_biomass(ipts,j,:,iheartabove,icarbon) + &
+                     circ_class_biomass(ipts,j,:,iheartbelow,icarbon) ) * scal(ipts,j)
+
+                DO l = 1,ncirc 
+
+                   !  Calculate tree height
+                   circ_class_height_eff(l) = pipe_tune2(j)*(4/pi*circ_class_ba_eff(l))**&
+                        (pipe_tune3(j)/2)
+
+                   ! Debug
+                   IF(printlev>=4)THEN
+                      WRITE(numout,*) 'circ_class_height, ',circ_class_height_eff(l)
+                      WRITE(numout,*) 'KF, ',  KF(ipts,j)
+                   ENDIF
+                   !-
+
+                   !  Do the biomass pools respect the pipe model?
+                   !  Do the current leaf, sapwood and root components respect the allometric 
+                   !  constraints? Due to plant phenology it is possible that we have too much 
+                   !  sapwood compared to the leaf and root mass (i.e. in early spring). 
+                   !  Calculate the optimal root and leaf mass, given the current wood mass 
+                   !  by using the basic allometric relationships. Calculate the optimal sapwood
+                   !  mass as a function of the current leaf and root mass.
+                   Cl_target(l) = MAX( KF(ipts,j) * Cs(l) / circ_class_height_eff(l), &
+                        Cr(l) * LF(ipts,j) , Cl(l))
+                   Cs_target(l) = MAX( Cl(l) / KF(ipts,j) * circ_class_height_eff(l), &
+                        Cr(l) * LF(ipts,j) / KF(ipts,j) * circ_class_height_eff(l) , Cs(l))
+
+                   ! Check dimensions of the trees
+                   ! If Cs = Cs_target then ba and height are correct, else calculate the 
+                   ! correct dimensions
+
+                   IF ( Cs_target(l) - Cs(l) .GT. min_stomate ) THEN
+
+                      ! If Cs = Cs_target then dia and height are correct. However, if 
+                      ! Cl = Cl_target or Cr = Cr_target then dia and height need to be 
+                      ! re-estimated. Cs_target should satify the relationship 
+                      ! Cl/Cs = KF/height where height is a function of Cs_target
+                      ! Search Cs needed to sustain the max of Cl or Cr.
+                      ! Search max of Cl and Cr first
+                      !
+                      ! [UPDATE] After the code passes through turnover or mortality
+                      ! we may end up in a situation where we have lost more
+                      ! sapwood than leaves and roots (i.e. sapwood turnover).
+                      ! The model would then suggest that at time=t+1 the tree
+                      ! should be smaller than at time=t0.  From a physiological
+                      ! standpoint this is not possible for the heartwood. If
+                      ! we now calculate Cs_target on the basis of the actual Cl
+                      ! or Cr, we find that Cs_target > Cs. The first priority
+                      ! of the allocation scheme will be to allocate C to Cs.
+                      ! Because we don't know yet whether the actual Cr or Cl is
+                      ! what drives the need to allocate to Cs, we calculate
+                      ! Cl_target first. 
+                      Cl_target(l) = MAX(Cl(l), Cr(l)*LF(ipts,j))
+
+                      ! Debug
+                      IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                         WRITE(numout,*) 'Does the tree need reshaping? Class: ',l
+                         WRITE(numout,*) 'circ_class_height_eff, ', circ_class_height_eff(l)
+                         WRITE(numout,*) 'KF, LF, ', KF(ipts,j), LF(ipts,j)
+                         WRITE(numout,*) 'Cl_target-Cl, ', Cl_target(l)-Cl(l), Cl_target(l), Cl(l)
+                         WRITE(numout,*) 'Cs, ', Cs(l)
+                         WRITE(numout,*) 'Cr, ', Cr(l)
+                         WRITE(numout,*) 'Ch, ', Ch(l)
+                      ENDIF
+                      !-
+
+                      ! We now have the Cl_target that we will use to calculate
+                      ! Cs_target. Given the allometric relationships we can
+                      ! calculate Cs_target as Cl_target*height/KF. 
+                      ! height is a function of ba, which in turn is a function 
+                      ! of woodmass (Woodmass = Cs+Ch (sapwood+heartwood) ). We 
+                      ! therefore substitute the following equations into one 
+                      ! another:
+                      !
+                      ! (1) Cs_target = Cl_target*height/KF
+                      ! (2) height = as a function of ba
+                      ! (3) ba = as a function of woodmass_ind
+                      !
+                      ! This gives:
+                      !
+                      ! (4) Cl_target = (KF*Cs_target)/(pipe_tune2*(Cs_target+Ch)/ &
+                      !                 & pi/4)**(pipe_tune3/(2+pipe_tune3))
+                      !
+                      ! The function newX searches for the value for Cs_target
+                      ! that satisfies this equation (4).
+                      Cs_target(l) =  newX(KF(ipts,j), Ch(l),&
+                           & pipe_tune2(j), pipe_tune3(j), Cl_target(l),&
+                           & tree_ff(j)*pipe_density(j)*pi/4*pipe_tune2(j), Cs(l),&
+                           & 2*Cs(l), 2, j, ipts)
+
+                      ! Recalculate height and ba from the correct
+                      ! Cs_target
+                      circ_class_height_eff(l) = Cs_target(l)*KF(ipts,j)&
+                           &/Cl_target(l)
+                      circ_class_ba_eff(l) = pi/4*(circ_class_height_eff(l)&
+                           &/pipe_tune2(j))**(2/pipe_tune3(j))
+                      Cl_target(l) = KF(ipts,j) * Cs_target(l) /&
+                           & circ_class_height_eff(l)
+                      Cr_target(l) = Cl_target(l) / LF(ipts,j)
+
+                      ! Debug
+                      IF (printlev_loc.GE.4 .AND. j .EQ. test_pft) THEN
+                         WRITE(numout,*) 'New Cl_target, ', Cl_target(l)
+                         WRITE(numout,*) 'New Cs_target, ', Cs_target(l)
+                         WRITE(numout,*) 'New Cr_target, ', Cr_target(l)       
+                      ENDIF
+                      !- 
+
+                   ENDIF
+
+                ENDDO
+
+                ! Calculate lai_target
+                lai_target(ipts,j) = cc_to_lai(Cl_target(:),circ_class_n(ipts,j,:),j)
+
+             ELSEIF ( .NOT. is_tree(j)) THEN
+                
+                ! Grasses and croplands
+                ! Current biomass pools per grass/crop (gC ind^-1)
+                ! Cs has too many dimensions for grass/crops. To have a consistent 
+                ! notation the same variables are used as for trees but the dimension 
+                ! of Cs, Cl and Cr i.e. ::ncirc should be ignored            
+                Cs(1) = circ_class_biomass(ipts,j,1,isapabove,icarbon) * scal(ipts,j)
+                Cr(1) = circ_class_biomass(ipts,j,1,iroot,icarbon) * scal(ipts,j)
+                Cl(1) = circ_class_biomass(ipts,j,1,ileaf,icarbon) * scal(ipts,j)
+                Ch(1) = zero
+
+                ! Do the biomass pools respect the pipe model?
+                ! Do the current leaf, sapwood and root components respect the allometric 
+                ! constraints? Calculate the optimal root and leaf mass, given the current 
+                ! wood mass by using the basic allometric relationships. Calculate the 
+                ! optimal sapwood mass as a function of the current leaf and root mass.
+                Cl_target(1) = MAX( Cs(1) * KF(ipts,j) , Cr(1) * LF(ipts,j), Cl(1) )
+                Cs_target(1) = MAX( Cl_target(1) / KF(ipts,j), &
+                     Cr(1) * LF(ipts,j) / KF(ipts,j), Cs(1) ) 
+                Cr_target(1) = MAX( Cl_target(1) / LF(ipts,j), &
+                     Cs_target(1) * KF(ipts,j) / LF(ipts,j), Cr(1) )
+
+                ! Calculate lai_target
+                lai_target(ipts,j) = cc_to_lai(Cl_target(:),circ_class_n(ipts,j,:), j)
+
+                ! Debug
+                IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                   WRITE(numout,*) 'KF, LF, ', KF(ipts,j), LF(ipts,j)
+                ENDIF
+                !-
+
+             ENDIF
+
+          ELSE
+
+             ! circ_class_biomass is empty  
+             lai_target(ipts,j) = zero
+
+          ENDIF ! SUM(circ_class_biomass) .GT. min_stomate
+
+!!$          !! 3.5 Calculate optimum LAI 
+!!$          !  Lai is optimised for mean annual radiation use efficiency and the C costs
+!!$          !  for producing the canopy. The cost-benefit ratio is optimised when the 
+!!$          !  marginal gain / marginal cost = 1
+!!$          !  Investing 1 gC in the canopy comes at a total cost that is composed by the 
+!!$          !  C required for the canopy in addition to the roots and the sapwood to support
+!!$          !  the canopy. The total cost (C) is thus calculated as C: 
+!!$          !  LAI/sla * ( (one_year/tau_leaf) + (one_year/tau_root)/LF + & 
+!!$          !  (one_year/tau_sap)*height/KF))
+!!$          !  The marginal cost for one unit of LAI is then dC/dLAI : 
+!!$          !  (one_year/tau_leaf)/sla + (one_year/tau_root)/LF/sla + Ã©
+!!$          !  (one_year/tau_sap)*height/KF/sla)
+!!$          !  Where, tau_leaf is given by ::tau_leaf in days, tau_root by ::tau_root in
+!!$          !  days and tau_sap by ::tau_sap in days. LF is unitless, KF is expressed in meters
+!!$          !  and sla in m^2.gC^{-1}. The unit of dC/dLAI is thus gC.m^{-2} but all turnover
+!!$          !  times need to be expressed on an annual scale.  
+!!$          !  Investing 1gC in the canopy enables the plant to assimilate more carbon
+!!$          !  The gain (G) can be approximated by using the 'radiation use efficiency' as 
+!!$          !  follows: RUE * one_year ( 1. - exp (-0.5 * LAI ))
+!!$          !  Where, 0.5 is the extinction factor that accounts for the fact the lower parts 
+!!$          !  of the canopy receive less light. Note that RUE has a peculiar definition 
+!!$          !  and is calculated as the ratio of GPP over the fraction of radiation 
+!!$          !  absorbed by the canopy.
+!!$          !  Hence the unit of RUE is gC.m^{-2}.day^{-1}. The marginal gain of one 
+!!$          !  unit of LAI is dG/dLAI: 
+!!$          !  0.5 * one_year * RUE * exp (-0.5 * LAI). 
+!!$          !  Subsequently, the optimal LAI is approximated by
+!!$          !  LAI_opt = -2. * log(2*(dC/dt)/(RUE*one_year))           
+!!$          !  Added the qm_height requirement since for a grass, it had no biomass
+!!$          !  but it did have individuals.  This caused qm_height to be zero and a crash
+!!$          !  in the calculation of lai_target.
+!!$          IF ( (rue_longterm(ipts,j) .GT. min_stomate) .AND. (ind(ipts,j) .NE. zero &
+!!$               .AND. qm_height(ipts,j) .NE. 0) ) THEN
+!!$
+!!$             ! Scheme in line with the documentation
+!!$             lai_target(ipts,j) = -deux* log( (deux * (one_year/tau_leaf(j))/sla(j) + &
+!!$                  ((one_year/tau_root(j))/LF(ipts,j))/sla(j) + &
+!!$                  ((one_year/tau_sap(j))*qm_height(ipts,j)/KF(ipts,j))/sla(j)) / &
+!!$                  (rue_longterm(ipts,j)*one_year))
+!!$             lai_target(ipts,j) = MAX(MIN(lai_target(ipts,j),12.),.5)
+!!$
+!!$          ELSE
+!!$
+!!$             lai_target(ipts,j) = 0.5
+!!$
+!!$          ENDIF
+          !++++++++++
+
+          !! 3.6 Calculate mean leaf age
+          leaf_meanage = zero
+          DO m = 1,nleafages
+          
+             leaf_meanage = leaf_meanage + &
+                  leaf_age(ipts,j,m) * leaf_frac(ipts,j,m)
+          
+          ENDDO
+
+          !! 3.7 Calculate labile fraction
+          ! +++CHECK+++
+          ! When we have leaf biomass, labile fraction is found to fluctuate
+          ! between ~0.1 and ~0.15. Hence, we do not fully explore the range
+          ! 0.1-0.7 for lab_fac as suggested by the code below. However, we 
+          ! do not think this is a problem for now, as the jump from ~0.15 to
+          ! 0.7 only occurs after leaffall, so we should not have issues that
+          ! propagate into photosynthesis.
+          ! Nevertheless the different option below suggest a false level of 
+          ! confidence in what is really happening with the labile fraction.
+          ! A simpler solution could be just to use a fixed fraction of the
+          ! labile pool.
+!!$          lab_fac(ipts,j) = 0.35
+
+          ! Instead of the code with the IF-statements.
+          IF ( (SUM(circ_class_biomass(ipts,j,:,ileaf,icarbon)) .LE. min_stomate) .AND. &
+               (use_reserve(ipts,j) .GT. min_stomate) ) THEN
+
+             ! Use constant labile fraction to initiate on-set of 
+             ! leaves in spring
+             lab_fac(ipts,j) = 0.7
+ 
+          ELSEIF ( (SUM(circ_class_biomass(ipts,j,:,ileaf,icarbon)) .GT. min_stomate) .AND. & 
+               (lai_target(ipts,j) .GT. min_stomate) .AND. &
+               ( plant_status(ipts,j) .EQ. ibudbreak .OR. &
+               plant_status(ipts,j) .EQ. icanopy ) ) THEN
+
+             ! Calculate labile fraction when a canopy is present but its lai 
+             ! is below ::lai_target the labile fraction is a function of 
+             ! ::leaf_meanage, the current lai calculated as 
+             ! ::biomass(ipts,j,ileaf,icarbon)*sla(j), the ::lai_target and 
+             ! ::ecureuil. This function scales lab_fac to a value between 
+             ! 0.1 and 0.7. Its scientific basis remains unclear.
+             IF ( is_tree(j)) THEN 
+                
+                ! labile fraction for trees
+                lab_fac(ipts,j) = 0.1 + 0.6 * &
+                     MAX(0.0,1.-MAX(ecureuil(j)*leaf_meanage/45., &    
+                     (cc_to_lai(circ_class_biomass(ipts,j,:,ileaf,icarbon),&
+                     circ_class_n(ipts,j,:),j)/&
+                     lai_target(ipts,j))))
+             ELSE
+
+                ! labile fraction for grasses
+                lab_fac(ipts,j) = 0.1 + 0.6 * &
+                     MAX(0.0,1.-(ecureuil(j)*when_growthinit(ipts,j)/70.))
+
+             ENDIF
+ 
+          ELSE
+
+             ! If the canopy has reached lai_target or is senescent lab_fac = 0.1
+             lab_fac(ipts,j) = 0.1
+
+          ENDIF ! SUM(circ_class_biomass) .gt. zero and  use_reserve .gt. zero
+          !+++++++++++   
+
+          !! 3.8 Calculate allocatable carbon
+          !  Total allocatable biomass during this time step determined from GPP.
+          !  GPP was calculated as CO2 assimilation in enerbil.f90
+          !  Under some exceptional conditions :gpp could be negative when
+          !  the dark respiration exceeds the photosynthesis. When this happens
+          !  the dark respiration is paid for by the labile and carbres pools
+          !  It is bit easier to deal with this issue at the stand level because
+          !  gpp_daily, the reserve, and labile pool are calculated at the 
+          !  stand level. After making stand level calculations the updated
+          !  pools will have to be converted to the plant level.
+          !  Calculate stand level biomass
+          tmp_bm(npts,j,:,:) = cc_to_biomass(npts,j,&
+               circ_class_biomass(npts,j,:,:,:),&
+               circ_class_n(npts,j,:))
+          ! Account for dark respiration if needed
+          IF ( (tmp_bm(ipts,j,ilabile,icarbon) + &
+               gpp_daily(ipts,j) * dt) .LT. zero ) THEN
+
+             deficit = (tmp_bm(ipts,j,ilabile,icarbon) + gpp_daily(ipts,j) * dt)
+
+           ! The deficit is less than the carbon reserve
+             IF (-deficit .LE. tmp_bm(ipts,j,icarbres,icarbon)) THEN
+
+              ! Pay the deficit from the reserve pool
+                tmp_bm(ipts,j,icarbres,icarbon) = &
+                     tmp_bm(ipts,j,icarbres,icarbon) + deficit
+                tmp_bm(ipts,j,ilabile,icarbon) = &
+                     tmp_bm(ipts,j,ilabile,icarbon) - deficit
+
+             ELSE
+
+                ! Not enough carbon to pay the deficit, the individual 
+                ! is going to die at the end of this day
+                tmp_bm(ipts,j,ilabile,icarbon) = &
+                     tmp_bm(ipts,j,ilabile,icarbon) + &
+                     tmp_bm(ipts,j,icarbres,icarbon) 
+                tmp_bm(ipts,j,icarbres,icarbon) = zero
+
+                ! Truncate the dark respiration to the available carbon.  Now we
+                ! should use up all the reserves.  If the plant has no leaves, it
+                ! will die quickly after this.
+                gpp_daily(ipts,j) = - tmp_bm(ipts,j,ilabile,icarbon)/dt 
+
+             ENDIF
+
+          ENDIF ! labile pool is empty
+       
+          ! Labile carbon pool after possible correction for dark respiration
+          tmp_bm(ipts,j,ilabile,icarbon) = tmp_bm(ipts,j,ilabile,icarbon) + &
+               gpp_daily(ipts,j) * dt
+
+          ! This would be a good place to update the plant level
+          ! labile and carbres pool but as it may be subject to
+          ! further modifications in the next block of code, it 
+          ! will be done later 
+
+          ! Debug
+          IF(printlev_loc.GE.4 .AND. ipts == test_grid .AND. j == test_pft)THEN
+             WRITE(numout,*) 'Adding gpp to labile pool'
+             WRITE(numout,*) 'biomass(ipts,j,ilabile,icarbon)',&
+                  tmp_bm(ipts,j,ilabile,icarbon)
+             WRITE(numout,*) 'biomass(ipts,j,ilabile,initrogen)',&
+                  tmp_bm(ipts,j,ilabile,initrogen)
+             WRITE(numout,*) 'gpp_daily(ipts,j)',gpp_daily(ipts,j)
+          ENDIF
+          !-
+
+          !! 3.9 Calculate activity of labile carbon pool  
+          !  Similar realtionship as that used for the temperature 
+          !  response of maintenance respiration.  The parameters in 
+          !  the equation were calibrated to give a fraction of 0.1 of 
+          !  GPP at reference temperature tl (i.e. 10Â°C). Note that 
+          !  the temperature response has a lower slope than for 
+          !  respiration to avoid too large turnover rates at high 
+          !  temperature. The stand level labile and reserve pool might 
+          !  get updated once more.
+          IF (tl(ipts) .GT. -2.) THEN
+             
+          !  gtemp = dt/one_day * &
+             gtemp = &
+                  EXP((e0_maint_resp(j)/4.)*(1.0/(tref_maint_resp(j)-tmin_maint_resp(j)) - &
+                  1.0/(tl(ipts)-tmin_maint_resp(j))))
+
+          ELSE
+
+             gtemp = zero            
+
+          ENDIF
+          
+          !  If there is a plant, and we are either at the very start or in 
+          !  the growing season not during senescences, calculate labile 
+          !  pool use for growth
+          IF ( SUM(circ_class_n(ipts,j,:)) .GT. min_stomate .AND. &
+               ( plant_status(ipts,j) .EQ. ibudbreak .OR. &
+               plant_status(ipts,j) .EQ. icanopy ) .AND. &
+               ( SUM(circ_class_biomass(ipts,j,:,ileaf,icarbon)) .GT. min_stomate .OR. &
+               use_reserve(ipts,j) .GT. min_stomate ) ) THEN
+
+             IF ( (tmp_bm(ipts,j,ilabile,icarbon) .GT. min_stomate) .OR. &
+                  (tmp_bm(ipts,j,icarbres,icarbon) .GT. min_stomate) ) THEN
+                
+                ! The labile pool is filled. Re-calculate turnover of the 
+                ! labile pool. Only if the labile pool is very small 
+                ! turnover will exceed 0.75 and the pool will thus be 
+                ! almost entirely emptied
+                gtemp = MAX(MIN( gtemp * lab_fac(ipts,j), 0.75 ), zero)
+
+             ELSE
+
+                gtemp = zero
+
+             ENDIF
+             
+             ! Prioritize the use of the carbhydrate pool. Move
+             ! carbohydrates to the labile pool.
+             IF ((use_reserve(ipts,j) .GT. min_stomate) .AND. &
+                  (tmp_bm(ipts,j,icarbres,icarbon) .GT. min_stomate)) THEN
+
+                tmp_bm(ipts,j,ilabile,icarbon) = &
+                     tmp_bm(ipts,j,ilabile,icarbon) + 0.05 * &
+                     tmp_bm(ipts,j,icarbres,icarbon)
+                tmp_bm(ipts,j,icarbres,icarbon) = & 
+                     tmp_bm(ipts,j,icarbres,icarbon) * 0.95
+
+             ENDIF
+
+             ! This would be a good place to update the plant level
+             ! labile and carbres pool but as it may be subject to
+             ! further modifications in the next block of code, it 
+             ! will be done later
+
+          ENDIF
+
+!!$             !+++CHECK+++
+!!$             ! Nicolas Nadjovski proposed to replace min_stomate by 30. this change
+!!$             ! has not been justified or documented. If retained this
+!!$             ! value should be externalized.
+!!$             !IF (tmp_bm(ipts,j,ilabile,icarbon) .GT. min_stomate) THEN
+!!$             IF (tmp_bm(ipts,j,ilabile,icarbon) .GT. 30.) THEN
+!!$             !+++++++++++
+!!$                
+!!$                ! The labile pool is filled. Re-calculate turnover of the labile pool. 
+!!$                ! Only if the labile pool is very small turnover will exceed 0.75 
+!!$                ! and the pool will thus be almost entirely emptied
+!!$                gtemp = MAX(MIN( gtemp * lab_fac(ipts,j), 0.75 ), zero)
+!!$
+!!$             ELSEIF (tmp_bm(ipts,j,icarbres,icarbon) .GT. min_stomate) THEN
+!!$
+!!$                ! The labile pool is empty but the carbohydrate pool is filled. Move 
+!!$                ! carbohydrates to the labile pool and recalculate the turnover of 
+!!$                ! the labile pool.
+!!$                tmp_bm(ipts,j,ilabile,icarbon) = tmp_bm(ipts,j,ilabile,icarbon) + 0.05 * &
+!!$                     tmp_bm(ipts,j,icarbres,icarbon)
+!!$                tmp_bm(ipts,j,icarbres,icarbon) = tmp_bm(ipts,j,icarbres,icarbon) * 0.95
+!!$                gtemp = MAX(MIN(gtemp*lab_fac(ipts,j), 0.75), zero)
+!!$                
+!!$                ! Debug
+!!$                IF(printlev_loc.GE.4 .AND. ipts == test_grid .AND. j == test_pft)THEN
+!!$                   WRITE(numout,*) 'Moving some carbon from carbres to labile pool 1'
+!!$                   WRITE(numout,*) 'biomass(ipts,j,ilabile,icarbon)', &
+!!$                        tmp_bm(ipts,j,ilabile,icarbon)
+!!$                   WRITE(numout,*) 'biomass(ipts,j,icarbres,icarbon)', &
+!!$                        tmp_bm(ipts,j,icarbres,icarbon)
+!!$                ENDIF
+!!$                !-
+!!$
+!!$             ELSE
+!!$
+!!$                ! There is no labile or carbohydrate pool to use carbon from. 
+!!$                ! Labile pool is not used
+!!$                gtemp = zero
+!!$                
+!!$             ENDIF
+!!$   
+!!$          ENDIF
+
+          !! 3.10 Calculate allocatable part of the labile pool
+          !  If there is a plant, and we are 
+          !  either at the very start or in the growing season not during 
+          !  senescences and after senescence only if use_reserve > 0., 
+          !  calculate labile pool use for growth.
+          IF (SUM(circ_class_n(ipts,j,:)) .GT. min_stomate .AND. &
+               ( plant_status(ipts,j) .EQ. ibudbreak .OR. &
+               plant_status(ipts,j) .EQ. icanopy ) .AND. &
+               ( SUM(circ_class_biomass(ipts,j,:,ileaf,icarbon)) .GT. min_stomate .OR. &
+               use_reserve(ipts,j) .GT. min_stomate ) ) THEN
+
+             ! Use carbon from the labile pool to allocate. The allometric (or 
+             ! functional) allocation scheme transfers gpp to the labile pool 
+             ! (see above) and then uses the labile pool (gpp + labile(t-1)) to sustain 
+             ! growth. The fraction of the labile pool that can be used is a 
+             ! function of the temperature and phenology. bm_alloc_tot in 
+             ! gC m-2 dt-1
+             bm_alloc_tot(ipts,j) = gtemp * tmp_bm(ipts,j,ilabile,icarbon)
+
+          ELSE
+
+             ! The conditions do not support growth
+             bm_alloc_tot(ipts,j) = zero
+
+          ENDIF
+
+          ! Update the labile carbon and nitrogen pool
+          ! The allocatable carbon is taken from the labile pool.
+          tmp_bm(ipts,j,ilabile,icarbon) = tmp_bm(ipts,j,ilabile,icarbon) - &
+               bm_alloc_tot(ipts,j)
+
+          ! Debug
+          IF(printlev_loc.GE.4 .AND. ipts == test_grid .AND. j == test_pft)THEN
+             WRITE(numout,*)'stomate_growth_fun_all, ivm',j  
+             WRITE(numout,*) "First bm_alloc_tot ", bm_alloc_tot(ipts,j)
+             WRITE(numout,*) "plant_status(ipts,j) ", plant_status(ipts,j)
+             WRITE(numout,*) "gtemp ", gtemp
+             WRITE(numout,*) "biomass(ipts,j,ilabile,icarbon) ", &
+                  tmp_bm(ipts,j,ilabile,icarbon)
+             WRITE(numout,*) "biomass(ipts,j,icarbres,icarbon) ", &
+                  tmp_bm(ipts,j,icarbres,icarbon)
+             WRITE(numout,*) "lab_fac(ipts,j) ", lab_fac(ipts,j)
+             WRITE(numout,*) "tl(ipts) ", tl(ipts)
+          ENDIF
+          !-
+
+          !! 3.11 Maintenance respiration
+          !  First, total maintenance respiration for the whole plant is 
+          !  calculated by summing maintenance respiration of the 
+          !  different plant compartments. This simply recalculates the 
+          !  maintenance respiration from stomate_resp.f90. 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:
+          !  The unit of ::resp_maint is gC m-2 dt-1
+          resp_maint(ipts,j) = resp_maint(ipts,j) + &
+               SUM(resp_maint_part(ipts,j,:))
+
+          ! Following the calculation of hourly maintenance respiration, 
+          ! verify that the PFT has not been killed after calcul of 
+          ! resp_maint_part in stomate. Can this generaly calculated 
+          ! ::resp_maint be use under the given conditions? Surpress 
+          ! the respiration for deciduous PFTs as long as they haven't 
+          ! carried leaves at least once. When starting from scratch 
+          ! there is no budburst in the first year because the longterm 
+          ! phenological parameters are not initialized yet. If not 
+          ! surpressed respiration consumes all the reserves before the
+          ! PFT can start growing. The code would establish a new PFT
+          ! but it was decided to surpress this respiration because  
+          ! it has no physiological bases.
+          IF (SUM(circ_class_n(ipts,j,:)) .GT. min_stomate .AND. &
+               rue_longterm(ipts,j) .NE. un) THEN
+
+             !+++CHECK+++
+             ! Can the calculated maintenance respiration be used ? Or 
+             ! does it have to be adjusted for special cases. Maintenance 
+             ! respiration should be positive. In case it is very low, use 20%
+             ! (::maint_from_labile) of the active labile carbon pool 
+             ! (gC m-2 dt-1)
+             ! resp_maint(ipts,j) = MAX(zero, MAX(maint_from_labile * gtemp * 
+             ! tmp_bm(ipts,j,ilabile,icarbon), resp_maint(ipts,j)))
+             ! Calculate resp_maint for the labile pool as well, 
+             ! no need to have the above threshold. Make sure resp_maint 
+             ! is not zero
+             resp_maint(ipts,j) = MAX(zero, resp_maint(ipts,j))
+             !+++++++++++
+
+             ! Phenological growth makes use of the reserves. Some carbon 
+             ! needs to remain to support the growth, hence, respiration 
+             ! will be limited. In this case resp_maint ((gC m-2 dt-1) 
+             ! should not be more than 80% (::maint_from_gpp) of the GPP 
+             ! (gC m-2 s-1) 
+             IF (lab_fac(ipts,j) .GT. 0.3) THEN
+
+                resp_maint(ipts,j) = MIN( MAX(zero, &
+                     maint_from_gpp * gpp_daily(ipts,j) * dt), &
+                     resp_maint(ipts,j))
+
+             ENDIF
+
+          ELSE
+
+             ! No plants, no respiration
+             resp_maint(ipts,j) = zero
+
+          ENDIF
+          
+          ! The calculation of ::resp_maint is solely based on the demand i.e.
+          ! given the biomass and the condition of the plant, how much should be
+          ! respired. It is not sure that this demand can be satisfied i.e. the 
+          ! calculated maintenance respiration may exceed the available carbon.
+          IF ( bm_alloc_tot(ipts,j) - resp_maint(ipts,j) .LT. zero ) THEN
+           
+            deficit = bm_alloc_tot(ipts,j) - resp_maint(ipts,j)
+            ! The deficit is less than the carbon reserve
+            IF (-deficit .LE. tmp_bm(ipts,j,icarbres,icarbon)) THEN
+          
+               ! Pay the deficit from the reserve pool
+               tmp_bm(ipts,j,icarbres,icarbon) = &
+                    tmp_bm(ipts,j,icarbres,icarbon) + deficit
+               bm_alloc_tot(ipts,j) = bm_alloc_tot(ipts,j) - deficit
+            ELSE
+          
+               ! Not enough carbon to pay the deficit, the individual 
+               ! is going to die at the end of this day
+               bm_alloc_tot(ipts,j) = bm_alloc_tot(ipts,j) + &
+                    tmp_bm(ipts,j,icarbres,icarbon) 
+               tmp_bm(ipts,j,icarbres,icarbon) = zero
+
+               ! Truncate the maintenance respiration to the available carbon
+               resp_maint(ipts,j) = bm_alloc_tot(ipts,j)
+            ENDIF
+
+          ENDIF
+          
+          ! Final ::resp_maint is known
+          bm_alloc_tot(ipts,j) = bm_alloc_tot(ipts,j) - resp_maint(ipts,j)
+
+          ! Debug
+          IF(printlev_loc.GE.4 .AND. ipts == test_grid .AND. j == test_pft)THEN
+             WRITE(numout,*) 'bm_alloc_tot-resp_maint, ',bm_alloc_tot(ipts,j)
+             WRITE(numout,*) "resp_maint ", resp_maint(ipts,j)
+          ENDIF
+          !-
+
+          !+++CHECK+++
+          ! It is more logical to deal with all the respiration terms at the
+          ! same time (as being done right here) but there are good reason to calculate
+          ! growth respiration in the end. Especialy if in the future we want
+          ! to have different growth respiration factors for different tissues.
+          
+          !  If not surpressed respiration consumes all the reserves before the PFT
+          !  can start growing. The code would establish a new PFT but it was
+          !  decided to surpress this respiration because it has no physiological
+          !  bases.
+          IF (SUM(circ_class_n(ipts,j,:)) .GT. min_stomate .AND. &
+               rue_longterm(ipts,j) .NE. un) THEN
+             
+             frac_growthresp_dyn = frac_growthresp(j)
+
+          ELSE
+
+             frac_growthresp_dyn = zero
+
+          ENDIF
+
+          !! 3.12 Growth respiration
+          !  Calculate total growth respiration and update allocatable carbon
+          !  Growth respiration is a tax on productivity, not actual allocation
+          !  Total growth respiration has been calculated before the allocation 
+          !  takes place because the allocation itself is not linear. 
+          !  Ideally, growth respiration should be included as an additional 
+          !  component in the allocation. That way the model could even have
+          !  different growth respiration costs for the different plant organs
+          !  and/or tissues. The unit of resp_growth is gC m-2 dt-1. Surpress 
+          !  the respiration for deciduous PFTs as long as they haven't carried 
+          ! leaves at least once.
+
+          !+++CHECK+++
+          ! This is the original code and ::bm_alloc_tot has to be
+          ! known before we can calculate ::resp_growth. Seems that
+          ! Nicolas Vuichard replaced ::bm_alloc_tot by gpp_daily. This is
+          ! possible but it implies that we no longer address the 
+          ! sink-source ideas by Korner.
+          resp_growth(ipts,j) = frac_growthresp_dyn * &
+               MAX(zero, bm_alloc_tot(ipts,j))
+!!$          resp_growth(ipts,j) = frac_growthresp_dyn * &
+!!$               MAX(zero, gpp_daily(ipts,j) * dt)
+          frac_growthresp_dyn = 0.
+          !+++++++++++
+          
+          ! The calculation of ::resp_growth is solely based on the demand i.e.
+          ! given the biomass and the condition of the plant, how much should be
+          ! respired. It is not sure that this demand can be satisfied i.e. the 
+          ! calculated maintenance respiration may exceed the available carbon
+          IF ( bm_alloc_tot(ipts,j) - resp_growth(ipts,j) .LT. zero ) THEN
+          
+            deficit = bm_alloc_tot(ipts,j) - resp_growth(ipts,j)
+          
+            ! The deficit is less than the carbon reserve
+            IF (-deficit .LE. tmp_bm(ipts,j,icarbres,icarbon)) THEN
+          
+               ! Pay the deficit from the reserve pool
+               tmp_bm(ipts,j,icarbres,icarbon) = &
+                    tmp_bm(ipts,j,icarbres,icarbon) + deficit
+               bm_alloc_tot(ipts,j) = bm_alloc_tot(ipts,j) - deficit
+            ELSE
+          
+               ! Not enough carbon to pay the deficit, the individual 
+               ! is going to die at the end of this day
+               bm_alloc_tot(ipts,j) = bm_alloc_tot(ipts,j) + &
+                    tmp_bm(ipts,j,icarbres,icarbon) 
+               tmp_bm(ipts,j,icarbres,icarbon) = zero
+          
+               ! Truncate the maintenance respiration to the available carbon
+               resp_growth(ipts,j) = bm_alloc_tot(ipts,j)
+            ENDIF
+         
+          ENDIF
+
+          ! Final ::resp_growth is known
+          bm_alloc_tot(ipts,j) = bm_alloc_tot(ipts,j) - resp_growth(ipts,j)
+
+          ! Debug
+          IF(printlev_loc.GE.4 .AND. ipts == test_grid .AND. j == test_pft)THEN
+             WRITE(numout,*) 'bm_alloc_tot-growth_maint, ',bm_alloc_tot(ipts,j)
+             WRITE(numout,*) "resp_growth ", resp_growth(ipts,j)
+          ENDIF
+          !-
+
+          ! Occasionally, there is a very special situation which arises, where
+          ! bm_alloc_tot is greater than min_stomate before accounting for growth 
+          ! respiration, but not afterwards.  This causes a mass balance error 
+          ! because growth respiration is non-zero but bm_alloc_tot is too small 
+          ! to trigger loops below, so nothing is done with that carbon. In this 
+          ! situation, the amout of carbon to allocate is so low that nothing 
+          ! really changes.  We set the growth respiration to zero in this special 
+          ! case to avoid mass imbalance, even though this will not effect the 
+          ! trajectory of the plant.  It seems to happen on the same day as leaves 
+          ! start growing, before any GPP is calculated.
+          IF(((bm_alloc_tot(ipts,j) + resp_growth(ipts,j)) .GT. min_stomate) &
+               .AND. (bm_alloc_tot(ipts,j) .LT. min_stomate)) THEN
+
+             bm_alloc_tot(ipts,j) = bm_alloc_tot(ipts,j) + resp_growth(ipts,j)
+             resp_growth(ipts,j) = zero
+
+             ! Debug
+             IF(printlev_loc.GE.4 .AND. j == test_pft .AND. ipts == test_grid)THEN
+                WRITE(numout,*) 'stomate_allocation - Hit exception 25'
+             ENDIF
+             !-
+
+          ENDIF
+
+          !! 3.13 Distribute stand level ilabile and icarbres at the tree level
+          !  The labile and carbres pools are calculated at the stand level but
+          !  are then redistributed at the tree level. Tree level biomass is the
+          !  prognostic variable in ORCHIDEE. Biomass is here used as a local
+          !  variable to deal with the reserve and labile pools.
+          circ_class_biomass(ipts,j,:,ilabile,icarbon) = &
+               biomass_to_cc(tmp_bm(ipts,j,ilabile,icarbon),&
+               circ_class_biomass(ipts,j,:,ilabile,icarbon),&
+               circ_class_n(ipts,j,:))
+          circ_class_biomass(ipts,j,:,icarbres,icarbon) = &
+               biomass_to_cc(tmp_bm(ipts,j,icarbres,icarbon),&
+               circ_class_biomass(ipts,j,:,icarbres,icarbon),&
+               circ_class_n(ipts,j,:))
+
+       ENDDO ! npts 
+
+
+     
+
+ !! 5. Allometric allocation
+
+       DO ipts = 1, npts
+
+          !!  5.1 Initialize allocated biomass pools
+          f_alloc(ipts,j,:) = zero
+          f_alloc_circ(ipts,:,:) = zero
+          Cl_inc(:) = zero
+          Cs_inc(:) = zero
+          Cr_inc(:) = zero
+          Cf_inc(:) = zero
+          Cl_incp(:) = zero
+          Cs_incp(:) = zero
+          Cr_incp(:) = zero 
+          Cs_inc_est(:) = zero
+          Cl_target(:) = zero
+          Cr_target(:) = zero
+          Cs_target(:) = zero
+          ba1(:) = zero
+          ba2(:) = zero
+ 
+          !! 5.2 Calculate allocated biomass pools for trees
+          !! 5.2.1 Stand to tree allocation rule of Deleuze & Dhote
+          IF ( is_tree(j) .AND. bm_alloc_tot(ipts,j) .GT. min_stomate ) THEN
+
+             !  Basal area at the tree level (m2 tree-1)
+             circ_class_ba_eff(:) = wood_to_ba_eff(circ_class_biomass(ipts,j,:,:,icarbon),j)
+             circ_class_circ_eff(:) = 2 * pi * SQRT(circ_class_ba_eff(:)/pi)
+
+             ! According to equation (-) in Bellasen et al 2010. 
+             ! ln(sigmas) = a_sig * ln(circ_med) + b_sig
+             ! sigmas = exp(a_sig*log(median(circ_med))+b_sig);
+             ! However, in the code (sapiens_forestry.f90) a different expression was used
+             ! sigmas = 0.023+0.58*prctile(circ_med,0.05);
+             ! Any of these implementations could work but seem to be more suited for 
+             ! continues or nearly continuous diameter distributions, say n_circ > 10
+             ! For a small number of diameter classes sigma depends on a prescribed
+             ! circumference percentile.
+             IF (ncirc .GE. 6) THEN          
+               
+                ! Calculate the median circumference
+                DO l = 1,ncirc
+                   
+                      IF (SUM(circ_class_n(ipts,j,1:l)) .GE. &
+                           0.5 * SUM(circ_class_n(ipts,j,:))) THEN
+                         
+                         median_circ  = circ_class_circ_eff(l) - 5 * min_stomate
+                         EXIT
+                      
+                      ENDIF
+                   
+                ENDDO
+
+                sigma(ipts,j) = deleuze_a(j) + deleuze_b(j) * median_circ
+                
+             ELSE
+                
+                ! The X percentile of the trees that will receive the photosynthates
+                ! depends on the FM type. In a coppice stand there is a lot of 
+                ! competition between the shoots and only the top half of the shoots
+                ! will receive GPP, the other half receives only little GPP. This was 
+                ! implemnted to get a reasonable diameter growth of coppice stands. 
+                ! If deleuze_p is independent from FM, FM strategies with high densities
+                ! have very slow diameter growth because the GPP has to be distributed 
+                ! over a large number of individuals. 
+                IF (forest_managed(ipts,j) == ifm_cop) THEN
+
+                   deleuze_p(j) = deleuze_p_coppice(j)
+
+                ELSEIF (forest_managed(ipts,j) == ifm_none .OR. &
+                     forest_managed(ipts,j) == ifm_thin .OR. &
+                     forest_managed(ipts,j) == ifm_src) THEN
+                   
+                   deleuze_p(j) = deleuze_p_all(j)
+
+                ELSE
+                   
+                   WRITE(numout, *) 'forest management, ', forest_managed(ipts,j)
+                   CALL ipslerr_p (3,'growth_fun_all', &
+                        'Forest management strategy does not exist','','')
+
+                ENDIF
+
+                ! Search for the X percentile, where X is given by ::deleuze_p
+                ! Substract a very small number (5*min_stomate) just to be sure that 
+                ! the circ_class will be corectly accounted for in GE or LE statements
+                DO l = 1,ncirc
+                   
+                      IF (SUM(circ_class_n(ipts,j,1:l)) .GE. deleuze_p(j) * SUM(circ_class_n(ipts,j,:))) THEN
+                         
+                         sigma(ipts,j) = circ_class_circ_eff(l) - 5 * min_stomate
+                         EXIT
+                      
+                      ENDIF
+                   
+                ENDDO
+                
+             ENDIF
+
+          
+             !! 5.2 Calculate allocated biomass pools for trees
+             !  Only possible if there is biomass to allocate
+             !  Use sigma and m_dv to calculate a single coefficient that can be
+             !  used in the subsequent allocation scheme.
+             circ_class_dba(:) = (circ_class_circ_eff(:) - m_dv(j)*sigma(ipts,j) + &
+                  ((m_dv(j)*sigma(ipts,j) + circ_class_circ_eff(:))**2 - &
+                  (4*sigma(ipts,j)*circ_class_circ_eff(:)))**(1/deleuze_power(j))) / 2
+
+             !! 5.2.2 Scaling factor to convert variables to the individual plant
+             !  Allocation is on an individual basis. Stand-level variables need to 
+             !  convert to a single individual. Different approach between the DGVM 
+             !  and statitic approach
+             IF (ok_dgvm) THEN
+
+                ! The DGVM does currently NOT work with the new allocation, consider this as
+                ! placeholder. The original code had two different transformations to 
+                ! calculate the scalars. Both could be used but the units will differ.
+                ! When fixing the DGVM check which quantities need to be multiplied by scal 
+                ! scal = ind(ipts,j) * cn_ind(ipts,j) / veget_cov_max(ipts,j)
+                scal(ipts,j) = veget_cov_max(ipts,j) / SUM(circ_class_n(ipts,j,:))  
+             
+             ELSE
+             
+                ! circ_class_biomass contain the data at the tree level
+                ! no conversion required
+                scal(ipts,j) = 1.
+             
+             ENDIF       
+
+             !! 5.2.3 Current biomass pools per tree (gC tree^-1) 
+             ! We will have different trees so this has to be calculated from the 
+             ! diameter relationships            
+             Cs(:) = ( circ_class_biomass(ipts,j,:,isapabove,icarbon) + &
+                  circ_class_biomass(ipts,j,:,isapbelow,icarbon) ) * scal(ipts,j)
+             Cr(:) = circ_class_biomass(ipts,j,:,iroot,icarbon) * scal(ipts,j)
+             Cl(:) = circ_class_biomass(ipts,j,:,ileaf,icarbon) * scal(ipts,j)
+             Ch(:) = ( circ_class_biomass(ipts,j,:,iheartabove,icarbon) + &
+                  circ_class_biomass(ipts,j,:,iheartbelow,icarbon) ) * scal(ipts,j)
+ 
+             ! Total amount of carbon that needs to ba allocated (::bm_alloc_tot). 
+             ! bm_alloc_tot is in gC m-2 day-1. At 1 m2 there are ::ind number of 
+             ! trees. We calculate the allocation for ::ncirc trees. Hence b_inc_tot 
+             ! needs to be scaled in the allocation routines. For all cases were 
+             ! allocation takes place for a single circumference class, scaling 
+             ! could be done before the allocation. In the ordinary allocation 
+             ! allocation takes place to all circumference classes at the same time. 
+             ! Hence scaling takes place in that step for consistency we scale during 
+             ! allocation. Note that b_inc (the carbon allocated to an individual 
+             ! circumference class cannot be estimates at this point.
+             b_inc_tot = bm_alloc_tot(ipts,j)
+
+             !! 5.2.4 C-allocation for trees
+             !  The mass conservation equations are detailed in the header of this subroutine.
+             !  The scheme assumes a functional relationships between leaves, sapwood and 
+             !  roots. When carbon is added to the leaf biomass pool, an increase in the root
+             !  biomass is to be expected to sustain water transport from the roots to the 
+             !  leaves. Also sapwood is needed to sustain this water transport and to support
+             !  the leaves.
+             DO l = 1,ncirc 
+
+                !! 5.2.4.1 Calculate tree height
+                circ_class_height_eff(l) = pipe_tune2(j)* & 
+                     (4/pi*circ_class_ba_eff(l))**(pipe_tune3(j)/2)
+
+                !! 5.2.4.2 Do the biomass pools respect the pipe model?
+                !  Do the current leaf, sapwood and root components respect the allometric 
+                !  constraints? Due to plant phenology it is possible that we have too much 
+                !  sapwood compared to the leaf and root mass (i.e. in early spring). 
+                !  Calculate the optimal root and leaf mass, given the current wood mass 
+                !  by using the basic allometric relationships. Calculate the optimal sapwood
+                !  mass as a function of the current leaf and root mass.
+                Cl_target(l) = MAX( KF(ipts,j) * Cs(l) / circ_class_height_eff(l), &
+                     Cr(l) * LF(ipts,j) , Cl(l))
+                Cr_target(l) = MAX( Cl_target(l) / LF(ipts,j), &
+                     Cs(l) * KF(ipts,j) / LF(ipts,j) / circ_class_height_eff(l) , Cr(l))
+                Cs_target(l) = MAX( Cl(l) / KF(ipts,j) * circ_class_height_eff(l), &
+                     Cr(l) * LF(ipts,j) / KF(ipts,j) * circ_class_height_eff(l) , Cs(l))
+
+                ! Debug
+                IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                   WRITE(numout,*) 'bm_alloc_tot, ', bm_alloc_tot(ipts,j)
+                   WRITE(numout,*) 'Does the tree need reshaping? Class: ',l
+                   WRITE(numout,*) 'circ_class_height_eff, ', circ_class_height_eff(l)
+                   WRITE(numout,*) 'KF, LF, ', KF(ipts,j), LF(ipts,j)
+                   WRITE(numout,*) 'Cl_target-Cl, ', Cl_target(l)-Cl(l), Cl_target(l), Cl(l)
+                   WRITE(numout,*) 'Cs_target-Cs, ', Cs_target(l)-Cs(l), Cs_target(l), Cs(l)
+                   WRITE(numout,*) 'Cr_target-Cr, ', Cr_target(l)-Cr(l), Cr_target(l), Cr(l)
+                ENDIF
+                !-
+
+                !! 5.2.4.2 Check dimensions of the trees
+                ! If Cs = Cs_target then ba and height are correct, else calculate 
+                ! the correct dimensions
+                IF ( Cs_target(l) - Cs(l) .GT. min_stomate ) THEN
+
+                   ! If Cs = Cs_target then dia and height are correct. However,
+                   ! if Cl = Cl_target or Cr = Cr_target then dia and height
+                   ! need to be re-estimated. Cs_target should satify the relationship 
+                   ! Cl/Cs = KF/height where height is a function of Cs_target
+                   ! Search Cs needed to sustain the max of Cl or Cr.
+                   ! Search max of Cl and Cr first
+                   !
+                   ! [UPDATE] After the code passes through turnover or mortality
+                   ! we may end up in a situation where we have lost more sapwood 
+                   ! than leaves and roots (i.e. sapwood turnover). The model would 
+                   ! then suggest that at time=t+1 the tree should be smaller than 
+                   ! at time=t0.  From a physiological standpoint this is not 
+                   ! possible for the heartwood. If we now calculate Cs_target on 
+                   ! the basis of Cl or Cr, we find that Cs_target > Cs. The first 
+                   ! priority of the allocation scheme will be to allocate C to Cs.
+                   ! Because we don't know yet whether the actual Cr or Cl is what 
+                   ! drives the need to allocate to Cs, we calculate Cl_target first. 
+                   Cl_target(l) = MAX(Cl(l), Cr(l)*LF(ipts,j))
+
+                   ! Debug
+                   IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                      WRITE(numout,*) 'Does the tree need reshaping? Class:',l
+                      WRITE(numout,*) 'circ_class_height_eff, ', circ_class_height_eff(l)
+                      WRITE(numout,*) 'KF, LF, ', KF(ipts,j), LF(ipts,j)
+                      WRITE(numout,*) 'Cl_target-Cl, ', Cl_target(l)-Cl(l), Cl_target(l), Cl(l)
+                      WRITE(numout,*) 'Cs, ', Cs(l)
+                      WRITE(numout,*) 'CS_target', Cs_target(l)
+                      WRITE(numout,*) 'Cr, ', Cr(l)
+                      WRITE(numout,*) 'Ch, ', Ch(l)
+                   ENDIF
+                   !-
+
+                   ! We now have the Cl_target that we will use to calculate
+                   ! Cs_target. Given the allometric relationships we can
+                   ! calculate Cs_target as Cl_target*height/KF. 
+                   ! height is a function of ba, which in turn is a function 
+                   ! of woodmass (Woodmass = Cs+Ch (sapwood+heartwood) ). We 
+                   ! therefore substitute the following equations into one another:
+                   !
+                   ! (1) Cs_target = Cl_target*height/KF
+                   ! (2) height = as a function of ba
+                   ! (3) ba = as a function of woodmass_ind
+                   !
+                   ! This gives:
+                   !
+                   ! (4) Cl_target = (KF*Cs_target)/(pipe_tune2*(Cs_target+Ch)/ &
+                   !                 & pi/4)**(pipe_tune3/(2+pipe_tune3))
+                   !
+                   ! The function newX searches for the value for Cs_target
+                   ! that satisfies this equation (4).
+                   Cs_target(l) =  newX(KF(ipts,j), Ch(l), pipe_tune2(j), &
+                        pipe_tune3(j), Cl_target(l), &
+                        tree_ff(j)*pipe_density(j)*pi/4*pipe_tune2(j), &
+                        Cs(l), 2*Cs(l), 2, j, ipts)
+
+                   ! Recalculate height and ba from the correct Cs_target
+                   circ_class_height_eff(l) = Cs_target(l)*KF(ipts,j)/Cl_target(l)
+                   circ_class_ba_eff(l) = pi/4*(circ_class_height_eff(l)/ & 
+                        pipe_tune2(j))**(2/pipe_tune3(j))
+                   Cl_target(l) = KF(ipts,j) * Cs_target(l) / circ_class_height_eff(l)
+                   Cr_target(l) = Cl_target(l) / LF(ipts,j)
+
+                ENDIF
+
+                ! Debug
+                IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                   WRITE(numout,*) 'height_fin, ba_fin, ', circ_class_height_eff(:), &
+                        circ_class_ba_eff(:)
+                   WRITE(numout,*) 'Cl_target, Cs_target, Cr_target, ', Cl_target(:), &
+                        Cs_target(:), Cr_target(:)
+                   WRITE(numout,*) 'New target values'
+                   WRITE(numout,*) 'Cl_target-Cl, ', Cl_target(l)-Cl(l), Cl_target(l), Cl(l)
+                   WRITE(numout,*) 'Cs_target-Cs, ', Cs_target(l)-Cs(l), Cs_target(l), Cs(l)
+                   WRITE(numout,*) 'Cr_target-Cr, ', Cr_target(l)-Cr(l), Cr_target(l), Cr(l)
+                ENDIF
+                !-
+
+             ENDDO !ncirc
+
+             ! The step estimate is used to linearalize the diameter vs height 
+             ! relationship. Use a prior to distribute b_inc_tot over the individual 
+             ! trees. The share of the total sapwood mass is used as a prior. 
+             ! Subsequently, estimate the change in diameter by assuming all the 
+             ! available C for allocation will be used in Cs. Hence, this represents 
+             ! the maximum possible diameter increase. It was not tested whether 
+             ! this is the best prior but it seems to work OK although it often 
+             ! results in very small (1e-8) negative values, with even more rare 
+             ! 1e-6 negative values. A C-balance closure check could reveal 
+             ! whether this is a real issue and requires to change the prior or not.
+             ! Calculate the linear slope (::s) of the relationship between ba and h as 
+             ! (1) s = (ba2-ba)/(height2-height). 
+             ! The goal is to approximate the ba2 that is predicted through the 
+             ! non-linear ordinary allocation approach, as this will keep the 
+             ! trees in allometric balance. In the next time step, allometric 
+             ! balance is recalculated and can be corrected through the so-called 
+             ! phenological growth; hence, small deviations resulting from the 
+             ! linearization will not accumulate with time.
+             ! Note that ba2 = ba + delta_ba and that height and ba are related as
+             ! (2) height = k2*(4*ba/pi)**(k3/2)
+             ! At this stage the only information we have is that there is b_inc_tot 
+             ! (gC m-2) available for allocation. There are two obvious approximations 
+             ! both making use of the same assumption, i.e. that for the initial 
+             ! estimate of delta_ba height is constant. The first approximation is 
+             ! crude and assumes that all the available C is used in Cs_inc 
+             ! (thus Cs_inc = b_inc_tot / ind ). The second approximation,
+             ! implemented here, makes use of the allometric rules and thus accounts 
+             ! for the knowledge that allocating one unit the sapwood comes with a cost 
+             ! in leaves and roots thus:
+             ! b_inc_temp = Cs_inc+Cl_inc+Cr_inc
+             ! (3) <=> b_inc_temp ~= (Cs_inc_est+Cs) + KF*(Cs_inc_est+Cs)/H + ...
+             !    KF/LF*(Cs_inc_est+Cs)/H - Cs - Cl - Cr
+             ! b_inc_temp is the amount of carbon that can be allocated to each diameter 
+             ! class. However, only the total amount i.e. b_inc_tot is known. Total 
+             ! allocatable carbon is distributed over the different diameter classes 
+             ! proportional to their share of the total wood biomass. Divide by 
+             ! circ_class_n to get the correct units (gC tree-1)
+             ! (4)  b_inc_temp ~= b_inc_tot / circ_class_n * (circ_class_n * ba**(1+k3)) / ...
+             !    sum(circ_class_n * ba**(1+k3))
+             ! By substituting (4) in (3) an expression is obtained to approximate the 
+             ! carbon that will be allocated to sapwood growth per diameter class 
+             ! ::Cs_inc_est. This estimate is then used to calculate delta_ba 
+             ! (called ::step) 
+             ! step = (Cs+Ch+Cs_inc_set)/(tree_ff*pipe_density*height) - ba 
+             ! where height is calculated from (2) after replacing ba by ba+delta_ba
+
+             ! Keep it simple - as described in the documentation
+             ! Cs_inc_est(:) = ( b_inc_tot / circ_class_n(ipts,j,:) * &
+             !     (circ_class_n(ipts,j,:) * circ_class_ba_eff(:)**(un+pipe_tune3(j))) / &
+             !     (SUM(circ_class_n(ipts,j,:) * circ_class_ba_eff(:)**(un+pipe_tune3(j)))))
+
+             ! We implemented a more precise approach following the same principles
+             Cs_inc_est(:) = ( b_inc_tot / circ_class_n(ipts,j,:) * &
+                  (circ_class_n(ipts,j,:) * circ_class_ba_eff(:)**(un+pipe_tune3(j))) / &
+                  (SUM(circ_class_n(ipts,j,:) * circ_class_ba_eff(:)**(un+pipe_tune3(j)))) + &
+                  Cs(:) + Cl(:) + Cr(:)) * circ_class_height_eff(:) / &
+                  (circ_class_height_eff(:) + KF(ipts,j) + KF(ipts,j)/LF(ipts,j)) - Cs(:)
+             step(:) = ((Ch(:)+Cs(:)+Cs_inc_est(:)) / (tree_ff(j)*pipe_density(j)* &
+                  circ_class_height_eff(:))) - circ_class_ba_eff(:)
+
+             ! It can happen that step is equal to zero sometimes.  I'm not sure why, but 
+             ! there was a case where it was nonzero for circ classes 1 and 3, and zero 
+             ! for 2.  This causes s to be zero and provokes a divide by zero error later 
+             ! on.  What if we make it not zero?  This might cause a small mass balance
+             ! error for this timestep, but I would rather have that than getting an 
+             ! infinite biomass, which is what happened in the other case.  These limits 
+             ! are arbitrary and adjusted by hand.  If the output file doesn't show this 
+             ! warning very often, I think we're okay, since the amount of carbon is really
+             ! small.
+             DO l=1,ncirc
+                IF(step(l) .LT. min_stomate*0.01 .AND. step(l) .GT. zero)THEN
+                   step(l)=min_stomate*0.02
+                   IF (printlev_loc.GE.4) THEN
+                      WRITE(numout,*) 'WARNING: Might cause mass balance problems '//&
+                           'in fun_all, position 1'
+                      WRITE(numout,*) 'WARNING: ips,j ',ipts,j
+                   END IF
+                ELSEIF(step(l) .GT. -min_stomate*0.01 .AND. step(l) .LT. zero)THEN
+                   step(l)=-min_stomate*0.02
+                   IF (printlev_loc.GE.4) THEN
+                      WRITE(numout,*) 'WARNING: Might cause mass balance problems '//&
+                           'in fun_all, position 2'
+                      WRITE(numout,*) 'WARNING: ips,j ',ipts,j
+                   END IF
+                ENDIF
+             ENDDO
+             s(:) = step(:)/(pipe_tune2(j)*(4.0_r_std/pi*(circ_class_ba_eff(:)+step(:)))**&
+                  (pipe_tune3(j)/deux) - &
+                  pipe_tune2(j)*(4.0_r_std/pi*circ_class_ba_eff(:))**(pipe_tune3(j)/deux))
+
+             !! 5.2.4.3 Phenological growth
+             !  Phenological growth and reshaping of the tree in line with the pipe model. 
+             !  Turnover removes C from the different plant components but at a 
+             !  component-specific rate, as such the allometric constraints are distorted 
+             !  at every time step and should be restored before ordinary growth can 
+             !  take place
+             l = ncirc
+             DO WHILE ( (l .GT. zero) .AND. (b_inc_tot .GT. min_stomate) )
+
+                !! 5.2.4.3.1 The available wood can sustain the available leaves and roots
+                !  Calculate whether the wood is in allometric balance. The target values 
+                !  should always be larger than the current pools so the use of ABS is 
+                !  redundant but was used to be on the safe side (here and in the rest 
+                !  of the module) as it could help to find logical flaws.
+                IF ( ABS(Cs_target(l) - Cs(l)) .LT. min_stomate ) THEN
+
+                   ! Use the difference between the target and the actual to
+                   ! ensure mass balance closure because l times a values 
+                   ! smaller than min_stomate can still add up to a value 
+                   ! exceeding min_stomate.
+                   Cs_incp(l) = MAX(zero, Cs_target(l) - Cs(l))
+
+                   ! Enough leaves and wood, only grow roots
+                   IF ( ABS(Cl_target(l) - Cl(l))  .LT. min_stomate ) THEN
+
+                      ! Allocate at the tree level to restore allometric balance
+                      ! Some carbon may have been used for Cs_incp and Cl_incp
+                      ! adjust the total allocatable carbon
+                      Cl_incp(l) = MAX(zero, Cl_target(l) - Cl(l))
+                      Cr_incp(l) = MAX( MIN(b_inc_tot / circ_class_n(ipts,j,l) - &
+                           Cs_incp(l) - Cl_incp(l), Cr_target(l) - Cr(l)), zero )
+
+                      ! Write debug comments to output file
+                      IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                         CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                              delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                              KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                              circ_class_n, 1)
+                      ENDIF
+
+                   ! Sufficient wood and roots, allocate C to leaves
+                   ELSEIF ( ABS(Cr_target(l) - Cr(l)) .LT. min_stomate ) THEN
+
+                      ! Allocate at the tree level to restore allometric balance
+                      ! Some carbon may have been used for Cs_incp and Cr_incp
+                      ! adjust the total allocatable carbon
+                      Cr_incp(l) = MAX(zero, Cr_target(l) - Cr(l))
+                      Cl_incp(l) = MAX( MIN(b_inc_tot / circ_class_n(ipts,j,l) - &
+                           Cs_incp(l) - Cr_incp(l), Cl_target(l) - Cl(l)), zero )
+
+                      ! Write debug comments to output file
+                      IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                         CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                              delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                              KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, &
+                              grow_wood, circ_class_n, 2)
+                      ENDIF
+                      
+                   ! Both leaves and roots are needed to restore the allometric relationships
+                   ELSEIF ( ABS(Cl_target(l) - Cl(l)) .GT. min_stomate .AND. &
+                        ABS(Cr_target(l) - Cr(l)) .GT. min_stomate ) THEN                 
+
+                      ! Allocate at the tree level to restore allometric balance
+                      !  The equations can be rearanged and written as
+                      !  (i) b_inc = Cl_inc + Cr_inc
+                      !  (ii) Cr_inc = (Cl_inc+Cl)/LF - Cr
+                      !  Substitue (ii) in (i) and solve for Cl_inc
+                      !  <=> Cl_inc = (LF*(b_inc+Cr)-Cl)/(1+LF)
+                      Cl_incp(l) = MIN( ((LF(ipts,j) * ((b_inc_tot/circ_class_n(ipts,j,l) - &
+                           Cs_incp(l)) + Cr(l))) - Cl(l)) / & 
+                           (1 + LF(ipts,j)), Cl_target(l) - Cl(l) )
+                      Cr_incp(l) = MIN ( ((Cl_incp(l) + Cl(l)) / LF(ipts,j)) - Cr(l), &
+                           Cr_target(l) - Cr(l))
+
+                      ! The imbalance between Cr and Cl can be so big that (Cl+Cl_inc)/LF 
+                      ! is still less then the available root carbon (observed!). This would 
+                      ! result in a negative Cr_incp
+                      IF ( Cr_incp(l) .LT. zero ) THEN
+
+                         Cl_incp(l) = MIN( b_inc_tot/circ_class_n(ipts,j,l) - Cs_incp(l), &
+                              Cl_target(l) - Cl(l) )
+                         Cr_incp(l) = (b_inc_tot/circ_class_n(ipts,j,l)) - Cs_incp(l) - &
+                              Cl_incp(l)
+
+                      ELSEIF (Cl_incp(l) .LT. zero) THEN
+
+                         Cr_incp(l) = MIN( b_inc_tot/circ_class_n(ipts,j,l) - Cs_incp(l), &
+                              Cr_target(l) - Cr(l) )
+                         Cl_incp(l) = (b_inc_tot/circ_class_n(ipts,j,l)) - &
+                              Cs_incp(l) - Cr_incp(l)
+
+                      ENDIF                          
+
+                      ! Write debug comments to output file
+                      IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                         CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                              delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                              KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, &
+                              grow_wood, circ_class_n, 3)
+                      ENDIF
+
+                   ELSE
+
+                      WRITE(numout,*) 'Exc 1-3: unexpected exception' 
+                      IF(err_act.GT.1)THEN
+                         CALL ipslerr_p (3,'growth_fun_all',&
+                              'Exc 1-3: unexpected exception','','')
+                      ENDIF
+
+                   ENDIF
+
+                !! 5.2.4.3.2 Enough leaves to sustain the wood and roots
+                ELSEIF ( ABS(Cl_target(l) - Cl(l)) .LT. min_stomate ) THEN
+
+                   ! Use the difference between the target and the actual to
+                   ! ensure mass balance closure because l times a values 
+                   ! smaller than min_stomate can still add up to a value 
+                   ! exceeding min_stomate.
+                   Cl_incp(l) = MAX(zero, Cl_target(l) - Cl(l))
+
+                   ! Enough leaves and wood, only grow roots
+                   ! This duplicates Exc 1 and these lines should never be called 
+                   IF ( ABS(Cs_target(l) - Cs(l)) .LT. min_stomate ) THEN
+
+                      ! Allocate at the tree level to restore allometric balance
+                      ! Some carbon may have been used for Cs_incp and Cl_incp
+                      ! adjust the total allocatable carbon
+                      Cs_incp(l) = MAX(zero, ABS(Cs_target(l) - Cs(l)))
+                      Cr_incp(l) = MAX( MIN(b_inc_tot/circ_class_n(ipts,j,l) - &
+                           Cl_incp(l) - Cs_incp(l), Cr_target(l) - Cr(l)), zero )
+
+                      ! Write debug comments to output file
+                      IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                         CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                              delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                              KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                              circ_class_n, 4)
+                      ENDIF
+
+                   ! Enough leaves and roots. Need to grow sapwood to support the available 
+                   ! canopy and roots
+                   ELSEIF ( ABS(Cr_target(l) - Cr(l)) .LT. min_stomate ) THEN
+
+                      ! In truth, there might be a little root carbon to allocate here,
+                      ! since min_stomate is not equal to zero.  If there is
+                      ! enough of this small carbon in every circ class, and there
+                      ! are enough circ classes, ordinary allocation will be skipped
+                      ! below and we might try to force allocation, which is silly
+                      ! if the different in the root masses is around 1e-8. This
+                      ! means we will allocate a tiny amount to the roots to make
+                      ! sure they are exactly in balance.                  
+                      Cr_incp(l) = MAX(zero, ABS(Cr_target(l) - Cr(l)))
+                      Cs_incp(l) = MAX( MIN(b_inc_tot/circ_class_n(ipts,j,l) - &
+                           Cl_incp(l) - Cr_incp(l), Cs_target(l) - Cs(l)), zero )
+
+                      ! Write debug comments to output file
+                      IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                         CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                              delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                              KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, &
+                              grow_wood, circ_class_n, 5)
+                      ENDIF                     
+
+                   ! Need both wood and roots to restore the allometric relationships
+                   ELSEIF ( ABS(Cs_target(l) - Cs(l) ) .GT. min_stomate .AND. &
+                        ABS(Cr_target(l) - Cr(l)) .GT. min_stomate ) THEN
+
+                      ! circ_class_ba_eff and circ_class_height_eff are already calculated
+                      ! for a tree in balance. It would be rather complicated to follow
+                      ! the allometric rules for wood allocation (implying changes in height 
+                      ! and basal area) because the tree is not in balance yet. First try 
+                      ! if we can simply satisfy the allocation needs
+                      IF (Cs_target(l) - Cs(l) + Cr_target(l) - Cr(l) .LE. &
+                           b_inc_tot/circ_class_n(ipts,j,l) - Cl_incp(l)) THEN
+                         
+                         Cr_incp(l) = Cr_target(l) - Cr(l)
+                         Cs_incp(l) = Cs_target(l) - Cs(l)
+
+                      ! Try to satisfy the need for roots
+                      ELSEIF (Cr_target(l) - Cr(l) .LE. b_inc_tot/circ_class_n(ipts,j,l) - &
+                           Cl_incp(l)) THEN
+
+                         Cr_incp(l) = Cr_target(l) - Cr(l)
+                         Cs_incp(l) = b_inc_tot/circ_class_n(ipts,j,l) - &
+                              Cl_incp(l) - Cr_incp(l)
+                         
+                      ! There is not enough use whatever is available
+                      ELSE
+                         
+                         Cr_incp(l) = b_inc_tot/circ_class_n(ipts,j,l) - Cl_incp(l)
+                         Cs_incp(l) = zero
+                         
+                      ENDIF
+
+                      ! Write debug comments to output file
+                      IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                         CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                              delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                              KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                              circ_class_n, 6)
+                      ENDIF   
+
+                   ELSE
+
+                      WRITE(numout,*) 'Exc 4-6: unexpected exception'
+                      IF(err_act.GT.1)THEN
+                         CALL ipslerr_p (3,'growth_fun_all',&
+                              'Exc 4-6: unexpected exception','','')
+                      ENDIF
+                      
+                   ENDIF
+
+                !! 5.2.4.3.3 Enough roots to sustain the wood and leaves
+                ELSEIF ( ABS(Cr_target(l) - Cr(l)) .LT. min_stomate ) THEN
+
+                   ! Use the difference between the target and the actual to
+                   ! ensure mass balance closure because l times a values 
+                   ! smaller than min_stomate can still add up to a value 
+                   ! exceeding min_stomate.
+                   Cr_incp(l) = MAX(zero, Cr_target(l) - Cr(l))
+
+                   ! Enough roots and wood, only grow leaves
+                   ! This duplicates Exc 2 and these lines should thus never be called 
+                   IF ( ABS(Cs_target(l) - Cs(l)) .LT. min_stomate ) THEN
+
+                      ! Allocate at the tree level to restore allometric balance
+                      Cs_incp(l) = MAX(zero, Cs_target(l) - Cs(l))
+                      Cl_incp(l) = MAX( MIN(b_inc_tot/circ_class_n(ipts,j,l) - &
+                           Cs_incp(l) - Cr_incp(l), &
+                           Cl_target(l) - Cl(l)), zero )
+
+                      ! Write debug comments to output file
+                      IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                         CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                              delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                              KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                              circ_class_n, 7)
+                      ENDIF
+                   ! Enough leaves and roots. Need to grow sapwood to support the 
+                   ! available canopy and roots. Duplicates Exc. 4 and these lines 
+                   ! should thus never be called 
+                   ELSEIF ( ABS(Cl_target(l) - Cl(l)) .LT. min_stomate ) THEN
+
+                      ! Allocate at the tree level to restore allometric balance
+                      Cl_incp(l) = MAX(zero, Cl_target(l) - Cl(l))
+                      Cs_incp(l) = MAX( MIN(b_inc_tot/circ_class_n(ipts,j,l) - &
+                           Cr_incp(l) - Cl_incp(l), Cs_target(l) - Cs(l) ), zero )
+
+                      ! Write debug comments to output file
+                      IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                         CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                              delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                              KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                              circ_class_n, 8)
+                      ENDIF
+                   ! Need both wood and leaves to restore the allometric relationships
+                   ELSEIF ( ABS(Cs_target(l) - Cs(l)) .GT. min_stomate .AND. &
+                        ABS(Cl_target(l) - Cl(l)) .GT. min_stomate ) THEN
+
+                      ! circ_class_ba_eff and circ_class_height_eff are already calculated
+                      ! for a tree in balance. It would be rather complicated to follow
+                      ! the allometric rules for wood allocation (implying changes in height 
+                      ! and basal area) because the tree is not in balance.First try if we 
+                      ! can simply satisfy the allocation needs
+                      IF (Cs_target(l) - Cs(l) + Cl_target(l) - Cl(l) .LE. &
+                           b_inc_tot/circ_class_n(ipts,j,l) - Cr_incp(l)) THEN
+
+                         Cl_incp(l) = Cl_target(l) - Cl(l)
+                         Cs_incp(l) = Cs_target(l) - Cs(l)
+
+                      ! Try to satisfy the need for leaves
+                      ELSEIF (Cl_target(l) - Cl(l) .LE. b_inc_tot/circ_class_n(ipts,j,l) - &
+                           Cr_incp(l)) THEN
+
+                         Cl_incp(l) = Cl_target(l) - Cl(l)
+                         Cs_incp(l) = b_inc_tot/circ_class_n(ipts,j,l) - &
+                              Cr_incp(l) - Cl_incp(l)
+
+                      ! There is not enough use whatever is available
+                      ELSE
+
+                         Cl_incp(l) = b_inc_tot/circ_class_n(ipts,j,l) - Cr_incp(l)
+                         Cs_incp(l) = zero
+
+                      ENDIF
+
+                      ! Write debug comments to output file
+                      IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                         CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                              delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                              KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                              circ_class_n, 9)
+                      ENDIF
+
+                   ELSE
+
+                      WRITE(numout,*) 'Exc 7-9: unexpected exception'
+                      IF(err_act.GT.1)THEN
+                         CALL ipslerr_p (3,'growth_fun_all',&
+                              'Exc 7-9: unexpected exception','','')
+                      ENDIF
+
+                   ENDIF
+
+                
+                ELSE
+
+                   ! Either Cl_target, Cs_target or Cr_target should be zero
+                   ! Something possibly important was overlooked                   
+                   WRITE(numout,*) 'WARNING 4: logical flaw in the phenological '//&
+                        'allocation, PFT, class: ', j, l
+                   WRITE(numout,*) 'WARNING 4: PFT, ipts: ',j,ipts
+                   WRITE(numout,*) 'Cs - Cs_target', Cs(l), Cs_target(l)
+                   WRITE(numout,*) 'Cl - Cl_target', Cl(l), Cl_target(l)
+                   WRITE(numout,*) 'Cr - Cr_target', Cr(l), Cr_target(l)
+                   IF(err_act.GT.1)THEN
+                       CALL ipslerr_p (3,'growth_fun_all',&
+                            'WARNING 4: logical flaw in the phenological allocation','','')
+                   ENDIF
+
+                ENDIF
+
+                IF ( Cl_incp(l) .GE. zero .OR. Cr_incp(l) .GE. zero .OR. &
+                     Cs_incp(l) .GE. zero) THEN
+
+                   ! Fake allocation for less messy equations in next case, 
+                   ! incp needs to be added to inc at the end
+                   Cl(l) = Cl(l) + Cl_incp(l)
+                   Cr(l) = Cr(l) + Cr_incp(l)
+                   Cs(l) = Cs(l) + Cs_incp(l)
+                   b_inc_tot = b_inc_tot - (circ_class_n(ipts,j,l) * &
+                        (Cl_incp(l) + Cr_incp(l) + Cs_incp(l)))             
+
+                   ! Something is wrong with the calculations
+                   IF (b_inc_tot .LT. -min_stomate) THEN
+                      WRITE(numout,*) 'WARNING 5: numerical problem, '//&
+                           'overspending in phenological allocation'
+                      WRITE(numout,*) 'WARNING 5: PFT, ipts: ',j,ipts
+                      CALL ipslerr_p (3,'growth_fun_all',&
+                           'WARNING 5: numerical problem, overspending in',&
+                           'phenological allocation','')
+                   ENDIF
+
+                ELSE
+
+                   ! The code was written such that the increment pools should be 
+                   ! greater than or equal to zero. If this is not the case, something 
+                   ! fundamental is wrong with the if-then constructs under Â§5.2.4.3
+                   WRITE(numout,*) 'WARNING 6: PFT, ipts: ',j,ipts
+                   CALL ipslerr_p (3,'growth_fun_all',&
+                        'WARNING 6: numerical problem,',&
+                        'one of the increment pools is less than zero','')
+                ENDIF
+
+                ! Set counter for next circumference class
+                l = l-1
+
+             ENDDO ! DO WHILE l.GE.1 .AND. b_inc_tot .GT. min_stomate
+
+             !! 5.2.4 Record basal area growth during phenological growth 
+             ! During phenological growth, some carbon may have been allocated
+             ! to the sapwood which then resulted in an increase in basal area
+             ! This increase in basal area has not been recorded yet. This
+             ! is done below. Later in the code, this increase is then added to
+             ! th increase in basal area due to ordinary growth to obtain the 
+             ! total increase which is an output variable and is used to 
+             ! calculate the tree ring width.
+             ba1(:) = wood_to_ba_eff(circ_class_biomass(ipts,j,:,:,icarbon),j)
+             temp_mass(:,:) = circ_class_biomass(ipts,j,:,:,icarbon)
+             temp_mass(:,isapabove) = temp_mass(:,isapabove) + Cs_incp(:)
+             ba2(:) = wood_to_ba_eff(temp_mass,j)
+             store_delta_ba(ipts,j,:) = ba2(:) - ba1(:)
+
+             !! 5.2.5 Calculate the expected size of the reserve pool
+             !  Reserve and labile pools are calculated at the stand level so 
+             !  first calculate the stand level biomass from the tree level 
+             !  biomass and the number of trees. Note that this value might
+             !  be different from the previous values calculated in biomass
+             !  because phenological growth could have increased the 
+             !  sapwood biomass. 
+             tmp_bm(ipts,j,:,:) = cc_to_biomass(ipts,j,&
+                  circ_class_biomass(ipts,j,:,:,:),&
+                  circ_class_n(ipts,j,:))
+
+             ! use the minimum of either (1) 2% of the total sapwood biomass 
+             ! or (2) the amount of carbon needed to develop the optimal LAI 
+             ! and the roots. This reserve pool estimate is only used to decide 
+             ! whether wood should be grown or not. When really dealing with 
+             ! the reserves the reserve pool is recalculated. See further below Â§7.1. 
+!!$             reserve_pool = MIN( 0.02 * ( tmp_bm(ipts,j,isapabove,icarbon) + &
+!!$                  tmp_bm(ipts,j,isapbelow,icarbon)), &
+!!$                  lai_to_biomass(lai_target(ipts,j),j)*(1.+0.3/ltor(ipts,j)))
+             reserve_pool = MIN( 0.12 * ( tmp_bm(ipts,j,isapabove,icarbon) + & 
+                  tmp_bm(ipts,j,isapbelow,icarbon)), &
+                  lai_to_biomass(lai_target(ipts,j),j) * &
+                  (1.+root_reserve(j)/ltor(ipts,j)))               
+             grow_wood = .TRUE.
+
+             ! If the carbohydrate pool is too small, don't grow wood
+             IF ( (pheno_type(j) .NE. 1) .AND. &
+                  (tmp_bm(ipts,j,icarbres,icarbon) .LE. reserve_pool) ) THEN
+
+                grow_wood = .FALSE.
+
+             ENDIF
+
+             ! Write debug comments to output file
+             IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                     delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                     KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                     circ_class_n, 10)
+             ENDIF
+
+             !! 5.2.6 Ordinary growth
+             !  Allometric relationship between components is respected, sustain 
+             !  ordinary growth and allocate
+             !  biomass to leaves, wood, roots and fruits.
+             IF ( (SUM( ABS(Cl_target(:) - Cl(:)) ) .LE. min_stomate) .AND. &
+                  (SUM( ABS(Cs_target(:) - Cs(:)) ) .LE. min_stomate) .AND. &
+                  (SUM( ABS(Cr_target(:) - Cr(:)) ) .LE. min_stomate) .AND. &
+                  (grow_wood) .AND. (b_inc_tot .GT. min_stomate) ) THEN
+
+                ! Allocate fraction of carbon to fruit production (at the tree level)
+                Cf_inc(:) = b_inc_tot / SUM(circ_class_n(ipts,j,:)) * fruit_alloc(j)
+
+                ! Residual carbon is allocated to the other components (b_inc_tot is
+                ! at the stand level)
+                b_inc_tot = b_inc_tot * (un-fruit_alloc(j))
+
+                ! Substitute (7), (8) and (9) in (1) 
+                ! b_inc = tree_ff*pipe_density*(ba+circ_class_dba*gammas)*...
+                ! (height+(circ_class_dba/s*gammas)) - Cs - Ch + ...
+                !    KF*tree_ff*pipe_density*(ba+circ_class_dba*gammas) - ... 
+                !    (KF*Ch)/(height+(circ_class_dba/s*gammas)) - Cl + ...
+                !    KF/LF*tree_ff*pipe_density*(ba+circ_class_dba*gammas) - ...
+                !    (KF*Ch/LF)/(height+(circ_class_dba/s*gammas)) - Cr
+                !
+                ! b_inc+Cs+Ch+Cl+Cr = tree_ff*pipe_density*(ba+circ_class_dba*gammas)*...
+                !    (height+(circ_class_dba/s*gammas))  + ...
+                !    KF*tree_ff*pipe_density*(ba+circ_class_dba*gammas) - ...
+                !    (KF*Ch)/(height+(circ_class_dba/s*gammas)) + ...
+                !    KF/LF*tree_ff*pipe_density*(ba+circ_class_dba*gammas) - ...
+                !    (KF*Ch/LF)/(height+(circ_class_dba/s*gammas))
+                ! <=> b_inc+Cs+Ch+Cl+Cr = circ_class_dba^2/s*tree_ff*...
+                !    pipe_density*gammas^2 + circ_class_dba/s*ba*tree_ff*...
+                !    pipe_density*gammas + ...
+                !    circ_class_dba*height*tree_ff*pipe_density*gammas + ...
+                !    bcirc_class_dba*height*tree_ff*pipe_density - ...
+                !    (Ch*KF*s)/(circ_class_dba*gammas+height*s) + ...
+                !    circ_class_dba*KF*tree_ff*pipe_density*gammas + ...
+                !    ba*KF*tree_ff*pipe_density - ...
+                !    (Ch*KF*s)/(LF*(circ_class_dba*gammas+height*s)) + ...
+                !    circ_class_dba*KF/LF*tree_ff*pipe_density*gammas + ...
+                !    ba*KF/LF*tree_ff*pipe_density
+                ! (10) b_inc+Cs+Ch+Cl+Cr = (circ_class_dba^2/s*tree_ff*...
+                !    pipe_density)*gammas^2 + ...
+                !    (circ_class_dba/s*ba*tree_ff*pipe_density + ...
+                !    circ_class_dba*height*tree_ff*pipe_density + ...
+                !    circ_class_dba*KF*tree_ff*pipe_density + ...
+                !    circ_class_dba*KF/LF*tree_ff*pipe_density)*gammas - ...
+                !    (Ch*KF*s)(1+1/LF)/(circ_class_dba*gammas+height*s) + ...
+                !    bcirc_class_dba*height*tree_ff*pipe_density + ...
+                !    ba*KF*tree_ff*pipe_density + ba*KF/LF*tree_ff*pipe_density
+                !
+                ! Note that b_inc is not known, only b_inc_tot (= sum(b_inc) is known. 
+                ! The above equations are for individual trees, at the stand level we 
+                ! have to take the sum over the individuals which is 
+                ! equivalant to substituting (10) in (2) 
+                ! (11) sum(b_inc) + sum(Cs+Ch+Cl+Cr) = ...
+                !    sum(circ_class_dba^2/s*tree_ff*pipe_density) * gammas^2 + ...
+                !    sum(circ_class_dba/s*ba*tree_ff*pipe_density + ...
+                !    circ_class_dba*height*tree_ff*pipe_density + ...
+                !    circ_class_dba*KF*tree_ff*pipe_density + ...
+                !    circ_class_dba*KF/LF*tree_ff*pipe_density) * gammas - ...
+                !    sum[(Ch*KF*s)(1+1/LF)/(circ_class_dba*gammas+height*s)] + ...
+                !    sum(bcirc_class_dba*height*tree_ff*pipe_density + ...
+                !    ba*KF*tree_ff*pipe_density + ba*KF/LF*tree_ff*pipe_density)
+                !
+                ! The term sum[(Ch*KF*s)(1+1/LF)/(circ_class_dba*gammas+height*s)] 
+                ! can be approximated by a series expansion
+                ! (12) sum((Ch*KF*s)(1+1/LF)/(height*s) + ...
+                !    sum((Ch*KF*s)(1+1/LF)*circ_class_dba/(height*s)^2)*gammas + ...
+                !    sum((Ch*KF*s)(1+1/LF)*circ_class_dba^2/(height*s)^3)*gammas^2
+                !
+                ! Substitute (12) in (11)
+                ! sum(b_inc) + sum(Cs+Ch+Cl+Cr) = ...
+                !    sum(circ_class_dba^2/s*tree_ff*pipe_density - ...
+                !    (Ch*KF*s)*(1+1/LF)*circ_class_dba^2/(height*s)^3) * gammas^2 + ...
+                !    sum(circ_class_dba/s*ba*tree_ff*pipe_density + ...
+                !    circ_class_dba*height*tree_ff*pipe_density + ...
+                !    circ_class_dba*KF*tree_ff*pipe_density + ...
+                !    circ_class_dba*KF/LF*tree_ff*pipe_density + ...
+                !    (Ch*KF*s)*(1+1/LF)*circ_class_dba/(height*s)^2) * gammas + ...
+                !    sum(bcirc_class_dba*height*tree_ff*pipe_density + ...
+                !    ba*KF*tree_ff*pipe_density + ba*KF/LF*tree_ff*pipe_density - ...
+                !    (Ch*KF*s)*(1+1/LF)/(height*s))
+                !
+                ! Solve this quadratic equation for gammas.
+                a = SUM( circ_class_n(ipts,j,:) * &
+                     (circ_class_dba(:)**2/s(:)*tree_ff(j)*pipe_density(j) - &
+                     (Ch(:)*KF(ipts,j)*s(:))*(1+1/LF(ipts,j))*&
+                     (circ_class_dba(:)**2/(circ_class_height_eff(:)*s(:))**3)) )
+                b = SUM( circ_class_n(ipts,j,:) * &
+                     (circ_class_dba(:)/s(:)*circ_class_ba_eff(:)*tree_ff(j)*pipe_density(j) + &
+                     circ_class_dba(:)*circ_class_height_eff(:)*tree_ff(j)*pipe_density(j) + &
+                     circ_class_dba(:)*KF(ipts,j)*tree_ff(j)*pipe_density(j) + &
+                     circ_class_dba(:)*KF(ipts,j)/LF(ipts,j)*tree_ff(j)*pipe_density(j) + &
+                     (Ch(:)*KF(ipts,j)*s(:))*(1+1/LF(ipts,j))*circ_class_dba(:)/&
+                     (circ_class_height_eff(:)*s(:))**2) )
+                c = SUM( circ_class_n(ipts,j,:) * &
+                     (circ_class_ba_eff(:)*circ_class_height_eff(:)*&
+                     tree_ff(j)*pipe_density(j) + &
+                     circ_class_ba_eff(:)*KF(ipts,j)*tree_ff(j)*pipe_density(j) + &
+                     circ_class_ba_eff(:)*KF(ipts,j)/LF(ipts,j)*tree_ff(j)*pipe_density(j) - &
+                     (Ch(:)*KF(ipts,j)*s(:))*(1+1/LF(ipts,j))/&
+                     (circ_class_height_eff(:)*s(:)) - &
+                     (Cs(:) + Ch(:) + Cl(:) + Cr(:))) ) - b_inc_tot
+
+                ! Solve the quadratic equation a*gammas2 + b*gammas + c = 0, for gammas.
+                gammas(ipts,j) = (-b + sqrt(b**2-4*a*c)) / (2*a)  
+                
+                ! The solution for gammas is then used to calculate delta_ba (eq. 3), 
+                ! delta_height (eq. 6), Cs_inc (eq. 7), Cl_inc (eq. 8) and Cr_inc (eq. 9). 
+                ! See comment on the calculation of delta_height and its implications on 
+                ! numerical consistency at the similar statement in Â§5.2.4.3.1
+
+                !delta_ba is a sum of phenological and ordinary growth
+                !but for further calculation, re-calculate delta_ba considering only ordinary growth 
+                delta_ba(:) = circ_class_dba(:) * gammas(ipts,j)                
+                store_delta_ba(ipts,j,:) = store_delta_ba(ipts,j,:) + delta_ba(:)
+                delta_height(:) = delta_ba(:)/s(:)              
+                Cs_inc(:) = tree_ff(j)*pipe_density(j)*(circ_class_ba_eff(:) + &
+                     delta_ba(:))*(circ_class_height_eff(:) + &
+                     delta_height(:)) - Cs(:) - Ch(:)
+                Cl_inc(:) = KF(ipts,j)*tree_ff(j)*pipe_density(j)*&
+                     (circ_class_ba_eff(:)+delta_ba(:)) - &
+                     (KF(ipts,j)*Ch(:))/(circ_class_height_eff(:)+delta_height(:)) - Cl(:)
+                Cr_inc = KF(ipts,j)/LF(ipts,j)*tree_ff(j)*pipe_density(j)*&
+                     (circ_class_ba_eff(:)+delta_ba(:)) - &
+                     (KF(ipts,j)*Ch(:)/LF(ipts,j))/(circ_class_height_eff(:)+&
+                     delta_height(:)) - Cr(:)
+
+                ! Write the initial residual to the history file to check
+                ! whether all goes well
+                residual_write(ipts,j) = b_inc_tot - SUM(circ_class_n(ipts,j,:)* &
+                     (Cl_inc(:) + Cr_inc(:) + Cs_inc(:)))
+
+                ! If the residual is larger than expected, reduce gamma a bit and 
+                ! recalculate the allocation. The residual is added then back into
+                ! the labile pool.
+                IF (b_inc_tot - SUM(circ_class_n(ipts,j,:)* &
+                     (Cl_inc(:) + Cr_inc(:) + Cs_inc(:))).LT. -min_stomate) THEN
+                   WRITE(numout,*) 'WARNING: residual, ',j,b_inc_tot - &
+                        SUM(circ_class_n(ipts,j,:)* &
+                        (Cl_inc(:) + Cr_inc(:) + Cs_inc(:)))
+                   WRITE(numout,*) 'WARNING: allocation is being adjusted'
+                   
+                   ! It is considered too large so we try to reduce the residual with some
+                   ! brute force
+                   delta_ba(:) = circ_class_dba(:) * gammas(ipts,j) * 0.99
+                   store_delta_ba(ipts,j,:) = store_delta_ba(ipts,j,:)+delta_ba(:)
+                   delta_height(:) = delta_ba(:)/s(:)              
+                   Cs_inc(:) = tree_ff(j)*pipe_density(j)*(circ_class_ba_eff(:) + &
+                        delta_ba(:))*(circ_class_height_eff(:) + &
+                        delta_height(:)) - Cs(:) - Ch(:)
+                   Cl_inc(:) = KF(ipts,j)*tree_ff(j)*pipe_density(j)*&
+                        (circ_class_ba_eff(:)+delta_ba(:)) - &
+                        (KF(ipts,j)*Ch(:))/(circ_class_height_eff(:)+delta_height(:)) - Cl(:)
+                   Cr_inc = KF(ipts,j)/LF(ipts,j)*tree_ff(j)*pipe_density(j)*&
+                        (circ_class_ba_eff(:)+delta_ba(:)) - &
+                        (KF(ipts,j)*Ch(:)/LF(ipts,j))/(circ_class_height_eff(:)+&
+                        delta_height(:)) - Cr(:)
+
+                   ! Now we may have some carbon left which we will not
+                   ! try to allocate. Reduce b_inc_tot and move the
+                   ! difference back into the labile pool where it comes
+                   ! from.
+                   b_inc_tot =  b_inc_tot - (b_inc_tot - SUM(circ_class_n(ipts,j,:)* &
+                        (Cl_inc(:) + Cr_inc(:) + Cs_inc(:))))
+                   tmp_bm(ipts,j,ilabile,icarbon) = tmp_bm(ipts,j,ilabile,icarbon) + &
+                        b_inc_tot - SUM(circ_class_n(ipts,j,:)* &
+                        (Cl_inc(:) + Cr_inc(:) + Cs_inc(:)))
+                   WRITE(numout,*) 'WARNING: new residual, ',b_inc_tot-&
+                        SUM(circ_class_n(ipts,j,:)* &
+                        (Cl_inc(:) + Cr_inc(:) + Cs_inc(:)))
+                 
+                ENDIF
+
+                ! After thousands of simulation years we had a single pixel where 
+                ! one of the three circ_class got a negative growth. The cause is
+                ! not entirely clear but could be related to the fact that KF
+                ! changes from one day to another in combination with a low b_inc.
+                ! If this happens, we don't allocate and simply leave the carbon
+                ! in the labile pool. We will try again with more carbon the next day.
+                ! This case is dealt with later in the code - see warning 10
+                
+                ! Debug
+                IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                   WRITE(numout,*) 'a, b, c, gammas, ', a, b, c, gammas(ipts,j)
+                   WRITE(numout,*) 'delta_height, ', delta_height(:)
+                   CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                        delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                        KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                        circ_class_n, 11)
+                ENDIF
+                !-
+
+                ! Wrap-up ordinary growth  
+                ! Calculate C that was not allocated, note that Cf_inc was already 
+                ! subtracted
+                b_inc_tot = b_inc_tot - &
+                     SUM(circ_class_n(ipts,j,:)*(Cl_inc(:) + Cr_inc(:) + Cs_inc(:)))
+
+                ! Debug
+                IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                   WRITE(numout,*) 'wrap-up ordinary allocation, left b_in_tot, ', &
+                        b_inc_tot 
+                ENDIF
+                !-
+
+             !! 5.2.7 Don't grow wood, use C to fill labile pool
+             ELSEIF ( (.NOT. grow_wood) .AND. (b_inc_tot .GT. min_stomate) ) THEN
+
+                ! Calculate the C that needs to be distributed to the 
+                ! labile pool. The fraction is proportional to the ratio 
+                ! between the total allocatable biomass and the unallocated 
+                ! biomass per tree (b_inc now contains the unallocated 
+                ! biomass). At the end of the allocation scheme bm_alloc_tot 
+                ! is substracted from the labile biomass pool to update the 
+                ! biomass pool (tmp_bm(:,:,ilabile) = tmp_bm(:,:,ilabile) - 
+                ! bm_alloc_tot(:,:)). At that point, the scheme puts the 
+                ! unallocated b_inc into the labile pool. What we 
+                ! want is that the unallocated fraction is removed from 
+                ! ::bm_alloc_tot such that only the allocated C is removed 
+                ! from the labile pool. b_inc_tot will be moved back into
+                ! the labile pool in 5.2.11
+                bm_alloc_tot(ipts,j) = bm_alloc_tot(ipts,j) - b_inc_tot
+                tmp_bm(ipts,j,ilabile,icarbon) = &
+                     tmp_bm(ipts,j,ilabile,icarbon) + b_inc_tot 
+
+                ! Wrap-up ordinary growth  
+                ! Calculate C that was not allocated (b_inc_tot), the 
+                ! equation should read b_inc_tot = b_inc_tot - b_inc_tot 
+                ! note that Cf_inc was already substracted
+                b_inc_tot = zero 
+
+                ! Debug
+                IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                   WRITE(numout,*) 'No wood growth, move remaining C to labile pool'
+                   WRITE(numout,*) 'bm_alloc_tot_new, ',bm_alloc_tot(ipts,j)
+                   WRITE(numout,*) 'wrap-up ordinary allocation, left b_inc_tot, ', &
+                        b_inc_tot 
+                ENDIF
+                !-
+
+             !! 5.2.8 Error - the allocation scheme is overspending 
+             ELSEIF (b_inc_tot .LT. min_stomate) THEN
+
+                IF (b_inc_tot .LT. -min_stomate) THEN
+
+                   ! Something is wrong with the calculations
+                   WRITE(numout,*) 'WARNING 7: numerical problem overspending '//&
+                        'in ordinary allocation'
+                   WRITE(numout,*) 'WARNING 7: PFT, ipts: ',j,ipts
+                   WRITE(numout,*) 'WARNING 7: b_inc_tot', b_inc_tot
+                   IF(err_act.GT.1)THEN
+                      CALL ipslerr_p (3,'growth_fun_all',&
+                           'WARNING 7: numerical problem',&
+                           'overspending in ordinary allocation','')
+                   ENDIF
+
+                ELSE
+
+                   IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+
+                      ! Succesful allocation
+                      WRITE(numout,*) 'Successful allocation'
+
+                   ENDIF
+
+                ENDIF
+
+                ! Although the biomass components respect the allometric 
+                ! relationships, there is no carbon left to allocate                      
+                b_inc_tot = zero
+                Cl_inc(:) = zero
+                Cs_inc(:) = zero
+                Cr_inc(:) = zero
+                Cf_inc(:) = zero
+
+             ENDIF ! Ordinary allocation
+
+             ! Update circ_class_biomass
+             circ_class_biomass(ipts,j,:,ilabile,icarbon) = &
+                  biomass_to_cc(tmp_bm(ipts,j,ilabile,icarbon),&
+                  circ_class_biomass(ipts,j,:,ilabile,icarbon),&
+                  circ_class_n(ipts,j,:))
+             circ_class_biomass(ipts,j,:,icarbres,icarbon) = &
+                  biomass_to_cc(tmp_bm(ipts,j,icarbres,icarbon),&
+                  circ_class_biomass(ipts,j,:,icarbres,icarbon),&
+                  circ_class_n(ipts,j,:))
+             !! 5.2.9 Error checking
+             IF ( b_inc_tot .GT. min_stomate) THEN
+
+                ! Although this should not happen. In case the functional 
+                ! allocation did not consume all the allocatable carbon, 
+                ! the remaining C is left for the next day. The numerical 
+                ! precision of the allocation scheme (i.e. the linearisation) 
+                ! is similar to min_stomate (i.e. 10-8) resulting in 'false' 
+                ! warnings.
+                WRITE(numout,*) 'WARNING 8: b_inc_tot greater than min_stomate '//&
+                     'force allocation'
+                WRITE(numout,*) 'WARNING 8: PFT, ipts: ',j,ipts
+                WRITE(numout,*) 'WARNING 8: b_inc_tot, ', b_inc_tot
+                IF(err_act.GT.1)THEN
+                   CALL ipslerr_p (3,'growth_fun_all',&
+                        'WARNING 8: b_inc_tot greater than min_stomate',&
+                        'force allocation','')
+                ENDIF
+
+             ELSEIF ( (b_inc_tot .LT. min_stomate) .AND. (b_inc_tot .GE. -min_stomate) ) THEN
+
+                ! Successful allocation
+                IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                   WRITE(numout,*) 'Successful allocation'
+                ENDIF
+
+             ELSE
+
+                ! Something possibly important was overlooked
+                IF ( (b_inc_tot .LT. 100*min_stomate) .AND. &
+                     (b_inc_tot .GE. -100*min_stomate) ) THEN
+                   IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                      WRITE(numout,*) 'Marginally successful allocation - '//&
+                           'precision better than 5 10-6'
+                      WRITE(numout,*) 'PFT, b_inc_tot', j, b_inc_tot
+                   ENDIF
+                ELSE
+                   WRITE(numout,*) 'WARNING 9: Logical flaw '//&
+                        'unexpected result in the ordinary allocation'
+                   WRITE(numout,*) 'WARNING 9: b_inc_tot, ',b_inc_tot
+                   WRITE(numout,*) 'WARNING 9: PFT, ipts: ',j,ipts
+                   IF(err_act.GT.1)THEN
+                      CALL ipslerr_p (3,'growth_fun_all',&
+                           'WARNING 9: Logical flaw',&
+                           'unexpected result in the ordinary allocation','')
+                   ENDIF
+                ENDIF
+
+             ENDIF
+
+             ! The second problem we need to catch is when one of the increment pools 
+             ! is negative. This is an undesired outcome (see comment where ::KF_old 
+             ! is calculated in this routine. In that case we write a warning, set all 
+             ! increment pools to zero and try it again at the next time step. A likely 
+             ! cause of this problem is a too large change in KF from one time step to 
+             ! another. Try decreasing the acceptable value for an absolute increase 
+             ! in KF.
+             IF (MINVAL(Cs_inc(:)) .LT. zero .OR. MINVAL(Cr_inc(:)) .LT. zero .OR. &
+                  MINVAL(Cs_inc(:)) .LT. zero) THEN
+
+                ! Do not allocate - save the carbon for the next time step
+                WRITE(numout,*) 'WARNING 10: numerical problem, '//&
+                     'one of the increment pools is less than zero'
+                WRITE(numout,*) 'WARNING 10: PFT, ipts: ',j,ipts
+                WRITE(numout,*) 'WARNING 10: Cl_inc(:): ',Cl_inc(:)
+                WRITE(numout,*) 'WARNING 10: Cr_inc(:): ',Cr_inc(:)
+                WRITE(numout,*) 'WARNING 10: Cs_inc(:): ',Cs_inc(:)
+                WRITE(numout,*) 'WARNING 10: PFT, ipts: ',j,ipts
+                WRITE(numout,*) 'WARNING 10: We will undo the allocation'
+                WRITE(numout,*) ' and save the carbon for the next day'
+
+                ! Reverse the allocation
+                b_inc_tot = b_inc_tot + &
+                     SUM(circ_class_n(ipts,j,:)*(Cl_inc(:) + Cr_inc(:) + Cs_inc(:)))
+                Cl_inc(:) = zero
+                Cr_inc(:) = zero
+                Cs_inc(:) = zero
+
+             ENDIF
+
+             !! 5.2.10 Wrap-up phenological and ordinary allocation
+             Cl_inc(:) = Cl_inc(:) + Cl_incp(:)
+             Cr_inc(:) = Cr_inc(:) + Cr_incp(:)
+             Cs_inc(:) = Cs_inc(:) + Cs_incp(:)
+             residual(ipts,j) = b_inc_tot
+
+             !Debug
+             IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                WRITE(numout,*) 'Final allocation', ipts, j
+                WRITE(numout,*) 'Cl, Cs, Cr', Cl(:), Cs(:), Cr(:) 
+                WRITE(numout,*) 'Cl_incp, Cs_incp, Cr_incp, ', &
+                     Cl_incp(:), Cs_incp(:), Cr_incp(:)
+                WRITE(numout,*) 'Cl_inc, Cs_ins, Cr_inc, Cf_inc, ', &
+                     Cl_inc(:), Cs_inc(:), Cr_inc(:), Cf_inc(:)
+                WRITE(numout,*) 'unallocated/residual, ', b_inc_tot
+                WRITE(numout,*) 'Old ba, delta_ba, new ba, ', circ_class_ba_eff(:), &
+                     delta_ba(:), circ_class_ba_eff(:)+delta_ba(:)
+                DO l=1,ncirc
+                   WRITE(numout,*) 'Circ_class_biomass, ', &
+                        circ_class_biomass(ipts,j,l,:,icarbon)
+                ENDDO
+             ENDIF
+             !-
+
+             !! 5.2.11 Account for the residual
+             !  The residual is usually around ::min_stomate but we deal 
+             !  with it anyway to make sure the mass balance is closed
+             !  and as a way to detect errors. Move the unallocated carbon
+             !  back into the labile pool
+             IF (tmp_bm(ipts,j,ilabile,icarbon) + residual(ipts,j) .LE. min_stomate) THEN
+
+                deficit = tmp_bm(ipts,j,ilabile,icarbon) + residual(ipts,j)
+
+                ! The deficit is less than the carbon reserve
+                IF (-deficit .LE. tmp_bm(ipts,j,icarbres,icarbon)) THEN
+
+                   ! Pay the deficit from the reserve pool
+                   tmp_bm(ipts,j,icarbres,icarbon) = &
+                        tmp_bm(ipts,j,icarbres,icarbon) + deficit
+                   tmp_bm(ipts,j,ilabile,icarbon)  = &
+                        tmp_bm(ipts,j,ilabile,icarbon) - deficit
+
+                ELSE
+
+                   ! Not enough carbon to pay the deficit
+                   ! There is likely a bigger problem somewhere in
+                   ! this routine
+                   WRITE(numout,*) 'WARNING 11: PFT, ipts: ',j,ipts
+                   CALL ipslerr_p (3,'growth_fun_all',&
+                        'WARNING 11: numerical problem overspending ',&
+                        'when trying to account for unallocatable C ','')
+
+                ENDIF
+
+             ELSE
+
+                ! Move the unallocated carbon back into the labile pool
+                tmp_bm(ipts,j,ilabile,icarbon) = &
+                     tmp_bm(ipts,j,ilabile,icarbon) + residual(ipts,j)
+
+             ENDIF
+             
+             !! 5.2.12 Distribute stand level ilabile and icarbres at the tree level
+             !  The labile and carbres pools are calculated at the stand level but
+             !  have to be redistributed at the tree level. Tree level biomass is the
+             !  prognostic variable in ORCHIDEE. Biomass is sometimes used as a local
+             !  variable mainly to deal with the reserve and labile pools.
+             circ_class_biomass(ipts,j,:,ilabile,icarbon) = &
+                  biomass_to_cc(tmp_bm(ipts,j,ilabile,icarbon),&
+                  circ_class_biomass(ipts,j,:,ilabile,icarbon),&
+                  circ_class_n(ipts,j,:))
+             circ_class_biomass(ipts,j,:,icarbres,icarbon) = &
+                  biomass_to_cc(tmp_bm(ipts,j,icarbres,icarbon),&
+                  circ_class_biomass(ipts,j,:,icarbres,icarbon),&
+                  circ_class_n(ipts,j,:))
+             
+             !! 5.2.13 Standardise allocation factors
+             !  Strictly speaking the allocation factors do not need to be 
+             !  calculated because the functional allocation scheme allocates 
+             !  absolute amounts of carbon. Hence, Cl_inc could simply be 
+             !  added to tmp_bm(:,:,ileaf,icarbon), Cr_inc to 
+             !  tmp_bm(:,:,iroot,icarbon), etc. However, using allocation 
+             !  factors bears some elegance in respect to distributing the 
+             !  growth respiration if this would be required. Further it 
+             !  facilitates comparison to the resource limited allocation 
+             !  scheme (stomate_growth_res_lim.f90) and it comes in handy 
+             !  for model-data comparison. This allocation takes place at 
+             !  the tree level - note that ::biomass is the only prognostic 
+             !  variable from the tree-based allocation
+             !  WARNING: the reserves pools are ignored when calculating
+             !  the allocation factors. Make sure this is OK for you before
+             !  using these factors.
+
+             !  Allocation   
+             Cl_inc(:) = MAX(zero, circ_class_n(ipts,j,:) * Cl_inc(:))
+             Cr_inc(:) = MAX(zero, circ_class_n(ipts,j,:) * Cr_inc(:))
+             Cs_inc(:) = MAX(zero, circ_class_n(ipts,j,:) * Cs_inc(:))
+             Cf_inc(:) = MAX(zero, circ_class_n(ipts,j,:) * Cf_inc(:))
+
+             ! Total_inc is based on the updated Cl_inc, Cr_inc, Cs_inc and 
+             ! Cf_inc. Therefore, do not multiply
+             ! circ_class_n(ipts,j,:) again
+             total_inc = SUM(Cf_inc(:) + Cl_inc(:) + Cs_inc(:) + Cr_inc(:))
+
+             ! Relative allocation
+             IF ( total_inc .GT. min_stomate ) THEN
+
+                Cl_inc(:) = Cl_inc(:) / total_inc
+                Cs_inc(:) = Cs_inc(:) / total_inc
+                Cr_inc(:) = Cr_inc(:) / total_inc
+                Cf_inc(:) = Cf_inc(:) / total_inc
+
+             ELSE
+
+                bm_alloc_tot(ipts,j) = zero
+                Cl_inc(:) = zero
+                Cs_inc(:) = zero
+                Cr_inc(:) = zero
+                Cf_inc(:) = zero
+
+             ENDIF
+
+             !! 5.2.13 Convert allocation to allocation facors
+             !  Convert allocation of individuals to ORCHIDEE's allocation 
+             !  factors - see comment for 5.2.5. Aboveground sapwood 
+             !  allocation is age dependent in trees. ::alloc_min and 
+             !  ::alloc_max must range between 0 and 1. 
+             alloc_sap_above = alloc_min(j) + ( alloc_max(j) - alloc_min(j) ) * &
+                  ( 1. - EXP( -age(ipts,j) / demi_alloc(j) ) )
+
+             ! Leaf, wood, root and fruit allocation. Note that the X_inc
+             ! are normalized before being used here.
+             f_alloc(ipts,j,ileaf) = SUM(Cl_inc(:))
+             f_alloc(ipts,j,isapabove) = SUM(Cs_inc(:)*alloc_sap_above)
+             f_alloc(ipts,j,isapbelow) = SUM(Cs_inc(:)*(1.-alloc_sap_above))
+             f_alloc(ipts,j,iroot) = SUM(Cr_inc(:))
+             f_alloc(ipts,j,ifruit) = SUM(Cf_inc(:))
+
+             ! Store f_alloc per circ_class to calculate the allocation
+             ! in circ_class_biomass after bm_alloc_tot has been checked
+             ! for the N availability. Note that the X_inc
+             ! are normalized before being used here.
+             f_alloc_circ(ipts,:,ileaf) = Cl_inc(:)
+             f_alloc_circ(ipts,:,isapabove) = Cs_inc(:)*alloc_sap_above
+             f_alloc_circ(ipts,:,isapbelow) = Cs_inc(:)*(1.-alloc_sap_above)
+             f_alloc_circ(ipts,:,iroot) = Cr_inc(:)
+             f_alloc_circ(ipts,:,ifruit) = Cf_inc(:)
+
+             ! Debug
+             IF (printlev_loc.GE.4) THEN
+                tempi = zero
+                DO icir = 1,ncirc
+                   IF (Cl_inc(icir) .LT. zero .OR. &
+                        Cs_inc(icir) * alloc_sap_above .LT. zero .OR. &
+                        Cs_inc(icir) * (un - alloc_sap_above) .LT. zero .OR. &
+                        Cr_inc(icir) .LT. zero .OR. & 
+                        Cf_inc(icir) .LT. zero .OR. &
+                        total_inc .LT. zero .OR. &
+                        circ_class_n(ipts,j,icir) .LT. zero) THEN
+                      WRITE(numout,*) 'Cl_inc, ', j, Cl_inc(icir)
+                      WRITE(numout,*) 'Cs_inc aboveground, ', j, &
+                           Cs_inc(icir) * alloc_sap_above
+                      WRITE(numout,*) 'Cs_inc aboveground, ', j, &
+                           Cs_inc(icir) * (un-alloc_sap_above)
+                      WRITE(numout,*) 'Cr_inc, ', j, Cr_inc(icir)
+                      WRITE(numout,*) 'Cf_inc, ', j, Cf_inc(icir)
+                      WRITE(numout,*) 'total_inc, ', j, total_inc
+                      WRITE(numout,*) 'circ_class_n, ', j, circ_class_n(ipts,j,icir)
+                      CALL ipslerr_p (3,'growth_fun_all',&
+                           'WARNING 11bis: the solution has negative values',&
+                           'None of these variables should be negative','')
+                   ENDIF
+                ENDDO
+             ENDIF
+             !-
+
+          ELSEIF (is_tree(j)) THEN
+       
+             residual(ipts,j) = zero
+             
+             ! Debug
+             IF(printlev_loc.GE.4) WRITE(numout,*) &
+                  'there is no tree biomass to allocate, PFT, ', j
+             !-
+
+          ENDIF ! Is there biomass to allocate (Â§5.2 - far far up)
+
+
+          !! 5.3 Calculate allocated biomass pools for grasses and crops
+          !  Only possible if there is biomass to allocate
+          IF ( .NOT. is_tree(j) .AND. bm_alloc_tot(ipts,j) .GT. min_stomate ) THEN
+
+             !! 5.3.1 Scaling factor to convert variables to the individual plant
+             !  Allocation is on an individual basis (gC ind-1). Stand-level variables 
+             !  need to convert to a single individual. The absence of sapwood makes 
+             !  this irrelevant because the allocation reduces to a linear function 
+             !  (contrary to the non-linearity of tree allocation). For the
+             !  beauty of consistency, the transformations will be implemented.
+             !  Different approach between the DGVM and statitic approach
+             IF (ok_dgvm) THEN
+
+                ! The DGVM does NOT work with the functional allocation. Consider
+                ! this code as a placeholder. The original code had two different 
+                ! transformations to calculate the scalars. Both could be used but 
+                ! the units will differ. For consistency only one was retained 
+                ! scal = ind(ipts,j) * cn_ind(ipts,j) / veget_cov_max(ipts,j)
+                scal(ipts,j) = veget_cov_max(ipts,j) / circ_class_n(ipts,j,1)
+
+             ELSE
+
+                ! By dividing the actual biomass by the number of individuals
+                ! the biomass of an individual is obtained. Note that a grass/crop 
+                ! individual was defined as 1m-2 of vegetation 
+                scal(ipts,j) = 1./ circ_class_n(ipts,j,1)
+
+             ENDIF
+
+             !! 5.3.2 Current biomass pools per grass/crop (gC ind^-1)
+             !  Cs has too many dimensions for grass/crops. To have a consistent 
+             !  notation the same variables are used as for trees but the dimension 
+             !  of Cs, Cl and Cr i.e. ::ncirc should be ignored            
+             Cs(:) = circ_class_biomass(ipts,j,1,isapabove,icarbon) * scal(ipts,j)
+             Cr(:) = circ_class_biomass(ipts,j,1,iroot,icarbon) * scal(ipts,j)
+             Cl(:) = circ_class_biomass(ipts,j,1,ileaf,icarbon) * scal(ipts,j)
+             Ch(:) = zero
+
+             ! Total amount of carbon that needs to be allocated 
+             ! (::bm_alloc_tot). bm_alloc_tot is in gC m-2 day-1. At 1 m2 
+             ! there are ::ind number of grasses.
+             b_inc_tot = bm_alloc_tot(ipts,j)
+
+             !! 5.3.3 C-allocation for crops and grasses
+             !  The mass conservation equations are detailed in the header of 
+             !  this subroutine. The scheme assumes a functional relationships 
+             !  between leaves and roots for grasses and crops. When carbon is 
+             !  added to the leaf biomass pool, an increase in the root biomass 
+             !  is to be expected to sustain water transport from the roots to 
+             !  the leaves.
+
+             !! 5.3.3.1 Do the biomass pools respect the pipe model?
+             !  Do the current leaf, sapwood and root components respect the 
+             !  allometric constraints? Calculate the optimal root and leaf mass, 
+             !  given the current wood mass by using the basic allometric 
+             !  relationships. Calculate the optimal sapwood mass as a function 
+             !  of the current leaf and root mass.
+             Cl_target(1) = MAX( Cs(1) * KF(ipts,j) , Cr(1) * LF(ipts,j), Cl(1) )
+             Cs_target(1) = MAX( Cl_target(1) / KF(ipts,j), &
+                  Cr(1) * LF(ipts,j) / KF(ipts,j), Cs(1) ) 
+             Cr_target(1) = MAX( Cl_target(1) / LF(ipts,j), &
+                  Cs_target(1) * KF(ipts,j) / LF(ipts,j), Cr(1) )
+             
+             ! Debug
+             IF (j .EQ. test_pft .AND. printlev_loc.GE.4) THEN
+                WRITE(numout,*) 'bm_alloc_tot, ',bm_alloc_tot(ipts,j)
+                WRITE(numout,*) 'Does the grass/crop needs reshaping?'
+                WRITE(numout,*) 'KF, LF, ', KF(ipts,j), LF(ipts,j)
+                WRITE(numout,*) 'qm_height, ', (Cl_target(1) * sla(j) * lai_to_height(j))
+                WRITE(numout,*) 'Cl_target-Cl, ', Cl_target(1)-Cl(1), Cl_target(1), Cl(1)
+                WRITE(numout,*) 'Cs_target-Cs, ', Cs_target(1)-Cs(1), Cs_target(1), Cs(1)
+                WRITE(numout,*) 'Cr_target-Cr, ', Cr_target(1)-Cr(1), Cr_target(1), Cr(1)
+             ENDIF
+             !-
+
+             !! 5.3.3.2 Phenological growth
+             !  Phenological growth and reshaping of the grass/crop in line with 
+             !  the pipe model. Turnover removes C from the different plant components 
+             !  but at a component-specific rate, as such the allometric constraints 
+             !  are distorted at every time step and should be restored before ordinary 
+             !  growth can take place
+
+             !! 5.3.3.2.1 The available C can sustain the present leaves and roots
+             !  Calculate whether the structural c is in allometric balance. The target 
+             !  values should always be larger than the current pools so the use of ABS 
+             !  is redundant but was used to be on the safe side (here and in the rest 
+             !  of the module) as it could help to find logical flaws.        
+             IF ( ABS(Cs_target(1) - Cs(1)) .LT. min_stomate ) THEN
+
+                Cs_incp(1) = MAX(zero, Cs_target(1) - Cs(1))
+
+                ! Enough leaves and structural biomass, only grow roots
+                IF ( ABS(Cl_target(1) - Cl(1))  .LT. min_stomate ) THEN
+
+                   ! Allocate at the tree level to restore allometric balance
+                   Cl_incp(1) = MAX(zero, Cl_target(1) - Cl(1))
+                   Cr_incp(1) = MAX( MIN(b_inc_tot / circ_class_n(ipts,j,1) - &
+                        Cs_incp(1) - Cl_incp(1), Cr_target(1) - Cr(1)), zero )
+
+                   ! Write debug comments to output file
+                   IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                      CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                           delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                           KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                           circ_class_n, 12)
+                   ENDIF
+
+                ! Sufficient structural C and roots, allocate C to leaves
+                ELSEIF ( ABS(Cr_target(1) - Cr(1)) .LT. min_stomate ) THEN
+
+                   ! Allocate at the tree level to restore allometric balance 
+                   Cr_incp(1) = MAX(zero, Cr_target(1) - Cr(1))
+                   Cl_incp(1) = MAX( MIN(b_inc_tot / circ_class_n(ipts,j,1) - &
+                        Cs_incp(1) - Cr_incp(1), Cl_target(1) - Cl(1)), zero )
+
+                   ! Update vegetation height
+                   qm_height = biomass_to_lai(Cl(1) + Cl_incp(1),j) * lai_to_height(j)
+               
+                   ! Write debug comments to output file
+                   IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                      CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                           delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                           KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                           circ_class_n, 13)
+                   ENDIF
+
+                ! Both leaves and roots are needed to restore the allometric relationships
+                ELSEIF ( ABS(Cl_target(1) - Cl(1)) .GT. min_stomate .AND. &
+                     ABS(Cr_target(1) - Cr(1)) .GT. min_stomate ) THEN                 
+
+                   ! Allocate at the tree level to restore allometric balance
+                   !  The equations can be rearanged and written as
+                   !  (i) b_inc = Cl_inc + Cr_inc
+                   !  (ii) Cr_inc = (Cl_inc+Cl)/LF - Cr
+                   !  Substitue (ii) in (i) and solve for Cl_inc
+                   !  <=> Cl_inc = (LF*(b_inc+Cr)-Cl)/(1+LF)
+                   Cl_incp(1) = MIN( ((LF(ipts,j) * ((b_inc_tot/circ_class_n(ipts,j,1)) - &
+                        Cs_incp(1) + Cr(1))) - Cl(1)) / (1 + LF(ipts,j)), &
+                        Cl_target(1) - Cl(1) )
+                   Cr_incp(1) = MIN ( ((Cl_incp(1) + Cl(1)) / LF(ipts,j)) - Cr(1), &
+                        Cr_target(1) - Cr(1))
+
+                   ! The imbalance between Cr and Cl can be so big that (Cl+Cl_inc)/LF 
+                   ! is still less then the available root carbon (observed!). This 
+                   ! would result in a negative Cr_incp
+                   IF ( Cr_incp(1) .LT. zero ) THEN
+
+                      Cl_incp(1) = MIN( b_inc_tot/circ_class_n(ipts,j,1) - &
+                           Cs_incp(1), Cl_target(1) - Cl(1) )
+                      Cr_incp(1) = b_inc_tot/circ_class_n(ipts,j,1) - &
+                           Cs_incp(1) - Cl_incp(1)
+
+                   ELSEIF (Cl_incp(1) .LT. zero) THEN
+
+                      Cr_incp(1) = MIN( b_inc_tot/circ_class_n(ipts,j,1) - &
+                           Cs_incp(1), Cr_target(1) - Cr(1) )
+                      Cl_incp(1) = (b_inc_tot/circ_class_n(ipts,j,1)) - &
+                           Cs_incp(1) - Cr_incp(1)
+
+                   ENDIF
+
+                   ! Update vegetation height
+                   qm_height = biomass_to_lai(Cl(1) + Cl_incp(1),j) * lai_to_height(j)
+
+                   ! Write debug comments to output file
+                   IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                      CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                           delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                           KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                           circ_class_n, 14)
+                   ENDIF    
+
+                ELSE
+
+                   WRITE(numout,*) 'WARNING 12: Exc 1-3 unexpected exception'
+                   WRITE(numout,*) 'WARNING 12: PFT, ipts: ',j,ipts
+                   IF(err_act.GT.1)THEN
+                      CALL ipslerr_p (3,'growth_fun_all',&
+                          'WARNING 12: Exc 1-3 unexpected exception','','') 
+                   ENDIF
+
+                ENDIF
+
+
+             !! 5.3.3.3.2 Enough leaves to sustain the structural C and roots
+             ELSEIF ( ABS(Cl_target(1) - Cl(1)) .LT. min_stomate ) THEN
+                
+                Cl_incp(1) = MAX(zero, Cl_target(1) - Cl(1))
+
+                ! Enough leaves and structural C, only grow roots
+                ! This duplicates Exc 1 and these lines should never be called 
+                IF ( ABS(Cs_target(1) - Cs(1)) .LT. min_stomate ) THEN
+
+                   ! Allocate at the tree level to restore allometric balance
+                   Cs_incp(1) = MAX(zero, Cs_target(1) - Cs(1))
+                   Cr_incp(1) = MAX( MIN(b_inc_tot/circ_class_n(ipts,j,1) - &
+                        Cl_incp(1) - Cs_incp(1), Cr_target(1) - Cr(1)), zero )
+
+                   ! Write debug comments to output file 
+                   IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                      CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                           delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                           KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                           circ_class_n, 15)
+                   ENDIF 
+
+                ! Enough leaves and roots. Need to grow structural C to support 
+                ! the available canopy and roots
+                ELSEIF ( ABS(Cr_target(1) - Cr(1)) .LT. min_stomate ) THEN
+
+                   Cr_incp(1) = MAX(zero, Cr_target(1) - Cr(1))
+                   Cs_incp(1) = MAX( MIN(b_inc_tot/circ_class_n(ipts,j,1) - &
+                        Cr_incp(1) - Cl_incp(1), Cs_target(1) - Cs(1)), zero )
+
+                   ! Write debug comments to output file 
+                   IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                      CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                           delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                           KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                           circ_class_n, 16)
+                   ENDIF
+
+                ! Need both structural C and roots to restore the allometric relationships
+                ELSEIF ( ABS(Cs_target(1) - Cs(1) ) .GT. min_stomate .AND. &
+                     ABS(Cr_target(1) - Cr(1)) .GT. min_stomate ) THEN
+
+                   !  First try if we can simply satisfy the allocation needs
+                   IF (Cs_target(1) - Cs(1) + Cr_target(1) - Cr(1) .LE. &
+                        b_inc_tot/circ_class_n(ipts,j,1) - Cl_incp(1)) THEN
+                         
+                      Cr_incp(1) = Cr_target(1) - Cr(1)
+                      Cs_incp(1) = Cs_target(1) - Cs(1)
+
+                   ! Try to satisfy the need for the roots
+                   ELSEIF (Cr_target(1) - Cr(1) .LE. &
+                        b_inc_tot/circ_class_n(ipts,j,1) - Cl_incp(1)) THEN
+
+                      Cr_incp(1) = Cr_target(1) - Cr(1)
+                      Cs_incp(1) = b_inc_tot/circ_class_n(ipts,j,1) - &
+                           Cl_incp(1) - Cr_incp(1)
+                      
+
+                   ! There is not enough use whatever is available
+                   ELSE
+                         
+                      Cr_incp(1) = b_inc_tot/circ_class_n(ipts,j,1) - Cl_incp(1)
+                      Cs_incp(1) = zero
+                         
+                   ENDIF
+
+                   ! Write debug comments to output file 
+                   IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                      CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                           delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                           KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                           circ_class_n, 17)
+                   ENDIF 
+
+                ELSE
+
+                   WRITE(numout,*) 'WARNING 13: Exc 4-6 unexpected exception'
+                   WRITE(numout,*) 'WARNING 13: PFT, ipts: ',j,ipts
+                   IF(err_act.GT.1)THEN
+                      CALL ipslerr_p (3,'growth_fun_all',&
+                           'WARNING 13: Exc 4-6 unexpected exception','','')
+                   ENDIF
+
+                ENDIF
+
+             !! 5.3.3.3.3 Enough roots to sustain the wood and leaves
+             ELSEIF ( ABS(Cr_target(1) - Cr(1)) .LT. min_stomate ) THEN
+
+                Cr_incp(1) = MAX(zero, Cr_target(1) - Cr(1)) 
+
+                ! Enough roots and wood, only grow leaves
+                ! This duplicates Exc 2 and these lines should thus never be called 
+                IF ( ABS(Cs_target(1) - Cs(1)) .LT. min_stomate ) THEN
+
+                   ! Allocate at the tree level to restore allometric balance
+                   Cs_incp(1) = MAX(zero, Cs_target(1) - Cs(1)) 
+                   Cl_incp(1) = MAX( MIN(b_inc_tot/circ_class_n(ipts,j,1) - &
+                        Cr_incp(1) - Cs_incp(1), Cl_target(1) - Cl(1)), zero )
+
+                   ! Update vegetation height
+                   qm_height = biomass_to_lai(Cl(1) + Cl_incp(1),j) * lai_to_height(j)
+
+                   ! Write debug comments to output file 
+                   IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                      CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                           delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                           KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                           circ_class_n, 18)
+                   ENDIF 
+
+                ! Enough leaves and roots. Need to grow sapwood to support the 
+                ! available canopy and roots. Duplicates Exc. 4 and these lines 
+                ! should thus never be called 
+                ELSEIF ( ABS(Cl_target(1) - Cl(1)) .LT. min_stomate ) THEN
+
+                   ! Allocate at the tree level to restore allometric balance
+                   Cl_incp(1) = MAX(zero, Cl_target(1) - Cl(1)) 
+                   Cs_incp(1) = MAX( MIN(b_inc_tot/circ_class_n(ipts,j,1) - &
+                        Cr_incp(1) - Cl_incp(1), Cs_target(1) - Cs(1) ), zero )
+
+                   ! Write debug comments to output file 
+                   IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                      CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                           delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                           KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                           circ_class_n, 19)
+                   ENDIF                       
+
+                ! Need both wood and leaves to restore the allometric relationships
+                ELSEIF ( ABS(Cs_target(1) - Cs(1)) .GT. min_stomate .AND. &
+                     ABS(Cl_target(1) - Cl(1)) .GT. min_stomate ) THEN
+
+                   ! circ_class_ba_eff and circ_class_height_eff are already calculated
+                   ! for a tree in balance. It would be rather complicated to follow
+                   ! the allometric rules for wood allocation (implying changes in height 
+                   ! and basal area) because the tree is not in balance.First try if we 
+                   ! can simply satisfy the allocation needs
+                   IF (Cs_target(1) - Cs(1) + Cl_target(1) - Cl(1) .LE. &
+                        b_inc_tot/circ_class_n(ipts,j,1) - Cr_incp(1)) THEN
+                      
+                      Cl_incp(1) = Cl_target(1) - Cl(1)
+                      Cs_incp(1) = Cs_target(1) - Cs(1)
+                      
+                   ! Try to satisfy the need for leaves
+                   ELSEIF (Cl_target(1) - Cl(1) .LE. &
+                        b_inc_tot/circ_class_n(ipts,j,1) - Cr_incp(1)) THEN
+
+                      Cl_incp(1) = Cl_target(1) - Cl(1)
+                      Cs_incp(1) = b_inc_tot/circ_class_n(ipts,j,1) - &
+                           Cr_incp(1) - Cl_incp(1)
+
+                   ! There is not enough use whatever is available
+                   ELSE
+
+                      Cl_incp(1) = b_inc_tot/circ_class_n(ipts,j,1) - Cr_incp(1)
+                      Cs_incp(1) = zero
+                      
+                   ENDIF
+                      
+                   ! Calculate the height of the expanded canopy
+                   qm_height(ipts,j) = biomass_to_lai(Cl(1) + Cl_inc(1),j) * lai_to_height(j)
+
+                   ! Write debug comments to output file 
+                   IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                      CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                           delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                           KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                           circ_class_n, 20)
+                   ENDIF
+
+                ELSE
+
+                   WRITE(numout,*) 'WARNING 14: Exc 7-9 unexpected exception'
+                   WRITE(numout,*) 'WARNING 14: PFT, ipts: ',j, ipts
+                   IF(err_act.GT.1)THEN
+                      CALL ipslerr_p (3,'growth_fun_all',&
+                           'WARNING 14: Exc 7-9 unexpected exception','','')
+                   ENDIF
+
+                ENDIF
+
+             ! Either Cl_target, Cs_target or Cr_target should be zero
+             ELSE
+
+                ! Something possibly important was overlooked
+                WRITE(numout,*) 'WARNING 15: Logical flaw in phenological allocation '
+                WRITE(numout,*) 'WARNING 15: PFT, ipts: ',j, ipts
+                WRITE(numout,*) 'Cs - Cs_target', Cs(1), Cs_target(1)
+                WRITE(numout,*) 'Cl - Cl_target', Cl(1), Cl_target(1)
+                WRITE(numout,*) 'Cr - Cr_target', Cr(1), Cr_target(1)
+                IF(err_act.GT.1)THEN
+                   CALL ipslerr_p (3,'growth_fun_all',&
+                        'WARNING 15: Logical flaw in phenological allocation','','')
+                ENDIF
+
+             ENDIF
+
+             !! 5.3.4 Wrap-up phenological allocation
+             IF ( Cl_incp(1) .GE. zero .OR. Cr_incp(1) .GE. zero .OR. &
+                  Cs_incp(1) .GE. zero) THEN
+
+                ! Fake allocation for less messy equations in next 
+                ! case, incp needs to be added to inc at the end
+                Cl(1) = Cl(1) + Cl_incp(1)
+                Cr(1) = Cr(1) + Cr_incp(1)
+                Cs(1) = Cs(1) + Cs_incp(1)
+                b_inc_tot = b_inc_tot - (circ_class_n(ipts,j,1) * &
+                     (Cl_incp(1) + Cr_incp(1) + Cs_incp(1)))
+
+             ELSE
+
+                ! The code was written such that the increment pools should be greater 
+                ! than or equal to zero. If this is not the case, something fundamental 
+                ! is wrong with the if-then constructs under Â§5.3.3.2
+                WRITE(numout,*) 'WARNING 16: numerical problem, '//&
+                     'one of the increment pools is less than zero'
+                WRITE(numout,*) 'WARNING 16: Cl_incp(1), Cr_incp(1), Cs_incp(1), j, ipts',&
+                     Cl_incp(1), Cr_incp(1), Cs_incp(1), j, ipts
+                IF(err_act.GT.1)THEN
+                   CALL ipslerr_p (3,'growth_fun_all',&
+                        'WARNING 16: numerical problem',&
+                        'one of the increment pools is less than zero','')
+                ENDIF
+
+             ENDIF
+
+             ! Something is wrong with the calculations
+             IF (b_inc_tot .LT. -min_stomate) THEN
+
+                WRITE(numout,*) 'WARNING 17: numerical problem overspending '//&
+                     'in the phenological allocation'
+                WRITE(numout,*) 'WARNING 17: b_inc_tot, j, ipts',b_inc_tot, j, ipts 
+                WRITE(numout,*) 'WARNING 17: Cl_incp, Cr_incp, Cs_incp, ', &
+                     Cl_incp(1), Cr_incp(1), Cs_incp(1)
+                IF(err_act.GT.1)THEN
+                    CALL ipslerr_p (3,'growth_fun_all',&
+                         'WARNING 17: numerical problem',&
+                         'overspending in the phenological allocation','')
+                ENDIF
+
+             ENDIF
+
+             ! Height depends on Cl, so update height when Cl gets updated
+             qm_height(ipts,j) = biomass_to_lai(Cl(1),j) * lai_to_height(j) 
+
+             !! 5.3.5 Calculate the expected size of the reserve pool
+             !  For crops and grasses only one circumference class is used. Therefore
+             !  there is no need to make use of the local variable biomass to calculate
+             !  the labile and carbohydrate reserve pools. circ_class_biomass is 
+             !  updated right away. This implies that the information stored in biomass
+             !  is no longer in sink with the information stored in circ_class_biomass.
+             !  This is stressed by setting biomass to zero.
+             tmp_bm(ipts,j,:,:) = zero
+
+             !  use the minimum of either (1) 20% of the total sapwood biomass or 
+             !  (2) the amount of carbon needed to develop the optimal LAI and the roots
+             !  This reserve pool estimate is only used to decide whether wood should be
+             !  grown or not. When really dealing with the reserves the reserve pool is 
+             !  recalculated. See further below Â§7.1.
+             
+             ! +++CHECK+++
+             ! The reserve pool calculated here seems to be never used. Next time
+             ! it is mentioned it is recalculated.
+             ! Sapwood has no meaning for grasses and crops - reserves should sustain 
+             ! the canopy. Sapwood could be considered to be the little stems of the 
+             ! grass. For trees 2% was used, given the much lower sapwood pool 
+             ! for grasses and crops we set it arbitrairly to 10%
+             reserve_pool = MIN( 0.10 * &
+                  ( circ_class_biomass(ipts,j,1,isapabove,icarbon) + &
+                  circ_class_biomass(ipts,j,1,isapbelow,icarbon)), &
+                  lai_to_biomass(lai_target(ipts,j),j) * & 
+                  (1.+root_reserve(j)/ltor(ipts,j)) )
+             ! ++++++++++
+             grow_wood = .TRUE.
+             
+             ! Write debug comments to output file 
+             IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                     delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                     KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                     circ_class_n, 21)
+             ENDIF
+
+             !! 5.3.6 Ordinary growth
+             !  Allometric relationship between components is respected, sustain 
+             !  ordinary growth and allocate biomass to leaves, wood, roots and fruits.
+             IF ( (ABS(Cl_target(1) - Cl(1) ) .LE. min_stomate) .AND. &
+                  (ABS(Cs_target(1) - Cs(1) ) .LE. min_stomate) .AND. &
+                  (ABS(Cr_target(1) - Cr(1) ) .LE. min_stomate) .AND. &
+                  (grow_wood) .AND. &
+                  (b_inc_tot/circ_class_n(ipts,j,1) .GT. min_stomate) ) THEN 
+
+                ! Allocate fraction of carbon to fruit production (at the tree level)
+                Cf_inc(:) = b_inc_tot * fruit_alloc(j)
+
+                ! Residual carbon is allocated to the other components (b_inc_tot is 
+                ! at the stand level)
+                b_inc_tot = b_inc_tot * (1-fruit_alloc(j))
+
+                ! Following allometric allocation
+                ! (i) b_inc = Cl_inc + Cr_inc + Cs_inc
+                ! (ii) Cr_inc = (Cl + Cl_inc)/LF - Cr
+                ! (iii) Cs_inc = (Cl + Cl_inc) / KF - Cs
+                ! Substitue (ii) and (iii) in (i) and solve for Cl_inc 
+                ! <=> b_inc = Cl_inc + ( Cl_inc + Cl ) / KF - Cs + ( Cl_inc + Cl ) / LF - Cr
+	        ! <=> b_inc = Cl_inc * ( 1.+ 1/KF + 1./LF ) + Cl/LF - Cs - Cr
+	        ! <=> Cl_inc = ( b_inc - Cl/LF + Cs + Cr ) / ( 1.+ 1/KF + 1./LF )
+                Cl_inc(1) = MAX( (b_inc_tot/circ_class_n(ipts,j,1) - Cl(1)/LF(ipts,j) - &
+                     Cl(1)/KF(ipts,j) + Cs(1) + Cr(1)) / &
+                     (1. + 1./KF(ipts,j) + 1./LF(ipts,j)), zero)
+               
+                IF (Cl_inc(1) .LE. zero) THEN
+
+                   Cr_inc(:) = zero
+                   Cs_inc(:) = zero
+
+                ELSE
+
+                   ! Calculate the height of the expanded canopy
+                   qm_height(ipts,j) = biomass_to_lai(Cl(1) + Cl_inc(1),j) * &
+                        lai_to_height(j)
+
+                   ! Use the solution for Cl_inc to calculate Cr_inc and 
+                   ! Cs_inc according to (ii) and (iii)
+                   Cr_inc(1) = (Cl(1) + Cl_inc(1)) / LF(ipts,j) - Cr(1)                
+                   Cs_inc(1) = (Cl(1)+Cl_inc(1)) / KF(ipts,j) - Cs(1)
+               
+                ENDIF
+
+                ! Write debug comments to output file 
+                IF ((j.EQ.test_pft .AND. printlev_loc.GE.4) .OR. printlev_loc>=5) THEN
+                   CALL comment(npts, Cl_target, Cl, Cs_target, Cs, Cr_target, Cr, &
+                        delta_ba, ipts, j, l, b_inc_tot, Cl_incp, Cs_incp, Cr_incp, &
+                        KF, LF, Cl_inc, Cs_inc, Cr_inc, Cf_inc, grow_wood, &
+                        circ_class_n, 22)
+                ENDIF
+                
+                ! Wrap-up ordinary growth  
+                ! Calculate C that was not allocated, note that Cf_inc was 
+                ! already substracted
+                b_inc_tot = b_inc_tot - &
+                     (circ_class_n(ipts,j,1) * (Cl_inc(1) + Cr_inc(1) + Cs_inc(1)))
+
+                ! Debug
+                IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                   WRITE(numout,*) 'wrap-up ordinary allocation, left b_in_tot, ', &
+                        b_inc_tot 
+                ENDIF
+                !-
+
+
+             !! 5.3.7 Don't grow wood, use C to fill labile pool
+             ELSEIF ( (.NOT. grow_wood) .AND. (b_inc_tot .GT. min_stomate) ) THEN
+
+                ! grow_wood is always .TRUE. see 5.3.5 around line 3652. Is this
+                ! intended or did we delete an if-statement?
+                ! Calculate the C that needs to be distributed to the 
+                ! labile pool. The fraction is proportional to the ratio 
+                ! between the total allocatable biomass and the unallocated 
+                ! biomass per tree (b_inc now contains the unallocated 
+                ! biomass). At the end of the allocation scheme bm_alloc_tot 
+                ! is substracted from the labile biomass pool to update the 
+                ! biomass pool (tmp_bm(:,:,ilabile) = tmp_bm(:,:,ilabile) - 
+                ! bm_alloc_tot(:,:)). At that point, the scheme puts the 
+                ! unallocated b_inc into the labile pool. What we 
+                ! want is that the unallocated fraction is removed from 
+                ! ::bm_alloc_tot such that only the allocated C is removed 
+                ! from the labile pool. b_inc_tot will be moved back into
+                ! the labile pool in 5.2.11
+                bm_alloc_tot(ipts,j) = bm_alloc_tot(ipts,j) - b_inc_tot
+                circ_class_biomass(ipts,j,1,ilabile,icarbon) = &
+                     circ_class_biomass(ipts,j,1,ilabile,icarbon) + &
+                     b_inc_tot
+                                
+                ! Wrap-up ordinary growth  
+                ! Calculate C that was not allocated (b_inc_tot), the 
+                ! equation should read b_inc_tot = b_inc_tot - b_inc_tot 
+                ! note that Cf_inc was already substracted
+                b_inc_tot = zero 
+
+                ! Debug
+                IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                   WRITE(numout,*) 'No wood growth, move remaining C to labile pool'
+                   WRITE(numout,*) 'bm_alloc_tot_new, ',bm_alloc_tot(ipts,j)
+                   WRITE(numout,*) 'wrap-up ordinary allocation, left b_inc_tot, ', &
+                        b_inc_tot 
+                ENDIF
+                !- 
+
+             !! 5.3.8 Error - the allocation scheme is overspending 
+             ELSEIF (b_inc_tot .LE. min_stomate) THEN  
+      
+                IF (b_inc_tot .LT. -min_stomate) THEN
+
+                   ! Something is wrong with the calculations
+                   WRITE(numout,*) 'WARNING 18: numerical problem'//&
+                        'overspending in ordinary allocation'
+                   WRITE(numout,*) 'WARNING 18: PFT, ipts, b_inc_tot: ', &
+                        j, ipts,b_inc_tot
+                   IF(err_act.GT.1)THEN
+                      CALL ipslerr_p (3,'growth_fun_all',&
+                           'WARNING 18: numerical problem',&
+                           'overspending in ordinary allocation','')
+                   ENDIF
+
+                ELSE
+
+                   IF (j .EQ. test_pft .AND. printlev_loc.GE.4) THEN
+
+                      ! Succesful allocation
+                      WRITE(numout,*) 'Successful allocation'
+
+                   ENDIF
+
+                ENDIF
+              
+                ! Althought the biomass components respect the allometric 
+                ! relationships, there is no carbon left to allocate                      
+                b_inc_tot = zero
+                Cl_inc(1) = zero
+                Cs_inc(1) = zero
+                Cr_inc(1) = zero
+                Cf_inc(1) = zero
+
+             ELSE
+
+                WRITE(numout,*) 'WARNING 19: Logical flaw'//&
+                     'unexpected result in ordinary allocation'
+                WRITE(numout,*) 'WARNING 19: PFT, ipts: ', j, ipts
+                WRITE(numout,*) 'WARNING 19: ',ABS(Cl_target(1) - Cl(1) ) , Cl(1)
+                WRITE(numout,*) 'WARNING 19: ',ABS(Cs_target(1) - Cs(1) )  , Cs(1)
+                WRITE(numout,*) 'WARNING 19: ',ABS(Cr_target(1) - Cr(1) )  , Cr(1)
+                WRITE(numout,*) 'WARNING 19: ',grow_wood
+                WRITE(numout,*) 'WARNING 19: ',b_inc_tot,circ_class_n(ipts,j,1),&
+                     b_inc_tot/circ_class_n(ipts,j,1)
+                IF(err_act.GT.1)THEN
+                   CALL ipslerr_p (3,'growth_fun_all',&
+                        'WARNING 19: Logical flaw',&
+                        'unexpected result in ordinary allocation','')
+                ENDIF
+                
+             ENDIF ! Ordinary allocation
+             
+             !! 5.3.9 Error checking
+             IF ( b_inc_tot .GT. min_stomate ) THEN 
+
+                ! This should not happen, in case the functional allocation 
+                ! did not consume all the allocatable carbon, the remaining C 
+                ! is left for the next day.
+                WRITE(numout,*) 'WARNING 20: unexpected outcome force allocation'
+                WRITE(numout,*) 'WARNING 20: grow_wood, b_inc_tot: ', grow_wood, b_inc_tot
+                WRITE(numout,*) 'WARNING 20: PFT, ipts: ',j,ipts
+                IF(err_act.GT.1)THEN
+                   CALL ipslerr_p (3,'growth_fun_all',&
+                        'WARNING 20: unexpected outcome force allocation','','')
+                ENDIF
+
+             ELSEIF ( (b_inc_tot .LT. min_stomate) .AND. &
+                  (b_inc_tot .GE. -min_stomate) ) THEN
+
+                ! Successful allocation
+                ! Debug
+                IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                   WRITE(numout,*) 'Successful allocation'
+                ENDIF
+                !----------
+
+             ELSE
+
+                ! Something possibly important was overlooked
+                IF ( (b_inc_tot .LT. 100*min_stomate) .AND. &
+                     (b_inc_tot .GE. -100*min_stomate) ) THEN
+                   IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                      WRITE(numout,*) 'Marginally successful allocation - '//&
+                           'precision is better than 10-6', j
+                   ENDIF
+                ELSE
+                   WRITE(numout,*) 'WARNING 21: Logical flaw '//&
+                        'unexpected result in ordinary allocation'
+                   WRITE(numout,*) 'WARNING 21: b_inc_tot',b_inc_tot
+                   WRITE(numout,*) 'WARNING 21: PFT, ipts: ',j,ipts
+                   CALL ipslerr_p (3,'growth_fun_all',&
+                        'WARNING 21: Logical flaw unexpected result',&
+                        'in ordinary allocation','')
+                ENDIF
+
+             ENDIF
+
+             ! The second problem we need to catch is when one of the increment 
+             ! pools is negative. This is an undesired outcome (see comment where 
+             ! ::KF_old is calculated in this routine. In that case we write a 
+             ! warning, set all increment pools to zero and try it again at the 
+             ! next time step. A likely cause of this problem is a too large change 
+             ! in KF from one time step to another. Try decreasing the acceptable 
+             ! value for an absolute increase in KF.
+             IF (Cs_inc(1) .LT. zero .OR. & 
+                Cr_inc(1) .LT. zero .OR. &
+                Cs_inc(1) .LT. zero) THEN
+             
+                ! Do not allocate - save the carbon for the next time step
+                Cl_inc(1) = zero
+                Cr_inc(1) = zero
+                Cs_inc(1) = zero
+                WRITE(numout,*) 'WARNING 22: numerical problem, one of the increment '//&
+                     'pools is less than zero'
+                WRITE(numout,*) 'WARNING 22: PFT, ipts: ',j,ipts
+               
+             ENDIF
+
+             !! 5.3.10 Wrap-up phenological and ordinary allocation
+             Cl_inc(1) = Cl_inc(1) + Cl_incp(1)
+             Cr_inc(1) = Cr_inc(1) + Cr_incp(1)
+             Cs_inc(1) = Cs_inc(1) + Cs_incp(1)
+             residual(ipts,j) = b_inc_tot
+
+             ! Debug
+             IF (j.EQ.test_pft .AND. printlev_loc.GE.4) THEN
+                WRITE(numout,*) 'Final allocation', j 
+                WRITE(numout,*) 'Cl, Cs, Cr', Cl(1), Cs(1), Cr(1) 
+                WRITE(numout,*) 'Cl_incp, Cs_incp, Cr_incp, ', &
+                     Cl_incp(1), Cs_incp(1), Cr_incp(1)
+                WRITE(numout,*) 'Cl_inc, Cs_ins, Cr_inc, Cf_inc, ', &
+                     Cl_inc(1), Cs_inc(1), Cr_inc(1), Cf_inc(1)
+                WRITE(numout,*) 'unallocated/residual, ', b_inc_tot
+             ENDIF
+             !-
+
+             !! 5.3.11 Account for the residual
+             !  The residual is usually around ::min_stomate but we deal 
+             !  with it anyway to make sure the mass balance is closed
+             !  and as a way to detect errors. Move the unallocated carbon
+             !  back into the labile pool
+             IF (circ_class_biomass(ipts,j,1,ilabile,icarbon) + &
+                  residual(ipts,j) .LE. min_stomate) THEN
+
+                deficit = circ_class_biomass(ipts,j,1,ilabile,icarbon) + residual(ipts,j)
+
+                ! The deficit is less than the carbon reserve
+                IF (-deficit .LE. circ_class_biomass(ipts,j,1,icarbres,icarbon)) THEN
+
+                   ! Pay the deficit from the reserve pool
+                   circ_class_biomass(ipts,j,1,icarbres,icarbon) = &
+                        circ_class_biomass(ipts,j,1,icarbres,icarbon) + deficit
+                   circ_class_biomass(ipts,j,1,ilabile,icarbon)  = &
+                        circ_class_biomass(ipts,j,1,ilabile,icarbon) - deficit
+
+                ELSE
+
+                   ! Not enough carbon to pay the deficit
+                   ! There is likely a bigger problem somewhere in
+                   ! this routine
+                   WRITE(numout,*) 'WARNING 23: PFT, ipts: ',j,ipts
+                   CALL ipslerr_p (3,'growth_fun_all',&
+                        'WARNING 23: numerical problem overspending ',&
+                        'when trying to account for unallocatable C ','')
+
+                ENDIF
+
+             ELSE
+                
+                ! Move the unallocated carbon back into the labile pool
+                circ_class_biomass(ipts,j,1,ilabile,icarbon) = &
+                     circ_class_biomass(ipts,j,1,ilabile,icarbon) + residual(ipts,j)
+                
+             ENDIF
+
+       
+             !! 5.3.12 Standardise allocation factors
+             !  Strictly speaking the allocation factors do not need to be 
+             !  calculated because the functional allocation scheme allocates 
+             !  absolute amounts of carbon. Hence, Cl_inc could simply be added to
+             !  tmp_bm(:,:,ileaf,icarbon), Cr_inc to tmp_bm(:,:,iroot,icarbon),
+             !  etc. However, using allocation factors bears some elegance in 
+             !  respect to distributing the growth respiration if this would be 
+             !  required. Further it facilitates comparison to the resource 
+             !  limited allocation scheme (stomate_growth_res_lim.f90) and it 
+             !  comes in handy for model-data comparison. This allocation
+             !  takes place at the tree level - note that ::biomass is the only 
+             !  prognostic variable from the tree-based allocation
+                          
+             !  Allocation   
+             Cl_inc(1) = MAX(zero, circ_class_n(ipts,j,1) * Cl_inc(1))
+             Cr_inc(1) = MAX(zero, circ_class_n(ipts,j,1) * Cr_inc(1))
+             Cs_inc(1) = MAX(zero, circ_class_n(ipts,j,1) * Cs_inc(1))
+             Cf_inc(1) = MAX(zero, circ_class_n(ipts,j,1) * Cf_inc(1))
+             
+             ! Total_inc is based on the updated Cl_inc, Cr_inc, 
+             ! Cs_inc and Cf_inc. Therefore, do not multiply
+             ! ind(ipts,j) again
+             total_inc = (Cf_inc(1) + Cl_inc(1) + Cs_inc(1) + Cr_inc(1))
+             
+             ! Relative allocation
+             IF ( total_inc .GT. min_stomate ) THEN
+
+                Cl_inc(1) = Cl_inc(1) / total_inc
+                Cs_inc(1) = Cs_inc(1) / total_inc
+                Cr_inc(1) = Cr_inc(1) / total_inc
+                Cf_inc(1) = Cf_inc(1) / total_inc
+
+             ELSE
+
+                bm_alloc_tot(ipts,j) = zero
+                Cl_inc(1) = zero
+                Cs_inc(1) = zero
+                Cr_inc(1) = zero
+                Cf_inc(1) = zero
+
+             ENDIF
+
+             !! 5.3.13 Convert allocation to allocation facors
+             !  Convert allocation of individuals to ORCHIDEE's allocation 
+             !  factors - see comment for 5.2.5
+             !  Aboveground sapwood allocation is age dependent in trees, 
+             !  but there is only aboveground allocation in grasses 
+             alloc_sap_above = un
+
+             ! Leaf, wood, root and fruit allocation. Note that the X_inc
+             ! are normalized before being used here
+             f_alloc(ipts,j,ileaf) = Cl_inc(1)
+             f_alloc(ipts,j,isapabove) = Cs_inc(1)*alloc_sap_above
+             f_alloc(ipts,j,isapbelow) = Cs_inc(1)*(1.-alloc_sap_above)
+             f_alloc(ipts,j,iroot) = Cr_inc(1)
+             f_alloc(ipts,j,ifruit) = Cf_inc(1)
+
+             ! Store f_alloc per circ_class to calculate the allocation
+             ! in circ_class_biomass after bm_alloc_tot has been checked
+             ! for the N availability. Note that the X_inc
+             ! are normalized before being used here
+             f_alloc_circ(ipts,1,ileaf) = Cl_inc(1)
+             f_alloc_circ(ipts,1,isapabove) = Cs_inc(1)*alloc_sap_above
+             f_alloc_circ(ipts,1,isapbelow) = Cs_inc(1)*(1.-alloc_sap_above)
+             f_alloc_circ(ipts,1,iroot) = Cr_inc(1)
+             f_alloc_circ(ipts,1,ifruit) = Cf_inc(1)
+
+          ELSEIF (.NOT. is_tree(j)) THEN 
+       
+             f_alloc(ipts,j,ileaf) = zero
+             f_alloc(ipts,j,isapabove) = zero
+             f_alloc(ipts,j,isapbelow) = zero
+             f_alloc(ipts,j,iroot) = zero
+             f_alloc(ipts,j,ifruit) = zero
+             residual(ipts,j) = zero
+
+             ! Debug
+             IF(printlev_loc.GE.4) WRITE(numout,*) &
+                  'there is no non-tree biomass '//&
+                  'to allocate, PFT, ', j
+             !-
+
+          ENDIF ! .NOT. is_tree(j) and there is biomass to allocate (Â§5.3 - far far up)
+
+       ENDDO ! npts
+
+       ! Account for the residual (carbon that could not be allocated
+       ! during phenological or ordinary growth) before using bm_alloc_tot
+       bm_alloc_tot(:,j)= bm_alloc_tot(:,j) - residual(:,j)
+   
+       !! 5.4 Quantify and account for nitrogen limitation on growth
+       DO ipts = 1 , npts 
+
+          ! This far we calculated how we would like to allocate the available
+          ! carbon (::f_alloc) and how much carbon of the available carbon we
+          ! can allocate (typically except for some exceptiona cases and numerical
+          ! residuals). Nothing has yet been allocated. Allocation itself, meaning 
+          ! the updating of biomass pools is taken care off in the subsequent parts
+          ! of the code. circ_class_biomass contains the latest information for
+          ! all the biomass pools. The next section is generic for trees, grasses and
+          ! crops so we first have to update the information in the biomass variable
+          ! so it can be used later
+          !+++CHECK+++
+          ! replace by biomass_to_cc_2d
+!!$       tmp_bm(:,:,:,:) = cc_to_biomass(npts,nvm,&
+!!$            circ_class_biomass(:,:,:,:,:),&
+!!$            circ_class_n(:,:,:))
+          DO iele = 1,nelements
+             DO ipar = 1,nparts
+                tmp_bm(ipts,j,ipar,iele) = &
+                     SUM(circ_class_biomass(ipts,j,:,ipar,iele)*&
+                     circ_class_n(ipts,j,:))
+             ENDDO
+          ENDDO
+          !++++++++++++
+
+          ! Initialize
+          deltacn=1.0
+
+          ! Nitrogen cost, given required N for a given allocatable 
+          ! biomass C, and an intended leaf CN as N = C * costf / C:N
+          ! Note that fcn is not a classic c/n ratio but is the c/n ratio
+          ! compared to the c/n ratio for leaves. When bm_supply_n is
+          ! calculated this is accounted for through multiplying
+          ! with cn_leaf.
+          costf = f_alloc(ipts,j,ileaf) + fcn_wood(j) * &
+               (f_alloc(ipts,j,isapabove)+f_alloc(ipts,j,isapbelow)) + &
+               fcn_root(j) * ( f_alloc(ipts,j,iroot) + f_alloc(ipts,j,ifruit))
+          
+          ! Debug
+          IF (printlev_loc>=4) THEN
+             WRITE(numout,*) 'costf L3894, ',costf
+             WRITE(numout,*) 'bm_alloc_tot, ',bm_alloc_tot(ipts,j)
+          ENDIF
+          !-
+          
+          ! only check if there is biomass growth
+          IF ( costf.GT.min_stomate ) THEN
+
+             ! fraction of labile N allocatable for growth
+             ! no growth respiration calculated here!
+             n_avail = MAX(tmp_bm(ipts,j,ilabile,initrogen)*0.9,0.0)
+
+             ! carbon growth possible given nitrogen availability and 
+             ! current nitrogen concentration
+             bm_supply_n = n_avail / costf / (1.-frac_growthresp_dyn) * &
+                  cn_leaf(ipts,j) 
+
+             ! elasticity of leaf nitrogen concentration
+             ! deltacnmax=exp(-(1./(cn_leaf(ipts,j)*0.5*(1./cn_leaf_max(j)+1./&
+             ! cn_leaf_min(j))))**8)
+             deltacnmax = 1. - exp(-((1.6 * MIN((1./cn_leaf(ipts,j)) - & 
+                  (1./cn_leaf_min(j)),0.) / &
+                  ( (1./(2*cn_leaf_max(j))) - (1./cn_leaf_min(j)) ) )**4.1))
+
+             IF((impose_cn) .AND. (bm_alloc_tot(ipts,j) .GT. bm_supply_n)) THEN
+
+                ! Debug
+                IF (printlev_loc.GT.4) THEN
+                   IF((test_grid == ipts) .AND. (test_pft==j)) THEN
+                      WRITE(numout,*) "atm_to_bm(initrogen)",atm_to_bm(ipts,j,initrogen)
+                      WRITE(numout,*) 'bm_alloc_tot, ',bm_alloc_tot(ipts,j)
+                      WRITE(numout,*) "bm_supply_n:",bm_supply_n
+                      WRITE(numout,*) 'frac_growthresp_dyn,  ', &
+                           1.-frac_growthresp_dyn
+                      WRITE(numout,*) 'biomass ilabile N L4090, ', j,test_pft, &
+                           tmp_bm(test_grid,test_pft,ilabile,initrogen)
+                   ENDIF
+                ENDIF
+                !-
+
+                ! Impose_cn = y so just take the required nitrogen from
+                ! the atmosphere and add it to the labile pool of the plant
+                atm_to_bm(ipts,j,initrogen) = atm_to_bm(ipts,j,initrogen) + &
+                     ((bm_alloc_tot(ipts,j)-bm_supply_n)&
+                     *costf*(1.-frac_growthresp_dyn) / &
+                     cn_leaf(ipts,j)/0.9 + min_stomate)/dt
+                tmp_bm(ipts,j,ilabile,initrogen) = &
+                     tmp_bm(ipts,j,ilabile,initrogen) + &
+                     (bm_alloc_tot(ipts,j)-bm_supply_n)&
+                     *costf*(1.-frac_growthresp_dyn) / &
+                     cn_leaf(ipts,j)/0.9 + min_stomate
+                n_avail = MAX(tmp_bm(ipts,j,ilabile,initrogen)*0.9,0.0)
+   
+                ! tmp_bm(ilabile) has changed, update circ_class_biomass 
+                circ_class_biomass(ipts,j,:,ilabile,initrogen) = &
+                     biomass_to_cc(tmp_bm(ipts,j,ilabile,initrogen),&
+                     circ_class_biomass(ipts,j,:,ilabile,initrogen),&
+                     circ_class_n(ipts,j,:))
+             
+                ! Debug
+                IF (printlev_loc.GT.4) THEN   
+                   IF((test_grid == ipts).AND.(test_pft==j)) THEN
+                      WRITE(numout,*) "atm_to_bm(nitrogen)",atm_to_bm(ipts,j,initrogen)
+                      WRITE(numout,*) 'biomass ilabile N L4121, ', j,test_pft, &
+                           tmp_bm(test_grid,test_pft,ilabile,initrogen)
+                   ENDIF
+                ENDIF
+                !-
+                
+                ! carbon growth possible given nitrogen availability and current 
+                ! nitrogen concentration
+                bm_supply_n = n_avail / costf / (1.-frac_growthresp_dyn) * &
+                     cn_leaf(ipts,j)
+                
+                ! Debug
+                IF (printlev_loc.GT.4) THEN
+                   IF((test_grid == ipts).AND.(test_pft==j)) THEN 
+                      WRITE(numout,*) "bm_supply_n:", bm_supply_n
+                   ENDIF
+                ENDIF
+                !-
+
+             ENDIF
+
+             IF ( bm_alloc_tot(ipts,j) .GT. bm_supply_n ) THEN
+
+                   ! case of not enough nitrogen to sustain intended growth, 
+                   ! reduce carbon allocation to meet nitrogen availability
+                   ! taking into account the maximal change of nitrogen 
+                   ! concentrations. delta of nitrogen concentrations in 
+                   ! response to nitrogen deficit
+                   IF ( lab_fac(ipts,j).GT.0.3) THEN
+
+                      deltacn=1.0
+
+                   ELSE
+
+                      deltacnmax = Dmax * (1.-deltacnmax) 
+                      deltacn = n_avail /  ( bm_alloc_tot(ipts,j) * &
+                           (1.-frac_growthresp_dyn) * costf * 1./cn_leaf(ipts,j) )
+                      deltacn = MIN(MAX(deltacn,1.0-deltacnmax),1.0)
+
+                   ENDIF
+                               
+                   ! nitrogen demand given possible nitrogen concentration change
+                   n_alloc_tot(ipts,j) =  MIN( n_avail , & 
+                        bm_alloc_tot(ipts,j) * (1.-frac_growthresp_dyn) * costf * &
+                       MAX(MIN( 1./cn_leaf(ipts,j)*deltacn,1./cn_leaf_min(j)),1./cn_leaf_max(j)) ) 
+
+                   ! if not successful, reduce growth
+                   ! constrain carbon used for growth dependent on available 
+                   ! nitrogen under the assumption that the f_allocs are 
+                   ! piecewise linear with bm_alloc_tot, which is first-order 
+                   ! correct 
+                   tmp_bm(ipts,j,ilabile,icarbon) = &
+                        tmp_bm(ipts,j,ilabile,icarbon) + &
+                        bm_alloc_tot(ipts,j)
+                   bm_alloc_tot(ipts,j) = MIN( bm_alloc_tot(ipts,j) , &
+                        n_alloc_tot(ipts,j) / costf / (1.-frac_growthresp_dyn) / &
+                        MAX(MIN((1./cn_leaf(ipts,j) * deltacn),1./cn_leaf_min(j)),1./cn_leaf_max(j)) )
+
+                   ! If bm_alloc_tot did not change, the labile pool will not
+                   ! have changed either. In case bm_alloc_tot was adjusted in 
+                   ! line with n_alloc_tot (line above), then the excess 
+                   ! carbon is stored in the labile pool
+                   tmp_bm(ipts,j,ilabile,icarbon) = &
+                        tmp_bm(ipts,j,ilabile,icarbon) - &
+                        bm_alloc_tot(ipts,j)
+                   
+                   ! tmp_bm(ilabile) has changed, update circ_class_biomass 
+                   circ_class_biomass(ipts,j,:,ilabile,icarbon) = &
+                        biomass_to_cc(tmp_bm(ipts,j,ilabile,icarbon),&
+                        circ_class_biomass(ipts,j,:,ilabile,icarbon),&
+                        circ_class_n(ipts,j,:))
+
+             ELSE
+
+                ! sufficient nitrogen, increase of leaf nitrogen concentration 
+                ! dependent on distance to maximal leaf nitrogen concentration
+                ! cannot change leaf C:N in bud burst period nitrogen 
+                ! constrained such that nitrogen concentration can only 
+                ! increase 1% per day
+                IF ( lab_fac(ipts,j).GT.0.3) THEN
+
+                   deltacn=1.0
+
+                ELSE
+
+                   deltacnmax=Dmax * deltacnmax !(1.-deltacnmax)
+                   deltacn = n_avail /  &
+                        ( bm_alloc_tot(ipts,j) * (1.-frac_growthresp_dyn) * &
+                        costf * 1./cn_leaf(ipts,j) ) 
+                   deltacn=MIN(MAX(deltacn,1.0),1.+deltacnmax)
+
+                ENDIF
+
+                ! Debug
+                IF((printlev_loc.GT.4) .AND. &
+                     (test_grid == ipts).AND.(test_pft==j)) THEN
+                   WRITE(numout,*) 'biomass ilabile N L4028, ', j,test_pft, &
+                        tmp_bm(test_grid,test_pft,ilabile,initrogen)
+                ENDIF
+                !-
+   
+                IF((impose_cn).AND.( (bm_alloc_tot(ipts,j) * &
+                     (1.-frac_growthresp_dyn) * costf * MAX( &
+                     MIN(1./cn_leaf(ipts,j)*deltacn, &
+                     1./cn_leaf_min(j)),1./cn_leaf_max(j)) &
+                      .GT. n_avail )) ) THEN
+
+                   ! Take the required nitrogen from
+                   ! the atmosphere and add it to the labile pool of the plant 
+                   atm_to_bm(ipts,j,initrogen) = atm_to_bm(ipts,j,initrogen) + &
+                        (((bm_alloc_tot(ipts,j) &
+                        * (1.-frac_growthresp_dyn) * costf * &
+                        1./cn_leaf(ipts,j)*deltacn)- &
+                        n_avail)/0.9)/dt
+                   tmp_bm(ipts,j,ilabile,initrogen) = &
+                        tmp_bm(ipts,j,ilabile,initrogen) + &
+                        ((bm_alloc_tot(ipts,j) &
+                        * (1.-frac_growthresp_dyn) * costf * &
+                        1./cn_leaf(ipts,j)*deltacn)-n_avail)/0.9
+                   n_avail = MAX(tmp_bm(ipts,j,ilabile,initrogen)*0.9,0.0)
+
+                   ! tmp_bm(ilabile) has changed, update circ_class_biomass 
+                   circ_class_biomass(ipts,j,:,ilabile,initrogen) = &
+                        biomass_to_cc(tmp_bm(ipts,j,ilabile,initrogen),&
+                        circ_class_biomass(ipts,j,:,ilabile,initrogen),&
+                        circ_class_n(ipts,j,:))
+
+                ENDIF
+
+                ! Debug
+                IF((test_grid == ipts).AND.(test_pft==j)) THEN
+                   WRITE(numout,*) 'biomass ilabile N L4054, ', j,test_pft, &
+                        tmp_bm(test_grid,test_pft,ilabile,initrogen)
+                ENDIF
+                !-
+
+                n_alloc_tot(ipts,j) =  MIN( n_avail , & 
+                     bm_alloc_tot(ipts,j) * (1.-frac_growthresp_dyn) * &
+                     costf * MAX(MIN(1./cn_leaf(ipts,j)*deltacn, & 
+                     1./cn_leaf_min(j)),1./cn_leaf_max(j)) )
+             ENDIF
+
+          ENDIF ! costf.GT.min_stomate
+
+          !+++CHECK+++
+          ! Calculate growth respiration at the end of the routine rather
+          ! then where maint_resp is calculated. By doing so ::bm_alloc_tot
+          ! is known and we implememnt the sink-source by Korner. If calculated
+          ! at the start of the routine we need to use gpp_daily and so we
+          ! implement a pure source-driven growth respiration. I [SL] thinks
+          ! that the growth itself is still sink-source-driven
+
+!!$          !! 3.12 Growth respiration
+!!$          !  Calculate total growth respiration and update allocatable carbon
+!!$          !  Growth respiration is a tax on productivity, not actual allocation
+!!$          !  Total growth respiration has be calculated before the allocation 
+!!$          !  takes place because the allocation itself is not linear. After 
+!!$          !  the allocation has been calculated, growth respiration can be 
+!!$          !  calculated for each biomass component separatly. The unit of
+!!$          !  resp_growth is gC m-2 dt-1. Surpress the respiration for deciduous
+!!$          !  PFTs as long as they haven't carried leaves at least once.
+!!$          IF (ind(ipts,j) .GT. min_stomate .AND. &
+!!$             rue_longterm(ipts,j) .NE. un) THEN
+!!$
+!!$             resp_growth(ipts,j) = frac_growthresp(j) * MAX(zero, bm_alloc_tot(ipts,j))
+!!$             bm_alloc_tot(ipts,j) = bm_alloc_tot(ipts,j) - resp_growth(ipts,j)
+!!$          
+!!$          ENDIF
+!!$
+!!$          ! Debug
+!!$          IF(printlev_loc.GE.4 .AND. j == test_pft .AND. ipts == test_grid)THEN
+!!$             WRITE(numout,*) 'initial bm_alloc_tot, ', &
+!!$                  bm_alloc_tot(ipts,j) + resp_growth(ipts,j)
+!!$             WRITE(numout,*) 'growth_resp, ', resp_growth(ipts,j) 
+!!$             WRITE(numout,*) 'bm_alloc_tot after growth resp ',bm_alloc_tot(ipts,j)
+!!$             WRITE(numout,*) 'gpp_daily: ',gpp_daily(ipts,j)
+!!$          ENDIF
+!!$          !-
+!!$
+!!$          ! Occasionally, there is a very special situation which arises, where
+!!$          ! bm_alloc_tot is greater than min_stomate before accounting for growth 
+!!$          ! respiration, but not afterwards.  This causes a mass balance error 
+!!$          ! because growth respiration is non-zero but bm_alloc_tot is too small 
+!!$          ! to trigger loops below, so nothing is done with that carbon.  In this 
+!!$          ! situation, the amout of carbon to allocate is so low that nothing 
+!!$          ! really changes.  We set the growth respiration to zero in this special 
+!!$          ! case to avoid mass imbalance, even though this will not effect the 
+!!$          ! trajectory of the plant.  It seems to happen on the same day as leaves 
+!!$          ! start growing, before any GPP is calculated.
+!!$          IF(((bm_alloc_tot(ipts,j) + resp_growth(ipts,j)) .GT. min_stomate) .AND. &
+!!$             (bm_alloc_tot(ipts,j) .LT. min_stomate)) THEN
+!!$
+!!$             bm_alloc_tot(ipts,j) = bm_alloc_tot(ipts,j) + resp_growth(ipts,j)
+!!$             resp_growth(ipts,j) = zero
+!!$
+!!$             IF(printlev_loc.GE.4 .AND. j == test_pft .AND. ipts == test_grid)THEN
+!!$                WRITE(numout,*) 'stomate_allocation - Hit exception 25'
+!!$             ENDIF
+!!$ 
+!!$          ENDIF
+!!$          !+++++++++++
+          
+       ENDDO ! # domain npts
+
+
+       !! 5.5 Allocate allocatable biomass to different plant compartments   
+       !  Absolute allocation at the tree level and for an individual tree (gC tree-1)
+       !  The labile and reserve pools are not allocated at the tree level. However,
+       !  stand level ilabile and icarbres biomass will be redistributed at the tree
+       !  level later in this subroutine. This is done after the relative allocation
+       !  beacuse now ::alloc_sap_above is known
+       DO ipts = 1,npts
+
+          DO icir = 1,ncirc
+
+             DO ipar = 1,nparts
+
+                IF (ipar.EQ.ileaf .OR. ipar.EQ.isapabove .OR. &
+                     ipar.EQ.isapbelow .OR. ipar.EQ.iroot .OR. &
+                     ipar.EQ.ifruit) THEN
+
+                   ! Check whether the allocation factor is defined
+                   ! and whether there are trees in this circ_class
+                   IF (f_alloc_circ(ipts,icir,ipar).GE.zero .AND. &
+                        f_alloc_circ(ipts,icir,ipar).LE.un .AND. &
+                        circ_class_n(ipts,j,icir).GT.min_stomate) THEN
+
+                      ! Calculate circ_class biomass with the latest and
+                      ! final bm_alloc_tot
+                      circ_class_biomass(ipts,j,icir,ipar,icarbon) = &
+                           circ_class_biomass(ipts,j,icir,ipar,icarbon) + &
+                           ( f_alloc_circ(ipts,icir,ipar) * bm_alloc_tot(ipts,j) / &
+                           circ_class_n(ipts,j,icir) )
+
+                   ENDIF ! f_alloc is defined
+
+                ENDIF ! select plant parts
+
+             ENDDO ! ipar
+
+          ENDDO ! icir
+
+       ENDDO ! ipts
+       
+       !  The amount of allocatable carbon biomass to each compartment is a 
+       !  fraction ::f_alloc of the total allocatable biomass
+       DO k = 1, nparts
+
+          bm_alloc(:,j,k,icarbon) = f_alloc(:,j,k) * bm_alloc_tot(:,j) 
+
+       ENDDO
+
+       ! All the carbon contained in bm_alloc_tot has been allocated
+       bm_alloc_tot(:,j) = zero
+
+       ! Zero the array for PFT 1, since it has not been calculated but it
+       ! is used in implict loops below
+       bm_alloc_tot(:,1) = zero
+       bm_alloc(:,1,:,:) = zero
+
+    ENDDO ! # End Loop over # of PFTs  
+
+
+ !! 6. Calculate nitrogen fluxes associated with biomass growth 
+    
+    ! this is the case of dynamic allocation of nitrogen taken up from the soil
+    ! The principles of this allocation are
+    ! 1) nitrogen allocated to the plant tissue is dependent on the 
+    !    labile nitrogen/carbon ratio i.e. carbon_alloc*(N/C)_labile
+    ! 2) the proportions of C/N ratios between different compartments 
+    !    are prescribed as in Hybrid 3
+    ! 3) since different to Hybrid, grasses have sapwood (...) the 
+    !    proportions have be adjusted for grasses, since their tillers 
+    !    are not lignified...
+    DO j = 2, nvm
+
+       DO ipts = 1, npts
+
+          IF (veget_cov_max(ipts,j) .LE. min_stomate) THEN
+
+             ! this vegetation type is not present, so no reason to do the 
+             ! calculation. CYCLE will take us out of the innermost DO loop
+             CYCLE
+          
+          ENDIF
+         
+          ! Debug
+          IF (j .EQ. test_pft .AND. printlev_loc.GE.4) THEN
+             WRITE(numout,*) 'bm_alloc_tot(ipts,j)=',bm_alloc_tot(ipts,j)   
+          ENDIF
+          !-
+
+          ! only allocate nitrogen when there is construction of new biomass
+          IF(SUM(bm_alloc(ipts,j,:,icarbon)).GT.min_stomate) THEN
+
+             alloc_c(ipts)=0.0
+             alloc_d(ipts)=0.0
+             alloc_e(ipts)=0.0
+             
+             ! pool sapwood and roots+fruits into each on pool
+             sum_sap(ipts) = bm_alloc(ipts,j,isapabove,icarbon) + &
+                  bm_alloc(ipts,j,isapbelow,icarbon)
+             sum_oth(ipts) = bm_alloc(ipts,j,iroot,icarbon) + &
+                  bm_alloc(ipts,j,ifruit,icarbon)
+             
+             IF((sum_sap(ipts)+sum_oth(ipts)).GT.min_stomate) THEN
+                
+                IF(bm_alloc(ipts,j,ileaf,icarbon).GT.min_stomate) THEN
+                 
+                   ! in case there is new allocation to leaves
+                   alloc_c(ipts) = 1./(1.+(fcn_wood(j)*sum_sap(ipts) + &
+                        fcn_root(j)*sum_oth(ipts))/bm_alloc(ipts,j,ileaf,icarbon))
+                   alloc_d(ipts) = fcn_wood(j)*sum_sap(ipts) / &
+                        bm_alloc(ipts,j,ileaf,icarbon)*alloc_c(ipts)
+                   alloc_e(ipts) = fcn_root(j)*sum_oth(ipts) / &
+                        bm_alloc(ipts,j,ileaf,icarbon)*alloc_c(ipts)
+                   
+                ELSE
+
+                   ! otherwise add no nitrogen to leaves and alocate the N 
+                   ! to whatever is constructed
+                   alloc_c(ipts)=0.0
+                   alloc_d(ipts)=sum_sap(ipts)/(sum_sap(ipts)+fcn_root(j) / &
+                        fcn_wood(j)*sum_oth(ipts))
+                   alloc_e(ipts)=1.-alloc_d(ipts)
+
+                ENDIF
+
+             ELSEIF(bm_alloc(ipts,j,ileaf,icarbon).GT.min_stomate)THEN
+                
+                ! case of only allocation to leaves!
+                alloc_c(ipts)=1.0
+
+             ENDIF
+
+             !calculate allocation 
+             bm_alloc(ipts,j,ileaf,initrogen) = alloc_c(ipts)*n_alloc_tot(ipts,j)
+
+             ! Debug
+             IF((test_grid == ipts).AND.(test_pft==j).AND. printlev_loc.GE.4)THEN
+                WRITE(numout,*) 'alloc_c(ipts)=',alloc_c(ipts) 
+                WRITE(numout,*) 'n_alloc_tot(ipts,j)=',n_alloc_tot(ipts,j)
+                WRITE(numout,*) 'bm_alloc(ipts,j,ileaf,initrogen)=', &
+                     bm_alloc(ipts,j,ileaf,initrogen)
+                WRITE(numout,*) 'bm_alloc(ipts,j,ileaf,icarbon)=', &
+                     bm_alloc(ipts,j,ileaf,icarbon)
+                WRITE(numout,*) 'bm_alloc(ipts,j,:,icarbon)=',&
+                     SUM(bm_alloc(ipts,j,:,icarbon))
+                IF (bm_alloc(ipts,j,ileaf,initrogen).GT.zero) THEN
+                   WRITE(numout,*) "((bm_alloc(ipts,j,ileaf,icarbon)/'//&
+                        'bm_alloc(ipts,j,ileaf,initrogen)):",&
+                        (bm_alloc(ipts,j,ileaf,icarbon)/&
+                        bm_alloc(ipts,j,ileaf,initrogen))
+                ENDIF
+             ENDIF
+             !-
+
+             IF(sum_sap(ipts).GT.min_stomate) THEN
+                bm_alloc(ipts,j,isapabove,initrogen)=alloc_d(ipts)* & 
+                     bm_alloc(ipts,j,isapabove,icarbon)/sum_sap(ipts)* &
+                     n_alloc_tot(ipts,j)
+                bm_alloc(ipts,j,isapbelow,initrogen) = alloc_d(ipts)* &
+                     bm_alloc(ipts,j,isapbelow,icarbon)/sum_sap(ipts)* &
+                     n_alloc_tot(ipts,j)
+             ENDIF
+             IF(sum_oth(ipts).GT.min_stomate) THEN
+                bm_alloc(ipts,j,iroot,initrogen) = alloc_e(ipts) * & 
+                     bm_alloc(ipts,j,iroot,icarbon)/sum_oth(ipts) * &
+                     n_alloc_tot(ipts,j)
+                bm_alloc(ipts,j,ifruit,initrogen) = alloc_e(ipts) * & 
+                     bm_alloc(ipts,j,ifruit,icarbon)/sum_oth(ipts) * &
+                     n_alloc_tot(ipts,j)
+             ENDIF
+
+             ! Necessary because bm_alloc_tot can be positive in deciduous, 
+             ! but all C is put into the reserve in this case, all fractions 
+             ! are set to zero, thus no nitrogen is allocated alternatively 
+             ! formulation is minus (c+d+e)*n_alloc_tot
+             n_alloc_tot(ipts,j) = (alloc_c(ipts) + &
+                  alloc_d(ipts) + alloc_e(ipts)) * &
+                  n_alloc_tot(ipts,j)
+
+          ELSE
+
+             n_alloc_tot(ipts,j) = zero
+
+          ENDIF
+
+       ENDDO ! # npts
+  
+    ENDDO ! #PFT
+
+    !! 6.3 Retrieve allocated biomass from labile pool
+    !  Only now the allocatable nitrogen is known 
+    !  so we will take it from the labile pool.
+    tmp_bm(:,:,ilabile,initrogen) = tmp_bm(:,:,ilabile,initrogen) - &
+         n_alloc_tot(:,:)
+
+    ! Some temporary variables to simplify the calculations
+    tmp_bm(:,:,ileaf,:) = zero
+    DO icir = 1,ncirc
+       DO iele = 1,nelements
+          tmp_bm(:,:,ileaf,iele) = tmp_bm(:,:,ileaf,iele) + &
+               circ_class_biomass(:,:,icir,ileaf,iele) * &
+               circ_class_n(:,:,icir)
+          tmp_bm(:,:,iroot,iele) = tmp_bm(:,:,iroot,iele) + &
+               circ_class_biomass(:,:,icir,iroot,iele) * &
+               circ_class_n(:,:,icir)
+       ENDDO
+    ENDDO
+       
+       
+    ! Nitrogen allocation is now accounted for in tmp_bm(ilabile,initrogen)
+    ! n_alloc_tot should be set to zero
+    n_alloc_tot(:,:) = zero
+
+    ! Calculate the nitrogen that is being translocated from the leaves
+    ! back to the labile pool.
+    IF( Dmax.GT.0.0 )THEN
+
+       WHERE((tmp_bm(:,:,ileaf,icarbon).GT.min_stomate).AND.&
+            (bm_alloc(:,:,ileaf,icarbon).GT.min_stomate))
+
+          transloc(:,:) = tmp_bm(:,:,ileaf,icarbon) * 0.05 * & 
+               (bm_alloc(:,:,ileaf,initrogen)/bm_alloc(:,:,ileaf,icarbon) - & 
+               tmp_bm(:,:,ileaf,initrogen) / &
+               tmp_bm(:,:,ileaf,icarbon))
+          transloc(:,:) = MAX(MIN(tmp_bm(:,:,ilabile,initrogen)*0.7,&
+               transloc(:,:)), -bm_alloc(:,:,ileaf,initrogen))
+          tmp_bm(:,:,ilabile,initrogen) = tmp_bm(:,:,ilabile,initrogen) - &
+               transloc(:,:)
+          bm_alloc(:,:,ileaf,initrogen) = bm_alloc(:,:,ileaf,initrogen) + &
+               transloc(:,:) 
+
+       ENDWHERE
+
+       WHERE((tmp_bm(:,:,iroot,icarbon).GT.min_stomate).AND. &
+            (bm_alloc(:,:,iroot,icarbon).GT.min_stomate))
+
+          transloc(:,:) = tmp_bm(:,:,iroot,icarbon) * 0.05 * &
+               (bm_alloc(:,:,iroot,initrogen)/bm_alloc(:,:,iroot,icarbon) - & 
+               tmp_bm(:,:,iroot,initrogen) / &
+               tmp_bm(:,:,iroot,icarbon))
+          transloc(:,:) = MAX(MIN(tmp_bm(:,:,ilabile,initrogen)*0.7,&
+               transloc(:,:)), -bm_alloc(:,:,iroot,initrogen))
+          tmp_bm(:,:,ilabile,initrogen) = tmp_bm(:,:,ilabile,initrogen) - &
+               transloc(:,:)
+          bm_alloc(:,:,iroot,initrogen) = bm_alloc(:,:,iroot,initrogen) + &
+               transloc(:,:)
+
+       ENDWHERE
+
+    ENDIF
+
+
+ !! 7. Update the biomass with newly allocated nitrogen biomass 
+
+    ! For icarbon, circ_class_biomass contains the latest information
+    ! for all its pools, For nitrogen this is also the case except for 
+    ! the labile pool. Account for the latest changes in tmp_bm(ilabile) 
+    ! and update circ_class_biomass so it contains the latest values 
+    ! for all pools for both elements.
+    circ_class_biomass(:,:,:,ilabile,initrogen) = &
+         biomass_to_cc(tmp_bm(:,:,ilabile,initrogen),&
+         circ_class_biomass(:,:,:,ilabile,initrogen),&
+         circ_class_n(:,:,:),npts,nvm)
+
+    ! Now convert circ_class_biomass to biomass to do all subsequent
+    ! calculations. This needs to recalculated because it is possible
+    ! that circ_class_biomass has changed since the last time we 
+    ! calculated biomass (see 5.4) 
+    tmp_bm(:,:,:,:) = cc_to_biomass(npts,nvm,&
+         circ_class_biomass(:,:,:,:,:),&
+         circ_class_n(:,:,:))
+
+    ! circ_class_biomass has not changed since the last time biomass
+    ! was calculated so there is no need to recalculate it
+    tmp_bm(:,:,:,initrogen) = tmp_bm(:,:,:,initrogen) + bm_alloc(:,:,:,initrogen)
+
+    ! All the biomass pools may have increased for nitrogen so update 
+    ! circ_class_biomass. After this operation circ_class_biomass and
+    ! biomass are in sync for carbon and nitrogen
+    DO ipar = 1,nparts
+       circ_class_biomass(:,:,:,ipar,initrogen) = &
+            biomass_to_cc(tmp_bm(:,:,ipar,initrogen),&
+            circ_class_biomass(:,:,:,ipar,initrogen),&
+            circ_class_n(:,:,:),npts,nvm)
+    ENDDO
+
+
+ !! 8. Use or fill reserve pools depending on relative size of the labile and reserve C pool
+
+    ! +++ CHECK +++
+    ! Externalize all the hard coded values i.e. 0.3
+    ! Calculate the labile pool for all plants and also the reserve pool for trees      
+    DO j = 2,nvm
+       
+       DO ipts = 1,npts
+
+          IF ( (veget_cov_max(ipts,j) .LE. min_stomate) .OR. &
+             (SUM(tmp_bm(ipts,j,:,icarbon)) .LT. min_stomate) ) THEN
+
+             ! this vegetation type is not present, so no reason to do the 
+             ! calculation. CYCLE will take us out of the innermost DO loop
+             CYCLE
+             
+          ENDIF
+
+          !! 8.1 Calculate NPP
+          !  Calculate the NPP @tex $(gC.m^{-2}dt^{-1})$ @endtex as the difference 
+          !  between GPP and the two components of autotrophic respiration 
+          !  (maintenance and growth respiration). GPP, R_maint and R_growth 
+          !  are prognostic variables, NPP is calculated as the residuals and is 
+          !  thus a diagnostic variable. Note that NPP is not used in the 
+          !  allocation scheme, instead bm_alloc_tot is allocated. The 
+          !  physiological difference between both is that bm_alloc_tot does no 
+          !  longer contain the reserves and labile pools and is only the carbon 
+          !  that needs to go into the biomass pools. NPP contains the reserves
+          !  and labile carbon. Note that GPP is in gC m-2 s-1 whereas the 
+          !  respiration terms were calculated in gC m-2 dt-1
+          npp(ipts,j) = gpp_daily(ipts,j) - resp_growth(ipts,j)/dt - &
+               resp_maint(ipts,j)/dt
+
+          !! 8.2 Calculate the reserves
+          !  There is vegetation present and it has started growing. The second and 
+          !  third condition required to make the PFT survive the first year during 
+          !  which the long term climate variables are initialized for the phenology. 
+          !  If these conditions are not added, the reserves are respired well 
+          !  before growth ever starts
+          IF ( veget_cov_max(ipts,j) .GT. min_stomate .AND. &
+               rue_longterm(ipts,j) .GE. zero .AND. &                  
+               rue_longterm(ipts,j) .NE. un) THEN
+        
+             !! 8.3 Calculate the optimal size of the pools   
+             ! We had an endless series of problems which were often difficult to
+             ! understand but which always seemed to be related to a sudden drop
+             ! in tmp_bm(ilabile). This drop was often the result of a sudden 
+             ! change in labile_pool. Given that there is not much science behind
+             ! this approach it seems a good idea to remove this max statement to
+             ! avoid sudden changes. Rather than using the actual biomass we propose
+             ! to use the target biomass. This assumes that the tree would like to 
+             ! fill its labile pool to be optimal when it would be in allometric
+             ! balance.
+             IF (is_tree(j)) THEN
+             
+                ! We will make use of the REAL sapwood, heartwood and effective height
+                ! and then calculate the target leaves and roots. This approach gives
+                ! us a target for a labile_pool of a tree in allometric balance. 
+                ! Basal area at the tree level (m2 tree-1)
+                circ_class_ba_eff(:) = &
+                     wood_to_ba_eff(circ_class_biomass(ipts,j,:,:,icarbon),j)             
+ 
+                ! Current biomass pools per tree (gC tree^-1) 
+                ! We will have different trees so this has to be calculated from the 
+                ! diameter relationships            
+                Cs(:) = (circ_class_biomass(ipts,j,:,isapabove,icarbon) + &
+                     circ_class_biomass(ipts,j,:,isapbelow,icarbon)) * scal(ipts,j)
+                Cr(:) = (circ_class_biomass(ipts,j,:,iroot,icarbon)) * scal(ipts,j)
+                Cl(:) = (circ_class_biomass(ipts,j,:,ileaf,icarbon)) * scal(ipts,j)
+
+                DO l = 1,ncirc 
+
+                   !  Calculate tree height
+                   circ_class_height_eff(l) = pipe_tune2(j) * &
+                        (4/pi*circ_class_ba_eff(l))**(pipe_tune3(j)/2)       
+                               
+                ENDDO
+
+                ! Use the pipe model to calculate the target leaf and root
+                ! biomasses
+                DO l = 1,ncirc
+                   IF(circ_class_height_eff(l) .GT. min_stomate) THEN
+                      Cl_target(l) = KF(ipts,j) * Cs(l) / circ_class_height_eff(l)
+                   
+                   ELSE
+                      Cl_target(l) = MAX((KF(ipts,j) * Cs(l) / circ_class_height_eff(l)), &
+                           (MAX(Cs(1)*KF(ipts,j), Cr(1)*LF(ipts,j), Cl(1))))
+                   
+                   ENDIF
+                ENDDO
+
+                DO l = 1,ncirc
+                   Cr_target(l) = Cl_target(l) / LF(ipts,j)
+                ENDDO
+
+             ! grasses and crops
+             ELSEIF ( .NOT. is_tree(j)) THEN
+
+                ! Initialize
+                Cs(:) = zero
+                Cl_target(:) = zero 
+                Cr_target(:) = zero
+
+                ! Current biomass pools per grass/crop (gC ind^-1)
+                ! Cs has too many dimensions for grass/crops. To have a consistent 
+                ! notation the same variables are used as for trees but the dimension 
+                ! of Cs, Cl and Cr i.e. ::ncirc should be ignored            
+                Cs(1) = tmp_bm(ipts,j,isapabove,icarbon) * scal(ipts,j)
+   
+                ! Use the pipe model to calculate the target leaf and root
+                ! biomasses
+                Cl_target(1) = Cs(1) * KF(ipts,j)
+                Cr_target(1) = Cl_target(1) / LF(ipts,j)
+                
+             ENDIF !is_tree
+
+             ! Accounting for the N-concentration of the tissue as a proxy
+             ! of tissue activity
+             ! labile_pool = lab_fac(ipts,j)/labile_reserve(j) * &
+             !     ( SUM(Cl_target(:))+ & 
+             !     SUM(Cr_target(:)) * fcn_root(j) + & 
+             !     SUM(Cs(:)) * fcn_wood(j) )  / cn_leaf(ipts,j)
+             ! There was some problems for the deciduous trees, when the targeted
+             ! labile pool was calculated based on the targeted values from the allometric 
+             ! allocation. Once the target was no longer reach for the labile both the reserve 
+             ! pool (because carbon was no longer redistributed from the labile to the reserve pool),
+             ! GPP and LAI would drastically decrease. Thus, the calculations were changed to the 
+             ! biomass at the stand level. The same is done in the CN version.
+             labile_pool = lab_fac(ipts,j)/labile_reserve(j) * (tmp_bm(ipts,j,ileaf,icarbon)  + & 
+                  fcn_root(j) * ( tmp_bm(ipts,j,iroot,icarbon) +tmp_bm(ipts,j,ifruit,icarbon) ) + & 
+                  fcn_wood(j) * (tmp_bm(ipts,j,isapabove,icarbon) +tmp_bm(ipts,j,isapbelow,icarbon) + &
+                  tmp_bm(ipts,j,icarbres,icarbon) ) )
+            
+            
+             ! Debug 
+             IF (j .EQ. test_pft .AND. printlev_loc.GE.4) THEN
+                WRITE(numout,*) 'circ_class_biomass(ipts,j,:,isapbelow,icarbon)=', &
+                     circ_class_biomass(ipts,j,:,isapbelow,icarbon)
+                WRITE(numout,*) 'circ_class_biomass(ipts,j,:,isapabove,icarbon)=', &
+                     circ_class_biomass(ipts,j,:,isapabove,icarbon)
+                WRITE(numout,*) 'scal=',scal(ipts,j)
+                WRITE(numout,*) 'labile_reserve(j)=',labile_reserve(j)
+                WRITE(numout,*) 'Cl_target(:)=',Cl_target(:)
+                WRITE(numout,*) 'Cr_target(:)=',Cr_target(:)
+                WRITE(numout,*) 'Cs(:)=',Cs(:)
+                WRITE(numout,*) 'fcn_root(j)=',fcn_root(j)
+                WRITE(numout,*) 'fcn_wood(j)=',fcn_wood(j)
+                WRITE(numout,*) 'cn_leaf(ipts,j)=',cn_leaf(ipts,j)
+                WRITE(numout,*) 'lab_fac, labile pool, ', lab_fac(ipts,j), labile_pool
+             ENDIF
+             !-
+
+             ! The max size of reserve pool is proportional to the size of the 
+             ! storage organ (the sapwood) and a the leaf functional trait of the 
+             ! PFT (::phene_type_tab). The reserve pool is constrained by the mass 
+             ! needed to replace foliage and roots. This constraint prevents the
+             ! scheme from putting too much reserves in big trees (which have a lot 
+             ! of sapwood compared to small trees). Exessive storage would hamper 
+             ! tree growth and would make mortality less likely.
+             IF(is_tree(j)) THEN
+
+                IF (pheno_type(j).EQ.1) THEN 
+
+                   ! Evergreen trees are not very conservative with respect to 
+                   ! C-storage. Therefore, only 5% of their sapwood mass is stored 
+                   ! in their reserve pool.
+                   reserve_pool = MIN(evergreen_reserve(j) * &
+                        ( tmp_bm(ipts,j,isapabove,icarbon) + &
+                        tmp_bm(ipts,j,isapbelow,icarbon)), &
+                        lai_to_biomass(lai_target(ipts,j),j)*(1.+0.3/ltor(ipts,j)))
+
+                   ! Debug
+                   IF (j .EQ. test_pft .AND. printlev_loc.GE.4 .AND. ipts == test_grid) THEN
+                      WRITE(numout,*) 'What happens to the reserve and labile &
+                           & pools? Evergreen'
+                      WRITE(numout,*) 'carbres, reserve_pool: ',&
+                           tmp_bm(ipts,j,icarbres,icarbon),reserve_pool
+                      WRITE(numout,*) 'ilabile, labile_pool: ',&
+                           tmp_bm(ipts,j,ilabile,icarbon),labile_pool
+                      WRITE(numout,*) 'evergreen_reserve(j): ',&
+                           evergreen_reserve(j)
+                      WRITE(numout,*) 'isapabove,isapbelow: ',&
+                           tmp_bm(ipts,j,isapabove,icarbon), &
+                           tmp_bm(ipts,j,isapbelow,icarbon)
+                      WRITE(numout,*) 'lai_target,ltor: ',&
+                           lai_target(ipts,j),ltor(ipts,j)
+                      WRITE(numout,*) 'term1, term2: ',&
+                           evergreen_reserve(j) * ( tmp_bm(ipts,j,isapabove,icarbon) + &
+                           tmp_bm(ipts,j,isapbelow,icarbon)),&
+                           lai_to_biomass(lai_target(ipts,j),j)*(1.+0.3/ltor(ipts,j))
+                   ENDIF
+                   !-
+               
+                ELSE
+
+                   ! Deciduous trees are more conservative and 12% of their sapwood mass 
+                   ! is stored in the reserve pool. The scheme avoids that during the 
+                   ! growing season too much reserve are accumulated (which would hamper 
+                   ! growth), therefore, the reduced rate of 12% is used until scenecence.
+                   IF (SUM(bm_alloc(ipts,j,:,icarbon)) .GT. min_stomate) THEN
+
+!!$                   !+++CHECK+++
+!!$                   ! This is the the original approach by Sonke
+!!$                     reserve_pool = MIN(deciduous_reserve(j) * &
+!!$                           ( tmp_bm(ipts,j,isapabove,icarbon) + &
+!!$                           tmp_bm(ipts,j,isapbelow,icarbon)), &
+!!$                           lai_target(ipts,j)/sla(j)*(1.+0.3/ltor(ipts,j)))
+                      ! A more stable alternative by Nicolas
+                      reserve_pool = deciduous_reserve(j) * &
+                           ( tmp_bm(ipts,j,isapabove,icarbon) + & 
+                           tmp_bm(ipts,j,isapbelow,icarbon))
+                      !+++++++++++
+
+                      ! Debug
+                      IF (j .EQ. test_pft .AND. printlev_loc.GE.4 .AND. &
+                           ipts == test_grid) THEN
+                         WRITE(numout,*) 'What happens to the reserve and '//&
+                              'labile pools? Deciduous'
+                         WRITE(numout,*) 'carbres, reserve_pool: ',&
+                              tmp_bm(ipts,j,icarbres,icarbon),reserve_pool
+                         WRITE(numout,*) 'deciduous_reserve: ',&
+                              deciduous_reserve(j)
+                         WRITE(numout,*) 'isapabove,isapbelow: ',&
+                              tmp_bm(ipts,j,isapabove,icarbon), &
+                              tmp_bm(ipts,j,isapbelow,icarbon)
+                         WRITE(numout,*) 'lai_target,ltor: ',&
+                              lai_target(ipts,j),ltor(ipts,j)
+                         WRITE(numout,*) 'term1, term2: ',&
+                              deciduous_reserve(j) * ( tmp_bm(ipts,j,isapabove,icarbon) + &
+                              tmp_bm(ipts,j,isapbelow,icarbon)),&
+                              lai_to_biomass(lai_target(ipts,j),j)*(1.+0.3/ltor(ipts,j))
+                      ENDIF
+                      !-
+
+                  ELSE  
+
+                     ! If the plant is scenecent, allow for a higher reserve mass. Plants 
+                     ! can then use the excess labile C, that is no longer used for growth 
+                     ! and would be respired otherwise, to regrow leaves after the dormant 
+                     ! period.
+                     !+++CHECK+++
+                     ! This is the the original approach by Sonke
+!!$                     reserve_pool = MIN(senescense_reserve(j) * &
+!!$                          ( tmp_bm(ipts,j,isapabove,icarbon) + &
+!!$                           tmp_bm(ipts,j,isapbelow,icarbon)), &
+!!$                           lai_target(ipts,j)/sla(j)*(1.+0.3/ltor(ipts,j)))
+                     ! A more stable alternative by Nicolas
+                     reserve_pool = senescense_reserve(j) * &
+                          ( tmp_bm(ipts,j,isapabove,icarbon) + & 
+                          tmp_bm(ipts,j,isapbelow,icarbon))
+                     !+++++++++++
+
+                     ! Debug
+                     IF (j .EQ. test_pft .AND. printlev_loc.GE.4 .AND. &
+                          ipts == test_grid) THEN
+                        WRITE(numout,*) 'What happens to the reserve and labile pools? '//&
+                             'Senescent'
+                        WRITE(numout,*) 'carbres, reserve_pool: ',&
+                             tmp_bm(ipts,j,icarbres,icarbon),reserve_pool
+                        WRITE(numout,*) 'senescense_reserve(j): ',&
+                             senescense_reserve(j)
+                        WRITE(numout,*) 'isapabove,isapbelow: ',&
+                             tmp_bm(ipts,j,isapabove,icarbon), &
+                             tmp_bm(ipts,j,isapbelow,icarbon)
+                        WRITE(numout,*) 'lai_target,ltor: ',&
+                             lai_target(ipts,j),ltor(ipts,j)
+                        WRITE(numout,*) 'term1, term2: ',&
+                             senescense_reserve(j) * ( tmp_bm(ipts,j,isapabove,icarbon) + &
+                             tmp_bm(ipts,j,isapbelow,icarbon)),&
+                             lai_to_biomass(lai_target(ipts,j),j)*(1.+0.3/ltor(ipts,j))
+                     ENDIF
+                      
+                  ENDIF ! Scenecent
+
+               ENDIF ! Phenology type
+
+            ! Grasses
+            ELSE
+
+               !+++CHECK+++
+               ! The min criterion results in the reserves being zero because 
+               ! isapabove goes to zero when the reserves are most needed 
+               reserve_pool = MIN(0.3 * ( tmp_bm(ipts,j,iroot,icarbon) + &
+                    tmp_bm(ipts,j,isapabove,icarbon) + & 
+                    tmp_bm(ipts,j,isapbelow,icarbon)), &
+                    lai_target(ipts,j)/sla(j)*(1.+root_reserve(j)/ltor(ipts,j)))
+               !+++++++++++
+
+               ! Debug 
+               IF (j .EQ. test_pft .AND. printlev_loc.GE.4 .AND. ipts == test_grid) THEN
+                  WRITE(numout,*) 'reserve pool, 30%', reserve_pool
+               ENDIF
+               !-
+
+            ENDIF
+
+            ! Store this intermediate result so it can be written to the history
+            ! files. The target reserve and labile pools are stored here.
+            reserve_pool_write(ipts,j) = reserve_pool   
+            labile_pool_write(ipts,j) = labile_pool
+
+            !! 8. Move carbon between the reserve pools
+            !  Fill the reserve pools up to their optimal level or until the min/max 
+            !  limits are reached. The original approach in OCN resulted in 
+            !  instabilities and sometimes oscilations. For this reason a more 
+            !  simple and straightforward transfer between the pools has been 
+            !  implemented.
+            
+            !! 8.4.1 Burn excess reserves
+            !  The actual reserve and/or labile pool exceed the required pools 
+            !  (as calculated in 7.1). The excess reserve pools respire C 
+            !  which needs to be accounted for in the growth respiration. Because 
+            !  of this line of code, NPP cannot be calculated at the start of this 
+            !  subroutine (i.e. between section 4 and 5). Last, correct the
+            !  labile and reserve pool for this respiration flux. Note that instead 
+            !  of respiring this carbon it could be used for leaching, feeding 
+            !  mycorrhizae, producing DOCs, producing VOCs or any other component 
+            !  of NPP that does not end up in the biomass.
+
+            !  In the past the follow IF-block has been commenting out because
+            !  it caused problems for trees from growing after coppicing.  It is unclear
+            !  exactly what the point of it is, too.  In another loop, if the
+            !  labile pool is overful but the carbres pool is just below the limit,
+            !  the code is supposed to move labile carbon to the reserve pool.  It does
+            !  it so slowly, though, that it might as well not be doing it at all.  Here
+            !  we burn off the reserves while leaving the labile pool, since the labile
+            !  pool is used for allocation.  This implicitly supposes that some of the
+            !  carbon burned off from the reserve pool turns into labile carbon, enough
+            !  to counter whatever is burned off from the labile pool.
+            IF ( (tmp_bm(ipts,j,icarbres,icarbon) .GE. reserve_pool) .AND. &
+                 (tmp_bm(ipts,j,ilabile,icarbon) .GE. labile_pool) ) THEN
+
+               ! reserves are full
+               IF ( tmp_bm(ipts,j,icarbres,icarbon) .GT. reserve_pool ) THEN
+
+                  excess = tmp_bm(ipts,j,icarbres,icarbon) - reserve_pool
+
+                  ! Debug
+                  IF (j.EQ.test_pft .AND. printlev_loc.GE.4 .AND. ipts == test_grid) THEN
+                     WRITE(numout,*) 'excess reserve, ', &
+                          excess, tmp_bm(ipts,j,icarbres,icarbon), &
+                          reserve_pool 
+                  ENDIF
+                  !-
+
+                  resp_growth(ipts,j) = resp_growth(ipts,j) + 0.1 * excess
+                  tmp_bm(ipts,j,icarbres,icarbon) = tmp_bm(ipts,j,icarbres,icarbon) - &
+                       0.1 * excess
+
+               ENDIF
+
+               ! Debug
+               IF (j.EQ.test_pft .AND. printlev_loc.GE.4 .AND. ipts == test_grid) THEN
+                  WRITE(numout,*) 'reserve pools are considered too full'
+                  WRITE(numout,*) 'excess, ', excess 
+                  WRITE(numout,*) 'resp_growth, ', resp_growth(ipts,j)
+                  WRITE(numout,*) 'biomass(ilabile) really final, ', &
+                       tmp_bm(ipts,j,ilabile,icarbon)
+                  WRITE(numout,*) 'biomass(icarbres) really final, ', &
+                       tmp_bm(ipts,j,icarbres,icarbon)
+                  WRITE(numout,*) 'when_growthinit, ', j, when_growthinit(ipts,j)
+                  WRITE(numout,*) 'plant_status, ',j, plant_status(ipts,j)
+               ENDIF
+               !-       
+
+            !! 8.4.2 Enough reserves, not enough labile
+            ELSEIF ( (tmp_bm(ipts,j,icarbres,icarbon) .GE. reserve_pool) .AND. &
+                 (tmp_bm(ipts,j,ilabile,icarbon) .LT. labile_pool) ) THEN
+
+               ! We need to move carbon from the reserve pool to the labile pool. 
+               ! We will move this gradually. Calculate the maximum flow of the 
+               ! carbon reserve pool to labile 
+               IF (is_tree(j)) THEN
+
+                  ! During the dormant season for evergreens or the growing season 
+                  ! for both functional leaf traits. 
+                  IF ( (tmp_bm(ipts,j,ileaf,icarbon) .GT. min_stomate .AND. &
+                       f_alloc(ipts,j,isapabove) .LE. min_stomate) .OR. & 
+                       (lab_fac(ipts,j) .GT. 0.1) ) THEN 
+
+                     ! Don't move more than an arbitrary 5% from the carbohydrate 
+                     ! reserve pool
+                     use_max = tmp_bm(ipts,j,icarbres,icarbon) * 0.05
+
+                  ! Dormant season
+                  ELSE 
+
+                     ! Don't move any carbon between the reserve and the labile pool
+                     use_max = zero
+
+                  ENDIF ! Growing or dormant season
+
+               ! Grasses
+               ELSE 
+
+                  ! During the growing season
+                  IF (tmp_bm(ipts,j,ileaf,icarbon).GT.min_stomate) THEN 
+
+                     ! Don't move more than an arbitrary 5% from the 
+                     ! carbohydrate reserve pool
+                     use_max = tmp_bm(ipts,j,icarbres,icarbon) * 0.05
+
+                  ! Dormant season
+                  ELSE 
+
+                     ! Don't move any carbon between the reserve and the labile pool
+                     use_max = zero
+
+                  ENDIF ! Growing or dormant season
+
+               ENDIF ! Trees or grasses
+
+               ! Calculate the required flow of the carbon reserve pool to labile  
+               ! Propose to use what can be moved from the reserve pool (::use_max) or 
+               ! the amount required to fill the pool.
+               use_res = MAX(zero, MIN(use_max, labile_pool - &
+                    tmp_bm(ipts,j,ilabile,icarbon)))
+
+               ! Update labile pool and reserve
+               bm_alloc(ipts,j,icarbres,icarbon) =  use_res
+               tmp_bm(ipts,j,ilabile,icarbon) = tmp_bm(ipts,j,ilabile,icarbon) + &
+                    bm_alloc(ipts,j,icarbres,icarbon)
+               tmp_bm(ipts,j,icarbres,icarbon) = tmp_bm(ipts,j,icarbres,icarbon) - &
+                    bm_alloc(ipts,j,icarbres,icarbon)
+
+               ! Debug 
+               IF (j .EQ. test_pft .AND. printlev_loc.GE.4) THEN
+                  WRITE(numout,*) 'move carbon from reserve to labile'
+                  WRITE(numout,*) 'use_res, ', use_res
+                  WRITE(numout,*) 'required: reserve and labile pool, ', &
+                       reserve_pool, labile_pool
+                  WRITE(numout,*) 'available: reserve and labile, ', &
+                       tmp_bm(ipts,j,icarbres,icarbon), &
+                       tmp_bm(ipts,j,ilabile,icarbon)
+               ENDIF
+               !-
+
+            ! 8.4.3 Enough labile, not enough reserves
+            ELSEIF ( (tmp_bm(ipts,j,icarbres,icarbon) .LT. reserve_pool) .AND. &
+                 (tmp_bm(ipts,j,ilabile,icarbon) .GE. labile_pool) ) THEN
+
+               ! The labile carbon is more mobile than the reserve pool but
+               ! it is also more important in the allocation scheme because 
+               ! it generates growth respiration and it is used to calculate
+               ! bm_alloc. Therefore, the mobility of the labile pool was
+               ! restricted to an arbitrary 15% 
+               use_max = tmp_bm(ipts,j,ilabile,icarbon) * 0.15
+
+               ! Propose to use what can be moved from the reserve labile pool
+               ! (::use_max) or the amount required to fill the pool.
+               use_lab = MAX(zero, MIN(use_max, &
+                    reserve_pool- tmp_bm(ipts,j,icarbres,icarbon)))
+
+               ! Update labile pool and reserve
+               bm_alloc(ipts,j,icarbres,icarbon) =  use_lab
+               tmp_bm(ipts,j,ilabile,icarbon) = tmp_bm(ipts,j,ilabile,icarbon) - &
+                    bm_alloc(ipts,j,icarbres,icarbon)
+               tmp_bm(ipts,j,icarbres,icarbon) = tmp_bm(ipts,j,icarbres,icarbon) + &
+                    bm_alloc(ipts,j,icarbres,icarbon)
+
+               ! Debug 
+               IF (j .EQ. test_pft .AND. printlev_loc.GE.4) THEN
+                  WRITE(numout,*) 'move carbon from labile to reserve'
+                  WRITE(numout,*) 'use_lab, ', use_lab
+                  WRITE(numout,*) 'required: reserve and labile pool, ',&
+                       reserve_pool, labile_pool
+                  WRITE(numout,*) 'available: reserve and labile, ', &
+                       tmp_bm(ipts,j,icarbres,icarbon), &
+                       tmp_bm(ipts,j,ilabile,icarbon)
+               ENDIF
+               !-
+
+            !! 8.4.4 We don't have enough carbon in either reserve pool. We will 
+            !  redistribute what we have to minimise the tension between available and 
+            !  required
+            ELSEIF ( (tmp_bm(ipts,j,icarbres,icarbon) .LT. reserve_pool) .AND. &
+                 (tmp_bm(ipts,j,ilabile,icarbon) .LT. labile_pool) ) THEN 
+
+               ! Not really clear what the advantage is of doing this. So
+               ! the code was removed
+
+               ! Debug
+               IF (j .EQ. test_pft .AND. printlev_loc.GE.4) THEN
+                  WRITE(numout,*) 'not enough carbon to satify the'//&
+                       'total requirement of labile and reserve'
+                  WRITE(numout,*) 'bm_alloc: ',bm_alloc(ipts,j,icarbres,icarbon)
+                  WRITE(numout,*) 'SUM(bm_alloc): ',SUM(bm_alloc(ipts,j,:,icarbon))
+                  WRITE(numout,'(A,2ES20.10)') 'required: reserve and labile pool, ',&
+                       reserve_pool, labile_pool
+                  WRITE(numout,'(A,2ES20.10)') 'available: reserve and labile, ', &
+                       tmp_bm(ipts,j,icarbres,icarbon), &
+                       tmp_bm(ipts,j,ilabile,icarbon)
+               ENDIF
+               !-
+           
+            !!  8.5 Unexpected condition
+            ELSE
+
+               IF(printlev_loc>=5 .OR. printlev_loc.GE.4) THEN
+                  WRITE(numout,*) 'An unexpected condition occured for the reserve pools'
+                  WRITE(numout,*) 'labile_reserve(j)=', j, labile_reserve(j)
+                  WRITE(numout,*) 'cn_leaf(ipts,j)=', j, cn_leaf(ipts,j)
+                  WRITE(numout,*) 'required: reserve and labile pool, ', j, &
+                       reserve_pool, labile_pool
+                  WRITE(numout,*) 'available: reserve and labile, ', &
+                       tmp_bm(ipts,j,icarbres,icarbon), &
+                       tmp_bm(ipts,j,ilabile,icarbon)
+                  CALL ipslerr_p (3,'growth_fun_all',&
+                       'An unexpected condition occured for the reserve pools','','')
+               ENDIF
+
+            ENDIF
+
+          ELSEIF ( veget_cov_max(ipts,j) .GT. min_stomate .AND. &
+               rue_longterm(ipts,j) .EQ. un) THEN
+
+             ! There hasn't been any photosynthesis yet. This happens when a 
+             ! new vegetation is prescribed and the longterm phenology variables 
+             ! are not initialized yet. These conditions happen when the model is 
+             ! started from scratch (no restart files). Because the plants are 
+             ! very small, they contain little reserves. We increased the amount 
+             ! of reserves by a factor ::tune_r_in_sapling where r stands for 
+             ! reserves. However, this amount gets simply respired before it is 
+             ! needed because the reserve_pool is calculated as a function of the 
+             ! sapwood biomass which is very low because the plants are really 
+             ! small. Here we skip recalculating the reserve_pool until the day 
+             ! we start using it.
+
+          ELSE
+
+             ! No reason to be here
+             WRITE(numout,*) 'Error: unexpected condition for the reserve pools, pft, ',j
+             WRITE(numout,*) 'veget_cov_max, rue_longterm, ', veget_cov_max(ipts,j), &
+                  rue_longterm(ipts,j)
+
+          ENDIF ! rue_longterm
+          
+
+          !! 8.6 Use or fill reserve pools depending on relative size of the 
+          !  labile and reserve N pool
+          IF(veget_cov_max(ipts,j) .GT. min_stomate) THEN 
+
+             costf = f_alloc(ipts,j,ileaf) + fcn_wood(j) * &
+                  (f_alloc(ipts,j,isapabove)+f_alloc(ipts,j,isapbelow)) + &
+                  fcn_root(j) * ( f_alloc(ipts,j,iroot) + f_alloc(ipts,j,ifruit) )
+
+             IF (costf.EQ.0.0) costf=1.
+             labile_pool = tmp_bm(ipts,j,ilabile,icarbon)/cn_leaf(ipts,j) * costf 
+             labile_pool_n = MIN(labile_pool, tmp_bm(ipts,j,ilabile,icarbon))/&
+                  cn_leaf(ipts,j) * costf
+
+             ! excess or deficit of nitrogen in the labile pool
+             use_lab = tmp_bm(ipts,j,ilabile,initrogen) - labile_pool_n
+
+!!$          IF(is_tree(j))THEN
+!!$          
+!!$             reserve_pool = 0.12 * ( tmp_bm(ipts,j,isapabove,icarbon) + &
+!!$                  tmp_bm(ipts,j,isapbelow,icarbon))/cn_leaf(ipts,j) * & 
+!!$                  (1.+fcn_root(j)/ltor(ipts,j))/(1.+0.3/ltor(ipts,j))
+!!$          ELSE
+!!$             
+!!$             reserve_pool = 0.3 * ( tmp_bm(ipts,j,iroot,icarbon) + &
+!!$                  tmp_bm(ipts,j,isapabove,icarbon) + &
+!!$                  tmp_bm(ipts,j,isapbelow,icarbon))/cn_leaf(ipts,j) * & 
+!!$                  (1.+fcn_root(j)/ltor(ipts,j))/(1.+0.3/ltor(ipts,j))
+!!$             
+!!$          ENDIF
+
+             reserve_pool = tmp_bm(ipts,j,icarbres,icarbon)/cn_leaf(ipts,j) * &
+                     (1.+fcn_root(j)/ltor(ipts,j))/(1.+root_reserve(j)/ltor(ipts,j))
+
+             IF(reserve_pool.GT.min_stomate)THEN
+
+                reserve_scal = MIN(MAX(1. - tmp_bm(ipts,j,icarbres,initrogen) / &
+                     reserve_pool,1.),0.1)
+                
+                IF(labile_pool_n.GT.min_stomate)THEN
+                   use_res= tmp_bm(ipts,j,icarbres,initrogen) * reserve_scal * &
+                        MAX(1.- tmp_bm(ipts,j,ilabile,initrogen) / labile_pool_n,0.0)
+
+                ELSE
+
+                   use_res=zero
+
+                ENDIF
+               
+             ELSE
+
+                use_res = tmp_bm(ipts,j,icarbres,initrogen)
+
+             ENDIF
+
+             IF(use_lab.GT.0.0)THEN
+
+                use_max=MAX(-use_lab, tmp_bm(ipts,j,icarbres,initrogen)-reserve_pool)
+
+             ELSEIF(use_res.GT.-use_lab)THEN
+
+                use_max=-use_lab
+
+             ELSE
+
+                use_max=use_res
+               
+             ENDIF
+            
+             tmp_bm(ipts,j,icarbres,initrogen) = tmp_bm(ipts,j,icarbres,initrogen)-use_max
+             tmp_bm(ipts,j,ilabile,initrogen) = tmp_bm(ipts,j,ilabile,initrogen)+use_max
+             bm_alloc(ipts,j,icarbres,initrogen) = bm_alloc(ipts,j,icarbres,initrogen)-use_max
+             
+             ! We need to keep the reserve nitrogen pool filled according to 
+             ! the filling status of the carbon reserve to allow decidiuous PFTs 
+             ! to grow when we initialize an impose_cn=n run with the restarts 
+             ! from an impose_cn=y simulation; if we don't ensure that there is 
+             ! enough reserve N the PFT will get extinct.
+             IF(is_tree(j)) THEN
+
+                IF (pheno_type(j).NE.1) THEN
+
+                   IF (impose_cn) THEN
+
+                      ! take what is needed to keep nitrogen reserves optimal
+                      atm_to_bm(ipts,j,initrogen) = atm_to_bm(ipts,j,initrogen) + &
+                            MAX((tmp_bm(ipts,j,icarbres,icarbon)/cn_leaf(ipts,j) * & 
+                            (1.+fcn_root(j)/ltor(ipts,j)) / &
+                            (1.+root_reserve(j)/ltor(ipts,j))) - &
+                            tmp_bm(ipts,j,icarbres,initrogen),zero)
+
+                      ! fill the pool
+                      tmp_bm(ipts,j,icarbres,initrogen) = &
+                           MAX(tmp_bm(ipts,j,icarbres,initrogen), &
+                           tmp_bm(ipts,j,icarbres,icarbon)/cn_leaf(ipts,j) * & 
+                           (1.+fcn_root(j)/ltor(ipts,j))/(1.+root_reserve(j)/ltor(ipts,j)))
+    
+
+                   ENDIF
+
+                ENDIF
+
+             ENDIF
+             
+          ENDIF
+
+          ! biomass has changed so update circ_class_biomass
+          DO ipar = 1,nparts
+             circ_class_biomass(ipts,j,:,ipar,icarbon) = &
+                  biomass_to_cc(tmp_bm(ipts,j,ipar,icarbon),&
+                  circ_class_biomass(ipts,j,:,ipar,icarbon),&
+                  circ_class_n(ipts,j,:))
+             circ_class_biomass(ipts,j,:,ipar,initrogen) = &
+                  biomass_to_cc(tmp_bm(ipts,j,ipar,initrogen),&
+                  circ_class_biomass(ipts,j,:,ipar,initrogen),&
+                  circ_class_n(ipts,j,:))
+          ENDDO
+
+      ENDDO ! pnts
+
+   ENDDO ! PFTs
+
+
+ !! 9. Check mass balance closure
+
+   IF (err_act.GT.1) THEN
+
+      ! 9.2 Check surface area
+      CALL check_surface_area("stomate_allocation", npts, veget_cov_max_begin, &
+           veget_cov_max,'pft')
+
+      ! 9.3 Mass balance closure 
+      ! 9.3.1 Calculate final biomass
+      pool_end(:,:,:) = zero
+      DO ipar = 1,nparts
+         DO iele = 1,nelements
+            DO icir = 1,ncirc
+               pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                    (circ_class_biomass(:,:,icir,ipar,iele) * &
+                    circ_class_n(:,:,icir) * veget_cov_max(:,:))
+            ENDDO
+         ENDDO
+      ENDDO
+
+      ! 9.3.2 Calculate mass balance 
+      ! Specific processes for carbon
+      check_intern(:,:,iatm2land,icarbon) = &
+           check_intern(:,:,iatm2land,icarbon) + &
+           (gpp_daily(:,:) + atm_to_bm(:,:,icarbon)) * dt * veget_cov_max(:,:)
+      check_intern(:,:,iatm2land,initrogen) = &
+           check_intern(:,:,iatm2land,initrogen) + & 
+           atm_to_bm(:,:,initrogen) * dt * veget_cov_max(:,:)
+      check_intern(:,:,iland2atm,icarbon) = -un * &
+           (resp_maint(:,:) + resp_growth(:,:)) * veget_cov_max(:,:)
+
+      ! Common processes for icarbon and initrogen
+      DO iele=1,nelements
+         check_intern(:,:,ipoolchange,iele) = -un * (pool_end(:,:,iele) - &
+              pool_start(:,:,iele))
+      ENDDO
+
+      closure_intern = zero
+
+      DO imbc = 1,nmbcomp
+         DO iele=1,nelements
+            ! Debug
+             IF (printlev_loc>=4) THEN
+                WRITE(numout,*) 'check_intern, imbc, iele, ', imbc, &
+                     iele, check_intern(:,test_pft,imbc,iele)
+             ENDIF
+             !-
+            closure_intern(:,:,iele) = closure_intern(:,:,iele) + &
+                 check_intern(:,:,imbc,iele)
+         ENDDO
+      ENDDO
+
+      ! 9.3.3 Check mass balance closure
+      IF(printlev_loc>=4) THEN 
+         WRITE(numout,*) 'closure intern, ', closure_intern
+         WRITE(numout,*) 'npts, ', npts
+         WRITE(numout,*) 'pool_end, ', pool_end
+         WRITE(numout,*) 'pool_start, ', pool_start
+         WRITE(numout,*) 'veget_cov_max, ', veget_cov_max
+      ENDIF
+
+      CALL check_mass_balance("stomate_allocation", closure_intern, npts, pool_end, &
+           pool_start, veget_cov_max, 'pft')
+
+   ENDIF ! err_act.GT.1
+
+
+   !! 10. Update leaf age
+   !  Leaf age is needed to calculate the turnover and vmax in the 
+   !  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. 
+   
+   !  Update biomass first
+   tmp_bm(:,:,:,:) = cc_to_biomass(npts,nvm,circ_class_biomass(:,:,:,:,:),&
+        circ_class_n(:,:,:))
+   
+   !! 9.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,icarbon)) with a leaf age of zero.
+   leaf_mass_young(:,:) = leaf_frac(:,:,1) * lm_old(:,:) + bm_alloc(:,:,ileaf,icarbon)
+
+   ! 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(:,:,1)' 
+   DO ipts=1,npts
+
+      DO j=1,nvm
+
+         ! IF(veget_cov_max(ipts,j) == zero)THEN
+         !     ! this vegetation type is not present, so no reason to do the 
+         !     ! calculation
+         !     CYCLE
+         ! ENDIF
+
+         IF( (bm_alloc(ipts,j,ileaf,icarbon) .GT. min_stomate ) .AND. &
+              ( leaf_mass_young(ipts,j) .GT. min_stomate ) )THEN
+
+            leaf_age(ipts,j,1) = MAX ( zero, leaf_age(ipts,j,1) * &
+                 ( leaf_mass_young(ipts,j) - bm_alloc(ipts,j,ileaf,icarbon) ) / &
+                 & leaf_mass_young(ipts,j) )
+
+         ENDIF
+
+      ENDDO
+
+   ENDDO
+
+
+   !! 11 Update leaf age
+   !  Update fractions of leaf biomass in each age class (fraction 
+   !  in youngest class increases)
+
+   !! 11.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
+   WHERE ( tmp_bm(:,:,ileaf,icarbon) .GT. min_stomate )
+
+      leaf_frac(:,:,1) = leaf_mass_young(:,:) / tmp_bm(:,:,ileaf,icarbon)
+
+   ENDWHERE
+
+
+   !! 11.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
+
+      WHERE ( tmp_bm(:,:,ileaf,icarbon) .GT. min_stomate )
+
+         leaf_frac(:,:,m) = leaf_frac(:,:,m) * lm_old(:,:) / tmp_bm(:,:,ileaf,icarbon)
+
+      ENDWHERE
+
+   ENDDO       ! Loop over # leaf age classes
+   !-----
+
+   !! 12. Update whole-plant age 
+
+   !! 12.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
+
+
+   !! 12.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( tmp_bm(:,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,:,icarbon), DIM=2 ). 
+   !  Before allocation, the plant biomass is bm_new-bm_add, its age is 
+   !  "age(:,j)". The age of the new biomass is the average of the ages 
+   !  of previous and added biomass. For trees, age is treated in 
+   !  "establish" if vegetation is dynamic, and in turnover routines if 
+   !  it is static (in this case, only the age of the heartwood is 
+   !  accounted for).
+   DO j = 2,nvm
+
+      IF ( .NOT. is_tree(j) ) THEN
+
+         bm_new(:) = tmp_bm(:,j,ileaf,icarbon) + tmp_bm(:,j,isapabove,icarbon) + &
+              tmp_bm(:,j,iroot,icarbon) + tmp_bm(:,j,ifruit,icarbon)
+         bm_add(:) = bm_alloc(:,j,ileaf,icarbon) + bm_alloc(:,j,isapabove,icarbon) + &
+              bm_alloc(:,j,iroot,icarbon) + bm_alloc(:,j,ifruit,icarbon)
+
+         WHERE ( ( bm_new(:) .GT. min_stomate ) .AND. ( bm_add(:) .GT. min_stomate ) )
+
+            age(:,j) = age(:,j) * ( bm_new(:) - bm_add(:) ) / bm_new(:)
+
+         ENDWHERE
+
+      ENDIF ! is .NOT. tree
+
+   ENDDO  ! Loop over #PFTs 
+
+   !! 13. Write history files
+
+   ! Save in history file the variables describing the biomass allocated to the plant parts
+   ! Calculate the change in biomass at the end of the routine
+   tmp_bm(:,:,:,:) = cc_to_biomass(npts,nvm,circ_class_biomass(:,:,:,:,:),&
+         circ_class_n(:,:,:)) - tmp_init_bm(:,:,:,:)
+
+    DO l=1,nelements
+       IF     (l == icarbon) THEN
+          element_str(l) = '_c'
+       ELSEIF (l == initrogen) THEN
+          element_str(l) = '_n'
+       ELSE
+          STOP 'Define element_str'
+       ENDIF
+
+       CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_LEAF'//TRIM(element_str(l)), itime, &
+            tmp_bm(:,:,ileaf,l), npts*nvm, horipft_index)
+       CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_SAP_AB'//TRIM(element_str(l)), itime, &
+            tmp_bm(:,:,isapabove,l), npts*nvm, horipft_index)
+       CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_SAP_BE'//TRIM(element_str(l)), itime, &
+            tmp_bm(:,:,isapbelow,l), npts*nvm, horipft_index)
+       CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_ROOT'//TRIM(element_str(l)), itime, &
+            tmp_bm(:,:,iroot,l), npts*nvm, horipft_index)
+       CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_FRUIT'//TRIM(element_str(l)), itime, &
+            tmp_bm(:,:,ifruit,l), npts*nvm, horipft_index)
+       CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_RES'//TRIM(element_str(l)), itime, &
+            tmp_bm(:,:,icarbres,l), npts*nvm, horipft_index)
+       CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_LABILE'//TRIM(element_str(l)), itime, &
+            tmp_bm(:,:,ilabile,l), npts*nvm, horipft_index)
+      
+        CALL xios_orchidee_send_field('BM_ALLOC_LEAF'//TRIM(element_str(l)), tmp_bm(:,:,ileaf,l))
+        CALL xios_orchidee_send_field('BM_ALLOC_SAP_AB'//TRIM(element_str(l)), tmp_bm(:,:,isapabove,l))
+        CALL xios_orchidee_send_field('BM_ALLOC_SAP_BE'//TRIM(element_str(l)), tmp_bm(:,:,isapbelow,l))
+        CALL xios_orchidee_send_field('BM_ALLOC_ROOT'//TRIM(element_str(l)), tmp_bm(:,:,iroot,l))
+        CALL xios_orchidee_send_field('BM_ALLOC_FRUIT'//TRIM(element_str(l)), tmp_bm(:,:,ifruit,l))
+        CALL xios_orchidee_send_field('BM_ALLOC_RES'//TRIM(element_str(l)), tmp_bm(:,:,icarbres,l))
+        CALL xios_orchidee_send_field('BM_ALLOC_LABILE'//TRIM(element_str(l)), tmp_bm(:,:,ilabile,l))       
+
+    ENDDO
+
+    CALL histwrite_p (hist_id_stomate, 'RUE_LONGTERM', itime, &
+         rue_longterm(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'KF', itime, &
+         KF(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LAB_FAC' , itime, &
+         lab_fac(:,:), npts*nvm, horipft_index)
+    
+    CALL xios_orchidee_send_field('RUE_LONGTERM', rue_longterm(:,:))
+    CALL xios_orchidee_send_field('KF', KF(:,:))
+    CALL xios_orchidee_send_field('LAB_FAC', lab_fac(:,:))
+    CALL xios_orchidee_send_field('RESERVE_POOL_TARGET', reserve_pool_write(:,:))
+    CALL xios_orchidee_send_field('LABILE_POOL_TARGET', labile_pool_write(:,:))
+
+
+    ring_width(:,:,:) = zero
+    sum_delta_ba(:,:,:) = zero
+    circ_height(:,:,:) = zero
+    
+    DO ipts = 1,npts
+       DO j = 1,nvm
+          IF(is_tree(j))THEN
+             ! Calculate the forestry basal area (thus NOT the effective ba)
+             circ_class_ba(:) = wood_to_ba(circ_class_biomass(ipts,j,:,:,icarbon),j)
+             ba(ipts,j) = SUM(circ_class_ba(:)*circ_class_n(ipts,j,:)) * m2_to_ha
+             wood_volume(ipts,j) = wood_to_volume(npts,circ_class_biomass(ipts,j,:,:,:),&
+                  circ_class_n(ipts,j,:),j,branch_ratio(j),0)
+             store_circ_class_ba(ipts,j,:) = circ_class_ba(:)
+
+             ! Calculate radius increment using store_delta_ba (which is alway
+             ! positive) 
+             sum_delta_ba(ipts,j,:) = store_delta_ba(ipts,j,:) + store_sum_delta_ba(ipts,j,:)
+             ring_width(ipts,j,:) = SQRT(sum_delta_ba(ipts,j,:)/pi) - SQRT(store_sum_delta_ba(ipts,j,:)/pi)
+             store_sum_delta_ba(ipts,j,:) = sum_delta_ba(ipts,j,:)
+
+             ! Calculate height per diameter class (above ground, not eff)
+             circ_height(ipts,j,:) = wood_to_height(circ_class_biomass(ipts,j,:,:,icarbon),j) 
+          ELSE
+             ba(ipts,j) = val_exp
+             wood_volume(ipts,j) = val_exp
+             store_circ_class_ba(ipts,j,:) = val_exp 
+          ENDIF
+       ENDDO
+    ENDDO
+
+    CALL histwrite_p (hist_id_stomate, 'BA', itime, &
+         ba(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'WOOD_VOL', itime, &
+         wood_volume(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'RESIDUAL', itime, &
+         residual_write(:,:), npts*nvm, horipft_index)
+
+    ! Some of these variables should only be used when the model
+    ! does not account for land cover changes and does not make
+    ! use of age classes. When using land cover changes and
+    ! age classes the biomass pool may get diluted which results
+    ! in shrinking trees. This doesn't make sense at the tree
+    ! level but is an acceptable approach at the landscape
+    ! level.  
+    DO icir = 1,ncirc
+       WRITE(var_name,'(A,I3.3)') 'CCBA_',icir
+       CALL histwrite_p (hist_id_stomate, var_name, itime, &
+            store_circ_class_ba(:,:,icir), npts*nvm, horipft_index)
+       WRITE(var_name,'(A,I3.3)') 'CCDELTABA_',icir
+       CALL histwrite_p (hist_id_stomate, VAR_NAME, itime, &
+            store_delta_ba(:,:,icir), npts*nvm, horipft_index)
+       WRITE(var_name,'(A,I3.3)') 'CCN_',icir
+       CALL histwrite_p (hist_id_stomate, VAR_NAME, itime, &
+            circ_class_n(:,:,icir), npts*nvm, horipft_index)
+       WRITE(var_name,'(A,I3.3)') 'CCTRW_',icir
+       CALL histwrite_p (hist_id_stomate, VAR_NAME, itime, &
+            ring_width(:,:,icir), npts*nvm, horipft_index)
+       WRITE(var_name,'(A,I3.3)') 'CCH_',icir
+       CALL histwrite_p (hist_id_stomate, VAR_NAME, itime, &
+            circ_height(:,:,icir), npts*nvm, horipft_index)
+    ENDDO
+
+    CALL xios_orchidee_send_field('WOOD_VOL',wood_volume(:,:))
+    CALL xios_orchidee_send_field('BA',ba(:,:))
+    CALL xios_orchidee_send_field('RESIDUAL',residual_write(:,:))
+    CALL xios_orchidee_send_field('CCBA', store_circ_class_ba(:,:,:))
+    CALL xios_orchidee_send_field('CCDELTABA', store_delta_ba(:,:,:)) 
+    CALL xios_orchidee_send_field('CCN', circ_class_n(:,:,:)) 
+    CALL xios_orchidee_send_field('CCTRW', ring_width(:,:,:))
+    CALL xios_orchidee_send_field('CCH', circ_height(:,:,:))
+
+    ! Debug
+    IF (printlev_loc.GE.4) THEN
+       WRITE(numout,*) 'leaf_biomass C:', tmp_bm(test_grid,test_pft,ileaf,icarbon)
+       WRITE(numout,*) 'leaf_biomass N:', tmp_bm(test_grid,test_pft,ileaf,initrogen)
+       WRITE(numout,*) 'reserve_biomass C:', tmp_bm(test_grid,test_pft,icarbres,icarbon)
+       WRITE(numout,*) 'reserve_biomass N:', tmp_bm(test_grid,test_pft,icarbres,initrogen)
+    ENDIF 
+    !-
+
+    IF (printlev.GE.3) WRITE(numout,*) 'Leaving functional allocation growth'
+
+    
+END SUBROUTINE growth_fun_all
+
+
+
+!! ================================================================================================================================
+!! FUNCTION	: func_derfunc
+!!
+!>\BRIEF        Calculate value for a function and its derivative
+!!
+!!
+!! DESCRIPTION  : the routine describes the function and its derivative. Both function and derivative are used
+!!              by the optimisation scheme. Hence, this function is part of the optimisation scheme and is only 
+!!              called by the optimisation 
+!!
+!! RECENT CHANGE(S): 
+!!
+!! MAIN OUTPUT VARIABLE(S): f, df
+!!
+!! REFERENCE(S)	: Numerical recipies in Fortran 77
+!! 
+!! FLOWCHART : 
+!! \n
+!_ ================================================================================================================================
+ 
+ SUBROUTINE func_derfunc(x, n, o, p, q, r, t, eq_num, f, df)
+
+!! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(in)                :: x           !! x value for which the function f(x) will be evaluated
+    REAL(r_std), INTENT(in)                :: n,o,p,q,r,t !! Coefficients of the equation. Not all equations use all coefficients
+    INTEGER(i_std), INTENT(in)             :: eq_num      !! Function i.e. f(x), g(x), ...
+
+    !! 0.2 Output variables
+    REAL(r_std), INTENT(out)               :: f           !! Value y for f(x)
+    REAL(r_std), INTENT(out)               :: df          !! Value y for derivative[f(x)]   
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+!_ ================================================================================================================================
+
+!! 1. Calculate f(x) and df(x)
+
+    IF (eq_num .EQ. 1) THEN
+
+       !f = n*x**4 + o*x**3 + p*x**2 + q*x + r  
+       !df = 4*n*x**3 + 3*o*x**2 + 2*p*x + q
+    
+    ELSEIF (eq_num .EQ. 2) THEN
+    
+       f = ( (n*x)/(p*((x+o)/t)**(q/(2+q))) ) - r
+       df = ( n*(o*(q+2)+2*x)*((o+x)/t)**(-q/(q+2)) ) / ( p*(q+2)*(o+x) )
+    
+    ENDIF
+
+ END SUBROUTINE func_derfunc
+
+
+!! ================================================================================================================================
+!! FUNCTION	: iterative_solver
+!!
+!>\BRIEF        find best fitting x for f(x)
+!!
+!!
+!! DESCRIPTION  : The function makes use of an iterative approach to optimise the value for X. The solver
+!!              splits the search region in two but there is an additional check to ensure that bounds are not
+!!              exceeded. 
+!!
+!!              Use the derivative (df) of the function (f) calculated in func_derfunc to narrow down the 
+!!              search range for X using the Newton-Raphson method for convergence as described in Numerical
+!!              Recipes in Fortran 77 (page 355-360).            
+!!
+!! RECENT CHANGE(S): 
+!!
+!! MAIN OUTPUT VARIABLE(S): x
+!!
+!! REFERENCE(S)	: Numerical recipies in Fortran 77
+!! 
+!! FLOWCHART : 
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION newX(n, o, p, q, r, t, x1, x2, eq_num, j, ipts)
+
+!! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(in)        :: n,o,p,q,r,t      !! Coefficients of the equation. Not all 
+                                                       !! equations use all coefficients
+    REAL(r_std), INTENT(in)        :: x1               !! Lower boundary off search range
+    REAL(r_std), INTENT(in)        :: x2               !! Upper boundary off search range
+    INTEGER(i_std), INTENT(in)     :: eq_num           !! Function for which an iterative solution is 
+                                                       !! searched
+    INTEGER(i_std), INTENT(in)     :: j                !! Number of PFT
+    INTEGER(i_std), INTENT(in)     :: ipts             !! Number of grdi square...for debugging
+    
+    !! 0.2 Output variables
+   
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std), PARAMETER      :: maxit = 20       !! Maximum number of iterations
+    INTEGER(i_std), PARAMETER      :: max_attempt = 5  !! Maximum number of iterations
+    INTEGER(i_std)                 :: i, attempt       !! Index
+    REAL(r_std)                    :: newX             !! New estimate for X
+    REAL(r_std)                    :: fl, fh, f        !! Value of the function for the lower bound (x1), 
+                                                       !! upper bound (x2) and the new value (newX)
+    REAL(r_std)                    :: xh, xl           !! Checked lower and upper bounds
+    REAL(r_std)                    :: df               !! Value of the derivative of the function for newX
+    REAL(r_std)                    :: dx, dxold        !! Slope of improvement
+    REAL(r_std)                    :: temp             !! Dummy variable for value swaps
+    REAL(r_std)                    :: low, high        !! temporary variables for x1 and x2 to avoid
+                                                       !! intent in/out conflicts with Cs
+    LOGICAL                        :: found_range      !! Flag indicating whether the range in which
+                                                       !! a solution exists was identified.
+    
+    
+!_ ================================================================================================================================   
+
+!! 1. Find solution for X
+ 
+    ! Not sure whether our initial range is large enough. We will
+    ! start with a narrow range so we are more likely to fine the
+    ! solution witin ::maxit iterations. If there is no solution
+    ! in the initial range we will expande the range and try again
+
+    ! Initilaze flags and counters
+    attempt = 2
+    found_range = .FALSE.
+    low = x1
+    high = x2
+    
+
+    ! Calculate y for the upper and lower bound
+    DO WHILE (.NOT. found_range .AND. attempt .LE. max_attempt)
+ 
+       CALL func_derfunc(low, n, o, p, q, r, t, eq_num, fl, df)
+       CALL func_derfunc(high, n, o, p, q, r, t, eq_num, fh, df)
+ 
+       IF ((fl .GT. 0.0 .AND. fh .GT. 0.0) .OR. &
+            (fl .LT. 0.0 .AND. fh .LT. 0.0)) THEN
+       
+          IF (attempt .EQ. max_attempt) THEN
+
+             ! If the sign of y does not changes between the upper 
+             ! and lower bound there no solution with the specified range
+             WRITE(numout,*) 'Iterative procedure - tried really hard but' 
+             WRITE(numout,*) 'no solution exists within the specified range'
+             WRITE(numout,*) 'PFT, grid square: ',j,ipts
+             CALL ipslerr_p (3,'growth_fun_all','newX',&
+                  'Iterative procedure - tried really hard but failed','')
+
+          ELSE
+ 
+             ! Update counter
+             attempt = attempt + 1
+             
+             ! Use previous upper boundary as the lower
+             ! boundary for the next range search. Increase
+             ! the upper boundary
+             temp = high
+             high = x1 * attempt
+             low = 0.5*low
+             
+             ! Enlarge the search range
+!!$             WRITE(numout,*) 'Iterative procedure - enlarge the search range'
+!!$             WRITE(numout,*) 'New range: ', x1, x2
+!!$             WRITE(numout,*) 'PFT, grid square, range: ',j,ipts,attempt
+
+          ENDIF
+       
+       ELSE
+
+          found_range = .TRUE.
+          
+       ENDIF
+      
+    ENDDO
+
+    ! Only when we found a range we will search for the solution 
+    IF (found_range) THEN
+       
+       ! If the sign of y changes between the upper and lower bound there is a solution
+       IF ( ABS(fl) .LT. min_stomate ) THEN          
+
+          ! The lower bound is the solution - most likely the lower bound is too high
+          newX = x1
+          RETURN
+
+       ELSEIF ( ABS(fh) .LT. min_stomate ) THEN
+
+          ! The upper bound is the solution - most likely the upper bound is too low
+          newX = x2
+          RETURN
+
+       ELSEIF (fl .LT. 0.0) THEN
+          
+          ! Accept the lower and upper bounds as specified
+          xl = x1
+          xh = x2
+       ELSE
+
+          ! Lower and upper bounds were swapped, correct their ranking 
+          xh = x1
+          xl = x2
+       ENDIF
+
+       ! Estimate the initial newX value 	
+       newX = 0.5 * (x1+x2)
+       dxold = ABS(x2-x1)
+       dx = dxold
+
+    ENDIF
+   
+    ! Calculate y=f(x) and df(x) for initial guess of newX
+    CALL func_derfunc(newX, n, o, p, q, r, t, eq_num, f, df)
+    
+    ! Evaluate for the maximum number of iterations  
+    DO  i = 1,maxit
+
+       IF ( ((newX-xh)*df-f)*((newX-xl)*df-f) .GT. 0.0 .OR. ABS(deux*f) > ABS(dxold*df) ) THEN
+             
+          ! Bisection
+          dxold = dx
+          dx = 0.5 * (xh-xl)
+          newX = xl+dx
+          IF (xl .EQ. newX) RETURN
+
+       ELSE
+             
+          ! Newton
+          dxold = dx
+          dx = f/df
+          temp = newX
+          newX = newX-dx
+          IF (temp .EQ. newX) RETURN
+
+       ENDIF
+
+       ! Precision reached
+       IF ( ABS(dx) .LT. min_stomate) RETURN
+          
+       ! Precision was not reached calculate f(x) and df(x) for newX
+       CALL func_derfunc(newX, n, o, p, q, r, t, eq_num, f, df)
+          
+       ! Narrow down the range
+       IF (f .LT. 0.0) then
+          xl = newX
+       ELSE
+          xh = newX
+       ENDIF
+
+    ENDDO ! maximum number of iterations
+       
+    ! Debug
+    IF (j.EQ. test_pft) THEN 
+       WRITE(numout,*) 'Iterative procedure: exceeded maximum iterations'
+    ENDIF
+    !----------
+
+  END FUNCTION newX
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	: comments
+!!
+!>\BRIEF        Contains all comments to check the code
+!!
+!!
+!! DESCRIPTION  : contains all comments to check the code. By setting pft_test to 0, this routine is not called 
+!!
+!! RECENT CHANGE(S): 
+!!
+!! MAIN OUTPUT VARIABLE(S): none
+!!
+!! REFERENCE(S)	: none
+!! 
+!! FLOWCHART : 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE comment(npts, Cl_target, Cl, Cs_target, & 
+       Cs, Cr_target, Cr, delta_ba, &
+       ipts, j, l, b_inc_tot, & 
+       Cl_incp, Cs_incp, Cr_incp, KF, LF, &
+       Cl_inc, Cs_inc, Cr_inc, Cf_inc, &
+       grow_wood, circ_class_n, n_comment)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: npts		                    !! Defined in stomate_growth_fun_all
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: Cl_target, Cs_target, Cr_target   !! Defined in stomate_growth_fun_all
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: Cl_incp, Cs_incp, Cr_incp         !! Defined in stomate_growth_fun_all
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: Cl_inc, Cs_inc, Cr_inc, Cf_inc    !! Defined in stomate_growth_fun_all
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)          :: circ_class_n                      !! Defined in stomate_growth_fun_all
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: Cl, Cs, Cr                        !! Defined in stomate_growth_fun_all
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: delta_ba                          !! Defined in stomate_growth_fun_all
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: KF, LF                            !! Defined in stomate_growth_fun_all
+    REAL(r_std), INTENT(in)                            :: b_inc_tot                         !! Defined in stomate_growth_fun_all
+    INTEGER(i_std), INTENT(in)                         :: ipts, j, l                        !! Defined in stomate_growth_fun_all
+    LOGICAL, INTENT(in)                                :: grow_wood                         !! Defined in stomate_growth_fun_all
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                     :: n_comment                         !! Comment number  
+    !_ ================================================================================================================================
+
+    SELECT CASE (n_comment)
+    CASE (1)
+       ! Enough leaves and wood, grow roots
+       WRITE(numout,*) 'Exc 1: Cl_incp(=0), Cs_incp (=0), Cr_incp (<>0), unallocated, class, '
+       WRITE(numout,*) Cl_incp(l), Cs_incp(l), Cr_incp(l), &
+            b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ), l
+       IF (b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 1.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)))
+       ELSE
+          IF ( (b_inc_tot - ( circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) .GE. zero) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cr_target(l)-Cr(l)-Cr_incp(l))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 1.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - ( circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) &
+               .LE. min_stomate) .AND. &
+               (circ_class_n(ipts,j,l) * ABS(Cr_target(l)-Cr(l)-Cr_incp(l)) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 1.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 24: Exc 1.4 unexpected result'
+             WRITE(numout,*) 'WARNING 24: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE (2)
+       ! Enough wood and roots, grow leaves 
+       WRITE(numout,*) 'Exc 2: Cl_incp(<>0), Cs_incp (=0), Cr_incp (=0), unallocated, class, '
+       WRITE(numout,*) Cl_incp(l), Cs_incp(l), Cr_incp(l), &
+            b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ), l
+       IF (b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 2.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)))
+       ELSE
+          IF ( (b_inc_tot - ( circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) .GE. zero) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cl_target(l)-Cl(l)-Cl_incp(l))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 2.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - ( circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) &
+               .LE. min_stomate) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cl_target(l)-Cl(l)-Cl_incp(l))) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 2.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 25: Exc 2.4 unexpected result'
+             WRITE(numout,*) 'WARNING 25: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+
+    CASE (3)
+
+       ! Enough wood, grow leaves and roots
+       WRITE(numout,*) 'Exc 3: Cl_incp(<>0), Cs_incp(=0), Cr_incp(<>0), unallocated, class, '
+       WRITE(numout,*) Cl_incp(l), Cs_incp(l), Cr_incp(l), b_inc_tot - & 
+            (circ_class_n(ipts,j,l) * (Cl_incp(l)+Cs_incp(l)+Cr_incp(l))), l
+       IF (b_inc_tot - circ_class_n(ipts,j,l) * (Cl_incp(l) + Cs_incp(l) + Cr_incp(l))  &
+            .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 3.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (circ_class_n(ipts,j,l) * (Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) )
+       ELSE
+          IF ( (b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l))) &
+               .GE. min_stomate) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cl_target(l)-Cl(l)-Cl_incp(l)) ) .LE. min_stomate) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cr_target(l)-Cr(l)-Cr_incp(l)) ) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 3.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) &
+               .LE. min_stomate) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cl_target(l)-Cl(l)-Cl_incp(l)) ) .GT. min_stomate) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cr_target(l)-Cr(l)-Cr_incp(l)) ) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 3.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 26: Exc 3.4 unexpected result'
+             WRITE(numout,*) 'WARNING 26: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(4)
+       ! Enough leaves and wood, grow roots
+       WRITE(numout,*) 'Exc 4: Cl_incp(=0), Cs_incp (=0), Cr_incp (<>0), unallocated, class, '
+       WRITE(numout,*) Cl_incp(l), Cs_incp(l), Cr_incp(l), &
+            b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ), l
+       IF (b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 4.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)))
+       ELSE
+          IF ( (b_inc_tot - ( circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) .GE. zero) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cr_target(l)-Cr(l)-Cr_incp(l))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 4.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - ( circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) &
+               .LE. min_stomate) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cr_target(l)-Cr(l)-Cr_incp(l))) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 4.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 27: Exc 4.4 unexpected result'
+             WRITE(numout,*) 'WARNING 27: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(5)
+       ! Enough leaves and roots, grow wood
+       WRITE(numout,*) 'Exc 5: Cl_incp(=0), Cs_incp (<>0), Cr_incp (=0), unallocated, class, '
+       WRITE(numout,*) Cl_incp(l), Cs_incp(l), Cr_incp(l), &
+            b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ), l
+       IF (b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 5.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)))
+       ELSE
+          IF ( (b_inc_tot - ( circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) .GE. zero) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cs_target(l)-Cs(l)-Cs_incp(l))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 5.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - ( circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) &
+               .LE. min_stomate) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cs_target(l)-Cs(l)-Cs_incp(l))) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 5.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 28: Exc 5.4 unexpected result'
+             WRITE(numout,*) 'WARNING 28: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(6)
+       ! Enough leaves, grow wood and roots
+       WRITE(numout,*) 'Exc 6: Cl_incp(=0), Cs_incp(<>0), Cr_incp(<>0), unallocated'
+       WRITE(numout,*) Cl_incp(l), Cs_incp(l), Cr_incp(l), &
+            b_inc_tot - (circ_class_n(ipts,j,l) * (Cl_incp(l)+Cs_incp(l)+Cr_incp(l)))
+       IF (b_inc_tot - (circ_class_n(ipts,j,l) * (Cl_incp(l)+Cs_incp(l)+Cr_incp(l))) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 6.1: unallocated less then 0: overspending, ', &
+               b_inc_tot - (circ_class_n(ipts,j,l) * (Cl_incp(l)+Cs_incp(l)+Cr_incp(l)))
+       ELSE
+          IF ( (b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l))) .GE. zero) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cs_target(l)-Cs(l)-Cs_incp(l))) .LE. min_stomate) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cr_target(l)-Cr(l)-Cr_incp(l))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 6.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l))) .LE. min_stomate) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cs_target(l)-Cs(l)-Cs_incp(l))) .GT. min_stomate) .OR. &
+               ((circ_class_n(ipts,j,l) * ABS(Cr_target(l)-Cr(l)-Cr_incp(l))) .GT. min_stomate) ) THEN
+             WRITE(numout,*) &
+                  'Exc 6.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 29: Exc 6.4 unexpected result'
+             WRITE(numout,*) 'WARNING 29: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(7)
+       ! Enough leaves and wood, grow roots
+       WRITE(numout,*) 'Exc 7: Cl_incp(=0), Cs_incp (=0), Cr_incp (<>0), unallocated, class, '
+       WRITE(numout,*) Cl_incp(l), Cs_incp(l), Cr_incp(l), &
+            b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ), l
+       IF (b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 7.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)))
+       ELSE
+          IF ( (b_inc_tot - ( circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) .GE. zero) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cl_target(l)-Cl(l)-Cl_incp(l))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 7.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - ( circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) &
+               .LE. min_stomate) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cl_target(l)-Cl(l)-Cl_incp(l))) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 7.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 30: Exc 7.4 unexpected result'
+             WRITE(numout,*) 'WARNING 30: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(8)
+       ! Enough leaves and roots, grow wood
+       WRITE(numout,*) 'Exc 8: Cl_incp(=0), Cs_incp (<>0), Cr_incp (=0), unallocated, class, '
+       WRITE(numout,*) Cl_incp(l), Cs_incp(l), Cr_incp(l), &
+            b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ), l
+       IF (b_inc_tot - (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 8.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)))
+       ELSE
+          IF ( (b_inc_tot - ( circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) .GE. zero) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cs_target(l)-Cs(l)-Cs_incp(l))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 8.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - ( circ_class_n(ipts,j,l)*(Cl_incp(l)+Cs_incp(l)+Cr_incp(l)) ) &
+               .LE. min_stomate) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cs_target(l)-Cs(l)-Cs_incp(l))) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 8.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 31: Exc 8.4 unexpected result'
+             WRITE(numout,*) 'WARNING 31: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(9)
+       ! Enough roots, grow leaves and wood
+       WRITE(numout,*) 'Exc 9: delta_ba, Cl_incp(<>0), Cs_incp(<>0), Cr_incp(=0), unallocated, class, '
+       WRITE(numout,*) delta_ba(:), Cl_incp(l), Cs_incp(l), Cr_incp(l), &
+            b_inc_tot - (circ_class_n(ipts,j,l) * (Cl_incp(l)+Cs_incp(l)+Cr_incp(l))), l
+       IF (b_inc_tot - (circ_class_n(ipts,j,l) * (Cl_incp(l)+Cs_incp(l)+Cr_incp(l))) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 9.1: unallocated less then 0: overspending, ', &
+               b_inc_tot - (circ_class_n(ipts,j,l) * (Cl_incp(l)+Cs_incp(l)+Cr_incp(l)))
+       ELSE
+          IF ( (b_inc_tot - (circ_class_n(ipts,j,l) * (Cl_incp(l)+Cs_incp(l)+Cr_incp(l))) .GE. zero) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cl_target(l)-Cl(l)-Cl_incp(l))) .LE. min_stomate) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cs_target(l)-Cs(l)-Cs_incp(l))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 9.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - (circ_class_n(ipts,j,l) * (Cl_incp(l)+Cs_incp(l)+Cr_incp(l))) &
+               .LE. min_stomate) .AND. &
+               ((circ_class_n(ipts,j,l) * ABS(Cl_target(l)-Cl(l)-Cl_incp(l))) .GT. min_stomate) .OR. &
+               ((circ_class_n(ipts,j,l) * ABS(Cs_target(l)-Cs(l)-Cs_incp(l))) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 9.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 32: Exc 9.4 unexpected result'
+             WRITE(numout,*) 'WARNING 32: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(10)
+       ! Ready for ordinary allocation
+       WRITE(numout,*) 'Ready for ordinary allocation?'
+       WRITE(numout,*) 'KF, LF, ', KF(ipts,j), LF(ipts,j)
+       WRITE(numout,*) 'b_inc_tot, ', b_inc_tot
+       WRITE(numout,*) 'Cl, Cs, Cr', Cl(:), Cs(:), Cr(:)
+       WRITE(numout,*) 'Cl_target-Cl, ', Cl_target(:)-Cl(:)
+       WRITE(numout,*) 'Cs_target-Cs, ', Cs_target(:)-Cs(:)
+       WRITE(numout,*) 'Cr_target-Cr, ', Cr_target(:)-Cr(:)
+       IF (b_inc_tot .GT. min_stomate) THEN
+          IF (SUM(ABS(Cl_target(:)-Cl(:))) .LE. min_stomate) THEN
+             IF (SUM(ABS(Cs_target(:)-Cs(:))) .LE. min_stomate) THEN
+                IF (SUM(ABS(Cr_target(:)-Cr(:))) .LE. min_stomate) THEN
+                   IF (grow_wood) THEN
+                      WRITE(numout,*) 'should result in exc 10.1 or 10.2'
+                   ELSE
+                      WRITE(numout,*) 'No wood growth.  Not a problem!  Just an observation.'
+                   ENDIF
+                ELSE
+                   WRITE(numout,*) 'WARNING 34: problem with Cr_target'
+                   WRITE(numout,*) 'WARNING 34: PFT, ipts: ',j,ipts
+                ENDIF
+             ELSE
+                WRITE(numout,*) 'WARNING 35: problem with Cs_target'
+                WRITE(numout,*) 'WARNING 35: PFT, ipts: ',j,ipts
+             ENDIF
+          ELSE
+             WRITE(numout,*) 'WARNING 36: problem with Cl_target'
+             WRITE(numout,*) 'WARNING 36: PFT, ipts: ',j,ipts
+          ENDIF
+       ELSEIF(b_inc_tot .LT. -min_stomate) THEN 
+          WRITE(numout,*) 'WARNING 37: problem with b_inc_tot'
+          WRITE(numout,*) 'WARNING 37: PFT, ipts: ',j,ipts
+       ELSE
+          WRITE(numout,*) 'no unallocated fraction'
+       ENDIF
+
+    CASE(11)
+       ! Ordinary allocation
+       WRITE(numout,*) 'delta_ba, ', delta_ba
+       IF ( (SUM(Cl_inc(:)) .GE. zero) .AND. (SUM(Cs_inc(:)) .GE. zero) .AND. &
+            (SUM(Cr_inc(:)) .GE. zero) .AND. &
+            ( b_inc_tot - SUM(circ_class_n(ipts,j,:) * (Cl_inc(:)+Cs_inc(:)+Cr_inc(:))) .GT. -1*min_stomate) .AND. &
+            ( b_inc_tot - SUM(circ_class_n(ipts,j,:) * (Cl_inc(:)+Cs_inc(:)+Cr_inc(:))) .LT. min_stomate ) ) THEN
+          WRITE(numout,*) 'Exc 10.1: Ordinary allocation was succesful'
+          WRITE(numout,*) 'Cl_inc, Cs_inc, Cr_inc, unallocated', Cl_inc(:), Cs_inc(:), Cr_inc(:), & 
+               b_inc_tot - SUM(circ_class_n(ipts,j,:) * (Cl_inc(:)+Cs_inc(:)+Cr_inc(:)))
+       ELSE
+          WRITE(numout,*) 'WARNING 38: Exc 10.2 problem with ordinary allocation'
+          WRITE(numout,*) 'WARNING 38: PFT, ipts: ',j,ipts
+          WRITE(numout,*) 'Cl_inc, Cs_inc, Cr_inc, unallocated', Cl_inc(:), Cs_inc(:), Cr_inc(:), & 
+               b_inc_tot - SUM(circ_class_n(ipts,j,:) * (Cl_inc(:)+Cs_inc(:)+Cr_inc(:)))
+       ENDIF
+
+    CASE(12)
+       ! Enough leaves and structure, grow roots
+       WRITE(numout,*) 'Exc 1: Cl_incp(=0), Cs_incp (=0), Cr_incp (<>0), unallocated, '
+       WRITE(numout,*) Cl_incp(1), Cs_incp(1), Cr_incp(1), &
+            b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) )
+       IF (b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 1.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)))
+       ELSE
+          IF ( (b_inc_tot - ( SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) .GE. zero) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cr_target(1)-Cr(1)-Cr_incp(1))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 1.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - ( SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) &
+               .LE. min_stomate) .AND. &
+               (SUM(circ_class_n(ipts,j,:)) * ABS(Cr_target(1)-Cr(1)-Cr_incp(1)) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 1.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 39: Exc 1.4 unexpected result'
+             WRITE(numout,*) 'WARNING 39: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(13)
+       ! Enough structural C and roots, grow leaves
+       WRITE(numout,*) 'Exc 2: Cl_incp(<>0), Cs_incp (=0), Cr_incp (=0), unallocated, '
+       WRITE(numout,*) Cl_incp(1), Cs_incp(1), Cr_incp(1), &
+            b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) )
+       IF (b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 2.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)))
+       ELSE
+          IF ( (b_inc_tot - ( SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) .GE. zero) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cl_target(1)-Cl(1)-Cl_incp(1))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 2.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - ( SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) &
+               .LE. min_stomate) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cl_target(1)-Cl(1)-Cl_incp(1))) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 2.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 40: Exc l.4 unexpected result'
+             WRITE(numout,*) 'WARNING 40: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(14)
+       ! Enough structural C and root, grow leaves
+       WRITE(numout,*) 'Exc 3: Cl_incp(<>0), Cs_incp(=0), Cr_incp(<>0), unallocated, '
+       WRITE(numout,*) Cl_incp(1), Cs_incp(1), Cr_incp(1), b_inc_tot - & 
+            (SUM(circ_class_n(ipts,j,:)) * (Cl_incp(1)+Cs_incp(1)+Cr_incp(1)))
+       IF (b_inc_tot - SUM(circ_class_n(ipts,j,:)) * (Cl_incp(1) + Cs_incp(1) + Cr_incp(1))  &
+            .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 3.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (SUM(circ_class_n(ipts,j,:)) * (Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) )
+       ELSE
+          IF ( (b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1))) &
+               .GE. min_stomate) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cl_target(1)-Cl(1)-Cl_incp(1)) ) .LE. min_stomate) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cr_target(1)-Cr(1)-Cr_incp(1)) ) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 3.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) &
+               .LE. min_stomate) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cl_target(1)-Cl(1)-Cl_incp(1)) ) .GT. min_stomate) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cr_target(1)-Cr(1)-Cr_incp(1)) ) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 3.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 41: Exc 3.4 unexpected result'
+             WRITE(numout,*) 'WARNING 41: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(15)
+       ! Enough leaves and structural C, grow roots
+       WRITE(numout,*) 'Exc 4: Cl_incp(=0), Cs_incp (=0), Cr_incp (<>0), unallocated, '
+       WRITE(numout,*) Cl_incp(1), Cs_incp(1), Cr_incp(1), &
+            b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) )
+       IF (b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 4.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)))
+       ELSE
+          IF ( (b_inc_tot - ( SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) .GE. zero) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cr_target(1)-Cr(1)-Cr_incp(1))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 4.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - ( SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) &
+               .LE. min_stomate) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cr_target(1)-Cr(1)-Cr_incp(1))) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 4.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 42: Exc 4.4 unexpected result'
+             WRITE(numout,*) 'WARNING 42: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(16)
+       ! Enough leaves and roots, grow structural C            
+       WRITE(numout,*) 'Exc 5: Cl_incp(=0), Cs_incp (<>0), Cr_incp (=0), unallocated, '
+       WRITE(numout,*) Cl_incp(1), Cs_incp(1), Cr_incp(1), &
+            b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) )
+       IF (b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 5.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)))
+       ELSE
+          IF ( (b_inc_tot - ( SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) .GE. zero) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cs_target(1)-Cs(1)-Cs_incp(1))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 5.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - ( SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) &
+               .LE. min_stomate) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cs_target(1)-Cs(1)-Cs_incp(1))) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 5.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 43: Exc 5.4 unexpected result'
+             WRITE(numout,*) 'WARNING 43: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(17)
+       ! Enough leaves, grow structural C and roots
+       WRITE(numout,*) 'Exc 6: Cl_incp(=0), Cs_incp(<>0), Cr_incp(<>0), unallocated'
+       WRITE(numout,*) Cl_incp(1), Cs_incp(1), Cr_incp(1), &
+            b_inc_tot - (SUM(circ_class_n(ipts,j,:)) * (Cl_incp(1)+Cs_incp(1)+Cr_incp(1)))
+       IF (b_inc_tot - (SUM(circ_class_n(ipts,j,:)) * (Cl_incp(1)+Cs_incp(1)+Cr_incp(1))) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 6.1: unallocated less then 0: overspending, ', &
+               b_inc_tot - (SUM(circ_class_n(ipts,j,:)) * (Cl_incp(1)+Cs_incp(1)+Cr_incp(1)))
+       ELSE
+          IF ( (b_inc_tot - SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) .GE. zero) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cs_target(1)-Cs(1)-Cs_incp(1))) .LE. min_stomate) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cr_target(1)-Cr(1)-Cr_incp(1))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 6.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) .LE. min_stomate) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cs_target(1)-Cs(1)-Cs_incp(1))) .GT. min_stomate) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cr_target(1)-Cr(1)-Cr_incp(1))) .GT. min_stomate) ) THEN
+             WRITE(numout,*) &
+                  'Exc 6.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 44: Exc 6.4 unexpected result'
+             WRITE(numout,*) 'WARNING 44: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(18)
+       ! Enough leaves and structural C, grow roots
+       WRITE(numout,*) 'Exc 7: Cl_incp(=0), Cs_incp (=0), Cr_incp (<>0), unallocated, '
+       WRITE(numout,*) Cl_incp(1), Cs_incp(1), Cr_incp(1), &
+            b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) )
+       IF (b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 7.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)))
+       ELSE
+          IF ( (b_inc_tot - ( SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) .GE. zero) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cl_target(1)-Cl(1)-Cl_incp(1))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 7.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - ( SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) &
+               .LE. min_stomate) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cl_target(1)-Cl(1)-Cl_incp(1))) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 7.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 45: Exc 7.4 unexpected result'
+             WRITE(numout,*) 'WARNING 45: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(19)
+       ! Enough leaves and roots, grow structural C
+       WRITE(numout,*) 'Exc 8: Cl_incp(=0), Cs_incp (<>0), Cr_incp (=0), unallocated, '
+       WRITE(numout,*) Cl_incp(1), Cs_incp(1), Cr_incp(1), &
+            b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) )
+       IF (b_inc_tot - (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 8.1: unallocated less then 0: overspending, ', b_inc_tot - &
+               (SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)))
+       ELSE
+          IF ( (b_inc_tot - ( SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) .GE. zero) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cs_target(1)-Cs(1)-Cs_incp(1))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 8.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - ( SUM(circ_class_n(ipts,j,:))*(Cl_incp(1)+Cs_incp(1)+Cr_incp(1)) ) &
+               .LE. min_stomate) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cs_target(1)-Cs(1)-Cs_incp(1))) .GT. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 8.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 46: Exc 8.4 unexpected result'
+             WRITE(numout,*) 'WARNING 46: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(20)
+       ! Enough roots, grow structural C and leaves
+       WRITE(numout,*) 'Exc 9: Cl_incp(<>0), Cs_incp(<>0), Cr_incp(=0), unallocated, '
+       WRITE(numout,*) Cl_incp(1), Cs_incp(1), Cr_incp(1), &
+            b_inc_tot - (SUM(circ_class_n(ipts,j,:)) * (Cl_incp(1)+Cs_incp(1)+Cr_incp(1)))
+       WRITE(numout,*) 'term 1', b_inc_tot - (SUM(circ_class_n(ipts,j,:)) * (Cl_incp(1)+Cs_incp(1)+Cr_incp(1)))
+       WRITE(numout,*) 'term 2', (SUM(circ_class_n(ipts,j,:)) * ABS(Cl_target(1)-Cl(1)-Cl_incp(1)))
+       WRITE(numout,*) 'term 3', (SUM(circ_class_n(ipts,j,:)) * ABS(Cs_target(1)-Cs(1)-Cs_incp(1)))
+       IF (b_inc_tot - (SUM(circ_class_n(ipts,j,:)) * (Cl_incp(1)+Cs_incp(1)+Cr_incp(1))) .LT. -min_stomate) THEN
+          WRITE(numout,*) 'Exc 9.1: unallocated less then 0: overspending, ', &
+               b_inc_tot - (SUM(circ_class_n(ipts,j,:)) * (Cl_incp(1)+Cs_incp(1)+Cr_incp(1)))
+       ELSE
+          IF ( (b_inc_tot - (SUM(circ_class_n(ipts,j,:)) * (Cl_incp(1)+Cs_incp(1)+Cr_incp(1))) .GE. zero) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cl_target(1)-Cl(1)-Cl_incp(1))) .LE. min_stomate) .AND. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cs_target(1)-Cs(1)-Cs_incp(1))) .LE. min_stomate) ) THEN
+             WRITE(numout,*) 'Exc 9.2: unallocated <>= 0 but tree is in good shape: successful allocation'
+          ELSEIF ( (b_inc_tot - (SUM(circ_class_n(ipts,j,:)) * (Cl_incp(1)+Cs_incp(1)+Cr_incp(1))) .LE. min_stomate) .AND. &
+               (((SUM(circ_class_n(ipts,j,:)) * ABS(Cl_target(1)-Cl(1)-Cl_incp(1))) .GT. min_stomate) .OR. &
+               ((SUM(circ_class_n(ipts,j,:)) * ABS(Cs_target(1)-Cs(1)-Cs_incp(1))) .GT. min_stomate) ) ) THEN
+             WRITE(numout,*) 'Exc 9.3: unallocated = 0, but the tree needs more reshaping: successful allocation'
+          ELSE
+             WRITE(numout,*) 'WARNING 47: Exc 9.4 unexpected result'
+             WRITE(numout,*) 'WARNING 47: PFT, ipts: ',j,ipts
+          ENDIF
+       ENDIF
+
+    CASE(21)
+       ! Ready for ordinary allocation
+       WRITE(numout,*) 'Ready for ordinary allocation?'
+       WRITE(numout,*) 'KF, LF, ', KF(ipts,j), LF(ipts,j)
+       WRITE(numout,*) 'b_inc_tot, ', b_inc_tot
+       WRITE(numout,*) 'Cl, Cs, Cr', Cl(1), Cs(1), Cr(1)
+       WRITE(numout,*) 'Cl_target-Cl, ', Cl_target(1)-Cl(1)
+       WRITE(numout,*) 'Cs_target-Cs, ', Cs_target(1)-Cs(1)
+       WRITE(numout,*) 'Cr_target-Cr, ', Cr_target(1)-Cr(1)
+       IF (b_inc_tot .GT. min_stomate) THEN
+          IF (ABS(Cl_target(1)-Cl(1)) .LE. min_stomate) THEN
+             IF (ABS(Cs_target(1)-Cs(1)) .LE. min_stomate) THEN
+                IF (ABS(Cr_target(1)-Cr(1)) .LE. min_stomate) THEN
+                   IF (b_inc_tot .GT. min_stomate) THEN
+                      IF (grow_wood) THEN
+                         WRITE(numout,*) 'should result in exc 10.1 or 10.2'
+                      ELSE
+                         WRITE(numout,*) 'WARNING 48: no wood growth'
+                         WRITE(numout,*) 'WARNING 48: PFT, ipts: ',j,ipts
+                      ENDIF
+                   ENDIF
+                ELSE
+                   WRITE(numout,*) 'WARNING 49: problem with Cr_target'
+                   WRITE(numout,*) 'WARNING 49: PFT, ipts: ',j,ipts
+                ENDIF
+             ELSE
+                WRITE(numout,*) 'WARNING 50: problem with Cs_target'
+                WRITE(numout,*) 'WARNING 50: PFT, ipts: ',j,ipts
+             ENDIF
+          ELSE
+             WRITE(numout,*) 'WARNING 51: problem with Cl_target'
+             WRITE(numout,*) 'WARNING 51: PFT, ipts: ',j,ipts
+          ENDIF
+       ELSEIF(b_inc_tot .LT. -min_stomate) THEN 
+          WRITE(numout,*) 'WARNING 52: problem with b_inc_tot'
+          WRITE(numout,*) 'WARNING 52: PFT, ipts: ',j,ipts
+       ELSE
+          WRITE(numout,*) 'no unallocated fraction'
+       ENDIF
+
+    CASE(22)
+       ! Ordinary allocation
+       IF ( ((Cl_inc(1)) .GE. zero) .AND. ((Cs_inc(1)) .GE. zero) .AND. &
+            ((Cr_inc(1)) .GE. zero) .AND. &
+            ( b_inc_tot - (SUM(circ_class_n(ipts,j,:)) * (Cl_inc(1)+Cs_inc(1)+Cr_inc(1))) .GT. -1*min_stomate) .AND. &
+            ( b_inc_tot - (SUM(circ_class_n(ipts,j,:)) * (Cl_inc(1)+Cs_inc(1)+Cr_inc(1))) .LT. min_stomate ) ) THEN
+          WRITE(numout,*) 'Exc 10.1: Ordinary allocation was succesful'
+          WRITE(numout,*) 'Cl_inc, Cs_inc, Cr_inc, unallocated', Cl_inc(1), Cs_inc(1), Cr_inc(1), & 
+               b_inc_tot - (SUM(circ_class_n(ipts,j,:)) * (Cl_inc(1)+Cs_inc(1)+Cr_inc(1)))
+       ELSE
+          WRITE(numout,*) 'WARNING 53: Exc 10.2 problem with ordinary allocation'
+          WRITE(numout,*) 'WARNING 53: PFT, ipts: ',j,ipts
+          WRITE(numout,*) 'Cl_inc, Cs_inc, Cr_inc, unallocated', Cl_inc(1), Cs_inc(1), Cr_inc(1), & 
+               b_inc_tot - (SUM(circ_class_n(ipts,j,:)) * (Cl_inc(1)+Cs_inc(1)+Cr_inc(1)))
+       ENDIF
+
+    END SELECT
+
+  END SUBROUTINE comment
+
+END MODULE stomate_growth_fun_all
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_io.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_io.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_io.f90	(revision 6412)
@@ -0,0 +1,2606 @@
+! =================================================================================================================================
+! MODULE            : stomate_io
+!
+! CONTACT           : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE           : IPSL (2006)
+!                     This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF              Module for read and write of restart files for all stomate modules.
+!!
+!!\n DESCRIPTION    : This module contains the subroutines readstart and writerestart. All variables that will be read or written
+!!                    are passed as argument to the subroutines. The subroutine readstart is called from stomate_initialize and 
+!!                    writerestart is called from stomate_finalize.
+!!                    Note: 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.
+!!
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S)	    : None
+!!
+!! SVN              :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_io
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE mod_orchidee_para
+  USE ioipsl_para
+  USE structures
+  !-
+  IMPLICIT NONE
+  !-
+  PRIVATE
+  PUBLIC readstart, writerestart
+  !-
+  ! reference temperature (K)
+  !-
+  REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE :: trefe
+!$OMP THREADPRIVATE(trefe)
+  !-
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : readstart
+!!
+!>\BRIEF          Read all variables for stomate from restart file. 
+!!
+!! DESCRIPTION  : Read all variables for stomate from restart file. 
+!!                Initialize the variables if they were not found in the restart file or if there was no restart file.
+!!                
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE readstart &
+       & (npts, index, lalo, resolution, t2m, &
+       &  dt_days, date, &
+       &  adapted, regenerate, &
+       &  moiavail_daily, gdd_init_date, litterhum_daily, &
+       &  t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+       &  soilhum_daily, precip_daily, &
+       &  gpp_daily, npp_daily, turnover_daily, &
+       &  moiavail_month, moiavail_week, moiavail_growingseason, &
+       &  t2m_longterm, tau_longterm, t2m_month, t2m_week, &
+       &  tsoil_month, soilhum_month, fireindex, firelitter, &
+       &  maxmoiavail_lastyear, maxmoiavail_thisyear, &
+       &  minmoiavail_lastyear, minmoiavail_thisyear, &
+       &  maxgppweek_lastyear, maxgppweek_thisyear, &
+       &  gdd0_lastyear, gdd0_thisyear, &
+       &  precip_lastyear, precip_thisyear, &
+       &  gdd_m5_dormance,  gdd_from_growthinit, gdd_midwinter, &
+       &  ncd_dormance, ngd_minus5, &
+       &  PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+       &  maxfpc_lastyear, maxfpc_thisyear, &
+       &  turnover_longterm, gpp_week, resp_maint_part, &
+       &  leaf_age, leaf_frac, plant_status, when_growthinit, age, &
+       &  resp_hetero, resp_maint, resp_growth, co2_fire, atm_to_bm, &
+       &  veget_lastlight, everywhere, need_adjacent, RIP_time, &
+       &  time_hum_min, hum_min_dormance, &
+       &  litter, dead_leaves, &
+       &  som, lignin_struc, lignin_wood, turnover_time, &
+       &  prod_s, prod_m, prod_l, flux_s, flux_m, flux_l, &
+       &  flux_prod_s, flux_prod_m, flux_prod_l, &
+       &  bm_to_litter, carb_mass_total, &
+       &  Tseason, Tseason_length, Tseason_tmp, & 
+       &  Tmin_spring_time, onset_date, &
+       &  global_years, ok_equilibrium, nbp_accu, nbp_flux, &
+       &  nbp_accu_pool, nbp_pool, nbp_pool_start, &
+       &  MatrixV, VectorU, previous_stock, current_stock, &
+       &  assim_param, CN_som_litter_longterm, &
+       &  tau_CN_longterm, KF, k_latosa_adapt, &
+       &  rue_longterm, cn_leaf_min_season, nstress_season, &
+       &  soil_n_min, p_O2, bact, &
+       &  circ_class_biomass, circ_class_n, store_sum_delta_ba, & 
+       &  forest_managed, &
+       &  forest_managed_lastyear, &
+       &  species_change_map, fm_change_map, lpft_replant, lai_per_level, &
+       &  laieff_fit, wstress_season, wstress_month, &
+       &  age_stand, rotation_n, last_cut, mai, pai, &
+       &  previous_wood_volume, mai_count, coppice_dens, &
+       &  light_tran_to_level_season,veget_cov_max, harvest_5y_area)
+
+    IMPLICIT NONE
+
+    ! 0 declarations
+    !-
+    ! 0.1 input
+    !-
+    ! Domain size
+    INTEGER(i_std),INTENT(in) :: npts
+    ! Indices of the points on the map
+    INTEGER(i_std),DIMENSION(npts),INTENT(in) :: index
+    ! Geogr. coordinates (latitude,longitude) (degrees)
+    REAL(r_std),DIMENSION(npts,2),INTENT(in) :: lalo
+    ! size in x an y of the grid (m)
+    REAL(r_std),DIMENSION(npts,2),INTENT(in) :: resolution
+    REAL(r_std),DIMENSION(npts),INTENT(in)   :: t2m                !! 2 m air temperature from forcing file or coupled model (K)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)  :: veget_cov_max       !! Maximum fraction of vegetation type including 
+                                                                   !! non-biological fraction (unitless)
+    !-
+    ! 0.2 output
+    !-
+    ! time step of STOMATE in days
+    REAL(r_std),INTENT(out) :: dt_days
+    ! date (d)
+    INTEGER(i_std),INTENT(out) :: date
+    ! Winter too cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: adapted
+    ! Winter sufficiently cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: regenerate
+    ! daily moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_daily
+    ! date for beginning of gdd count
+    REAL(r_std),DIMENSION(npts,2),INTENT(out) :: gdd_init_date
+    ! daily litter humidity
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: litterhum_daily
+    ! daily 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_daily
+    ! daily minimum 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_min_daily
+    ! daily surface temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: tsurf_daily
+    ! daily soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: tsoil_daily
+    ! daily soil humidity
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: soilhum_daily
+    ! daily precipitations (mm/day) (for phenology)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: precip_daily
+    ! daily gross primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gpp_daily
+    ! daily net primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: npp_daily
+    ! daily turnover rates (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out) :: turnover_daily
+    ! "monthly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_month
+    ! "weekly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_week
+    ! mean growing season moisture availability (used for allocation response)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_growingseason
+    ! "long term" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_longterm
+    ! "tau_longterm"
+    REAL(r_std), INTENT(out)        :: tau_longterm
+    ! "monthly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_month
+    ! "seasonal" 2 meter temperatures (K) 
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: Tseason
+    ! temporary variable to calculate Tseason
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: Tseason_length
+    ! temporary variable to calculate Tseason
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: Tseason_tmp
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out)  :: Tmin_spring_time
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out)  :: onset_date
+!!$    LOGICAL,DIMENSION(npts,nvm),INTENT(out)      :: begin_leaves
+    ! "weekly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_week
+    ! "monthly" soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: tsoil_month
+    ! "monthly" soil humidity
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: soilhum_month
+    ! Probability of fire
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: fireindex
+    ! Longer term total litter above the ground, gC/m**2 of ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: firelitter
+    ! last year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxmoiavail_lastyear
+    ! this year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxmoiavail_thisyear
+    ! last year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: minmoiavail_lastyear
+    ! this year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: minmoiavail_thisyear
+    ! last year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxgppweek_lastyear
+    ! this year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxgppweek_thisyear
+    ! last year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: gdd0_lastyear
+    ! this year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: gdd0_thisyear
+    ! last year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: precip_lastyear
+    ! this year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: precip_thisyear
+    ! growing degree days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_m5_dormance
+    ! growing degree days, from begin of season
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_from_growthinit
+    ! growing degree days since midwinter (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_midwinter
+    ! number of chilling days since leaves were lost (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ncd_dormance
+    ! number of growing days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ngd_minus5
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(out)    :: PFTpresent
+    ! "long term" net primary productivity (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: npp_longterm
+    ! last year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: lm_lastyearmax
+    ! this year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: lm_thisyearmax
+    ! last year's maximum fpc for each natural PFT, on ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxfpc_lastyear
+    ! this year's maximum fpc for each PFT,
+    ! on *total* ground (see stomate_season)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxfpc_thisyear
+    ! "long term" turnover rate (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out) :: turnover_longterm
+    ! "weekly" GPP (gC/day/(m**2 covered)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gpp_week
+    ! 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
+    !! Growth and phenological status of the plant
+    !! The different stati are defined in constantes
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: plant_status
+    ! 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 taken from the atmosphere (gC or gN /(m**2 of total ground)/day)
+    REAL(r_std),DIMENSION(npts,nvm,nelements),INTENT(out) :: atm_to_bm
+    ! vegetation fractions (on ground) after last light competition
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: veget_lastlight
+    ! is the PFT everywhere in the grid box or very localized
+    ! (after its introduction)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: everywhere
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box?
+    LOGICAL,DIMENSION(npts,nvm),INTENT(out) :: need_adjacent
+    ! How much time ago was the PFT eliminated for the last time (y)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: RIP_time
+    ! time elapsed since strongest moisture availability (d)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: time_hum_min
+    ! minimum moisture during dormance
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: hum_min_dormance
+    ! fraction of litter above the ground belonging to different PFTs
+    ! separated for natural and agricultural PFTs.
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs,nelements),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
+    ! Soil Organic Matter pool: active, slow, or passive, (gC (or N)/m**2)
+    REAL(r_std),DIMENSION(npts,ncarb,nvm,nelements),INTENT(out) :: som
+    ! ratio Lignine/Carbon in structural litter, above and below ground,(gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nlevs),INTENT(out) :: lignin_struc
+    ! ratio Lignine/Carbon in woody litter, above and below ground,(gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nlevs),INTENT(out) :: lignin_wood
+    REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(out) :: turnover_time
+
+    ! For Spinup matrix resolution
+    INTEGER(i_std), INTENT(out)                   :: global_years   
+    LOGICAL, DIMENSION(npts), INTENT(out)         :: ok_equilibrium
+    REAL(r_std), DIMENSION(npts), INTENT(out)     :: nbp_accu       !! Accumulated Net Biospheric Production over the year
+    REAL(r_std), DIMENSION(npts), INTENT(out)     :: nbp_flux       !! Net Biospheric Production over the year
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: nbp_accu_pool  !! Pool-based Accumulated Net Biospheric Production over the year
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: nbp_pool       !! Pool-based Net Biospheric Production over the year
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: nbp_pool_start !! NBP at previous time step
+
+    !-
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(out) :: MatrixV
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out) :: VectorU
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out) :: previous_stock
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out) :: current_stock
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out) :: CN_som_litter_longterm
+    REAL(r_std), INTENT(out)                              :: tau_CN_longterm  !! Counter used for calculating the longterm CN ratio of SOM and litter pools (seconds)
+    REAL(r_std), DIMENSION(npts,nvm,npco2),   INTENT(out) :: assim_param
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)           :: KF             !! Scaling factor to convert sapwood mass                     
+                                                                              !! into leaf mass (m)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)           :: k_latosa_adapt !! Leaf to sapwood area adapted for water       
+                                                                              !! stress. Adaptation takes place at the 
+                                                                              !! end of the year (m)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                       :: mai                     !! The mean annual increment
+                                                                                                   !! @tex $(m**3 / m**2 / year)$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                       :: pai                     !! The period annual increment
+                                                                                                   !! @tex $(m**3 / m**2 / year)$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                       :: previous_wood_volume    !! The volume of the tree trunks
+                                                                                                   !! in a stand for the previous year.
+                                                                                                   !! @tex $(m**3 / m**2 )$ @endtex
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(out)                     :: mai_count               !! The number of times we've
+                                                                                                   !! calculated the volume increment
+                                                                                                   !! for a stand
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(out)                        :: coppice_dens            !! The density of a coppice at the first
+                                                                                                   !! cutting.
+                                                                                                   !! @tex $( 1 / m**2 )$ @endtex
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                       :: rue_longterm            !! longterm radiation use efficiency
+    INTEGER(i_std), DIMENSION(npts, nvm), INTENT(out)                   :: age_stand               !! Age of stand (years)
+    INTEGER(i_std), DIMENSION(npts, nvm), INTENT(out)                   :: rotation_n              !! Rotation number (number of rotation 
+                                                                                                   !! since pft is managed)
+    INTEGER(i_std), DIMENSION(npts, nvm), INTENT(out)                   :: last_cut                !! Years since last thinning (years)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                       :: cn_leaf_min_season          !! Seasonal min CN ratio of leaves 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                       :: nstress_season          !! N-related seasonal stress (used for allocation) 
+   
+    REAL(r_std), DIMENSION(npts,nvm,nnspec), INTENT(out)                :: soil_n_min              !! mineral nitrogen in the soil (gN/m**2)  
+                                                                                                   !! (first index=npts, second index=nvm, third index=nnspec) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                       :: p_O2                    !! partial pressure of oxigen in the soil (hPa)
+                                                                                                   !! (first index=npts, second index=nvm)
+                      
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                       :: bact                    !! denitrifier biomass (gC/m**2)
+                                                                                                   !! (first index=npts, second index=nvm)
+
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(out)                 :: circ_class_n            !! Number of trees in each circumference classes
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), INTENT(out):: circ_class_biomass      !! Biomass components of the model tree within 
+                                                                                                   !! each circumference classes (gC ind^-1) 
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(inout)               :: store_sum_delta_ba      !! Sum of increase of basal area(m^2) which
+                                                                                                   !! doesn't pass through gap clean 
+    INTEGER(i_std), DIMENSION (npts,nvm), INTENT(out)                   :: forest_managed_lastyear !! forest management flag for the previous year
+    INTEGER(i_std), DIMENSION(npts,nvm), INTENT(out)                    :: forest_managed          !! forest management flag
+    REAL(r_std), DIMENSION(npts,0:nshort,nelements), INTENT(out)        :: prod_s                  !!
+    REAL(r_std), DIMENSION(npts,0:nmedium,nelements), INTENT(out)       :: prod_m                  !!
+    REAL(r_std), DIMENSION(npts,0:nlong,nelements), INTENT(out)         :: prod_l                  !!
+    REAL(r_std), DIMENSION(npts,nshort,nelements), INTENT(out)          :: flux_s                  !!
+    REAL(r_std), DIMENSION(npts,nmedium,nelements), INTENT(out)         :: flux_m                  !!
+    REAL(r_std), DIMENSION(npts,nlong,nelements), INTENT(out)           :: flux_l                  !!
+    REAL(r_std), DIMENSION(npts,nelements), INTENT(out)                 :: flux_prod_s            !!
+    REAL(r_std), DIMENSION(npts,nelements), INTENT(out)                 :: flux_prod_m            !!
+    REAL(r_std), DIMENSION(npts,nelements), INTENT(out)                 :: flux_prod_l            !!
+    INTEGER(i_std), DIMENSION(:,:), INTENT(out)                         :: species_change_map      !! A map which gives the PFT number that each
+                                                                                                   !! PFT will be replanted as in case of a clearcut.
+                                                                                                   !! (1-nvm,unitless)
+    INTEGER(i_std), DIMENSION(:,:), INTENT(out)                         :: fm_change_map           !! A map which gives the desired FM strategy when
+                                                                                                   !! the PFT will be replanted after a clearcut.
+                                                                                                   !! (1-nvm,unitless)
+    LOGICAL, DIMENSION(:,:), INTENT(out)                                :: lpft_replant            !! Indicates if this PFT has either died this year
+                                                                                                   !! or been clearcut/coppiced.  If it has, it is not
+                                                                                                   !! replanted until the end of the year.
+
+
+    REAL(r_std), DIMENSION(npts,nvm,nlevels_tot),INTENT(out)            :: lai_per_level           !! The amount of LAI in each physical
+
+   !! canopy level. 
+                                                                                                   !! @tex $( m**2 / m**2 )$ @endtex
+ 
+    TYPE(laieff_type),DIMENSION (:,:,:),INTENT(out)                     :: laieff_fit              !! Fitted parameters for the effective LAI
+
+    REAL(r_std), DIMENSION(:,:), INTENT(out)                            :: wstress_season          !! Water stress factor, based on hum_rel_daily
+
+                  !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:), INTENT(out)                            :: wstress_month           !! Water stress factor, based on hum_rel_daily
+                                                                                                   !! (unitless, 0-1)
+
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out)        :: bm_to_litter
+    REAL(r_std),DIMENSION(npts),INTENT(out)                             :: carb_mass_total
+    REAL(r_std), DIMENSION(:,:,:), INTENT(out)                          :: light_tran_to_level_season  !! Mean seasonal fraction of light transmitted to
+                                                                                                   !! a given canopy level (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(out)                          :: harvest_5y_area         !! Total harvested area in the last 5 years (m^{2})
+
+  !! 0.4 Local variables
+    
+    REAL(r_std) :: date_real
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs), real
+    REAL(r_std),DIMENSION(npts,nvm) :: PFTpresent_real
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box? - real
+    REAL(r_std),DIMENSION(npts,nvm) :: need_adjacent_real
+    REAL(r_std), DIMENSION(1) :: vartmp  !! temporary variable because restget/restput needs an array and not a scalar
+    ! To store variables names for I/O
+    CHARACTER(LEN=80) :: var_name
+    ! string suffix indicating an index
+    CHARACTER(LEN=10) :: part_str
+    ! string suffix indicating an index
+    CHARACTER(LEN=10) :: circ_str             
+    ! string suffix indicating litter type
+    CHARACTER(LEN=4),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)
+
+    CHARACTER(LEN=2),DIMENSION(nelements) :: element_str   !! string suffix indicating element
+    REAL(r_std), DIMENSION(1) :: temp_global_years
+    CHARACTER(LEN=6), DIMENSION(nbpools) :: pools_str
+    REAL(r_std), DIMENSION(npts) :: ok_equilibrium_real    
+    CHARACTER(LEN=80) :: filename   !! filename for reference temerature file
+    ! land cover change variables
+    INTEGER                                                             :: n,ilev,ipts,ivm,icarb   !! Indices
+    REAL(r_std), DIMENSION(npts,nvm)                                    :: temp_real               !! temporary real to allow restget 
+                                                                                                   !! to work on multi-dimensional integers
+    REAL(r_std), DIMENSION(npts,nvm)                                    :: r_replant               !! Getting logical values from the restart
+                                                                                                   !! is not possible, so this is a temporary
+                                                                                                   !! array where 1.0 is TRUE.
+    REAL(r_std),DIMENSION(npts,nvm,nlevels_tot,nparams_laieff)          :: temp_array              !! To store structure values for I/O
+    CHARACTER(LEN=10)                                                   :: part_str2               !! string suffix indicating an index
+
+    CHARACTER(LEN=2), DIMENSION(wind_years)                             :: wyear_str               !! string suffix indicating wind year index
+
+
+   !_ ================================================================================================================================
+
+    IF (printlev >= 3) WRITE(numout,*) 'Entering readrestart'
+    !-
+    ! 1 string definitions
+    !-
+    DO l=1,nlitt
+       IF     (l == imetabolic) THEN
+          litter_str(l) = 'met'
+       ELSEIF (l == istructural) THEN
+          litter_str(l) = 'str'
+       ELSEIF (l == iwoody) THEN
+          litter_str(l) = 'wood'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io readstart', 'Define litter_str','','')
+       ENDIF
+    ENDDO
+    !-
+    DO l=1,nlevs
+       IF     (l == iabove) THEN
+          level_str(l) = 'ab'
+       ELSEIF (l == ibelow) THEN
+          level_str(l) = 'be'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io readstart','Define level_str','','')
+       ENDIF
+    ENDDO
+
+    pools_str(1:nbpools) =(/'str_ab ','str_be ','met_ab ','met_be ','wood_ab','wood_be',& 
+         & 'actif  ','slow   ','passif ','surface'/) 
+    !-
+    DO l=1,nelements
+       IF     (l == icarbon) THEN
+          element_str(l) = ''
+       ELSEIF (l == initrogen) THEN
+          element_str(l) = '_n'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io readstart','Define element_str','','')
+       ENDIF
+    ENDDO
+    !-
+    ! 2 run control
+    !-
+    ! 2.2 time step of STOMATE in days
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'dt_days'
+       CALL restget (rest_id_stomate, var_name, 1   , 1     , 1, itime, &
+            &                 .TRUE., xtmp)
+       dt_days = xtmp(1)
+       IF (dt_days == val_exp) dt_days = un
+    ENDIF
+    CALL bcast(dt_days)
+    !-
+    ! 2.3 date
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'date'
+       CALL restget (rest_id_stomate, var_name, 1   , 1     , 1, itime, &
+            &                 .TRUE., xtmp)
+       date_real = xtmp(1)
+       IF (date_real == val_exp) date_real = zero
+       date = NINT(date_real)
+    ENDIF
+    CALL bcast(date)
+    !-
+    ! 3 daily meteorological variables
+    !-
+    moiavail_daily(:,:) = val_exp
+    var_name = 'moiavail_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., moiavail_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(moiavail_daily(:,:) == val_exp)) moiavail_daily(:,:) = zero
+    !-
+    gdd_init_date(:,:) = val_exp
+    var_name = 'gdd_init_date'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 2 , 1, itime, &
+         &              .TRUE., gdd_init_date, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_init_date(:,1) == val_exp)) gdd_init_date(:,1) = 365.
+    !-
+    litterhum_daily(:) = val_exp
+    var_name = 'litterhum_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., litterhum_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(litterhum_daily(:) == val_exp)) litterhum_daily(:) = zero
+    !-
+    t2m_daily(:) = val_exp
+    var_name = 't2m_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., t2m_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(t2m_daily(:) == val_exp)) t2m_daily(:) = zero
+    !-
+    t2m_min_daily(:) = val_exp
+    var_name = 't2m_min_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., t2m_min_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(t2m_min_daily(:) == val_exp)) t2m_min_daily(:) = large_value
+    !-
+    tsurf_daily(:) = val_exp
+    var_name = 'tsurf_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., tsurf_daily, 'gather', nbp_glo, index_g)
+    ! The initial value is set to the current temperature at 2m
+    IF (ALL(tsurf_daily(:) == val_exp)) tsurf_daily(:) = t2m(:)
+    !-
+    tsoil_daily(:,:) = val_exp
+    var_name = 'tsoil_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nbdl, 1, itime, &
+         &                .TRUE., tsoil_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(tsoil_daily(:,:) == val_exp)) tsoil_daily(:,:) = zero
+    !-
+    soilhum_daily(:,:) = val_exp
+    var_name = 'soilhum_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nbdl, 1, itime, &
+         &                .TRUE., soilhum_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(soilhum_daily(:,:) == val_exp)) soilhum_daily(:,:) = zero
+    !-
+    precip_daily(:) = val_exp
+    var_name = 'precip_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., precip_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(precip_daily(:) == val_exp)) precip_daily(:) = zero
+    !-
+    ! 4 productivities
+    !-
+    gpp_daily(:,:) = val_exp
+    var_name = 'gpp_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gpp_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(gpp_daily(:,:) == val_exp)) gpp_daily(:,:) = zero
+    !-
+    npp_daily(:,:) = val_exp
+    var_name = 'npp_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., npp_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(npp_daily(:,:) == val_exp)) npp_daily(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'turnover_daily', nbp_glo, nvm, nparts, nelements, itime, & 
+        &                .TRUE., turnover_daily, 'gather', nbp_glo, index_g) 
+    IF (ALL(turnover_daily  == val_exp)) turnover_daily(:,:,:,:) = zero
+    !-
+    ! 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
+
+    moiavail_growingseason(:,:) = val_exp
+    var_name = 'moiavail_grow'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., moiavail_growingseason, 'gather', nbp_glo, index_g)
+    IF (ALL(moiavail_growingseason(:,:) == val_exp)) moiavail_growingseason(:,:) = un
+    
+
+    !
+    ! Longterm temperature at 2m
+    !
+    var_name = 't2m_longterm'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., t2m_longterm, 'gather', nbp_glo, index_g)
+
+    IF (ALL(t2m_longterm(:) == val_exp)) THEN
+       ! t2m_longterm is not in restart file
+       ! The initial value for the reference temperature is set to the current temperature
+       t2m_longterm(:)=t2m(:)
+       ! Set the counter to 2 time steps
+       tau_longterm=2
+    ELSE
+       ! t2m_longterm was in the restart file
+       ! Now read tau_longterm
+       ! tau_longterm is a scalar, therefor only master process read this value
+       IF (is_root_prc) THEN
+          CALL restget (rest_id_stomate, 'tau_longterm', 1 ,1  , 1, itime, &
+               .TRUE., vartmp)
+          IF (vartmp(1) == val_exp) THEN
+             ! tau_longterm is not found in restart file. 
+             ! This is not normal as t2m_longterm was in restart file. Write a warning and initialize it to tau_longterm_max
+             CALL ipslerr(2, 'stomate_io readstart','tau_longterm was not in restart file',&
+                  'But t2m_longterm was in restart file','')
+             tau_longterm = tau_longterm_max
+          ELSE
+             tau_longterm = vartmp(1)
+          END IF
+       ENDIF
+       CALL bcast(tau_longterm)
+
+    END IF
+    !-
+    t2m_month(:) = val_exp
+    var_name = 't2m_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., t2m_month, 'gather', nbp_glo, index_g)
+    IF (ALL(t2m_month(:) == val_exp)) t2m_month(:) = t2m(:)
+    
+    CALL restget_p (rest_id_stomate, 'Tseason', nbp_glo, 1     , 1, itime, &
+         .TRUE., Tseason, 'gather', nbp_glo, index_g)
+    IF (ALL(Tseason(:) == val_exp)) Tseason(:) = t2m(:)
+    
+    CALL restget_p (rest_id_stomate,'Tseason_length', nbp_glo, 1     , 1, itime, &
+         .TRUE., Tseason_length, 'gather', nbp_glo, index_g)
+    IF (ALL(Tseason_length(:) == val_exp)) Tseason_length(:) = zero
+    
+    CALL restget_p (rest_id_stomate, 'Tseason_tmp', nbp_glo, 1     , 1, itime, &
+         .TRUE., Tseason_tmp, 'gather', nbp_glo, index_g)
+    IF (ALL(Tseason_tmp(:) == val_exp)) Tseason_tmp(:) = zero
+
+    CALL restget_p (rest_id_stomate, 'Tmin_spring_time', nbp_glo, nvm, 1, itime, &
+         .TRUE., Tmin_spring_time, 'gather', nbp_glo, index_g)
+    IF (ALL(Tmin_spring_time(:,:) == val_exp)) Tmin_spring_time(:,:) = zero
+    
+    CALL restget_p (rest_id_stomate, 'onset_date', nbp_glo, nvm  , 1, itime, &
+         .TRUE., onset_date(:,:), 'gather', nbp_glo, index_g)
+    IF (ALL(onset_date(:,:) == val_exp)) onset_date(:,:) = zero
+
+    t2m_week(:) = val_exp
+    var_name = 't2m_week'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., t2m_week, 'gather', nbp_glo, index_g)
+    ! The initial value is set to the current temperature
+    IF (ALL(t2m_week(:) == val_exp)) t2m_week(:) = t2m(:)
+    
+    tsoil_month(:,:) = val_exp
+    var_name = 'tsoil_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nbdl, 1, itime, &
+         &              .TRUE., tsoil_month, 'gather', nbp_glo, index_g)
+
+    ! The initial value is set to the current temperature
+    IF (ALL(tsoil_month(:,:) == val_exp)) THEN
+       DO l=1,nbdl
+          tsoil_month(:,l) = t2m(:)
+       ENDDO
+    ENDIF
+    !-
+    soilhum_month(:,:) = val_exp
+    var_name = 'soilhum_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nbdl, 1, itime, &
+         &              .TRUE., soilhum_month, 'gather', nbp_glo, index_g)
+    IF (ALL(soilhum_month(:,:) == val_exp)) soilhum_month(:,:) = zero
+    !-
+    wstress_season(:,:) = val_exp
+    var_name = 'wstress_season'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                .TRUE., wstress_season, 'gather', nbp_glo, index_g)
+    IF (ALL(wstress_season(:,:) == val_exp)) wstress_season(:,:) = un
+    !-
+    wstress_month(:,:) = val_exp
+    var_name = 'wstress_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                .TRUE., wstress_month, 'gather', nbp_glo, index_g)
+    IF (ALL(wstress_month(:,:) == val_exp)) wstress_month(:,:) = un
+    !-
+    ! 6 fire probability
+    !-
+    fireindex(:,:) = val_exp
+    var_name = 'fireindex'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              .TRUE., fireindex, 'gather', nbp_glo, index_g)
+    IF (ALL(fireindex(:,:) == val_exp)) fireindex(:,:) = zero
+    !-
+    firelitter(:,:) = val_exp
+    var_name = 'firelitter'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              .TRUE., firelitter, 'gather', nbp_glo, index_g)
+    IF (ALL(firelitter(:,:) == val_exp)) firelitter(:,:) = zero
+    !-
+    ! 7 maximum and minimum moisture availabilities for tropic phenology
+    !-
+    maxmoiavail_lastyear(:,:) = val_exp
+    var_name = 'maxmoistr_last'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxmoiavail_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxmoiavail_lastyear(:,:) == val_exp)) &
+         &     maxmoiavail_lastyear(:,:) = zero
+    !-
+    maxmoiavail_thisyear(:,:) = val_exp
+    var_name = 'maxmoistr_this'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxmoiavail_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxmoiavail_thisyear(:,:) == val_exp)) &
+         &     maxmoiavail_thisyear(:,:) = zero
+    !-
+    minmoiavail_lastyear(:,:) = val_exp
+    var_name = 'minmoistr_last'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., minmoiavail_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(minmoiavail_lastyear(:,:) == val_exp)) &
+         &     minmoiavail_lastyear(:,:) = un
+    !-
+    minmoiavail_thisyear(:,:) = val_exp
+    var_name = 'minmoistr_this'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., minmoiavail_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL( minmoiavail_thisyear(:,:) == val_exp)) &
+         &     minmoiavail_thisyear(:,:) = un
+    !-
+    ! 8 maximum "weekly" GPP
+    !-
+    maxgppweek_lastyear(:,:) = val_exp
+    var_name = 'maxgppweek_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxgppweek_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxgppweek_lastyear(:,:) == val_exp)) &
+         &     maxgppweek_lastyear(:,:) = zero
+    !-
+    maxgppweek_thisyear(:,:) = val_exp
+    var_name = 'maxgppweek_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxgppweek_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxgppweek_thisyear(:,:) == val_exp)) &
+         &     maxgppweek_thisyear(:,:) = zero
+    !-
+    ! 9 annual GDD0
+    !-
+    gdd0_thisyear(:) = val_exp
+    var_name = 'gdd0_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., gdd0_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd0_thisyear(:) == val_exp)) gdd0_thisyear(:) = zero
+    !-
+    gdd0_lastyear(:) = val_exp
+    var_name = 'gdd0_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., gdd0_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd0_lastyear(:) == val_exp)) gdd0_lastyear(:) = gdd_crit_estab
+    !-
+    ! 10 annual precipitation
+    !-
+    precip_thisyear(:) = val_exp
+    var_name = 'precip_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., precip_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(precip_thisyear(:) == val_exp)) precip_thisyear(:) = zero
+    !-
+    precip_lastyear(:) = val_exp
+    var_name = 'precip_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., precip_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(precip_lastyear(:) == val_exp)) &
+         &     precip_lastyear(:) = precip_crit
+    !-
+    ! 11 derived "biometeorological" variables
+    !-
+    gdd_m5_dormance(:,:) = val_exp
+    var_name = 'gdd_m5_dormance'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gdd_m5_dormance, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_m5_dormance(:,:) == val_exp)) &
+         &     gdd_m5_dormance(:,:) = undef
+    !-
+    gdd_from_growthinit(:,:) = val_exp
+    var_name = 'gdd_from_growthinit'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gdd_from_growthinit, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_from_growthinit(:,:) == val_exp)) &
+         &     gdd_from_growthinit(:,:) = zero
+    !-
+    gdd_midwinter(:,:) = val_exp
+    var_name = 'gdd_midwinter'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gdd_midwinter, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_midwinter(:,:) == val_exp)) gdd_midwinter(:,:) = undef
+    !-
+    ncd_dormance(:,:) = val_exp
+    var_name = 'ncd_dormance'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., ncd_dormance, 'gather', nbp_glo, index_g)
+    IF (ALL(ncd_dormance(:,:) == val_exp)) ncd_dormance(:,:) = undef
+    !-
+    ngd_minus5(:,:) = val_exp
+    var_name = 'ngd_minus5'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., ngd_minus5, 'gather', nbp_glo, index_g)
+    IF (ALL(ngd_minus5(:,:) == val_exp)) ngd_minus5(:,:) = zero
+    !-
+    time_hum_min(:,:) = val_exp
+    var_name = 'time_hum_min'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., time_hum_min, 'gather', nbp_glo, index_g)
+    IF (ALL(time_hum_min(:,:) == val_exp)) time_hum_min(:,:) = undef
+    !-
+    hum_min_dormance(:,:) = val_exp
+    var_name = 'hum_min_dormance'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., hum_min_dormance, 'gather', nbp_glo, index_g)
+    IF (ALL(hum_min_dormance(:,:) == val_exp)) &
+         &     hum_min_dormance(:,:) = undef
+    !-
+    ! 12 Plant status
+    !-
+    CALL restget_p (rest_id_stomate, 'PFTpresent', 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
+    !-
+    !CALL restget_p (rest_id_stomate, 'ind', nbp_glo, nvm  , 1, itime, &
+    !     &              .TRUE., ind, 'gather', nbp_glo, index_g)
+    !IF (ALL(ind(:,:) == val_exp)) ind(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'adapted', nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., adapted, 'gather', nbp_glo, index_g)
+    IF (ALL(adapted(:,:) == val_exp)) adapted(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'regenerate', nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., regenerate, 'gather', nbp_glo, index_g)
+    IF (ALL(regenerate(:,:) == val_exp)) regenerate(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'npp_longterm', nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., npp_longterm, 'gather', nbp_glo, index_g)
+    IF (ALL(npp_longterm(:,:) == val_exp)) npp_longterm(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'lm_lastyearmax', nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., lm_lastyearmax, 'gather', nbp_glo, index_g)
+    IF (ALL(lm_lastyearmax(:,:) == val_exp)) lm_lastyearmax(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'lm_thisyearmax', nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., lm_thisyearmax, 'gather', nbp_glo, index_g)
+    IF (ALL(lm_thisyearmax(:,:) == val_exp)) lm_thisyearmax(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'maxfpc_lastyear', nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxfpc_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxfpc_lastyear(:,:) == val_exp)) maxfpc_lastyear(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'maxfpc_thisyear', nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxfpc_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxfpc_thisyear(:,:) == val_exp)) maxfpc_thisyear(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'turnover_time', nbp_glo, nvm  , nparts, itime, &
+         &              .TRUE., turnover_time, 'gather', nbp_glo, index_g)
+    IF ( ALL( turnover_time(:,:,:) == val_exp)) turnover_time(:,:,:) = 100.
+    !-
+    CALL restget_p (rest_id_stomate, 'turnover_longterm', nbp_glo, nvm, nparts, nelements, itime, & 
+         &              .TRUE., turnover_longterm, 'gather', nbp_glo, index_g) 
+    IF (ALL(turnover_longterm == val_exp)) turnover_longterm(:,:,:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'gpp_week', nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gpp_week, 'gather', nbp_glo, index_g)
+    IF (ALL(gpp_week(:,:) == val_exp)) gpp_week(:,:) = zero
+    !-
+    !CALL restget_p (rest_id_stomate, 'biomass', nbp_glo, nvm, nparts, nelements, itime, &
+    !     &              .TRUE., biomass, 'gather', nbp_glo, index_g)
+    !IF (ALL(biomass == val_exp)) biomass(:,:,:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'circ_class_n', nbp_glo, nvm, ncirc, itime, &
+         &              .TRUE., circ_class_n, 'gather', nbp_glo, index_g)
+    IF (ALL(circ_class_n == val_exp)) circ_class_n(:,:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'store_sum_delta_ba', nbp_glo, nvm, ncirc, itime, &
+         &              .TRUE., store_sum_delta_ba, 'gather', nbp_glo, index_g)
+    IF (ALL(store_sum_delta_ba == val_exp)) store_sum_delta_ba(:,:,:) = zero
+    !-
+    DO m = 1,nelements
+        var_name = 'cc_biomass_'//TRIM(element_str(m))
+        CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, ncirc, nparts, itime, &
+             &         .TRUE., circ_class_biomass(:,:,:,:,m), 'gather', nbp_glo, index_g)
+        IF (ALL(circ_class_biomass(:,:,:,:,m) == val_exp)) circ_class_biomass(:,:,:,:,m) = zero
+    ENDDO
+    !-
+    CALL restget_p (rest_id_stomate, 'lai_per_level', nbp_glo, nvm, nlevels_tot, itime, &
+         &               .TRUE., lai_per_level, 'gather', nbp_glo, index_g)
+    IF (ALL(lai_per_level == val_exp)) lai_per_level(:,:,:) = zero
+    !
+    ! This is ugly, since the restart routines were not developed to deal with structures. 
+    ! But all I have to do is copy some things to arrays.
+    temp_array(:,:,:,:) = val_exp
+    DO m=1,nlevels_tot
+       WRITE(part_str,'(I2)') m
+       IF ( m < 10 ) part_str(1:1) = '0'
+       DO n=1,nparams_laieff
+          WRITE(part_str2,'(I2)') n
+          IF ( n < 10 ) part_str2(1:1) = '0'
+
+          var_name = 'laieff_fit_'//part_str(1:LEN_TRIM(part_str)) // '_' &
+               // part_str2(1:LEN_TRIM(part_str2))
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+               .TRUE., temp_array(:,:,m,n), 'gather', nbp_glo, index_g)
+          IF (ALL(temp_array(:,:,m,n) == val_exp)) temp_array(:,:,m,n) = zero
+       ENDDO
+    ENDDO
+    DO ipts=1,npts
+       DO ivm=1,nvm
+          DO ilev=1,nlevels_tot
+             laieff_fit(ipts,ivm,ilev)%a=temp_array(ipts,ivm,ilev,1)
+             laieff_fit(ipts,ivm,ilev)%b=temp_array(ipts,ivm,ilev,2)
+             laieff_fit(ipts,ivm,ilev)%c=temp_array(ipts,ivm,ilev,3)
+             laieff_fit(ipts,ivm,ilev)%d=temp_array(ipts,ivm,ilev,4)
+             laieff_fit(ipts,ivm,ilev)%e=temp_array(ipts,ivm,ilev,5)
+          ENDDO
+       ENDDO
+    ENDDO
+    !
+    CALL restget_p (rest_id_stomate, 'maint_resp', nbp_glo, nvm, nparts, itime, &
+         &                   .TRUE., resp_maint_part, 'gather', nbp_glo, index_g)
+    IF (ALL(resp_maint_part == val_exp)) resp_maint_part(:,:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'leaf_age', nbp_glo, nvm, nleafages, itime, &
+         &                   .TRUE., leaf_age(:,:,:), 'gather', nbp_glo, index_g)
+    IF (ALL(leaf_age == val_exp)) leaf_age(:,:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'leaf_frac', nbp_glo, nvm, nleafages, itime, &
+         &                  .TRUE., leaf_frac(:,:,:), 'gather', nbp_glo, index_g)
+    IF (ALL(leaf_frac(:,:,:) == val_exp)) leaf_frac(:,:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'plant_status', nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., plant_status, 'gather', nbp_glo, index_g)
+    IF (ALL(plant_status(:,:) == val_exp)) THEN
+       plant_status(:,:) = iprescribe
+       plant_status(:,ibare_sechiba) = inone
+    ENDIF
+    !-
+    CALL restget_p (rest_id_stomate, 'when_growthinit', nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., when_growthinit, 'gather', nbp_glo, index_g)
+    IF (ALL(when_growthinit(:,:) == val_exp)) when_growthinit(:,:) = 240.
+    !-
+    CALL restget_p (rest_id_stomate, 'age', nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., age, 'gather', nbp_glo, index_g)
+    IF (ALL(age(:,:) == val_exp)) age(:,:) = zero
+    !-
+    ! 13 CO2
+    !-
+    CALL restget_p (rest_id_stomate, 'resp_hetero', nbp_glo, nvm, 1, itime, &
+         &                .TRUE., resp_hetero, 'gather', nbp_glo, index_g)
+    IF (ALL(resp_hetero(:,:) == val_exp)) resp_hetero(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'resp_maint', nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., resp_maint, 'gather', nbp_glo, index_g)
+    IF (ALL(resp_maint(:,:) == val_exp)) resp_maint(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'resp_growth', nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., resp_growth, 'gather', nbp_glo, index_g)
+    IF (ALL(resp_growth(:,:) == val_exp)) resp_growth(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'co2_fire', nbp_glo, nvm     , 1, itime, &
+         &                .TRUE., co2_fire, 'gather', nbp_glo, index_g)
+    IF (ALL(co2_fire(:,:) == val_exp)) co2_fire(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'atm_to_bm', nbp_glo, nvm, nelements, itime, &
+         &                .TRUE., atm_to_bm, 'gather', nbp_glo, index_g)
+    IF (ALL(atm_to_bm == val_exp)) atm_to_bm(:,:,:) = zero
+    !-
+ 
+    !-
+    ! 14 vegetation distribution after last light competition
+    !-
+    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
+    !-
+    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
+    !-
+    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
+    !-
+    var_name = 'RIP_time'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., RIP_time, 'gather', nbp_glo, index_g)
+    IF (ALL(RIP_time(:,:) == val_exp)) RIP_time(:,:) = large_value
+    !-
+    ! 17 litter
+    !-
+    DO k = 1,nelements
+       var_name = 'litter_'//element_str(k)
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt, nvm, nlevs, itime, &
+            &                     .TRUE., litter(:,:,:,:,k), 'gather', nbp_glo, index_g)
+       IF (ALL(litter(:,:,:,:,k) == val_exp)) litter(:,:,:,:,k) = zero
+    END DO
+    !-
+    CALL restget_p (rest_id_stomate, 'dead_leaves', nbp_glo, nvm, nlitt, itime, &
+          &                   .TRUE., dead_leaves, 'gather', nbp_glo, index_g)
+    IF (ALL(dead_leaves == val_exp)) dead_leaves(:,:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'soil_carbon', nbp_glo, ncarb, nvm, itime, &
+         &                   .TRUE., som(:,:,:,icarbon), 'gather', nbp_glo, index_g) 
+    ! Initialise the soil pools. 
+    IF (ALL(som(:,:,:,icarbon) == val_exp)) THEN
+       ! We set the pools to zero for all PFTs
+       som(:,:,:,icarbon) = zero
+       DO ipts =1,npts
+          DO ivm = 1,nvm 
+             ! Set the initial values for PFTs that are present.  
+             IF( veget_cov_max(ipts,ivm) .GT. min_stomate) THEN 
+                som(ipts,iactive,ivm,icarbon) = som_init_active 
+                som(ipts,isurface,ivm,icarbon) = som_init_surface 
+                som(ipts,islow,ivm,icarbon) = som_init_slow
+                som(ipts,ipassive,ivm,icarbon) = som_init_passive
+             ENDIF
+          ENDDO
+       ENDDO  
+    ENDIF
+    !-
+    CALL restget_p (rest_id_stomate, 'soil_nitrogen', nbp_glo, ncarb, nvm, itime, & 
+         &                   .TRUE., som(:,:,:,initrogen), 'gather', nbp_glo, index_g) 
+    IF (ALL(som(:,:,:,initrogen) == val_exp)) THEN 
+       som(:,iactive,:,initrogen) = som(:,iactive,:,icarbon) / CN_target_iactive_ref 
+       som(:,isurface,:,initrogen) = som(:,isurface,:,icarbon) / CN_target_isurface_ref 
+       som(:,islow,:,initrogen) = som(:,islow,:,icarbon) / CN_target_islow_ref 
+       som(:,ipassive,:,initrogen) =  som(:,ipassive,:,icarbon) / CN_target_ipassive_ref 
+    ENDIF
+    !-
+    CALL restget_p (rest_id_stomate, 'lignin_struc', nbp_glo, nvm, nlevs, itime, &
+         &     .TRUE., lignin_struc, 'gather', nbp_glo, index_g)
+    IF (ALL(lignin_struc == val_exp)) lignin_struc(:,:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'lignin_wood', nbp_glo, nvm, nlevs, itime, &
+         &     .TRUE., lignin_wood, 'gather', nbp_glo, index_g)
+    IF (ALL(lignin_wood == val_exp)) lignin_wood(:,:,:) = zero
+    !-
+    ! 18 Product use and LCC
+    !-
+    CALL restget_p (rest_id_stomate, 'prod_s', nbp_glo, nshort+1, nelements, itime, &
+         &                .TRUE., prod_s, 'gather', nbp_glo, index_g)
+    IF (ALL(prod_s == val_exp)) prod_s(:,:,:) = zero
+        
+    CALL restget_p (rest_id_stomate, 'prod_m', nbp_glo, nmedium+1, nelements, itime, &
+         &                .TRUE., prod_m, 'gather', nbp_glo, index_g)
+    IF (ALL(prod_m == val_exp)) prod_m(:,:,:) = zero
+
+    CALL restget_p (rest_id_stomate, 'prod_l', nbp_glo, nlong+1, nelements, itime, &
+         &                .TRUE., prod_l, 'gather', nbp_glo, index_g)
+    IF (ALL(prod_l == val_exp)) prod_l(:,:,:) = zero
+
+    CALL restget_p (rest_id_stomate, 'flux_s', nbp_glo, nshort , nelements, itime, &
+         &                .TRUE., flux_s, 'gather', nbp_glo, index_g)
+    IF (ALL(flux_s == val_exp)) flux_s(:,:,:) = zero
+        
+    CALL restget_p (rest_id_stomate, 'flux_m', nbp_glo, nmedium, nelements, itime, &
+         &                .TRUE., flux_m, 'gather', nbp_glo, index_g)
+    IF (ALL(flux_m == val_exp)) flux_m(:,:,:) = zero
+
+    CALL restget_p (rest_id_stomate, 'flux_l', nbp_glo, nlong, nelements, itime, &
+         &                .TRUE., flux_l, 'gather', nbp_glo, index_g)
+    IF (ALL(flux_l == val_exp)) flux_l(:,:,:) = zero
+
+    CALL restget_p (rest_id_stomate, 'flux_prod_s', nbp_glo, nelements, 1, itime, &
+         &              .TRUE., flux_prod_s, 'gather', nbp_glo, index_g)
+    IF (ALL(flux_prod_s == val_exp)) flux_prod_s(:,:) = zero
+
+    CALL restget_p (rest_id_stomate, 'flux_prod_m', nbp_glo, nelements, 1, itime, &
+         &              .TRUE., flux_prod_m, 'gather', nbp_glo, index_g)
+    IF (ALL(flux_prod_m == val_exp)) flux_prod_m(:,:) = zero
+
+    CALL restget_p (rest_id_stomate, 'flux_prod_l', nbp_glo, nelements, 1, itime, &
+         &              .TRUE., flux_prod_l, 'gather', nbp_glo, index_g)
+    IF (ALL(flux_prod_l == val_exp)) flux_prod_l(:,:) = zero
+    !-
+    CALL restget_p (rest_id_stomate, 'bm_to_litter', nbp_glo, nvm, nparts, nelements, itime, &
+         &                .TRUE., bm_to_litter, 'gather', nbp_glo, index_g)
+    IF (ALL(bm_to_litter == val_exp)) bm_to_litter(:,:,:,:) = zero
+    !-
+    carb_mass_total(:) = val_exp
+    var_name = 'carb_mass_total'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., carb_mass_total, 'gather', nbp_glo, index_g)
+    IF (ALL(carb_mass_total(:) == val_exp)) carb_mass_total(:) = zero
+    !-
+    ! 19. Spinup
+    !-
+    IF (spinup_analytic) THEN
+
+       IF (is_root_prc) THEN
+          temp_global_years(1) = val_exp
+          var_name = 'Global_years'
+          CALL restget (rest_id_stomate, var_name, 1 ,1  , 1, itime, &
+               &                .TRUE., temp_global_years)
+          IF(temp_global_years(1) == val_exp) temp_global_years(1) = zero
+          global_years = INT(temp_global_years(1))
+       ENDIF
+       CALL bcast(global_years)
+
+       nbp_accu(:) = val_exp
+       var_name = 'nbp_sum'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+            &              .TRUE., nbp_accu, 'gather', nbp_glo, index_g)
+       IF (ALL(nbp_accu(:) == val_exp)) nbp_accu(:) = zero    
+
+       nbp_flux(:) = val_exp
+       var_name = 'nbp_flux'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+            &              .TRUE., nbp_flux, 'gather', nbp_glo, index_g)
+       IF (ALL(nbp_flux(:) == val_exp)) nbp_flux(:) = zero     
+
+       nbp_pool(:,:) = val_exp
+       var_name = 'nbp_pool'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+            &              .TRUE., nbp_pool(:,:), 'gather', nbp_glo, index_g)
+       IF (ALL(nbp_pool(:,:) == val_exp)) nbp_pool(:,:) = zero
+
+       nbp_pool_start(:,:) = val_exp
+       var_name = 'nbp_pool_start'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+            &              .TRUE., nbp_pool_start(:,:), 'gather', nbp_glo, index_g)
+
+       IF (ALL(nbp_pool_start(:,:) == val_exp))THEN
+           nbp_pool_start(:,:) = zero
+           DO ipts =1,npts
+             DO ivm = 1,nvm
+                ! Set the initial valies of the NBP pool. 
+                ! When runnig from scratch there is neither litter og bimass
+                ! pools yet, but the soil pools are set by initial values. Thus,
+                ! we start by initialising the NPB pool with the soilpool.
+                ! However, this means that the first year of NBP pools should be
+                ! disregarded. 
+                IF( veget_cov_max(ipts,ivm) .GT. min_stomate) THEN
+
+                   DO icarb = 1, ncarb
+                      nbp_pool_start(ipts,ivm) = nbp_pool_start(ipts,ivm) + &
+                          som(ipts,icarb,ivm,icarbon)*veget_cov_max(ipts,ivm)
+                   ENDDO
+                ENDIF
+             ENDDO  
+           ENDDO
+       ENDIF
+
+       nbp_accu_pool(:,:) = val_exp
+       var_name = 'nbp_accu_pool'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+            &              .TRUE., nbp_accu_pool, 'gather', nbp_glo, index_g)
+       IF (ALL(nbp_accu_pool(:,:) == val_exp)) nbp_accu_pool(:,:) = zero
+
+       !-
+       ok_equilibrium_real(:) = val_exp
+       var_name = 'ok_equilibrium'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo , 1  , 1, itime, &
+            &                .TRUE., ok_equilibrium_real,'gather', nbp_glo, index_g)
+       IF (ALL(ok_equilibrium_real(:) == val_exp)) ok_equilibrium_real(:) = zero
+       WHERE(ok_equilibrium_real(:) >= 0.5) 
+          ok_equilibrium = .TRUE.
+       ELSEWHERE
+          ok_equilibrium = .FALSE.
+       ENDWHERE
+       !-
+       MatrixV(:,:,:,:) = val_exp
+       DO k = 1,nbpools
+          DO j = 1,nbpools
+             WRITE(part_str,'(I2)') k
+             IF (k < 10) part_str(1:1) = '0'
+             var_name ='MatrixV_'//part_str(1:LEN_TRIM(part_str))//'_'//TRIM(pools_str(j))
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime,&
+                  &                     .TRUE., MatrixV(:,:,k,j), 'gather',nbp_glo, index_g)
+          ENDDO
+       ENDDO
+       ! If nothing is found in the restart file, we initialize each submatrix
+       ! by identity
+       IF (ALL(MatrixV(:,:,:,:) == val_exp))  THEN
+          MatrixV(:,:,:,:) = zero
+          DO l = 1,nbpools
+             MatrixV(:,:,l,l) = un
+          END DO
+       END IF
+
+
+       VectorU(:,:,:)  = val_exp
+       DO k= 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'Vector_U_'//part_str(1:LEN_TRIM(part_str))
+          CALL restget_p &
+               &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &     .TRUE., VectorU(:,:,k), 'gather', nbp_glo, index_g)
+          IF (ALL(VectorU(:,:,k) == val_exp))  VectorU(:,:,k) = zero
+       ENDDO
+
+       previous_stock(:,:,:)  = val_exp
+       DO k= 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'previous_stock_'//part_str(1:LEN_TRIM(part_str))
+          CALL restget_p &
+               &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &     .TRUE., previous_stock(:,:,k), 'gather', nbp_glo, index_g)
+          IF (ALL(previous_stock(:,:,k) == val_exp))  previous_stock(:,:,k) = undef_sechiba
+       ENDDO
+
+       current_stock(:,:,:)  = val_exp
+       DO k= 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'current_stock_'//part_str(1:LEN_TRIM(part_str))
+          CALL restget_p &
+               &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &     .TRUE., current_stock(:,:,k), 'gather', nbp_glo, index_g)
+          IF (ALL(current_stock(:,:,k) == val_exp))  current_stock(:,:,k) = zero
+       ENDDO
+
+       CN_som_litter_longterm(:,:,:)  = val_exp
+       DO k= 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'CN_longterm_'//part_str(1:LEN_TRIM(part_str))
+          CALL restget_p &
+               &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &     .TRUE., CN_som_litter_longterm(:,:,k), 'gather', nbp_glo,index_g)
+          IF (ALL(CN_som_litter_longterm(:,:,k) == val_exp))CN_som_litter_longterm(:,:,k) = zero
+       ENDDO
+
+       vartmp(1) = val_exp
+       var_name = 'tau_CN_longterm'
+       IF (is_root_prc) THEN
+          CALL restget (rest_id_stomate, var_name, 1 ,1  , 1, itime, &
+               .TRUE., vartmp)
+          IF (vartmp(1) == val_exp) THEN
+             tau_CN_longterm = dt_sechiba/one_day
+          ELSE
+             tau_CN_longterm = vartmp(1)
+          ENDIF   
+       ENDIF
+       CALL bcast(tau_CN_longterm)
+
+    ENDIF ! spinup_matrix_method
+
+    KF(:,:) = val_exp
+    CALL restget_p (rest_id_stomate, 'KF', nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., KF, 'gather', nbp_glo, index_g)
+    ! I don't want to set it equal to zero, since this is a problem if these
+    ! values are not here!  Better it blows up later on
+    !IF (ALL(KF(:,:) == val_exp)) KF(:,:) = zero
+
+    k_latosa_adapt(:,:) = val_exp
+    CALL restget_p (rest_id_stomate, 'k_latosa_adapt', nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., k_latosa_adapt, 'gather', nbp_glo, index_g)
+    DO m = 1,nvm
+       IF (ALL(k_latosa_adapt(:,m) == val_exp)) k_latosa_adapt(:,m) = k_latosa_min(m)
+    ENDDO
+
+    rue_longterm(:,:) = val_exp
+    var_name = 'rue_longterm'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+         &        .TRUE., rue_longterm(:,:), 'gather', nbp_glo, index_g)
+    IF (ALL(rue_longterm(:,:) == val_exp)) rue_longterm(:,:) = 1.
+
+    cn_leaf_min_season(:,:) = val_exp 
+    var_name = 'cn_leaf_min_season' 
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, & 
+         &              .TRUE., cn_leaf_min_season, 'gather', nbp_glo, index_g) 
+    IF ( ALL(cn_leaf_min_season(:,:) == val_exp) ) THEN 
+       DO m=1,nvm 
+          cn_leaf_min_season(:,m) = cn_leaf_init(m) 
+       ENDDO
+    ENDIF
+    
+    nstress_season(:,:) = val_exp 
+    var_name = 'nstress_season' 
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, & 
+         &              .TRUE., nstress_season, 'gather', nbp_glo, index_g) 
+    IF ( ALL(nstress_season(:,:) == val_exp) ) nstress_season(:,:)=1.0 
+    
+    CALL restget_p (rest_id_stomate, 'soil_n_min', nbp_glo, nvm, nnspec, itime, & 
+         &              .TRUE., soil_n_min, 'gather', nbp_glo, index_g) 
+!    IF ( ALL(soil_n_min == val_exp) ) soil_n_min(:,:,:)=100000000. 
+    IF ( ALL(soil_n_min == val_exp) ) soil_n_min(:,:,:)=0. 
+
+    p_O2(:,:) = val_exp 
+    var_name = 'p_O2'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, & 
+         &              .TRUE., p_O2(:,:), 'gather', nbp_glo, index_g) 
+    IF ( ALL(p_O2(:,:) == val_exp) ) p_O2(:,:)=200
+
+    bact(:,:) = val_exp 
+    var_name = 'bact'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, & 
+         &              .TRUE., bact(:,:), 'gather', nbp_glo, index_g) 
+    IF ( ALL(bact(:,:) == val_exp) ) bact(:,:)=10 
+    !-
+    temp_real(:,:) = val_exp
+    var_name = 'age_stand'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., temp_real, 'gather', nbp_glo, index_g)
+    IF ( ALL(temp_real(:,:) == val_exp) ) THEN
+       age_stand(:,:) = 0
+    ELSE
+       age_stand = NINT(temp_real)
+    ENDIF
+    !-
+    temp_real(:,:) = val_exp
+    var_name = 'rotation_n'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., temp_real, 'gather', nbp_glo, index_g)
+    IF ( ALL(temp_real(:,:) == val_exp) ) THEN
+       rotation_n(:,:) = 1
+    ELSE
+       rotation_n(:,:) = NINT(temp_real(:,:))
+    ENDIF
+    !-
+    temp_real(:,:) = val_exp
+    var_name = 'last_cut'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., temp_real, 'gather', nbp_glo, index_g)
+    IF ( ALL(temp_real(:,:) == val_exp) ) THEN
+       last_cut(:,:) = 0
+    ELSE
+       last_cut(:,:) = NINT(temp_real(:,:))
+    ENDIF
+    !-
+    mai(:,:) = val_exp
+    var_name = 'mai'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., mai, 'gather', nbp_glo, index_g)
+    IF ( ALL(mai(:,:) == val_exp) ) mai(:,:) = zero
+    !-
+    pai(:,:) = val_exp
+    var_name = 'pai'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., pai, 'gather', nbp_glo, index_g)
+    IF ( ALL(pai(:,:) == val_exp) ) pai(:,:) = zero
+    !-
+    previous_wood_volume(:,:) = val_exp
+    var_name = 'previous_wood_volume'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., previous_wood_volume, 'gather', nbp_glo, index_g)
+    IF ( ALL(previous_wood_volume(:,:) == val_exp) ) previous_wood_volume(:,:) = zero
+    !-
+    temp_real(:,:) = val_exp
+    var_name = 'mai_count'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., temp_real, 'gather', nbp_glo, index_g)
+    IF ( ALL(temp_real(:,:) == val_exp) ) THEN
+       mai_count(:,:) = 0
+    ELSE
+       mai_count = NINT(temp_real)
+    ENDIF
+    !-
+    coppice_dens(:,:) = val_exp
+    var_name = 'coppice_dens'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., coppice_dens, 'gather', nbp_glo, index_g)
+    IF ( ALL(coppice_dens(:,:) == val_exp) ) coppice_dens(:,:) = zero
+    !-
+    temp_real(:,:) = val_exp
+    var_name = 'fm_lyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., temp_real, 'gather', nbp_glo, index_g)
+    IF ( ALL(temp_real(:,:) == val_exp) ) THEN
+       forest_managed_lastyear(:,:) = 0
+    ELSE
+       forest_managed_lastyear = NINT(temp_real)
+    ENDIF
+
+    IF (.NOT.ok_change_species) THEN
+       ! In the abscence of a ok_change_species the model has to be
+       ! driven by a prescribed value for forest_managed. This
+       ! prescribed value can come from either a FMmap which is 
+       ! read in or a value for ::FOREST_MANAGED_FORCED. In these 
+       ! cases the values in the restart file are ignored.  
+    ELSE
+       ! We have a ok_change_species which implies that we only want
+       ! to read the FMmap once at the start of the simulation
+       ! after which forest_managed becomes a prognostic variable 
+       ! (as it may change after a clear cut) and therefore the 
+       ! values from the maps are ignored and the value from the 
+       ! restart is used except at the first time step.
+       temp_real(:,:) = val_exp
+       var_name = 'fm_current'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &              .TRUE., temp_real, 'gather', nbp_glo, index_g)
+       IF ( ALL(temp_real(:,:) == val_exp) ) THEN
+          ! This is the first time step. The restart is still empty
+          ! so use the values from the FMmap as read in stomate.f90
+          ! Nothing should be done
+       ELSE
+          ! As soon as there is something in the restart file these
+          ! values are used to overwrite the values that were read 
+          ! from the FMmap.
+          forest_managed = NINT(temp_real)
+       ENDIF
+       
+    END IF
+    
+    ! The routines don't like to store integer variables.  So instead
+    ! we create a real array.  If the value of the real array is one,
+    ! we assign a value of TRUE to the logical array.  Anything
+    ! else is .FALSE.
+    r_replant(:,:) = val_exp
+    var_name = 'sc_map'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+         &        .TRUE., r_replant(:,:), 'gather', nbp_glo, index_g)
+    DO ipts=1,npts
+       DO ivm=1,nvm
+          IF( r_replant(ipts,ivm) .LT. nvm*2)THEN
+             species_change_map(ipts,ivm)=NINT(r_replant(ipts,ivm))
+          ELSE
+             species_change_map(ipts,ivm)=0
+          ENDIF
+       ENDDO
+    ENDDO
+
+    r_replant(:,:) = val_exp
+    var_name = 'fmc_map'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+         &        .TRUE., r_replant(:,:), 'gather', nbp_glo, index_g)
+    DO ipts=1,npts
+       DO ivm=1,nvm
+          IF( r_replant(ipts,ivm) .LT. nvm*2)THEN
+             fm_change_map(ipts,ivm)=NINT(r_replant(ipts,ivm))
+          ELSE
+             fm_change_map(ipts,ivm)=0
+          ENDIF
+       ENDDO
+    ENDDO
+
+    ! read harvest_5y_area from restart file
+    harvest_5y_area(:,:,:) = val_exp
+    DO l=1,wind_years
+       WRITE(wyear_str(l),'(I2.2)') l
+       var_name = 'harvest_area_year_'//wyear_str(l)
+       !WRITE(numout,*) 'YC: 20160531: var_name for restart file', var_name
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., harvest_5y_area(:,:,l), 'gather', nbp_glo,index_g)
+       IF (ALL(harvest_5y_area(:,:,l) == val_exp)) harvest_5y_area(:,:,l)= zero
+    ENDDO
+
+
+
+    ! The routines don't like to store logical variables.  So instead
+    ! we create a real array.  If the value of the real array is one,
+    ! we assign a value of TRUE to the logical array.  Anything
+    ! else is .FALSE.
+    r_replant(:,:) = val_exp
+    var_name = 'lpft_replant'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+         &        .TRUE., r_replant(:,:), 'gather', nbp_glo, index_g)
+    DO ipts=1,npts
+       DO ivm=1,nvm
+          IF(ABS(r_replant(ipts,ivm) - un) .LT. 0.001)THEN
+             lpft_replant(ipts,ivm)=.TRUE.
+          ELSE
+             lpft_replant(ipts,ivm)=.FALSE.
+          ENDIF
+       ENDDO
+    ENDDO
+     
+    ! Read assim_param from restart file. The initialization of assim_param will 
+    ! be done in stomate_var_init if the variable is not in the restart file.
+    assim_param(:,:,:)  = val_exp
+    var_name = 'assim_param'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, npco2, itime, &
+         &     .TRUE., assim_param, 'gather', nbp_glo, index_g)
+
+ 
+    light_tran_to_level_season(:,:,:) = val_exp 
+    var_name = 'light_tran_season' 
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, nlevels_tot, itime, & 
+         &     .TRUE., light_tran_to_level_season, 'gather', nbp_glo, index_g) 
+    IF (ALL(light_tran_to_level_season(:,:,:) == val_exp)) light_tran_to_level_season = zero
+
+    IF (printlev >= 4) WRITE(numout,*) 'Leaving readrestart'
+    !-----------------------
+  END SUBROUTINE readstart
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : writerestart
+!!
+!>\BRIEF          Write all variables for stomate from restart file. 
+!!
+!! DESCRIPTION  : Write all variables for stomate from restart file. 
+!!                
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE writerestart &
+       & (npts, index, dt_days, date, &
+       &  adapted, regenerate, moiavail_daily, gdd_init_date, litterhum_daily, &
+       &  t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+       &  soilhum_daily, precip_daily, gpp_daily, npp_daily, &
+       &  turnover_daily, moiavail_month, moiavail_week, moiavail_growingseason,&
+       &  t2m_longterm, tau_longterm, t2m_month, t2m_week, &
+       &  tsoil_month, soilhum_month, fireindex, firelitter, &
+       &  maxmoiavail_lastyear, maxmoiavail_thisyear, &
+       &  minmoiavail_lastyear, minmoiavail_thisyear, &
+       &  maxgppweek_lastyear, maxgppweek_thisyear, &
+       &  gdd0_lastyear, gdd0_thisyear, precip_lastyear, precip_thisyear, &
+       &  gdd_m5_dormance, gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       &  PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+       &  maxfpc_lastyear, maxfpc_thisyear, &
+       &  turnover_longterm, gpp_week, resp_maint_part, &
+       &  leaf_age, leaf_frac, plant_status, when_growthinit, age, &
+       &  resp_hetero, resp_maint, resp_growth, co2_fire, atm_to_bm, &
+       &  veget_lastlight, everywhere, need_adjacent, RIP_time, &
+       &  time_hum_min, hum_min_dormance, &
+       &  litter, dead_leaves, &
+       &  som, lignin_struc, lignin_wood, turnover_time, &
+       &  prod_s, prod_m, prod_l, &
+       &  flux_s, flux_m, flux_l, flux_prod_s, flux_prod_m, &
+       &  flux_prod_l, bm_to_litter, carb_mass_total, &
+       &  Tseason, Tseason_length, Tseason_tmp, & 
+       &  Tmin_spring_time, onset_date, &
+       &  global_years, ok_equilibrium, nbp_accu, nbp_flux, &
+       &  nbp_accu_pool, nbp_pool, nbp_pool_start, &
+       &  MatrixV, VectorU, previous_stock, current_stock, &
+       &  assim_param, CN_som_litter_longterm, &
+       &  tau_CN_longterm, KF, k_latosa_adapt, &
+       &  rue_longterm, cn_leaf_min_season, nstress_season, soil_n_min, p_O2, bact, &
+       &  circ_class_biomass, circ_class_n, store_sum_delta_ba, &
+       &  forest_managed, forest_managed_lastyear, &
+       &  species_change_map, fm_change_map, lpft_replant, lai_per_level, &
+       &  laieff_fit, wstress_season, wstress_month,&
+       &  age_stand, rotation_n, last_cut, mai, pai, &
+       &  previous_wood_volume, mai_count, coppice_dens, &
+       &  light_tran_to_level_season, harvest_5y_area)
+
+
+    ! 0 declarations
+    !-
+    ! 0.1 input
+    !-
+    ! Domain size
+    INTEGER(i_std),INTENT(in) :: npts
+    ! Indices of the points on the map
+    INTEGER(i_std),DIMENSION(npts),INTENT(in) :: index
+    ! time step of STOMATE in days
+    REAL(r_std),INTENT(in) :: dt_days
+    ! date (d)
+    INTEGER(i_std),INTENT(in) :: date
+    ! Winter too cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: adapted
+    ! Winter sufficiently cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: regenerate
+    ! daily moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_daily
+    ! gdd init date
+    REAL(r_std),DIMENSION(npts,2),INTENT(in) :: gdd_init_date
+    ! daily litter humidity
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: litterhum_daily
+    ! daily 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_daily
+    ! daily minimum 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_min_daily
+    ! daily surface temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: tsurf_daily
+    ! daily soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: tsoil_daily
+    ! daily soil humidity
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: soilhum_daily
+    ! daily precipitations (mm/day) (for phenology)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_daily
+    ! daily gross primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gpp_daily
+    ! daily net primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: npp_daily
+    ! daily turnover rates (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: turnover_daily
+    ! "monthly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_month
+    ! "weekly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_week
+    ! mean growing season moisture availability 
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_growingseason
+    ! "long term" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_longterm
+    ! "tau_longterm"
+    REAL(r_std), INTENT(IN)             :: tau_longterm
+    ! "monthly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_month
+    ! "seasonal" 2 meter temperatures (K) 
+    REAL(r_std),DIMENSION(npts),INTENT(in)      :: Tseason
+    ! temporary variable to calculate Tseason
+    REAL(r_std),DIMENSION(npts),INTENT(in)      :: Tseason_length
+    ! temporary variable to calculate Tseason
+    REAL(r_std),DIMENSION(npts),INTENT(in)      :: Tseason_tmp
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)  :: Tmin_spring_time
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)  :: onset_date
+!!$    LOGICAL,DIMENSION(npts,nvm),INTENT(in)      :: begin_leaves
+
+    ! "weekly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_week
+    ! "monthly" soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: tsoil_month
+    ! "monthly" soil humidity
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: soilhum_month
+    ! Probability of fire
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: fireindex
+    ! Longer term total litter above the ground, gC/m**2 of ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: firelitter
+    ! last year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxmoiavail_lastyear
+    ! this year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxmoiavail_thisyear
+    ! last year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: minmoiavail_lastyear
+    ! this year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: minmoiavail_thisyear
+    ! last year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxgppweek_lastyear
+    ! this year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxgppweek_thisyear
+    ! last year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: gdd0_lastyear
+    ! this year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: gdd0_thisyear
+    ! last year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_lastyear
+    ! this year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_thisyear
+    ! growing degree days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_m5_dormance
+    ! growing degree days, from begin of season (crops)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_from_growthinit
+    ! growing degree days since midwinter (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_midwinter
+    ! number of chilling days since leaves were lost (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ncd_dormance
+    ! number of growing days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ngd_minus5
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: PFTpresent
+    ! "long term" net primary productivity (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: npp_longterm
+    ! last year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: lm_lastyearmax
+    ! this year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: lm_thisyearmax
+    ! last year's maximum fpc for each natural PFT, on ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxfpc_lastyear
+    ! this year's maximum fpc for each PFT,
+    ! on *total* ground (see stomate_season)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxfpc_thisyear
+    ! "long term" turnover rate (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: turnover_longterm
+    ! "weekly" GPP (gC/day/(m**2 covered)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gpp_week
+    ! 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
+    ! Growth and phenological status of the plant
+    ! The different stati are defined in constantes
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: plant_status
+    ! 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 taken from the atmosphere (gC or gN/(m**2 of total ground)/day)
+    REAL(r_std),DIMENSION(npts,nvm,nelements),INTENT(in) :: atm_to_bm
+    ! vegetation fractions (on ground) after last light competition
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: veget_lastlight
+    ! is the PFT everywhere in the grid box or very localized
+    ! (after its introduction)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: everywhere
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box?
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: need_adjacent
+    ! How much time ago was the PFT eliminated for the last time (y)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: RIP_time
+    ! time elapsed since strongest moisture availability (d)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: time_hum_min
+    ! minimum moisture during dormance
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: hum_min_dormance
+    ! fraction of litter above the ground belonging to different PFTs
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs,nelements),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
+    ! SOM pool: active, slow, or passive, (gC(orN)/m**2)
+    REAL(r_std),DIMENSION(npts,ncarb,nvm,nelements),INTENT(in) :: som
+    ! 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
+    ! ratio Lignine/Carbon in woody litter, above and below ground, (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nlevs),INTENT(in) :: lignin_wood
+    ! turnover_time of leaves
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: turnover_time
+
+    INTEGER(i_std), DIMENSION(npts,nvm), INTENT(in)                    :: age_stand               !! Age of stand (years)
+    INTEGER(i_std), DIMENSION(npts,nvm), INTENT(in)                    :: rotation_n              !! Rotation number (number of rotation 
+                                                                                                  !! since pft is managed)
+    INTEGER(i_std), DIMENSION(npts,nvm), INTENT(in)                    :: last_cut                !! Years since last thinning (years)
+    
+
+    ! For Spinup matrix resolution
+    INTEGER(i_std), INTENT(in)                   :: global_years   
+    LOGICAL, DIMENSION(npts), INTENT(in)         :: ok_equilibrium
+    REAL(r_std), DIMENSION(npts), INTENT(in)     :: nbp_accu        !! Accumulated Net Biospheric Production over the year 
+    REAL(r_std), DIMENSION(npts), INTENT(in)     :: nbp_flux        !! Net Biospheric Production over the year 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: nbp_accu_pool   !! Pool-based Accumulated Net Biospheric Production over the year 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: nbp_pool        !! Pool-based Net Biospheric Production over the year 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: nbp_pool_start !! NBP atprevious time step
+    !-
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(in) :: MatrixV
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(in) :: VectorU
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(in) :: previous_stock
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(in) :: current_stock
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(in) :: CN_som_litter_longterm
+    REAL(r_std), INTENT(in)                              :: tau_CN_longterm  !! Counter used for calculating the longterm CN ratio of SOM and litter pools (seconds)
+    REAL(r_std), DIMENSION(npts,nvm,npco2),   INTENT(in) :: assim_param
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)         :: KF                !! Scaling factor to convert sapwood mass
+                                                                              !! into leaf mass (m)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)         :: k_latosa_adapt    !! Leaf to sapwood area adapted for water  
+                                                                              !! stress. Adaptation takes place at the  
+                                                                              !! end of the year (m)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                       :: mai                     !! The mean annual increment
+                                                                                                  !! @tex $(m**3 / m**2 / year)$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                       :: pai                     !! The period annual increment
+                                                                                                  !! @tex $(m**3 / m**2 / year)$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                       :: previous_wood_volume    !! The volume of the tree trunks
+                                                                                                  !! in a stand for the previous year.
+                                                                                                  !! @tex $(m**3 / m**2 )$ @endtex
+    INTEGER(i_std), DIMENSION(npts,nvm),INTENT(in)                     :: mai_count               !! The number of times we've
+                                                                                                  !! calculated the volume increment
+                                                                                                  !! for a stand
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(in)                        :: coppice_dens            !! The density of a coppice at the first
+                                                                                                  !! cutting.
+                                                                                                  !! @tex $( 1 / m**2 )$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)         :: rue_longterm      !! Longterm radiation use efficiency
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)         :: cn_leaf_min_season    !! Seasonal CN ratio of leaves 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)         :: nstress_season    !! N-related seasonal stress (used for allocation) 
+    
+    REAL(r_std), DIMENSION(npts,nvm,nnspec), INTENT(in)  :: soil_n_min        !! mineral nitrogen in the soil (gN/m**2)  
+                                                                              !! (first index=npts, second index=nvm, third index=nnspec)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)        :: p_O2               !! partial pressure of oxygen in the soil (hPa)
+                                                                              !! (first index=npts, second index=nvm)
+                                                        
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)        :: bact               !! denitrifier biomass (gC/m**2)
+                                                                              !! (first index=npts, second index=nvm)
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(in)                 :: circ_class_n            !! Number of trees in each circumference classes
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), INTENT(in):: circ_class_biomass      !! Biomass components of the model tree within 
+                                                                                                  !! each circumference classes (gC ind-1)
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(in)                 :: store_sum_delta_ba      !! Sum of increase of basal area(m^2) which
+                                                                                                  !! doesn't pass through the gap clean
+    REAL(r_std), DIMENSION(npts,nvm,nlevels_tot), INTENT(in)           :: lai_per_level           !! The amount of LAI in each physical
+                                                                                                  !! canopy level.
+                                                                                                  !! @tex $( m**2 / m**2 )$ @endtex
+    TYPE(laieff_type),DIMENSION (:,:,:),INTENT(in)                     :: laieff_fit              !! Fitted parameters for the effective LAI
+
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                            :: wstress_season          !! Water stress factor, based on hum_rel_daily
+                                                                                                  !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                            :: wstress_month           !! Water stress factor, based on hum_rel_daily
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in)        :: bm_to_litter
+    REAL(r_std),DIMENSION(npts),INTENT(in)                             :: carb_mass_total
+    INTEGER(i_std), DIMENSION(npts,nvm), INTENT(in)                    :: forest_managed          !! forest management flag
+    INTEGER(i_std), DIMENSION(npts,nvm), INTENT(in)                    :: forest_managed_lastyear !! forest management flag for the previous year
+    REAL(r_std), DIMENSION(npts,0:nshort,nelements), INTENT(in)        :: prod_s                  !!
+    REAL(r_std), DIMENSION(npts,0:nmedium,nelements), INTENT(in)       :: prod_m                  !!
+    REAL(r_std), DIMENSION(npts,0:nlong,nelements), INTENT(in)         :: prod_l                  !!
+    REAL(r_std), DIMENSION(npts,nshort,nelements), INTENT(in)          :: flux_s                  !!
+    REAL(r_std), DIMENSION(npts,nmedium,nelements), INTENT(in)         :: flux_m                  !!
+    REAL(r_std), DIMENSION(npts,nlong,nelements), INTENT(in)           :: flux_l                  !!
+    REAL(r_std), DIMENSION(npts,nelements), INTENT(in)                 :: flux_prod_s             !!
+    REAL(r_std), DIMENSION(npts,nelements), INTENT(in)                 :: flux_prod_m             !!
+    REAL(r_std), DIMENSION(npts,nelements), INTENT(in)                 :: flux_prod_l             !!
+    INTEGER(i_std), DIMENSION(:,:), INTENT(in)                         :: species_change_map      !! A map which gives the PFT number that each
+                                                                                                  !! PFT will be replanted as in case of a clearcut.
+                                                                                                  !! (1-nvm,unitless)
+    INTEGER(i_std), DIMENSION(:,:), INTENT(in)                         :: fm_change_map           !! A map which gives the desired FM strategy when
+                                                                                                  !! the PFT will be replanted after a clearcut.
+                                                                                                  !! (1-nvm,unitless)
+    LOGICAL, DIMENSION(:,:), INTENT(in)                                :: lpft_replant            !! Indicates if this PFT has either died this year
+                                                                                                  !! or been clearcut/coppiced.  If it has, it is not
+                                                                                                  !! replanted until the end of the year.
+    REAL(r_std), DIMENSION(npts,nvm,nlevels_tot), INTENT(in)           :: light_tran_to_level_season  !! Mean seasonal fraction of light transmitted to
+                                                                                                  !! a given canopy level (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)                          :: harvest_5y_area         !! Total harvested area in the last 5 years (m^{2})
+
+   !! 0.4 Local variables
+    ! 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
+    ! 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) :: circ_str 
+    ! string suffix indicating an index
+    CHARACTER(LEN=10) :: part_str
+    ! string suffix indicating litter type
+    CHARACTER(LEN=4),DIMENSION(nlitt) :: litter_str
+    ! string suffix indicating level
+    CHARACTER(LEN=2),DIMENSION(nlevs) :: level_str
+    ! temporary storage
+    REAL(r_std), DIMENSION(npts) :: ok_equilibrium_real    
+    REAL(r_std),DIMENSION(1) :: xtmp
+    REAL(r_std), DIMENSION(1) :: vartmp  !! temporary variable because restget/restput needs a variable with DIMESION(:)
+    ! index
+    INTEGER(i_std) :: j,k,l,m
+    CHARACTER(LEN=2),DIMENSION(nelements) :: element_str  !! string suffix indicating element
+    REAL(r_std), DIMENSION(1) :: temp_global_years
+    CHARACTER(LEN=6),DIMENSION(nbpools) :: pools_str
+    INTEGER                                                             :: n,ilev,ipts,ivm         !! Indices
+    REAL(r_std), DIMENSION(npts,nvm)                                    :: temp_real               !! temporary real to allow restget 
+                                                                                                   !! to work on multi-dimensional integers
+    REAL(r_std), DIMENSION(npts,nvm)                                    :: r_replant               !! Getting logical values from the restart
+                                                                                                   !! is not possible, so this is a temporary
+                                                                                                   !! array where 1.0 is TRUE.
+    REAL(r_std),DIMENSION(npts,nvm,nlevels_tot,nparams_laieff)          :: temp_array              !! To store structure values for I/O
+    CHARACTER(LEN=10)                                                   :: part_str2               !! string suffix indicating an index
+    
+    CHARACTER(LEN=2), DIMENSION(wind_years)                             :: wyear_str               !! string suffix indicating wind year index
+
+
+!_ ================================================================================================================================
+
+    IF (printlev >= 3) WRITE(numout,*) 'Entering writerestart'
+    !-
+    ! 1 string definitions
+    !-
+    DO l=1,nlitt
+       IF     (l == imetabolic) THEN
+          litter_str(l) = 'met'
+       ELSEIF (l == istructural) THEN
+          litter_str(l) = 'str'
+       ELSEIF (l == iwoody) THEN
+          litter_str(l) = 'wood'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io writerestart','Define litter_str','','')
+       ENDIF
+    ENDDO
+    !-
+    DO l=1,nlevs
+       IF     (l == iabove) THEN
+          level_str(l) = 'ab'
+       ELSEIF (l == ibelow) THEN
+          level_str(l) = 'be'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io writerestart','Define level_str','','')
+       ENDIF
+    ENDDO
+    !-
+    DO l=1,nelements
+       IF     (l == icarbon) THEN
+          element_str(l) = ''
+       ELSEIF (l == initrogen) THEN
+          element_str(l) = '_n'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io writerestart','Define element_str','','')
+       ENDIF
+    ENDDO
+    !-
+    pools_str(1:nbpools) =(/'str_ab ','str_be ','met_ab ','met_be ','wood_ab','wood_be', & 
+         & 'actif  ','slow   ','passif ','surface'/) 
+    !-
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p ('UNITS','-')
+       CALL ioconf_setatt_p ('LONG_NAME',' ')
+    ENDIF
+    !-
+    ! 2 run control
+    !-
+    ! 2.2 time step of STOMATE in days
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'dt_days'
+       xtmp(1) = dt_days
+       CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, xtmp)
+    ENDIF
+    !-
+    ! 2.3 date
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'date'
+       date_real = REAL(date,r_std)
+       xtmp(1) = date_real
+       CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, xtmp)
+    ENDIF
+    !-
+    ! 3 daily meteorological variables
+    !-
+    var_name = 'moiavail_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                moiavail_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd_init_date'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    2, 1, itime, &
+         &              gdd_init_date, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'litterhum_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                litterhum_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 't2m_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 't2m_min_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_min_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'tsurf_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                tsurf_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'tsoil_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
+         &                tsoil_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'soilhum_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
+         &                soilhum_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'precip_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                precip_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'wstress_season'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                wstress_season, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'wstress_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                wstress_month, '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)
+    !-
+
+    var_name = 'turnover_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nparts, nelements, itime, &
+         &                turnover_daily, 'scatter', nbp_glo, index_g)
+
+    !-
+    ! 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 = 'moiavail_grow'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                moiavail_growingseason, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 't2m_longterm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_longterm, 'scatter', nbp_glo, index_g)
+    
+    IF (is_root_prc) THEN
+       var_name='tau_longterm'
+       vartmp(1)=tau_longterm
+       CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, vartmp)
+    ENDIF
+       
+
+    var_name = 't2m_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+                         t2m_month, 'scatter', nbp_glo, index_g)
+    
+
+    CALL restput_p (rest_id_stomate, 'Tseason', nbp_glo,    1, 1, itime, &
+         Tseason, 'scatter', nbp_glo, index_g)
+    
+    CALL restput_p (rest_id_stomate, 'Tseason_length', nbp_glo,    1, 1, itime, &
+         Tseason_length, 'scatter', nbp_glo, index_g)
+    
+    CALL restput_p (rest_id_stomate, 'Tseason_tmp', nbp_glo,    1, 1, itime, &
+         Tseason_tmp, 'scatter', nbp_glo, index_g)
+    
+    CALL restput_p (rest_id_stomate, 'Tmin_spring_time', nbp_glo, nvm, 1, itime, &
+         Tmin_spring_time, 'scatter', nbp_glo, index_g)
+    
+    CALL restput_p (rest_id_stomate, 'onset_date', nbp_glo, nvm, 1, itime, &
+         onset_date, 'scatter', nbp_glo, index_g)
+    
+    var_name = 't2m_week'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_week, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'tsoil_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
+         &                tsoil_month, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'soilhum_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
+         &                soilhum_month, 'scatter', nbp_glo, index_g)
+    !-
+    ! 6 fire probability
+    !-
+    var_name = 'fireindex'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                fireindex, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'firelitter'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                firelitter, 'scatter', nbp_glo, index_g)
+    !-
+    ! 7 maximum and minimum moisture availabilities for tropic phenology
+    !-
+    var_name = 'maxmoistr_last'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxmoiavail_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxmoistr_this'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxmoiavail_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'minmoistr_last'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                minmoiavail_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'minmoistr_this'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                minmoiavail_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 8 maximum "weekly" GPP
+    !-
+    var_name = 'maxgppweek_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxgppweek_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxgppweek_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxgppweek_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 9 annual GDD0
+    !-
+    var_name = 'gdd0_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                gdd0_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd0_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                gdd0_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 10 annual precipitation
+    !-
+    var_name = 'precip_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                precip_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'precip_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                precip_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 11 derived "biometeorological" variables
+    !-
+    var_name = 'gdd_m5_dormance'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gdd_m5_dormance, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd_from_growthinit'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              gdd_from_growthinit, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd_midwinter'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gdd_midwinter, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'ncd_dormance'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                ncd_dormance, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'ngd_minus5'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                ngd_minus5, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'time_hum_min'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                time_hum_min, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'hum_min_dormance'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                hum_min_dormance, 'scatter', nbp_glo, index_g)
+    !-
+    ! 12 Plant status
+    !-
+    var_name = 'PFTpresent'
+    WHERE ( PFTpresent(:,:) )
+       PFTpresent_real = un
+    ELSEWHERE
+       PFTpresent_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                PFTpresent_real, 'scatter', nbp_glo, index_g)
+    !-
+    !var_name = 'ind'
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+    !     &                ind, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'turnover_time'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                turnover_time, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'adapted'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                adapted, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'regenerate'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                regenerate, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'npp_longterm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                npp_longterm, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'lm_lastyearmax'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                lm_lastyearmax, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'lm_thisyearmax'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                lm_thisyearmax, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxfpc_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxfpc_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxfpc_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxfpc_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'turnover_longterm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nparts, nelements, itime, &
+         &                turnover_longterm, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gpp_week'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gpp_week, 'scatter', nbp_glo, index_g)
+    !-
+    !var_name = 'biomass'
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nparts, nelements, itime, &
+    !     &                   biomass, 'scatter', nbp_glo, index_g)
+
+    !-
+    var_name = 'maint_resp'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nparts, itime, &
+         &                   resp_maint_part, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'leaf_age'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nleafages, itime, &
+         &                  leaf_age, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'leaf_frac'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nleafages, itime, &
+         &                   leaf_frac, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'lai_per_level'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nlevels_tot, itime, &
+         &                   lai_per_level, 'scatter', nbp_glo, index_g)
+    !
+    DO ipts=1,npts
+       DO ivm=1,nvm
+          DO ilev=1,nlevels_tot
+             temp_array(ipts,ivm,ilev,1)=laieff_fit(ipts,ivm,ilev)%a
+             temp_array(ipts,ivm,ilev,2)=laieff_fit(ipts,ivm,ilev)%b
+             temp_array(ipts,ivm,ilev,3)=laieff_fit(ipts,ivm,ilev)%c
+             temp_array(ipts,ivm,ilev,4)=laieff_fit(ipts,ivm,ilev)%d
+             temp_array(ipts,ivm,ilev,5)=laieff_fit(ipts,ivm,ilev)%e
+          ENDDO
+       ENDDO
+    ENDDO
+    DO m=1,nlevels_tot
+       WRITE(part_str,'(I2)') m
+       IF ( m < 10 ) part_str(1:1) = '0'
+       DO n=1,nparams_laieff
+          WRITE(part_str2,'(I2)') n
+          IF ( n < 10 ) part_str2(1:1) = '0'
+
+          var_name = 'laieff_fit_'//part_str(1:LEN_TRIM(part_str)) // '_' &
+               // part_str2(1:LEN_TRIM(part_str2))
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                   temp_array(:,:,m,n), 'scatter', nbp_glo, index_g)
+       ENDDO
+    ENDDO
+    !-
+    var_name = 'circ_class_n'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, ncirc, itime, &
+         &                   circ_class_n, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'store_sum_delta_ba'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, ncirc, itime, &
+         &                   store_sum_delta_ba, 'scatter', nbp_glo, index_g)
+    !-
+    DO m = 1,nelements
+       var_name = 'cc_biomass_'//TRIM(element_str(m))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, ncirc, nparts, itime, &
+          &         circ_class_biomass(:,:,:,:,m), 'scatter', nbp_glo, index_g)
+    ENDDO
+   !-
+    var_name = 'plant_status'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                plant_status, '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 = 'atm_to_bm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nelements, itime, &
+         &                atm_to_bm, 'scatter', nbp_glo, index_g)
+
+    !-
+    ! 14 vegetation distribution after last light competition
+    !-
+    var_name = 'veget_lastlight'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                veget_lastlight, 'scatter', nbp_glo, index_g)
+    !-
+    ! 15 establishment criteria
+    !-
+    var_name = 'everywhere'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                everywhere, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'need_adjacent'
+    WHERE (need_adjacent(:,:))
+       need_adjacent_real = un
+    ELSEWHERE
+       need_adjacent_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                need_adjacent_real, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'RIP_time'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                RIP_time, 'scatter', nbp_glo, index_g)
+    !-
+    ! 17 litter
+    !-
+    DO k = 1,nelements
+        var_name = 'litter_'//element_str(k)
+        CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, nvm, nlevs, itime, &
+             &                     litter(:,:,:,:,k), 'scatter', nbp_glo, index_g)
+    END DO
+    !-
+    var_name = 'dead_leaves'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nlitt, itime, &
+         &                   dead_leaves, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'soil_carbon'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, nvm, itime, &
+         &                   som(:,:,:,icarbon), 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'soil_nitrogen' 
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, nvm, itime, & 
+         &                   som(:,:,:,initrogen), 'scatter', nbp_glo, index_g) 
+    !- 
+    var_name = 'lignin_struc'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nlevs, itime, &
+         &       lignin_struc, 'scatter', nbp_glo, index_g)
+    !- 
+    var_name = 'lignin_wood'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nlevs, itime, &
+         &       lignin_wood, 'scatter', nbp_glo, index_g)
+    !-
+    ! 18 land cover change
+    !-
+    var_name = 'prod_s'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nshort+1, nelements, itime, &
+         &                prod_s, 'scatter', nbp_glo, index_g)
+
+    var_name = 'prod_m'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nmedium+1, nelements, itime, &
+         &                prod_m, 'scatter', nbp_glo, index_g)
+
+    var_name = 'prod_l'   
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlong+1, nelements, itime, &
+         &                prod_l, 'scatter', nbp_glo, index_g)
+
+    var_name = 'flux_s'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nshort, nelements, itime, &
+         &                flux_s, 'scatter', nbp_glo, index_g)
+    
+    var_name = 'flux_m'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nmedium, nelements, itime, &
+         &                flux_m, 'scatter', nbp_glo, index_g)
+
+    var_name = 'flux_l'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlong, nelements, itime, &
+         &                flux_l, 'scatter', nbp_glo, index_g)
+
+    var_name = 'flux_prod_s'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nelements, 1, itime, &
+         &              flux_prod_s, 'scatter', nbp_glo, index_g)
+
+    var_name = 'flux_prod_m'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nelements, 1, itime, &
+         &              flux_prod_m, 'scatter', nbp_glo, index_g)
+    
+    var_name = 'flux_prdo_l'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nelements, 1, itime, &
+         &              flux_prod_l, 'scatter', nbp_glo, index_g)
+
+    var_name = 'bm_to_litter'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nparts, nelements, itime, &
+         &                bm_to_litter, 'scatter', nbp_glo, index_g)
+
+    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)
+
+
+! put the harvest_5y_area to the restart file
+    DO l=1,wind_years
+       WRITE(wyear_str(l),'(I2.2)') l
+       var_name = 'harvest_area_year_'//wyear_str(l)
+       !WRITE(numout,*) 'YC: 20160531: var_name for restart file', var_name
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     harvest_5y_area(:,:,l), 'scatter', nbp_glo, index_g)
+    ENDDO
+
+
+
+
+    !-
+    ! 19. Spinup
+    !-
+    IF (spinup_analytic) THEN
+
+       IF (is_root_prc) THEN
+          temp_global_years(1) = REAL(global_years)
+          var_name='Global_years'
+          CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, temp_global_years)
+       ENDIF
+       
+       var_name = 'nbp_sum'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+            &              nbp_accu, 'scatter', nbp_glo, index_g)
+
+       var_name = 'nbp_flux'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+            &              nbp_flux, 'scatter', nbp_glo, index_g)
+
+       var_name = 'nbp_accu_pool'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &              nbp_accu_pool, 'scatter', nbp_glo, index_g)
+
+       var_name = 'nbp_pool'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &              nbp_pool, 'scatter', nbp_glo, index_g)
+
+       var_name = 'nbp_pool_start'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &              nbp_pool_start, 'scatter', nbp_glo, index_g)
+
+       var_name = 'ok_equilibrium'
+       WHERE(ok_equilibrium(:))
+          ok_equilibrium_real = un
+       ELSEWHERE
+          ok_equilibrium_real = zero
+       ENDWHERE
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+            &               ok_equilibrium_real, 'scatter', nbp_glo, index_g)
+       
+       DO k = 1,nbpools
+          DO j = 1,nbpools
+             WRITE(part_str,'(I2)') k
+             IF (k < 10) part_str(1:1) = '0'
+             var_name = 'MatrixV_'//part_str(1:LEN_TRIM(part_str))//'_'//TRIM(pools_str(j))
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime,&
+                  &                MatrixV(:,:,k,j), 'scatter', nbp_glo,index_g)
+          ENDDO
+       ENDDO
+
+       DO k = 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'Vector_U_'//part_str(1:LEN_TRIM(part_str))
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                VectorU(:,:,k), 'scatter', nbp_glo, index_g)
+       ENDDO
+
+       DO k = 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'previous_stock_'//part_str(1:LEN_TRIM(part_str))
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                previous_stock(:,:,k), 'scatter', nbp_glo,index_g)
+       ENDDO
+       
+       DO k = 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'current_stock_'//part_str(1:LEN_TRIM(part_str))
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                current_stock(:,:,k), 'scatter', nbp_glo,index_g)
+       ENDDO
+
+       DO k = 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'CN_longterm_'//part_str(1:LEN_TRIM(part_str))
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                CN_som_litter_longterm(:,:,k), 'scatter',nbp_glo, index_g)
+       ENDDO
+
+       IF (is_root_prc) THEN
+          var_name='tau_CN_longterm'
+          vartmp(1)=tau_CN_longterm
+          CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, vartmp)
+       ENDIF
+            
+    ENDIF !(spinup_analytic)
+
+    !-
+    var_name = 'KF'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+          &              KF(:,:), 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'k_latosa_adapt'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+          &              k_latosa_adapt(:,:), 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'rue_longterm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+          &              rue_longterm(:,:), 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'cn_leaf_min_season' 
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, & 
+         &              cn_leaf_min_season(:,:), 'scatter', nbp_glo, index_g) 
+    !- 
+    var_name = 'nstress_season' 
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, & 
+         &              nstress_season(:,:), 'scatter', nbp_glo, index_g) 
+    !- 
+    var_name = 'soil_n_min' 
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nnspec, itime, & 
+         &              soil_n_min, 'scatter', nbp_glo, index_g) 
+    !- 
+    var_name = 'p_O2' 
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, & 
+         &              p_O2(:,:), 'scatter', nbp_glo, index_g) 
+    !- 
+    var_name = 'bact' 
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, & 
+         &              bact(:,:), 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'age_stand'
+    temp_real = REAL(age_stand,r_std)
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              temp_real, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'rotation_n'
+    temp_real = REAL(rotation_n,r_std)  
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              temp_real, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'last_cut'
+    temp_real = REAL(last_cut,r_std)
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              temp_real, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'mai'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              mai, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'pai'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              pai, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'coppice_dens'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              coppice_dens, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'previous_wood_volume'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              previous_wood_volume, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'mai_count'
+    temp_real = REAL(mai_count,r_std)
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              temp_real, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'fm_lyear'
+    temp_real = REAL(forest_managed_lastyear,r_std)
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              temp_real, 'scatter', nbp_glo, index_g)
+    
+    var_name = 'fm_current'
+    temp_real = REAL(forest_managed,r_std)
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              temp_real, 'scatter', nbp_glo, index_g)
+    !- 
+    ! For these next three variables, we have to convert to a real array first.
+    r_replant(:,:)=REAL(species_change_map(:,:),r_std)
+    var_name = 'sc_map'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              r_replant, 'scatter', nbp_glo, index_g)
+    
+    r_replant(:,:)=REAL(fm_change_map(:,:),r_std)
+    var_name = 'fmc_map'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              r_replant, 'scatter', nbp_glo, index_g)
+
+    DO ipts=1,npts
+       DO ivm=1,nvm
+          IF(lpft_replant(ipts,ivm))THEN
+             r_replant(ipts,ivm)=un
+          ELSE
+             r_replant(ipts,ivm)=zero
+          ENDIF
+       END DO
+    END DO
+    var_name = 'lpft_replant'
+    CALL restput_p(rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              r_replant, 'scatter', nbp_glo, index_g)
+
+    var_name = 'assim_param'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, npco2, itime, &
+         &                assim_param, 'scatter', nbp_glo, index_g)
+
+    ! 21 Seasonal mean transmitted light for recruitment in DOFOCO  
+    var_name = 'light_tran_season' 
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, nlevels_tot, itime, & 
+ 	&                   light_tran_to_level_season, 'scatter', nbp_glo, index_g)
+
+
+    IF (printlev >= 4) WRITE(numout,*) 'Leaving writerestart'
+    !--------------------------
+
+  END SUBROUTINE writerestart
+  !-
+  !===
+  !-
+END MODULE stomate_io
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_kill.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_kill.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_kill.f90	(revision 6412)
@@ -0,0 +1,1657 @@
+! =================================================================================================================================
+! MODULE       : stomate_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       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 replaces lpj_gap/kill.  Biomass actually
+!! dies here and is moved to the litter pools.  This does not work with the DGVM
+!! at the moment.
+!!
+!! 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: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-DOFOCO/ORCHIDEE/src_stomate/stomate_kill.f90 $
+!! $Date: 2013-09-27 09:59:24 +0200 (Fri, 27 Sep 2013) $
+!! $Revision: 1485 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_kill
+
+  ! modules used:
+
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE ioipsl_para 
+  USE stomate_prescribe
+  USE stomate_mark_kill,      ONLY : distribute_mortality_biomass
+  USE function_library,       ONLY : nmax, wood_to_dia, check_surface_area, &
+                                     check_mass_balance, sort_circ_class_biomass, &
+                                     cc_to_biomass
+  USE sapiens_lcchange,       ONLY : merge_biomass_pfts
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC natural_mortality, natural_mortality_clear, mortality_clean
+  
+  ! Variable declaration 
+
+  LOGICAL, SAVE             :: firstcall = .TRUE.     !! first call flag
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : natural_mortality_clear
+!!
+!>\BRIEF        Set the firstcall flag back to .TRUE. to prepare for the next simulation.
+!_ ================================================================================================================================
+  
+  SUBROUTINE natural_mortality_clear
+     firstcall = .TRUE.
+  END SUBROUTINE natural_mortality_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : natural_mortality
+!!
+!>\BRIEF        Transfer dead biomass to litter and update stand density for trees
+!!              which die of natural causes.
+!!
+!! DESCRIPTION  : This routine has a simple purpose: kill individuals by natural causes.  
+!!   The variable circ_class_kill indicates how many individuals need to be killed by the various
+!!   processes in the code, and is calculated in other modules. natural_mortality takes
+!!   this variable and decides on the correct order of which to actually kill the
+!!   trees, making sure that we don't double count.  
+!!
+!! RECENT CHANGE(S): 
+!!
+!! MAIN OUTPUT VARIABLE(S): ::circ_class_biomass; ::circ_class_n density of individuals, 
+!! ::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 natural_mortality (npts,  bm_to_litter, &
+       circ_class_biomass, circ_class_kill, circ_class_n, &
+       veget_cov_max, biomass_cut)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                                   :: npts               !! Domain size (-)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                   :: veget_cov_max          !! Maximum fraction of vegetation type 
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables   
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), &                         
+                                              INTENT(inout)      :: circ_class_biomass !! Biomass of the components of the model  
+                                                                                       !! tree within a circumference
+                                                                                       !! class @tex $(gC ind^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(inout)        :: circ_class_n       !! Number of individuals in each circ class
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nfm_types,ncut_times),&
+                                                  INTENT(inout)  :: circ_class_kill    !! Number of trees within a circ that needs
+                                                                                       !! to be killed @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), &
+                                                  INTENT(inout)  :: bm_to_litter       !! Biomass transfer to litter 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements,nfm_types,ncut_times), &   
+                                                  INTENT(inout)  :: biomass_cut        !! Biomass change due to  ncut
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                               :: ipts, ivm, ipar    !! Indices
+    INTEGER(i_std)                                               :: iele, icir, imbc   !! Indices
+    INTEGER(i_std)                                               :: ifm,icut           !! Indices
+    INTEGER,DIMENSION(nvm)                                       :: nkilled            !! the number of grid points at which a given
+                                                                                       !! given PFT's biomass has been reduced to zero
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)           :: check_intern       !! Contains the components of the internal
+                                                                                       !! mass balance chech for this routine
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: closure_intern     !! Check closure of internal mass balance
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_start         !! Start pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                   :: pool_end           !! End pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                             :: veget_cov_max_begin    !! temporary storage of veget_cov_max to check area conservation
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements)            :: init_biomass       !! Temporary array of the initial biomass
+    REAL(r_std), DIMENSION(nparts,nelements)                     :: actu_biomass       !! Temporary array of the actual biomass
+
+!_ ================================================================================================================================
+
+ !! Initialize variables
+
+    !! 1.1 Set firstcall flag
+    IF ( firstcall ) THEN
+       firstcall = .FALSE.
+    ENDIF
+
+    IF (printlev.GE.3) WRITE(numout,*) 'Entering gap. Use constant mortality = ', &
+         ok_constant_mortality
+
+    !! 1.2 Initialize variables
+    nkilled(:)=0
+    
+    !! 1.1 Initialize local printlev
+    !printlev_loc=get_printlev('natural_mortality')
+
+    ! 1.3 Initialize check for mass balance closure
+    IF (err_act.GT.1) THEN
+
+       check_intern(:,:,:,:) = zero
+       pool_start(:,:,:) = zero
+       DO ipar = 1,nparts
+          DO iele = 1,nelements        
+             !  Initial litter and biomass
+             DO icir = 1,ncirc
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                     (circ_class_biomass(:,:,icir,ipar,iele) * &
+                     circ_class_n(:,:,icir) * veget_cov_max(:,:))
+                     
+             ENDDO
+             pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                     bm_to_litter(:,:,ipar,iele) * veget_cov_max(:,:)
+          ENDDO
+       ENDDO
+
+       !! 1.3 Initialize check for area conservation
+       veget_cov_max_begin(:,:) = veget_cov_max(:,:)
+       
+    ENDIF ! err_act.GT.1
+
+    ! The total biomass at the start of the routine
+    init_biomass = cc_to_biomass(npts,nvm,circ_class_biomass(:,:,:,:,:),&
+         circ_class_n(:,:,:))
+
+
+ !! 3. Kill plants
+
+    DO  ipts = 1,npts ! loop over land_points
+
+       DO ivm = 2,nvm  ! loop over #PFT
+
+          IF(veget_cov_max(ipts,ivm) == zero)THEN
+              ! this vegetation type is not present, so no reason to do the 
+              ! calculation
+               CYCLE
+          ENDIF
+
+          !! First, all the plants that are supposed to be killed by fire are killed.
+          !! We do not yet know how to handle this, so this will have to be taken
+          !! into account when SPITFIRE is coupled.
+!!$          DO iele = 1,nelements
+
+             !! All of the natural death is grouped 
+             !! together in one pool since all of the biomass will be left on 
+             !! site (moved to the litter pools).
+             DO ifm=1,nfm_types
+
+                DO icut=1,ncut_times
+
+                   ! Since we gave circ_class_kill the same dimensions as the
+                   ! harvest pool, we need to explicitly say which combinations
+                   ! of ifm and icut are killed in which ways.  Currently, I am
+                   ! putting all natural death into ifm_none, even if it happens
+                   ! in another management type (for example, self-thinning will 
+                   ! happen with ifm_thin, but it's really a natural death).
+                   IF(ifm .NE. ifm_none)CYCLE
+                   IF((icut .NE. icut_thin) .AND. &
+                        (icut .NE. icut_clear) .AND. &
+                        (icut .NE. icut_storm_break) .AND. &
+                        (icut .NE. icut_storm_uproot)) CYCLE
+
+                   ! Killing is done a little differently for trees and 
+                   ! non-trees, since circ_classes are not defined for non-trees.
+                   IF(is_tree(ivm))THEN
+
+                      DO icir=1,ncirc
+
+                         ! Debug
+                         IF(test_pft == ivm .AND. test_grid == ipts .AND. &
+                              printlev_loc>=4) THEN
+                            WRITE(numout,*) 'killing before: ',ipts,ivm,icir,ifm,icut,&
+                                 circ_class_kill(ipts,ivm,icir,ifm,icut),&
+                                 circ_class_n(ipts,ivm,icir)
+                         ENDIF
+                         !
+
+                         ! move the dead biomass to the respective litter pool
+                         bm_to_litter(ipts,ivm,:,:) = bm_to_litter(ipts,ivm,:,:) + &
+                              circ_class_biomass(ipts,ivm,icir,:,:)*&
+                              circ_class_kill(ipts,ivm,icir,ifm,icut)
+                         
+                         ! remove the number of individuals that died
+                         circ_class_n(ipts,ivm,icir) = circ_class_n(ipts,ivm,icir) - &
+                              circ_class_kill(ipts,ivm,icir,ifm,icut)
+
+                         ! Here, it's possible that the number of individuals left
+                         ! will be a very, very small amount.  If it's very low,
+                         ! we will just move all that biomass to the dead pool
+                         ! and set the number of individuals equal to zero,
+                         ! effectively killing the circ class.
+                         IF(circ_class_n(ipts,ivm,icir) .LE. min_stomate)THEN
+
+                            bm_to_litter(ipts,ivm,:,:) = bm_to_litter(ipts,ivm,:,:) + &
+                                 circ_class_biomass(ipts,ivm,icir,:,:)*&
+                                 circ_class_n(ipts,ivm,icir)
+
+                            ! zero the number of individuals in this circ class
+                            circ_class_n(ipts,ivm,icir) = circ_class_n(ipts,ivm,icir) - &
+                                 circ_class_n(ipts,ivm,icir)
+
+                            ! If there are no individuals left then the biomass
+                            ! in that circ should be set to zero. If not some of 
+                            ! the IF-loops will fail because circ_class_n = 0 and
+                            ! circ_class_biomass = 0 is used as a logic test later
+                            ! in the code
+                            circ_class_biomass(ipts,ivm,icir,:,:) = zero
+                            
+                         ENDIF
+
+                         ! Debug
+                         IF(test_pft == ivm .AND. test_grid == ipts .AND. &
+                              printlev_loc>=4) THEN
+                            WRITE(numout,*) 'killing after: ',ipts,ivm,icir,ifm,icut,&
+                                 circ_class_kill(ipts,ivm,icir,ifm,icut),&
+                                 circ_class_n(ipts,ivm,icir)
+                         ENDIF
+                         !-
+
+                     ENDDO ! loop over circ classes
+
+                     ! Actual biomass after mortality has been accounted for
+                     actu_biomass = cc_to_biomass(npts,nvm,&
+                          circ_class_biomass(ipts,ivm,:,:,:),&
+                          circ_class_n(ipts,ivm,:))
+
+                     ! Calculate the biomass change due to ncuts
+                     biomass_cut(ipts,ivm,:,:,ifm,icut) = &
+                          biomass_cut(ipts,ivm,:,:,ifm,icut) + &
+                          init_biomass(ipts,ivm,:,:) - actu_biomass(:,:)
+
+                     ! Update the initial biomass to avoid double counting
+                     init_biomass(ipts,ivm,:,:) = actu_biomass(:,:)
+                          
+
+                   ELSE ! Grasses and croplands
+
+                      !! WARNING !!
+                      ! This is not very clean.  We don't use circ classes for grasses 
+                      ! and crops.  All mortality is done based on biomass.  However, 
+                      ! it's cleaner here to just pass circ_class_kill from 
+                      ! stomate_mark_kill, 
+                      ! and it is in line with what is done for the forests.  So we take
+                      ! the total grass/crop biomass that is scheduled for killing in 
+                      ! stomate_mark_kill and define circ_class_kill(:,:,inatural,1) and 
+                      ! circ_class_biomass(:,:,1,:,:) so that the product of these two
+                      ! matches the amount of biomass scheduled for killing.  We do NOT
+                      ! change the number of individuals after killing, either.
+
+                      ! Let us compute the fraction of plants which die of natural
+                      ! causes in this step.
+                      ! Individuals are not killed for grasses and crops, so we cannot
+                      ! calculate the mortality as a function of the individuals
+
+                      ! We renormalize by circ_class_n below.  If it's zero,
+                      ! we have an error.  Of course, if it's zero there is no
+                      ! reason to be here in the first place.
+                      IF(circ_class_n(ipts,ivm,1) .LE. min_stomate) THEN
+                         CYCLE
+                      ENDIF
+
+                      ! move the dead biomass to the respective litter pool
+                      bm_to_litter(ipts,ivm,:,:) = bm_to_litter(ipts,ivm,:,:) + &
+                           circ_class_biomass(ipts,ivm,1,:,:)*&
+                           circ_class_kill(ipts,ivm,1,ifm,icut)
+
+                      ! circ_class_biomass has to change such that the biomass
+                      ! and circ_class_biomass*circ_class_n are in sync.  So we
+                      ! will just sync it here.  This has to be done this way
+                      ! since circ_class_n never changes for grass/crops.
+                      ! Below we combine the calculation of the new biomass
+                      ! biomass = circ_class_biomass * circ_class_n
+                      ! biomass_killed = circ_class_biomass * circ_class_kill
+                      ! Given that we keep circ_class_n constant for grass and crops
+                      ! we recalculate circ_class_biomass as 
+                      ! (biomass-biomass_killed)/circ_class_n
+                      circ_class_biomass(ipts,ivm,1,:,:) = &
+                           circ_class_biomass(ipts,ivm,1,:,:) * &
+                           (circ_class_n(ipts,ivm,1) - &
+                           circ_class_kill(ipts,ivm,1,ifm,icut)) / &
+                           circ_class_n(ipts,ivm,1)
+
+                      ! In order for something to be prescribed, ind must be zero.
+                      ! We don't change ind and circ_class_n if we just kill some
+                      ! of the biomass, but if we kill all of it we must set
+                      ! it to zero in order for it to be prescribed.
+                      ! IF(ivm == test_pft) WRITE(numout,*) 'Killing? ', &
+                      ! SUM(biomass(ipts,ivm,:,iele))
+                      IF(SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1),1) .LE. &
+                           min_stomate)THEN
+
+                         ! Move the remaining biomass into the proper
+                         ! litter pools
+                         DO ipar = 1,nparts
+                            DO iele = 1,nelements
+                               bm_to_litter(ipts,ivm,ipar,iele) = &
+                                    bm_to_litter(ipts,ivm,ipar,iele) + &
+                                    SUM(circ_class_biomass(ipts,ivm,:,ipar,iele) * &
+                                    circ_class_n(ipts,ivm,:))
+                            ENDDO
+                         ENDDO
+
+                         ! Set the biomass and the number of individuals to zero
+                         circ_class_biomass(ipts,ivm,:,:,:) = zero
+                         circ_class_n(ipts,ivm,:) = zero                         
+
+                      ENDIF
+                      
+                   ENDIF ! checking for a tree
+
+                   ! This PFT should never be killed again.  
+                   ! To make sure of that, reset all the
+                   ! variables to zero.
+                   circ_class_kill(ipts,ivm,:,ifm,icut) = zero
+
+                ENDDO ! reason of mortality
+
+             ENDDO ! management types
+
+!!$          ENDDO ! loop over elements
+
+       ENDDO  ! loop over pfts
+
+    END DO ! loop over land points
+
+ !! 4. Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+
+       ! 4.2 Check surface area
+       CALL check_surface_area("stomate_natural_mortality", npts, &
+            veget_cov_max_begin, veget_cov_max,'pft')
+
+       ! 4.3 Mass balance closure 
+       pool_end = zero
+       DO ipar = 1,nparts
+          DO iele = 1,nelements
+             DO icir = 1,ncirc
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                     (circ_class_biomass(:,:,icir,ipar,iele) * &
+                     circ_class_n(:,:,icir) * veget_cov_max(:,:))
+             ENDDO
+             pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                  bm_to_litter(:,:,ipar,iele) * veget_cov_max(:,:)
+          ENDDO
+       ENDDO
+
+       ! 4.3.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(:,:,ipoolchange,iele) = -un * (pool_end(:,:,iele) - &
+               pool_start(:,:,iele)) 
+       ENDDO
+
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) WRITE(numout,*) &
+                  'check_intern, ivm, imbc, iele, ', imbc, &
+                  iele, check_intern(:,test_pft,imbc,iele)
+             !-
+             closure_intern(:,:,iele) = closure_intern(:,:,iele) + &
+                  check_intern(:,:,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 4.3.3 Check mass balance closure
+       CALL check_mass_balance("stomate_natural_mortality", closure_intern, &
+            npts, pool_end, pool_start, veget_cov_max, 'pft')
+      
+    ENDIF ! err_act.GT.1
+
+    IF (printlev.GE.4) WRITE(numout,*) 'Leaving natural_mortality'
+
+  END SUBROUTINE natural_mortality
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : mortality_clean
+!!
+!>\BRIEF        After biomass has been killed, there are some clean-up operations
+!!              to do.
+!!
+!! DESCRIPTION  : If all the biomass has been killed for a PFT, we want to reset
+!!                some counters.  There is also the chance that we have
+!!                killed all the biomass in a circ class of trees.  If this is
+!!                the case, we want to redistribut ethe biomass in the remaining
+!!                classes so that all circ classes have some biomass in them.
+!!                A circ class with no biomass causes allocation to crash.
+!!
+!! RECENT CHANGE(S): 
+!!
+!! MAIN OUTPUT VARIABLE(S): ::circ_class_biomass
+!!
+!! REFERENCE(S)   :
+!!
+!! FLOWCHART    : None
+!!\n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE mortality_clean (npts, circ_class_biomass, &
+       circ_class_n, age, everywhere, leaf_age, &
+       leaf_frac, plant_status, when_growthinit, circ_class_dist, &
+       age_stand, PFTpresent, last_cut, mai_count, &
+       veget_cov_max, npp_longterm, KF, atm_to_bm, &
+       wstress_season, lm_lastyearmax, lignin_struc, lignin_wood, &
+       som, litter, dt_days, &
+       forest_managed, bm_to_litter, lab_fac, &
+       gpp_daily, resp_maint, &
+       resp_growth, npp_daily, use_reserve, mai, pai, &
+       rue_longterm, previous_wood_volume, species_change_map,&
+       tau_eff_leaf, tau_eff_sap, tau_eff_root, moiavail_growingseason,&
+       k_latosa_adapt, lpft_replant, cn_leaf_min_season, &
+       nstress_season, soil_n_min, n_uptake_daily, p_O2, bact,&
+       CN_som_litter_longterm,matrixA,matrixV,vectorB,vectorU)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                       :: npts                   !! Domain size (-)
+    REAL(r_std), DIMENSION(ncirc), INTENT(in)        :: circ_class_dist        !! The probability distribution of trees 
+                                                                               !! in a circ class in case of a 
+                                                                               !! redistribution (unitless).
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: tau_eff_root           !! Effective root turnover time that accounts
+                                                                               !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: tau_eff_sap            !! Effective sapwood turnover time that accounts
+                                                                               !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: tau_eff_leaf           !! Effective leaf turnover time that accounts
+                                                                               !! waterstress (days)  
+    REAL(r_std), INTENT(in)                          :: dt_days                !! Time step of vegetation dynamics for stomate (days)
+    INTEGER(i_std), DIMENSION (:,:), INTENT(in)      :: forest_managed         !! forest management flag
+     LOGICAL, DIMENSION(npts,nvm), INTENT(in)        :: lpft_replant           !! Set to true if a PFT has been clearcut
+                                                                               !! and needs to be replaced by another species
+    INTEGER(i_std), DIMENSION (:,:), INTENT(in)       :: species_change_map    !! A map which gives the PFT number that each
+
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables   
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: circ_class_biomass     !! Biomass of the components of the model  
+                                                                               !! tree within a circumference
+                                                                               !! class @tex $(gC ind^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: plant_status           !! Growth and phenological status of the plant 
+                                                                               !! see constants voor values
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: age                    !! Mean age (years)  
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: when_growthinit        !! How many days ago was the beginning of the 
+                                                                               !! growing season (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: everywhere             !! Is the PFT everywhere in the grid box or very
+                                                                               !! localized (after its introduction)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: leaf_age               !! Leaf age (days)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: leaf_frac              !! Fraction of leaves in leaf age class 
+                                                                               !! (unitless;0-1)
+    INTEGER(i_std), DIMENSION(:,:), INTENT(inout)    :: age_stand              !! Age of the forest stand (years)  
+    INTEGER(i_std), DIMENSION(:,:), INTENT(inout)    :: last_cut               !! Years since last thinning (years)
+    INTEGER(i_std), DIMENSION(:,:), INTENT(inout)    :: mai_count              !! The number of times we've
+                                                                               !! calculated the volume increment
+                                                                               !! for a stand
+    LOGICAL, DIMENSION(:,:), INTENT(inout)           :: PFTpresent             !! PFT present (0 or 1)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: KF                     !! Scaling factor to convert sapwood mass into leaf 
+                                                                               !! mass (m)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: k_latosa_adapt         !! Leaf to sapwood area adapted for long 
+                                                                               !! term water stress (m)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: veget_cov_max              !! "maximal" coverage fraction of a PFT on the ground
+                                                                               !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: atm_to_bm              !! C and N taken from the atmosphere to get C to create  
+                                                                               !! the seedlings @tex (gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: wstress_season         !! Water stress factor, based on hum_rel_daily
+                                                                               !! (unitless, 0-1) 
+
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: npp_longterm           !! "long term" net primary productivity
+                                                                               !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: lm_lastyearmax         !! last year's maximum leaf mass for each PFT 
+                                                                               !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: lignin_struc           !! ratio Lignine/Carbon in structural litter,
+                                                                               !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: lignin_wood            !! ratio Lignine/Carbon in woody litter,
+                                                                               !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)   :: som                    !! carbon pool: active, slow, or passive 
+                                                                               !! @tex ($gC m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: litter                 !! metabolic and structural litter, above and 
+                                                                               !! below ground @tex ($gC m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: circ_class_n           !! Number of individuals in each circ class
+                                                                               !! @tex $(ind m^{-2})$ @endtex  
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)   :: bm_to_litter           !! Transfer of biomass to litter 
+                                                                               !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: lab_fac                !! Activity of labile pool factor (??units??)
+!!$    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: gdd_from_growthinit    !! growing degree days, since growthinit 
+!!$                                                                               !! for crops
+!!$    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: gdd_midwinter          !! Growing degree days (K), since midwinter 
+!!$                                                                               !! (for phenology) - this is written to the
+!!$                                                                               !!  history files 
+!!$    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: time_hum_min           !! Time elapsed since strongest moisture 
+!!$                                                                               !! availability (days)
+!!$    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)  :: hum_min_dormance       !! minimum moisture during dormance 
+!!$                                                                               !! (0-1, unitless)
+!!$    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: gdd_m5_dormance        !! Growing degree days (K), threshold -5 deg 
+!!$                                                                               !! C (for phenology)
+!!$    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: ncd_dormance           !! Number of chilling days (days), since 
+!!$                                                                               !! leaves were lost (for phenology) 
+!!$    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: moiavail_month         !! "Monthly" moisture availability (0 to 1, 
+!!$                                                                               !! unitless) 
+!!$    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: moiavail_week          !! "Weekly" moisture availability 
+!!$                                                                               !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: gpp_daily              !! Daily gross primary productivity  
+                                                                               !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: resp_maint             !! Maintenance respiration  
+                                                                               !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: resp_growth            !! Growth respiration  
+                                                                               !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: npp_daily              !! Net primary productivity 
+                                                                               !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: use_reserve            !! Mass taken from carbohydrate reserve 
+                                                                               !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)  :: mai                    !! The mean annual increment
+                                                                               !! @tex $(m**3 / m**2 / year)$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)  :: pai                    !! The period annual increment
+                                                                               !! @tex $(m**3 / m**2 / year)$ @endtex          
+!!$    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: ngd_minus5             !! Number of growing days (days), threshold 
+!!$                                                                               !! -5 deg C (for phenology)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: rue_longterm           !! Longterm radiation use efficiency 
+                                                                               !! (??units??) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)  :: previous_wood_volume   !! The volume of the tree trunks
+                                                                               !! in a stand for the previous year.
+                                                                               !! @tex $(m**3 / m**2 )$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: moiavail_growingseason !! Mean growingseason moisture 
+                                                                               !! availability (0 to 1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: cn_leaf_min_season     !! Seasonal min CN ratio of leaves 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: nstress_season         !! N-related seasonal stress (used for allocation) 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: soil_n_min             !! mineral nitrogen in the soil (gN/m**2)  
+                                                                               !! (first index=npts, second index=nvm, third index=nnspec) 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: n_uptake_daily         !! Daily N uptake by plants
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: p_O2                   !! partial pressure of oxigen in the soil (hPa)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: bact                   !! denitrifier biomass (gC/m**2)
+    REAL(r_std), DIMENSION(:,:,:),INTENT(inout)      :: CN_som_litter_longterm !! Longterm CN ratio of litter and som pools (gC/gN)
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)   :: matrixA                !! Matrix containing the fluxes between the carbon
+                                                                               !! pools per sechiba time step @tex $(gC.m^2.day^{-1})$
+                                                                               !! @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: vectorB                !! Vector containing the litter increase per sechiba
+                                                                               !! time step @tex $(gCm^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)   :: matrixV                !! Matrix containing the accumulated values of matrixA
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: vectorU                !! Matrix containing the accumulated values of VectorB
+
+    !! 0.4 Local variables
+    REAL(r_std)                                      :: share_young            !! Share of the veget_cov_max of the youngest age class
+                                                                               !! (unitless, 0-1)
+    INTEGER(i_std)                                   :: ipts,ivm,ilage         !! Indices
+    INTEGER(i_std)                                   :: icir,jcir,ilev         !! Indices
+    INTEGER(i_std)                                   :: ipar,iele,imbc         !! Indices
+    INTEGER(i_std)                                   :: ilit,icarb             !! Indices
+    INTEGER(i_std)                                   :: inc, ispec             !! Indices
+    LOGICAL                                          :: lredistribute          !! Flag if we need to redistribute individuals
+                                                                               !! among the circ classes
+    INTEGER,DIMENSION(nvm)                           :: nkilled                !! the number of grid points at which a given
+                                                                               !! given PFT's biomass has been reduced to 
+                                                                               !! zero
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)&
+                                                     :: check_intern           !! Contains the components of the internal
+                                                                               !! mass balance chech for this routine
+                                                                               !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: closure_intern         !! Check closure of internal mass balance
+                                                                               !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: pool_start             !! Start pool of this routine 
+                                                                               !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: pool_end               !! End pool of this routine 
+                                                                               !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                    :: old_trees_left
+    REAL(r_std), DIMENSION(ncirc)                    :: circ_class_n_new
+    REAL(r_std), DIMENSION(ncirc,nparts,nelements)   :: circ_class_biomass_new
+    REAL(r_std)                                      :: trees_needed
+    LOGICAL                                          :: lyoungest
+    REAL(r_std), DIMENSION(npts,nvm,nleafages)       :: new_leaf_frac          !! Temporary variable for leaf_frac (unitless;0-1)
+    REAL(r_std), DIMENSION(ncirc)                    :: est_circ_class_n       !! Temporary variable for circ_class_n of the 
+                                                                               !! established vegetation @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                    :: tmp_circ_class_n       !! Temporary variable for circ_class_n of the 
+                                                                               !! established vegetation @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)           :: new_circ_class_n       !! Temporary variable for circ_class_n of the
+                                                                               !! new vegetation
+                                                                               !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc,nparts,nelements)   :: est_circ_class_biomass !! Temporary variable for circ_class_biomass of the
+                                                                               !! established vegetation @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc,nparts,nelements)   :: tmp_circ_class_biomass !! Temporary variable for circ_class_biomass of the
+                                                                               !! established vegetation @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements) &
+                                                     :: new_circ_class_biomass !! Temporary variable for circ_class_biomass of the
+                                                                               !! new vegetation @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                    :: est_circ_class_dia     !! Variable to store temporary values for 
+                                                                               !! circ_class (m)
+    REAL(r_std), DIMENSION(ncirc)                    :: tmp_circ_class_dia     !! Variable to store temporary values for 
+                                                                               !! circ_class (m)
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)           :: new_circ               !! Temporary variable for circ (m)
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: new_atm_to_bm          !! Temporary variable for atm_to_bm 
+                                                                               !! @tex (gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                 :: new_age                !! Temporary variable for age (years)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: new_lm_lastyearmax     !! Temporary variable for lm_last_year 
+                                                                               !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                 :: new_everywhere         !! Temporary variable for everywhere (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: dum_when_growthinit    !! Dummy for when_growthinit (days)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: dum_npp_longterm       !! Dummy for npp_long_term
+                                                                               !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    INTEGER(i_std)                                   :: ivma
+    LOGICAL, DIMENSION(npts,nvm)                     :: dum_PFTpresent         !! Dummy for PFTpresent (0 or 1)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: dum_plant_status       !! Dummy for plant_status (true/false)
+    REAL(r_std)                                      :: moi_bank               !! bank to store moiavail_growingseason of the cleared
+                                                                               !! PFT's (unitless; 0-1)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: loss_gain              !! The same as delta_veget but distributed of all
+                                                                               !! age classes and thus taking the age-classes into 
+                                                                               !! account (unitless, 0-1)
+    REAL(r_std)                                      :: total_losses           !! Sum of losses only in delta_veget (unitless, 0-1)
+    REAL(r_std), DIMENSION(nlitt,nlevs,nelements)    :: litter_bank            !! Bank to store the litter that becomes available when
+                                                                               !! part of a PFT is removed @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(ncarb)                    :: soil_bank              !! Bank to store soil carbon that becomes available when
+                                                                               !! part of a PFT is removed  @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nlevs)                    :: struct_ltr_bank        !! Bank to store the lignin in structural litter that 
+                                                                               !! becomes available when part of a PFT is removed 
+                                                                               !! (0-1,unitless)
+    REAL(r_std),DIMENSION(nlevs)                     :: woody_ltr_bank         !! Bank to store the lignin in woody litter that 
+                                                                               !! becomes available when part of a PFT is removed 
+                                                                               !! (0-1,unitless)
+    REAL(r_std),DIMENSION(nvm,nparts,nelements)      :: fresh_litter           !! Pool of fresh litter that is being released during 
+                                                                               !! LCC @tex ($gC m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION(nparts,nelements)          :: fresh_ltr_bank         !! Bank to store all the fresh litter from site 
+                                                                               !! clearing during LCC. Weighted value of fresh_litter
+                                                                               !! @tex ($gC m^{-2}$) @endtex
+    INTEGER(i_std)                                   :: iyoung                 !! index of the youngest age class of that species
+    REAL(r_std), DIMENSION(npts,nvm,norphans,nelements) &
+                                               :: orphan_flux_local            !! Storage for fluxes of PFTs that no longer exist. 
+                                                                               !! This is only for co2bm at the moment, since that
+                                                                               !! is the only one used in this routine. Following the 
+                                                                               !! total destruction of a PFT by death
+                                                                               !! (veget_cov_max_new = 0), a flux from before death needs  
+                                                                               !! storage @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nlitt,nlevs)                :: litter_weight_young  !! The fraction of litter on the young
+                                                                               !! PFT.
+                                                                               !! @tex $-$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                   :: veget_cov_max_begin      !! Temporairy variable to check area conservation 
+    REAL(r_std), DIMENSION(npts,nvm,nlevels_tot)       :: dummy1               !! Dummy variable for prescribe
+    LOGICAL                                            :: dummy2               !! Dummy variable for prescribe 
+!_ ================================================================================================================================
+
+    IF (printlev.GE.3) WRITE(numout,*) 'Entering mortality_clean.'
+
+ !! 1. Initialize check for mass balance closure
+  
+    !! 1.1 Initialize local printlev
+    !printlev_loc=get_printlev('mortality_clean')
+
+    !! 1.2 Initialize check for mass balance closure 
+    IF (err_act.GT.1) THEN
+
+       check_intern(:,:,:,:) = zero
+       pool_start(:,:,:) = zero
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             DO icir = 1,ncirc
+                !  Initial biomass
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                     (circ_class_biomass(:,:,icir,ipar,iele) * &
+                     circ_class_n(:,:,icir) * veget_cov_max(:,:)) 
+             ENDDO
+          ENDDO
+
+          ! The litter and soil carbon pools can be moved around
+          ! if age classes are changed.
+       
+          ! Litter pool (gC m-2) *  (m2 m-2) 
+          DO ilit = 1,nlitt
+             DO ilev = 1,nlevs
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                     litter(:,ilit,:,ilev,iele) * veget_cov_max(:,:)
+             ENDDO
+          ENDDO
+
+          ! Soil carbon (gC m-2) *  (m2 m-2)
+          DO icarb = 1,ncarb
+             pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                  som(:,icarb,:,iele) * veget_cov_max(:,:)
+          ENDDO
+
+          check_intern(:,:,iatm2land,iele) = -un * &
+               atm_to_bm(:,:,iele) * veget_cov_max(:,:)
+
+       ENDDO
+
+       ! Denitrifying bacteria (only C)
+       pool_start(:,:,icarbon) = pool_start(:,:,icarbon) + &
+            bact(:,:) * veget_cov_max(:,:)
+
+       ! Nitrogen only
+       DO ispec = 1,nnspec
+          pool_start(:,:,initrogen) = pool_start(:,:,initrogen) + &
+               soil_n_min(:,:,ispec) * veget_cov_max(:,:)
+       ENDDO
+
+       ! Specific fluxes
+       check_intern(:,:,iatm2land,icarbon) = &
+            check_intern(:,:,iatm2land,icarbon) - un *&
+            gpp_daily(:,:) * veget_cov_max(:,:)
+       check_intern(:,:,iland2atm,icarbon) = &
+            check_intern(:,:,iland2atm,icarbon) + &
+            (resp_maint(:,:) + resp_growth(:,:)) * &
+            veget_cov_max(:,:)
+
+       !! 1.3 Initialize check for area conservation
+       veget_cov_max_begin(:,:) = veget_cov_max(:,:)
+
+    ENDIF ! err_act.GT.1
+
+
+ !! 2. Redistribute biomass
+  
+    DO  ipts = 1,npts ! loop over land_points
+
+       DO ivm = 2,nvm  ! loop over #PFT
+
+          IF(veget_cov_max(ipts,ivm) == zero)THEN
+             ! this vegetation type is not present, so no reason to do the 
+             ! calculation.
+             CYCLE
+          ENDIF
+
+          ! First we check to see if one of the circ classes is empty.  
+          ! We only need to do this if there is some biomass, since we 
+          ! don't care if all of the circ classes are empty.
+          IF(SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1)) .GT. min_stomate)THEN
+             
+             IF(is_tree(ivm))THEN
+
+                ! By setting this to .TRUE. redistribution
+                ! will be taken care of every day. Initially this flag was 
+                ! only true at the end of the year but that resulted in 
+                ! spikes and pulses.
+                lredistribute=.TRUE.
+
+                IF(lredistribute) THEN
+
+                   ! Debug
+                   IF(printlev_loc>=4 .AND. ivm==test_pft)THEN
+                      WRITE(numout,*) 'Start of redistributing biomass in mortality_clean'
+                      WRITE(numout,*) 'ipts,ivm',ipts,ivm
+                      WRITE(numout,*) 'circ_class_n, ',circ_class_n(ipts,ivm,:)
+                      WRITE(numout,*) 'circ_class_biomass, ', &
+                           SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),2)
+                   ENDIF
+                   !-
+
+                   ! What we want to do is recreate the circumference class distribution,
+                   ! since if we have hit this point we have at least one class that
+                   ! is empty and this will cause the allocation to crash.  
+
+                   ! The first step is to decide of the distribution of individuals 
+                   ! that we want in each class, for example, a uniform or exponential 
+                   ! distribution. This was made this an input parameter. Note
+                   ! that this is a decisison with very high consequences. The diamter
+                   ! range may vary but the distribution is always the same.
+
+                   ! Now we need to populate the new distribution of trees among
+                   ! the circumference classes, and move the heartwood and sap masses 
+                   ! to the new distributions. We also need to move the other pools.  
+                   ! This is tricky because the allometric relations for the new
+                   ! tree sizes will NOT give the same amount of biomass for
+                   ! the non-woody pools.  Let us first try it just distributing
+                   ! everything equally, and then if that doesn't work we can
+                   ! redistribute the non-woody pools more cleverly, even if that 
+                   ! means we change the total amount of biomass we have in this
+                   ! stand.  I want to try it this way because we conserve biomass 
+                   ! this way, and I hope that the stress on the trees will be
+                   ! small enough that it doesn't cause problems.  This
+                   ! redistribution should only happen rarely, so the trees
+                   ! should have a chance to equilibrate.
+                   circ_class_n_new(:)=circ_class_dist(:)*SUM(circ_class_n(ipts,ivm,:))
+                   circ_class_biomass_new(:,:,:)=zero
+
+                   ! now we populate the new classes
+                   old_trees_left(:)=circ_class_n(ipts,ivm,:)
+
+                   ! The subsequent calculation nicely closes the carbon
+                   ! balance but within the precision 10-16. If there are
+                   ! enough trees (first case in the IF-loop), we introduce
+                   ! a precision error in the number of trees. This implies
+                   ! that when the number of trees is very small, the
+                   ! precision issue can become a numerical issue. This is 
+                   ! especially true for the largest circumference classes 
+                   ! because they contain the fewest individuals. 
+                   ! We observed the largest circumference classes 
+                   ! containing 10-4 to 10-5 gC less than the previous 
+                   ! class. The rest of the code shouldn't care too much 
+                   ! whether the circumferences classes are in order or not 
+                   ! but to reduce the chances this problem occurs
+                   ! we inverted the DO-loops. That way the precision error
+                   ! is carried to the smaller diameter classes 
+                   ! which have more individuals and so the precision error
+                   ! stays a precision issue. Note that this routine is
+                   ! called every day so the problem is likely to be 
+                   ! corrected the next day.
+                   DO icir=ncirc,1,-1
+
+                      trees_needed=circ_class_n_new(icir)
+
+                      DO jcir=ncirc,1,-1
+
+                         IF(trees_needed .LE. zero)EXIT
+
+                         ! Debug
+                         IF(printlev_loc>=4 .AND. ivm==test_pft)THEN
+                            WRITE(numout,*) 'start of loop'
+                            WRITE(numout,*) 'circ_class_biomass_new, C',&
+                                 icir,SUM(circ_class_biomass_new(icir,:,icarbon))
+                             WRITE(numout,*) 'circ_class_biomass_new, N',&
+                                 icir,SUM(circ_class_biomass_new(icir,:,initrogen))
+                            WRITE(numout,*) 'old_trees_left, ', &
+                                 jcir, old_trees_left(jcir)
+                            WRITE(numout,*) 'trees needed, ',trees_needed
+                         ENDIF
+                         !-
+
+                         IF(old_trees_left(jcir) .GE. trees_needed )THEN
+
+                            ! we can get all the trees we need from this class
+                            ! and don't have to continue searching
+                            circ_class_biomass_new(icir,:,:)=circ_class_biomass_new(icir,:,:)+&
+                                 circ_class_biomass(ipts,ivm,jcir,:,:)*trees_needed
+                            old_trees_left(jcir)=old_trees_left(jcir)-trees_needed
+                            trees_needed = zero
+
+                            ! Debug
+                            IF(printlev_loc>=4 .AND. ivm==test_pft)THEN
+                               WRITE(numout,*) 'enough trees'
+                            ENDIF
+                            !-
+   
+                            EXIT
+
+                         ELSE
+
+                            ! the trees in this class are not sufficient, so we
+                            ! need to move all of them to the new class.
+                            circ_class_biomass_new(icir,:,:)=circ_class_biomass_new(icir,:,:)+&
+                                 circ_class_biomass(ipts,ivm,jcir,:,:)*&
+                                 old_trees_left(jcir)
+                            trees_needed = trees_needed-old_trees_left(jcir)
+                            old_trees_left(jcir)=zero
+
+                            ! Debug
+                            IF(printlev_loc>=4 .AND. ivm==test_pft)THEN
+                               WRITE(numout,*) 'not enough trees'
+                            ENDIF
+                            !-
+
+                         ENDIF
+                         
+                         ! Debug
+                         IF(printlev_loc>=4 .AND. ivm==test_pft)THEN
+                            WRITE(numout,*) 'start of loop'
+                            WRITE(numout,*) 'circ_class_biomass_new, C',&
+                                 icir,SUM(circ_class_biomass_new(icir,:,icarbon))
+                             WRITE(numout,*) 'circ_class_biomass_new, N',&
+                                 icir,SUM(circ_class_biomass_new(icir,:,initrogen))
+                            WRITE(numout,*) 'old_trees_left, ', &
+                                 jcir, old_trees_left(jcir)
+                            WRITE(numout,*) 'trees needed, ',trees_needed
+                         ENDIF
+                         !-
+
+                      ENDDO ! jcir=1,ncirc
+
+                   ENDDO ! icir=1,ncirc
+
+                   ! right now, circ_class_biomass_new gives the total biomass
+                   ! in each class, but it should only be for a model tree. 
+                   ! So let's normalize it.
+                   DO icir=1,ncirc
+                      circ_class_biomass_new(icir,:,:) = &
+                           circ_class_biomass_new(icir,:,:)/&
+                           circ_class_n_new(icir)
+                   ENDDO
+
+                   ! Check whether the order was preserved. We only want to
+                   ! preserve the order for the carbon biomass. Nitrogen follows
+                   ! carbon. We expect that the biomass of an individual tree 
+                   ! increases with an increasing circ class. This is probably 
+                   ! not important for the correct functioning of the model. So,
+                   ! if this turns out to be computationally expensive it is 
+                   ! worth trying without. We try to preserve the order as
+                   ! an additional mean to control the quality of the simulations.
+                   ! A strict order also helps to interpret the output. Hence, 
+                   ! if the order was not preserved we will sort the biomasses. 
+                   ! Note that this subroutine first checks whether the order 
+                   ! was preseverd.
+                   CALL sort_circ_class_biomass(circ_class_biomass_new,&
+                           circ_class_n_new)
+
+                   ! Now update the variables that pass this information around
+                   DO icir=1,ncirc
+                      circ_class_biomass(ipts,ivm,icir,:,:) = &
+                           circ_class_biomass_new(icir,:,:)
+                      circ_class_n(ipts,ivm,icir) = circ_class_n_new(icir)
+                   ENDDO
+
+                ENDIF ! redistribute
+                
+                ! Debug
+                IF(printlev_loc>=4 .AND. ivm==test_pft)THEN
+                   WRITE(numout,*) 'End of redistributing biomass in mortality_clean'
+                   WRITE(numout,*) 'ipts,ivm',ipts,ivm
+                   WRITE(numout,*) 'circ_class_n, ',circ_class_n(ipts,ivm,:)
+                   WRITE(numout,*) 'circ_class_biomass - C, ', &
+                        SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),2)
+                    WRITE(numout,*) 'circ_class_biomass - N, ', &
+                        SUM(circ_class_biomass(ipts,ivm,:,:,initrogen),2)
+                ENDIF
+                !-
+
+             ELSE
+
+                ! we have biomass here but it's not a tree.  Don't need to do anything.
+
+             ENDIF
+
+          ELSEIF (SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1),1) .LT. &
+               min_stomate .AND. &
+               plant_status(ipts,ivm) .EQ. idead) THEN 
+
+             ! All the biomass was killed for this site.  Some flags to
+             ! be reset in this case. It is OK to kill the PFT even if 
+             ! we are using species change but we can not replant yet
+             ! because we want to replant with a different species this is
+             ! basically the same as a land cover change and so it is best 
+             ! taken care of with the sapiens_lcchange code. To end up
+             ! here we need a veget_cov_max for this PFT. Another check is 
+             ! through using ::PFTpresent.
+             IF(PFTpresent(ipts,ivm))THEN
+                
+                nkilled(ivm)=nkilled(ivm)+1 ! purely an informational variable
+
+                !! 1.5 Reinitialize vegetation characteristics in STOMATE
+                plant_status(ipts,ivm) = iprescribe
+                age(ipts,ivm) = zero
+                when_growthinit(ipts,ivm) = large_value
+
+                ! Specific variables for forest stands
+                IF(is_tree(ivm))THEN
+
+                   last_cut(ipts,ivm) = zero
+                   mai_count(ipts,ivm) = zero
+                   age_stand(ipts,ivm) = zero
+
+                ENDIF
+
+                !! 1.6 Update leaf ages
+                DO ilage = 1, nleafages
+                   
+                   leaf_age(ipts,ivm,ilage) = zero 
+                   leaf_frac(ipts,ivm,ilage) = zero 
+                   
+                ENDDO
+
+                ! This used to be done in lpj_kill.  If we have grasses,
+                ! we reset the long term GPP.  This value as 500 in the
+                ! old code.  We externalized the variable, but we are
+                ! leaving the default at 500.  Many PFTs should have
+                ! a long term value of less than 500, so someone could
+                ! do some work on this in the future.
+                IF (.NOT. is_tree(ivm) .AND. .NOT. ok_constant_mortality) THEN
+                   
+                   npp_longterm(ipts,ivm) = npp_reset_value(ivm)
+
+                ENDIF
+              
+             ENDIF ! is PFT present?
+
+!          ELSE
+!
+!             CALl ipslerr_p (3,'mortality_clean',&
+!                  'unexpected condition in if-loop','','')
+!
+          ENDIF ! check if biomass is equal to zero
+
+          ! If we have no vegetation left, this stand has been completely cleared.
+          ! We have to reset the age, regardless if it was for natural or human reasons.
+          IF(is_tree(ivm))THEN
+             
+             ! This is essentially the same code that is found in land cover change,
+             ! since the same process happens there.  Notice that here we do not
+             ! need to use the _bank variables, since we assume that if a stand dies
+             ! due to natural causes it will always be replaced by the same species.
+             ! We also assume that if a stand is clearcut, the model will replace it
+             ! by the same species.  To do so otherwise would require something more
+             ! like a DGVM. That is what is being done in the species change code.
+             ! If the species change code is used, the PFT will be replanted at the
+             ! end of the year. Not in the middle of the year as being done here.
+
+             ! If we are using age classes, we need to reset a lot of counters
+             ! and change veget_cov_max, moving veget_cov_max from this age class to
+             ! the lowest age class.  If veget_cov_max is greater than zero and there
+             ! is no biomass, prescribe will attempt to grow trees here in the
+             ! next timestep.  This is fine if we have no age classes, but it doesn't
+             ! make any sense to prescribe trees that are 50 years old.  We should
+             ! only prescribe trees which are 0 years old.
+             IF( SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1),1) .LT. &
+                  min_stomate .AND. (agec_group(ivm)==species_change_map(ipts,ivm) .OR. &
+                  .NOT.lpft_replant(ipts,ivm))) THEN 
+
+                ! Debug
+                IF(printlev_loc>=4)THEN
+                   WRITE(numout,*) 'Getting reset in mortality_clean'
+                   WRITE(numout,*) 'ivm,ipts',ivm,ipts
+                ENDIF
+                !-
+                
+                IF(nagec .GT. 1)THEN
+
+                   ! First, we need to find the youngest age class of this PFT.
+                   iyoung=start_index(agec_group(ivm))
+                   IF(ivm == iyoung)THEN
+                      lyoungest=.TRUE.
+                   ELSE
+                      lyoungest=.FALSE.
+                   ENDIF
+
+                   IF(lyoungest)THEN
+
+                      ! We don't need to do anything.  Things will be handled properly with
+                      ! prescribe in the next step.
+
+                   ELSE
+
+                      ! All of our counters for this stand are zero.  We need to merge that
+                      ! with the youngest age class.  There are a couple possibilities.
+                      ! One is that nothing exists right now in the youngest age class, in 
+                      ! which case the veget_cov_max of the old age class becomes that of the 
+                      ! youngest and we prescribe.  Another possibility is that something 
+                      ! does exist in the youngest age class, in which case we prescribe 
+                      ! to the current age class and then merge biomass with the youngest.  
+                      ! A third is that both the youngest age class and the current age 
+                      ! class have died.  In that case we can do the same thing as if there 
+                      ! is no vegetation in the young age class, we just have to make sure 
+                      ! to add the veget_cov_max and not replace it.
+                      ! Veget_max after PFT expansion. As ::veget_cov_max is used in the 
+                      ! IF-statements we won't update it until the end of this routine. If 
+                      ! we would updatebefore that, the same PFT may be subject to 
+                      ! conflicting actions.
+                      share_young = veget_cov_max(ipts,iyoung) / &
+                           ( veget_cov_max(ipts,iyoung) + veget_cov_max(ipts,ivm) )
+
+                      ! We also need a scaling factor which includes the litter
+                      DO ilev=1,nlevs
+                         DO ilit=1,nlitt
+                            IF(litter(ipts,ilit,iyoung,ilev,icarbon) .GT. min_stomate)THEN
+
+                               litter_weight_young(ilit,ilev)=&
+                                    litter(ipts,ilit,iyoung,ilev,icarbon)*&
+                                    veget_cov_max(ipts,iyoung)/ &
+                                    (litter(ipts,ilit,ivm,ilev,icarbon)*veget_cov_max(ipts,ivm) + &
+                                    litter(ipts,ilit,iyoung,ilev,icarbon)*&
+                                    veget_cov_max(ipts,iyoung))
+
+                            ELSE
+
+                               litter_weight_young(ilit,ilev)=zero
+
+                            ENDIF
+                         END DO
+                      ENDDO
+
+                      IF( SUM(SUM(circ_class_biomass(ipts,iyoung,:,:,icarbon),1),1) .LT. &
+                           min_stomate)THEN
+
+                         ! Debug
+                         IF(printlev_loc>=4)THEN
+                            WRITE(numout,*) 'Merging our biomass to the youngest age class.'
+                            WRITE(numout,*) 'No current biomass in the youngest age class.'
+                            WRITE(numout,*) 'ipts,iyoung,ivm: ',ipts,iyoung,ivm
+                            WRITE(numout,*) 'share_young: ',share_young
+                            WRITE(numout,*) 'veget_cov_max(young and current): ',&
+                                 veget_cov_max(ipts,iyoung),veget_cov_max(ipts,ivm)
+                         ENDIF
+                         !-
+
+                         ! Is there anything in the smallest age class?  It
+                         ! does not matter if the youngest age class died in this
+                         ! step or not.
+                         plant_status(ipts,iyoung) = iprescribe
+                         plant_status(ipts,ivm) = idead
+   
+                         veget_cov_max(ipts,iyoung) = veget_cov_max(ipts,iyoung)+veget_cov_max(ipts,ivm)
+                         
+                         moiavail_growingseason(ipts,iyoung) = &
+                              share_young * moiavail_growingseason(ipts,iyoung) + &
+                              moiavail_growingseason(ipts,ivm) * &
+                              (un - share_young)
+
+                         ! To keep the mass balance closed we have to move the
+                         ! gpp and autothropic respiration fluxes to youngest
+                         ! age class
+                         gpp_daily(ipts,iyoung) = share_young * gpp_daily(ipts,iyoung) + &
+                              (un-share_young) * gpp_daily(ipts,ivm)
+                         resp_maint(ipts,iyoung) = share_young * resp_maint(ipts,iyoung) + &
+                              (un-share_young) * resp_maint(ipts,ivm)
+                         resp_growth(ipts,iyoung) = share_young * resp_growth(ipts,iyoung) + &
+                              (un-share_young) * resp_growth(ipts,ivm)
+                         atm_to_bm(ipts,iyoung,:) = share_young * atm_to_bm(ipts,iyoung,:) + &
+                              (un-share_young) * atm_to_bm(ipts,ivm,:)
+
+                         ! I am not sure why we merge wstress here.  wstress is recalculated
+                         ! everyday from moiavail_growingseason.
+                         wstress_season(ipts,iyoung) = &
+                              share_young * wstress_season(ipts,iyoung) + &
+                              wstress_season(ipts,ivm) * (un - share_young)
+                         nstress_season(ipts,iyoung) = &
+                              share_young * nstress_season(ipts,iyoung) + &
+                              nstress_season(ipts,ivm) * (un - share_young)
+                         
+                         ! The litter variables also need to be merged, since these will not
+                         ! get updated in prescribe in the next step.
+                         litter(ipts,:,iyoung,:,:) =   &
+                              share_young * litter(ipts,:,iyoung,:,:) + &
+                              litter(ipts,:,ivm,:,:) * &
+                              (un - share_young)
+                         som(ipts,:,iyoung,:) =  &
+                              share_young * som(ipts,:,iyoung,:) + &
+                              som(ipts,:,ivm,:) * &
+                              (un - share_young)
+
+                         ! We also need to merge plant N uptake
+                         n_uptake_daily(ipts,iyoung,iammonium) = share_young * &
+                              n_uptake_daily(ipts,iyoung,iammonium) + &
+                              n_uptake_daily(ipts,ivm,iammonium) * (un - share_young)
+                         n_uptake_daily(ipts,iyoung,initrate) = share_young * &
+                              n_uptake_daily(ipts,iyoung,initrate) + &
+                              n_uptake_daily(ipts,ivm,initrate) * (un - share_young)
+
+                         DO ilev=1,nlevs
+                            lignin_struc(ipts,iyoung,ilev) = &
+                                 litter_weight_young(istructural,ilev) * &
+                                 lignin_struc(ipts,iyoung,ilev) + &
+                                 (un - litter_weight_young(istructural,ilev)) * &
+                                 lignin_struc(ipts,ivm,ilev) 
+                            lignin_wood(ipts,iyoung,ilev) = &
+                                 litter_weight_young(iwoody,ilev) * &
+                                 lignin_wood(ipts,iyoung,ilev) + &
+                                 (un - litter_weight_young(iwoody,ilev) ) * &
+                                 lignin_wood(ipts,ivm,ilev) 
+                         ENDDO
+
+                         bm_to_litter(ipts,iyoung,:,:) = &
+                              share_young * bm_to_litter(ipts,iyoung,:,:) + &
+                              bm_to_litter(ipts,ivm,:,:) * &
+                              (un - share_young)
+
+                         ! Update the soil pools
+                         soil_n_min(ipts,iyoung,:) = &
+                              share_young * soil_n_min(ipts,iyoung,:) + &
+                              soil_n_min(ipts,ivm,:) * &
+                              (un - share_young)
+                         p_O2(ipts,iyoung) = &
+                              share_young * p_O2(ipts,iyoung) + &
+                              p_O2(ipts,ivm) * (un - share_young)
+                         bact(ipts,iyoung) = &
+                              share_young * bact(ipts,iyoung) + &
+                              bact(ipts,ivm) * (un - share_young)
+
+                         ! Leaf properties
+                         cn_leaf_min_season(ipts,iyoung) = &
+                              share_young * cn_leaf_min_season(ipts,iyoung) + &
+                              cn_leaf_min_season(ipts,ivm) * (un - share_young)
+                         ! For the analytic spinup, we need longterm CN ratios
+                         ! calculated over the spinup period. If the tree grows
+                         ! and move to an older age class, this is taken care of
+                         ! by age_class_distr, but if PFT is killed we need to
+                         ! move CN back to the first age class as well.
+                         ! Otherwise, we will not get a CN ratio for soil and
+                         ! litter pools the corresponds to the spinup period. 
+                         IF(spinup_analytic)THEN
+                            CN_som_litter_longterm(ipts,iyoung,:)=&
+                              share_young * CN_som_litter_longterm(ipts,iyoung,:) + &
+                              CN_som_litter_longterm(ipts,ivm,:) * (un - share_young)
+                            matrixA(ipts,iyoung,:,:)=&
+                              share_young *matrixA(ipts,iyoung,:,:) + &
+                              matrixA(ipts,ivm,:,:) * (un -share_young)
+                            matrixV(ipts,iyoung,:,:)=&
+                              share_young *matrixV(ipts,iyoung,:,:) + &
+                              matrixV(ipts,ivm,:,:) * (un -share_young)
+                            vectorB(ipts,iyoung,:)=&
+                              share_young *vectorB(ipts,iyoung,:) + &
+                              vectorB(ipts,ivm,:) * (un -share_young)
+                            vectorU(ipts,iyoung,:)=&
+                              share_young *vectorB(ipts,iyoung,:) + &
+                              vectorB(ipts,ivm,:) * (un -share_young)
+
+                         ENDIF 
+
+                      ELSE
+
+                         ! There are two important things to do here.  First,
+                         ! we need to prescribe biomass to this PFT, since it
+                         ! is currently empty.  Then we need to merge this biomass
+                         ! with what is already in the youngest age class of this PFT.
+
+                         ! We want to make use of prescribe but it should 
+                         ! be noted that the youngest PFT already contains biomass. 
+                         ! Therefore we will create a temporary PFT without biomass which 
+                         ! can be used to establish the  new vegetation within the 
+                         ! youngest. For most of the INTENT(inout)  variables of 
+                         ! prescribe we receive temporary variables back this 
+                         ! helps us to calculate the weighted mean of the newly established 
+                         ! vegetation and the vegetation that is already there. For some 
+                         ! other variables we receive dummies as we are simply not
+                         ! going to use these values but will continue using the values of the
+                         ! vegetation that is already there.
+
+                         ! Debug
+                         IF(printlev_loc>=4)THEN
+                            WRITE(numout,*) 'Merging our biomass to the youngest age class.'
+                            WRITE(numout,*) 'Biomass already in the youngest age class.'
+                            WRITE(numout,*) 'ipts,iyoung,ivm: ',ipts,iyoung,ivm
+                            WRITE(numout,*) 'share_young: ',share_young
+                            WRITE(numout,*) 'veget_cov_max(young and current): ',&
+                                 veget_cov_max(ipts,iyoung),veget_cov_max(ipts,ivm)
+                         ENDIF
+                         !-
+
+                         !! 5.2.3.1 Initialize new and dummy variables
+                         new_circ_class_biomass(:,:,:,:,:) = zero
+                         new_circ_class_n(:,:,:) = zero
+                         new_lm_lastyearmax(:,:) = zero
+                         new_age(:,:) = zero
+                         new_leaf_frac(:,:,:) = zero
+                         new_atm_to_bm(:,:,:) = zero
+                         new_everywhere(:,:) = zero 
+                         dum_when_growthinit(:,:) = large_value
+                         dum_npp_longterm(:,:) = zero
+                         dum_PFTpresent(:,:) = .TRUE.
+                         dum_plant_status(:,:) = iprescribe
+                
+                         !! 5.2.3.2 Merge the new and already available vegetation
+
+                         ! Assign value to moiavail_growingseason
+                         ! We do this differently from LCC, because we are replanting
+                         ! the same stand that we just cut.
+                         moiavail_growingseason(ipts,iyoung) = &
+                              moiavail_growingseason(ipts,iyoung) * &
+                              share_young + moiavail_growingseason(ipts,ivm) * &
+                              (un - share_young)
+                         wstress_season(ipts,iyoung) = wstress_season(ipts,iyoung) * &
+                              share_young + wstress_season(ipts,ivm) * (un - share_young)
+                         nstress_season(ipts,iyoung) = nstress_season(ipts,iyoung) * &
+                              share_young + nstress_season(ipts,ivm) * (un - share_young)
+
+     
+                         !! 5.2.3.3 Initialize the newly established vegetation: 
+                         !  Initialize the newly established vegetation: density of 
+                         !  individuals, biomass, allocation factors, leaf age distribution, 
+                         !  etc to some reasonable value ::veget_cov_max is not updated yet, 
+                         !  therefore loss_gain is passed in the argument list.
+                         !  For loss_gain, we only want to replant the current PFT.
+                         !  If lpft_replat is TRUE we should never be here in the 
+                         !  first place but to be safe lpft_replant is passed into
+                         !  prescribe. This is an optional variable that will prevent
+                         !  prescribing biomass if species change is used.
+
+                         ! Debug
+                         IF(printlev_loc>=4)THEN
+                            IF(lpft_replant(ipts,ivm))THEN
+                               WRITE(numout,*) 'ERROR - mortality_clean should never be here'
+                               IF (err_act.GT.1) CALL ipslerr_p(3, &
+                                    'mortality_clean in stomate_kill.f90',&
+                                    'species change was activated, replanting needed',&
+                                    'do not replant in mortality_clean, wait for lcchange','')
+                            ENDIF
+                         ENDIF
+                         !-
+
+                         loss_gain(:,:)=zero
+                         loss_gain(ipts,ivm)=veget_cov_max(ipts,ivm)
+                         ! In gap_clean stomate_prescribe is only used to establish new
+                         ! vegetation. The variables required for recruitment are not 
+                         ! passed all the way into this routine but are made dummy
+                         ! variables. A more elegant solution is to use OPTIONAL variables
+                         ! but the code became a bit confused because lpft_replant is
+                         ! already an OPTINAL variable but for a completly different 
+                         ! functionality.
+                         ! Dummy for light_tran_tot_season
+                         dummy1(:,:,:) = un
+                         ! Dummy for EndOfYear
+                         dummy2 = .FALSE.
+                         CALL prescribe (npts,loss_gain, dt_days, &
+                              dum_PFTpresent, new_everywhere, dum_when_growthinit, &
+                              new_leaf_frac, circ_class_dist, new_circ_class_n, &
+                              new_circ_class_biomass, new_atm_to_bm, forest_managed, &
+                              KF, dum_plant_status, new_age, dum_npp_longterm, &
+                              new_lm_lastyearmax, tau_eff_leaf, tau_eff_sap, &
+                              tau_eff_root, k_latosa_adapt, dummy1, &
+                              dummy2, lpft_replant,species_change_map)
+
+
+                         !! 5.2.3.3.1 Merge biomass of new and already available trees
+                         ! Unlike LCC, we are only at this point if we are dealing
+                         ! with forests, so we don't have to check for that here.
+
+                         ! Copy the number of individuals and the biomass of the established 
+                         ! vegetation to a temporary variable. In the subroutine ::circ_class_n
+                         ! and ::circ_class_biomass will be overwritten with the characteristics
+                         ! of the merged vegetation
+                         ! The term "established" here refers to the youngest age class, while
+                         ! "tmp" is the prescribed vegetation that we just created.
+                         est_circ_class_n(:) = circ_class_n(ipts,iyoung,:)
+                         est_circ_class_biomass(:,:,:) = circ_class_biomass(ipts,iyoung,:,:,:)
+                         tmp_circ_class_n(:) = new_circ_class_n(ipts,ivm,:)
+                         tmp_circ_class_biomass(:,:,:) = new_circ_class_biomass(ipts,ivm,:,:,:)
+                         
+                         ! Store circumference (m) in a temporary variable that can be 
+                         ! sorted from small to large - note that the dimension of these
+                         ! variables are 2*ncirc
+                         est_circ_class_dia(:) = &
+                              wood_to_dia(est_circ_class_biomass(:,:,icarbon),ivm)
+                         tmp_circ_class_dia(:) = &
+                              wood_to_dia(tmp_circ_class_biomass(:,:,icarbon),ivm)
+
+                         ! Debug
+                         IF(printlev_loc>=4)THEN
+                            WRITE(numout,*) 'stomate_kill share_young, ',ipts, ivm, share_young
+                            WRITE(numout,*) 'rest, ', SUM(circ_class_n(ipts,ivm,:)), &
+                              SUM(est_circ_class_n), SUM(tmp_circ_class_n), &
+                              SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),2),1), &
+                              SUM(est_circ_class_biomass), &
+                              SUM(tmp_circ_class_biomass), &
+                              ipts, iyoung, SUM(est_circ_class_dia), SUM(tmp_circ_class_dia), &
+                              lpft_replant(ipts,ivm)
+                         ENDIF
+                         !-
+
+                         ! Merge the biomass 
+                         CALL merge_biomass_pfts(npts, share_young, circ_class_n, &
+                              est_circ_class_n, tmp_circ_class_n, circ_class_biomass, &
+                              est_circ_class_biomass, &
+                              tmp_circ_class_biomass, circ_class_dist, &
+                              ipts, iyoung, est_circ_class_dia, tmp_circ_class_dia)
+
+                         !! 5.2.3.4 Calculate the PFT characteristics of the merged PFT
+                         !  Take the weighted mean of the existing vegetation and the new 
+                         !  vegetation in this PFT. Note that co2_to_bm is in gC. m-2 dt-1 
+                         !  so we should also take the weighted mean (rather than sum if
+                         !  this where absolute values).
+                         lm_lastyearmax(ipts,iyoung) = share_young * &
+                              lm_lastyearmax(ipts,iyoung) + &
+                              (un - share_young) * new_lm_lastyearmax(ipts,ivm)
+                         age(ipts,iyoung) = share_young * age(ipts,iyoung) + &
+                              (un - share_young) * new_age(ipts,ivm)
+                         leaf_frac(ipts,iyoung,:) = share_young * leaf_frac(ipts,iyoung,:) + &
+                              (un - share_young) * new_leaf_frac(ipts,ivm,:)
+
+                         ! Note that the purpose of the prescribe subroutine is
+                         ! to get biomass (seedlings) without having to simulate
+                         ! seed germination and growth of very small plants.
+                         ! This means that through prescribe we get biomass
+                         ! without GPP, Ra and Rg. They are accounted for for
+                         ! consistency reasons. Germination and growth of
+                         ! seedlings is by-passed through atm_to_bm so this
+                         ! really needs to ba accounted for.
+                         atm_to_bm(ipts,iyoung,:) = share_young * atm_to_bm(ipts,iyoung,:) + &
+                              (un - share_young) * atm_to_bm(ipts,ivm,:)
+                         gpp_daily(ipts,iyoung) = share_young * gpp_daily(ipts,iyoung) + &
+                              (un - share_young) * gpp_daily(ipts,ivm)
+                         resp_maint(ipts,iyoung) = share_young * resp_maint(ipts,iyoung) + &
+                              (un - share_young) * resp_maint(ipts,ivm)
+                         resp_growth(ipts,iyoung) = share_young * resp_growth(ipts,iyoung) + &
+                              (un - share_young) * resp_growth(ipts,ivm) 
+
+                         ! Everywhere deals with the migration of vegetation. Copy the
+                         ! status of the most migrated vegetation for the whole PFT
+                         everywhere(ipts,iyoung) = MAX(everywhere(ipts,iyoung), &
+                              new_everywhere(ipts,ivm))
+
+                         ! The new soil&litter pools are the weighted mean of the newly 
+                         ! established vegetation for that PFT and the vegetation that 
+                         ! already exists in that PFT.  Notice that we do not use the
+                         ! "bank" concept present in LCC because we are replanting
+                         ! the same PFT which already existed, just in a younger class.
+                         litter(ipts,:,iyoung,:,:) = share_young * litter(ipts,:,iyoung,:,:) + &
+                              (un - share_young) * litter(ipts,:,ivm,:,:)
+                         som(ipts,:,iyoung,:) =  share_young * som(ipts,:,iyoung,:) + &
+                              (un - share_young) * som(ipts,:,ivm,:)
+                         DO ilev=1,nlevs
+                            lignin_struc(ipts,iyoung,ilev) = &
+                                 litter_weight_young(istructural,ilev) * &
+                                 lignin_struc(ipts,iyoung,ilev) + &
+                                 (un - litter_weight_young(istructural,ilev)) * &
+                                 lignin_struc(ipts,ivm,ilev) 
+                            lignin_wood(ipts,iyoung,ilev) = &
+                                 litter_weight_young(iwoody,ilev) * &
+                                 lignin_wood(ipts,iyoung,ilev) + &
+                                 (un - litter_weight_young(iwoody,ilev) ) * &
+                                 lignin_wood(ipts,ivm,ilev) 
+                         ENDDO
+                         bm_to_litter(ipts,iyoung,:,:) = share_young * &
+                              bm_to_litter(ipts,iyoung,:,:) + & 
+                              (un - share_young) * bm_to_litter(ipts,ivm,:,:)
+
+                         ! Update the soil pools
+                         soil_n_min(ipts,iyoung,:) = &
+                              share_young * soil_n_min(ipts,iyoung,:) + &
+                              soil_n_min(ipts,ivm,:) * (un - share_young)
+                         p_O2(ipts,iyoung) = share_young * p_O2(ipts,iyoung) + &
+                              p_O2(ipts,ivm) * (un - share_young)
+                         bact(ipts,iyoung) = share_young * bact(ipts,iyoung) + &
+                              bact(ipts,ivm) * (un - share_young)
+
+                         ! Update plant N uptake
+                         n_uptake_daily(ipts,iyoung,iammonium) = share_young * &
+                              n_uptake_daily(ipts,iyoung,iammonium) + &
+                              n_uptake_daily(ipts,ivm,iammonium) * (un - share_young)
+                         n_uptake_daily(ipts,iyoung,initrate) = share_young * &
+                              n_uptake_daily(ipts,iyoung,initrate) + &
+                              n_uptake_daily(ipts,ivm,initrate) * (un - share_young)
+
+                         ! Leaf properties
+                         cn_leaf_min_season(ipts,iyoung) = &
+                              share_young * cn_leaf_min_season(ipts,iyoung) + &
+                              cn_leaf_min_season(ipts,ivm) * (un - share_young)
+
+                         ! For the analytic spinup, we need longterm CN ratios
+                         ! calculated over the spinup period. If the tree grows
+                         ! and move to an older age class, this is taken care of
+                         ! by age_class_distr, but if PFT is killed we need to
+                         ! move CN back to the first age class as well.
+                         ! Otherwise, we will not get a CN ratio for soil and
+                         ! litter pools the corresponds to the spinup period. 
+                         IF(spinup_analytic)THEN
+                            CN_som_litter_longterm(ipts,iyoung,:)=&
+                              share_young * CN_som_litter_longterm(ipts,iyoung,:)+ &
+                              CN_som_litter_longterm(ipts,ivm,:) * (un -share_young)
+                            matrixA(ipts,iyoung,:,:)=&
+                              share_young *matrixA(ipts,iyoung,:,:) + &
+                              matrixA(ipts,ivm,:,:) * (un -share_young)
+                            matrixV(ipts,iyoung,:,:)=&
+                              share_young *matrixV(ipts,iyoung,:,:) + &
+                              matrixV(ipts,ivm,:,:) * (un -share_young)
+                            vectorB(ipts,iyoung,:)=&
+                              share_young *vectorB(ipts,iyoung,:) + &
+                              vectorB(ipts,ivm,:) * (un -share_young)
+                            vectorU(ipts,iyoung,:)=&
+                              share_young *vectorB(ipts,iyoung,:) + &
+                              vectorB(ipts,ivm,:) * (un -share_young)
+
+                         ENDIF
+
+                         ! Now move the veget_cov_max from the current class to the young one.
+                         veget_cov_max(ipts,iyoung)=veget_cov_max(ipts,iyoung)+veget_cov_max(ipts,ivm)
+
+                      ENDIF
+                
+                      ! Reset all these variables, since the PFT is dead.
+                      PFTpresent(ipts,ivm) = .FALSE.
+                      veget_cov_max(ipts,ivm) = zero
+                      lm_lastyearmax(ipts,ivm) = zero
+                      age(ipts,ivm) = zero
+                      leaf_frac(ipts,ivm,:) = zero
+                      atm_to_bm(ipts,ivm,:) = zero
+                      gpp_daily(ipts,ivm) = zero
+                      resp_maint(ipts,ivm) = zero
+                      resp_growth(ipts,ivm) = zero
+                      everywhere(ipts,ivm) = zero
+                      litter(ipts,:,ivm,:,:) = zero
+                      som(ipts,:,ivm,:) = zero
+                      lignin_struc(ipts,ivm,:) = zero
+                      lignin_wood(ipts,ivm,:) = zero
+                      bm_to_litter(ipts,ivm,:,:) = zero
+                      soil_n_min(ipts,ivm,:) = zero
+                      cn_leaf_min_season(ipts,ivm) = zero
+                      bact(ipts,ivm) = zero
+                      p_O2(ipts,ivm) = zero
+                      nstress_season(ipts,ivm) = zero
+                      CN_som_litter_longterm(ipts,ivm,:)=zero 
+                      matrixA(ipts,ivm,:,:) = zero
+                      matrixV(ipts,ivm,:,:) = zero
+                      vectorB(ipts,ivm,:) =  zero
+                      vectorU(ipts,ivm,:) = zero
+                      
+                                           
+                      ! Keep ::biomass and circ_class_biomass synchronized
+                      circ_class_biomass(ipts,ivm,:,:,:) = zero
+                      circ_class_n(ipts,ivm,:) = zero
+                      
+                   ENDIF ! If this is the youngest age class
+
+                ENDIF ! If we are using age classes
+
+             ENDIF ! All biomass in ivm and plant the same species
+
+          ENDIF ! is_tree
+
+       ENDDO  ! loop over pfts
+
+    END DO ! loop over land points
+
+ !! 3. Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 3.2 Check surface area
+       CALL check_surface_area("mortality_clean", npts, veget_cov_max_begin, &
+            veget_cov_max,'ageclass')
+
+       ! 3.3 Mass balance closure 
+       ! 3.3.1 Calculate final biomass
+       pool_end(:,:,:) = zero 
+       DO iele = 1,nelements
+          DO ipar = 1,nparts
+             DO icir = 1,ncirc
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                     (circ_class_biomass(:,:,icir,ipar,iele) * &
+                     circ_class_n(:,:,icir) * veget_cov_max(:,:)) 
+             ENDDO
+          ENDDO
+
+          ! Litter pool (gC m-2) *  (m2 m-2) 
+          DO ilit = 1,nlitt
+             DO ilev = 1,nlevs
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                     litter(:,ilit,:,ilev,iele) * veget_cov_max(:,:)
+             ENDDO
+          ENDDO
+
+          ! Soil carbon (gC m-2) *  (m2 m-2)
+          DO icarb = 1,ncarb
+             pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                  som(:,icarb,:,iele) * veget_cov_max(:,:)
+          ENDDO
+
+       ENDDO
+
+       ! Denitrifying bacteria (only C)
+       pool_end(:,:,icarbon) = pool_end(:,:,icarbon) + &
+            bact(:,:) * veget_cov_max(:,:)
+       
+       ! Nitrogen only
+       DO ispec = 1,nnspec
+          pool_end(:,:,initrogen) = pool_end(:,:,initrogen) + &
+               soil_n_min(:,:,ispec) * veget_cov_max(:,:)
+       ENDDO
+    
+       ! 3.3.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(:,:,iatm2land,iele) = &
+               check_intern(:,:,iatm2land,iele) + &
+               atm_to_bm(:,:,iele) * veget_cov_max(:,:) 
+          check_intern(:,:,ipoolchange,iele) = -un * (pool_end(:,:,iele) - &
+               pool_start(:,:,iele)) 
+       ENDDO
+   
+       ! Specific fluxes
+       check_intern(:,:,iatm2land,icarbon) = &
+            check_intern(:,:,iatm2land,icarbon) + &
+            gpp_daily(:,:) * veget_cov_max(:,:)
+       check_intern(:,:,iland2atm,icarbon) = &
+            check_intern(:,:,iland2atm,icarbon) -un * &
+            (resp_maint(:,:) + resp_growth(:,:)) * &
+            veget_cov_max(:,:)
+
+       !! 1.3 Initialize check for area conservation
+       veget_cov_max_begin(:,:) = veget_cov_max(:,:)
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) WRITE(numout,*) &
+                  'check_intern, ivm, imbc, iele, ', imbc, &
+                  iele, check_intern(:,test_pft,imbc,iele)
+             !-
+             closure_intern(:,:,iele) = closure_intern(:,:,iele) + &
+                  check_intern(:,:,imbc,iele)
+          ENDDO
+       ENDDO
+       
+       ! 4.3.3 Check mass balance closure
+       CALL check_mass_balance("mortality_clean", closure_intern, npts, &
+            pool_end, pool_start, veget_cov_max, 'ageclass')
+       
+    ENDIF ! err_act.GT.1
+    
+    IF (printlev.GE.4) WRITE(numout,*) 'Leaving mortality_clean'
+    
+  END SUBROUTINE mortality_clean
+
+END MODULE stomate_kill
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_laieff.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_laieff.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_laieff.f90	(revision 6412)
@@ -0,0 +1,2848 @@
+! =================================================================================================================================
+! MODULE       : stomate_laieff
+!
+! 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 are used to calculate the effective
+!!             LAI.  Right now this is only used in the albedo routines.  I
+!!             originally tried to put these routines there, but that creates
+!!             some dependency problems that could not be resolved, since
+!!             the effective LAI is calculated in stomate.f90 along with
+!!             the LAI.
+!!
+!!\n DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-DOFOCO/ORCHIDEE/src_stomate/stomate_laieff.f90 $
+!! $Date: 2013-02-13 11:14:38 +0100 (Wed, 13 Feb 2013) $
+!! $Revision: 1182 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_laieff
+
+  ! Modules used:
+  USE constantes
+  USE pft_parameters
+  USE structures
+  USE ioipsl_para, ONLY : ipslerr_p
+  USE stomate_stand_structure
+  USE stomate_data
+  USE function_library, ONLY: wood_to_height_eff, wood_to_cn_eff, biomass_to_lai 
+  USE matrix_resolution
+
+  IMPLICIT NONE
+
+  ! Private & public routines
+
+  PUBLIC effective_lai, fitting_laieff, calculate_z_level_photo, &
+       find_lai_per_level, combine_lai_levels
+
+  INTEGER(i_std) ,SAVE :: ivm_save
+  INTEGER(i_std) ,SAVE :: ibin_save
+  INTEGER(i_std) ,SAVE :: ilevel_save 
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: calculate_z_level_photo
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  :  This is routine to calculate the physical heights of
+!!                 all the levels used to calculate photosynthesis.  The bottom layer
+!!                 will always have a height of zero, since it must be at the ground
+!!                 level.  I tried to make all the layers evenly spaced starting from
+!!                 zero to the top of the canopy, but this does not work very well
+!!                 for tall trees; all the vegetation ends up in the top level and
+!!                 nothing in the lower levels.  So now I try to find the bottom of
+!!                 the canopy for trees as well, and start the second level from there.
+!!                 The top level is always just below the top of the canopy (unless there
+!!                 is only one level).  If there are multiple levels used in the energy
+!!                 budget, the spacing between the levels will not be uniform.
+!!
+!!                 If there is no leaf biomass, all the levels are set to zero since
+!!                 they should not be used and it would be a waste of time to calculate.
+!!
+!!                 Please be aware of the vertical layers. The original design
+!!                 using nlevels and nlevels_photo here in
+!!                 calculate_z_level_photo has only been tested together with
+!!                 the new multi-layer energy budget, when set to nlevels=1 and
+!!                 nlevels_photo=jnlvls_canopy+1.  
+!!    NOTE:
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::z_level_photo
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE calculate_z_level_photo(npts, circ_class_biomass, circ_class_n, z_level_photo)
+
+  !! 0 Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std),INTENT(IN)                        :: npts                 !! Domain size - number of pixels (unitless)
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(IN)  &
+                                                     :: circ_class_biomass   !! Biomass of the componets of the model  
+                                                                             !! tree within a circumference
+                                                                             !! class @tex $(gC ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(IN)        :: circ_class_n         !! Number of trees within each circ class
+                                                                             !! class @tex $(m^{-2})$ @endtex
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION(:,:,:),INTENT(OUT)         :: z_level_photo        !! the height of the bottom of each of our levels 
+                                                                             !! @tex $(m)$ @endtex
+                                                                             !! note that level 1 is closest to the ground
+
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER :: ipts,ivm,il,il_photo,icir                                     !! Indices (unitless)
+    REAL(r_std),DIMENSION(ncirc)  :: heights                                 !! Tree heights @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(ncirc)  :: cn_dia                                  !! Crown diameters @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(ncirc)  :: cn_bottom                               !! Height of the bottom of the crown @tex $(m)$ @endtex
+    REAL(r_std) :: max_height                                                !! Highest actual vegetation height @tex $(m)$ @endtex
+    REAL(r_std) :: min_height                                                !! Lowest bottom of the canopy @tex $(m)$ @endtex
+    REAL(r_std) :: upper_level_boundary                                      !! The height of the top of the current energy budget
+                                                                             !! level @tex $(m)$ @endtex
+    REAL(r_std) :: lower_level_boundary                                      !! The height of the bottom of the current energy budget
+                                                                             !! level @tex $(m)$ @endtex
+    REAL(r_std) :: ideal_level_thickness                                     !! The thickness of the photosynthesis levels in this
+                                                                             !! energy budget level if there are no other concerns.
+                                                                             !! @tex $(m)$ @endtex
+    REAL(r_std) :: block_thickness                                           !! The thickness of a chunk of PS levels together.
+                                                                             !! @tex $(m)$ @endtex
+    REAL(r_std) :: canopy_thickness                                          !! The thickness of the whole vegetation layer.
+                                                                             !! @tex $(m)$ @endtex
+    REAL(r_std) :: canopy_center                                             !! The height of the center of the whole vegetation layer.
+                                                                             !! @tex $(m)$ @endtex
+!_ ================================================================================================================================
+    
+    IF (printlev.GE.4) WRITE(numout,*) 'Entering calculate_z_level_photo'
+
+    ! Initialize local printlev
+    !printlev_loc=get_printlev('laieff')
+
+    ! Debug
+     IF (printlev_loc.GE.4) WRITE(numout,*) 'Entering calculate_z_level_photo',nlevels,nlevels_tot
+
+    ! If we are not using any additional levels for 
+    ! the photosynthesis, this is easy.
+    IF(nlevels_photo .EQ. 1) THEN
+       DO il=1,nlevels
+          z_level_photo(:,:,il)=z_level(il)
+          IF(printlev_loc >= 4)THEN
+             WRITE(numout,*)'is this were we calculate z_level_photo?'
+             WRITE(numout,*) 'yes, z_level_photo is', z_level_photo(:,:,il)
+          ENDIF ! (printlev_loc >= 4)
+       ENDDO
+       RETURN
+    ENDIF
+
+    IF(nlevels .GT. 1)THEN
+       WRITE(numout,*) 'WARNING: calculate_z_level_photo has not been tested yet'
+       WRITE(numout,*) 'WARNING: for the multilevel energy budget.  Be sure to '
+       WRITE(numout,*) 'WARNING: do this and then remove this warning message.'
+    ENDIF
+
+    ! This is just a quick test.  The difference between the energy level heights
+    ! should not be so small that it is impossible to fit all our photosynthesis
+    ! levels in.
+
+    DO il=1,nlevels-1
+
+       ideal_level_thickness=(z_level(il+1)-z_level(il))&
+            /REAL(nlevels_photo,r_std)
+
+       WRITE(numout,*)'ideal_level_thickness',ideal_level_thickness
+
+       DO ivm=1,nvm
+
+          WRITE(numout,*)'min_level_sep,ivm', min_level_sep(ivm),ivm 
+          IF(ideal_level_thickness .LE. min_level_sep(ivm))THEN
+
+             WRITE(numout,*) 'ERROR: We do not have enough space between the energy '
+             WRITE(numout,*) '       levels to fit all the photosynthesis levels you '
+             WRITE(numout,*) '       are asking for.  Either reduce nlevels_photo or min_level_sep, '
+             WRITE(numout,*) '       or increase the width of the levels for the energy budget.'
+
+             WRITE(numout,*) 'il, ivm: ',il,ivm
+             WRITE(numout,*) 'ideal_level_thickness, min_level_sep(ivm): ',&
+                  ideal_level_thickness, min_level_sep(ivm)
+             WRITE(numout,*) 'z_level(il+1),z_level(il): ',z_level(il+1),z_level(il)
+             WRITE(numout,*) 'nlevels_photo: ',nlevels_photo
+
+             CALL ipslerr_p (3,'calculate_z_level_photo', 'Not enough space.','','')
+          ENDIF
+
+       ENDDO
+
+    ENDDO
+
+    DO ipts=1,npts
+       DO ivm=1,nvm
+          ! Skip all of this if we have no leaf biomass
+          IF(SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)) .LE. min_stomate)THEN
+             z_level_photo(ipts,ivm,:)=zero
+             CYCLE
+          ENDIF
+
+          IF(is_tree(ivm))THEN
+
+             ! We need to know the maximum height of the vegetation so that
+             ! we don't calculate a lot of levels with nothing in them
+             ! Notice that we have to use wood_to_height_eff here.  The reason is that
+             ! after coppicing, we may have zero aboveground wood, so our height calculated
+             ! with wood_to_height would be zero.
+             heights(:)=wood_to_height_eff(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+             max_height=MAXVAL(heights(:))
+
+             ! Find the crown diameter and subtract this from the height,
+             ! so that we know where the bottom of the canopy is.
+             cn_dia(:)=SQRT(4._r_std/pi*wood_to_cn_eff(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm))
+             cn_bottom(:)=heights(:)-cn_dia(:)
+             min_height=MINVAL(cn_bottom(:))
+
+             IF(printlev_loc.GT.4)THEN
+               IF((ivm == test_pft) .AND. (ipts == test_grid))THEN
+                   WRITE(numout,*) 'This is the largest height of trees in z_level_photo'
+                   WRITE(numout,*) 'max_height, min_height: ',max_height,min_height
+                   WRITE(numout,*) 'heights: ',heights(:)
+                   WRITE(numout,*) 'cn_dia: ',cn_dia(:)
+                   DO il=1,nlevels
+                      WRITE(numout,*) 'il, ivm: ',il,ivm
+                      WRITE(numout,*) 'min_level_sep(ivm): ',&
+                        min_level_sep(ivm)
+                      IF(il .NE. nlevels) &
+                           WRITE(numout,*) 'z_level(il+1),z_level(il):',z_level(il+1),z_level(il)
+                   ENDDO
+                ENDIF
+             ENDIF
+
+          ELSE
+             ! I took this from stomate_growth_fun_all
+             max_height = biomass_to_lai(SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)* &
+                circ_class_n(ipts,ivm,:)),ivm) * lai_to_height(ivm)
+
+             min_height = 0.0001_r_std ! arbitrary. Don't want it equal to zero because
+                                       ! it won't enter the correct loop below.
+
+             IF(printlev_loc.GT.4)THEN
+                IF((ivm == test_pft) .AND. (ipts == test_grid))THEN
+                   WRITE(numout,*) 'This is the largest height of grasses/crops in z_level_photo'
+                   WRITE(numout,*) 'max_height, min_height: ',max_height,min_height
+                   WRITE(numout,*) 'lai_to_height: ',lai_to_height(ivm)
+                ENDIF
+             ENDIF
+
+          ENDIF
+  
+
+          ! Loop over the levels used by the energy budget.  For each level, there are
+          ! six possibilities, based on the location of the canopy vis-a-vis the location
+          ! of this level height and the level above (if there is no level above, we take
+          ! a boundary that is equal to a very big number).
+          ! The word "slice" refers to the space between this level and the level above.
+          ! 1) Only the bottom part of the canopy is in this slice.
+          ! 2) Only the top part of the canopy is in this slice.
+          ! 3) The whole canopy is below this slice.
+          ! 4) The whole canopy is above this slice.
+          ! 5) The whole canopy is inside this slice.
+          ! 6) The top of the canopy is above the slice, the bottom is below the
+          !    slice, and we just have the middle part in the slice.
+          ! We adjust the photosynthesis levels in this slice to cover as much as the canopy as possible, assuming
+          ! a mininum distince between the levels.  This is done to avoid having a lot of levels with
+          ! very little LAI, which could cause a problem in the photosyntheis routines.
+          ! If there is too much LAI, the absorbed light saturates and we lose
+          ! sensitivity in the photosynthesis routines.  0.5 seems to be a good LAI
+          ! to have in a level, but this is just a feeling.
+
+          DO il=1,nlevels
+
+             lower_level_boundary=z_level(il)
+
+             ! The lowest photosynthesis level should always be equal to
+             ! the lower_level_boundary.  In this way we make sure that
+             ! we account for all the vegetation in this level.  We need
+             ! to make sure we don't overwrite this below.  This means that
+             ! the highest PS level in this level should always be at least
+             ! min_level_sep from the upper_boundary, and that instead of
+             ! nlevels_photo levels to play with, we only have nlevels_photo-1.  This
+             ! should not cause any divide by zero errors since there is
+             ! a loop at the beginning of the subroutine to handle the trivial
+             ! case where nlevels_photo=1.
+             z_level_photo(ipts,ivm,nlevels_photo*(il-1)+1)=lower_level_boundary
+
+             IF(il .NE. nlevels)THEN
+                upper_level_boundary=z_level(il+1)
+             ELSE
+                ! This number is arbitary, but it just needs to be larger than
+                ! the largest possible vegetation height.  10000 meters is a very
+                ! tall tree.
+                upper_level_boundary=10000.0_r_std
+             ENDIF
+
+             IF((min_height .GT. lower_level_boundary .AND. &
+                  min_height .LT. upper_level_boundary ) .AND. &
+                  (max_height .GT. upper_level_boundary))THEN 
+                ! 1) This slice only has the bottom part of the canopy in it.
+                ! Ideally, we would want the second lowest PS level to be just
+                ! above the bottom of the canopy, and the highest PS level
+                ! to be just below the upper boundary.  If there is not
+                ! enough of the canopy to do this and maintain our
+                ! minimum level spacing, we just space the levels
+                ! with this minimum starting from just below the upper boundary.
+                ideal_level_thickness = ((upper_level_boundary-min_level_sep(ivm))-&
+                     (min_height+min_level_sep(ivm)))&
+                     /REAL(nlevels_photo-2,r_std)
+
+                IF(ideal_level_thickness .GT. min_level_sep(ivm))THEN
+                   ! It worked, the levels are thick enough.
+                   DO il_photo=nlevels_photo,2,-1
+                      z_level_photo(ipts,ivm,nlevels_photo*(il-1)+il_photo)=&
+                           (upper_level_boundary-min_level_sep(ivm))-&
+                           ideal_level_thickness*REAL(nlevels_photo-il_photo,r_std)
+                   ENDDO
+
+                ELSE
+
+                   ! Use the minimum level thickness starting from the 
+                   ! upper boundary.
+                   DO il_photo=nlevels_photo,2,-1
+                      z_level_photo(ipts,ivm,nlevels_photo*(il-1)+il_photo)=&
+                           (upper_level_boundary-min_level_sep(ivm))-&
+                           min_level_sep(ivm)*REAL(nlevels_photo-il_photo,r_std)
+                   ENDDO
+
+                ENDIF
+
+             ELSEIF(min_height .LT. lower_level_boundary .AND. &
+                  ((max_height .GT. lower_level_boundary) .AND. &
+                  (max_height .LT. upper_level_boundary)))THEN
+                ! 2) Only the top half of the canopy is in this slice.  We need
+                ! to do the same thing as case (1), but in the other direction.
+                ideal_level_thickness = ((max_height-min_level_sep(ivm))-&
+                     (lower_level_boundary+min_level_sep(ivm)))&
+                     /REAL(nlevels_photo-2,r_std)
+
+                IF(ideal_level_thickness .GT. min_level_sep(ivm))THEN
+                   ! It worked, the levels are thick enough.
+                   DO il_photo=2,nlevels_photo
+                      z_level_photo(ipts,ivm,nlevels_photo*(il-1)+il_photo)=&
+                           (lower_level_boundary+min_level_sep(ivm))+&
+                           ideal_level_thickness*REAL(il_photo-2,r_std)
+                   ENDDO
+
+                ELSE
+
+                   ! Use the minimum level thickness starting from the 
+                   ! upper boundary.
+                   DO il_photo=2,nlevels_photo
+                      z_level_photo(ipts,ivm,nlevels_photo*(il-1)+il_photo)=&
+                           (lower_level_boundary+min_level_sep(ivm))+&
+                           min_level_sep(ivm)*REAL(il_photo-2,r_std)
+                   ENDDO
+
+                ENDIF
+
+             ELSEIF((min_height .GT. upper_level_boundary) .OR. &
+                  (max_height .LT. lower_level_boundary) )THEN
+                ! (3) and (4) The whole canopy is below the slice, or the whole canopy
+                ! is above this slice.  Whatever we do does not
+                ! matter, since there is no LAI in the slice and therefore
+                ! there will be no PS.  
+                DO il_photo=2,nlevels_photo
+                   z_level_photo(ipts,ivm,nlevels_photo*(il-1)+il_photo)=lower_level_boundary+&
+                        min_level_sep(ivm)*REAL(il_photo-1,r_std)
+                ENDDO
+
+             ELSEIF((min_height .GT. lower_level_boundary) .AND. &
+                  (max_height .LT. upper_level_boundary) )THEN
+                ! (5) The whole canopy is inside this slice.  This is the trickiest
+                ! case, and unfortunately the most common.  In fact, it's the only
+                ! case which can exist with a single level energy budget.
+                ideal_level_thickness = ((max_height-min_level_sep(ivm))-&
+                     (min_height+min_level_sep(ivm)))&
+                     /REAL(nlevels_photo-2,r_std)
+
+                IF(ideal_level_thickness .GT. min_level_sep(ivm))THEN
+                   ! It worked, the levels are thick enough.
+!!$                   WRITE(numout,*)'the levels are thick enough'
+                   DO il_photo=2,nlevels_photo
+                      z_level_photo(ipts,ivm,nlevels_photo*(il-1)+il_photo)=&
+                           (min_height+min_level_sep(ivm))+&
+                           ideal_level_thickness*REAL(il_photo-2,r_std)
+                   ENDDO
+
+                ELSE
+
+                   ! Here we have a block of min_level_sep levels.  Let's place the 
+                   ! center of this block in the center of our canopy, and check to see
+                   ! if the ends poke past the boundaries of this slice.
+
+                   block_thickness = REAL(nlevels_photo-2,r_std) * min_level_sep(ivm)
+                   canopy_thickness = (max_height - min_height )
+                   canopy_center = min_height + canopy_thickness / deux
+
+                   IF( ((canopy_center + block_thickness/deux) .LT. &
+                        (upper_level_boundary - min_level_sep(ivm))) .AND. &
+                        (canopy_center - block_thickness/deux) .GT. &
+                        (lower_level_boundary + min_level_sep(ivm)))THEN
+                      ! The block center can be placed at the center of the canopy, which means that
+                      ! the bottom of the block starts at canopy_center - block_thickness/2
+
+                      DO il_photo=2,nlevels_photo
+                         z_level_photo(ipts,ivm,nlevels_photo*(il-1)+il_photo)=&
+                              canopy_center - block_thickness/deux+&
+                              min_level_sep(ivm)*REAL(il_photo-2,r_std)
+                      ENDDO
+
+                   ELSEIF( (canopy_center - block_thickness/deux) .LE. &
+                        (lower_level_boundary + min_level_sep(ivm)))THEN
+                      ! we have enough space up, but not down, so move the whole block upwards.
+                      ! All we have to do is start the block above the lower boundary level.
+
+                      DO il_photo=2,nlevels_photo
+                         z_level_photo(ipts,ivm,nlevels_photo*(il-1)+il_photo)=&
+                              lower_level_boundary + &
+                              min_level_sep(ivm)*REAL(il_photo-1,r_std)
+                      ENDDO
+
+                   ELSEIF( (canopy_center + block_thickness/deux) .GE. &
+                        (upper_level_boundary - min_level_sep(ivm)))THEN
+                      ! we have enough space down, but not up, so move the whole block downwards
+                      ! All we need to do is start the block just below the upper boundary.
+
+                      DO il_photo=nlevels_photo,2,-1
+                         z_level_photo(ipts,ivm,nlevels_photo*(il-1)+il_photo)=&
+                              upper_level_boundary - &
+                              min_level_sep(ivm)*REAL(nlevels_photo-il_photo+1,r_std)
+                      ENDDO
+
+                   ELSE
+                      ! We should not be here!
+                      WRITE(numout,*) 'ERROR: In calculate_z_photo_level, we have reached a '
+                      WRITE(numout,*) 'ERROR: case that I have not foreseen!'
+                      WRITE(numout,*) 'ipts,ivm,il: ',ipts,ivm,il
+                      WRITE(numout,*) 'canopy_center: ',canopy_center
+                      WRITE(numout,*) 'block_thickness: ',block_thickness
+                      WRITE(numout,*) 'upper_level_boundary: ',upper_level_boundary
+                      WRITE(numout,*) 'lower_level_boundary: ',lower_level_boundary
+                      WRITE(numout,*) 'nlevels_photo: ',nlevels_photo
+
+                      CALL ipslerr_p (3,'calculate_z_level_photo', 'Unforeseen case.','','')
+
+                   ENDIF
+
+                ENDIF
+
+             ELSEIF((min_height .LT. lower_level_boundary) .AND. &
+                  (max_height .GT. upper_level_boundary) )THEN
+
+                ! (6) This slice is completely filled by the canopy.  This is easy,
+                ! we just evenly space the levels in this slice.
+                ideal_level_thickness = ((upper_level_boundary-min_level_sep(ivm))-&
+                     (lower_level_boundary+min_level_sep(ivm)))&
+                     /REAL(nlevels_photo-2,r_std)
+
+                DO il_photo=2,nlevels_photo
+                   z_level_photo(ipts,ivm,nlevels_photo*(il-1)+il_photo)=&
+                        (lower_level_boundary+min_level_sep(ivm))+&
+                        ideal_level_thickness*REAL(il_photo-2,r_std)
+                ENDDO
+          
+             ELSE
+
+                ! Should not be here!  This is a case I haven't thought of.
+                WRITE(numout,*) 'Should not be here in find photosynthesis levels!'
+                WRITE(numout,*) 'ipts,ivm,il: ',ipts,ivm,il
+                WRITE(numout,*) 'max_height: ',max_height
+                WRITE(numout,*) 'min_height: ',min_height
+                WRITE(numout,*) 'upper_level_boundary: ',upper_level_boundary
+                WRITE(numout,*) 'lower_level_boundary: ',lower_level_boundary
+                CALL ipslerr_p (3,'calculate_z_level_photo', 'Unforeseen case in ps levels.','','')
+                
+             ENDIF ! All the possible locations of the canopy with respect to
+                   ! the level boundaries.
+          ENDDO
+
+          IF(printlev_loc >= 4 .AND. ivm == test_pft .AND. ipts == test_grid)THEN
+             WRITE(numout,*) 'Printing the level heights used by photosynthesis.'
+             WRITE(numout,*) 'ipts,ivm,max_height: ',ipts,ivm,max_height
+             DO il=1,nlevels_tot
+                WRITE(numout,*) 'il,z_level_photo(ipts,ivm,il): ',&
+                     il,z_level_photo(ipts,ivm,il)
+             ENDDO
+          ENDIF
+       ENDDO
+    ENDDO
+
+    IF (printlev.GE.5) WRITE(numout,*) 'Leaving calculate_z_level_photo'
+
+  END SUBROUTINE calculate_z_level_photo
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: combine_lai_levels
+!!
+!>\BRIEF        Collapses the LAI per photosynthesis level into an array
+!!              which only has the LAI per energy budget level.
+!!
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lai_per_level_temp
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE combine_lai_levels(lai_per_level, lai_per_level_temp)
+
+  !! 0 Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+    
+    REAL(r_std),DIMENSION(:,:,:),INTENT(IN)        :: lai_per_level        !! The LAI per photosynthesis level
+                                                                           !! @tex $(m^{2} m^{-2})$
+
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION(:,:,:),INTENT(OUT)       :: lai_per_level_temp   !! The LAI per energy budget level
+                                                                           !! @tex $(m^{2} m^{-2})$
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER                                        :: il, ilevel           !! indices                        
+!_ ================================================================================================================================
+    
+    IF (printlev.GE.4) WRITE(numout,*) 'Entering combine_lai_levels'
+
+    lai_per_level_temp(:,:,:)=zero
+
+    DO ilevel=1,nlevels_tot
+       il=CEILING(REAL(ilevel)/REAL(nlevels_photo))
+       lai_per_level_temp(:,:,il)=lai_per_level_temp(:,:,il)+lai_per_level(:,:,ilevel)
+    ENDDO
+
+    IF (printlev.GE.5) WRITE(numout,*) 'Leaving combine_lai_levels'
+
+  END SUBROUTINE combine_lai_levels
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: find_lai_per_level
+!!
+!>\BRIEF         Calculates the LAI per vertical level of the canopy.
+!!
+!! DESCRIPTION  :  Given a total biomass, number of individuals, size of individuals,
+!!                 and set of vertical layer boundaries, this routine calculates the
+!!                 the leaf area index (LAI) found between the layer boundaries.  It
+!!                 first makes a call to the stand structure in order to find out some
+!!                 canopy properties like height and canopy diameter, and then uses geometry
+!!                 to determine the amount of LAI present.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lai_per_level
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE find_lai_per_level(npts, z_level_photo, &
+       circ_class_biomass, circ_class_n, lai_per_level, max_height_store)
+
+  !! 0 Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std),INTENT(IN)                         :: npts               !! Domain size - number of pixels (unitless)
+    REAL(r_std),DIMENSION(:,:,:),INTENT(IN)           :: z_level_photo      !! The height of the bottom of each of our levels @tex $(m)$ @endtex
+                                                                            !! Note that level 1 is closest to the ground
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(IN)     :: circ_class_biomass !! Biomass of the componets of the model  
+                                                                            !! tree within a circumference
+                                                                            !! class @tex $(gC ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(IN)         :: circ_class_n       !! Number of trees within each circ class
+                                                                            !! class @tex $(m^{-2})$ @endtex
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(:,:,:), INTENT(OUT)        :: lai_per_level      !! This is the LAI per vertical level
+                                                                            !! @tex $(m^{2} m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)    :: max_height_store
+
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER                                            :: ipts, ivm, il, il_photo, &
+                                                          icir                  !! indices
+    REAL(r_std)                                        :: max_height            !! The height of the tallest tree
+                                                                                !! @tex $(m)$ @endtex
+    REAL(r_std)                                        :: ind_loc               !! The number of individuals
+                                                                                !! @tex $(m^{-2})$ @endtex
+    REAL(r_std)                                        :: upper_boundary        !! The top of the current level 
+                                                                                !! @tex $(m)$ @endtex
+    REAL(r_std)                                        :: lower_boundary        !! The bottom of the current level 
+                                                                                !! @tex $(m)$ @endtex
+    REAL(r_std)                                        :: lai_temp              !! LAI of the current PFT/grid square
+                                                                                !! @tex $(m^{2} m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,ndist_types)  :: values                !! An array which holds various canopy parameters
+    REAL(r_std),DIMENSION(npts,nvm,nlevels_tot)        :: PartialCrownVolumeL   !! The fraction of the crown volume found
+                                                                                !! in this level averaged over all circ classes
+                                                                                !! @tex $(m^{3})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_tot)  :: PartialCrownVolume_h  !! The fraction of the crown volume found
+                                                                                !! in this level for each circ class
+                                                                                !! @tex $(m^{3})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm)                    :: CrownVolumeL          !! The average crown volume of the stand.
+                                                                                !! @tex $(m^3)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm)                    :: favd                  !! Foliage area volume density
+                                                                                !! @tex $(m^2 (leaf) m^{-3})$ @endtex
+
+!_ ================================================================================================================================
+
+    IF (printlev.GE.4) WRITE(numout,*) 'Entering find_lai_per_level'
+
+    ! Initialize local printlev
+    !printlev_loc=get_printlev('laieff')
+
+    CALL derive_biomass_quantities(npts, nvm, ncirc, circ_class_n, &
+         circ_class_biomass, values)
+
+    PartialCrownVolumeL(:,:,:)=zero
+    PartialCrownVolume_h(:,:,:,:)=zero
+    CrownVolumeL(:,:)=zero
+    favd(:,:) = zero    
+
+    DO ipts=1,npts
+       DO ivm=1,nvm
+
+          ! Skip all of this if we have no leaf biomass
+          IF(SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)) .LE. min_stomate)THEN
+             lai_per_level(ipts,ivm,:)=zero
+             CYCLE
+          ENDIF
+
+          ind_loc=SUM(circ_class_n(ipts,ivm,:))
+
+          IF(ind_loc .LT. min_stomate)THEN
+             WRITE(numout,*) 'How do we have biomass but no individuals?'
+             WRITE(numout,*) 'ipts,ivm: ',ipts,ivm
+             WRITE(numout,*) 'biomass(ipts,ivm,ileaf,icarbon),ind_loc: ',&
+                  SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)),ind_loc
+             CALL ipslerr_p (3,'find_lai_per_level', 'Biomass but no individuals.','','')
+          ENDIF
+
+          CALL calculate_favd(ipts,ivm, values(ipts,ivm,:,icnvol), circ_class_biomass, &
+               circ_class_n, favd)
+
+          ! Find the LAI of this PFT.
+          lai_temp = biomass_to_lai(SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)*circ_class_n(ipts,ivm,:)), ivm)
+         
+
+          ! This is done differently for forests and grass/crops, since grass
+          ! and crops will not have a canopy volume.  We just assume a solid
+          ! block of vegetation with a given height.
+
+          IF(is_tree(ivm))THEN
+
+             ! Debug
+             IF(printlev_loc.GT.4 .AND. test_pft == ivm .AND. ipts == test_grid)&
+                  WRITE(6,*) 'On tree ',ivm,lai_temp,favd(ipts,ivm)
+             !-
+
+             max_height = MAXVAL(values(ipts,ivm,:,iheight))
+
+             ! We need to integrate over the height distribution. This is just a
+             ! simple rectangular integration, and it gives us the average crown
+             ! volume for the whole stand.
+             DO icir=1,ncirc
+                CrownVolumeL(ipts,ivm)=CrownVolumeL(ipts,ivm)+&
+                     values(ipts,ivm,icir,icnvol)*&
+                     circ_class_n(ipts,ivm,icir)/ind_loc
+                IF(test_pft == ivm .AND. printlev_loc.GT.4 .AND. ipts == test_grid)THEN
+                   WRITE(numout,*) 'Volume for icir: ',icir,values(ipts,ivm,icir,icnvol)
+                ENDIF
+             ENDDO
+
+             ! Now I need to find the average crown volume per layer.  This is not the
+             ! same thing as taking the average crown volume and dividing it up
+             ! over the layers, since the crowns are at different heights.
+
+             DO il=1,nlevels_tot
+                
+                IF(il .NE. nlevels_tot)THEN
+                   upper_boundary=z_level_photo(ipts,ivm,il+1)
+                ELSE
+                   ! This height is arbitrary.  It just has to include the whole canopy.
+                   upper_boundary=z_level_photo(ipts,ivm,nlevels_tot)+max_height
+                ENDIF
+                lower_boundary=z_level_photo(ipts,ivm,il)
+
+                ! For this level, how much of each canopy is here?  We will also
+                ! integrate this value over the whole height distribution, thus
+                ! finding the average canopy volume in this layer.
+                DO icir=1,ncirc
+
+                   PartialCrownVolume_h(ipts,ivm,icir,il)=&
+                        partial_spheroid_vol(upper_boundary, lower_boundary, &
+                        values(ipts,ivm,icir,icndiaver)/deux, &
+                        values(ipts,ivm,icir,icndiahor)/deux, &
+                        values(ipts,ivm,icir,iheight))
+
+                   ! Debug
+                   IF(printlev_loc.GT.4 .AND. test_pft == ivm .AND. test_grid == ipts)THEN
+                      WRITE(numout,*) 'ipts,ivm,icir,il: ',ipts,ivm,icir,il
+                      WRITE(numout,*) 'PartialCrownVolume_h(ipts,ivm,icir,il): ',&
+                           PartialCrownVolume_h(ipts,ivm,icir,il)
+                      WRITE(numout,*) 'crown diameter: ', values(ipts,ivm,icir,icndiaver)
+                      WRITE(numout,*) 'tree height: ', values(ipts,ivm,icir,iheight)
+                      WRITE(numout,*) 'circ_class_n(ipts,ivm,icir)',circ_class_n(ipts,ivm,icir)
+                   ENDIF
+                   !-
+
+                    ! It's important to note here that the units of PartialCrownVolume_h
+                    ! are m**3/tree, since the canopy properties that we passed to
+                    ! partial_spheroid_vol are also per tree.  We need to get it in
+                    ! m**3/m**2 (land area).
+                    PartialCrownVolumeL(ipts,ivm,il)=PartialCrownVolumeL(ipts,ivm,il)+&
+                         PartialCrownVolume_h(ipts,ivm,icir,il)*&
+                         circ_class_n(ipts,ivm,icir)
+
+                END DO
+
+                ! Now I have the average crown volume per level.  I also have
+                ! the foliage area volume density.  The amount of LAI in this
+                ! level is just the combination of the two.
+                lai_per_level(ipts,ivm,il)=PartialCrownVolumeL(ipts,ivm,il)*&
+                     favd(ipts,ivm)
+
+             ENDDO
+
+              IF(printlev_loc.GT.4 .AND. ipts == test_grid .AND. ivm == test_pft)THEN
+                 WRITE(numout,*) 'CrownVolumeL: ',CrownVolumeL(ipts,ivm)
+              ENDIF
+
+          ELSE
+
+             ! For grasses and crops.
+
+             ! This is not ideal, since we already had to calculate lai_temp 
+             ! and max_height to find the favd.  If there is a speed problem,
+             ! we can change it.
+
+             ! What is the height of our grass/crop?
+       
+             ! This converts LAI to a height.  I took this from functional_allocation.
+             max_height = lai_temp * lai_to_height(ivm)
+
+
+             ! Find out how much of this vegetation cube is in this layer
+             ! These calculations here include some implict factors of 
+             ! m**2/m**2, so be aware of that when calculating the levels.
+             ! All heights are multiplied by 1x1 m to find a volume, but
+             ! that is not explictly shown.
+             DO il=1,nlevels_tot
+
+                IF(il .NE. nlevels_tot)THEN
+                   upper_boundary=z_level_photo(ipts,ivm,il+1)
+                ELSE
+                   ! This height is arbitrary.  It just has to include the whole canopy.
+                   upper_boundary=z_level_photo(ipts,ivm,nlevels_tot)+max_height
+                ENDIF
+                lower_boundary=z_level_photo(ipts,ivm,il)
+
+                IF(max_height .GE. upper_boundary)THEN
+                   ! This whole level is full of vegetation.
+                   lai_per_level(ipts,ivm,il)=&
+                        (upper_boundary-lower_boundary)*favd(ipts,ivm)
+
+                ELSEIF(max_height .LE. lower_boundary)THEN
+
+                   ! There is no vegetation in this level.
+                   lai_per_level(ipts,ivm,il)=zero
+
+                ELSE
+                   
+                   ! This level is partially full.
+                   lai_per_level(ipts,ivm,il)=&
+                        (max_height-lower_boundary)*favd(ipts,ivm)
+
+                ENDIF ! checking where max_height is
+
+             ENDDO
+
+          ENDIF
+
+          IF(test_pft == ivm .AND. test_grid == ipts .AND. printlev_loc.GT.4)THEN
+             WRITE(numout,*) 'LAI per level: ',ipts,ivm
+             DO il=nlevels_tot,1,-1
+                WRITE(numout,*) 'il,lai_per_level(ipts,ivm,il): ',&
+                     il,lai_per_level(ipts,ivm,il)
+             ENDDO
+          ENDIF
+
+          ! Test to see if our LAI is equal to the sum over all the levels.
+          IF( ABS(lai_temp - SUM(lai_per_level(ipts,ivm,:))) &
+               .GT. 1e-5)THEN
+             WRITE(numout,*) '!*****************************************************'
+             WRITE(numout,*) 'Problem in LAI levels! '
+             WRITE(numout,*) 'ipts,ivm: ',ipts,ivm
+             WRITE(numout,*) 'lai_temp, SUM(lai_per_level(ipts,ivm,:)): ',&
+                  lai_temp,SUM(lai_per_level(ipts,ivm,:))
+             DO il=nlevels_tot,1,-1
+                WRITE(numout,*) 'il,lai_per_level(ipts,ivm,il): ',&
+                     il,lai_per_level(ipts,ivm,il)
+             ENDDO
+
+             ! There can be issues using the functions in the print statements.  If a print 
+             ! statement in a function is activated when the function call itself is in a print
+             ! statement, there is a crash.
+             WRITE(numout,*) 'Check whether canopy dimensions exceed the height '
+!             WRITE(numout,*) 'diameter, ', wood_to_dia(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+             WRITE(numout,*) 'diameter, ', values(ipts,ivm,:,idiameter)
+!             WRITE(numout,*) 'height: ', wood_to_height(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)  
+             WRITE(numout,*) 'height: ', values(ipts,ivm,:,iheight)
+!             WRITE(numout,*) 'crown area: ', wood_to_cn(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+             WRITE(numout,*) 'crown area: ', values(ipts,ivm,:,icnarea)
+!             WRITE(numout,*) 'crown diameter: ', (4./pi*wood_to_cn(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm))**(1./2.)
+             WRITE(numout,*) 'crown diameter - ver: ', values(ipts,ivm,:,icndiaver)
+             WRITE(numout,*) 'crown diameter - hor: ', values(ipts,ivm,:,icndiahor)
+             WRITE(numout,*) 'crown volume: ', values(ipts,ivm,:,icnvol)
+             WRITE(numout,*) 'crown diameter used in this routine: ', (6./pi*values(ipts,ivm,:,icnvol))**(1./3.) 
+             WRITE(numout,*) '!*****************************************************'
+             CALL ipslerr_p (2,'find_lai_per_level', 'Inconsistency with LAI in levels.','','')
+          ENDIF ! check to see if the LAI per level is consistent with the total LAI
+
+          max_height_store(ipts, ivm) = max_height
+
+
+       ENDDO ! loop over PFTs
+    ENDDO ! loop over points
+
+    IF (printlev.GE.5) WRITE(numout,*) 'Leaving find_lai_per_level'
+
+  END SUBROUTINE find_lai_per_level
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: fitting_laieff
+!!
+!>\BRIEF          Fits the effective LAI as a function of the solar angle    
+!!
+!! DESCRIPTION  :  Calculation of the effective LAI is a very expensive part of the
+!!                 model, due to the loops over points, PFTs, circ classes, and levels,
+!!                 in addition to using trig functions.  We need this value at
+!!                 every time step (up to 48 times a day).  Thankfully, the function
+!!                 doesn't change a lot, in particular when the sun is high in the sky.
+!!                 Therefore, we will calculate a few points exactly, and then fit
+!!                 a function to these points to predict the value of the LAIeff at any
+!!                 solar angle.  This method seems to work well for low solar zenith
+!!                 angles, which are the most important since they will have the most
+!!                 incoming solar radiation.
+!!
+!!    NOTE:
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::laieff_fit
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE fitting_laieff(npts, z_level_photo, circ_class_biomass, &
+       circ_class_n, veget_cov_max, lai_per_level, laieff_fit, &
+       h_array_out, z_array_out)
+
+  !! 0 Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std),INTENT(IN)                              :: npts                !! Domain size - number of pixels (unitless)
+    REAL(r_std),DIMENSION(:,:,:),INTENT(IN)                :: z_level_photo       !! the height of the bottom of each of our levels 
+                                                                                  !! @tex $(m)$ @endtex
+                                                                                  !! note that level 1 is closest to the ground
+    REAL(r_std), DIMENSION(:,:,:,:,:), &
+         INTENT(IN)                                        :: circ_class_biomass  !! Biomass of the componets of the model  
+                                                                                  !! tree within a circumference class
+                                                                                  !! @tex $(gC ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(IN)              :: circ_class_n        !! Number of trees within each circ class
+                                                                                  !! @tex $(m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(:,:),INTENT(IN)                  :: veget_cov_max           !! Maximum fraction of vegetation type including 
+                                                                                  !! non-biological fraction (unitless)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(IN)              :: lai_per_level       !! This is the LAI per vertical level
+                                                                                  !! @tex $(m^{2} m^{-2})$
+    !! 0.2 Output variables
+    TYPE(laieff_type),DIMENSION (:,:,:),INTENT(OUT)        :: laieff_fit          !! Fitted parameters for the effective LAI
+
+
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_tot), INTENT(OUT)      &                
+                                                           :: h_array_out         !! An output of h_array, to use in sechiba
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_tot), INTENT(OUT)      &                
+                                                           :: z_array_out         !! Height above soil of the Pgap points.
+                                                                                  !! @tex $(m)$ @endtex 
+
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    !+++CHECK+++
+    ! Idealy, the next two values would be externalised.
+    INTEGER, PARAMETER                                     :: nangles=8           !! The number of angles to fit the parameterization
+                                                                                  !! of the effective LAI. 
+
+    REAL(r_std), DIMENSION(nangles)                        :: param_angles        !! the angles to
+    !+++++++++++
+
+    REAL(r_std), DIMENSION(nlevels_tot,npts,nvm,nangles)   :: laieff              !! Leaf Area Index Effective converts 3D lai into 
+                                                                                  !! 1D lai for two stream radiation transfer model
+                                                                                  !! @tex $(m^{2} m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts)                           :: solar_angle         !! The solar zenith angle of every grid square 
+                                                                                  !! @tex $(rad)$ @endtex 
+    INTEGER(i_std)                                         :: ilevel, ipts, icir  !! index (unitless)
+    INTEGER(i_std)                                         :: ivm, iangle, jangle !! index (unitless)
+
+    INTEGER(i_std)                                         :: nzero               !! Counter to keep track of the number of
+                                                                                  !! LAIeff with value zero
+    INTEGER(i_std)                                         :: temp_index          !! An index which allows us to fit only non-zero
+                                                                                  !! values
+    REAL(r_std), DIMENSION(npts)                           :: test_angles         !! Converts the param_angles (degrees) into radians
+                                                                                  !! @tex $(rad)$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nlevels_tot)           :: z_array2_out           !! Same as z_array, but one less dimension.
+                                                                                  !! @tex $(m)$ @endtex (local because the 
+                                                                                  !! call to effective_lai requires it)]
+    REAL(r_std),DIMENSION(npts,nvm,nlevels_tot)            :: Pgap_out            !! The transmission probabilility of light through 
+                                                                                  !! the canopy.  This is per level, not cumulative.
+                                                                                  !! (unitless, between 0 and 1) 
+    REAL(r_std), DIMENSION(npts,nvm)                       :: favd                !! The LAI per canopy volume density
+                                                                                  !! @tex $(m^{-3} m^{-2})$ @endtex
+
+!_ ================================================================================================================================
+    
+    IF (printlev.GE.4) WRITE(numout,*) 'Entering fitting_laieff'
+
+    ! Debug
+    IF (printlev_loc.GT.4) THEN
+       WRITE(numout, *) '130416 nlevels_tot is: ', nlevels_tot
+       WRITE(numout, *) '130416 nlevels_photo is: ', nlevels_photo
+    ENDIF
+    !-
+
+    ! Initialize local printlev
+    !printlev_loc=get_printlev('laieff')
+
+    !! 1. Initialize check for surface area conservation
+    !  Veget_max is a INTENT(in) variable and can therefore
+    !  not be changed during the course of this subroutine
+    !  No need to check whether the subroutine preserves the
+    !  total surface area of the pixel.
+
+    !! 2. Calculations
+    ! We want to parameterize the effective LAI as a function of
+    ! the solar zenith angle for every level, grid square, and
+    ! PFT type.  Let's choose a series of angles to use.
+    ! There are somtimes numerical issues with using exactly
+    ! 90 degrees or exactly 0 degrees.
+
+!    param_angles = (/ 5.0, 15.0, 25.0, 35.0, 45.0, 55.0, 65.0, 75.0, 85.0 /)
+    ! Using high SZA (near the horizon) seems to cause problems
+    ! with the fitting, as strange behavior happens there.  Since there
+    ! is not a lot of light, let's use smaller values.
+    param_angles = (/ 5.0, 15.0, 25.0, 35.0, 45.0, 55.0, 65.0, 75.0 /)
+
+
+    ! Right now, I'm doing this the brute force way.  It will probably
+    ! need to be refined later.
+
+    DO iangle=1,nangles
+
+       test_angles(:)=COS(param_angles(iangle)/180.0*pi)
+       
+       ! Debug
+       IF(printlev_loc.GT.4)&
+            WRITE(numout,*) 'Calculating for test angle: ',param_angles(iangle)
+       !-
+
+       CALL effective_lai(npts, nlevels_tot, z_level_photo,  circ_class_biomass, &
+            circ_class_n, veget_cov_max, test_angles, lai_per_level, &
+            laieff(:,:,:,iangle),h_array_out=h_array_out,z_array_out=z_array_out,&
+            z_array2_out=z_array2_out,Pgap_out=Pgap_out)
+
+       ! Debug
+       IF(printlev_loc.GT.4)THEN
+          DO ipts=1,npts
+             DO ivm=1,nvm
+                IF(ipts == test_grid .AND. ivm == test_pft)THEN
+                   WRITE(numout,*) 'LAIEFF for angle ',param_angles(iangle)
+                   DO ilevel=nlevels_tot,1,-1
+                      WRITE(numout,*) ilevel,laieff(ilevel,ipts,ivm,iangle)
+                   ENDDO
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDIF
+       !-
+
+    ENDDO
+
+    param_angles(:)=COS(param_angles(:)/180.0_r_std*pi)
+
+    ! Now we have all the data points, so we can fit the function.
+    DO ipts=1,npts
+       DO ivm=1,nvm
+          DO ilevel=1,nlevels_tot
+
+             ! The 0.001 is completely arbitrary here.
+             IF(SUM(laieff(ilevel,ipts,ivm,:)) .GT. 0.001_r_std )THEN
+
+                ! We have a choice to make.  Sometimes the laieff for highest zenith angles
+                ! will be zero, even if the previous points were not.  This seems to happen
+                ! when no light gets through, which is normal for lower vegetation
+                ! levels as the sun gets closer to the horizon.  The pattern of points is
+                ! something like 1,1,1,1,1,1.9,4.0,0.0.  This causes a problem for
+                ! fitting, and we don't care too much about this largest angle.  If we
+                ! can fit the first points well, and the last point is greater than 4.0, 
+                ! we will probably be okay since there is not a lot of sunlight wen the
+                ! sun is near the horizon in any case.  So let's run a test.
+                IF(laieff(ilevel,ipts,ivm,nangles) .LT. min_stomate)THEN
+
+                   ! We know that the sum of all elements is greater than our cutoff
+                   ! above, so we need to find the final substantial element.
+                   ! Count backwards to see how many zero elements we have
+                   ! at the end.
+                   nzero=1
+                   DO iangle=nangles-1,1,-1
+                      IF(laieff(ilevel,ipts,ivm,iangle) .LT. min_stomate)THEN
+                         nzero=nzero+1
+                      ELSE
+                         EXIT
+                      ENDIF
+                   ENDDO
+                   
+                   IF(nzero .GE. nangles)THEN
+                      WRITE(numout,*) 'ERROR: Something went wrong in fitting the laieff!'
+                      WRITE(numout,*) 'ipts,ivm,ilevel: ',ipts,ivm,ilevel
+                      WRITE(numout,*) 'nzero,nangles: ',nzero,nangles
+                      WRITE(numout,*) 'laieff(ilevel,ipts,ivm,:): ',laieff(ilevel,ipts,ivm,:)
+                      CALL ipslerr_p (3,'fitting_laieff', 'All zero values in the fit.','','')
+                   ENDIF
+
+                   ! This three is also arbitrary.
+                   IF(nzero .GE. 3)THEN
+                      WRITE(numout,*) 'ERROR: A surprising number of zero values in laieff!'
+                      WRITE(numout,*) 'ipts,ivm,ilevel: ',ipts,ivm,ilevel
+                      WRITE(numout,*) 'nzero,nangles: ',nzero,nangles
+                      WRITE(numout,*) 'laieff(ilevel,ipts,ivm,:): ',laieff(ilevel,ipts,ivm,:)
+                      CALL ipslerr_p (3,'fitting_laieff', 'Too many zero values in the fit.','','')
+                   ENDIF
+
+                   ! Only use the first non-zero values for the fitting
+                   temp_index=nangles-nzero
+                   CALL fit_laieff_to_points(temp_index,param_angles(1:temp_index),&
+                        laieff(ilevel,ipts,ivm,1:temp_index), &
+                        laieff_fit(ipts,ivm,ilevel),ipts,ivm,ilevel)
+                ELSE
+                   CALL fit_laieff_to_points(nangles,param_angles,laieff(ilevel,ipts,ivm,:), &
+                        laieff_fit(ipts,ivm,ilevel),ipts,ivm,ilevel)
+                ENDIF
+
+             ELSE
+
+                ! Not enough vegetation to fit it.  Everything is zero.
+                laieff_fit(ipts,ivm,ilevel)%a=zero
+                laieff_fit(ipts,ivm,ilevel)%b=zero
+                laieff_fit(ipts,ivm,ilevel)%c=zero
+                laieff_fit(ipts,ivm,ilevel)%d=zero
+                laieff_fit(ipts,ivm,ilevel)%e=zero
+             ENDIF
+          END DO
+       ENDDO
+    ENDDO
+
+    ! Now we have all the data points, so we can fit the function.
+    DO ipts=1,npts
+       DO ivm=1,nvm
+          DO ilevel=1,nlevels_tot
+                  IF(laieff_fit(ipts,ivm,ilevel)%a .LT. 0.0d0)THEN
+                     ! temporary, during merge, to try and eliminate negative values
+                     IF(printlev_loc.GT.4) &
+                          WRITE(numout, *) '130416c laieff is at this point less than zero' 
+                     laieff_fit(ipts,ivm,ilevel)%a = 0.0d0
+                  END IF
+                  IF(laieff_fit(ipts,ivm,ilevel)%b .LT. 0.0d0)THEN
+                     ! temporary, during merge, to try and eliminate negative values
+                     IF(printlev_loc.GT.4) &
+                          WRITE(numout, *) '130416c laieff is at this point less than zero' 
+                     laieff_fit(ipts,ivm,ilevel)%b = 0.0d0
+                  END IF
+                  IF(laieff_fit(ipts,ivm,ilevel)%c .LT. 0.0d0)THEN
+                     ! temporary, during merge, to try and eliminate negative values
+                     IF(printlev_loc.GT.4) &
+                          WRITE(numout, *) '130416c laieff is at this point less than zero' 
+                     laieff_fit(ipts,ivm,ilevel)%c = 0.0d0
+                  END IF
+                  IF(laieff_fit(ipts,ivm,ilevel)%d .LT. 0.0d0)THEN
+                     ! temporary, during merge, to try and eliminate negative values
+                     IF(printlev_loc.GT.4) &
+                          WRITE(numout, *) '130416c laieff is at this point less than zero' 
+                     laieff_fit(ipts,ivm,ilevel)%d = 0.0d0
+                  END IF
+                  IF(laieff_fit(ipts,ivm,ilevel)%e .LT. 0.0d0)THEN
+                     ! temporary, during merge, to try and eliminate negative values
+                     IF(printlev_loc.GT.4) &
+                          WRITE(numout, *) '130416c laieff is at this point less than zero' 
+                     laieff_fit(ipts,ivm,ilevel)%e = 0.0d0
+                  END IF
+          END DO
+       ENDDO
+    ENDDO
+
+    ! Debug
+    IF(printlev_loc.GT.4) THEN
+       WRITE(numout, *) '130416b end of fitting_laieff'
+       WRITE(numout, *) '130416b laieff_fit(1,4,:): ', laieff_fit(1,4,:)
+    ENDIF
+    !-
+
+    IF (printlev.GE.5) WRITE(numout,*) 'Leaving fitting_laieff'
+
+  END SUBROUTINE fitting_laieff
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: fit_laieff_to_points
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : 
+!!
+!!    NOTE:
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::laieff_fit
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE fit_laieff_to_points(nangles, test_angles, laieff, laieff_fit, ipts, ivm, ilevel)
+
+  !! 0 Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std),INTENT(IN)                  :: nangles          !! The number of angles (data points)
+    INTEGER(i_std),INTENT(IN)                  :: ipts             !! The grid square
+    INTEGER(i_std),INTENT(IN)                  :: ivm              !! The PFT number
+    INTEGER(i_std),INTENT(IN)                  :: ilevel           !! The canopy level
+    REAL(r_std),DIMENSION(:),INTENT(IN)        :: test_angles      !! the cosine of the solar angles
+    REAL(r_std),DIMENSION(:),INTENT(IN)        :: laieff           !! the laieff at each of these angles
+
+    !! 0.2 Output variables
+    TYPE(laieff_type),INTENT(out)              :: laieff_fit       !! Fitted parameters for the effective LAI
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std)   :: x,y,one,x2,x3,x4,x5,x6,x7,x8,xy,x2y,x3y,x4y
+    INTEGER  :: iangle
+    REAL(r_std),DIMENSION(5) :: vector_b
+    REAL(r_std),DIMENSION(5,5) :: matrix_a
+    REAL(r_std) :: mean,sse,sst,r_corr, max_diff, diff
+
+!_ ================================================================================================================================
+    
+    IF (printlev.GE.4) WRITE(numout,*) 'Entering fit_laieff_to_points'
+
+    ! Initialize local printlev
+    !printlev_loc=get_printlev('laieff')
+
+    ! We have a set of angles, test_angles.  We also have the
+    ! effective LAI for each of these angles.  The structure
+    ! laieff_fit gives the parameters and functional form.
+    ! If you wish to change the functional form, you need to 
+    ! change this routine, the lai_type, and the function
+    ! below which evaluates the LAIeff as a function of
+    ! the angle.
+    
+    ! We are going to use a least squares method to fit a parabola
+    ! of the form a+b*x+c*x**2+d*x**3+e*x**4.  This means we will need to solve
+    ! a system of linear equations, A x = b.
+    ! In this notation, y is the sum over all angles for the laieff,
+    ! x is the sum for the angles, x2 is the sum of the square of the
+    ! angles, etc.
+
+    y=zero
+    xy=zero
+    x2y=zero
+    x3y=zero
+    x4y=zero
+    one=zero
+    x=zero
+    x2=zero
+    x3=zero
+    x4=zero
+    x5=zero
+    x6=zero
+    x7=zero
+    x8=zero
+    DO iangle=1,nangles
+           y=y+laieff(iangle)
+           xy=xy+test_angles(iangle)*laieff(iangle)
+           x2y=x2y+test_angles(iangle)**2*laieff(iangle)
+           x3y=x3y+test_angles(iangle)**3*laieff(iangle)
+           x4y=x4y+test_angles(iangle)**4*laieff(iangle)
+           x=x+test_angles(iangle)
+           x2=x2+test_angles(iangle)**2
+           x3=x3+test_angles(iangle)**3
+           x4=x4+test_angles(iangle)**4
+           x5=x5+test_angles(iangle)**5
+           x6=x6+test_angles(iangle)**6
+           x7=x7+test_angles(iangle)**7
+           x8=x8+test_angles(iangle)**8
+    ENDDO
+    one=REAL(nangles)
+
+    ! Now we create our system of equations.
+    vector_b(1:5) = (/ y, xy, x2y, x3y, x4y /)
+
+    ! From what I see in the gauss_jordan routine, the format is
+    ! matrix(row, column), which matches standard notation. In this
+    ! case the matrix is symmetric, anyway.
+    matrix_a(1,1:5) = (/ one,  x, x2, x3, x4 /) 
+    matrix_a(2,1:5) = (/   x, x2, x3, x4, x5 /) 
+    matrix_a(3,1:5) = (/  x2, x3, x4, x5, x6 /)
+    matrix_a(4,1:5) = (/  x3, x4, x5, x6, x7 /)
+    matrix_a(5,1:5) = (/  x4, x5, x6, x7, x8 /)
+
+    ! TEST... should give -2, 3, 1...it does
+!    matrix_a(1,1:3) = (/  -3, 2, -6 /) 
+!    matrix_a(2,1:3) = (/  5, 7, -5 /) 
+!    matrix_a(3,1:3) = (/  1, 4, -2 /)
+!    vector_b(1:3) = (/ 6, 6, 8 /)
+
+    CALL gauss_jordan_method(SIZE(vector_b),matrix_a,vector_b)
+
+    ! These are our parameters.
+    laieff_fit%a=vector_b(1)
+    laieff_fit%b=vector_b(2)
+    laieff_fit%c=vector_b(3)
+    laieff_fit%d=vector_b(4)
+    laieff_fit%e=vector_b(5)
+
+    !++++++ CHECK ++++++++
+    !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    ! These are some checks that we do to make sure our fitting
+    ! is decent.  I'm going to leave these on during parameterization,
+    ! but we might want to remove it during the real runs.  Things
+    ! should be tested well before then, and it will only be freak
+    ! chance that causes it to fail afterwards.  If this happens
+    ! on one day in one hundred years, we don't care so much.
+
+    ! Calculate a regression coefficienct
+    sst=zero
+    sse=zero
+    mean=zero
+    DO iangle=1,nangles
+       mean=mean+laieff(iangle)
+    ENDDO
+    mean=mean/REAL(nangles)
+    max_diff=zero
+    DO iangle=1,nangles
+       sst=sst+(laieff(iangle)-mean)**2
+       diff=laieff(iangle)-calculate_laieff_fit(test_angles(iangle),laieff_fit)
+       sse=sse+diff**2
+       IF(diff .GT. max_diff) max_diff=diff
+    ENDDO
+
+    IF(sse .GT. sst)THEN
+       r_corr = zero
+    ELSEIF(sst .EQ. zero)THEN
+       r_corr = zero
+    ELSE
+       r_corr=SQRT(un-sse/sst)
+    ENDIF
+
+    ! Debug
+    IF(printlev_loc.GT.4 .AND. (ipts == test_grid) .AND. (ivm == test_pft)) &
+         WRITE(numout,*) 'Regression coefficient: ',r_corr
+    !-
+
+    IF(r_corr .LT. 0.95)THEN
+
+       ! Sometimes the correlation coefficient is not great, but the difference
+       ! in the values is really small.  We don't care so much if our values
+       ! are off by 0.001.
+
+       ! Debug
+       IF(printlev_loc.GT.4 .AND. (ipts == test_grid) .AND. (ivm == test_pft)) &
+            WRITE(numout,*) 'max_diff ',max_diff
+       !-
+
+       IF(max_diff .GT. 0.01)THEN
+          WRITE(numout,*) 'Difference is too big for fitting!'
+          WRITE(numout,*) 'max_diff ',max_diff
+          WRITE(numout,*) 'r_corr ',r_corr
+          WRITE(numout,*) 'ipts,ivm,ilevel: ',ipts,ivm,ilevel
+          WRITE(numout,*) 'COS(angle)     Real value       Fitted value'
+          DO iangle=1,nangles
+             WRITE(1600,'(10F20.10)') test_angles(iangle),&
+                  laieff(iangle),calculate_laieff_fit(test_angles(iangle),laieff_fit)
+             WRITE(numout,'(10F20.10)') test_angles(iangle),&
+                  laieff(iangle),calculate_laieff_fit(test_angles(iangle),laieff_fit) 
+          ENDDO
+          CALL ipslerr_p (3,'fitting_laieff', 'Difference is too big for fitting.','','')
+       ENDIF
+    ENDIF
+    !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+    ! Some debugging information
+    IF(printlev_loc.GT.4 .AND. (ivm == test_pft) .AND. (ipts == test_grid))THEN
+       ! Let's see how closely they match
+       DO iangle=1,nangles
+          IF(SUM(laieff(:)) .GT. 0.1 )THEN
+             WRITE(numout,*) 'TESTING fitting LAIEFF ',ipts,ivm,ilevel
+             WRITE(numout,'(10F16.8)') test_angles(iangle),&
+                  laieff(iangle),calculate_laieff_fit(test_angles(iangle),laieff_fit)
+          ENDIF
+       ENDDO
+    ENDIF
+
+    IF (printlev.GE.5) WRITE(numout,*) 'Leaving fit_laieff_to_points'
+
+  END SUBROUTINE fit_laieff_to_points
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: effective_lai
+!!
+!>\BRIEF        Calculate effective lai for the 1-D two stream 
+!! radiative canopy transfer model
+!!
+!! DESCRIPTION  : The effective LAI is computed to be used with the two-stream
+!!    albedo model described by Pinty 2006, by using an equation in Pinty 2004
+!!    and the Pgap method of Haverd et al...code was taken from the latter group
+!!    and cleaned up and reformatted...these routines were valided against the original
+!!    code and gave identical results for Pgap (the original code was single precision, while
+!!    these results are double precision):
+!!
+!!    NOTE:
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::laieff, ::Pgap_out
+!!
+!! REFERENCE(S) : Pinty et al; Simplifying the interaction of land surfaces 
+!!   with radiation for relating remote sensing products to climate models
+!!   JOURNAL OF GEOPHYSICAL RESEARCH, VOL. 111, D02116, doi:10.1029/2005JD005952, 2006
+!!
+!!                Pinty et al; Synergy between 1-D and 3-D radiation transfer models
+!!   to retrieve vegetation canopy properties from remote sensing data
+!!   JOURNAL OF GEOPHYSICAL RESEARCH, VOL. 109, D21205, doi:10.1029/2004JD005214, 2004
+!!
+!!                Haverd et al; The Canopy Semi-analytic Pgap and radiative transfer 
+!!   (CanSPART) model: Formulation and application
+!!   AGRICULTURAL AND FOREST METEOROLOGY, VOL. 160, pp. 14-35, 2012
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE effective_lai(npts, nlevels_loc, z_level_loc,  circ_class_biomass, &
+       circ_class_n, veget_cov_max, coszang, lai_per_level, laieff, z_array2_out, &
+       h_array_out, z_array_out, Pgap_out)
+
+  !! 0 Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(IN)                      :: nlevels_loc           !! The number of physical levels over which we
+                                                                            !! will calculate the gap probability. We still 
+                                                                            !! need  nlevels_loc in this subroutine call, 
+                                                                            !! as this it also called from slowproc_vege, but
+                                                                            !! only for the layer at the soil.
+    INTEGER(i_std),INTENT(IN)                      :: npts                  !! Domain size - number of pixels (unitless)
+                                                                            !! we will calculate the gap probability.
+    REAL(r_std),DIMENSION(:,:,:),INTENT(IN)        :: z_level_loc           !! the height of the bottom of each of our levels @tex $(m)$ @endtex
+                                                                            !! note that level 1 is closest to the ground
+    REAL(r_std), DIMENSION(:,:,:,:,:), &
+         INTENT(IN)                                :: circ_class_biomass    !! Biomass of the componets of the model  
+                                                                            !! tree within a circumference
+                                                                            !! class @tex $(gC ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(IN)      :: circ_class_n          !! Number of trees within each circ class
+                                                                            !! class @tex $(m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(:,:),INTENT(IN)          :: veget_cov_max             !! Maximum fraction of vegetation type including 
+                                                                            !! non-biological fraction (unitless)
+    REAL(r_std), DIMENSION(:), INTENT(in)          :: coszang                !! the cosine of the view zenith angle
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)      :: lai_per_level         !! This is the LAI per vertical level
+                                                                            !! @tex $(m^{2} m^{-2})$
+
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION(:,:,:),INTENT(OUT)       :: laieff                !! Leaf Area Index Effective converts 3D lai into 
+                                                                            !! 1D lai for two stream radiation transfer model
+                                                                            !! @tex $(m^{2} m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,nvm,nlevels_loc),INTENT(OUT),OPTIONAL  &
+                                                   :: Pgap_out              !! The transmission probabilility of light through 
+                                                                            !! the canopy.  This is per level, not cumulative.
+                                                                            !! (unitless, between 0 and 1) 
+
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc), INTENT(OUT), OPTIONAL      &                
+                                                   :: z_array_out           !! Height above soil of the Pgap points.
+                                                                            !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,nlevels_loc), INTENT(OUT), OPTIONAL            &                
+                                                   :: z_array2_out          !! Same as z_array, but one less dimension.
+                                                                            !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc), INTENT(OUT), OPTIONAL      &                
+                                                   :: h_array_out           !! An output of h_array, to use in sechiba
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                   :: solar_angle           !! the view angle of every grid square (radians)
+    INTEGER(i_std)                                 :: ilevel, ipts, icir    !! index (unitless)
+    INTEGER(i_std)                                 :: ivm, jlevel           !! index (unitless)
+    INTEGER(i_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)   &
+                                                   :: upward_array          !! Flag to indicate if the view angle is pointing
+                                                                            !! upwards (1) or downwards (0). (unitless)
+ 
+    ! These next values need a bit of caution with the units.  Since they are derived
+    ! from circ_class_biomass, it seems they have units per land area, in
+    ! addition to the units given here.
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &
+                                                   :: ver_axis_array        !! The veritical diameter of the tree canopy.
+                                                                            !! @tex $(m)$ @endtex 
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &                
+                                                   :: hor_axis_array        !! The horizontal diameter of the tree canopy.
+                                                                            !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &                
+                                                   :: h_array               !! Height to the top of the tree canopy.
+                                                                            !! @tex $(m)$ @endtex
+
+
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &
+                                                   :: crown_shadow_h        !! The projected shadow of an opaque crown.
+                                                                            !! @tex $(m^2)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &
+                                                   :: trunk_shadow_h        !! The projected shadow of the trunk.
+                                                                            !! @tex $(m^2)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &
+                                                   :: crown_area_h          !! The area of a horizontal plane cutting
+                                                                            !! through the crown.
+                                                                            !! @tex $(m^2)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &
+                                                   :: sbar_h                !! The mean free distance through the crown
+                                                                            !! along the path dictated by the view angle.
+                                                                            !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &
+                                                   :: ph_array              !! The height of the top of the canopy.
+                                                                            !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &
+                                                   :: favd_array            !! The foliage area volume density of
+                                                                            !! the canopy.
+                                                                            !! @tex $(LAI m^{-3})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &
+                                                   :: DBH_array             !! Trunk diameter at breast height.
+                                                                            !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &
+                                                   :: G_array               !! The mean horizontal projection of
+                                                                            !! unit leaf area (leaf orientation function).
+                                                                            !! @tex $(m^{-2})$ @endtex
+    ! These next two values are not currently used since we set G=0.5
+!!$    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &
+!!$                                                   :: thetaL_mean_array
+!!$    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &
+!!$                                                   :: thetaL_sd_array
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc)      &
+                                                   :: Pwc_h                 !! Crown porosity.
+                                                                            !! (unitless)
+    REAL(r_std),DIMENSION(npts,nvm,nlevels_loc)    :: TrunkShadowL          !! Trunk shadow, integrated over the population.
+                                                                            !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,nlevels_loc)    :: CrownAreaL            !! The area of a horizontal plane cutting
+                                                                            !! through the crown, averaged over population.
+                                                                            !! @tex $(m^2 m^{-2})$ @endtex
+!    REAL(r_std),DIMENSION(npts,nvm,nlevels_loc)    :: Pbc_trunkL
+    REAL(r_std),DIMENSION(npts,nvm,nlevels_loc)    :: PorousCrownShadowL    !! The average shadow cast by a tree taking
+                                                                            !! into account porosity.
+                                                                            !! @tex $(m^2)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,nlevels_loc)    :: PgapL                 !! The probability of finding a gap in the
+                                                                            !! in the canopy.
+                                                                            !! (unitless)
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_loc):: z_array             !! Height above soil of the Pgap points.
+                                                                            !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,nlevels_loc)    :: z_array2              !! Same as z_array, but one less dimension.
+                                                                            !! @tex $(m)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,ncirc)          :: CrownVolume_h         !! The crown volume of a circ class.
+                                                                            !! @tex $(m^3)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm)                :: CrownVolumeL          !! The average crown volume of the stand.
+                                                                            !! @tex $(m^3)$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm)                :: favd                  !! The foliage area volume density of
+                                                                            !! the canopy.
+                                                                            !! @tex $(LAI m^{-3})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)               :: ind_loc               !! Density of individuals
+                                                                            !! @tex $(m^{-2})$ @endtex
+    ! The following two variables are ways to speed up the calculation
+    ! by not trying to calculate everything, based on if we have
+    ! biomass or individuals for this PFT on the grid square
+    LOGICAL, DIMENSION(npts,nvm)                   :: lcalculate_tree       !! For trees
+    LOGICAL, DIMENSION(npts,nvm)                   :: lcalculate_nontree    !! For non-trees
+
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,ndist_types)  :: values            !! An array that holds canopy properties.
+    REAL(r_std)                                    :: lai_sum               !! The total LAI in the canopy,
+                                                                            !! summed across all levels.
+                                                                            !! @tex $(m^{2} m^{-2})$
+    REAL(r_std),PARAMETER                          :: max_laieff=20.0       !! A numerical construct to cap the effective LAI so 
+                                                                            !! as to not cause numerical problems. If laieff > 20
+                                                                            !! the lai >> 20 so we have a problem somewhere else.
+    REAL(r_std)                                    :: min_pgap              !! The probability that light makes
+                                                                            !! it through a layer of max_laieff thickness.
+   
+!_ ================================================================================================================================
+    
+    IF (printlev.GE.4) WRITE(numout,*) 'Entering effective_lai'
+
+    ! Initialize local printlev
+    !printlev_loc=get_printlev('laieff')
+
+    !! 1. Initialize check for surface area conservation
+    !  Veget_max is a INTENT(in) variable and can therefore
+    !  not be changed during the course of this subroutine
+    !  No need to check whether the subroutine preserves the
+    !  total surface area of the pixel.
+
+    !! 2. Initialize
+    laieff(:,:,:) = zero
+    PGapL(:,:,:) = un
+    h_array(:,:,:,:) = zero
+    z_array(:,:,:,:) = zero
+    z_array2(:,:,:) = zero
+
+    ! we need the total number of individuals
+    ind_loc(:,:)=SUM(circ_class_n(:,:,:),3)
+    ind_loc(:,1)=zero
+
+    ! for each PFT and each grid square, let's determine if we actually need to run
+    ! the calculation
+    lcalculate_tree(:,:)=.FALSE.
+    lcalculate_nontree(:,:)=.FALSE.
+    DO ipts=1,npts
+       DO ivm=1,nvm
+          IF(is_tree(ivm))THEN
+             IF(ind_loc(ipts,ivm) .GT. min_stomate .AND. &
+                  ind_loc(ipts,ivm) .LT. val_exp*ncirc)THEN 
+                lcalculate_tree(ipts,ivm)=.TRUE.
+             ENDIF
+          ELSE
+             ! This approach makes the model crash if veget_cov_max > 0 but there is
+             ! no biomass yet. Replaced by an approach based on leaf biomass
+             ! IF(veget_cov_max(ipts,ivm) .GT. min_stomate) lcalculate_nontree(ipts,ivm)=.TRUE.
+             IF(SUM(lai_per_level(ipts,ivm,:)) .GT. min_stomate) &
+                 lcalculate_nontree(ipts,ivm)=.TRUE.
+
+          ENDIF
+       ENDDO
+    ENDDO
+
+    ! Calculate the solar angle
+    solar_angle(:)=ACOS(coszang(:)) 
+
+    ! We need to derive some diagnostic variables from the biomass of each
+    ! tree in the circ distribution, based on allometic relations. We need the
+    ! height of the vegetation, the crown projected surface area, and the trunk
+    ! diameter
+    CALL derive_biomass_quantities(npts, nvm, ncirc, circ_class_n, &
+         circ_class_biomass, values)
+
+
+!************************************
+! this is taken directly from Jenny and Vanessa's code
+! I've replaced nlayer in their code with nvm, since it seems to me they are 
+! referring to canopy layers and not strict height levels...I feel these are
+! represented by our PFTs, although this is probably better represented by
+! species.
+! I've also read a little about the WHERE and FORALL constructs, and it seems
+! that there is no real advantage to using them over traditional nested loops
+! since compilers have gotten really good at loop optimization...I find nested
+! loops to be a bit more readable and easier to debug, so I've used those, even
+! though the order of the array indices are not necessarily optimized.
+
+    DO ipts = 1,npts
+       DO ivm=1,nvm
+          IF (.NOT. lcalculate_tree(ipts,ivm)) CYCLE
+          DO icir=1,ncirc
+             ! we are doing spheres right now, so the horizontal and vertical
+             ! axes have the same distributions
+             ver_axis_array(ipts,ivm,icir,:) = values(ipts,ivm,icir,icndiaver)
+             hor_axis_array(ipts,ivm,icir,:) = values(ipts,ivm,icir,icndiahor)
+             ph_array(ipts,ivm,icir,:) = values(ipts,ivm,icir,iheight)
+             DBH_array(ipts,ivm,icir,:) = values(ipts,ivm,icir,idiameter)
+          ENDDO
+
+          ! these two values are taken from the spherical LAD description in
+          !  section 4.2 of the paper. Looks like they are in degrees.
+          ! We don't need them since we set G=0.5 below
+          !thetaL_mean_array(ipts,ivm,:,:) = 57.0_r_std
+          !thetaL_sd_array(ipts,ivm,:,:) = 20.0_r_std
+
+          ! put some input values into arrays that are used in Vanessa's code
+
+          DO icir = 1,ncirc
+             h_array(ipts,ivm,icir,:) = values(ipts,ivm,icir,iheight)
+          ENDDO
+       ENDDO ! loop over PFTS
+    ENDDO ! end loop over grid
+
+    DO icir=1,ncirc
+          ! these are the z values that we're computing the gap probability for, 
+          ! i.e. the bottom of each level. Level 1 is the level next to the soil.
+          z_array(:,:,icir,:) = z_level_loc(:,:,:)
+    ENDDO
+    z_array2(:,:,:) = z_level_loc(:,:,:)
+
+    ! 0 means we are looking downward, which is what we need
+    ! for the albedo since that is the direction the light is heading
+    upward_array = 0 
+
+    DO ipts=1,npts
+       DO ivm=1,nvm
+          IF (.NOT. lcalculate_tree(ipts,ivm)) CYCLE
+          DO icir=1,ncirc
+             DO ilevel=1,nlevels_loc
+                ! compute the shadow of the crown projected onto each height for
+                ! each view angle using Appendix A in the manuscript...careful,
+                ! there are typos in the manuscript, but these routines came
+                ! directly from Vanessa and Jenny and should be correct if
+                ! either of the elipsoid axes are zero, this routine will crash.
+                ! These limits are arbitrary.
+                IF(ver_axis_array(ipts,ivm,icir,ilevel) .GT. laieff_zero_cutoff .AND. &
+                     hor_axis_array(ipts,ivm,icir,ilevel) .GT. laieff_zero_cutoff)THEN
+                   crown_shadow_h(ipts,ivm,icir,ilevel) = spheroid_shadow(solar_angle(ipts),&
+                        upward_array(ipts,ivm,icir,ilevel),&
+                        ver_axis_array(ipts,ivm,icir,ilevel),&
+                        hor_axis_array(ipts,ivm,icir,ilevel),&
+                        h_array(ipts,ivm,icir,ilevel),&
+                        z_array(ipts,ivm,icir,ilevel))
+
+
+                   ! this computes Eq. 10 in the manuscript, the mean path through
+                   ! each crown
+                   sbar_h(ipts,ivm,icir,ilevel) = sbar(h_array(ipts,ivm,icir,ilevel),&
+                        ver_axis_array(ipts,ivm,icir,ilevel)/2.0_r_std,&
+                        hor_axis_array(ipts,ivm,icir,ilevel)/2.0_r_std,&
+                        z_array(ipts,ivm,icir,ilevel),&
+                        crown_shadow_h(ipts,ivm,icir,ilevel),&
+                        solar_angle(ipts), upward_array(ipts,ivm,icir,ilevel)) 
+                ELSE
+                   crown_shadow_h(ipts,ivm,icir,ilevel)=zero
+                   sbar_h(ipts,ivm,icir,ilevel) = zero
+                ENDIF ! checking for ver_axis_array(ipts,ivm,icir,ilevel)
+
+                ! Notice that this crown area is different than the crown area
+                ! we calculate above. This crown area is the area on a plane 
+                ! cutting through the crown, whereas that calculated above is
+                ! the crown area projected on the ground from an overhead sun
+
+                IF(ver_axis_array(ipts,ivm,icir,ilevel) .GT. laieff_zero_cutoff .AND. &
+                     hor_axis_array(ipts,ivm,icir,ilevel) .GT. laieff_zero_cutoff)THEN
+                   crown_area_h(ipts,ivm,icir,ilevel) = spheroid_area(solar_angle(ipts),&
+                        upward_array(ipts,ivm,icir,ilevel),&
+                        ver_axis_array(ipts,ivm,icir,ilevel),&
+                        hor_axis_array(ipts,ivm,icir,ilevel),&
+                        h_array(ipts,ivm,icir,ilevel),&
+                        z_array(ipts,ivm,icir,ilevel))
+                ELSE
+                   crown_area_h(ipts,ivm,icir,ilevel)=zero
+                ENDIF
+                
+                
+! This subroutine takes a lot of time, and we're not currently using the trunks
+! below.  So let's just comment it out for now.
+!!$                ! Now compute the shadow of the trunks. We need the same check
+!!$                ! as above in case the diameter is zero. No shadow for such a
+!!$                ! skinny tree   
+!!$                IF(DBH_array(ipts,ivm,icir,ilevel) .GT. laieff_zero_cutoff)THEN
+!!$                   trunk_shadow_h(ipts,ivm,icir,ilevel) = trunk_shadow(solar_angle(ipts),&
+!!$                        upward_array(ipts,ivm,icir,ilevel),&
+!!$                        DBH_array(ipts,ivm,icir,ilevel),&
+!!$                        h_array(ipts,ivm,icir,ilevel),&
+!!$                        z_array(ipts,ivm,icir,ilevel))
+!!$                ELSE
+!!$                   trunk_shadow_h(ipts,ivm,icir,ilevel)=zero
+!!$                ENDIF
+
+             ENDDO ! loop over levels
+          ENDDO ! loop over circ classes
+
+
+          ! reassign the crown volume calculated above to an array used in Vanessa's code
+          DO icir=1,ncirc
+             CrownVolume_h(ipts,ivm,icir) = values(ipts,ivm,icir,icnvol)
+          ENDDO
+
+          ! do some integrations over the height distribution to find average values
+          ! This is equivalent to taking a weighted average by the number of 
+          ! individuals in each circ class.
+
+          DO ilevel=1,nlevels_loc
+             !************************
+             ! find the average trunk shadow per square meter
+             ! this is Eq. 5 in the manuscript
+             !                CrownShadowL(ipts,ivm,ilevel)=zero
+             ! in the code, some properties of opaque crowns are calculated, but
+             ! those are not  used in the calculation of Pgap so I'm leaving
+             ! them out, like CrownShadowL
+             !***********************
+             TrunkShadowL(ipts,ivm,ilevel)=zero
+             CrownAreaL(ipts,ivm,ilevel)=zero
+             DO icir=1,ncirc
+                !++++ CHECK +++++
+                ! Right now we are not using trunks.
+!                TrunkShadowL(ipts,ivm,ilevel)=TrunkShadowL(ipts,ivm,ilevel)+&
+!                     trunk_shadow_h(ipts,ivm,icir,ilevel)*&
+!                     circ_class_n(ipts,ivm,icir)
+                !+++++++++++++++++
+                CrownAreaL(ipts,ivm,ilevel)=CrownAreaL(ipts,ivm,ilevel)+&
+                     crown_area_h(ipts,ivm,icir,ilevel)*&
+                     circ_class_n(ipts,ivm,icir)
+
+             ENDDO ! loop over circ classes
+             CrownAreaL(ipts,ivm,ilevel)=CrownAreaL(ipts,ivm,ilevel)&
+                  /ind_loc(ipts,ivm)
+
+             ! this is part of Eq. 3 in the manuscript
+             !++++ CHECK +++++
+             ! Right now we are not using trunks
+             !TrunkShadowL(ipts,ivm,ilevel)=TrunkShadowL(ipts,ivm,ilevel)*&
+             ! ind_loc(ipts,ivm)
+             !Pbc_trunkL(ipts,ivm,ilevel)=EXP(-TrunkShadowL(ipts,ivm,ilevel))
+             !+++++++++++++++
+
+          ENDDO! loop over levels
+
+          ! Compute the average foliage volume density across the height distribution.
+          ! Notice that we do not need the area of the grid square here because we have a
+          ! number density of trees instead of just the number of trees, so grid area
+          ! cancels out in the equation
+
+          ! We need to integrate over the height distribution. This is equivalent
+          ! to taking a weighted average by the number of individuals in each
+          ! circ class.
+          CrownVolumeL(ipts,ivm)=zero
+          DO icir=1,ncirc
+             CrownVolumeL(ipts,ivm)=CrownVolumeL(ipts,ivm)+&
+                  CrownVolume_h(ipts,ivm,icir)*&
+                  circ_class_n(ipts,ivm,icir)
+          ENDDO
+
+          CrownVolumeL(ipts,ivm)=CrownVolumeL(ipts,ivm)/ind_loc(ipts,ivm)
+          
+          IF(printlev_loc.GT.4)THEN
+             WRITE(numout,*) 'ipts, ivm, values :', ipts, ivm, values(ipts,ivm,:,icnvol) 
+             WRITE(numout,*) 'circ_class_biomass :', circ_class_biomass(ipts,ivm,:,:,icarbon)
+             WRITE(numout,*) 'circ_class_n :', circ_class_n(ipts,ivm,:)
+             WRITE(numout,*) 'favd :', favd(ipts,ivm)
+          ENDIF
+
+          CALL calculate_favd(ipts, ivm, values(ipts,ivm,:,icnvol), circ_class_biomass, &
+               circ_class_n, favd)
+
+          ! Debug
+          IF(printlev_loc.GT.4 .AND. ipts == test_grid .AND. ivm == test_pft)THEN
+             WRITE(numout,*) ' favd debugging: ',favd(ipts,ivm)
+             WRITE(numout,*) ' CrownVolumeL debugging: ',CrownVolumeL(ipts,ivm)
+             DO icir=1,ncirc
+                WRITE(numout,'(A,I5,F16.8)') 'Crown diameter: ',icir,values(ipts,ivm,icir,icndiaver)
+             ENDDO
+          ENDIF
+
+          ! generate a larger array of values
+          favd_array(ipts,ivm,:,:) = favd(ipts,ivm)
+    
+          ! now we calculate the crown porosity, since the crown is not opaque...Eq. 8
+          ! for this we need the projection of the leaf area in the direction of the beam,
+          ! which is done by the Nilson method (end of Section 4.2 in the manuscript)
+          ! the code also did this with the Ross G function, but we'll take Nilson's.
+          ! the leaf angle distributions (LAD) are currently assumed to be spherical, which
+          ! means the mean leaf inclination is 57Â° and the standard deviation is 20Â°,
+          ! described with a two parameter beta function...this should be explored in more
+          ! depth
+
+          DO icir=1,ncirc
+             DO ilevel=1,nlevels_loc
+!                G_array(ipts,ivm,icir,ilevel)=&
+!                     NilsonG(thetaL_mean_array(ipts,ivm,icir,ilevel),&
+!                     thetaL_sd_array(ipts,ivm,icir,ilevel),laieff_solar_angle)
+                ! this is done slightly differently from the original code, 
+                ! because in the two-stream stream albedo method some coefficients
+                ! are done under the assumption of Ross's G function and a
+                ! spherical leaf distribution, which Pinty et al says makes the 
+                ! G function constant and equal to 0.5. Using NilsonG and the
+                ! above parameters gives a value of 0.505, so it's not much
+                ! different but this is good for consistency
+                G_array(ipts,ivm,icir,ilevel)=0.5_r_std
+
+                ! I am adding a clumping factor here to account for needles 
+                ! clumping to shoots, which increases the porosity of the canopy
+                ! and lets more light through. Notice this is not in the 
+                ! original Pgap model.
+                Pwc_h(ipts,ivm,icir,ilevel)=EXP(-G_array(ipts,ivm,icir,ilevel)*&
+                     favd_array(ipts,ivm,icir,ilevel)*sbar_h(ipts,ivm,icir,ilevel)&
+                     *leaf_to_shoot_clumping(ivm))
+
+             ENDDO ! loop over levels
+
+          ENDDO ! loop over circ classes
+
+       ENDDO ! loop over PFTs
+
+    ENDDO ! loop over grid points
+    
+    ! Calculate the porous crown shadow integrating over the height distribution.
+    ! This is equivalent
+    ! to taking a weighted average by the number of individuals in each
+    ! circ class.
+    ! Eq. 4, and then calculate Pgap
+    DO ipts=1,npts
+       DO ivm=1,nvm
+
+          ! Here we need to calculate the effective LAI for all land types, 
+          ! including grass, crops, and bare soil
+          IF (is_tree(ivm)) THEN
+
+             IF(.NOT. lcalculate_tree(ipts,ivm)) CYCLE
+
+             ! first for forests
+             DO ilevel=1,nlevels_loc
+                PorousCrownShadowL(ipts,ivm,ilevel)=zero
+                DO icir=1,ncirc
+                   PorousCrownShadowL(ipts,ivm,ilevel)=&
+                        PorousCrownShadowL(ipts,ivm,ilevel)+&
+                        crown_shadow_h(ipts,ivm,icir,ilevel)*&
+                        (1.0_r_std-Pwc_h(ipts,ivm,icir,ilevel))*&
+                        circ_class_n(ipts,ivm,icir)
+                ENDDO
+
+                ! These next lines are commented out, but I'm leaving them here
+                ! for clarity.  The first line normalises the integration done
+                ! in the previous step so that we have the average porous
+                ! crown shadow over the whole stand.  The second line multiplies
+                ! by the density to be used in the exponential of the Poisson
+                ! distribution.  It's clear from these two lines that
+                ! they cancel each other out.
+!!$                PorousCrownShadowL(ipts,ivm,ilevel)=&
+!!$                     PorousCrownShadowL(ipts,ivm,ilevel)/ind_loc(ipts,ivm)
+!!$                PorousCrownShadowL(ipts,ivm,ilevel)=&
+!!$                     PorousCrownShadowL(ipts,ivm,ilevel)*ind_loc(ipts,ivm)
+                
+                ! this seems to be Eq. 3 in the manuscript
+!                PGapL(ipts,ivm,ilevel)=Pbc_trunkL(ipts,ivm,ilevel)*&
+!                     EXP(-PorousCrownShadowL(ipts,ivm,ilevel))
+                ! This line doesn't include the effect of trunks. Since our 
+                ! trunks in the albedo calculation aren't distinguishable from
+                ! the leaves, and since we don't want trunks absorbing light, we
+                ! remove the influence of trunks for now.
+                PGapL(ipts,ivm,ilevel)=&
+                     EXP(-PorousCrownShadowL(ipts,ivm,ilevel))
+             ENDDO ! loop over levels
+
+          ELSEIF(ivm == ibare_sechiba)THEN
+
+             ! For bare soil the transmission probability is always one. The
+             ! only thing that matters to the albedo is the background reflectance
+             PGapL(ipts,ivm,:)=un
+
+          ELSE
+
+             IF(.NOT. lcalculate_nontree(ipts,ivm)) CYCLE
+
+             ! Now for grass and croplands. We treat these exactly the same 
+             ! right now, just a slab of vegetation filling space.  For this, we
+             ! need to know the amount of vegetation that is in each level, which
+             ! was calculated in the find_lai_per_level routine.  It assumes folliage
+             ! is distributed evenly from the ground to the height of the
+             ! grass/crops.  Since the LAI will not be correct for grasslands and
+             ! croplands due to the lack of management in ORCHIDEE, we are
+             ! introducing a tunable parameter to help recover the true albedo values.
+
+             DO ilevel=1,nlevels_loc
+                ! This Eq. 1 in the manuscript, assuming G(theta)=0.5 (spherical
+                ! distribution) and using the LAI value with the adjusted LAI 
+                ! mentioned above. 
+                ! Notice that this lai_temp value has to be cumulative, since that
+                ! of the forests is and we correct Pgap based on that assumption below.
+                ! This means that we need the total LAI through which light has passed
+                ! in order to get here, i.e. the sum of all levels higher than and
+                ! including this level.
+!!$                lai_sum = biomass_to_lai(biomass(ipts,ivm,ileaf,icarbon),&
+!!$                     ivm)
+                lai_sum=zero
+                DO jlevel=nlevels_loc,ilevel,-1
+                   lai_sum=lai_sum+lai_per_level(ipts,ivm,jlevel)
+                ENDDO
+
+                PGapL(ipts,ivm,ilevel)=EXP(-0.5_r_std*lai_sum*&
+                     lai_correction_factor(ivm)/COS(solar_angle(ipts)))
+
+                IF(ipts == test_grid .AND. ivm == test_pft .AND. printlev_loc.GT.4)THEN
+                   WRITE(numout,*) 'PgapL: ',PGapL(ipts,ivm,ilevel)
+                   WRITE(numout,*) 'lai_sum,lai_correction_factor(ivm): ',lai_sum,lai_correction_factor(ivm)
+                   WRITE(numout,*) 'COS(solar_angle(ipts)),ilevel: ',COS(solar_angle(ipts)),ilevel
+                ENDIF
+             ENDDO
+             
+          ENDIF ! check for tree
+       ENDDO ! loop over PFTs
+    ENDDO ! loop over grid points
+
+    ! Find the pgap for each level seperately...this makes PGap a measure of
+    ! the chance to make it through just this level, as opposed to the 
+    ! chance to make it through this level and all the above levels.
+
+    ! I do not need to CYCLE if lcalculate is not equal to
+    ! true here because I initialize PgapL to be
+    ! equal to 1 on all levels above.  The calculation
+    ! of this loop is much less expensive than
+    ! the other loops.
+    DO ipts=1,npts
+       DO ivm=1,nvm
+
+          ! Debug
+          IF(printlev_loc.GT.4)THEN
+             IF((ipts == test_grid) .AND. (ivm == test_pft))THEN
+                WRITE(numout,*) 'Cumulative Pgap'
+                DO ilevel=nlevels_loc,1,-1
+                   WRITE(numout,*) ivm,ilevel,PgapL(ipts,ivm,ilevel)
+                ENDDO
+             ENDIF
+          ENDIF
+          !-
+
+          DO ilevel=1,nlevels_loc-1
+
+             ! include a check for numerical stability.
+             ! The minumum Pgap is a function of the maximum
+             ! effective LAI that we allow.  The higher the
+             ! effective LAI, the lower the amount of light
+             ! which will be allowed through the layer.  This
+             ! number cannot be so high as to cause numerical
+             ! problems, though.  The value of 20 here is
+             ! arbitrary, but doesn't seem to cause any problems.
+             min_pgap=exp(-max_laieff/2.0/cos(solar_angle(ipts)))
+
+             IF(PgapL(ipts,ivm,ilevel+1) .GT. min_pgap )THEN
+                PgapL(ipts,ivm,ilevel)= PgapL(ipts,ivm,ilevel)/ &
+                     PgapL(ipts,ivm,ilevel+1)
+             ELSE
+                ! This is a problem.  We can't really say anything about
+                ! the gap probability for this level.  However, if the
+                ! above level is so dark, no light will make it
+                ! to this level, anyway.  So let's just make this
+                ! level opaque.  This is equivalent to giving a maximum
+                ! effective LAI value.
+                PgapL(ipts,ivm,ilevel)=exp(-max_laieff/2.0/cos(solar_angle(ipts)))
+             ENDIF
+
+             ! Include a check.  PgapL should always be between zero and
+             ! one.  Due to numerical issues, it's possible that it won't 
+             ! be sometimes.  We don't check to see if it's less than
+             ! zero because that will be caught later, and it's a more
+             ! serious issue.
+             IF(PgapL(ipts,ivm,ilevel) .GT. un) PgapL(ipts,ivm,ilevel)=un
+
+          ENDDO ! loop over levels
+
+          ! compute the effective LAI, based on Eq. 25 in Pintys 2004 paper cited
+          ! in the references above
+          ! Debug
+          IF(test_pft == ivm .AND. test_grid == ipts .AND. printlev_loc.GT.4)THEN
+             WRITE(numout,*) 'Effective lai',ivm
+             WRITE(numout,*) 'ipts,ivm,nlevels_loc',ipts,ivm,nlevels_loc
+          ENDIF
+          !-
+
+          DO ilevel=nlevels_loc,1,-1
+             ! include a check for numerical stability...min_stomate is arbitrary
+             IF(PgapL(ipts,ivm,ilevel) .GT. min_stomate)THEN
+                laieff(ilevel,ipts,ivm)=-2.0_r_std*COS(solar_angle(ipts))*&
+                     LOG(PgapL(ipts,ivm,ilevel))
+             ELSE
+                laieff(ilevel,ipts,ivm)=-2.0_r_std*COS(solar_angle(ipts))*&
+                     LOG(min_stomate)
+             ENDIF
+
+             ! If the value is small enough or negative, we set it equal to zero.
+             ! A negative value for the effective LAI does not make sense in the
+             ! context of Eq. 12 in Pinty 2006.  If the effective LAI is zero, the
+             ! uncollided transmission will be one.  If LAI is positive, the
+             ! uncollided transmission will be between zero and one, since light
+             ! is intercepted by the canopy elements.  A negative effective
+             ! LAI results in uncollided transmitted light being greater than one,
+             ! which means there is a light source in the canopy.
+             IF(laieff(ilevel,ipts,ivm) .LE. min_stomate)THEN
+                IF( laieff(ilevel,ipts,ivm) .LE. -min_stomate) THEN
+                   WRITE(numout,*) 'ilevel,ipts,ivm', ilevel,ipts,ivm
+                   WRITE(numout,*) 'laieff(ilevel,ipts,ivm)', laieff(ilevel,ipts,ivm)
+                   CALL ipslerr_p (3,'effective_lai', 'We should not have a negative effective LAI.','','')
+                ENDIF
+                laieff(ilevel,ipts,ivm) = zero
+             ENDIF
+
+
+          ENDDO ! loop over levels
+          
+          ! Debug
+          IF(test_pft == ivm .AND. test_grid == ipts .AND. printlev_loc.GT.4)THEN
+             WRITE(numout,*) 'ilevel, laieff, PgapL: ',ivm
+             DO ilevel=nlevels_loc,1,-1
+                WRITE(numout,'(I5,2E20.10)') ilevel,laieff(ilevel,ipts,ivm),PgapL(ipts,ivm,ilevel)
+             ENDDO
+          ENDIF
+          !-
+
+       ENDDO ! loop over PFTs
+    ENDDO ! loop over grid points
+
+    ! Deal with the optinal arguments
+    IF(PRESENT(h_array_out)) h_array_out = h_array
+    IF(PRESENT(z_array_out)) z_array_out = z_array
+    IF(PRESENT(z_array2_out)) z_array2_out = z_array2
+    IF(PRESENT(Pgap_out)) Pgap_out = PgapL
+
+    IF (printlev.GE.5) WRITE(numout,*) 'Leaving effective_lai'
+
+  END SUBROUTINE effective_lai
+
+
+
+!! ================================================================================================================================
+!! FUNCTION 	: spheroid_shadow
+!!
+!>\BRIEF        Calculates the projected shadow of a tree canopy at different heights and
+!!              sun angles, assuming a spheriod canopy
+!!
+!! DESCRIPTION  : Taken with permission from V. HAVERD's code, based on the equations in Appendix A
+!!                of her paper
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::spheroid_shadow
+!!
+!! REFERENCE(S) : 
+!!                Haverd et al; The Canopy Semi-analytic Pgap and radiative transfer 
+!!      (CanSPART) model: Formulation and application, AGRICULTURAL AND FOREST METEOROLOGY
+!!      Vol. 160, pp. 14-35, 2012
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  REAL(r_std) FUNCTION spheroid_shadow(theta,upward,T,D,&
+       H,z)
+    
+    !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(IN)                      :: theta ! view angle (radians)
+    REAL(r_std), INTENT(IN)                      :: T ! vertical diameter of the spheroid (m) 
+    REAL(r_std), INTENT(IN)                      :: D ! horizontal diameter (m)
+    REAL(r_std), INTENT(IN)                      :: H ! tree height (top of crown)
+    REAL(r_std), INTENT(IN)                      :: z ! height above ground
+    INTEGER(i_std), INTENT(IN)                   :: upward ! ==1 for upward view, ==0 for downward view
+    
+    
+    !! 0.2 Output variables
+!    REAL(r_std)                                  :: spheroid_shadow
+    
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std)                                  :: thetapr, Ypr, Y1pr, Y1, X1, D1pr, D2pr, Y
+
+!_ ================================================================================================================================
+    
+    thetapr =  ATAN(T/D*TAN(theta)) ! zenith angle in spherical space
+    
+    
+! the conventions are described in Appendix A of this paper
+    IF (upward==1) THEN
+       Y = z-H+T/2 
+    ELSE
+       Y = H-T/2-z
+    ENDIF
+    Ypr  = Y*D/T
+    Y1pr = D/2.0*TAN(thetapr)/SQRT(1+TAN(thetapr)**2) 
+    Y1 = T/D*Y1pr 
+    IF (TAN(thetapr).NE.0.0) THEN
+       X1 = Y1pr/TAN(thetapr) 
+    ELSE
+       X1 = D/2 
+    END IF
+    
+    
+    
+    ! first calculate major axis (D1pr) of elliptic shadow
+    
+    IF (Y<=-T/2.0) THEN ! below crown bottom
+        D1pr = 0.0 
+    END IF
+    
+    IF (Y>-T/2 .AND. Y<=-Y1)  THEN !between crown bottom and lower tangent point
+       D1pr = D*SQRT(1.0-Ypr**2*4.0/D**2)  
+    END IF
+    
+    IF (Y>-Y1 .AND. Y <Y1) THEN !between lower and upper tangent points
+       D1pr = D/2.0*SQRT(1.0-MIN(Ypr**2*4.0/D**2,1.0)) +X1 - &
+            TAN(thetapr)*(-Y1pr-Ypr) 
+    END IF
+    
+    IF (Y > Y1) THEN !above upper tangent point
+       D1pr = D/COS(thetapr)     
+    END IF
+
+    ! second calculate minor axis (D2pr) of elliptic shadow 
+    ! (this is just the diameter of the circular cross-section at height z)
+    IF (Y <= -T/2) THEN
+       D2pr = 0.0                      !shadow breadth
+    END IF
+    
+    IF (Y<=0 .AND. Y >-T/2) THEN
+       D2pr = 2.0*SQRT((D/2.0)**2-Ypr**2)    !shadow breadth
+    END IF
+    
+    IF (Y>=0) THEN
+       D2pr = D    !shadow breadth
+    END IF
+    
+
+    ! shadow area
+    spheroid_shadow = pi/4.0*D2pr*D1pr 
+
+  END FUNCTION spheroid_shadow
+
+
+!! ================================================================================================================================
+!! FUNCTION     : trunk_shadow
+!!
+!>\BRIEF        ! Calculates the projected shadow of a tree trunk at different heights and
+!!              sun angles, assuming a cone shape
+!!
+!! DESCRIPTION : Taken with permission from V. HAVERD's code, based on the equations in Appendix E
+!!                of her paper
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : trunk_shadow
+!!
+!! REFERENCE(S) : Haverd et al; The Canopy Semi-analytic Pgap and radiative transfer 
+!!      (CanSPART) model: Formulation and application, AGRICULTURAL AND FOREST METEOROLOGY
+!!      Vol. 160, pp. 14-35, 2012
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  REAL(r_std) FUNCTION trunk_shadow(theta,upward,D,H,z)
+    !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(IN)                       :: theta ! view angle              @tex $(radians)$ @endtex
+    REAL(r_std), INTENT(IN)                       :: D ! trunk diameter              @tex $(m)$ @endtex
+    REAL(r_std), INTENT(IN)                       :: H ! tree height (top of crown)  @tex $(m)$ @endtex
+    REAL(r_std), INTENT(IN)                       :: z ! height above ground         @tex $(m)$ @endtex
+    INTEGER(i_std), INTENT(IN)                    :: upward ! ==1 for upward view, ==0 for downward view
+  
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std)                                  :: sinalpha, alpha 
+
+!_ ================================================================================================================================
+    
+    sinalpha = D/(2.*H*TAN(theta))
+    IF (ABS(sinalpha).LT.1.0.AND.D.GT.0.0) THEN
+       alpha = 2.*ASIN(sinalpha)
+
+       IF (upward==1) THEN
+          ! shadow is bounded by base-of-trunk circle; trunk cross-section at z
+          ! and tangents joining the two circles
+          IF (z<H) THEN
+             trunk_shadow = 1./4. * D**2*(1.-(1.-z/H)**2)/(TAN(alpha/2.)) + &
+                  1./8.*D**2*(pi+alpha) + 1./8.*D**2*(1-z/H)**2*(pi-alpha)
+          ELSE
+             trunk_shadow = 1./4. * D**2*1./(TAN(alpha/2.)) + 1./8.*D**2*(pi+alpha)
+          ENDIF
+          
+          trunk_shadow = trunk_shadow - pi * (D**2)/4.
+       ELSEIF (upward==0) THEN
+          
+          ! shadow is bounded by trunk cross-section at z and tangents joining two circles
+          IF (z<H) THEN
+             trunk_shadow = 1./4. * D**2*(1.-z/H)**2*1./(TAN(alpha/2.)) + &
+                  1./8.*D**2*(1.-z/H)**2*(pi+alpha)
+          ELSE
+             trunk_shadow = 0.
+          ENDIF
+          
+       ENDIF
+       
+    ELSE
+       trunk_shadow = 0.0
+    ENDIF
+    
+  END FUNCTION trunk_shadow
+
+
+!! ================================================================================================================================
+!! FUNCTION     : sbar
+!!
+!>\BRIEF        ! Calculates the mean free distance through the crown, Eq. 10 in Haverd et al.
+!!
+!! DESCRIPTION : Taken with permission from V. HAVERD's code
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : sbar
+!!
+!! REFERENCE(S) : Haverd et al; The Canopy Semi-analytic Pgap and radiative transfer 
+!!      (CanSPART) model: Formulation and application, AGRICULTURAL AND FOREST METEOROLOGY
+!!      Vol. 160, pp. 14-35, 2012
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  REAL(r_std) FUNCTION sbar(x, b, r, z, area,&
+       theta, upward )
+    !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(IN)         :: x             ! tree height              
+                                                     ! @tex $(m)$ @endtex
+    REAL(r_std), INTENT(IN)         :: b             ! vertical crown radius
+                                                     ! @tex $(m)$ @endtex
+    REAL(r_std), INTENT(IN)         :: r             ! horizontal crown radius
+                                                     ! @tex $(m)$ @endtex
+    REAL(r_std), INTENT(IN)         :: z             ! height above ground
+                                                     ! @tex $(m)$ @endtex
+    REAL(r_std), INTENT(IN)         :: theta         ! view angle
+                                                     ! @tex $(radians)$ @endtex
+    REAL(r_std), INTENT(IN)         :: area          ! shadow area of partial spheroid  
+                                                     ! @tex $(m^2)$ @endtex
+    INTEGER(i_std), INTENT(IN)      :: upward        ! ==1 for upward view, ==0 
+                                                     ! for downward view
+  
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std)                                  :: Hpr, Y, V_ps
+
+!_ ================================================================================================================================
+
+    Hpr = x-b ! Hpr is height at crown centre
+    IF (upward==1) THEN
+       Y = z-Hpr  ! Y=0 corresponds to crown centre
+    ELSE
+       Y = Hpr - z
+    ENDIF
+    
+    ! initialize the output variables, just in case there is a numerical reason 
+    ! none of the loops is hit
+    V_ps =zero
+    sbar =zero
+
+    IF (Y<b.AND.Y>-b) THEN
+
+       ! volume of partial spheroid below height z
+       V_ps = 4.0_r_std/3.0_r_std*pi*(r)**2*(b) - ((2.0_r_std* b)/3.0_r_std - Y &
+            + Y**3/(3.0_r_std* b**2)) *pi* r**2 
+
+       ! there are some numerical issues here occasionally that give a negative 
+       ! extremely small value, which in turn gives a negative sbar which causes
+       ! problems later
+       IF(ABS(V_ps) .LT. 0.0000001_r_std) V_ps= zero
+       sbar = V_ps/COS(theta)/area
+
+    ENDIF
+
+ !!!!!! had to add the check for area
+   IF (Y>=b .AND. area .NE. zero) THEN
+       V_ps = 4.0_r_std/3.0_r_std*pi*(r)**2*(b)  ; ! volume of whole spheroid
+       sbar= V_ps/COS(theta)/area
+    ENDIF
+
+
+  END FUNCTION sbar
+  
+!! ================================================================================================================================
+!! FUNCTION     : spheroid_area
+!!
+!>\BRIEF        ! Calculates the area of the cross section of a spheroid at a height of z
+!!
+!! DESCRIPTION : Taken with permission from V. HAVERD's code
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : spheroid_area
+!!
+!! REFERENCE(S) : Haverd et al; The Canopy Semi-analytic Pgap and radiative transfer 
+!!      (CanSPART) model: Formulation and application, AGRICULTURAL AND FOREST METEOROLOGY
+!!      Vol. 160, pp. 14-35, 2012
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  REAL(r_std) FUNCTION spheroid_area(theta,upward,T,D,H,z)
+
+    !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(IN)          :: theta ! view angle              
+                                              ! @tex $(radians)$ @endtex
+    REAL(r_std), INTENT(IN)          :: T ! vertical diameter           
+                                          ! @tex $(m)$ @endtex
+    REAL(r_std), INTENT(IN)          :: D ! horizontal diameter         
+                                          ! @tex $(m)$ @endtex
+    REAL(r_std), INTENT(IN)          :: H ! tree height (top of crown)  
+                                          ! @tex $(m)$ @endtex
+    REAL(r_std), INTENT(IN)          :: z ! height above ground         
+                                          ! @tex $(m)$ @endtex
+    INTEGER(i_std), INTENT(IN)       :: upward ! ==1 for upward view, 
+                                               ! ==0 for downward view
+
+  
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std)                      :: thetapr, Ypr, Y1pr, Y1, X1, D2pr, Y
+
+!_ ================================================================================================================================
+
+    thetapr =  ATAN(T/D*TAN(theta)) ! zenith angle in spherical space
+
+
+    IF (upward==1) THEN
+       Y = z-H+T/2 
+    ELSE
+       Y = H-T/2-z
+    ENDIF
+    Ypr  = Y*D/T
+    Y1pr = D/2.0*TAN(thetapr)/SQRT(1+TAN(thetapr)**2) 
+    Y1 = T/D*Y1pr 
+    IF (TAN(thetapr).NE.0.0) THEN
+       X1 = Y1pr/TAN(thetapr) 
+    ELSE
+       X1 = D/2 
+    END IF
+    
+
+    ! calculate minor axis (D2pr) of elliptic shadow 
+    ! (this is just the diameter of the circular cross-section at height z)
+    
+    
+    IF (Y<=T/2 .AND. Y >-T/2) THEN
+       D2pr = 2.0*SQRT((D/2.0)**2-Ypr**2)    !shadow breadth
+    ELSE
+       D2pr = 0    !shadow breadth
+    END IF
+    
+
+    ! shadow area
+    spheroid_area = pi/4.0*D2pr**2 
+
+  END FUNCTION spheroid_area
+
+!! ================================================================================================================================
+!! FUNCTION     : NilsonG
+!!
+!>\BRIEF        ! Calculates the projection of unit foliage area  G(theta) as described by
+!!              Wang et al, 2007, referenced in section 4.2 from V. Haverd's paper
+!!
+!! DESCRIPTION : Taken with permission from V. HAVERD's code
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : NilsonG
+!!
+!! REFERENCE(S) : Haverd et al; The Canopy Semi-analytic Pgap and radiative transfer 
+!!      (CanSPART) model: Formulation and application, AGRICULTURAL AND FOREST METEOROLOGY
+!!      Vol. 160, pp. 14-35, 2012
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  REAL(r_std) FUNCTION NilsonG(mean_thetaL,sd_thetaL,theta_deg)
+    !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(IN)          :: mean_thetaL ! the mean leaf angle inclination 
+                                                    ! @tex $(degrees)$ @endtex 
+    REAL(r_std), INTENT(IN)          :: sd_thetaL ! the standard deviation of the leaf angle inclination 
+                                                  ! @tex $(degrees)$ @endtex 
+    REAL(r_std), INTENT(IN)          :: theta_deg ! the solar zenith angle 
+                                                  ! @tex $(degrees)$ @endtex 
+  
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std)                      :: var_t, thl_bar, theta, thetaL, psi
+    REAL(r_std), ALLOCATABLE         :: A(:), f(:)
+    INTEGER(i_std)                   :: k, nthetaL
+!_ ================================================================================================================================
+
+    var_t = (sd_thetaL/90.0_r_std)**2
+    thl_bar = mean_thetaL*pi/180.0_r_std
+    theta = theta_deg*pi/180.0_r_std
+    nthetaL = 20
+    ALLOCATE (A(nthetaL))
+    ALLOCATE (f(nthetaL))
+    DO k=1,nthetaL
+       thetaL = 0.0_r_std + 89.0_r_std/nthetaL*(k)*pi/180.0_r_std
+       IF (ABS((1/TAN(theta))*(1/TAN(thetaL)))>1) THEN
+          A(k) = COS(theta)*COS(thetaL);
+       ELSE
+          psi = ACOS((1.0_r_std/TAN(theta))*(1.0_r_std/TAN(thetaL)));
+          A(k) = COS(theta)*COS(thetaL)*(1.0_r_std+2.0_r_std/pi*(TAN(psi)-psi));
+       ENDIF
+       f(k) = BETA_LAD(thl_bar,var_t, thetaL)
+    ENDDO
+    NilsonG = SUM(A(1:nthetaL)*f(1:nthetaL))/SUM(f(1:nthetaL))
+
+    DEALLOCATE(A)
+    DEALLOCATE(F)
+
+  END FUNCTION NilsonG
+
+!! ================================================================================================================================
+!! FUNCTION     : BETA_LAD
+!!
+!>\BRIEF        ! Calculates the beta leaf angle distribution as described by
+!!              Wang et al, 2007, referenced in section 4.2 from V. Haverd's paper
+!!
+!! DESCRIPTION : Taken with permission from V. HAVERD's code
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : BETA_LAD
+!!
+!! REFERENCE(S) : Haverd et al; The Canopy Semi-analytic Pgap and radiative transfer 
+!!      (CanSPART) model: Formulation and application, AGRICULTURAL AND FOREST METEOROLOGY
+!!      Vol. 160, pp. 14-35, 2012
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  REAL(r_std) FUNCTION BETA_LAD(thl_bar,var_t, theta)
+
+    !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(IN):: thl_bar,var_t, theta
+  
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std)                                  :: tbar, sig0_2, sigt_2, mu, nu, t, num
+!_ ================================================================================================================================
+
+    tbar = 2.0_r_std*thl_bar/(pi)
+    sig0_2 = tbar*(1.0_r_std-tbar)
+    sigt_2 = var_t
+    num = sig0_2/sigt_2 - 1.0_r_std
+    ! Test for negative num as this causes distribution to fail.
+    IF (num <= zero) THEN 
+       num = 0.01_r_std
+       !write(*,*)'WARNING: leaf angle SD too large'
+    ENDIF
+    
+    nu = tbar*num
+    mu = (1.0_r_std-tbar)*num
+    
+    t = 2.0_r_std*theta/pi
+    beta_lad = ((1.0_r_std-t)**(mu-1.0_r_std))*(t**(nu-1.0_r_std))/beta(mu,nu)   
+    
+  END FUNCTION BETA_LAD
+!********************************************************************************
+
+!! ================================================================================================================================
+!! FUNCTION     : beta
+!!
+!>\BRIEF        ! Calculates the beta leaf angle distribution as described by
+!!              Wang et al, 2007, referenced in section 4.2 from V. Haverd's paper
+!!
+!! DESCRIPTION : Taken with permission from V. HAVERD's code
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : BETA
+!!
+!! REFERENCE(S) : Haverd et al; The Canopy Semi-analytic Pgap and radiative transfer 
+!!      (CanSPART) model: Formulation and application, AGRICULTURAL AND FOREST METEOROLOGY
+!!      Vol. 160, pp. 14-35, 2012
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  REAL(r_std) FUNCTION beta(z,w)
+    !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(IN):: z,w
+  
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+!_ ================================================================================================================================
+
+    beta=EXP(gammln(z)+gammln(w)-gammln(z+w))
+
+  END FUNCTION beta
+!! ================================================================================================================================
+!! FUNCTION     : gammaln
+!!
+!>\BRIEF        ! Calculates the beta leaf angle distribution as described by
+!!              Wang et al, 2007, referenced in section 4.2 from V. Haverd's paper
+!!
+!! DESCRIPTION : Taken with permission from V. HAVERD's code
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : gammaln
+!!
+!! REFERENCE(S) : Haverd et al; The Canopy Semi-analytic Pgap and radiative transfer 
+!!      (CanSPART) model: Formulation and application, AGRICULTURAL AND FOREST METEOROLOGY
+!!      Vol. 160, pp. 14-35, 2012
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  REAL(r_std) FUNCTION gammln(xx)
+    !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(IN):: xx
+  
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std) :: tmp,x,stp,temp,first,increment
+    INTEGER(i_std) :: k,k2,n
+    INTEGER(i_std), PARAMETER :: NPAR_ARTH=16,NPAR2_ARTH=8
+    REAL(r_std),DIMENSION(6) :: coef,ARTH
+!_ ================================================================================================================================
+    
+    stp = 2.5066282746310005_r_std
+    coef = (/76.18009172947146_r_std,&
+         -86.50532032941677_r_std,24.01409824083091_r_std,&
+         -1.231739572450155_r_std,0.1208650973866179e-2_r_std,&
+         -0.5395239384953e-5_r_std/)
+    x=xx
+    tmp=x+5.5_r_std
+    tmp=(x+0.5_r_std)*LOG(tmp)-tmp
+    
+    n = SIZE(coef)
+    increment = 1.0_r_std
+    first = x+1.0_r_std
+    IF (n > 0) arth(1)=first
+    IF (n <= NPAR_ARTH) THEN
+       DO k=2,n
+          ARTH(k)=ARTH(k-1)+increment
+       END DO
+    ELSE
+       DO k=2,NPAR2_ARTH
+          ARTH(k)=ARTH(k-1)+increment
+       END DO
+       temp=increment*NPAR2_ARTH
+       k=NPAR2_ARTH
+       DO
+          IF (k >= n) EXIT
+          k2=k+k
+          arth(k+1:MIN(k2,n))=temp+arth(1:MIN(k,n-k))
+          temp=temp+temp
+          k=k2
+       END DO
+    END IF
+    
+    gammln=tmp+LOG(stp*(1.000000000190015_r_std+&
+         SUM(coef(:)/arth(:)))/x)
+  END FUNCTION gammln
+
+!! ================================================================================================================================
+!! FUNCTION     : partial_spheroid_vol
+!!
+!>\BRIEF        ! Calculates the beta leaf angle distribution as described by
+!!              Wang et al, 2007, referenced in section 4.2 from V. Haverd's paper
+!!
+!! DESCRIPTION : Taken with permission from V. HAVERD's code
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : partial_spheroid_vol
+!!
+!! REFERENCE(S) : Haverd et al; The Canopy Semi-analytic Pgap and radiative transfer 
+!!      (CanSPART) model: Formulation and application, AGRICULTURAL AND FOREST METEOROLOGY
+!!      Vol. 160, pp. 14-35, 2012
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  REAL(r_std) FUNCTION partial_spheroid_vol(Z_up, Z_down, b, r, h)
+    !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+    ! The units of all these variables can be anything, so long as they
+    ! are all the same.
+    !  I assume
+    REAL(r_std), INTENT(IN)         :: Z_up  ! The height of the top cutting plane
+    REAL(r_std), INTENT(IN)         :: Z_down ! The height of the lower cutting plane
+    REAL(r_std), INTENT(IN)         :: b     ! Distance from center to top of the spheroid
+    REAL(r_std), INTENT(IN)         :: r     ! Distance from center to outside on the XY plane
+    REAL(r_std), INTENT(IN)         :: h     ! Height of the top of the spheroid above the ground
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std)                      :: Z1, Z2, center
+
+!_ ================================================================================================================================
+    
+    ! initialize the output variables
+    partial_spheroid_vol =zero
+
+    ! It's possible that none of this spheroid is in this level!
+    center = h-b
+
+    IF(Z_down - center .GE. b)RETURN
+    IF(Z_up - center .LE. -b)RETURN
+
+    ! Z1 and Z2 have to be within the limits of the spheroid
+    ! I also want the center at the origin.
+    Z2=MIN(Z_up-center,b)
+    Z1=MAX(Z_down-center,-b)
+
+    ! With a little calculus, I computed the following formula, which
+    ! gives the correct result in the case of the full spheroid,
+    ! i.e. Z2=b and Z1=-b, as well as for a full sphere (r=b)
+    partial_spheroid_vol = pi*r**2*(Z2-Z1-(Z2**3-Z1**3)/(3.0_r_std*b**2))
+
+    ! there are some numerical issues here occasionally that give a negative 
+    ! extremely small value, which in turn gives a negative partial_spheroid_vol which causes
+    ! problems later
+    IF(ABS(partial_spheroid_vol) .LT. min_stomate) partial_spheroid_vol= zero
+
+  END FUNCTION partial_spheroid_vol
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: calculate_favd
+!!
+!>\BRIEF       Calculates the foliage area volume density of a canopy.
+!!
+!! DESCRIPTION  : WARNING: This should only be used for trees.  Grasses
+!!                and crops have no canopy volume currently in the model.
+!!
+!!    NOTE:
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::favd
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE calculate_favd(ipts, ivm, cn_vol, circ_class_biomass, &
+       circ_class_n, favd)
+
+  !! 0 Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std),INTENT(in)                            :: ipts         
+    INTEGER(i_std),INTENT(in)                            :: ivm        
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)        :: circ_class_biomass    !! Biomass of the components of the model  
+                                                                                  !! tree within a circumference class
+                                                                                  !! @tex $(gC ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)            :: circ_class_n          !! Number of trees within each circ class
+                                                                                  !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:), INTENT(in)                :: cn_vol                !! Canopy volume for each circ class
+                                                                                  !! @tex $(m^{-3} ind^{-1})$ @endtex
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: favd                  !! The LAI per canopy volume density
+                                                                                  !! @tex $(m^{-3} m^{-2})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER :: icir
+    REAL(r_std) :: total_bm
+    REAL(r_std) :: total_vol
+    REAL(r_std) :: total_la
+    REAL(r_std) :: max_height
+    REAL(r_std) :: lai_temp
+    REAL(r_std) :: ind_loc
+!_ ================================================================================================================================
+    
+    IF (printlev.GE.4) WRITE(numout,*) 'Entering calculate_favd'
+
+    ! Initialize local printlev
+    !printlev_loc=get_printlev('laieff')
+
+    ind_loc = SUM(circ_class_n(ipts,ivm,:))
+
+    IF(is_tree(ivm))THEN
+       ! How much total leaf biomass do we have?
+       ! How much total canopy volume do we have?
+       total_bm=zero
+       total_vol=zero
+       ! Notice that we don't have to take the surface area of the stand
+       ! into account.  total_bm will be in units of gC / m**2, while
+       ! the canopy volume should be in units of m**3 / m**2.  The surface
+       ! area would cancel out when we take the ratio.
+       DO icir=1,ncirc
+          total_bm=total_bm+circ_class_biomass(ipts,ivm,icir,ileaf,icarbon)*&
+               !            circ_class_n(ipts,ivm,icir)*surface_area
+               circ_class_n(ipts,ivm,icir)
+          total_vol=total_vol+cn_vol(icir)*&
+               circ_class_n(ipts,ivm,icir)
+          !            circ_class_n(ipts,ivm,icir)*surface_area
+
+          ! Debug
+          IF(ipts == test_grid .AND. ivm == test_pft .AND. printlev_loc.GT.4)THEN
+             WRITE(numout,'(A,I5,3F16.8)') 'icir,cn_vol,circ_class_biomass,circ_class_n: ',&
+                  icir,cn_vol(icir),circ_class_biomass(ipts,ivm,icir,ileaf,icarbon),circ_class_n(ipts,ivm,icir)
+          ENDIF
+          !-
+
+       ENDDO
+
+       
+
+       ! Right now, total_vol is in m**3/tree * tree/m**2
+
+       ! How much leaf area do we have on our grid square?
+       total_la=total_bm*sla(ivm)
+
+       ! Total_la is unitless. m**2 / m**2.
+       
+       ! Debug
+       IF(ipts == test_grid .AND. ivm == test_pft .AND. printlev_loc.GT.4)THEN
+          WRITE(numout,'(A,3F16.8)') &
+               'total_la,total_vol: ',total_la,total_vol,total_la/total_vol
+       ENDIF
+       !-
+
+       ! What is the foliage area volume density?
+       IF (total_vol .GT. min_stomate) THEN
+          ! 1 / m**3 (canopy volume) / m**2 (land area)
+         favd(ipts,ivm)=total_la/total_vol
+       ELSE
+          favd(ipts,ivm)=zero
+       ENDIF
+
+    ELSE
+
+       ! What is the height of our grass/crop?
+       lai_temp = biomass_to_lai(SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)*circ_class_n(ipts,ivm,:)), ivm)
+
+       ! This converts LAI to a height.  I took this from functional_allocation.
+       max_height = lai_temp * lai_to_height(ivm)
+
+       ! The units here are per square meter, so the volume of the cube is
+       ! just the height*1*1.
+       IF (max_height .GT. min_stomate) THEN
+          favd(ipts,ivm)=lai_temp / max_height
+       ELSE
+          favd(ipts,ivm)=zero
+       ENDIF
+    ENDIF
+
+    IF (printlev.GE.5) WRITE(numout,*) 'Leaving calculate_favd'
+
+  END SUBROUTINE calculate_favd
+
+!! ================================================================================================================================
+!! FUNCTION     : calculate_laieff_fit
+!!
+!>\BRIEF        : 
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : calculate_laieff_fit
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  REAL(r_std) FUNCTION calculate_laieff_fit(test_angle, laieff_fit)
+    !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+    REAL(r_std),INTENT(IN)        :: test_angle        !! the cosine of the solar angle
+    TYPE(laieff_type),INTENT(in)    :: laieff_fit      !! Fitted parameters for the effective LAI
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+!_ ================================================================================================================================
+    
+    ! y = a + b*x + c*x**2 + d*x**3 + e*x**4
+    calculate_laieff_fit=laieff_fit%a + test_angle * laieff_fit%b + &
+         test_angle**2 * laieff_fit%c +  test_angle**3 * laieff_fit%d + &
+         test_angle**4 * laieff_fit%e
+
+
+
+  END FUNCTION calculate_laieff_fit
+
+END MODULE stomate_laieff
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_litter.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_litter.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_litter.f90	(revision 6412)
@@ -0,0 +1,2540 @@
+! ================================================================================================================================
+! MODULE       : stomate_litter
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Update litter and lignine content after litter fall and 
+!! calculating litter decomposition.      
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_litter
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE function_library, ONLY : check_mass_balance, biomass_to_lai, cc_to_biomass
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC littercalc,littercalc_clear, deadleaf
+
+  LOGICAL, SAVE             :: firstcall_litter = .TRUE.       !! first call
+!$OMP THREADPRIVATE(firstcall_litter)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : littercalc_calc
+!!
+!!\BRIEF        Set the flag ::firstcall_litter 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_litter =.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
+!!
+!! In the section 7, if the flag SPINUP_ANALYTIC is set to true, we fill MatrixA
+!! and VectorB following Lardy(2011).
+!!
+!! MAIN OUTPUT VARIABLES: ::deadleaf_cover, ::resp_hetero_litter, ::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.
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART    :
+!! \latexonly
+!! \includegraphics(scale=0.5){littercalcflow.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE littercalc (npts, turnover, bm_to_litter, &
+       veget_cov_max, tsurf, tsoil, soilhum, litterhum, som, clay, silt, & 
+       soil_n_min, litter, dead_leaves, lignin_struc, &
+       lignin_wood, n_mineralisation, deadleaf_cover, resp_hetero_litter, &
+       som_input, control_temp, control_moist, n_fungivores, &
+       MatrixA, VectorB, CN_target, CN_som_litter_longterm, tau_CN_longterm, &
+       ld_redistribute,circ_class_biomass,circ_class_n)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                  :: npts               !! Domain size - number of grid pixels
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: turnover         !! Turnover rates of plant biomass 
+                                                                                      !! @tex $(gC m^{-2} dt\_slow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: bm_to_litter     !! Conversion of biomass to litter 
+                                                                                      !! @tex $(gC m^{-2} dt\_slow^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                  :: veget_cov_max      !! PFT "Maximal" coverage fraction of a PFT 
+                                                                                      !! defined in the input vegetation map 
+                                                                                      !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: tsurf              !! Temperature (K) at the surface
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)               :: tsoil              !! Soil temperature (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)               :: soilhum            !! Daily soil humidity of each soil layer 
+                                                                                      !! (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: litterhum          !! Daily litter humidity (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: clay               !! Clay fraction (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: silt               !! Silt fraction (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvm,nnspec),INTENT(inout)       :: soil_n_min         !! mineral nitrogen in the soil (gN/m**2)  
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), INTENT(in) :: circ_class_biomass !! Biomass components of the model tree  
+                                                                                      !! within a circumference class 
+                                                                                      !! @tex $(g C ind^{=1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(in)          :: circ_class_n       !! Number of individuals in each circ class
+                                                                                        
+    !! 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 dt_sechiba one\_day^{-1}) m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nelements), INTENT(out) :: som_input        !! Quantity of Carbon (or Nitrogen) going into SOM pools
+                                                                                      !! from litter decomposition. The unit is  
+                                                                                      !! given by m^2 of ground 
+                                                                                      !! @tex $(gC(orN) 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)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)               :: n_fungivores       !! Fraction of N released for plant uptake
+                                                                                      !! due to fungivore consumption.
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(out) :: MatrixA          !! Matrix containing the fluxes between the
+                                                                                      !! carbon pools per sechiba time step 
+                                                                                      !! @tex $(gC.m^2.day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out)       :: VectorB            !! Vector containing the litter increase per
+                                                                                      !! sechiba time step
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncarb), INTENT(out)         :: CN_target          !! C to N ratio of SOM flux from one pool to another (gN m-2 dt-1) 
+    REAL(r_std), DIMENSION(nvm), INTENT(out)                    :: ld_redistribute    !! logical set to redistribute som and litter  
+ 
+    !! 0.3 Modified variables
+   
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nelements), INTENT(in)          :: som      !! SOM pools: active, slow, or passive, \f$(gC m^{2})$\f 
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), 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)
+    REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(inout)       :: lignin_wood        !! Ratio Lignin/Carbon in woody litter,	
+                                                                                      !! above and below ground, (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)             :: n_mineralisation   !! Mineral N pool (gN m-2)
+
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(inout)     :: CN_som_litter_longterm !! Longterm CN ratio of litter and som pools (gC/gN)
+    REAL(r_std), INTENT(inout)                                  :: tau_CN_longterm        !! Counter used for calculating the longterm CN_ratio of som and litter pools [seconds]
+
+    !! 0.4 Local variables
+ 
+    REAL(r_std)                                                 :: dt                 !! Time step of the simulations for stomate
+                                                                                      !! @tex $(dt_sechiba one\_day^{-1})$ @endtex 
+    REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)          :: litterfrac         !! The fraction of leaves, wood, etc. that 
+                                                                                      !! goes into metabolic and structural 
+                                                                                      !! litterpools (0-1, unitless)
+!$OMP THREADPRIVATE(litterfrac)
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)                :: z_soil             !! Soil levels (m)
+!$OMP THREADPRIVATE(z_soil)
+    REAL(r_std), DIMENSION(npts)                                :: rpc                !! Integration constant for vertical root 
+                                                                                      !! profiles (unitless)
+    REAL(r_std), SAVE, DIMENSION(nlitt)                         :: litter_dec_fac     !! Turnover time in litter pools (days)
+!$OMP THREADPRIVATE(litter_dec_fac)
+    REAL(r_std), SAVE, DIMENSION(nlitt,ncarb,nlevs)             :: frac_soil          !! Fraction of litter that goes into soil 
+                                                                                      !! (litter -> carbon, above and below). The
+                                                                                      !! remaining part goes to the atmosphere
+!$OMP THREADPRIVATE(frac_soil)
+    REAL(r_std), DIMENSION(npts)                                :: tsoil_decomp       !! Temperature used for decompostition in 
+                                                                                      !! soil (K)
+    REAL(r_std), DIMENSION(npts)                                :: soilhum_decomp     !! Humidity used for decompostition in soil
+                                                                                      !! (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: fd                 !! Fraction of structural or metabolic litter
+                                                                                      !! decomposed (unitless)
+    REAL(r_std), DIMENSION(npts,nelements)                      :: qd                 !! Quantity of structural or metabolic litter
+                                                                                      !! decomposed @tex $(gC m^{-2})$ @endtex
+                                                                                      !! @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,nlevs)                      :: old_woody          !! Old woody litter, above and below 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements)      :: 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,nlevs)                      :: lignin_wood_inc    !! Lignin increase in woody litter, 
+                                                                                      !! above and below ground. The unit is given 
+                                                                                      !! by m^2 of ground. 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts)                                :: zdiff_min          !! Intermediate field for looking for minimum
+                                                                                      !! of what? this is not used in the code. 
+                                                                                      !! [??CHECK] could we delete it?
+    CHARACTER(LEN=10), DIMENSION(nlitt)                         :: litter_str         !! Messages to write output information about
+                                                                                      !! the litter
+    CHARACTER(LEN=22), DIMENSION(nparts)                        :: part_str           !! Messages to write output information about
+                                                                                      !! the plant
+    CHARACTER(LEN=7), DIMENSION(ncarb)                          :: carbon_str         !! Messages to write output information about
+                                                                                      !! the soil carbon
+    CHARACTER(LEN=5), DIMENSION(nlevs)                          :: level_str          !! Messages to write output information about
+                                                                                      !! the level (aboveground or belowground litter)
+    INTEGER(i_std)                                              :: ilitt,ilev,ibdl    !! Indices (unitless)
+    INTEGER(i_std)                                              :: ipts,ivm, j        !! Indices (unitless)
+    INTEGER(i_std)                                              :: icarb,inspec,iele  !! Indices (unitless)
+    INTEGER(i_std)                                              :: ipar,imbc,iicarb   !! Indices (unitless)
+    REAL(r_std), DIMENSION(npts,nvm)                            :: f_soil_n_min       !! soil_n_min function response used for defing C to N target ratios (-) 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: f_pnc              !! plant nitrogen concentration function response
+                                                                                      !! used for defining C to N target ratios (-)  
+    INTEGER(i_std)                                              :: itarget            !! target som pool 
+    REAL(r_std), DIMENSION(npts,nvm,nparts)                     :: CN                 !! CN ratio of the litter pools 
+    REAL(r_std), DIMENSION(npts,nelements)                      :: summ  
+    INTEGER(i_std)                                              :: ier                !! Error handling
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)          :: check_intern       !! Contains the components of the internal
+                                                                                      !! mass balance check for this routine
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: closure_intern     !! Check closure of internal mass balance
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: pool_start         !! Start and end pool of this routine 
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: pool_end           !! Start and end pool of this routine 
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                            :: temp
+    REAL(r_std), DIMENSION(npts)                                :: err                     !! Array for error checking 
+    REAL(r_std), DIMENSION(ncarb,nelements)                     :: som_input_old           !! Used to store som_input values
+                                                                                           !! in case of inadequate soil N
+    REAL(r_std), DIMENSION(ncarb,nelements)                     :: delta_som_input         !! Used to store som_input values
+                                                                                           !! in case of inadequate soil N
+    REAL(r_std), DIMENSION(nvm,nelements)                       :: som_input_new           !! Used to recalculate som_input in
+                                                                                           !! case of inadequate soil N
+    REAL(r_std)                                                 :: CN_input_total          !! overall C/N ratio of som_input_total
+    REAL(r_std), DIMENSION(nvm,nelements)                       :: som_input_total         !! Used to recalculate som_input in
+                                                                                           !! case of inadequate soil N
+    REAL(r_std), DIMENSION(nelements)                           :: litter_total_new        !! Updated litter pool in case of nitrogen
+                                                                                           !! deficit
+    REAL(r_std), DIMENSION(npts,nvm)                            :: total_init_nitrogen     !! Litter pool at the very start of the 
+                                                                                           !! calculations. Required to correct for the
+                                                                                           !! nitrogen deficit
+    REAL(r_std)                                                 :: n_mineralisation_init   !! temp variable in case of overspending
+    REAL(r_std)                                                 :: delta_hetero_litter     !! reduction factor of resp_hetero
+                                                                                           !! in case of nitrogen shortage
+    
+!!$    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: delta_s_in              !! som_input removed
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: share_litter_struc_a    !! Fractions of litter in various pools
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: share_litter_struc_b    !! Fractions of litter in various pools
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: share_litter_met_a      !! Fractions of litter in various pools
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: share_litter_met_b      !! Fractions of litter in various pools
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: share_litter_woody_a    !! Fractions of litter in various pools
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: share_litter_woody_b    !! Fractions of litter in various pools
+    REAL(r_std)                                                 :: share_som_input_active  !! Active pool fraction of 
+                                                                                           !! som_input(:,:,ivm,initrogen)
+    REAL(r_std)                                                 :: share_som_input_slow    !! Slow pool fraction of
+                                                                                           !! som_input(:,:,ivm,initrogen)
+    REAL(r_std)                                                 :: share_som_input_surface !! Surface pool fraction of
+                                                                                           !! som_input(:,:,ivm,initrogen)
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nlevs)                :: N_deficit               !! Missing litter N (per pool) after pulling 
+                                                                                           !! additional litter N to satisfy 
+                                                                                           !! N_mineralisation demand (5.5)
+    REAL(r_std)                                                 :: N_deficit_total         !! Total litter N deficit (5.5)
+    REAL(r_std), DIMENSION(npts,nvm)                            :: litter_max              !! Finds largest current litter pool
+    REAL(r_std), DIMENSION(npts,nvm,ncarb,ncarb,nelements)      :: flux                    !! Fluxes between carbon pools (gC/m^2)
+    REAL(r_std), DIMENSION(npts,nvm,ncarb,nelements)            :: fluxtot                 !! Total flux out of carbon pools (gC/m^2)
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nelements)            :: som_temp                !! Temp variable
+    REAL(r_std), DIMENSION(npts,ncarb,ncarb)                    :: frac_carb               !! Flux fractions between carbon pools
+    REAL(r_std), DIMENSION(npts,ncarb)                          :: frac_resp               !! Flux fractions from carbon pools to the atmosphere
+                                                                                           !! atmosphere (respiration) (unitless, 0-1)
+    REAL(r_std), DIMENSION(ncarb)                               :: som_turn                !! Residence time in SOM pools (days)
+    REAL(r_std), DIMENSION(npts,nvm)                            :: n_mineralisation_som    !! n_mineralisation that we will calculate in the 
+                                                                                           !! next routine
+    REAL(r_std), DIMENSION(npts,nvm)                            :: n_min_new               !! Temp variable
+    REAL(r_std), DIMENSION(npts,nvm)                            :: n_min_old               !! Temp variable
+    REAL(r_std), DIMENSION(nvm,nelements)                       :: som_input_total_new     !! Truncated value of N moved from 
+                                                                                           !! n_mineralisation to som_input
+    REAL(r_std), DIMENSION(npts,nvm)                            :: share_som_input_act_n   !! Active pool fraction of 
+                                                                                           !! som_input(:,:,ivm,initrogen)
+    REAL(r_std), DIMENSION(npts,nvm)                            :: share_som_input_slow_n  !! Slow pool fraction of
+                                                                                           !! som_input(:,:,ivm,initrogen)
+    REAL(r_std), DIMENSION(npts,nvm)                            :: share_som_input_surf_n  !! Surface pool fraction of
+                                                                                           !! som_input(:,:,ivm,initrogen)
+    REAL(r_std), DIMENSION(npts,nvm)                            :: resp_hetero_soil        !! Soil heterotrophic respiration (gC/m^2/day)   
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: total_som_n_flux        !! Total flux between all soil pools. Used to adjust 
+                                                                                           !! som if overspending @tex $(N gN m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                            :: f_fungivores            !! Fraction of decomposed litter consumed by 
+                                                                                           !! fungivores
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements)           :: biomass_temp            !! Temporal value to calculate fungivores 
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering littercalc'
+
+    !! 1.1 Initialize local printlev
+    !printlev_loc=get_printlev('litter')
+
+
+  !! 1. Initialisations of the different fields during the first call of the routine 
+    dt = dt_sechiba/one_day
+
+    IF ( firstcall_litter ) THEN
+
+       IF ( .NOT. ALLOCATED(litterfrac) ) THEN
+          ALLOCATE(litterfrac(npts,nvm,nparts,nlitt))
+       ENDIF
+
+       !! 1.1.2 residence times in litter pools (days)
+       ! .5 years, 3 years and ??30 years??(2.45)
+       litter_dec_fac(imetabolic) = turn_metabolic / one_year      
+       litter_dec_fac(istructural) = turn_struct / one_year        
+       litter_dec_fac(iwoody) = turn_woody / one_year  
+      
+       !! 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,isurface,iabove) = frac_soil_struct_sua
+       frac_soil(istructural,iactive,ibelow) = frac_soil_struct_ab
+       frac_soil(istructural,islow,iabove) = frac_soil_struct_sa
+       frac_soil(istructural,islow,ibelow) = frac_soil_struct_sb
+
+       ! metabolic litter: all goes into active pool + respiration.
+       ! Nothing into slow or passive pool.
+       frac_soil(imetabolic,isurface,iabove) = frac_soil_metab_sua
+       frac_soil(imetabolic,iactive,ibelow) = frac_soil_metab_ab
+
+       ! woody litter: lignin fraction goes into slow pool + respiration,
+       ! rest into active pool + respiration. Same as strucutural
+       !!$ frac_soil(iwoody,isurface,iabove) = frac_soil_struct_sua
+       !!$ frac_soil(iwoody,iactive,ibelow) = frac_soil_struct_ab
+       !!$ frac_soil(iwoody,islow,iabove) = frac_soil_struct_sa
+       !!$ frac_soil(iwoody,islow,ibelow) = frac_soil_struct_sb
+
+       ! woody litter lignin fraction should be lower than that of structural
+       ! litter, else woody litter will not decompose quickly enough.
+       ! In effect, this decreases the carbon use efficiency of the system to  
+       ! allow for faster litter decomposition. The parameter frac_woody is not
+       ! well-constrained and was tested for a boreal PFT in northern Sweden.       
+       frac_soil(iwoody,isurface,iabove) = frac_woody * frac_soil_struct_sua
+       frac_soil(iwoody,iactive,ibelow) = frac_woody * frac_soil_struct_ab
+       frac_soil(iwoody,islow,iabove) = frac_woody * frac_soil_struct_sa
+       frac_soil(iwoody,islow,ibelow) = frac_woody * frac_soil_struct_sb
+
+       !! 1.2 soil levels
+       ALLOCATE(z_soil(0:nbdl), stat=ier)
+       IF ( ier /= 0 ) CALL ipslerr(3,'littercalc','Pb in allocate of z_soil','','')
+
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+       !! 1.3 messages
+       litter_str(imetabolic) = 'metabolic'
+       litter_str(istructural) = 'structural'
+       litter_str(iwoody) = 'woody'
+
+       carbon_str(iactive) = 'active'
+       carbon_str(isurface) = 'surface'
+       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'
+       part_str(ilabile) = 'labile reserve'
+
+       ! Debug
+       IF (printlev_loc.GE.4) THEN
+          WRITE(numout,*) 'litter:'
+
+          WRITE(numout,*) '   > C/N ratios: '
+          DO ipar = 1, nparts
+             WRITE(numout,*) '       ', part_str(ipar), ': ',CN_fix(ipar)
+          ENDDO
+          
+          WRITE(numout,*) '   > scaling depth for decomposition (m): ',z_decomp
+
+          WRITE(numout,*) '   > minimal carbon residence time in litter pools (d):'
+          DO ilitt = 1, nlitt
+             WRITE(numout,*) '       ',litter_str(ilitt),':',litter_dec_fac(ilitt)
+          ENDDO
+          
+          WRITE(numout,*) '   > litter decomposition flux fraction that really goes '
+          WRITE(numout,*) '     into carbon pools (rest into the atmosphere):'
+          DO ilitt = 1, nlitt
+             DO ilev = 1, nlevs
+                DO icarb = 1, ncarb
+                   WRITE(numout,*) '       ',litter_str(ilitt),' ',level_str(ilev),' -> ',&
+                        carbon_str(icarb),':', frac_soil(ilitt,icarb,ilev)
+                ENDDO
+             ENDDO
+          ENDDO
+
+       ENDIF
+       !-
+          
+       firstcall_litter = .FALSE.
+
+    ENDIF
+
+    !! 1.1.3 litter fractions:
+    !  What fraction of leaves, wood, etc. goes into metabolic and 
+    !  structural litterpools
+
+    ! PFT 1 needs to be initialised for when everything is printed below
+    litterfrac(:,1,:,:)=zero
+    CN(:,:,:) = zero
+
+    !+++CHECK+++
+    ! Add documentation
+    ! Calculate the CN ratio. If the CN ratio cannot be calculated
+    ! then use the prescribed value
+    DO ipar = 1, nparts
+       
+       ! Debug
+       IF(printlev_loc >=4) THEN
+          WRITE(numout,*) 'bm_to_litter carbon for ',&
+            part_str(ipar),':',bm_to_litter(:,:,ipar,icarbon)
+          WRITE(numout,*) 'bm_to_litter nitrogen for ',&
+            part_str(ipar),':',bm_to_litter(:,:,ipar,initrogen)
+          WRITE(numout,*) 'turnover carbon for ',&
+            part_str(ipar),':',turnover(:,:,ipar,icarbon)
+          WRITE(numout,*) 'turnover nitrogen for ',&
+            part_str(ipar),':',turnover(:,:,ipar,initrogen)       
+       ENDIF
+       !-
+
+       WHERE((bm_to_litter(:,:,ipar,initrogen)+&
+            turnover(:,:,ipar,initrogen)).GT.min_stomate) 
+          CN(:,:,ipar) = (bm_to_litter(:,:,ipar,icarbon)+&
+               turnover(:,:,ipar,icarbon))/ & 
+               (bm_to_litter(:,:,ipar,initrogen)+&
+               turnover(:,:,ipar,initrogen))
+
+       ELSEWHERE
+
+          CN(:,:,ipar) = CN_fix(ipar)
+
+       ENDWHERE
+
+       DO ivm = 1,nvm
+
+          IF ( ((ipar == isapabove) .OR. (ipar == isapbelow) .OR. &
+               (ipar == iheartabove) .OR. (ipar == iheartbelow)) .AND. &
+               ivm == 1) THEN
+
+             WHERE (SUM(litter(:,iwoody,ivm,:,icarbon),2).GT.min_stomate)
+
+                ! PFT 1 with woody litter will be treated as
+                ! a forest
+                litterfrac(:,ivm,ipar,iwoody) = 1.0
+                litterfrac(:,ivm,ipar,imetabolic) = zero
+                litterfrac(:,ivm,ipar,istructural) = zero
+                
+             ENDWHERE
+ 
+          ELSEIF ( ((ipar == isapabove) .OR. (ipar == isapbelow) .OR. &
+               (ipar == iheartabove) .OR. (ipar == iheartbelow)) &
+               .AND. is_tree(ivm) ) THEN
+             
+             ! Woody components of forest PFTs
+             litterfrac(:,ivm,ipar,iwoody) = 1.0
+             litterfrac(:,ivm,ipar,imetabolic) = zero
+             litterfrac(:,ivm,ipar,istructural) = zero
+
+          ELSE 
+
+             ! PFT 1 without woody litter and all non-forest PFTs
+             IF( (ipar == icarbres) .OR. (ipar == ilabile)) THEN
+
+                litterfrac(:,ivm,ipar,imetabolic) = 1.0
+
+             ELSE
+
+                litterfrac(:,ivm,ipar,imetabolic) = &
+                     MAX(metabolic_ref_frac - metabolic_LN_ratio  * &
+                     LC(ivm,ipar) * CN(:,ivm,ipar),zero)
+
+             ENDIF
+
+             litterfrac(:,ivm,ipar,istructural) = &
+                  1. - litterfrac(:,ivm,ipar,imetabolic)
+             litterfrac(:,ivm,ipar,iwoody) = zero
+             
+          ENDIF
+   
+       END DO
+       
+    END DO
+
+    ! Error checking
+    IF(err_act.GT.1)THEN
+       DO ipts = 1,npts
+          DO ivm = 1,nvm
+             DO ipar = 1, nparts
+                IF((bm_to_litter(ipts,ivm,ipar,initrogen)+turnover(ipts,ivm,ipar,initrogen)).GT.min_stomate)THEN
+                   IF (abs(SUM(litterfrac(ipts,ivm,ipar,:))-1.0).GT.min_stomate) THEN
+                      WRITE(numout,*) 'litterfrac - should equal to 1, ', ivm, ipar, &
+                           SUM(litterfrac(ipts,ivm,ipar,:))
+                      WRITE(numout,*) 'CN, ', CN(ipts,ivm,ipar)
+                      WRITE(numout,*) 'CN_target (ncarb), ',CN_target(ipts,ivm,:)
+                      CALL ipslerr(3,'stomate_litter',&
+                           'litterfrac do not add up to 1','','')
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+    ! Error checking
+    ! soil_n_min should never be zero. It is a nitrogen pool
+    ! expressed in gN m-2
+    temp(:,:)=zero
+    WHERE(soil_n_min(:,:,iammonium).LT.zero)
+       temp(:,:) = un
+    ENDWHERE
+
+    IF (SUM(SUM(temp(:,:),2)).GT.zero) THEN
+       WRITE(numout,*)'ERROR: soil_n_min iammonium is negative',&
+            soil_n_min(:,:,iammonium)     
+       CALL ipslerr(3,'stomate_litter',&
+            'At least one soil_n_min value',&
+            'is negative in stomate_litter','')
+    ENDIF
+    
+    temp(:,:)=zero
+    WHERE(soil_n_min(:,:,initrate).LT.zero)
+       temp(:,:) = un
+    ENDWHERE
+    
+    IF (SUM(SUM(temp(:,:),2)).GT.zero) THEN
+       WRITE(numout,*)'ERROR: soil_n_min initrate is negative', &
+            soil_n_min(:,:,initrate)     
+       CALL ipslerr(3,'stomate_litter',&
+            'At least one soil_n_min value',&
+            'is negative in stomate_litter','')
+    ENDIF
+
+    !+++HACK+++
+    ! This code is OK only when the land cover change and the age
+    ! class distribution code are working properly. Better to test
+    ! it in those subroutines than to enforce it here. If there are
+    ! problems with land cover change or age class distribution the
+    ! mass balance for soil_n_min may be violated here.
+    DO ipts = 1, npts
+       DO ivm = 1, nvm
+          DO inspec = 1, nnspec
+             IF((veget_cov_max(ipts,ivm).LT.min_stomate) .AND. &
+                  (soil_n_min(ipts,ivm,inspec).GT. min_stomate)) THEN
+                !WRITE(numout,*) 'PFT,',ivm,', pixel:', ipts,', truc:',inspec
+                !WRITE(numout,*) 'veget_cov_max,',veget_cov_max(ipts,ivm)
+                !WRITE(numout,*) 'soil_n_min, ',soil_n_min(ipts,ivm,inspec)
+                CALL ipslerr(3,'stomate_litter',&
+                     'soil_n_min present in pixels without veget_cov_max',&
+                     '','')   
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDDO
+    !++++++++++
+
+    !+++CHECK+++
+    ! ADD documentation. What justifies the use of 2? Should 
+    ! that parameter be externalized? What does that parameter
+    ! represent? The MIN does NOT protect against negative
+    ! soil_n_values. Negative values should not occur!
+    f_soil_n_min(:,:) = &
+         MIN((soil_n_min(:,:,iammonium) + soil_n_min(:,:,initrate)), 2.)
+    !+++++++++++
+
+    ! C to N target ratios of different pools
+    CN_target(:,:,:)=zero
+
+    ! CN ratio ranges between 3 and 15 for active pool
+    ! Figure 4 of Parton et al. (1993) show lower CN values for active 
+    ! pool of 2 rather than 3
+    CN_target(:,:,iactive)= CN_target_iactive_ref + &
+         CN_target_iactive_Nmin * f_soil_n_min(:,:)
+
+    ! CN ratio ranges between 12 and 20 for slow pool
+    CN_target(:,:,islow)= CN_target_islow_ref + &
+         CN_target_islow_Nmin * f_soil_n_min(:,:)
+
+    ! CN ratio ranges between 7 and 10 for passive pool
+    ! OCN uses a fixed value of 9. (don't know why)
+    ! Figure 4 of Parton et al. (1993) show lower CN values 
+    ! for passive pool of 3 rather than 7
+    CN_target(:,:,ipassive)= CN_target_ipassive_ref + &
+         CN_target_ipassive_Nmin * f_soil_n_min(:,:)
+
+    ! Plant nitrogen content (%)
+    WHERE(litter(:,imetabolic,:,iabove,icarbon)+&
+         litter(:,istructural,:,iabove,icarbon).GT.zero)
+
+       !+++CHECK+++
+       ! Why do we multiply with 2?, why do we take the
+       ! minimun between the calculation and 2. Do those
+       ! two 2s represent the same parameter? The 2* may
+       ! be used to convert carbon biomass to fresh biomass 
+       f_pnc(:,:)=MIN((litter(:,imetabolic,:,iabove,initrogen)+&
+            litter(:,istructural,:,iabove,initrogen)) / &
+            (2.*(litter(:,imetabolic,:,iabove,icarbon)+&
+            litter(:,istructural,:,iabove,icarbon))) * 100., 2.)
+       !+++++++++++
+
+    ELSEWHERE
+
+       f_pnc(:,:)= zero
+
+    ENDWHERE    
+
+    !+++CHECK+++
+    ! Add documentation
+    CN_target(:,:,isurface) = CN_target_isurface_ref + &
+         CN_target_isurface_pnc * f_pnc(:,:)
+    !+++++++++++
+
+    !! 1.4 set output to zero
+    deadleaf_cover(:) = zero
+    resp_hetero_litter(:,:) = zero
+    som_input(:,:,:,:) = zero
+    n_fungivores(:,:) = zero
+    f_fungivores(:,:) = zero
+
+    !! 1.5 Initialize check for mass balance closure
+    !  The mass balance is calculated at the end of this routine
+    !  in section 6. Initial biomass and harvest pool all other
+    !  relevant pools were just set to zero.
+    IF (err_act.GT.1) THEN
+
+          pool_start(:,:,:) = zero
+          pool_start(:,:,initrogen) = pool_start(:,:,initrogen) + &
+               n_mineralisation(:,:) * veget_cov_max(:,:)              
+          pool_start(:,:,initrogen) = pool_start(:,:,initrogen) + &
+               n_fungivores(:,:) * veget_cov_max(:,:)
+     
+          DO iele = 1,nelements 
+             ! The litter pool
+             DO ilitt = 1,nlitt
+                DO ilev = 1,nlevs
+                   pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                        (litter(:,ilitt,:,ilev,iele) * veget_cov_max(:,:))
+                ENDDO
+             ENDDO
+             
+             ! Pools added to the litter
+             DO ipar = 1,nparts
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                     (turnover(:,:,ipar,iele) + &
+                     bm_to_litter(:,:,ipar,iele)) * veget_cov_max(:,:)
+             ENDDO
+ 
+          ENDDO
+
+    ENDIF ! err_act.GT.1
+
+    ! Store the initial available N. In case there is overspending of nitrogen
+    ! this value can be used to adjust the spending
+    WHERE (veget_cov_max(:,:).GT.zero)
+       total_init_nitrogen(:,:) = n_mineralisation(:,:) +  &
+            SUM(SUM(litter(:,:,:,:,initrogen),4),2) + SUM(turnover(:,:,:,initrogen),3) + &
+            SUM(bm_to_litter(:,:,:,initrogen),3)
+    ELSEWHERE
+       total_init_nitrogen(:,:) = zero
+    ENDWHERE
+
+   ! fungivores was applied to avoid the problem that soil mineral nitrogen is used up by
+   ! the decomposition after all individuals death. A certain portion (f_fungivores) of nitrogen
+   ! pool from the litter was fed to the vegetation using n_fungivores. But not to give extra
+   ! nitrogen even in optimum condition, dynamic f_fungivores is more reasonable
+   ! than fixed f_fungivores. Before calculating n_fungivores f_fungivoes is
+   ! calculated using total biomass and total litter of carbon.  
+   ! Underlying idea is to use predator prey relationship between fungi and
+   ! fungivores. When there is a lot of litter, there will be a lot of fungi and
+   ! so we expect a lot of fungivores. Nitrogen excreted by the fungivores will
+   ! be used by plants. This implementation would benefit from a more solid
+   ! process understanding and more literature on the topic.
+   biomass_temp(:,:,:,:) = cc_to_biomass(npts,nvm,circ_class_biomass(:,:,:,:,:),&
+       circ_class_n(:,:,:))
+
+   WHERE ((SUM(biomass_temp(:,:,:,icarbon),3) + SUM(SUM(litter(:,:,:,:,icarbon),4),2) + &
+      SUM(bm_to_litter(:,:,:,icarbon),3) ) .LT. min_stomate)
+      f_fungivores(:,:) = zero
+   ELSEWHERE
+      f_fungivores(:,:) = (SUM(SUM(litter(:,:,:,:,icarbon),4),2) + &
+       SUM(bm_to_litter(:,:,:,icarbon),3))/(SUM(biomass_temp(:,:,:,icarbon),3) + &
+       SUM(SUM(litter(:,:,:,:,icarbon),4),2) + SUM(bm_to_litter(:,:,:,icarbon),3) )
+   ENDWHERE
+ 
+  !! 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 ilev = 1, nlevs !Loop over litter levels (above and below ground)
+
+       DO ivm = 1,nvm !Loop over PFTs
+
+          old_struc(:,ivm,ilev) = litter(:,istructural,ivm,ilev,icarbon)
+          old_woody(:,ivm,ilev) = litter(:,iwoody,ivm,ilev,icarbon)
+
+       ENDDO
+
+    ENDDO
+    
+    !! 2.2 update litter, dead leaves, and lignin content in structural litter
+    litter_inc(:,:,:,:,:) = zero
+    lignin_struc_inc(:,:,:) = zero
+    lignin_wood_inc(:,:,:) = zero
+
+    DO ivm = 1,nvm !Loop over PFTs
+
+       !! 2.2.1 litter
+       DO ilitt = 1, nlitt    !Loop over litter pools (metabolic and structural)
+          
+          DO iele = 1, nelements  ! Loop over element pools (carbon and nitrogen)
+             
+             !! 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(:,ilitt,ivm,iabove,iele) = & 
+                  litterfrac(:,ivm,ileaf,ilitt) * bm_to_litter(:,ivm,ileaf,iele) + & 
+                  litterfrac(:,ivm,isapabove,ilitt) * bm_to_litter(:,ivm,isapabove,iele) + & 
+                  litterfrac(:,ivm,iheartabove,ilitt) * bm_to_litter(:,ivm,iheartabove,iele) + & 
+                  litterfrac(:,ivm,ifruit,ilitt) * bm_to_litter(:,ivm,ifruit,iele) + & 
+                  litterfrac(:,ivm,icarbres,ilitt) * bm_to_litter(:,ivm,icarbres,iele) + & 
+                  litterfrac(:,ivm,ilabile,ilitt) * bm_to_litter(:,ivm,ilabile,iele) + & 
+                  litterfrac(:,ivm,ileaf,ilitt) * turnover(:,ivm,ileaf,iele) + & 
+                  litterfrac(:,ivm,isapabove,ilitt) * turnover(:,ivm,isapabove,iele) + & 
+                  litterfrac(:,ivm,iheartabove,ilitt) * turnover(:,ivm,iheartabove,iele) + & 
+                  litterfrac(:,ivm,ifruit,ilitt) * turnover(:,ivm,ifruit,iele) + & 
+                  litterfrac(:,ivm,icarbres,ilitt) * turnover(:,ivm,icarbres,iele)+ &  
+                  litterfrac(:,ivm,ilabile,ilitt) * turnover(:,ivm,ilabile,iele) 
+
+             litter_inc(:,ilitt,ivm,ibelow,iele) = & 
+                  litterfrac(:,ivm,isapbelow,ilitt) * bm_to_litter(:,ivm,isapbelow,iele) + & 
+                  litterfrac(:,ivm,iheartbelow,ilitt) * bm_to_litter(:,ivm,iheartbelow,iele) + & 
+                  litterfrac(:,ivm,iroot,ilitt) * bm_to_litter(:,ivm,iroot,iele) + & 
+                  litterfrac(:,ivm,isapbelow,ilitt) * turnover(:,ivm,isapbelow,iele) + & 
+                  litterfrac(:,ivm,iheartbelow,ilitt) * turnover(:,ivm,iheartbelow,iele) + & 
+                  litterfrac(:,ivm,iroot,ilitt) * turnover(:,ivm,iroot,iele) 
+             
+          ENDDO
+
+          IF ( ilitt /= iwoody ) THEN
+
+             !! 2.2.3 dead leaves, for soil cover.
+             dead_leaves(:,ivm,ilitt) = &
+                  dead_leaves(:,ivm,ilitt) + litterfrac(:,ivm,ileaf,ilitt) * &
+                  ( bm_to_litter(:,ivm,ileaf,icarbon) + &
+                  turnover(:,ivm,ileaf,icarbon) )
+
+          ENDIF
+
+          IF(is_tree(ivm))THEN
+
+             IF ( ilitt == istructural ) THEN
+
+                !! 2.2.4 lignin increase in structural litter
+                lignin_struc_inc(:,ivm,iabove) = &
+                     LC(ivm,ileaf) * bm_to_litter(:,ivm,ileaf,icarbon) + &
+                     LC(ivm,ifruit) * bm_to_litter(:,ivm,ifruit,icarbon) + &
+                     LC(ivm,icarbres) * bm_to_litter(:,ivm,icarbres,icarbon) + &
+                     LC(ivm,ilabile) * bm_to_litter(:,ivm,ilabile,icarbon) + &
+                     LC(ivm,ileaf) * turnover(:,ivm,ileaf,icarbon) + &
+                     LC(ivm,ifruit) * turnover(:,ivm,ifruit,icarbon) + &
+                     LC(ivm,icarbres) * turnover(:,ivm,icarbres,icarbon) + &
+                     LC(ivm,ilabile) * turnover(:,ivm,ilabile,icarbon)
+             
+                lignin_struc_inc(:,ivm,ibelow) = &
+                     LC(ivm,iroot) * bm_to_litter(:,ivm,iroot,icarbon) + &
+                     LC(ivm,iroot)*turnover(:,ivm,iroot,icarbon)
+              
+             ELSEIF ( ilitt == iwoody) THEN       
+              
+                !! 2.2.4 lignin increase in woody litter
+                lignin_wood_inc(:,ivm,iabove) = &
+                     LC(ivm,isapabove) * bm_to_litter(:,ivm,isapabove,icarbon) + &
+                     LC(ivm,iheartabove) * bm_to_litter(:,ivm,iheartabove,icarbon) + &
+                     LC(ivm,isapabove) * turnover(:,ivm,isapabove,icarbon) + &
+                     LC(ivm,iheartabove) * turnover(:,ivm,iheartabove,icarbon) 
+             
+                lignin_wood_inc(:,ivm,ibelow) = &
+                     LC(ivm,isapbelow) * bm_to_litter(:,ivm,isapbelow,icarbon) + &
+                     LC(ivm,iheartbelow) * bm_to_litter(:,ivm,iheartbelow,icarbon) + &
+                     LC(ivm,isapbelow)*turnover(:,ivm,isapbelow,icarbon) + &
+                     LC(ivm,iheartbelow)*turnover(:,ivm,iheartbelow,icarbon) 
+             
+             ENDIF ! istructural or iwoody
+
+          ELSE 
+
+             ! None woody vegetation
+
+             IF (ilitt == istructural) THEN
+
+                !! 2.2.4 lignin increase in structural litter
+                lignin_struc_inc(:,ivm,iabove) = lignin_struc_inc(:,ivm,iabove) + &
+                     LC(ivm,isapabove) * bm_to_litter(:,ivm,isapabove,icarbon) + &
+                     LC(ivm,iheartabove) * bm_to_litter(:,ivm,iheartabove,icarbon) + &
+                     LC(ivm,isapabove) * turnover(:,ivm,isapabove,icarbon) + &
+                     LC(ivm,iheartabove) * turnover(:,ivm,iheartabove,icarbon) 
+             
+                lignin_struc_inc(:,ivm,ibelow) = lignin_struc_inc(:,ivm,ibelow) + &
+                     LC(ivm,isapbelow) * bm_to_litter(:,ivm,isapbelow,icarbon) + &
+                     LC(ivm,iheartbelow) * bm_to_litter(:,ivm,iheartbelow,icarbon) + &
+                     LC(ivm,isapbelow)*turnover(:,ivm,isapbelow,icarbon) + &
+                     LC(ivm,iheartbelow)*turnover(:,ivm,iheartbelow,icarbon)
+                
+             ENDIF ! istructural
+             
+          ENDIF ! is_tree
+          
+       ENDDO ! #nlitt
+
+       ! Error checking
+       ! bm_to_litter should be completely transfered to litter_inc
+       DO iele = 1,nelements
+          IF (ABS(SUM(SUM(SUM(litter_inc(:,:,ivm,:,iele),3),2)) - &
+               SUM(SUM(bm_to_litter(:,ivm,:,iele),2)) - SUM(SUM(turnover(:,ivm,:,iele),2))).GT. min_stomate) THEN
+             WRITE(numout,*) 'Problem with ivm, element,',ivm,iele
+             WRITE(numout,*) 'difference,',ABS(SUM(SUM(SUM(litter_inc(:,:,ivm,:,iele),3),2)) - &
+                  SUM(SUM(bm_to_litter(:,ivm,:,iele),2))-SUM(SUM(turnover(:,ivm,:,iele),2)))
+             CALL ipslerr(3,'littercalc','problem with litterfrac',&
+                  'Not all C/N has been transefered from',&
+                  'bm_to_litter & turnover to litter_inc')
+          ENDIF
+       ENDDO
+       
+    ENDDO !#nvm
+
+    !! 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 ilev = 1, nlevs !Loop over litter levels (above and below ground)
+
+       DO ivm = 1,nvm !Loop over PFTs
+          
+          lignin_struc_inc(:,ivm,ilev) = MIN( lignin_struc_inc(:,ivm,ilev), &
+               litter_inc(:,istructural,ivm,ilev,icarbon) )
+          lignin_wood_inc(:,ivm,ilev) = MIN( lignin_wood_inc(:,ivm,ilev), &
+               litter_inc(:,iwoody,ivm,ilev,icarbon) )
+
+       ENDDO ! nvm
+
+    ENDDO ! nlevs
+
+    !! 2.2.7 new lignin content: add old lignin and lignin increase, divide by 
+    !!       total structural litter (above/below)
+    DO ilev = 1, nlevs !Loop over litter levels (above and below ground)
+       
+       DO ivm = 1,nvm !Loop over PFTs
+
+           WHERE( litter(:,istructural,ivm,ilev,icarbon) .GT. min_stomate )
+
+              lignin_struc(:,ivm,ilev) = ( lignin_struc(:,ivm,ilev) * &
+                   old_struc(:,ivm,ilev) + lignin_struc_inc(:,ivm,ilev) ) / &
+                   litter(:,istructural,ivm,ilev,icarbon)
+              
+           ELSEWHERE
+
+              lignin_struc(:,ivm,ilev) = zero
+              
+           ENDWHERE
+     
+           WHERE ( litter(:,iwoody,ivm,ilev,icarbon) .GT. min_stomate )
+
+              lignin_wood(:,ivm,ilev) = ( lignin_wood(:,ivm,ilev) * &
+                   old_woody(:,ivm,ilev) + lignin_wood_inc(:,ivm,ilev) ) / &
+                   litter(:,iwoody,ivm,ilev,icarbon)
+
+           ELSEWHERE
+
+              lignin_wood(:,ivm,ilev) = zero
+
+           ENDWHERE
+      
+        ENDDO ! ivm
+        
+     ENDDO ! ilev
+    
+    
+     !! 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(:) = zero
+     
+     DO ibdl = 1, nbdl
+        
+        tsoil_decomp(:) = &
+             tsoil_decomp(:) + tsoil(:,ibdl) * rpc(:) * &
+             ( EXP( -z_soil(ibdl-1)/z_decomp ) - EXP( -z_soil(ibdl)/z_decomp ) )
+
+     ENDDO
+     IF(printlev_loc.GE.4)THEN
+         WRITE(numout,*) 'rpc',rpc(:)
+         WRITE(numout,*) 'tsoil',tsoil(:,:)
+         WRITE(numout,*) 'z_soil',z_soil(:)
+         WRITE(numout,*) 'z_decomp',z_decomp
+     ENDIF      
+     
+     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(:) = zero
+     
+     DO ibdl = 1, nbdl !Loop over soil levels
+        
+        soilhum_decomp(:) = &
+             soilhum_decomp(:) + soilhum(:,ibdl) * rpc(:) * &
+             ( EXP( -z_soil(ibdl-1)/z_decomp ) - EXP( -z_soil(ibdl)/z_decomp ) )
+        
+     ENDDO
+     
+     control_moist(:,ibelow) = control_moist_func (npts, soilhum_decomp)
+
+     ! Debug
+     IF(printlev_loc.GE.4) THEN
+        WRITE(numout,*) 'lignin_wood, ', test_pft, &
+             lignin_wood(:,test_pft,:)
+        WRITE(numout,*) 'lignin_struc, ', test_pft, &
+             lignin_struc(:,test_pft,:)
+        WRITE(numout,*) 'dead_leaves, ', test_pft, &
+             dead_leaves(:,test_pft,:)
+        WRITE(numout,*) 'control_temp above', control_temp(:,iabove)
+        WRITE(numout,*) 'tsurf', tsurf(:)
+        WRITE(numout,*) 'control_temp below', control_temp(:,ibelow)
+        WRITE(numout,*) 'tsoil_decomp', tsoil_decomp(:)  
+        WRITE(numout,*) 'control_moist above ', control_moist(:,iabove)
+        WRITE(numout,*) 'literhum', litterhum(:)
+        WRITE(numout,*) 'control_moist below ', control_moist(:,ibelow)
+        WRITE(numout,*) 'soil_hum_decomp', soilhum_decomp(:)
+      
+     ENDIF
+
+  !! 5. fluxes from litter to carbon pools and respiration
+
+     DO ilev = 1, nlevs !Loop over litter levels (above and below ground)
+        
+        DO ivm = 1,nvm !Loop over PFTs
+           
+           IF (ilev.EQ.iabove)THEN 
+              itarget=isurface 
+           ELSE 
+              itarget=iactive 
+           ENDIF
+
+           !! 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_dec_fac(istructural) * &
+                control_temp(:,ilev) * control_moist(:,ilev) * &
+                exp( -litter_struct_coef * lignin_struc(:,ivm,ilev) )
+
+           ! Ensure that fd is between 0 and 1
+           fd(:) = MAX(zero,MIN(fd(:),un))
+           
+           !! decompose same fraction of structural part of dead leaves. 
+           ! Not exact as lignin 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 calculate 
+           ! only ones in 1,nlev loop
+           IF (ilev == iabove)  THEN
+              
+              dead_leaves(:,ivm,istructural) = &
+                   dead_leaves(:,ivm,istructural) * ( un - fd(:) )
+              
+           ENDIF
+           
+           !! 5.1.2 Calculate the amount of structural litter
+           !  that was decomposed
+           err(:) = zero
+           WHERE ((litter(:,istructural,ivm,ilev,icarbon).GE.zero) .AND. &
+                (litter(:,istructural,ivm,ilev,initrogen).GE.zero))
+              
+              ! Calculate the quantity of structural litter that should
+              ! be decomposed
+              qd(:,icarbon) = litter(:,istructural,ivm,ilev,icarbon) * fd(:)
+              qd(:,initrogen) = litter(:,istructural,ivm,ilev,initrogen) * fd(:)
+
+           ELSEWHERE
+
+              ! Keep track of how many errors there are
+              err(:) = 1.
+
+           ENDWHERE
+
+           ! Check for errors 
+           IF (SUM(err(:)) .GT. zero) THEN
+              
+              WRITE(numout,*) 'Number of errors found: ,', SUM(err(:))
+              WRITE(numout,*) 'Negative structural litter pools in stomate_litter'
+              WRITE(numout,*) 'That does not make any sense'
+              DO iele = 1,nelements
+                 WRITE(numout,*) 'Structural litter pool, ', &
+                      ivm, ilev, iele, litter(:,istructural,ivm,ilev,iele)
+              END DO
+              CALL ipslerr(3,'stomate_litter','Negative litter pools',&
+                   'This should not be the case','')
+              !-
+              
+           END IF   
+             
+           ! Debug
+           IF(printlev_loc.GE.4 .AND. ivm.EQ.test_pft)THEN
+              WRITE(numout,*) 'fd, ',fd(:)
+              WRITE(numout,*) 'initial condition, ',ilev
+              WRITE(numout,*) 'dead_leaves(istructural), ',&
+                   dead_leaves(:,test_pft,istructural)
+              WRITE(numout,*) 'fracsoil, ',frac_soil(istructural,itarget,ilev)
+              WRITE(numout,*) 'resp_hetero, ',resp_hetero_litter(:,test_pft)
+              WRITE(numout,*) 'som_input - C, ', &
+                   SUM(som_input(:,:,test_pft,icarbon),2)
+              WRITE(numout,*) 'n_mineralisation, ',n_mineralisation(:,test_pft)
+              WRITE(numout,*) 'som_input - N, ',&
+                   SUM(som_input(:,:,test_pft,initrogen),2)
+              WRITE(numout,*) ''
+           ENDIF
+           !-
+
+           ! Subtract the mineralized fraction from the litter but make sure
+           ! the mineralisation cannot become negative
+           err(:) = zero   
+           WHERE ( (litter(:,istructural,ivm,ilev,icarbon).GE.qd(:,icarbon)) .AND. &
+                (litter(:,istructural,ivm,ilev,initrogen).GE.qd(:,initrogen)))
+
+              ! qd is calculated as litter(:,istructural,ivm,ilev,iele)*fd(:)
+              ! as long as fd is positive (which was enforced above) the
+              ! subtraction below should never result in a number that is
+              ! less than zero (except for precision issues). fd is the same
+              ! for carbon and nitrogen and therefore the ratio is preserved
+              ! during mineralization. The test conditions should be
+              ! satisfied for C and N at the same time.
+              litter(:,istructural,ivm,ilev,icarbon) = &
+                   litter(:,istructural,ivm,ilev,icarbon) - qd(:,icarbon)
+              litter(:,istructural,ivm,ilev,initrogen) = &
+                   litter(:,istructural,ivm,ilev,initrogen) - qd(:,initrogen)
+
+           ELSEWHERE
+
+              err(:) = 1.
+
+           ENDWHERE
+
+           ! Check for errors 
+           IF (SUM(err(:)) .GT. zero) THEN
+              
+              WRITE(numout,*) 'Number of errors found: ,', SUM(err(:))
+              WRITE(numout,*) 'Mineralization exceeds litter pools in stomate_litter'
+              WRITE(numout,*) 'This will cause problems later on'
+              DO iele = 1,nelements
+                 WRITE(numout,*) 'Structural litter pool, qd, ', &
+                      ivm, ilev, iele, litter(:,istructural,ivm,ilev,iele),qd(:,iele)
+              END DO
+              CALL ipslerr(3,'stomate_litter','Structural mineralization exceeds litter pool',&
+                   'This will cause problems later on','Fix the problem now')
+              
+           ENDIF
+
+!!$        ! Store n_mineralization for later use   
+!!$        n_mineralisation(:,ivm) = n_mineralisation(:,ivm) + qd(:,initrogen) 
+           
+           !+++++CHECK+++++ 
+           ! After large-scale dieback events, so much soil mineral N becomes immobilized 
+           ! to decompose litter that too little N is left for plant regrowth. To address 
+           ! this, we implicitly represent the action of fungivores, which release N for 
+           ! the plants and increase N turnover rates.  We set aside a fraction of qd, 
+           ! n_fungivores, which becomes available for plant uptake in nitrogen_dynamics.      
+           ! This parameter is not very well constrained and has been calibrated to find 
+           ! a good compromise between plant regrowth and litter decomposition.
+
+           n_mineralisation(:,ivm) = n_mineralisation(:,ivm) + (1-f_fungivores(:,ivm))*qd(:,initrogen)
+
+           n_fungivores(:,ivm) = n_fungivores(:,ivm) + f_fungivores(:,ivm)*qd(:,initrogen)
+          
+           !! 5.1.3 non-lignin fraction of structural litter goes into
+           !!       active (or surface) carbon pool + respiration 
+           som_input(:,itarget,ivm,icarbon) = &
+                som_input(:,itarget,ivm,icarbon) + & 
+                frac_soil(istructural,itarget,ilev) * qd(:,icarbon) * &
+                ( 1. - lignin_struc(:,ivm,ilev) ) / dt 
+           
+           ! 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.
+           resp_hetero_litter(:,ivm) = resp_hetero_litter(:,ivm) + &
+                ( 1. - frac_soil(istructural,itarget,ilev) ) * qd(:,icarbon) * &
+                ( 1. - lignin_struc(:,ivm,ilev) ) / dt
+      
+           !! 5.1.4 lignin fraction of structural litter goes into
+           !!       slow carbon pool + respiration
+           som_input(:,islow,ivm,icarbon) = som_input(:,islow,ivm,icarbon) + &
+                frac_soil(istructural,islow,ilev) * qd(:,icarbon) * &
+                lignin_struc(:,ivm,ilev) / 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 dt_sechiba/one_day time step and avoid some 
+           ! constructions that could create bug during future developments.
+           resp_hetero_litter(:,ivm) = resp_hetero_litter(:,ivm) + &
+                ( 1. - frac_soil(istructural,islow,ilev) ) * qd(:,icarbon) * &
+                lignin_struc(:,ivm,ilev) / dt
+           
+           ! Debug
+           IF(printlev_loc.GE.4 .AND. ivm.EQ.test_pft)THEN
+              WRITE(numout,*) 'check 1, ',ilev
+              WRITE(numout,*) 'dead_leaves(istructural), ',&
+                   dead_leaves(:,test_pft,istructural)
+              WRITE(numout,*) 'qd, icarbon, ilev', ilev, qd(:,icarbon)
+              WRITE(numout,*) 'resp_hetero, ',resp_hetero_litter(:,test_pft)
+              WRITE(numout,*) 'som_input - C, ', &
+                   SUM(som_input(:,:,test_pft,icarbon),2)
+              WRITE(numout,*) 'n_mineralisation, ',n_mineralisation(:,test_pft)
+              WRITE(numout,*) 'som_input - N, ',&
+                   SUM(som_input(:,:,test_pft,initrogen),2)
+              WRITE(numout,*) ''
+           ENDIF
+           !-
+        
+           !! 5.2 metabolic litter goes into active carbon pool + respiration
+           !! 5.2.1 total quantity of metabolic litter that is decomposed
+           fd(:) = dt*litter_dec_fac(imetabolic) * control_temp(:,ilev) * &
+                control_moist(:,ilev)
+           
+           ! Ensure that fd is between 0 and 1
+           fd(:) = MAX(zero,MIN(fd(:),un))
+
+           ! Calculate qd, make sure it has a positive value
+           err(:) = zero
+           WHERE ((litter(:,imetabolic,ivm,ilev,icarbon).GE.zero) .AND. &
+                (litter(:,imetabolic,ivm,ilev,initrogen).GE.zero))
+
+              ! Calculate the quantity of metabolic litter that should
+              ! be decomposed
+              qd(:,icarbon) = litter(:,imetabolic,ivm,ilev,icarbon) * fd(:)
+              qd(:,initrogen) = litter(:,imetabolic,ivm,ilev,initrogen) * fd(:)
+
+           ELSEWHERE
+
+              ! Keep track of how many errors there are
+              err(:) = 1.
+
+           ENDWHERE
+
+           ! Check for errors 
+           IF (SUM(err(:)) .GT. zero) THEN
+              
+              WRITE(numout,*) 'Number of errors found in icarbon: ,', SUM(err(:))
+              WRITE(numout,*) 'Negative litter pools in stomate_litter'
+              WRITE(numout,*) 'That does not make any sense'
+              DO iele = 1,nelements
+                 WRITE(numout,*) 'Metabolic litter pool, ', &
+                      ivm, ilev, iele, litter(:,imetabolic,ivm,ilev,iele)
+              END DO
+              CALL ipslerr(3,'stomate_litter','Negative metabolic litter pools',&
+                   'This should not be the case','')
+              !-
+              
+           END IF
+
+           ! Subtract the mineralization from the litter pool but make
+           ! sure that no negative values for the litter pool are created
+           err(:) = zero 
+           WHERE ( (litter(:,imetabolic,ivm,ilev,icarbon).GE.qd(:,icarbon)) .AND. &
+                (litter(:,imetabolic,ivm,ilev,initrogen).GE.qd(:,initrogen)))
+
+              ! qd is calculated as litter(:,imetabolic,ivm,ilev,iele)*fd(:)
+              ! as long as fd is positive (which was enforced above) the
+              ! subtraction below should never result in a number that is
+              ! less than zero (except for precision issues). fd is the same
+              ! for carbon and nitrogen and therefore the ratio is preserved
+              ! during mineralization. The test conditions should be
+              ! satisfied for C and N at the same time.
+              litter(:,imetabolic,ivm,ilev,icarbon) = &
+                   litter(:,imetabolic,ivm,ilev,icarbon) - qd(:,icarbon)
+              litter(:,imetabolic,ivm,ilev,initrogen) = &
+                   litter(:,imetabolic,ivm,ilev,initrogen) - qd(:,initrogen)
+
+           ELSEWHERE
+
+              err(:) = 1.
+
+           ENDWHERE
+
+           ! Check for errors 
+           IF (SUM(err(:)) .GT. zero) THEN
+              
+              WRITE(numout,*) 'Number of errors found: ,', SUM(err(:))
+              WRITE(numout,*) 'Mineralization exceeds litter pools in stomate_litter'
+              WRITE(numout,*) 'This will cause problems latter on'
+              DO iele = 1,nelements
+                 WRITE(numout,*) 'Metabolic litter pool, qd, ', &
+                      ivm, ilev, iele, litter(:,imetabolic,ivm,ilev,iele),qd(:,iele)
+              END DO
+              CALL ipslerr(3,'stomate_litter','Metabolic mineralization exceeds litter pool',&
+                   'This will cause problems later on','Fix the problem now')
+              !-
+              
+           ENDIF
+
+!!$        ! Store n_mineralization for later use
+!!$        n_mineralisation(:,ivm) = n_mineralisation(:,ivm) + qd(:,initrogen) 
+
+           !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!+++++CHECK+++++!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+           ! After large-scale dieback events, so much soil mineral N becomes immobilized 
+           ! to decompose litter that too little N is left for plant regrowth. To address 
+           ! this, we implicitly represent the action of fungivores, which release N for 
+           ! the plants and increase N turnover rates.  We set aside a fraction of qd, 
+           ! n_fungivores, which becomes available for plant uptake in nitrogen_dynamics.      
+           ! This parameter is not very well constrained and has been calibrated to find 
+           ! a good compromise between plant regrowth and litter decomposition.
+           n_mineralisation(:,ivm) = n_mineralisation(:,ivm) + &
+                (1-f_fungivores(:,ivm))*qd(:,initrogen)    
+           n_fungivores(:,ivm) = n_fungivores(:,ivm) + &
+                f_fungivores(:,ivm)*qd(:,initrogen)
+
+           !! 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 (ilev == iabove) THEN
+              
+              dead_leaves(:,ivm,imetabolic) = &
+                   dead_leaves(:,ivm,imetabolic) * ( 1. - fd(:) )
+
+           ENDIF
+
+           !! 5.2.3 put decomposed litter into active 
+           !  (or surface) pool + respiration 
+           som_input(:,itarget,ivm,icarbon) = &
+                som_input(:,itarget,ivm,icarbon) + & 
+                frac_soil(imetabolic,itarget,ilev) * qd(:,icarbon) / 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 bugs during future developments.
+           resp_hetero_litter(:,ivm) = resp_hetero_litter(:,ivm) + &
+                ( 1. - frac_soil(imetabolic,itarget,ilev) ) * qd(:,icarbon) / dt
+
+           ! Debug
+           IF(printlev_loc.GE.4 .AND. ivm.EQ.test_pft)THEN
+              WRITE(numout,*) 'check 2, ',ilev
+              WRITE(numout,*) 'qd, icarbon, ilev', ilev, qd(:,icarbon)
+              WRITE(numout,*) 'resp_hetero, ',resp_hetero_litter(:,test_pft)
+              WRITE(numout,*) 'som_input - C, ', &
+                   SUM(som_input(:,:,test_pft,icarbon),2)
+              WRITE(numout,*) 'n_mineralisation, ',n_mineralisation(:,test_pft)
+              WRITE(numout,*) 'som_input - N, ',&
+                   SUM(som_input(:,:,test_pft,initrogen),2)
+              WRITE(numout,*) ''
+           ENDIF
+           !-
+
+           !! 5.3 woody litter: goes into active and slow carbon 
+           !  pools + respiration
+           
+           !! 5.3.1 total quantity of woody litter which is decomposed
+           fd(:) = dt*litter_dec_fac(iwoody) * &
+                control_temp(:,ilev) * control_moist(:,ilev) * &
+                EXP( -3. * lignin_wood(:,ivm,ilev) )
+           
+           ! Ensure that fd is between 0 and 1
+           fd(:) = MAX(zero,MIN(fd(:),un))
+
+           ! Calculate qd for woody litter
+           err(:) = zero
+           WHERE ((litter(:,iwoody,ivm,ilev,icarbon).GE.zero) .AND. &
+                (litter(:,iwoody,ivm,ilev,initrogen).GE.zero))
+
+                 ! Calculate the quantity of woody litter that should
+                 ! be decomposed
+                 qd(:,icarbon) = litter(:,iwoody,ivm,ilev,icarbon) * fd(:)
+                 qd(:,initrogen) = litter(:,iwoody,ivm,ilev,initrogen) * fd(:)
+
+           ELSEWHERE
+
+              ! Keep track of how many errors there are
+              err(:) = 1.
+
+           ENDWHERE
+
+           ! Check for errors 
+           IF (SUM(err(:)) .GT. zero) THEN
+              
+              WRITE(numout,*) 'Number of errors found: ,', SUM(err(:))
+              WRITE(numout,*) 'Negative litter pools in stomate_litter'
+              WRITE(numout,*) 'That does not make any sense'
+              DO iele = 1,nelements
+                 WRITE(numout,*) 'Woody litter pool, ', &
+                      ivm, ilev, iele, litter(:,iwoody,ivm,ilev,iele)
+              END DO
+              CALL ipslerr(3,'stomate_litter','Negative woody litter pools',&
+                   'This should not be the case','')
+              !-
+              
+           END IF
+
+           ! Subtract the mineralization from the litter pool but make
+           ! sure that no negative values for the litter pool are created
+           err(:) = zero 
+           WHERE ( (litter(:,iwoody,ivm,ilev,icarbon).GE.qd(:,icarbon)) .AND. &
+                (litter(:,iwoody,ivm,ilev,initrogen).GE.qd(:,initrogen)))
+
+              ! qd is calculated as litter(:,iwoody,ivm,ilev,iele)*fd(:)
+              ! as long as fd is positive (which was enforced above) the
+              ! subtraction below should never result in a number that is
+              ! less than zero (except for precision issues). fd is the same
+              ! for carbon and nitrogen and therefore the ratio is preserved
+              ! during mineralization. The test conditions should be
+              ! satisfied for C and N at the same time.
+              litter(:,iwoody,ivm,ilev,icarbon) = &
+                      litter(:,iwoody,ivm,ilev,icarbon) - qd(:,icarbon)
+              litter(:,iwoody,ivm,ilev,initrogen) = &
+                      litter(:,iwoody,ivm,ilev,initrogen) - qd(:,initrogen)
+
+           ELSEWHERE
+
+              err(:) = 1.
+
+           ENDWHERE
+
+           ! Check for errors 
+           IF (SUM(err(:)) .GT. zero) THEN
+              
+              WRITE(numout,*) 'Number of errors found: ,', SUM(err(:))
+              WRITE(numout,*) 'Mineralization exceeds litter pools in stomate_litter'
+              WRITE(numout,*) 'This will cause problems latter on'
+              DO iele = 1,nelements
+                 WRITE(numout,*) 'Woody litter pool, qd, ', &
+                      ivm, ilev, iele, litter(:,iwoody,ivm,ilev,iele),qd(:,iele)
+              END DO
+              CALL ipslerr(3,'stomate_litter','Woody mineralization exceeds litter pool',&
+                   'This will cause problems later on','Fix the problem now')
+              !-
+              
+           ENDIF
+
+!!$        ! Store n_mineralization for later use
+!!$        n_mineralisation(:,ivm) = n_mineralisation(:,ivm) + qd(:,initrogen)
+
+           !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!+++++CHECK+++++!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+           ! After large-scale dieback events, so much soil mineral N becomes immobilized 
+           ! to decompose litter that too little N is left for plant regrowth. To address 
+           ! this, we implicitly represent the action of fungivores, which release N for 
+           ! the plants and increase N turnover rates.  We set aside a fraction of qd, 
+           ! n_fungivores, which becomes available for plant uptake in nitrogen_dynamics.      
+           ! This parameter is not very well constrained and has been calibrated to find 
+           ! a good compromise between plant regrowth and litter decomposition.
+
+           n_mineralisation(:,ivm) = n_mineralisation(:,ivm) + (1-f_fungivores(:,ivm))*qd(:,initrogen)
+         
+           n_fungivores(:,ivm) = n_fungivores(:,ivm) +f_fungivores(:,ivm)*qd(:,initrogen)
+
+           !! 5.3.2 non-lignin fraction of woody litter goes into
+           !!       active/structural carbon pool + respiration (per time unit)
+           som_input(:,itarget,ivm,icarbon) = som_input(:,itarget,ivm,icarbon) + &
+                frac_soil(iwoody,itarget,ilev) * qd(:,icarbon) * &
+                ( 1. - lignin_wood(:,ivm,ilev) ) / dt 
+    
+           resp_hetero_litter(:,ivm) = resp_hetero_litter(:,ivm) + &
+                ( 1. - frac_soil(iwoody,itarget,ilev) ) * qd(:,icarbon) * &
+                ( 1. - lignin_wood(:,ivm,ilev) ) / dt
+    
+           !! 5.3.3 lignin fraction of woody litter goes into
+           !!       slow carbon pool + respiration (per time unit)
+           som_input(:,islow,ivm,icarbon) = som_input(:,islow,ivm,icarbon) + &
+                frac_soil(iwoody,islow,ilev) * qd(:,icarbon) * &
+                lignin_wood(:,ivm,ilev) / dt 
+
+           resp_hetero_litter(:,ivm) = resp_hetero_litter(:,ivm) + &
+                ( 1. - frac_soil(iwoody,islow,ilev) ) * qd(:,icarbon) * &
+                lignin_wood(:,ivm,ilev) / dt
+
+           ! Debug
+           IF(printlev_loc.GE.4 .AND. ivm.EQ.test_pft)THEN
+              WRITE(numout,*) 'check 3, ',ilev
+              WRITE(numout,*) 'qd, icarbon, ilev', ilev, qd(:,icarbon)
+              WRITE(numout,*) 'resp_hetero, ',resp_hetero_litter(:,test_pft)
+              WRITE(numout,*) 'som_input - C, ', &
+                   SUM(som_input(:,:,test_pft,icarbon),2)
+              WRITE(numout,*) 'n_mineralisation, ',n_mineralisation(:,test_pft)
+              WRITE(numout,*) 'som_input - N, ',&
+                   SUM(som_input(:,:,test_pft,initrogen),2)
+              WRITE(numout,*) ''
+           ENDIF
+           !-
+
+        ENDDO
+
+     ENDDO
+
+     ! 5.4 Calculate som_input for nitrogen
+     ! This far the som input for icarbon has been recorded. Now
+     ! use the CN ratios to calculate the som input for nitrogen.
+     ! Note the difference in units between ::som_input (gN m-2 s-1) 
+     ! and ::n_mineralisation (gN m-2).
+     som_input(:,iactive,:,initrogen) = &
+         som_input(:,iactive,:,icarbon)/CN_target(:,:,iactive)  
+     som_input(:,islow,:,initrogen) = &
+         som_input(:,islow,:,icarbon)/CN_target(:,:,islow) 
+     som_input(:,isurface,:,initrogen) = &
+         som_input(:,isurface,:,icarbon)/CN_target(:,:,isurface) 
+
+     ! We may need these later:
+     DO ipts = 1, npts
+        
+        DO ivm = 1, nvm
+
+           n_min_old(ipts,ivm) = n_mineralisation(ipts,ivm)
+           som_input_total(ivm,initrogen) = &
+                som_input(ipts,iactive,ivm,initrogen) + &
+                som_input(ipts,islow,ivm,initrogen) + &
+                som_input(ipts,isurface,ivm,initrogen)
+
+           IF (som_input_total(ivm,initrogen).GT.zero) THEN
+
+              share_som_input_act_n(ipts,ivm) = &
+                   som_input(ipts,iactive,ivm,initrogen) &
+                   / som_input_total(ivm,initrogen)
+              share_som_input_slow_n(ipts,ivm) = &
+                   som_input(ipts,islow,ivm,initrogen) &
+                   / som_input_total(ivm,initrogen)
+              share_som_input_surf_n(ipts,ivm) = &
+                   som_input(ipts,isurface,ivm,initrogen) &
+                   / som_input_total(ivm,initrogen)
+           ENDIF
+           
+        ENDDO
+
+     ENDDO
+
+     ! 5.5 Truncate som_input(:,:,:,initrogen) if necessary. 
+
+     ! 5.5.1 We first need to pre-determine the value of n_mineralisation(:,:)
+     ! we will have in the next routine (som_dynamics) after the fluxes are 
+     ! subtracted. This means we have to port some of the code from som_dynamics 
+     ! to here. 
+     ! The following block of code is copied from sections 1.1 - 3.2.3 of 
+     ! som_dynamics:
+
+     !! Initialise
+     resp_hetero_soil(:,:) = zero
+     total_som_n_flux(:,:,:) = zero
+     n_mineralisation_som(:,:) = zero
+     frac_carb(:,:,:) = zero
+     som_temp(:,:,:,:) = zero
+     n_min_new(:,:)=zero
+
+     ! Get soil "constants"
+     ! Flux fractions between carbon pools: depend on clay content,
+     ! recalculated each time
+     ! From active pool: depends on clay content
+     frac_carb(:,iactive,ipassive) = active_to_pass_ref_frac + &
+          active_to_pass_clay_frac*clay(:)
+     frac_carb(:,iactive,islow) = un - frac_carb(:,iactive,ipassive) - &
+          (active_to_co2_ref_frac - active_to_co2_clay_silt_frac*(clay(:)+silt(:)))
+
+     ! From slow pool    
+     frac_carb(:,islow,ipassive) = slow_to_pass_ref_frac + &
+          slow_to_pass_clay_frac*clay(:)
+
+     ! OCN doesn't use Parton 1993 formulation for
+     ! frac_carb(:,islow,ipassive) 
+     ! but the one of 1987 : ie = 0.03 ....
+     frac_carb(:,islow,iactive) = un - frac_carb(:,islow,ipassive) - &
+          slow_to_co2_ref_frac
+
+     ! From passive pool
+     frac_carb(:,ipassive,iactive) = pass_to_active_ref_frac
+     frac_carb(:,ipassive,islow) = pass_to_slow_ref_frac
+
+     ! From surface pool
+     frac_carb(:,isurface,islow) = surf_to_slow_ref_frac
+
+     !! Determine the respiration fraction : what's left after
+     ! subtracting all the 'pool-to-pool' flux fractions
+     ! Diagonal elements of frac_carb are zero
+     frac_resp(:,:) = un - frac_carb(:,:,isurface) - frac_carb(:,:,iactive) - &
+        frac_carb(:,:,islow) - frac_carb(:,:,ipassive)
+
+     !! Turnover in SOM pools (in days)
+     ! som_turn_ipool is the turnover (in years)
+     ! It is weighted by Temp and Humidity function later
+     som_turn(iactive) = som_turn_iactive / one_year
+     som_turn(islow) = som_turn_islow / one_year
+     som_turn(ipassive) = som_turn_ipassive / one_year
+     som_turn(isurface) = som_turn_isurface / one_year
+
+     !! Update the SOM stocks with the different soil carbon input
+     som_temp(:,:,:,:) = som(:,:,:,:) + som_input(:,:,:,:) * dt
+
+     !! Fluxes between carbon reservoirs, and to the atmosphere
+     ! (respiration)
+      
+     !! Calculate fluxes
+     !! Flux out of pools
+     ! Loop over carbon pools from which the flux comes
+     DO ivm = 1,nvm
+
+        DO icarb = 1, ncarb
+ 
+           DO  iele = 1, nelements
+     
+              ! Determine total flux out of pool [gN m-2]
+              fluxtot(:,ivm,icarb,iele) = dt*som_turn(icarb) * &
+                   som_temp(:,icarb,ivm,iele) * control_moist(:,ibelow) * &
+                   control_temp(:,ibelow) * decomp_factor(ivm)
+              
+              ! Flux from active pools depends on clay content [gN m-2]
+              IF ( icarb .EQ. iactive ) THEN
+                 fluxtot(:,ivm,icarb,iele) = fluxtot(:,ivm,icarb,iele) * &
+                      ( un - som_turn_iactive_clay_frac * clay(:) )
+              ENDIF
+ 
+              ! Update the loss in each carbon pool [gN m-2]
+              som_temp(:,icarb,ivm,iele) = som_temp(:,icarb,ivm,iele) - &
+                   fluxtot(:,ivm,icarb,iele)
+     
+           ENDDO ! nelements
+     
+           ! Fluxes towards the other pools (icarb -> iicarb)
+           ! Loop over the SOM pools where the flux goes
+           DO iicarb = 1, ncarb
+     
+              ! Carbon flux [gN m-2]
+              flux(:,ivm,icarb,iicarb,icarbon) = frac_carb(:,icarb,iicarb) * &
+                   fluxtot(:,ivm,icarb,icarbon)
+     
+              ! Nitrogen flux - Function of the C stock of the 'departure'
+              ! pool and of the C to N target ratio of the 'arrival' pool [gN
+              ! m-2]
+              flux(:,ivm,icarb,iicarb,initrogen) = frac_carb(:,icarb,iicarb) * &
+                   fluxtot(:,ivm,icarb,icarbon) / &
+                   CN_target(:,ivm,iicarb)
+     
+           ENDDO ! receiving SOM pools
+     
+        ENDDO ! donating SOM pools
+
+     ENDDO ! ivm
+
+     !! Respiration
+     ! Fluxtot is in [gN m-2], resp_hetero_soil is in [gN m-2 dt-1] 
+     ! divide by dt.
+     !+++CHECK+++
+     ! The ENDDO above and the DO ivm below could probably be removed
+     ! to make a single bigger loop.
+     !+++++++++++
+     DO ivm = 1,nvm
+
+        resp_hetero_soil(:,ivm) = &
+             ( frac_resp(:,iactive) * fluxtot(:,ivm,iactive,icarbon) + &
+             frac_resp(:,islow) * fluxtot(:,ivm,islow,icarbon) + &
+             frac_resp(:,ipassive) * fluxtot(:,ivm,ipassive,icarbon) + &
+             frac_resp(:,isurface) * fluxtot(:,ivm,isurface,icarbon) ) / dt
+
+        !! Add fluxes to active, slow, and passive pools
+        ! Loop over SOM pools
+
+        DO icarb = 1, ncarb
+
+           ! Calculate the components of the som fluxes [gN m-2]
+           ! or [gC m-2]
+           som_temp(:,icarb,ivm,initrogen) = som_temp(:,icarb,ivm,initrogen) + &
+                flux(:,ivm,iactive,icarb,initrogen) + &
+                flux(:,ivm,ipassive,icarb,initrogen) + &
+                flux(:,ivm,islow,icarb,initrogen) + &
+                flux(:,ivm,isurface,icarb,initrogen)
+
+           ! Calculate the total flux [gN m-2]
+           total_som_n_flux(:,ivm,initrogen) = total_som_n_flux(:,ivm,initrogen) + &
+                flux(:,ivm,iactive,icarb,initrogen) + &
+                flux(:,ivm,ipassive,icarb,initrogen) + &
+                flux(:,ivm,islow,icarb,initrogen) + &
+                flux(:,ivm,isurface,icarb,initrogen)
+
+        ENDDO ! Loop over SOM pools
+
+     ENDDO
+
+!!$    ! 5.5.2 n_mineralisation_som(ipts,ivm) is what we're after. This value 
+!!$    ! should not become negative, or else we may deplete our soil_n_min pools.
+!!$    DO ivm = 1,nvm
+!!$       DO ipts = 1,npts
+!!$          n_mineralisation_som(ipts,ivm) = n_mineralisation(ipts,ivm) + &
+!!$               SUM(fluxtot(ipts,ivm,:,initrogen)) - &
+!!$               total_som_n_flux(ipts,ivm,initrogen)
+!!$       ENDDO
+!!$    ENDDO      
+
+     ! 5.5.3 Calculate the final value for mineralisation
+     DO ivm = 1, nvm
+
+        DO ipts = 1, npts
+
+           ! No redistrubtion needed unless specified in the code
+           ld_redistribute(ivm) = zero
+
+           ! Only check for existing PFTs
+           IF (veget_cov_max(ipts,ivm).LE.zero) CYCLE
+ 
+           ! Total internal nitrogen flux to be taken from the 
+           ! mineralised pool. Note that litter decomposition does not
+           ! contribute directly to the passive component of the soil 
+           ! organic matter [gN m-2 dt-1] multiply with dt to obtain 
+           ! [gN m-2].
+           som_input_total(ivm,:) = (som_input(ipts,iactive,ivm,:) + & 
+                som_input(ipts,islow,ivm,:) + & 
+                som_input(ipts,isurface,ivm,:))*dt
+
+           ! Store the positive component of n_mineralisation calculated
+           ! above
+           n_mineralisation_init = n_mineralisation(ipts,ivm)
+
+           ! Calculate the n_mineralisation pool after all internal
+           ! n fluxes from som_input(initrogen) are accounted for. 
+           ! n_mineralisation can be both positive or negative
+           n_mineralisation(ipts,ivm) = n_mineralisation_init - &
+                som_input_total(ivm,initrogen)
+
+           n_mineralisation_som(ipts,ivm) = n_mineralisation(ipts,ivm) + &
+                SUM(fluxtot(ipts,ivm,:,initrogen)) - &
+                total_som_n_flux(ipts,ivm,initrogen)
+
+           ! Check whether the decomposition estimates above are realistic in 
+           ! terms of the nitrogen available for immobilisation if 
+           ! n_mineralisation is negative. 
+           IF ((soil_n_min(ipts,ivm,initrate)+soil_n_min(ipts,ivm,iammonium)) + &
+              n_mineralisation_init.LT.zero) THEN
+
+              CALL ipslerr(3,'stomate_litter',&
+                   'First time that this problem is encountered',&
+                   'Debug the code first before continuing','Really!')
+
+              ! All the C and N contained in som_input will need to be moved 
+              ! back into the litter pool. Furthermore the n_mineralisation
+              ! needs to be decreased as is the heterotrophic respiration
+              DO iele = 1,nelements
+                 litter_total_new(iele) = &
+                      SUM(SUM(litter(ipts,:,ivm,:,iele),1)) + som_input_total(ivm,iele)
+                 som_input_total(ivm,iele) = zero
+              ENDDO
+
+              ! Adjust resp_hetero_litter proportionaly.
+              delta_hetero_litter = (resp_hetero_litter(ipts,ivm)- &
+                   (resp_hetero_litter(ipts,ivm)/n_mineralisation_init) * &
+                   (soil_n_min(ipts,ivm,initrate)+soil_n_min(ipts,ivm,iammonium)))*dt
+
+              ! Update the litter pools
+              litter_total_new(initrogen) = litter_total_new(initrogen) + &
+                   n_mineralisation_init - (soil_n_min(ipts,ivm,initrate)+soil_n_min(ipts,ivm,iammonium))
+              litter_total_new(icarbon) = litter_total_new(icarbon) + delta_hetero_litter
+
+              ! Set flag to redistribute the new pools
+              ld_redistribute(ivm) = 1.
+
+           ELSEIF ((((soil_n_min(ipts,ivm,initrate)+soil_n_min(ipts,ivm,iammonium)) + &
+              n_mineralisation(ipts,ivm).LT.zero) .AND. &
+              ((soil_n_min(ipts,ivm,initrate)+soil_n_min(ipts,ivm,iammonium)) + &
+              n_mineralisation_init.GT.zero)) .OR. &
+              (n_mineralisation_som(ipts,ivm) .LT. -min_stomate)) THEN
+
+              ! If the above conditions are satified there exists a solution.
+              ! The new n_mineralisation should get a value between its initial
+              ! and its current value. 
+
+              ! Initialize
+              litter_total_new(:) = zero
+              
+              ! CN_ratio of som_input total
+              IF (som_input_total(ivm,icarbon).GT.zero)THEN
+                 
+                 CN_input_total = som_input_total(ivm,initrogen) / &
+                      som_input_total(ivm,icarbon)
+                 
+              ELSE
+                 
+                 WRITE(numout,*) 'ERROR: surprise in CN calculation &
+                      & no carbon available, ', ivm, som_input_total(ivm,icarbon), &
+                      som_input_total(ivm,initrogen)
+                 CALL ipslerr(3,'stomate_litter','no carbon',&
+                      'problems to calculate C/N ratio for som_input_total','')
+
+              ENDIF
+
+!!$           ! The final n_mineralisation calculated as the sum of
+!!$           ! n_mineralisation_init - som_input_new should be the 
+!!$           ! maximum that can be afforded which is the current active
+!!$           ! soil nitrogen pool [gN m-2]. See nitrogen_dynamics.
+!!$
+!!$           n_mineralisation(ipts,ivm) = - (soil_n_min(ipts,ivm,initrate) + &
+!!$                soil_n_min(ipts,ivm,iammonium))
+
+              !!!!!!!!!!!!!!!!!!!!!!!!!!!!!+++++CHECK+++++!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+              ! The above formulation had allowed negative n_mineralisation values to 
+              ! be passed to stomate_soilcarbon. Previously, we had treated these as 
+              ! immobilization. If we have persistent negative values, however, we 
+              ! can reach a situation where we completely deplete our soil_n_min 
+              ! pools to satisfy the demand for immobilization. This tends to happen
+              ! when there is no plant recruitment, in which case a generation 
+              ! of trees will all reach their maximum height and die at the same 
+              ! time. This creates an enormous amount of litter, meaning our som_input 
+              ! values become relatively large and when we subtract som_input from 
+              ! n_mineralisation, the values become negative.
+              ! To remedy this, we'll truncate som_input based on the current 
+              ! n_mineralisation pool, but we'll limit the occurrence of negative
+              ! values. Instead we'll set a minimum (min_n) for n_mineralisation 
+              ! (e.g. .00001 g/m^2) so we can keep some N in the soil. In the future, 
+              ! we may be able to use the old formulation for simulations using
+              ! recruitment. As of rev 4574 we were not using recruitment in the model. 
+              
+              IF(n_min_old(ipts,ivm).GT.min_n) THEN  
+
+                 n_min_new(ipts,ivm) = min_n
+                 som_input_new(ivm,initrogen) = n_min_old(ipts,ivm) - &
+                      n_min_new(ipts,ivm)
+
+              ELSE
+
+                 !!+++++++++++++++++++++++++CHECK+++++++++++++++++++++++++++++++++
+                 ! If n_mineralisation is less than min_n, take a fraction of the
+                 ! remaining n_mineralisation for som_input. This is arbitrarily 
+                 ! set to 50% for now. Needs further testing/discussion.
+                 
+                 som_input_new(ivm,initrogen) = 0.5*n_min_old(ipts,ivm)
+
+              ENDIF
+ 
+!!$           ! The adjusted som_input carbon [gC m-2] should be
+!!$           som_input_new(ivm,icarbon) = som_input_new(ivm,initrogen) / CN_input_total
+
+              !!!!!!!!!!!!!!!!!!!!!!!!!!!!!+++++CHECK+++++!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+              ! When too little N is available to reach the target C:N ratio of
+              ! the receiving pool, the equation above results in values that are too 
+              ! low for som_input_total(:,icarbon), meaning carbon litter can not 
+              ! decompose. som_input_total(:,icarbon) still needs to be fixed, 
+              ! however, or else the C:N ratio in the surface soil pool will become 
+              ! unrealistic.
+              ! Rather than setting som_input_new(:,icarbon) proportionally as a factor 
+              ! of som_input_new(:,initrogen) and CN_input_total, we need to have enough
+              ! som_input(:,:,:,icarbon) to decompose the litter while at the same time 
+              ! constraining [som_input(:,:,:,icarbon)/som_input(:,:,:,initrogen)] to a
+              ! reasonable range. For the time being, we'll do this by capping the 
+              ! ratio at a prescribed value (max_cn).
+              ! The ecological justification behind this is that mycorrhizae take up 
+              ! extra C using the photosynthesis product. Thus, litter can still 
+              ! decompose even though C is not incorporated into the plant biomass. 
+              ! The C:N ratio controlling this flux can therefore be quite flexible.   
+
+              som_input_new(ivm,icarbon) = som_input_total(ivm,icarbon)
+
+              ! Protect against dividing by zero.  som_input_new(ivm,initrogen) may be zero here in cases
+              ! cases where n_mineralisation is zero at the beginning of the run, and then there
+              ! is some new litter input which forces us to this point in the code.  This can
+              ! happen if there is no litter for a long time, but to date we have only seen
+              ! this in cases where the GPP is zero for a long time.  So I will flag it as a 
+              ! warning.
+              IF(som_input_new(ivm,initrogen) .NE. zero)THEN
+                 IF((som_input_new(ivm,icarbon)/som_input_new(ivm,initrogen)) .GT. max_cn) THEN
+                    som_input_new(ivm,icarbon) = som_input_new(ivm,initrogen) * max_cn
+                 ENDIF
+              ELSE
+                 ! leave the new soil organic matter carbon input as it was, but 
+                 ! write a warning. This warning is not very useful for crops
+                 ! so it is only written for trees.
+                 IF (is_tree(ivm)) THEN
+                    WRITE(numout,*) 'WARNING: ivm,icarbon,initrogen,ipts ',&
+                         ivm,icarbon,initrogen,ipts
+                    WRITE(numout,*) 'WARNING: som_input_new(ivm,initrogen), &
+                         & n_min_old(ipts,ivm)',som_input_new(ivm,initrogen),&
+                      n_min_old(ipts,ivm)
+                 WRITE(numout,*) 'WARNING: n_min_new(ipts,ivm),&
+                      n_mineralisation(ipts,ivm),som_input_new(ivm,icarbon)',&
+                      n_min_new(ipts,ivm), n_mineralisation(ipts,ivm),&
+                      som_input_new(ivm,icarbon)
+                 CALL ipslerr(2,'stomate_litter','Perhaps no n_mineralization &
+                      & pools, but new litter','Previously only seen in cases &
+                      & where GPP is zero for long term','')
+                 ENDIF !is_tree
+              ENDIF
+
+              ! Calculate the n_mineralisation pool after all internal
+              ! n fluxes from som_input(initrogen) are accounted for. 
+              ! n_mineralisation can be both positive or negative
+              n_mineralisation(ipts,ivm) = n_min_old(ipts,ivm) - &
+                   som_input_new(ivm,initrogen)
+
+
+              ! Error checking
+              IF (som_input_new(ivm,initrogen).LT.zero) THEN
+
+                 WRITE(numout,*) 'ERROR: should not be here ',&
+                      (soil_n_min(ipts,ivm,initrate)+soil_n_min(ipts,ivm,iammonium)),&
+                      ivm, n_mineralisation(ipts,ivm),&
+                      som_input_total(ivm,initrogen)
+                 CALL ipslerr(3,'stomate_litter',&
+                      'Seems that the nitrogen can be satisfied',&
+                      'Should not have ended up in this part of the code','')
+
+              ENDIF
+
+              ! The nitrogen that was not mineralized should be added back 
+              ! into the litter pool. The carbon no longer included in 
+              ! som_input should also be added back into the litter pool.
+              litter_total_new(initrogen) = total_init_nitrogen(ipts,ivm) - &
+                   n_mineralisation(ipts,ivm) - som_input_new(ivm,initrogen) - &
+                   n_fungivores(ipts,ivm)
+              litter_total_new(icarbon) = SUM(SUM(litter(ipts,:,ivm,:,icarbon),1)) + &
+                   som_input_total(ivm,icarbon) - som_input_new(ivm,icarbon)
+
+              ! Som_input was adjusted to ensure that after accounting for
+              ! n_mineralisation there is enough soil nitrogen left to
+              ! account for nitrogen immobilisation. When litter is 
+              ! transformed into som_input, part of the carbon is lost as
+              ! heterotrophic respiration. For each unit of som_input a
+              ! certain number given by ::resp_ratio is respired
+              IF ((som_input_total(ivm,icarbon) .GT. zero) .AND. &
+                   (resp_hetero_litter(ipts,ivm).GT.zero)) THEN
+                 
+                 ! The change will be used to adjust the litter pool. The units should
+                 ! be [gC m-2]
+                 delta_hetero_litter = &
+                      (som_input_total(ivm,icarbon) - som_input_new(ivm,icarbon)) * &
+                      (resp_hetero_litter(ipts,ivm)/som_input_total(ivm,icarbon))*dt
+
+                 ! Respiration is a flux, the units should be [gC m-2 dt-1]
+                 resp_hetero_litter(ipts,ivm) = som_input_new(ivm,icarbon) * &
+                      resp_hetero_litter(ipts,ivm) / som_input_total(ivm,icarbon)
+
+              ELSE
+
+                 WRITE(numout,*) 'ERROR: surprise when recalculating &
+                      & resp_hetero_litter, ', som_input_new(ivm,icarbon), &
+                      resp_hetero_litter(ipts,ivm), som_input_total(ivm,icarbon)
+                 CALL ipslerr(3,'stomate_litter','problems with the sign',&
+                      'when calculating delta_hetero_litter','')
+
+              ENDIF
+
+              ! The carbon that is not respired stays in the litter pool.
+              litter_total_new(icarbon) = litter_total_new(icarbon) + &
+                   delta_hetero_litter
+
+              ! Set flag to redistribute the new pools
+              ld_redistribute(ivm) = 1.
+
+
+           ELSEIF ((soil_n_min(ipts,ivm,initrate)+soil_n_min(ipts,ivm,iammonium)) + &
+                n_mineralisation(ipts,ivm).GE.zero) THEN
+
+              ! Set flag to redistribute the new pools
+              ld_redistribute(ivm) = zero
+
+
+           ELSE
+
+              WRITE(numout,*) 'ERROR: unexpected case'
+              WRITE(numout,*) 'mineralisation wanted, ',n_mineralisation(ipts,ivm)
+              WRITE(numout,*) 'mineralisation_old, ',n_mineralisation_init
+              WRITE(numout,*) 'soil_n_min, ',(soil_n_min(ipts,ivm,initrate)+soil_n_min(ipts,ivm,iammonium))
+              CALL ipslerr(3,'stomate_litter','Unexpected case',&
+                   'Check the logic of IF-statement','')
+
+           ENDIF
+ 
+           IF (ld_redistribute(ivm) == 1.) THEN
+     
+              ! Share of each component to the total flux
+              DO iele = 1,nelements
+     
+                 IF (som_input_total(ivm,iele).GT.zero) THEN
+     
+                    share_som_input_active = som_input(ipts,iactive,ivm,iele) / &
+                         (som_input_total(ivm,iele) / dt)
+                    share_som_input_slow = som_input(ipts,islow,ivm,iele) / &
+                         (som_input_total(ivm,iele) / dt)
+                    share_som_input_surface = 1 - share_som_input_active - &
+                         share_som_input_slow
+     
+                 ELSE
+     
+                    WRITE(numout,*) 'ERROR: new problem. som_input = zero &
+                         & cannot redistribute the overspended nitrogen'
+                    CALL ipslerr(3,'stomate_litter','som_input = zero',&
+                         'cannot redistribute the overspended N or C','')
+     
+                 ENDIF
+     
+                 ! Error checking
+                 IF(err_act.GT.1)THEN
+     
+                    IF ( abs(share_som_input_surface + share_som_input_active + &
+                         share_som_input_slow - 1) .GT. min_stomate) THEN
+                       WRITE(numout,*) 'ERROR: sum of shares should be 0 ', &
+                            ipts, ivm, share_som_input_surface + &
+                            share_som_input_active + share_som_input_slow
+                       CALL ipslerr (3,'stomate_litter','sum of shares',&
+                            'share_som_input_xxx','')
+     
+                    ENDIF
+      
+                 ENDIF ! err_act.GT.1
+     
+                 ! Store old som_inputs in a temporary variable 
+                 DO icarb = 1, ncarb
+                    som_input_old(icarb,iele) = som_input(ipts,icarb,ivm,iele)*dt
+                 ENDDO
+     
+                 ! Truncate som_input values
+                 som_input(ipts,iactive,ivm,iele) = (share_som_input_active * &
+                      som_input_new(ivm,iele)) 
+                 som_input(ipts,islow,ivm,iele) = (share_som_input_slow * &
+                      som_input_new(ivm,iele)) 
+                 som_input(ipts,isurface,ivm,iele) = (share_som_input_surface * &
+                      som_input_new(ivm,iele))
+     
+              ENDDO
+     
+              ! Convert to the initial units to avoid problems when closing the mass balance
+              som_input(ipts,:,ivm,:) = som_input(ipts,:,ivm,:) / dt
+
+              ! Distribute delta_som_input over the litter pools
+              ! Calculate the share of each litter pool.
+              DO iele = 1,nelements
+                 share_litter_struc_a(ipts,ivm,iele) = litter(ipts,istructural,ivm,iabove,iele) / &
+                      SUM(SUM(litter(ipts,:,ivm,:,iele),1))
+                 share_litter_struc_b(ipts,ivm,iele) = litter(ipts,istructural,ivm,ibelow,iele) / &
+                      SUM(SUM(litter(ipts,:,ivm,:,iele),1))
+                 share_litter_met_a(ipts,ivm,iele) = litter(ipts,imetabolic,ivm,iabove,iele) / &
+                      SUM(SUM(litter(ipts,:,ivm,:,iele),1))
+                 share_litter_met_b(ipts,ivm,iele) = litter(ipts,imetabolic,ivm,ibelow,iele) / &
+                      SUM(SUM(litter(ipts,:,ivm,:,iele),1))
+                 share_litter_woody_a(ipts,ivm,iele) = litter(ipts,iwoody,ivm,iabove,iele) / &
+                      SUM(SUM(litter(ipts,:,ivm,:,iele),1))
+                 share_litter_woody_b(ipts,ivm,iele) = un - (share_litter_struc_a(ipts,ivm,iele) + &
+                      share_litter_struc_b(ipts,ivm,iele) + share_litter_met_a(ipts,ivm,iele) + &
+                      share_litter_met_b(ipts,ivm,iele) + share_litter_woody_a(ipts,ivm,iele))
+
+                 ! Correct precision errors
+                 IF((ABS(share_litter_woody_b(ipts,ivm,iele)) .LT. min_stomate) .AND. &
+                    (ABS(share_litter_woody_b(ipts,ivm,iele)) .GT. zero)) THEN
+                    share_litter_woody_b(ipts,ivm,iele) = zero
+                 ENDIF 
+
+                 ! Error checking
+                 IF (ABS((share_litter_struc_a(ipts,ivm,iele) + share_litter_struc_b(ipts,ivm,iele) + &
+                      share_litter_met_a(ipts,ivm,iele) + share_litter_met_b(ipts,ivm,iele) + &
+                      share_litter_woody_a(ipts,ivm,iele) + litter(ipts,iwoody,ivm,ibelow,iele) / &
+                      SUM(SUM(litter(ipts,:,ivm,:,iele),1)))-1).GT.min_stomate)THEN
+    
+                    WRITE(numout,*) 'ERROR: share_litter differs from 1 , ', &
+                         share_litter_struc_a(ipts,ivm,iele) + &
+                         share_litter_struc_b(ipts,ivm,iele) + share_litter_met_a(ipts,ivm,iele) + &
+                         share_litter_met_b(ipts,ivm,iele) + share_litter_woody_a(ipts,ivm,iele) + &
+                         litter(ipts,iwoody,ivm,ibelow,iele) / SUM(SUM(litter(ipts,:,ivm,:,iele),1)) 
+                    CALL ipslerr(3,'stomate_litter','share_litter differs from 1','','')
+    
+                 ENDIF
+
+                 litter(ipts,istructural,ivm,iabove,iele) = share_litter_struc_a(ipts,ivm,iele) * &
+                      litter_total_new(iele)
+                 litter(ipts,istructural,ivm,ibelow,iele) = share_litter_struc_b(ipts,ivm,iele) * &
+                      litter_total_new(iele)
+                 litter(ipts,imetabolic,ivm,iabove,iele) = share_litter_met_a(ipts,ivm,iele) * &
+                      litter_total_new(iele) 
+                 litter(ipts,imetabolic,ivm,ibelow,iele) = share_litter_met_b(ipts,ivm,iele) * &
+                      litter_total_new(iele)
+                 litter(ipts,iwoody,ivm,iabove,iele) = share_litter_woody_a(ipts,ivm,iele) * &
+                      litter_total_new(iele)
+                 litter(ipts,iwoody,ivm,ibelow,iele) = share_litter_woody_b(ipts,ivm,iele) * &
+                      litter_total_new(iele)
+
+              ENDDO ! nelements
+
+           ENDIF !ld_redistribute
+              
+        ENDDO ! nvm
+        
+     ENDDO ! npts
+
+    !! Reset variables
+    resp_hetero_soil(:,:) = zero
+    total_som_n_flux(:,:,:) = zero
+
+    !! 6. Check mass balance closure
+
+    !! 6.1 Calculate components of the mass balance
+    !  The carbon in turnover and bm_to_litter is moved to different pools but
+    !  ::turnover and ::bm_to_litter are never updated. They should either be
+    !  set to zero or not be included in the calculation of ::pool_end 
+ 
+    IF (err_act.GT.1) THEN
+
+       pool_end(:,:,:) = zero
+       pool_end(:,:,initrogen) = pool_end(:,:,initrogen) + &
+            n_mineralisation(:,:) * veget_cov_max(:,:)
+
+       DO ivm = 1,nvm
+          pool_end(:,ivm,initrogen) = pool_end(:,ivm,initrogen) + &
+                n_fungivores(:,ivm) * veget_cov_max(:,ivm) 
+       ENDDO
+
+       DO iele = 1,nelements
+          
+          ! The litter pool
+          DO ilitt = 1,nlitt
+             DO ilev = 1,nlevs
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                     (litter(:,ilitt,:,ilev,iele) * veget_cov_max(:,:))
+             ENDDO
+          ENDDO
+          
+       ENDDO
+
+       !! 6.2 Calculate mass balance
+       check_intern(:,:,:,:) = zero                    
+       check_intern(:,:,iland2atm,icarbon) = -un * resp_hetero_litter(:,:) * &
+            veget_cov_max(:,:) * dt
+
+       DO iele = 1,nelements
+          check_intern(:,:,ilat2out,iele) = -un * &
+               SUM(som_input(:,:,:,iele),2) * veget_cov_max(:,:) * dt
+          check_intern(:,:,ipoolchange,iele) = -un * (pool_end(:,:,iele) - &
+               pool_start(:,:,iele))
+       ENDDO
+
+       closure_intern = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) WRITE(numout,*) &
+                  'check_intern, test_pft,imbc, iele, ', test_pft,imbc, &
+                  iele, check_intern(:,test_pft,imbc,iele)!/&
+                 ! veget_cov_max(:,test_pft)
+             !-
+             closure_intern(:,:,iele) = closure_intern(:,:,iele) + &
+                  check_intern(:,:,imbc,iele)
+          ENDDO
+
+       ENDDO
+
+    
+       !! 6.3 Write the verdict
+       CALL check_mass_balance("littercalc", closure_intern, npts, pool_end, &
+            pool_start, veget_cov_max, 'pft')
+       
+    ENDIF ! err_act.GT.1
+
+  !! 7. calculate fraction of total soil covered by dead leaves
+
+    CALL deadleaf (npts, veget_cov_max, dead_leaves, deadleaf_cover)
+
+  !! 8. (Quasi-)Analytical Spin-up : Start filling MatrixA
+
+    IF (spinup_analytic) THEN
+
+       MatrixA(:,:,:,:) = zero
+       VectorB(:,:,:) = zero
+       
+       
+       DO ivm = 1,nvm
+
+          !- MatrixA : carbon fluxes leaving the litter
+          
+          MatrixA(:,ivm ,istructural_above,istructural_above)= - dt*litter_dec_fac(istructural) * &
+               control_temp(:,iabove) * control_moist(:,iabove) * exp( -litter_struct_coef * lignin_struc(:,ivm ,iabove) )
+          
+          MatrixA(:,ivm ,istructural_below,istructural_below) = - dt*litter_dec_fac(istructural) * &
+               control_temp(:,ibelow) * control_moist(:,ibelow) * exp( -litter_struct_coef * lignin_struc(:,ivm ,ibelow) )
+          
+          MatrixA(:,ivm ,imetabolic_above,imetabolic_above) = - dt*litter_dec_fac(imetabolic) * & 
+               control_temp(:,iabove) * control_moist(:,iabove)
+          
+          MatrixA(:,ivm ,imetabolic_below,imetabolic_below) = - dt*litter_dec_fac(imetabolic) * & 
+               control_temp(:,ibelow) * control_moist(:,ibelow)
+          
+          ! Flux leaving the woody above litter pool :
+          MatrixA(:, ivm , iwoody_above, iwoody_above) = - dt * litter_dec_fac(iwoody) * control_temp(:,iabove) * &
+               control_moist(:,iabove) * exp( -3. * lignin_wood(:,ivm ,iabove) )
+
+          ! Flux leaving the woody below litter pool :
+          MatrixA(:, ivm , iwoody_below, iwoody_below) = - dt * litter_dec_fac(iwoody) * control_temp(:,ibelow) * &
+               control_moist(:,ibelow) * exp( -3. * lignin_wood(:,ivm ,ibelow))
+
+          ! Flux received by the carbon surface from the woody above litter pool :
+          MatrixA(:, ivm , isurface_pool, iwoody_above) = frac_soil(iwoody, isurface, iabove) * & 
+               dt *litter_dec_fac(iwoody) * & 
+               control_temp(:,iabove) * &
+               control_moist(:,iabove) *  &
+               exp( -3. * lignin_wood(:,ivm ,iabove) ) * ( 1. -  lignin_wood(:,ivm ,iabove) ) 
+
+          ! Flux received by the carbon active from the woody below litter pool :
+          MatrixA(:, ivm , iactive_pool, iwoody_below) = frac_soil(iwoody, iactive, ibelow) * & 
+               dt *litter_dec_fac(iwoody) * &
+               control_temp(:,ibelow) * &
+               control_moist(:,ibelow) * &
+               exp( -3. * lignin_wood(:,ivm ,ibelow) ) * ( 1. -  lignin_wood(:,ivm ,ibelow) ) 
+
+          ! Flux received by the carbon slow from the woody above litter pool :
+          MatrixA(:, ivm , islow_pool, iwoody_above) = frac_soil(iwoody, islow, iabove) * &
+               dt *litter_dec_fac(iwoody) * &
+               control_temp(:,iabove) * &
+               control_moist(:,iabove) * &
+               exp( -3. * lignin_wood(:,ivm ,iabove) ) * lignin_wood(:,ivm ,iabove)
+
+          ! Flux received by the carbon slow from the woody below litter pool :
+          MatrixA(:, ivm , islow_pool, iwoody_below) =  frac_soil(iwoody, islow, ibelow) * & 
+               dt *litter_dec_fac(iwoody) * & 
+               control_temp(:,ibelow) * &
+               control_moist(:,ibelow) * &
+               exp( -3. * lignin_wood(:,ivm ,ibelow) ) * lignin_wood(:,ivm ,ibelow)
+
+                    
+          !- MatrixA : carbon fluxes between the litter and the pools (the rest of the matrix is filled in stomate_soilcarbon.f90)
+          MatrixA(:,ivm ,isurface_pool,istructural_above) = frac_soil(istructural,isurface,iabove) * &
+               dt*litter_dec_fac(istructural) * &                    
+               control_temp(:,iabove) * control_moist(:,iabove) * & 
+               exp( -litter_struct_coef * lignin_struc(:,ivm ,iabove) ) * &
+               ( 1. - lignin_struc(:,ivm ,iabove) ) 
+                         
+
+          MatrixA(:,ivm ,iactive_pool,istructural_below) = frac_soil(istructural,iactive,ibelow) * &
+               dt*litter_dec_fac(istructural) * &                     
+               control_temp(:,ibelow) * control_moist(:,ibelow) * & 
+               exp( -litter_struct_coef * lignin_struc(:,ivm ,ibelow) ) * &
+               ( 1. - lignin_struc(:,ivm ,ibelow) ) 
+          
+          MatrixA(:,ivm ,isurface_pool,imetabolic_above) =  frac_soil(imetabolic,isurface,iabove) * &
+               dt*litter_dec_fac(imetabolic) * control_temp(:,iabove) * control_moist(:,iabove) 
+           
+          MatrixA(:,ivm ,iactive_pool,imetabolic_below) =  frac_soil(imetabolic,iactive,ibelow) * &
+               dt*litter_dec_fac(imetabolic) * control_temp(:,ibelow) * control_moist(:,ibelow)          
+                    
+          MatrixA(:,ivm ,islow_pool,istructural_above) = frac_soil(istructural,islow,iabove) * &
+               dt*litter_dec_fac(istructural) * &                   
+               control_temp(:,iabove) * control_moist(:,iabove) * &
+               exp( -litter_struct_coef * lignin_struc(:,ivm ,iabove) )* &
+               lignin_struc(:,ivm ,iabove)
+          
+          
+          MatrixA(:,ivm ,islow_pool,istructural_below) = frac_soil(istructural,islow,ibelow) * &
+               dt*litter_dec_fac(istructural) * &   
+               control_temp(:,ibelow) * control_moist(:,ibelow) *  &
+                  exp( -litter_struct_coef * lignin_struc(:,ivm ,ibelow) )* &
+                  lignin_struc(:,ivm ,ibelow) 
+          
+          
+          !- VectorB : carbon input -
+          
+          VectorB(:,ivm ,istructural_above) = litter_inc(:,istructural,ivm ,iabove,icarbon)
+          VectorB(:,ivm ,istructural_below) = litter_inc(:,istructural,ivm ,ibelow,icarbon)
+          VectorB(:,ivm ,imetabolic_above) = litter_inc(:,imetabolic,ivm ,iabove,icarbon)
+          VectorB(:,ivm ,imetabolic_below) = litter_inc(:,imetabolic,ivm ,ibelow,icarbon)
+          VectorB(:,ivm ,iwoody_above) = litter_inc(:,iwoody,ivm ,iabove,icarbon)
+          VectorB(:,ivm ,iwoody_below) = litter_inc(:,iwoody,ivm ,ibelow,icarbon)
+
+          IF (printlev>=4) WRITE(numout,*) 'We filled MatrixA and VectorB' 
+          
+          WHERE(litter(:,istructural,ivm ,iabove,initrogen) .GT. min_stomate)
+             CN_som_litter_longterm(:,ivm ,istructural_above) = &
+                  ( CN_som_litter_longterm(:,ivm ,istructural_above) * (tau_CN_longterm-dt) &
+                  + litter(:,istructural,ivm ,iabove,icarbon)/litter(:,istructural,ivm ,iabove,initrogen) * dt)/ (tau_CN_longterm)
+          ENDWHERE
+          
+          WHERE(litter(:,istructural,ivm ,ibelow,initrogen) .GT. min_stomate)
+             CN_som_litter_longterm(:,ivm ,istructural_below) = &
+                  ( CN_som_litter_longterm(:,ivm ,istructural_below) * (tau_CN_longterm-dt) &
+                  + litter(:,istructural,ivm ,ibelow,icarbon)/litter(:,istructural,ivm ,ibelow,initrogen) * dt)/ (tau_CN_longterm)
+          ENDWHERE
+
+          WHERE(litter(:,imetabolic,ivm ,iabove,initrogen) .GT. min_stomate)
+             CN_som_litter_longterm(:,ivm ,imetabolic_above) = &
+                  ( CN_som_litter_longterm(:,ivm ,imetabolic_above) * (tau_CN_longterm-dt) &
+                  + litter(:,imetabolic,ivm ,iabove,icarbon)/litter(:,imetabolic,ivm ,iabove,initrogen) * dt)/ (tau_CN_longterm)
+          ENDWHERE
+
+          WHERE(litter(:,imetabolic,ivm ,ibelow,initrogen) .GT. min_stomate)
+             CN_som_litter_longterm(:,ivm ,imetabolic_below) = &
+                  ( CN_som_litter_longterm(:,ivm ,imetabolic_below) * (tau_CN_longterm-dt) &
+                  + litter(:,imetabolic,ivm ,ibelow,icarbon)/litter(:,imetabolic,ivm ,ibelow,initrogen) * dt)/ (tau_CN_longterm)
+          ENDWHERE
+
+          WHERE(litter(:,iwoody,ivm ,iabove,initrogen) .GT. min_stomate)
+             CN_som_litter_longterm(:,ivm ,iwoody_above) = &
+                  ( CN_som_litter_longterm(:,ivm ,iwoody_above) * (tau_CN_longterm-dt) &
+                  + litter(:,iwoody,ivm ,iabove,icarbon)/litter(:,iwoody,ivm ,iabove,initrogen) * dt)/ (tau_CN_longterm)
+          ENDWHERE
+          
+          WHERE(litter(:,iwoody,ivm ,ibelow,initrogen) .GT. min_stomate)
+             CN_som_litter_longterm(:,ivm ,iwoody_below) = &
+                  ( CN_som_litter_longterm(:,ivm ,iwoody_below) * (tau_CN_longterm-dt) &
+                  + litter(:,iwoody,ivm ,ibelow,icarbon)/litter(:,iwoody,ivm ,ibelow,initrogen) * dt)/ (tau_CN_longterm)
+          ENDWHERE
+
+       ENDDO ! Loop over # PFTs
+
+          
+    ENDIF ! spinup analytic 
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving littercalc'
+
+  END SUBROUTINE littercalc
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE   : deadleaf
+!!
+!>\BRIEF        This routine calculates the deadleafcover. 
+!!
+!! DESCRIPTION  : It first calculates the lai corresponding to the dead leaves (LAI) using 
+!! the dead leaves carbon content (DL) the specific leaf area (sla) and the 
+!! maximal coverage fraction of a PFT (veget_cov_max) 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_cov_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_cov_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)                                      :: ivm            !! Index (unitless)
+!_ ================================================================================================================================
+    
+  !! 1. LAI of dead leaves
+  
+    IF (printlev>=3) WRITE(numout,*) 'Entering deadleaf'
+    
+    ! Debug
+    IF (printlev_loc>=4) THEN
+       WRITE(numout,*) 'dead_leaves, imetabolic ',dead_leaves(:,:,imetabolic)
+       WRITE(numout,*) 'dead_leaves, istructural ',dead_leaves(:,:,istructural)
+    END IF
+    !-
+
+    dead_lai(:) = zero
+
+    DO ivm = 1,nvm !Loop over PFTs
+       dead_lai(:) = dead_lai(:) + biomass_to_lai(( dead_leaves(:,ivm,imetabolic) + dead_leaves(:,ivm,istructural) ),npts,ivm) &
+            * veget_cov_max(:,ivm)
+    ENDDO
+
+  !! 2. fraction of soil covered by dead leaves
+    
+    IF (printlev_loc>=4) WRITE(numout,*) 'dead_lai, ', dead_lai(:)
+
+    
+    deadleaf_cover(:) = un - exp( - 0.5 * dead_lai(:) )
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving deadleaf'
+
+  END SUBROUTINE deadleaf
+
+
+!! ================================================================================================================================
+!! FUNCTION     : control_moist_func
+!!
+!>\BRIEF        Calculate moisture control for litter and soil 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 Moistcont_min 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(:) = -moist_coeff(1) * moist_in(:) * moist_in(:) + moist_coeff(2)* moist_in(:) - moist_coeff(3)
+    moistfunc_result(:) = MAX( moistcont_min, MIN( un, moistfunc_result(:) ) )
+
+  END FUNCTION control_moist_func
+
+
+!! ================================================================================================================================
+!! FUNCTION     : control_temp_func
+!!
+!>\BRIEF        Calculate temperature control for litter and soild C decomposition
+!!
+!! DESCRIPTION  : Calculate temperature control factor applied
+!! to litter decomposition and to soil carbon decomposition in
+!! stomate_soilcarbon.f90 using the following equation: \n
+!! \latexonly
+!! \input{control_temp_func1.tex}
+!! \endlatexonly
+!! \n
+!! with T the temperature control factor, temp the temperature in Kelvin of 
+!! the air (for aboveground litter) or of the soil (for belowground litter 
+!! and soil)
+!! Then, the function is limited in its maximal range to 1:\n
+!! \latexonly
+!! \input{control_temp_func2.tex}
+!! \endlatexonly
+!! \n
+!! RECENT CHANGE(S) : None
+!!
+!! RETURN VALUE: ::tempfunc_result
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION control_temp_func (npts, temp_in) 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( soil_Q10 * ( temp_in(:) - (ZeroCelsius+tsoil_ref)) / Q10 )
+    tempfunc_result(:) = MIN( un, tempfunc_result(:) )
+
+  END FUNCTION control_temp_func
+
+END MODULE stomate_litter
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_lpj.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_lpj.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_lpj.f90	(revision 6412)
@@ -0,0 +1,2734 @@
+
+! ================================================================================================================================
+!
+! 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, 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_para
+  USE xios_orchidee
+  USE grid
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE structures
+  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 sapiens_agriculture
+  USE sapiens_lcchange
+  USE sapiens_kill,     ONLY : anthropogenic_mortality
+  USE sapiens_forestry
+  USE sapiens_product_use
+  USE stomate_prescribe
+  USE stomate_phenology
+  USE stomate_mark_kill
+  USE stomate_kill
+  USE stomate_growth_fun_all
+  USE stomate_stand_structure
+  USE stomate_turnover
+  USE stomate_litter
+  USE stomate_laieff,   ONLY : find_lai_per_level, calculate_z_level_photo,&
+                               combine_lai_levels, fitting_laieff
+  USE stomate_som_dynamics
+  USE stomate_vmax
+  USE stomate_windthrow, ONLY : wind_damage  
+ 
+  USE function_library, ONLY: wood_to_qmdia, cc_to_lai,&
+                              wood_to_qmheight, check_biomass_sync, &
+                              check_surface_area, check_mass_balance, &
+                              wood_to_volume
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC stomate_lpj_vegetation,stomate_lpj_clear
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : stomate_lpj_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 stomate_lpj_clear
+
+    CALL prescribe_clear
+    CALL phenology_clear
+    CALL turnover_clear
+    CALL som_dynamics_clear
+    CALL constraints_clear
+    CALL establish_clear
+    CALL fire_clear
+    CALL gap_clear
+    CALL light_clear
+    CALL pftinout_clear
+
+  END SUBROUTINE stomate_lpj_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : stomate_lpj
+!!
+!>\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 stomate_lpj_vegetation (npts, dt_days, EndOfYear, &
+       neighbours, resolution, &
+       herbivores, &
+       tsurf_daily, tsoil_daily, t2m_daily, t2m_min_daily, &
+       litterhum_daily, soilhum_daily, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       gdd0_lastyear, precip_lastyear, &
+       moiavail_month, moiavail_week, &
+       t2m_longterm, t2m_month, t2m_week, &
+       tsoil_month, soilhum_month, &
+       gdd_m5_dormance, gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       turnover_longterm, gpp_daily, &
+       time_hum_min, hum_min_dormance, maxfpc_lastyear, resp_maint_part, &
+       PFTpresent, age, fireindex, firelitter, &
+       leaf_age, leaf_frac, adapted, regenerate, &
+       plant_status, when_growthinit, litter, &
+       dead_leaves, som, lignin_struc, lignin_wood, &
+       veget_cov_max, veget_cov, veget_cov_max_new, npp_longterm, lm_lastyearmax, &
+       veget_lastlight, everywhere, need_adjacent, RIP_time, &
+       rprof, npp_daily, turnover_daily, turnover_time,&
+       control_moist, control_temp, som_input, &
+       atm_to_bm, co2_fire, resp_hetero, resp_maint, resp_growth, &
+       height, deadleaf_cover, vcmax, &
+       nue,bm_to_litter, &
+       prod_s, prod_m, prod_l, flux_s, flux_m, flux_l, &
+       flux_prod_s, flux_prod_m, flux_prod_l, carb_mass_total, &
+       fpc_max, MatrixA, MatrixV, VectorB, VectorU, &
+       Tseason, Tmin_spring_time, onset_date, KF, k_latosa_adapt, &
+       cn_leaf_min_season, nstress_season, moiavail_growingseason, soil_n_min, &
+       rue_longterm, plant_n_uptake_daily, &
+       circ_class_n, circ_class_biomass, forest_managed, forest_managed_lastyear, &
+       tau_eff_leaf, tau_eff_sap, tau_eff_root, &
+       species_change_map, fm_change_map, lpft_replant, &
+       age_stand, rotation_n, last_cut, mai, pai, previous_wood_volume, &
+       mai_count, coppice_dens, &
+       lab_fac, circ_class_dist, store_sum_delta_ba, &
+       harvest_pool_bound, harvest_pool, harvest_type, harvest_cut, harvest_area, &
+       lai_per_level, laieff_fit, h_array_out, z_array_out, max_height_store, &
+       wstress_season, wstress_month, st_dist, litter_demand, &
+       mass_balance_closure, light_tran_to_level_season, p_O2, bact, &
+       CN_som_litter_longterm,nbp_pool_start, &
+       wind_speed_daily, soil_temp_daily, harvest_5y_area)
+    
+  !! 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)
+    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
+    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,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(inout)            :: moiavail_month       !! "Monthly" moisture availability (0 to 1, 
+                                                                                       !! unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: moiavail_week        !! "Weekly" moisture availability 
+                                                                                       !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_longterm         !! "Long term" 2 meter reference 
+                                                                                       !! temperatures (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_month            !! "Monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_week             !! "Weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: Tseason              !! "seasonal" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: Tmin_spring_time
+    REAL(r_std), DIMENSION(npts,nvm,2), INTENT(in)             :: onset_date
+    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(inout)            :: gdd_m5_dormance      !! Growing degree days (K), threshold -5 deg 
+                                                                                       !! C (for phenology) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: gdd_from_growthinit  !! growing degree days, since growthinit for crops
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: gdd_midwinter        !! Growing degree days (K), since midwinter 
+                                                                                       !! (for phenology) - this is written to the history files 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: ncd_dormance         !! Number of chilling days (days), since 
+                                                                                       !! leaves were lost (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), INTENT(inout)                :: wind_speed_daily     !! Actual wind speed calculated from the actual half hourly
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                :: soil_temp_daily      !! Soil temperature at 80 cm below ground
+
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: gpp_daily            !! Daily gross primary productivity  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: maxfpc_lastyear      !! Last year's maximum foliage projected
+                                                                                       !! coverage for each natural PFT,
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)        :: resp_maint_part      !! Maintenance respiration of different 
+                                                                                       !! plant parts  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: fpc_max              !! "Maximal" coverage fraction of a PFT (LAI 
+                                                                                       !! -> infinity) on ground  
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+!!$    REAL(r_std), DIMENSION(npts,nvm),INTENT(in)                :: veget_cov_max_new        !! Old timestep "maximal" coverage fraction of a PFT 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: cn_leaf_min_season   !! Seasonal min CN ratio of leaves 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: nstress_season       !! N-related seasonal stress (used for allocation)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: moiavail_growingseason !! mean growing season moisture availability 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                    :: tau_eff_root         !! Effective root turnover time that accounts
+                                                                                       !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                    :: tau_eff_sap          !! Effective sapwood turnover time that accounts
+                                                                                       !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                    :: tau_eff_leaf         !! Effective leaf turnover time that accounts
+                                                                                       !! waterstress (days)
+    REAL(r_std), DIMENSION(0:), INTENT(in)                     :: harvest_pool_bound   !! The boundaries of the diameter classes
+                                                                                       !! in the wood harvest pools
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(:), INTENT(in)                      :: st_dist              !! The probability distribution of trees 
+                                                                                       !! removed from a circ class in case of  
+                                                                                       !! self thinning (unitless).
+    INTEGER(i_std), DIMENSION(:,:), INTENT(in)                 :: species_change_map   !! A map which gives the PFT number that each
+                                                                                       !! PFT will be replanted as in case of a clearcut.
+                                                                                       !! (1-nvm,unitless)
+    INTEGER(i_std), DIMENSION(:,:), INTENT(in)                 :: fm_change_map        !! A map which gives the desired FM strategy when
+                                                                                       !! the PFT will be replanted after a clearcut.
+                                                                                       !! (1-nvm,unitless)
+    REAL(r_std), DIMENSION(:,:,:),INTENT(in)                   :: light_tran_to_level_season !! Mean seasonal fraction of light transmitted
+                                                                                       !! to canopy levels  
+    
+  !! 0.2 Output variables    
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: npp_daily            !! Net primary productivity 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: turnover_daily   !! Turnover rates            
+    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,nparts,nelements), INTENT(out):: bm_to_litter      !! Conversion of biomass to litter 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(npts,nvm), INTENT(out)               :: nue                  !! Nitrogen use Efficiency with impact of leaf 
+                                                                                       !! age (umol CO2 (gN)-1 s-1)
+
+    REAL(r_std), DIMENSION(:,:), INTENT(out)                   :: lab_fac              !! Activity of labile pool factor (??units??)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(out)                 :: lai_per_level        !! This is the LAI per vertical level
+                                                                                       !! @tex $(m^{2} m^{-2})$
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_tot), INTENT(out) &               
+                                                               :: h_array_out          !! An output of h_array, to use in sechiba    
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,nlevels_tot), INTENT(out) &
+                                                               :: z_array_out          !! Height above soil of the Pgap points.
+                                                                                       !! @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(out)             :: max_height_store     !! ???
+    TYPE(laieff_type),DIMENSION (:,:,:),INTENT(out)            :: laieff_fit           !! Fitted parameters for the effective LAI
+    
+    
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: time_hum_min         !! Time elapsed since strongest moisture 
+                                                                                       !! availability (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: hum_min_dormance     !! minimum moisture during dormance 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: ngd_minus5           !! Number of growing days (days), threshold 
+                                                                                       !! -5 deg C (for phenology) 
+    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,nelements), INTENT(inout) :: som_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)            :: 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), 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) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: plant_status         !! Growth and phenological status of the plant
+                                                                                       !! istatus = Phases defined in constantes
+    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,nlitt,nvm,nlevs,nelements), 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,nelements), INTENT(inout)      :: som        !! Carbon pool: active, slow, or passive, 
+                                                                                       !! @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,nlevs), INTENT(inout)      :: lignin_wood          !! Ratio of Lignin/Carbon in woody
+                                                                                       !! litter, above and below ground, 	
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: veget_cov_max            !! "Maximal" coverage fraction of a PFT (LAI 
+                                                                                       !! -> infinity) on ground
+    REAL(r_std),DIMENSION(npts,nvm), INTENT(in)                :: veget_cov            !! Fractional coverage: actually share of the pixel 
+                                                                                       !! covered by a PFT (fraction of ground area), 
+                                                                                       !! taking into account LAI ??(= grid scale fpc)?? 
+    
+    
+ !! 0.3 Modified variables
+
+    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,nparts), INTENT(inout)     :: turnover_time        !! Turnover_time of leaves for grasses 
+                                                                                       !! (days)
+    REAL(r_std), DIMENSION(:,:),INTENT(inout)               :: veget_cov_max_new           !! New "maximal" coverage fraction of a PFT 
+                                                                                !! (LAI -> infinity)  Includes
+                                                                                !! the nobio fraction, so may sum to
+                                                                                !! less than unity. (unitless)    
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: flux_prod_s           !! C-released during first years (short term) 
+                                                                                !! following land cover change 
+                                                                                !! @tex ($gC year^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: flux_prod_m           !! Total annual release from decomposition of 
+                                                                                !! the medium-lived product pool 
+                                                                                !! @tex ($gC year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: flux_prod_l           !! Total annual release from decomposition of 
+                                                                                !! the long-lived product pool 
+                                                                                !! @tex ($gC year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,0:,:), INTENT(inout)      :: prod_s                !! Short-lived product pool after the annual 
+                                                                                !! release of each compartment (short + 1 : 
+                                                                                !! input from year of land cover change) 
+                                                                                !! @tex ($gC$) @endtex    
+    REAL(r_std), DIMENSION(:,0:,:), INTENT(inout)      :: prod_m                !! Medium-lived product pool after the annual
+                                                                                !! release of each compartment (medium + 1 : 
+                                                                                !! input from year of land cover change) 
+                                                                                !! @tex ($gC$) @endtex 
+    REAL(r_std), DIMENSION(:,0:,:), INTENT(inout)      :: prod_l                !! long-lived product pool after the annual 
+                                                                                !! release of each compartment (long + 1 : 
+                                                                                !! input from year of land cover change) 
+                                                                                !! @tex ($gC$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: flux_s                !! Annual release from the short-lived product 
+                                                                                !! pool @tex ($gC) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: flux_m                !! Annual release from the medium-lived product  
+                                                                                !! pool compartments @tex ($gC) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: flux_l                !! Annual release from the long-lived product
+                                                                                !! pool @tex ($gC) @endtex
+
+
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                :: carb_mass_total      !! Carbon Mass total (soil, litter, veg) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: KF                            !! Scaling factor to convert sapwood mass
+                                                                                       !! into leaf mass (m)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: k_latosa_adapt                !! Leaf to sapwood area adapted for long 
+                                                                                       !! term water stress (m)
+    REAL(r_std), DIMENSION(npts,nvm,nionspec), INTENT(inout)      :: plant_n_uptake_daily    !! Uptake of soil N by plants  
+       !! (gN/m**2/day)  
+    REAL(r_std), DIMENSION(npts,nvm,nnspec), INTENT(inout)       :: soil_n_min         !! mineral nitrogen in the soil (gN/m**2)  
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: rue_longterm            !! Longterm radiation use efficiency
+                                                                                !! (??units??) 
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: circ_class_biomass      !! Biomass of the componets of the model  
+                                                                                !! tree within a circumference
+                                                                                !! class @tex $(gC ind^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: circ_class_n            !! Number of individuals in each circ class
+                                                                                !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)    :: store_sum_delta_ba      !! Sum of increase of ba (m^2) which doesn't pass 
+                                                                                !! through the gap clean
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)   :: MatrixA                 !! Matrix containing the fluxes  
+                                                                                !! between the carbon pools
+                                                                                !! per sechiba time step 
+                                                                                !! @tex $(gC.m^2.day^{-1})$ @endtex
+
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), &
+                                       INTENT(inout) :: VectorB                 !! Vector containing the litter increase per
+                                                                                !! sechiba time step
+                                                                                !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), &
+                                       INTENT(inout) :: MatrixV                 !! Matrix containing the accumulated values of matrixA
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), &
+                                       INTENT(inout) :: VectorU                 !! Matrix containing the accumulated values of VectorB
+
+    INTEGER(i_std), DIMENSION (:,:), INTENT(inout)   :: forest_managed          !! forest management flag (is the forest 
+                                                                                !! being managed?)
+    INTEGER(i_std), DIMENSION (:,:), INTENT(inout)   :: forest_managed_lastyear !! forest management flag for the 
+                                                                                !! previous year
+    INTEGER(i_std), DIMENSION(:,:), INTENT(inout)    :: age_stand               !! Age of stand (years)
+    INTEGER(i_std), DIMENSION(:,:), INTENT(inout)    :: rotation_n              !! Rotation number (number of rotation 
+                                                                                !! since pft is managed)
+    INTEGER(i_std), DIMENSION(:,:), INTENT(inout)    :: last_cut                !! Years since last thinning (years)
+
+    LOGICAL, DIMENSION(:,:), INTENT(inout)           :: lpft_replant            !! Set to true if a PFT has been clearcut
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: atm_to_bm               !! C and N taken from atmosphere when 
+                                                                                !! introducing a new PFT (introduced for 
+                                                                                !! carbon balance closure) 
+                                                                                !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:), INTENT(inout)         :: circ_class_dist         !! The probability distribution of trees 
+                                                                                !! in a circ class in case of a 
+                                                                                !! redistribution (unitless).
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)   :: harvest_pool            !! The wood and biomass that have been
+                                                                                !! havested by humans @tex $(gC)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: harvest_type            !! Type of management that resulted
+                                                                                !! in the harvest (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: harvest_cut             !! Type of cutting that was used for the harvest
+                                                                                !! (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: harvest_area            !! Harvested area (m^{2})
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: harvest_5y_area         !! Harvested area accumulated in previous five year (m^{2})  
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: mai                     !! The mean annual increment
+                                                                                !! @tex $(m**3 / m**2 / year)$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: pai                     !! The period annual increment
+                                                                                !! @tex $(m**3 / m**2 / year)$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: previous_wood_volume    !! The volume of the tree trunks
+                                                                                !! in a stand for the previous year.
+                                                                                !! @tex $(m**3 / m**2 )$ @endtex
+    INTEGER(i_std), DIMENSION(:,:),INTENT(inout)     :: mai_count               !! The number of times we've
+                                                                                !! calculated the volume increment
+                                                                                !! for a stand
+    REAL(r_std), DIMENSION(:,:),INTENT(inout)        :: coppice_dens            !! The density of a coppice at the first
+                                                                                !! cutting @tex $( 1 / m**2 )$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: wstress_month           !! Water stress factor, based on hum_rel_daily
+                                                                                !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: wstress_season          !! Water stress factor, based on hum_rel_daily
+                                                                                !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:),INTENT(inout)        :: mass_balance_closure    !! Missing mass in the carbon balance
+                                                                                !! @tex $(gC(N) pixel^{-1} dt^{-1})$@endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: p_O2                    !! partial pressure of oxigen in the soil (hPa)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: bact                    !! denitrifier biomass (gC/m**2)
+    REAL(r_std), DIMENSION(:,:,:),INTENT(inout)      :: CN_som_litter_longterm  !! Longterm CN ratio of litter and som pools (gC/gN)
+    REAL(r_std), DIMENSION(:,:),INTENT(inout)        :: nbp_pool_start          !! Variable used to calculate the pool based NBP 
+                                                                                !! @tex $(gC day^{-1} m^{-2})$@endtex
+  
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts,nvm)                 :: var_real                !! temporary variable used to convert an integer
+                                                                                !! when writing to a history file
+    REAL(r_std), DIMENSION(npts,nelements)           :: prod_s_total            !! Total products remaining in the short-lived  
+                                                                                !! pool after the annual decomposition 
+                                                                                !! @tex $(gC)$ @endtex 
+    REAL(r_std), DIMENSION(npts,nelements)           :: prod_m_total            !! Total products remaining in the medium-lived
+                                                                                !! pool after the annual decomposition 
+                                                                                !! @tex $(gC)$ @endtex 
+    REAL(r_std), DIMENSION(npts,nelements)           :: prod_l_total            !! Total products remaining in the long-lived
+                                                                                !! pool after the annual release 
+                                                                                !! @tex $(gC)$ @endtex 
+    REAL(r_std), DIMENSION(npts,nelements)           :: flux_prod_total         !! Total flux from decomposition of the short,
+                                                                                !! medium and long lived product pools 
+                                                                                !! @tex $(gC year^{-1})$ @endtex
+
+
+
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: tot_bm_to_litter        !! Total conversion of biomass to litter 
+                                                                                !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: tot_live_biomass        !! Total living biomass  
+                                                                                !! @tex $(gC m{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements):: bm_alloc                !! Biomass increase, i.e. NPP per plant part 
+                                                                                !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: tot_turnover            !! Total turnover rate  
+                                                                                !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                 :: 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)                 :: 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,ncirc,nfm_types,ncut_times) &
+                                                     :: circ_class_kill         !! Number of trees within a circ class that needs
+                                                                                !! to be killed @tex $(ind m^{-2})$ @endtex
+                                                                                !! IMPORTANT: See the note in constantes.f90
+                                                                                !! regarding the indicies for this variable.
+    REAL(r_std), DIMENSION(npts,nvm)                 :: woodmass_ind            !! Woodmass of individuals (gC) 
+    REAL(r_std), DIMENSION(npts,nvm,nparts)          :: f_alloc                 !! Fraction that goes into plant part 
+                                                                                !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts)                     :: avail_tree              !! Space availability for trees 
+                                                                                !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: avail_grass         !! Space availability for grasses 
+                                                                                       !! (0 to 1, unitless) 
+    INTEGER                                                     :: j,k,l,ipts,ivm,icut,ifm,ispec 
+    INTEGER                                                     :: ilev, ilit,icarb,iele, ipar, imbc, icir, iyear
+!!$    REAL(r_std),DIMENSION(npts,nvm)                             :: veget_cov_max_tmp       !! "Maximal" coverage fraction of a PFT  
+!!$                                                                                       !! (LAI-> infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: mortality           !! Fraction of individual dying this time 
+                                                                                       !! step (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: vartmp              !! Temporary variable used to add history
+    REAL(r_std), DIMENSION(npts,nvm)                            :: histvar             !! History variables
+    REAL(r_std), DIMENSION(npts,nvm)                            :: use_reserve         !! Mass taken from carbohydrate reserve 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    CHARACTER(LEN=2), DIMENSION(nelements)                      :: element_str         !! string suffix indicating element 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: vcmax_new   
+    REAL(r_std), DIMENSION(npts,nvm)                            :: gammas              !! Slope for individual tree growth (m)
+    REAL(r_std), DIMENSION(npts,nvm)                            :: sigma               !! Threshold for indivudal tree growth (m)
+    REAL(r_std), DIMENSION(npts,nvm)                            :: lrake_frac          !! Relative amount of litter that raked (-)
+    REAL(r_std), DIMENSION(npts,nvm)                            :: qm_height           !! Quadratic mean height of vegetation (m)
+    REAL(r_std), DIMENSION(npts,nvm)                            :: qm_dia              !! Quadratic mean diameter of vegetation (m)
+    REAL(r_std), DIMENSION(npts,nvm)                            :: rdi                 !! relative density index (ntrees/Nmax)         
+    REAL(r_std), DIMENSION(npts,nvm)                            :: rdi_target_upper    !! relative density index (ntrees/Nmax)
+    REAL(r_std), DIMENSION(npts,nvm)                            :: rdi_target_lower    !! relative density index (ntrees/Nmax)
+    REAL(r_std), DIMENSION(npts,nvm,nlevels)                    :: lai_per_level_temp  !! This is the LAI per vertical level
+                                                                                       !! @tex $(m^{2} m^{-2})$
+    REAL(r_std), DIMENSION(npts,nvm,nlevels_tot)                :: z_level_photo       !! The height of the levels that we will
+                                                                                       !! use to calculate the effective LAI for
+                                                                                       !! the albedo routines and photosynthesis.
+                                                                                       !! @tex $(m)$ @endtex 
+    REAL(r_std), DIMENSION(npts)                                :: litter_demand       !! The amount of litter which will
+                                                                                       !! be moved from forest to crop pools
+                                                                                       !! at the end of the year.
+                                                                                       !! @tex $( gC year^{-1} )$ @endtex
+    CHARACTER(30)                                               :: var_name            !! Temporary variable name for histwrite
+    REAL(r_std), DIMENSION(npts)                                :: pixel_area          !! surface area of the pixel @tex ($m^{2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                            :: N_support           !! Nitrogen which is added to the ecosystem to 
+                                                                                       !! support vegetation growth (only used when 
+                                                                                       !! IMPOSE_CN .EQ. true) (gC/m2/day)
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)          :: check_intern        !! Contains the components of the internal
+                                                                                       !! mass balance chech for this routine
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: closure_intern      !! Check closure of internal mass balance
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: pool_start          !! Start pool of this routine 
+                                                                                       !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: pool_end            !! End pool of this routine 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: temp                
+    REAL(r_std), DIMENSION(npts,nvm,nlevels_tot)                :: dummy               !! dummy variable for prescribe
+
+    ! Debug
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements)           :: temp_bio            !! Biomass @tex $(gC m^{-2})$ @endtex
+    CHARACTER(30)                                               :: losses              !! Loss distribution across age classes
+    REAL(r_std), DIMENSION(npts,nvm,nupdates,nelements)         :: atm_to_bm_hist      !! History of atm_to_bm for C and N for the 
+                                                                                       !! different subroutines where it is used recruitment
+    REAL(r_std), DIMENSION(npts,nvm,nupdates)                   :: veget_cov_max_hist      !! History of veget_cov_max for C and N for the 
+    integer, dimension(3)  :: pft_t
+
+
+   ! Windthrow
+    REAL(r_std), DIMENSION(npts,nvm,wind_years)                 :: tmp_5y_area         !! Temporary array for harvested area in previous 5years (m^{2})
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements,nfm_types,ncut_times) &
+                                                                :: biomass_cut         !! Biomass change due to  ncut
+    REAL(r_std), DIMENSION(npts,ncut_times)                     :: wood_volume_pix_cut !! Wood volume change due to ncut
+
+!_ ================================================================================================================================
+
+    IF (printlev>=2) WRITE(numout,*) 'Entering stomate_lpj'
+
+!!$  !! 0. Calculate the LAI from the biomass. 
+!!$  !! This is done to prevent passing an incorrect
+!!$  !! LAI around, since LAI is diagnostic.
+!!$  !! We can't do this if we use an LAI map! So this breaks DO_STOMATE=N
+!!$     lai(:,ibare_sechiba) = zero
+!!$     DO ipts = 1, npts
+!!$        DO ivm = 1, nvm
+!!$           lai(ipts,ivm) = cc_to_lai(circ_class_biomass(ipts,ivm,:,ileaf,icarbon),&
+!!$                circ_class_n(ipts,ivm,:),ivm)
+!!$        ENDDO
+!!$     ENDDO
+ 
+  !! 1. Initializations
+    
+    !! 1.1 Initialize local printlev
+    !printlev_loc=get_printlev('stomate_lpj')
+
+    !! 1.2 Initialize variables to zero
+    co2_fire(:,:) = zero
+    npp_daily(:,:) = zero
+    resp_maint(:,:) = zero
+    resp_growth(:,:) = zero
+    bm_to_litter(:,:,:,:) = zero
+    cn_ind(:,:) = zero
+    woodmass_ind(:,:) = zero
+    turnover_daily(:,:,:,:) = zero
+    circ_class_kill(:,:,:,:,:) = zero
+    bm_alloc(:,:,:,:) = zero
+    rdi(:,:) = zero
+    rdi_target_upper(:,:) = zero
+    rdi_target_lower(:,:) = zero
+    lrake_frac(:,:) = zero
+    use_reserve(:,:) = zero
+    atm_to_bm_hist(:,:,:,:) = zero
+    veget_cov_max_hist(:,:,:) = zero
+    harvest_pool(:,:,:,:) = zero
+    biomass_cut(:,:,:,:,:,:) = zero
+
+    !! 1.3 Surface area (m2) of the pixel
+    pixel_area(:) = resolution(:,1) * resolution(:,2)   
+
+    !! 1.4 Initialize check for mass balance closure
+    !  This test is always performed. If err_act.EQ.1 then 
+    !  the value of the mass balance error -if any- is 
+    !  written to the history file.
+
+    ! Based on the dimensions of the variables it looks like 
+    ! we can distinguish different PFTs but that is not true.
+    ! We need to account for the wood products and those are 
+    ! only defined at the pixel level. The highest resolution
+    ! we can thus check for mass balance closure is the pixel.
+    check_intern(:,:,:,:) = zero
+    pool_start(:,:,:) = zero
+    DO iele = 1,nelements
+
+       ! atm_to_bm has as intent inout, the variable 
+       ! accumulates carbon over the course of a day. 
+       ! Use the difference between start and the end of 
+       ! this routine
+       DO ipar = 1,nparts
+          DO icir=1, ncirc
+             pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                  (circ_class_biomass(:,:,icir,ipar,iele) * &
+                  circ_class_n(:,:,icir) * veget_cov_max(:,:))
+          ENDDO
+       ENDDO
+
+       ! The biomass harvest pool shouldn't be multiplied by veget_cov_max
+       ! its units are already in gC or gN pixel-1. The total amount 
+       ! for the pixel was stored in harvest_pool. Account for C and N 
+       ! stored in the wood product pools. There are no longer PFTs 
+       pool_start(:,1,iele) = pool_start(:,1,iele) + &
+            (SUM(SUM(harvest_pool(:,:,:,iele),3),2) + &
+            SUM(prod_l(:,:,iele),2) + SUM(prod_m(:,:,iele),2) + &
+            SUM(prod_s(:,:,iele),2) ) / pixel_area(:)
+
+    ENDDO
+
+    ! Account for the N-uptake calculated in stomate.f90
+    pool_start(:,:,initrogen) = pool_start(:,:,initrogen) + &
+         (plant_n_uptake_daily(:,:,iammonium) + &
+         plant_n_uptake_daily(:,:,initrate)) * veget_cov_max(:,:)
+
+       !! DEBUG !!
+       ! Debug...only use if you know what you are doing, not for general use
+       IF (.FALSE.) THEN
+       pft_t=(/ 13, 16, 1/)
+       DO j=1, size(pft_t)
+          ivm=pft_t(j)
+          DO iele = 1,nelements
+             WRITE(numout,*) 'veget_cov_max: ', veget_cov_max(test_grid,ivm), 'ipts:',test_grid, 'ivm:',ivm
+             WRITE(numout,*) 'atm_to_bm: ', atm_to_bm_hist(test_grid,ivm,:,iele)*veget_cov_max(test_grid,ivm)
+             WRITE(numout,*) 'element ',iele
+            WRITE(numout,*)  'biomass',SUM(SUM(circ_class_biomass(test_grid,ivm,:,:,iele),1)*circ_class_n(test_grid,ivm,:)) * &
+                 veget_cov_max(test_grid,ivm)
+             WRITE(numout,*) 'in bm_to_litter:',SUM(bm_to_litter(test_grid,ivm,:,iele))*veget_cov_max(test_grid,ivm)
+             WRITE(numout,*)'in turnover_daily:',SUM(turnover_daily(test_grid,ivm,:,iele))*veget_cov_max(test_grid,ivm)
+             WRITE(numout,*) 'in litter:',SUM(SUM(litter(test_grid,:,ivm,:,iele),2))*veget_cov_max(test_grid,ivm)
+             WRITE(numout,*) 'in som:',SUM(som(test_grid,:,ivm,iele))*veget_cov_max(test_grid,ivm)
+             WRITE(numout,*) 'in harvest_pool:',SUM(harvest_pool(test_grid,ivm,:,iele),1)/pixel_area(test_grid)
+             !wrong dimensions WRITE(numout,*) 'in prod_s:',prod_s(test_grid,ivm,iele)/pixel_area(test_grid)
+             !wrong dimensions WRITE(numout,*) 'in prod_m:',prod_m(test_grid,ivm,iele)/pixel_area(test_grid)
+             !wrong dimensions WRITE(numout,*) 'in prod_l:',prod_l(test_grid,ivm,iele)/pixel_area(test_grid)
+             WRITE(numout,*) 'in gpp_daily:',gpp_daily(test_grid,ivm)*veget_cov_max(test_grid,ivm)
+             WRITE(numout,*) 'inresp_maint:',resp_maint(test_grid,ivm)*veget_cov_max(test_grid,ivm)
+             WRITE(numout,*) 'in resp_growth:',resp_growth(test_grid,ivm)*veget_cov_max(test_grid,ivm)
+             !wrong dimensions WRITE(numout,*) 'in flux_s:',flux_s(test_grid,ivm,iele)/pixel_area(test_grid)
+             !wrong dimensions WRITE(numout,*) 'in flux_m:',flux_m(test_grid,ivm,iele)/pixel_area(test_grid)
+             !wrong dimensions WRITE(numout,*) 'in flux_l:',flux_l(test_grid,ivm,iele)/pixel_area(test_grid)
+             WRITE(numout,*) 'in plant_n_uptake_daily:',SUM(plant_n_uptake_daily(test_grid,ivm,:))
+          ENDDO
+        ENDDO
+      ENDIF
+      !!! END DEBUG !!!
+
+    ! Initialize check for area conservation
+    veget_cov_max_hist(:,:,ibeg) = veget_cov_max(:,:)
+    atm_to_bm_hist(:,:,ibeg,:) = atm_to_bm(:,:,:)
+
+       
+    ! +++CHECK+++
+    ! Check and document why we do this
+    IF (EndOfYear) THEN
+       forest_managed_lastyear(:,:) = forest_managed(:,:)
+    ENDIF
+    ! +++++++++++
+
+    !! 1.6 Update stand age
+    ! Here we increment the age of the stand, if it's the end of the 
+    ! year. Notice that we need to do this before the forestry routines, 
+    ! since the forest has had a chance to grow since the last time
+    ! we called the routine.  Doing it this way may cause a small 
+    ! problem since forestry is only done every year. For example, 
+    ! let us say that a forest die-off occurs due to natural reasons 
+    ! at the end of December. The age of that stand will be set to zero. 
+    ! However, when the end of year happens the age will be incremented 
+    ! by one here, even though the forest is only a couple weeks old. 
+    ! There doesn't seem to be a better way to do this, though, so a 
+    ! forest age of x should be taken to mean that the forest is 
+    ! between x-1 and x years old.  I see this only being an issue
+    ! in short rotation coppices, but those forests should never have
+    ! die off because they are harvested every couple years.
+    IF (EndOfYear) THEN
+       DO ipts=1,npts
+          DO ivm=1,nvm
+             IF(veget_cov_max(ipts,ivm) .GT. min_stomate)THEN
+                age_stand(ipts,ivm) = age_stand(ipts,ivm) + 1
+                
+                ! last_cut is similar to stand age, but it measures the
+                ! time since any human intervention, either thinning or 
+                ! clearcutting.
+                last_cut(ipts,ivm) = last_cut(ipts,ivm) + 1
+                
+             ELSE
+                   
+                age_stand(ipts,ivm) = 0
+                last_cut(ipts,ivm) = 0
+                
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDIF
+
+    !! 1.7 Calculate some vegetation characteristics
+    
+    ! +++CHECK++++
+    ! Seems useless except for the veget_cov_max issue which I don't
+    ! understand.  Crown and height are now prognostic and can
+    ! be calculated from biomass whenever needed. No need to
+    ! call crown here.
+    !! 1.7.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_cov_max in the DGVM
+    !??        and why you don't multiply with veget_cov_max in stomate.
+!!$    IF ( ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN
+!!$       IF(ok_dgvm) THEN
+!!$          WHERE (ind(:,:).GT.min_stomate)
+!!$             woodmass_ind(:,:) = &
+!!$                  ((biomass(:,:,isapabove,icarbon)+biomass(:,:,isapbelow,icarbon) &
+!!$                  +biomass(:,:,iheartabove,icarbon)+biomass(:,:,iheartbelow,icarbon)) & 
+!!$                  *veget_cov_max(:,:))/ind(:,:)
+!!$          ENDWHERE
+!!$       ELSE
+!!$          WHERE (ind(:,:).GT.min_stomate)
+!!$             woodmass_ind(:,:) = &
+!!$                  (biomass(:,:,isapabove,icarbon)+biomass(:,:,isapbelow,icarbon) &
+!!$                  +biomass(:,:,iheartabove,icarbon)+biomass(:,:,iheartbelow,icarbon))/ind(:,:)
+!!$          ENDWHERE
+!!$       ENDIF
+!!$
+!!$       CALL crown (npts,  PFTpresent, &
+!!$            ind, biomass, woodmass_ind, &
+!!$            veget_cov_max, cn_ind, height)
+!!$    ENDIF
+
+  !! 2. Prescribe vegetation characteristics if the vegetation is not dynamic
+    !   At the first call this routine takes atmospheric CO2 and converts it
+    !   into carbon pools to basically avoid modelling seed germination.
+    !   When lpft_replant is used we ware not sure whether we want to replant
+    !   with the same or another species. Replanting with another species is
+    !   a lcchange and therefore when lpf_replant is used it will be dealt with
+    !   at the end of the year in sapiens_lcchange. In this case replanting
+    !   will only take place at the end of the year. If a PFT dies during the 
+    !   year it will be left fallow until the last day of the year.
+    ! +++CHECK+++
+    ! Old issue, check whether the code can deal with it - I [SL] think this 
+    ! should not be an issue. The model now always has density and individuals.
+    !  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.
+    ! +++++++++++
+    
+    ! Debug
+    !printlev_loc=get_printlev('stomate_lpj')
+    IF (printlev_loc>=4) CALL debug_write(npts, 'before prescribe', &
+         circ_class_biomass, circ_class_n, circ_class_kill, &
+         plant_status, veget_cov_max)
+    !-
+
+    dummy(:,:,:) = un
+    CALL prescribe (npts, veget_cov_max, dt_days, PFTpresent, &
+            everywhere, when_growthinit, leaf_frac, circ_class_dist, &  
+            circ_class_n, circ_class_biomass, atm_to_bm, &
+            forest_managed, KF, plant_status, age, npp_longterm, &
+            lm_lastyearmax, tau_eff_leaf, tau_eff_sap, tau_eff_root, &
+            k_latosa_adapt, dummy, EndOfYear, lpft_replant, species_change_map)
+
+    !We store intermediate veget_cov_max and atm_to_bm in order to calculate
+    !the mass balance closure at the end odf the subroutine
+    atm_to_bm_hist(:,:,ipre,:) = atm_to_bm(:,:,:)
+    veget_cov_max_hist(:,:,ipre) =  veget_cov_max(:,:)
+    ! atm_to_bm is always reset to zero  begore going to another subroutine
+    atm_to_bm(:,:,:) = zero
+
+
+  !! 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.
+    ! +++CHECK+++
+    ! Uncomment when working on the DGVM
+!!$    CALL constraints (npts, dt_days, &
+!!$         t2m_month, t2m_min_daily,when_growthinit, Tseason, &
+!!$         adapted, regenerate)
+    ! +++++++++++
+    
+  !! 3. Determine introduction and elimination of PTS based on climate criteria
+    ! +++CHECK+++
+    ! Uncomment when working on the DGVM
+!!$    IF ( ok_dgvm ) THEN
+!!$      
+!!$       !! 3.1 Calculate introduction and elimination
+!!$       CALL pftinout (npts, dt_days, adapted, regenerate, &
+!!$            neighbours, veget_cov_max, &
+!!$            biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, &
+!!$            PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, &
+!!$            atm_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_cov_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_cov_max(:,:) .GT. min_stomate)
+!!$             woodmass_ind(:,:) = &
+!!$                  ((biomass(:,:,isapabove,icarbon) + biomass(:,:,isapbelow,icarbon) &
+!!$                  + biomass(:,:,iheartabove,icarbon) + biomass(:,:,iheartbelow,icarbon))*veget_cov_max(:,:))/ind(:,:)
+!!$          ELSEWHERE
+!!$             woodmass_ind(:,:) =(biomass(:,:,isapabove,icarbon) + biomass(:,:,isapbelow,icarbon) &
+!!$                  + biomass(:,:,iheartabove,icarbon) + biomass(:,:,iheartbelow,icarbon))/ind(:,:)
+!!$          ENDWHERE
+!!$
+!!$       ENDWHERE
+!!$       
+!!$       ! Calculate crown area and diameter for all PFTs (including the newly established)
+!!$       CALL crown (npts, PFTpresent, &
+!!$            ind, biomass, woodmass_ind, &
+!!$            veget_cov_max, cn_ind, height)
+!!$
+!!$    ENDIF
+     ! +++++++++++
+ 
+  !! 4. Phenology
+
+    ! Forests and grasses or the so called natural vegetation in ORCHIDEE
+    ! undergo a real phenology based on climatology. This means that the
+    ! plants are planted the first day of the year and that they live from
+    ! their reserves until the day of bud burst. Crops are planted 
+    ! (and harvested) every year. We plant them the day of bud burst. The 
+    ! biggest difference is that crops do not need reserves to live
+    ! between January 1st and the day of bud burst.
+    
+    ! Debug
+    !printlev_loc=get_printlev('stomate_lpj')
+    IF (printlev_loc>=4) CALL debug_write(npts, 'before phenology', &
+         circ_class_biomass, circ_class_n, circ_class_kill, &
+         plant_status, veget_cov_max)
+
+    ! 
+    CALL phenology (npts, dt_days, PFTpresent, &
+         veget_cov_max, &
+         t2m_longterm, t2m_month, t2m_week, gpp_daily, &
+         maxmoiavail_lastyear, minmoiavail_lastyear, &
+         moiavail_month, moiavail_week, &
+         gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+         plant_status, time_hum_min, &
+         leaf_frac, leaf_age, &
+         when_growthinit, atm_to_bm, circ_class_n, &
+         circ_class_biomass, KF, &
+         tau_eff_leaf, tau_eff_sap, tau_eff_root, age, &
+         everywhere, npp_longterm, lm_lastyearmax, k_latosa_adapt, &
+         cn_leaf_min_season, plant_n_uptake_daily)
+
+    !We store intermediate veget_cov_max and atm_to_bm in order to calculate
+    !the mass balance closure at the end odf the subroutine
+    atm_to_bm_hist(:,:,iphe,:) = atm_to_bm(:,:,:)
+    veget_cov_max_hist(:,:,iphe) =  veget_cov_max(:,:)
+    atm_to_bm(:,:,:) = zero
+
+ !! 5. Allocate C to different plant parts
+
+    ! Allometry based allocation and intra-stand competition (based on 
+    ! Sitch et al 2003, Zaehle et al 2010 and Deleuze 2004)
+    
+    ! Debug
+    !printlev_loc=get_printlev('stomate_lpj')
+    IF (printlev_loc>=4) CALL debug_write(npts, 'before allocation', &
+         circ_class_biomass, circ_class_n, circ_class_kill, &
+         plant_status, veget_cov_max)
+
+    !-
+    CALL growth_fun_all (npts, dt_days, veget_cov_max, veget_cov, PFTpresent, &
+         plant_status, when_growthinit, t2m_week, &
+         nstress_season, moiavail_growingseason, &
+         gpp_daily, resp_maint_part, resp_maint, &
+         resp_growth, npp_daily, bm_alloc, age, &
+         leaf_age, leaf_frac, use_reserve, &
+         lab_fac, rue_longterm, circ_class_n, &
+         circ_class_biomass, KF, sigma, &
+         gammas, tau_eff_leaf, tau_eff_sap, tau_eff_root, &
+         k_latosa_adapt, forest_managed, circ_class_dist, &
+         cn_leaf_min_season, atm_to_bm, store_sum_delta_ba)     
+
+    check_intern(:,:,iatm2land,icarbon) = gpp_daily(:,:) * veget_cov_max(:,:) * dt_days
+    check_intern(:,:,iland2atm,icarbon) = &
+        -un*(resp_maint(:,:) + resp_growth(:,:)) *veget_cov_max(:,:) * dt_days
+ 
+
+    !We store intermediate veget_cov_max and atm_to_bm in order to calculate
+    !the mass balance closure at the end odf the subroutine
+    veget_cov_max_hist(:,:,igro) =  veget_cov_max(:,:)
+    atm_to_bm_hist(:,:,igro,:) = atm_to_bm(:,:,:)
+    atm_to_bm(:,:,:)=zero
+
+ !! 6. Land cover change and land management
+
+    ! We only want to do management at the end of the year. Whether 
+    ! LCC takes place before land management appears to be a matter
+    ! of taste but given that LCC results in the (partial) destruction 
+    ! of the PFT it appears somehow logic to deal with LCC before FM. 
+    ! After all, it seems unlikely that a land owner will first 
+    ! carefully thin a forest and then cut it to turn it into a 
+    ! grassland or cropland.
+    IF ( EndOfYear) THEN
+       
+       ! Debug
+       !printlev_loc=get_printlev('stomate_lpj')
+       IF (printlev_loc>=4) CALL debug_write(npts,'before age class distr', &
+            circ_class_biomass, circ_class_n, circ_class_kill, &
+            plant_status, veget_cov_max)
+       !- 
+
+       !  Following allocation, the trees have grown and it needs to be
+       !  checked whether they are still in the correct age class. If not,
+       !  redistribute the age classes in line with a prescribe diameter
+       !  threshold for each age class. This function could be applied on 
+       !  daily time step but once per year is probably enough. This 
+       !  routines distributes biomass within a species group so it can 
+       !  be used in combination with species changes.
+       CALL age_class_distr(npts, circ_class_n, circ_class_biomass, &
+            veget_cov_max, circ_class_dist, wstress_season, &
+            lm_lastyearmax, age, leaf_frac, atm_to_bm, &
+            everywhere, litter, som, lignin_struc, &
+            lignin_wood, bm_to_litter,turnover_daily, PFTpresent, when_growthinit,&
+            forest_managed, KF, plant_status, &
+            npp_longterm, gpp_daily, leaf_age, lab_fac, &
+            gdd_from_growthinit, gdd_midwinter, time_hum_min, &
+            hum_min_dormance, gdd_m5_dormance, &
+            ncd_dormance, moiavail_month, moiavail_week, ngd_minus5, &
+            resp_maint, resp_growth, npp_daily, &
+            use_reserve, rue_longterm, mai, pai, &
+            mai_count, previous_wood_volume, moiavail_growingseason,&
+            matrixA, matrixV, VectorB, VectorU, age_stand, last_cut, &
+            k_latosa_adapt, fm_change_map, lpft_replant, cn_leaf_min_season,&
+            nstress_season, soil_n_min, p_O2, bact, store_sum_delta_ba, &
+            CN_som_litter_longterm,nbp_pool_start)
+
+      ! We store intermediate veget_cov_max and atm_to_bm in order to calculate
+      ! the mass balance closure at the end odf the subroutine
+      veget_cov_max_hist(:,:,iage) =  veget_cov_max(:,:)
+      atm_to_bm_hist(:,:,iage,:) = atm_to_bm(:,:,:)
+      atm_to_bm(:,:,:)=zero
+
+ 
+      !! 5.2 Land cover change
+      IF (do_now_stomate_lcchange) THEN
+       
+          ! When there is a loss in veget_cov_max (i.e., oaks are changed 
+          ! to grasslands the) standard code will distribute this loss 
+          ! proportionaly (i.e., all age classes with oak will be partly
+          ! converted) to the populated age classes of the species group. 
+          ! In case of a species change we only want to change the surface 
+          ! area of the youngest age class (because we will only plant 
+          ! trees in the youngest age class). set losses = proportional
+          losses = 'proportional'
+          CALL land_cover_change_main(npts, dt_days, veget_cov_max, veget_cov, &
+               harvest_pool, harvest_type, harvest_cut, harvest_area, &
+               litter, som, lignin_struc, lignin_wood, &
+               PFTpresent, everywhere, when_growthinit, & 
+               leaf_frac, circ_class_n, circ_class_biomass, &
+               atm_to_bm, forest_managed, &
+               KF, wstress_season, wstress_month, plant_status, npp_longterm, &
+               age, lm_lastyearmax, harvest_pool_bound, resolution, &
+               bm_to_litter, turnover_daily,leaf_age, circ_class_dist, &
+               tau_eff_leaf, tau_eff_sap, &
+               tau_eff_root, veget_cov_max_new, age_stand, last_cut, &
+               k_latosa_adapt, losses, light_tran_to_level_season, &
+               EndOfYear,  lpft_replant,  soil_n_min, bact, species_change_map)
+
+          ! Set the flag done_stomate_lcchange to be used in the end of sechiba_main 
+          ! to update the fractions.
+          do_now_stomate_lcchange=.FALSE.
+          done_stomate_lcchange=.TRUE.
+          
+          !We store intermediate veget_cov_max and atm_to_bm in order to
+          !calculate
+          !the mass balance closure at the end odf the subroutine
+          atm_to_bm_hist(:,:,ilcc,:) = atm_to_bm(:,:,:)
+          veget_cov_max_hist(:,:,ilcc) =  veget_cov_max(:,:)
+          atm_to_bm(:,:,:) = zero
+ 
+       ENDIF
+
+       !! 5.3 Forest management
+       !  Thin and harvest species. Flag opportunities for species
+       !  changes.
+
+       ! Debug
+       !printlev_loc=get_printlev('stomate_lpj')
+       IF (printlev_loc>=4) CALL debug_write(npts,'before forestry', &
+            circ_class_biomass, circ_class_n, circ_class_kill, &
+            plant_status, veget_cov_max)
+       !- 
+       CALL forestry (npts, age_stand, last_cut, &
+            circ_class_n, circ_class_kill, forest_managed, rdi,&
+            circ_class_biomass, mai, pai, previous_wood_volume, &
+            mai_count, coppice_dens, veget_cov_max, rdi_target_upper,&
+            rdi_target_lower, fm_change_map, species_change_map)
+
+       !! 5.4 Crop harvest
+       !  According to the logic of this module crop harvest should 
+       !  take place here but it depends on :: turnover_daily and that
+       !  variable is not calculated until the call to turnover. Also
+       !  the implemented approach harvests biomass daily rather once
+       !  per year (as it should be).
+       
+       !! 5.5 Grazing
+       !  This is an excellent place to account for grazing.
+       
+       !! 5.6 Litter raking
+       !  If you are NOT doing historical runs, litter raking almost certainly
+       !  does not apply to you.
+       !
+       !  In order to feed animals through the winter, as well as absorb
+       !  their manure to spread on the fields during the spring, farmers
+       !  in historical Europe would collect litter from forests and place
+       !  it in the stables during winter.  We will simulate this by
+       !  looking at the litter pools at the end of every year and moving
+       !  around a certain amount of litter from the forest to the crop PFTs.
+       !  We do this after the forest management under the assumption that
+       !  branches left on site after thinning operations would, historically,
+       !  have been collected for this purpose. Of course, litter raking fell
+       !  out of fashion in the mid-19th century, around the same time that
+       !  scientific sylviculture became popular, so perhaps it doesn't 
+       !  matter.
+       IF(ok_litter_raking)THEN
+
+          ! Calculate fluxes from litter raking
+          CALL litter_raking(npts, veget_cov_max, resolution, litter_demand, &
+               litter, lrake_frac)
+          
+       ENDIF
+
+    ENDIF ! EndOfYear
+
+!! 6. Fire, Wind and Pests
+
+      !! 6.1 Call wind_damage module
+       IF (ok_windthrow) THEN
+
+       !  Calculate the critical wind speed for uprooting and breakage
+       !  critical windspeeds are calculated every half-hour. A
+       !  cummulated critical windspeed is then passed to stomate_lpj
+       !  to calculate the actual stand damage and mortality
+!       IF(ld_windfall)THEN
+          WRITE(numout,*) 'Call wind_damage module for calculating critical wind speed'
+          WRITE(numout,*) 'Daily maximum windspeed at pixel level:', &
+                           wind_speed_daily
+          WRITE(numout,*) 'Daily maximum soil temperature near 80 cm below ground  at pixel level:',&
+                           soil_temp_daily
+
+!       ENDIF
+
+       CALL wind_damage(npts, nlevels_tot, circ_class_biomass, &
+            veget_cov_max, circ_class_n, wind_speed_daily, plant_status, &
+            resolution, circ_class_kill, harvest_5y_area, forest_managed, &
+            soil_temp_daily)
+
+       ENDIF
+       !! 6.2 Call the fire module
+
+
+ !! 7. Kill PFT's
+   
+    ! Kill slow growing PFTs in DGVM or STOMATE with dynamic or
+    ! constant mortality. Mark trees that died from self-thinning
+    ! or environmental mortality. The biomass pools are not touched.
+    ! Vegetation is only marked for killing
+   
+    ! Debug
+    !printlev_loc=get_printlev('stomate_lpj')
+    IF (printlev_loc>=4) CALL debug_write(npts, 'before mark_to_kill', &
+         circ_class_biomass, circ_class_n, circ_class_kill, &
+         plant_status, veget_cov_max)
+    !- 
+    CALL mark_to_kill (npts, 'growth    ', lm_lastyearmax, &
+         PFTpresent, npp_longterm, circ_class_biomass, &
+         circ_class_n, circ_class_kill, rue_longterm, turnover_longterm, &
+         dt_days, veget_cov_max, st_dist, forest_managed)
+
+
+     ! +++CHECK+++
+     ! Uncomment when working on the DGVM
+!!$    IF ( ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN
+!!$       CALL kill (npts, 'npp       ', lm_lastyearmax,  &
+!!$            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+!!$            lai, age, leaf_age, leaf_frac, npp_longterm, &
+!!$            when_growthinit, everywhere, veget_cov_max, bm_to_litter)
+!!$
+!!$       !! 6.2.1 Update wood biomass      
+!!$       !        For the DGVM
+!!$       IF(ok_dgvm) THEN
+!!$          WHERE (ind(:,:).GT.min_stomate)
+!!$             woodmass_ind(:,:) = &
+!!$                  ((biomass(:,:,isapabove,icarbon) + biomass(:,:,isapbelow,icarbon) &
+!!$                  + biomass(:,:,iheartabove,icarbon) + biomass(:,:,iheartbelow,icarbon)) & 
+!!$                  *veget_cov_max(:,:))/ind(:,:)
+!!$          ENDWHERE
+!!$
+!!$       ! For all pixels with individuals
+!!$       ELSE
+!!$          WHERE (ind(:,:).GT.min_stomate)
+!!$             woodmass_ind(:,:) = &
+!!$                  (biomass(:,:,isapabove,icarbon) + biomass(:,:,isapbelow,icarbon) &
+!!$                  + biomass(:,:,iheartabove,icarbon) + biomass(:,:,iheartbelow,icarbon))/ind(:,:)
+!!$          ENDWHERE
+!!$       ENDIF ! ok_dgvm
+!!$
+!!$       !! 6.2.2 New crown area and maximum vegetation cover after growth
+!!$       CALL crown (npts, PFTpresent, &
+!!$            ind, biomass, woodmass_ind,&
+!!$            veget_cov_max, cn_ind, height)
+!!$
+!!$    ENDIF ! ok_dgvm
+     ! +++++++++++
+    
+  !! 7. fire
+
+    !! 7.1. Burn PFTs
+     ! +++CHECK+++
+     ! Uncomment when working on the DGVM
+!!$     CALL fire (npts, dt_days, &
+!!$         litterhum_daily, t2m_daily, lignin_struc, lignin_wood, veget_cov_max, &
+!!$         fireindex, firelitter, biomass, ind, &
+!!$         litter, dead_leaves, bm_to_litter, &
+!!$         co2_fire, matrixA)
+    ! +++++++++++ 
+
+    !! 7.2 Kill PFTs in DGVM
+     ! +++CHECK+++
+     ! Uncomment when working on the DGVM
+!!$     IF ( ok_dgvm ) THEN
+!!$
+!!$        ! reset attributes for eliminated PFTs
+!!$        CALL kill (npts, 'fire      ', lm_lastyearmax, &
+!!$             ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+!!$             lai, age, leaf_age, leaf_frac, npp_longterm, &
+!!$             when_growthinit, everywhere, veget_cov_max, bm_to_litter)
+!!$
+!!$    ENDIF ! ok_dgvm
+    ! +++++++++++ 
+
+ !! 8. Tree mortality
+
+    ! Here is where the trees actually die and biomass is moved around.  
+    ! First, we kill all the trees that died because of human intervention.
+    ! When we mark trees for killing the reason of their dead is also
+    ! stored in circ_class_kill. This is where we make use of that 
+    ! information.
+
+    !+++CHECK+++
+    ! This is called always. It is not clear whether this relates to
+    ! the DGVM or not. The temperature dependencies suggest it does.
+    ! check when working on the DGVM. It is not needed for when the
+    ! PFTs are prescribed.
+!!$    ! Does not depend on age, therefore does not change crown area.
+!!$    CALL gap (npts, dt_days, &
+!!$         npp_longterm, turnover_longterm, lm_lastyearmax, &
+!!$         PFTpresent, t2m_min_daily, Tmin_spring_time, &
+!!$         biomass, ind, bm_to_litter, mortality)
+    !+++++++++++
+    
+    ! Debug
+    !printlev_loc=get_printlev('stomate_lpj')
+    IF (printlev_loc>=4) CALL debug_write(npts,'before anthrop. mortality', &
+         circ_class_biomass, circ_class_n, circ_class_kill, &
+         plant_status, veget_cov_max)
+    !-
+    CALL anthropogenic_mortality (npts, &
+         bm_to_litter, circ_class_biomass, circ_class_kill, &
+         circ_class_n, harvest_pool_bound, harvest_pool, harvest_type, &
+         harvest_cut, harvest_area, resolution, &
+         veget_cov_max, age_stand, last_cut, mai_count, circ_class_dist, &
+         coppice_dens, plant_status, biomass_cut)
+
+!+++CHECK+++
+    ! Code for the DGVM - in addition to the killing
+!!$    IF ( ok_dgvm ) THEN
+!!$       ! reset attributes for eliminated PFTs
+!!$       CALL kill (npts, 'gap       ', lm_lastyearmax, &
+!!$            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+!!$            lai, age, leaf_age, leaf_frac, npp_longterm, &
+!!$            when_growthinit, everywhere, veget_cov_max, bm_to_litter)
+!!$    ENDIF
+    !+++++++++++
+       
+    ! Now we kill all the plants which died due to natural causes. This comes
+    ! after the plant died due to human causes, since in theory a forest
+    ! that is thinned will not suffer as high of natural mortality.
+    ! When we mark trees for killing the reason of their dead is also
+    ! stored in circ_class_kill. This is where we make use of that information.
+
+    ! Debug
+    !printlev_loc=get_printlev('stomate_lpj')
+    IF (printlev_loc>=4) CALL debug_write(npts, 'before natural mortality', &
+         circ_class_biomass, circ_class_n, circ_class_kill, &
+        plant_status, veget_cov_max)
+    !-
+    
+    CALL natural_mortality (npts, bm_to_litter, &
+         circ_class_biomass, circ_class_kill, circ_class_n, &
+         veget_cov_max, biomass_cut)
+
+ !! 9. Change forestry
+       
+       ! PFTs have been managed and killed based on the outcome of 
+       ! the operations and processes it is now decided whether we
+       ! will replant the PFT possible with a different species.
+       IF(ok_change_species)THEN
+          CALL flag_species_change(npts, veget_cov_max, circ_class_biomass,&
+            circ_class_n,lpft_replant, forest_managed)
+       ENDIF
+       
+ !! 10. Clean the stands after mortality
+
+    ! Now we need to do some checking. If there is no biomass on the site,
+    ! some variables have to be reset. If some of the circumference classes
+    ! are empty, we need to redistribute the biomass among them.  Notice this
+    ! must be done after both the natural and human killing is done, because
+    ! circ_class_kill for the natural killing is calculated based on 
+    ! circ_class_biomass, and if we redistribute we change circ_class_biomass.
+    ! If a PFT is found empty (= killed) it is getting replanted unless
+    ! species change is used. In that case we wait for the end of the year
+    ! to replant with a different species.
+
+    ! Debug
+    !printlev_loc=get_printlev('stomate_lpj')
+    IF (printlev_loc>=4) CALL debug_write(npts, 'before mortality_clean', &
+         circ_class_biomass, circ_class_n, circ_class_kill, &
+         plant_status, veget_cov_max)
+
+    !-
+
+    CALL mortality_clean (npts, circ_class_biomass, &
+         circ_class_n, age, everywhere, leaf_age,&
+         leaf_frac, plant_status, when_growthinit, circ_class_dist,&
+         age_stand, PFTpresent, last_cut, mai_count, &
+         veget_cov_max, npp_longterm, KF, atm_to_bm, &
+         wstress_season, lm_lastyearmax, lignin_struc, lignin_wood, &
+         som, litter, dt_days, forest_managed, bm_to_litter, lab_fac, &
+         gpp_daily, resp_maint,&
+         resp_growth, npp_daily, use_reserve, mai, pai,&
+         rue_longterm, previous_wood_volume,species_change_map,&
+         tau_eff_leaf, tau_eff_sap, tau_eff_root, moiavail_growingseason,&
+         k_latosa_adapt, lpft_replant, cn_leaf_min_season, &
+         nstress_season, soil_n_min, plant_n_uptake_daily, p_O2, bact, &
+         CN_som_litter_longterm, matrixA, matrixV, vectorB, vectorU)
+         
+    atm_to_bm_hist(:,:,imor,:) = atm_to_bm(:,:,:)
+    veget_cov_max_hist(:,:,imor) =  veget_cov_max(:,:)
+    atm_to_bm(:,:,:) = zero
+
+  !! 11. Leaf senescence and other turnover processes
+
+    ! Calculate all turnover processes which are responsible
+    ! for moving carbon/nitrogen to bifferent living biomass pools in 
+    ! the case of sapwood to heartwood turnover or moving carbon/
+    ! nitrogen from the living biomass to the litter pools. The
+    ! turnover module also deals with leaf fall in autumn.
+
+    ! Debug
+    !printlev_loc=get_printlev('stomate_lpj')
+    IF (printlev_loc>=4) CALL debug_write(npts,'before turnover', &
+         circ_class_biomass, circ_class_n, circ_class_kill, &
+         plant_status, veget_cov_max)
+    !-
+
+    CALL turn_over (npts, dt_days, PFTpresent, herbivores, &
+         maxmoiavail_lastyear, minmoiavail_lastyear, moiavail_week, &
+         moiavail_month, t2m_longterm, t2m_month, t2m_week, &
+         veget_cov_max, gdd_from_growthinit, leaf_age, leaf_frac, age, &
+         turnover_daily, plant_status, turnover_time, &
+         circ_class_biomass, circ_class_n, &
+         when_growthinit, tau_eff_leaf, tau_eff_sap, tau_eff_root, &
+         harvest_pool, harvest_type, harvest_cut, harvest_area, &
+         resolution, wstress_month)
+
+  !! 12. Product use
+ 
+    !  +++CHECK+++
+    !  Write the harvest pools to the history files here because they will
+    !  be reset when the subroutine basic_product_use is called. Note that
+    !  due to some peculiarities in the coding the units of the harvest 
+    !  pool differ for grasses, crops and forests. For forest, the 
+    !  harvest_pool is filled and emptied the last day of the year. Hence
+    !  all daily values are 0, except for the last day. When writing,
+    !  for example, monthly output files the mean monthly value will be 
+    !  written. To obtain the absolute harvest, the value in the history
+    !  file should be multiplied by 30 or 31 depending on whether a 360 or 
+    !  365 day calendre is used. For grasslands the harvest_pool is filled
+    !  daily with the turnover. So the mean value written to the history file
+    !  is the correct value. Crops are typically harvested before December
+    !  31st but the harvest_pool is only emptied on December 31st (just as
+    !  for grasses and forests). So between the harvest date and December
+    !  31st the same biomass remains in the harvest pools. If the harvest 
+    !  takes place before December 1st the same average value is written for
+    !  every day of December and therefore the last month contains the correct
+    !  value for harvest.
+    !  All of this would become straightforward if we would only write 
+    !  harvest_pool the last day of the year. We tried using the operator 
+    !  once in histwrite but were unhappy with the outcome. The IPSL team 
+    !  no longer maintains histwrite as it should get replaced by the 
+    !  ioxserver.
+    CALL histwrite_p (hist_id_stomate, 'HARVEST_POOL_C', itime, &
+         SUM(harvest_pool(:,:,:,icarbon),3), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HARVEST_POOL_N', itime, &
+         SUM(harvest_pool(:,:,:,initrogen),3), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HARVEST_TYPE', itime, &
+         harvest_type(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HARVEST_CUT', itime, &
+         harvest_cut(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HARVEST_AREA', itime, &
+         harvest_area(:,:), npts*nvm, horipft_index)
+
+    CALL xios_orchidee_send_field("HARVEST_POOL_C",SUM(harvest_pool(:,:,:,icarbon),3))
+    CALL xios_orchidee_send_field("HARVEST_POOL_N",SUM(harvest_pool(:,:,:,initrogen),3))
+    CALL xios_orchidee_send_field("HARVEST_TYPE",harvest_type(:,:))
+    CALL xios_orchidee_send_field("HARVEST_CUT",harvest_cut(:,:)) 
+    CALL xios_orchidee_send_field("HARVEST_AREA",harvest_area(:,:))
+    !+++++++++++
+    
+    !  Agricultural harvest now goes into the short-lived product pool.
+    !  Hence, product use can only be estimated after crop_harvest which
+    !  in turn depends on the calculation of turnover. In previous versions
+    !  product use was an integral part of LCC. Maintaining this approach 
+    !  would result in inconsistencies with harvest from forestry and 
+    !  agriculture. Note that there is still no real harvest from grasslands. 
+    !  Grasslands are thus wrongly considered natural PFTs without any human 
+    !  use. To partly overcome this issue the turnover in grasslands is moved 
+    !  into the harvest pool but this approach should be considered as a
+    !  patch rather than a permanent solution.
+    IF(EndofYear)THEN
+       
+       ! Debug
+       !printlev_loc=get_printlev('stomate_lpj')
+       IF (printlev_loc>=4) CALL debug_write(npts,'before wood use', &
+            circ_class_biomass, circ_class_n, circ_class_kill,&
+            plant_status, veget_cov_max)
+       !- 
+
+       IF(ok_dimensional_product_use)THEN
+
+          ! Wood harvest with small dimensions is being used as fire wood
+          ! the remaining wood goes into the short, medium and long product
+          ! pools. This implies that when the dimensions of the harvest 
+          ! change, the product pools will change as well
+          CALL dim_product_use(npts, dt_days, harvest_pool_bound, harvest_pool, &
+               harvest_type, harvest_cut, harvest_area, &
+               flux_prod_s, flux_prod_m, flux_prod_l, prod_s, &
+               prod_m, prod_l, prod_s_total, prod_m_total, &
+               prod_l_total, flux_prod_total, flux_s, flux_m, &
+               flux_l, resolution, veget_cov_max) 
+          
+       ELSE
+
+          ! The scheme does not account for the harvest dimensions. All
+          ! wood is distributed across the short, medium and long product
+          ! pools. This basically means that wood use in 1600, 1700, 1800,
+          ! 1900 and 2000 was identical.
+          CALL basic_product_use(npts, dt_days, harvest_pool_bound, harvest_pool, &
+               harvest_type, harvest_cut, harvest_area, &
+               flux_prod_s, flux_prod_m, flux_prod_l, prod_s, &
+               prod_m, prod_l, prod_s_total, prod_m_total, &
+               prod_l_total, flux_prod_total, flux_s, flux_m, &
+               flux_l, resolution, veget_cov_max)
+
+       ENDIF ! dimensional product use
+
+    ELSE ! EndOfYear
+       
+       ! These variables are all intent(out) so they should be initialized 
+       ! if it's not the end of the year
+       CALL product_init(flux_prod_s, flux_prod_m, flux_prod_l, &
+            prod_s_total, prod_m_total, prod_l_total, flux_s, &
+            flux_m, flux_l, flux_prod_total)
+       
+    ENDIF
+
+ !! 13. Establishment of saplings/recruitment   
+  
+    IF(ok_recruitment .AND. EndOfYear)THEN
+
+       ! Debug
+       IF(printlev_loc.GT.4) WRITE(numout,*) 'We will call recruitment from stomate_lpj.f90  '
+       !-
+
+       !! 12.1 Call recruitment process in
+       CALL prescribe (npts, veget_cov_max, dt_days, PFTpresent, &
+            everywhere, when_growthinit, leaf_frac, circ_class_dist, & 
+            circ_class_n, circ_class_biomass, atm_to_bm, &
+            forest_managed, KF, plant_status, age, npp_longterm, &
+            lm_lastyearmax, tau_eff_leaf, tau_eff_sap, tau_eff_root, &
+            k_latosa_adapt, light_tran_to_level_season, &
+            EndOfYear, lpft_replant, species_change_map)
+
+       !We store intermediate veget_cov_max and atm_to_bm in order to calculate
+       !the mass balance closure at the end odf the subroutine
+       atm_to_bm_hist(:,:,irec,:) = atm_to_bm(:,:,:)
+       veget_cov_max_hist(:,:,irec) =  veget_cov_max(:,:)
+       atm_to_bm(:,:,:) = zero
+
+    ENDIF ! establishment/recruitment    
+  
+  !! 13. Establishment of saplings
+
+!!       IF (.NOT. ok_constant_mortality) THEN
+
+          ! Establish new plants based on the functional allocation
+          ! +++CHECK+++
+          ! The comments below were written during the first round of
+          ! ORCHIDEE-CAN code development. In the mean time a recruitment
+          ! module was added to prescribe. Some the functionality
+          ! that was aimed for in the initial establish routine can now
+          ! be accounted for in prescribe.
+
+          ! Old comments:
+          ! How does this intefer with self-thinning it seems that this 
+          ! code tries to maintain a +/- high biomass by adding individuals 
+          ! when the fpc (foliage) projected cover decreases). This is 
+          ! exactely what we want to avoid as we want to introduce gaps 
+          ! in the static approach. We could try to adjust the 
+          ! proposed aproach for unmanaged systems but I doubt whether 
+          ! the rule of Deleuze and Dhote could deal with such an extreme
+          ! range of diameter sizes. Most unmanged forest are, however, 
+          ! under a disturbance regime and may be aproximated 
+          ! by an 'even-age' evolution.
+
+          ! NOTE:  We have decided not to create this routine.  The 
+          ! reasoning is that we really want gaps in the system and don't 
+          ! want to continually establish. All of this should be taken 
+          ! care of in prescribe at the end
+          ! of the year.  If someone wants to run with DGVM and the new 
+          ! allocation, this will require some effort here.
+
+          !CALL establish_prognostic (npts, dt_days, PFTpresent, regenerate, &
+          !     neighbours, resolution, need_adjacent, herbivores, &
+          !     precip_lastyear, gdd0_lastyear, lm_lastyearmax, avail_tree, &
+          !     avail_grass, npp_longterm, leaf_age, leaf_frac, &
+          !     ind, biomass, age, everywhere, &
+          !     co2_to_bm, veget_cov_max, circ_class_biomass, circ_class_n)
+          ! ++++++++++++
+
+!!       ELSE
+          
+          ! Plant establishment does not occur when constant mortality 
+          ! is used outside the DGVM. Write the values of the flags to 
+          ! make sure this condition is satisfied
+!!          IF (firstcall) THEN
+             
+!!             WRITE(numout,*) 'Plant establishment does not occur because '
+!!             WRITE(numout,*) 'constant mortality is used outside the DGVM'
+!!             WRITE(numout,*) 'control%ok_dgvm, ', ok_dgvm
+!!             WRITE(numout,*) 'control%ok_constant_mortality, ', &
+!!                  ok_constant_mortality
+!!             
+!!          ENDIF
+
+!!       ENDIF  ! constant mortality 
+
+ !! 14. Replant PFTs with a different species.
+
+    IF(EndOfYear)THEN
+
+       IF(ok_change_species)THEN
+
+          IF(printlev_loc>4)  WRITE(numout,*) 'species change lpft_replant'
+
+          ! This is an ad-hoc method to change the species after they die.
+          ! It is only meant to change species through human intervention.
+          ! In theory, this is a function that should be done in a DGVM, which
+          ! is why this code is considered only temporary. Because we passed
+          ! the mortality routines the PFTs may have changed. For example, in 
+          ! sapiens_forestry the oldest age class was marked for harvest. In
+          ! kill the biomass is removed and the surface area taken by the 
+          ! oldest age class was moved to the youngest age class of that group
+          ! Here we will move the youngest age class of the intial group to
+          ! the younest age class of the new species group. First create
+          ! the vectors that are then used to calculate the losses and gains
+          ! in surface area (veget_cov_max)
+          CALL species_change(npts, lpft_replant, veget_cov_max_new, &
+               forest_managed, species_change_map, veget_cov_max, fm_change_map)
+
+          ! Use the land cover change code to move the biomass to the
+          ! correct PFT. When veget_cov_max is lost (i.e., oaks are changed 
+          ! to grasslandsthe) standard code will distribute this loss 
+          ! proportionaly (i.e., all age classes with oak will be partly
+          ! coverted) to the populated age classes of the species group. 
+          ! In case of species change we only want to change the surface 
+          ! area of the youngest age class (because we will only plant 
+          ! trees in the youngest age class). set losses = youngest
+          losses = 'youngest'
+
+          CALL land_cover_change_main (npts, dt_days, veget_cov_max, &
+               veget_cov, harvest_pool, &
+               harvest_type, harvest_cut, harvest_area, &
+               litter, som, lignin_struc, lignin_wood, &
+               PFTpresent, everywhere, when_growthinit, & 
+               leaf_frac, circ_class_n, circ_class_biomass, &
+               atm_to_bm, forest_managed, &
+               KF, wstress_season, wstress_month, plant_status, npp_longterm, &
+               age, lm_lastyearmax, harvest_pool_bound, resolution, &
+               bm_to_litter, turnover_daily,leaf_age, circ_class_dist, &
+               tau_eff_leaf, tau_eff_sap, &
+               tau_eff_root, veget_cov_max_new, age_stand, last_cut, &
+               k_latosa_adapt, losses, light_tran_to_level_season, &
+               EndOfYear, lpft_replant, soil_n_min, bact, species_change_map)    
+
+          veget_cov_max_hist(:,:,ispc) = veget_cov_max(:,:)
+          atm_to_bm_hist(:,:,ispc,:) = atm_to_bm(:,:,:)
+          atm_to_bm(:,:,:) = zero
+
+       ENDIF ! checking for species change  
+
+    ENDIF ! checking for the end of the year
+
+    !! 11. Light competition
+     ! +++CHECK+++
+     ! Uncomment when working on the DGVM
+
+!!$    !! If not using constant mortality then kill with light competition
+!!$!    IF ( ok_dgvm .OR. .NOT.(lpj_gap_const_mort) ) THEN
+!!$    IF ( ok_dgvm ) THEN
+!!$ 
+!!$       !! 11.1 Light competition
+!!$       CALL light (npts, dt_days, &
+!!$            veget_cov_max, fpc_max, PFTpresent, cn_ind, 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_cov_max, bm_to_litter)
+!!$
+!!$    ENDIF
+!!$
+!!$   
+!!$ 
+!!$  !! 12. Establishment of saplings
+!!$    
+!!$    IF ( ok_dgvm .OR. .NOT.lpj_gap_const_mort ) THEN
+!!$
+!!$       !! 12.1 Establish new plants
+!!$       CALL establish (npts, dt_days, PFTpresent, regenerate, &
+!!$            neighbours, resolution, need_adjacent, herbivores, &
+!!$            precip_lastyear, gdd0_lastyear, lm_lastyearmax, &
+!!$            cn_ind, lai, avail_tree, avail_grass, npp_longterm, &
+!!$            leaf_age, leaf_frac, &
+!!$            ind, biomass, age, everywhere, atm_to_bm, &
+!!$            soil_n_min, plant_n_uptake_daily, nstress_season, veget_cov_max, woodmass_ind, &
+!!$            mortality, bm_to_litter)
+!!$
+!!$       IF (printlev_loc>=3) WRITE (numout,*) 'after establish soil_n_min(test_grid,test_pft,:):',soil_n_min(test_grid,test_pft,:)
+!!$       !! 12.2 Calculate new crown area (and maximum vegetation cover)
+!!$       CALL crown (npts, PFTpresent, &
+!!$            ind, biomass, woodmass_ind, &
+!!$            veget_cov_max, cn_ind, height)
+!!$
+!!$    ENDIF
+    ! +++++++++++
+
+
+  !! 13. Calculate final LAI and vegetation cover
+    ! +++CHECK+++
+    ! Move to DGVM - not needed when using prescribed veget_cov_max
+!!$    CALL cover (npts, cn_ind, ind, biomass, &
+!!$         veget_cov_max, veget_cov_max_tmp, lai, &
+!!$         litter, som, turnover_daily, bm_to_litter, &
+!!$         atm_to_bm, co2_fire, resp_hetero, resp_maint, resp_growth, gpp_daily, &
+!!$         lignin_struc, lignin_wood, soil_n_min)
+    ! +++++++++++
+
+
+
+  !! 16. Calculate vcmax
+
+    CALL vmax (npts, dt_days, leaf_age, leaf_frac, vcmax, nue)
+
+  !! 17. Compute the effective leaf area index. 
+     
+    ! Need to put in a function here to compute the height of the
+    ! photosynthesis levels given the height of the energy levels and the 
+    ! vegetation on the grid square.  The hightest levels will be a 
+    ! function of the height of the vegetation so that we don't waste 
+    ! computational time on empty levels.
+
+    ! Debug
+    ! The ipslerr_p issue is most likely causing the crash here. 
+    ! printlev_loc=get_printlev('stomate_lpj')
+    ! IF (printlev_loc>=4) 
+    ! CALL debug_write(npts,'before lai effective', &
+    !      circ_class_biomass, circ_class_n, circ_class_kill, &
+    !      plant_status, veget_cov_max)
+
+    !- 
+    CALL calculate_z_level_photo(npts, circ_class_biomass, circ_class_n, &
+         z_level_photo)
+    
+    ! Finding the true LAI per level is different from finding the
+    ! effective LAI per level, so we'll do that here.  This only
+    ! changes once every day so hopefully it is not too expensive.
+    ! It will eventually be needed by the energy budget.  It is
+    ! also needed by effective_lai for grasses and crops.
+    CALL find_lai_per_level(npts, z_level_photo, &
+         circ_class_biomass, circ_class_n, lai_per_level, &
+         max_height_store)
+    
+    ! This is a function of the solar angle, and needed for the albedo
+    ! and the photosynthesis.  It was very expensive to compute, so instead
+    ! of computing it at every timestep we compute it at a couple points
+    ! throughout the day and fit a function to it.  We do this now because
+    ! the canopy as it appears now will be used for the next day.
+    ! Now we actually find the effective LAI and fit the function 
+    ! we'll use later on 
+    CALL fitting_laieff(npts, z_level_photo, circ_class_biomass, & 
+         circ_class_n, veget_cov_max, lai_per_level, laieff_fit, &
+         h_array_out, z_array_out)
+ 
+ !! 18. Check numerical consistency of this routine
+
+    !  This test is always performed. If err_act.EQ.1 then 
+    !  the value of the mass balance error -if any- is written 
+    !  to the history file.
+!!$    printlev_loc=get_printlev('stomate_lpj')
+
+    ! 14.2 Check surface area
+    CALL check_surface_area("stomate_lpj", npts, veget_cov_max_hist(:,:,ibeg), &
+         veget_cov_max,'pixel')
+
+    IF (printlev_loc .GE. 4) THEN  
+       DO ivm=1,nvm
+          WRITE(numout,*) "step, veget_cov_max, atm_to_bm for ivm:", ivm 
+          WRITE(numout,*)"IBEG",veget_cov_max_hist(test_grid,ivm,ibeg),&
+               atm_to_bm_hist(test_grid,ivm,ibeg,1)
+          WRITE(numout,*)"IPRE",veget_cov_max_hist(test_grid,ivm,ipre),& 
+               atm_to_bm_hist(test_grid,ivm,ipre,1)
+          WRITE(numout,*)"IPHE",veget_cov_max_hist(test_grid,ivm,iphe),&
+               atm_to_bm_hist(test_grid,ivm,iphe,1)
+          WRITE(numout,*)"IGRO",veget_cov_max_hist(test_grid,ivm,igro),&
+               atm_to_bm_hist(test_grid,ivm,igro,1)
+          WRITE(numout,*)"IAGE",veget_cov_max_hist(test_grid,ivm,iage),&
+               atm_to_bm_hist(test_grid,ivm,iage,1)
+          WRITE(numout,*)"ILCC",veget_cov_max_hist(test_grid,ivm,ilcc),&
+               atm_to_bm_hist(test_grid,ivm,ilcc,1)
+          WRITE(numout,*)"IMOR",veget_cov_max_hist(test_grid,ivm,imor),&
+               atm_to_bm_hist(test_grid,ivm,imor,1)
+          WRITE(numout,*)"IREC",veget_cov_max_hist(test_grid,ivm,irec),&
+               atm_to_bm_hist(test_grid,ivm,irec,1)
+          WRITE(numout,*)"ISPC",veget_cov_max_hist(test_grid,ivm,ispc),&
+               atm_to_bm_hist(test_grid,ivm,ispc,1)
+       ENDDO
+    ENDIF
+
+    ! 14.3 Mass balance closure 
+    ! 14.3.1 Calculate final biomass
+    pool_end(:,:,:) = zero 
+    DO iele = 1,nelements
+       DO ipar = 1,nparts
+          DO icir=1,ncirc
+             pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                  circ_class_biomass(:,:,icir,ipar,iele)* &
+                  circ_class_n(:,:,icir) * veget_cov_max(:,:)
+          ENDDO
+          pool_end(:,:,iele) = pool_end(:,:,iele) + &
+               (bm_to_litter(:,:,ipar,iele)  + &
+               turnover_daily(:,:,ipar,iele)) * veget_cov_max(:,:)
+       ENDDO
+       pool_end(:,1,iele) = pool_end(:,1,iele) + &
+            ( SUM(SUM(harvest_pool(:,:,:,iele),3),2) + &
+            SUM(prod_l(:,:,iele),2) + SUM(prod_m(:,:,iele),2) + &
+            SUM(prod_s(:,:,iele),2) ) / pixel_area(:)
+    ENDDO
+
+    ! Common processes. Atm_to_bm should be empty when the model enters
+    ! stomate_lpj but its value can change at several call in stomate_lpj.
+    ! for this reason the history of atm_to_bm needs to be stored and
+    ! it has be multiplied by the history of veget_cov_max within stomate_lpj
+    ! to track all the carbon down.
+    DO iele = 1,nelements
+       check_intern(:,:,iatm2land,iele) = &
+            check_intern(:,:,iatm2land,iele) + &
+            SUM(atm_to_bm_hist(:,:,:,iele) * veget_cov_max_hist(:,:,:) * dt_days,3)
+       check_intern(:,1,iland2atm,iele) = check_intern(:,1,iland2atm,iele) &
+            -un * ( SUM(flux_s(:,:,iele),2) + SUM(flux_m(:,:,iele),2) + &
+            SUM(flux_l(:,:,iele),2) ) / pixel_area(:)
+       check_intern(:,:,ilat2out,iele) = zero
+       check_intern(:,:,ilat2in,iele) = -un * zero
+       check_intern(:,:,ipoolchange,iele) = -un * (pool_end(:,:,iele) - &
+            pool_start(:,:,iele))
+    ENDDO
+
+    closure_intern = zero
+    DO ivm=1, nvm
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) THEN              
+                IF(iele .EQ. 1) WRITE(numout,"(9999(G12.5,:,','))") &
+                     'imbc, ivm, check_intern', test_grid , imbc, &
+                     ivm, check_intern(test_grid,ivm,imbc,iele)
+             ENDIF
+             closure_intern(:,ivm,iele) = closure_intern(:,ivm,iele) + &
+                  check_intern(:,ivm,imbc,iele)
+          ENDDO
+       ENDDO
+    ENDDO
+    CALL check_mass_balance("stomate_lpj", closure_intern, npts, &
+         pool_end, pool_start, veget_cov_max, 'pixel')
+
+    ! Add to the mass balance errors of stomate_dt_sechiba
+    DO iele = 1,nelements
+       mass_balance_closure(:,iele) = mass_balance_closure(:,iele) + &
+            closure_intern(:,1,iele)
+    ENDDO
+ 
+
+    !+++CHECK+++
+    ! This does not look essential. Just making daily totals.
+    ! Shouldn we do this where we calculate heterothropic respiration?
+!!$  !! 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,icarbon) + &
+!!$            &          litter(:,imetabolic,j,iabove,icarbon) + litter(:,iwoody,j,iabove,icarbon) + &
+!!$            &          litter(:,istructural,j,ibelow,icarbon) + litter(:,imetabolic,j,ibelow,icarbon)+ &
+!!$            &          litter(:,iwoody,j,ibelow,icarbon))
+!!$
+!!$       tot_soil_carb(:,j) = tot_soil_carb(:,j) + (som(:,iactive,j,icarbon) + &
+!!$            &          som(:,islow,j,icarbon)+  som(:,ipassive,j,icarbon)+  som(:,isurface,j,icarbon))
+!!$
+!!$    ENDDO
+!!$    tot_litter_soil_carb(:,:) = tot_litter_carb(:,:) + tot_soil_carb(:,:)
+!!$
+!!$!     DO k = 1, nelements ! Loop over # elements
+!!$!        tot_live_biomass(:,:,k) = biomass(:,:,ileaf,k) + biomass(:,:,isapabove,k) + biomass(:,:,isapbelow,k) +&
+!!$!             &                    biomass(:,:,iheartabove,k) + biomass(:,:,iheartbelow,k) + &
+!!$!             &                    biomass(:,:,iroot,k) + biomass(:,:,ifruit,k) + biomass(:,:,icarbres,k)
+!!$!    END DO ! Loop over # elements
+!!$
+!!$    tot_live_biomass(:,:,:) = biomass(:,:,ileaf,:) + biomass(:,:,isapabove,:) + biomass(:,:,isapbelow,:) +&
+!!$             &                    biomass(:,:,iheartabove,:) + biomass(:,:,iheartbelow,:) + &
+!!$             &                    biomass(:,:,iroot,:) + biomass(:,:,ifruit,:) + biomass(:,:,icarbres,:) + biomass(:,:,ilabile,:)
+!!$
+!!$
+!!$    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,:) + turnover_daily(:,:,ilabile,:) 
+!!$
+!!$    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,:) + bm_to_litter(:,:,ilabile,:)
+!!$
+!!$    carb_mass_variation(:)=-carb_mass_total(:)
+!!$    carb_mass_total(:)=SUM((tot_live_biomass(:,:,icarbon)+tot_litter_carb+tot_soil_carb)*veget_cov_max,dim=2) + &
+!!$         &                 (prod10_total + prod100_total)
+!!$    carb_mass_variation(:)=carb_mass_total(:)+carb_mass_variation(:)
+   ! +++++++++++
+   
+ 
+    !! 19. Write history
+
+    !! 19.1 Calculate the latest values before writing
+    lai(:,1) = zero
+    qm_dia(:,1) = zero
+    qm_height(:,1) = zero
+
+    vcmax_new=zero
+
+    DO ipts = 1,npts
+       DO ivm=2,nvm
+
+           lai(ipts,ivm) = cc_to_lai(circ_class_biomass(ipts,ivm,:,ileaf,icarbon),&
+            circ_class_n(ipts,ivm,:),ivm)
+           qm_dia(ipts,ivm)=wood_to_qmdia(circ_class_biomass(ipts,ivm,:,:,icarbon), &
+                circ_class_n(ipts,ivm,:), ivm)
+           qm_height(ipts,ivm)=wood_to_qmheight(circ_class_biomass(ipts,ivm,:,:,icarbon), &
+                circ_class_n(ipts,ivm,:), ivm)
+
+           IF(SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)*&
+                circ_class_n(ipts,ivm,:)) .GT. min_stomate)THEN
+
+             vcmax_new(ipts,ivm)=nue(ipts,ivm)*SUM(circ_class_biomass(ipts,ivm,:,ileaf,initrogen)*&
+                circ_class_n(ipts,ivm,:))* ext_coeff_N(ivm) / &
+                ( 1.-exp(-ext_coeff_N(ivm) * lai(ipts,ivm)))
+
+           ENDIF
+       ENDDO
+    ENDDO
+
+    ! Soil, litter, biomass and llc
+    ! Total living biomass (gC m-2)i
+    DO l=1,nelements
+        tot_live_biomass(:,:,l) = SUM((circ_class_biomass(:,:,:,ileaf,l) +& 
+             circ_class_biomass(:,:,:,isapabove,l) + &
+             circ_class_biomass(:,:,:,isapbelow,l) + &
+             circ_class_biomass(:,:,:,iheartabove,l) + &
+             circ_class_biomass(:,:,:,iheartbelow,l) + &
+             circ_class_biomass(:,:,:,iroot,l) + &
+             circ_class_biomass(:,:,:,ifruit,l) + &
+             circ_class_biomass(:,:,:,icarbres,l))*circ_class_n(:,:,:),3)
+    ENDDO
+
+    !! Calculate the wood volume change at pixel level by ncuts
+    DO ivm = 1,nvm
+       IF(is_tree(ivm))THEN
+          DO icut= 1,ncut_times
+
+             ! This variable is used to monitor the change in biomass due
+             ! to different reasons for cutting trees. For this variable we
+             ! don't care about the exact forest management but we do care
+             ! whether the forest was managed or not. If the forest is
+             ! managed the cuttings will be exported. If the forest is not
+             ! managed the cuttings are left on-site.
+             wood_volume_pix_cut(:,icut) = wood_volume_pix_cut(:,icut) + &
+                  ((biomass_cut(:,ivm,isapabove,icarbon,ifm_none,icut) + &
+                  biomass_cut(:,ivm,iheartabove,icarbon,ifm_none,icut)) * &
+                  (1-branch_ratio(ivm)) / pipe_density(ivm) + &
+                  (biomass_cut(:,ivm,isapabove,icarbon,ifm_thin,icut) + &
+                  biomass_cut(:,ivm,iheartabove,icarbon,ifm_thin,icut)) * &
+                  (1-branch_ratio(ivm)) / pipe_density(ivm) + &
+                  (biomass_cut(:,ivm,isapabove,icarbon,ifm_cop,icut) + &
+                  biomass_cut(:,ivm,iheartabove,icarbon,ifm_cop,icut)) * &
+                  (1-branch_ratio(ivm)) / pipe_density(ivm) + &
+                  (biomass_cut(:,ivm,isapabove,icarbon,ifm_src,icut) + &
+                  biomass_cut(:,ivm,iheartabove,icarbon,ifm_src,icut)) * &
+                  (1-branch_ratio(ivm)) / pipe_density(ivm)) * &
+                  veget_cov_max(:,ivm)
+                   
+          ENDDO !icut
+       ENDIF ! is_tree
+    ENDDO !ivm
+
+    CALL xios_orchidee_send_field("WOOD_VOL_PIX_CUT",wood_volume_pix_cut)
+    
+    !! 19.2 Write using XIOS
+    !! 19.2.1 stomate history
+    CALL xios_orchidee_send_field("RESOLUTION_X",resolution(:,1))
+    CALL xios_orchidee_send_field("RESOLUTION_Y",resolution(:,2))
+    CALL xios_orchidee_send_field("VEGET_COV_MAX",veget_cov_max)
+    CALL xios_orchidee_send_field("CONTFRAC_STOMATE",contfrac(:))
+
+    ! climatic conditions
+    CALL xios_orchidee_send_field("T2M_MONTH",t2m_month)
+    CALL xios_orchidee_send_field("T2M_WEEK",t2m_week)
+    CALL xios_orchidee_send_field("TSEASON",Tseason)
+    CALL xios_orchidee_send_field("TMIN_SPRING_TIME",Tmin_spring_time)
+    CALL xios_orchidee_send_field("FPC_MAX",fpc_max)
+    CALL xios_orchidee_send_field("MAXFPC_LASTYEAR",maxfpc_lastyear)
+    !CALL xios_orchidee_send_field("ONSET_DATE",onset_date(:,:,2))
+    CALL xios_orchidee_send_field("LITTERHUM",litterhum_daily)
+    CALL xios_orchidee_send_field("FIREINDEX",fireindex(:,:))
+    
+    ! Fluxes
+    CALL xios_orchidee_send_field("NPP_STOMATE",npp_daily)
+    CALL xios_orchidee_send_field("GPP",gpp_daily)
+    CALL xios_orchidee_send_field("HET_RESP",resp_hetero(:,:))
+    CALL xios_orchidee_send_field("CO2_TAKEN",SUM(atm_to_bm_hist(:,:,:,initrogen),3))
+    IF(ok_ncycle) CALL xios_orchidee_send_field("N_TAKEN",SUM(atm_to_bm_hist(:,:,:,initrogen),3))
+    CALL xios_orchidee_send_field("RDI",rdi(:,:))
+    CALL xios_orchidee_send_field("RDI_TARGET_UPPER",rdi_target_upper(:,:))
+    CALL xios_orchidee_send_field("RDI_TARGET_LOWER",rdi_target_lower(:,:))
+    CALL xios_orchidee_send_field("MAINT_RESP",resp_maint)
+    CALL xios_orchidee_send_field("GROWTH_RESP",resp_growth)
+    CALL xios_orchidee_send_field("PLANT_STATUS",plant_status)
+
+    ! Fire results 
+    CALL xios_orchidee_send_field("CO2_FIRE",co2_fire)
+
+    ! Soil, litter, biomass and llc
+    ! Total living biomass (gC m-2)
+    DO l=1,nelements
+        tot_live_biomass(:,:,l) = SUM((circ_class_biomass(:,:,:,ileaf,l) +&
+            circ_class_biomass(:,:,:,isapabove,l) + &
+            circ_class_biomass(:,:,:,isapbelow,l) + &
+            circ_class_biomass(:,:,:,iheartabove,l) + &
+            circ_class_biomass(:,:,:,iheartbelow,l) + &
+            circ_class_biomass(:,:,:,iroot,l) + &
+            circ_class_biomass(:,:,:,ifruit,l) + &
+            circ_class_biomass(:,:,:,icarbres,l))*circ_class_n(:,:,:),3)
+    ENDDO
+
+    DO l=1,nelements 
+       IF     (l == icarbon) THEN 
+          element_str(l) = '_c' 
+       ELSEIF (l == initrogen) THEN 
+          element_str(l) = '_n' 
+       ELSE 
+          STOP 'Define element_str' 
+       ENDIF 
+
+       !! The writting could be more compact, but writting all the components to
+       !! seperate variables might make it more userfriendly i.e. the user need not to
+       !! remember the order of the indexes of nelement and nparts.(asl)      
+       ! Biomass
+       CALL xios_orchidee_send_field("TOTAL_M"//TRIM(element_str(l)),tot_live_biomass(:,:,l))
+       CALL xios_orchidee_send_field("LEAF_M"//TRIM(element_str(l)),&
+            SUM(circ_class_biomass(:,:,:,ileaf,l)*circ_class_n(:,:,:),3))
+       CALL xios_orchidee_send_field("SAP_M_AB"//TRIM(element_str(l)),&
+            SUM(circ_class_biomass(:,:,:,isapabove,l)*circ_class_n(:,:,:),3))
+       CALL xios_orchidee_send_field("SAP_M_BE"//TRIM(element_str(l)),&
+            SUM(circ_class_biomass(:,:,:,isapbelow,l)*circ_class_n(:,:,:),3))
+       CALL xios_orchidee_send_field("HEART_M_AB"//TRIM(element_str(l)),&
+            SUM(circ_class_biomass(:,:,:,iheartabove,l)*circ_class_n(:,:,:),3))
+       CALL xios_orchidee_send_field("HEART_M_BE"//TRIM(element_str(l)),&
+            SUM(circ_class_biomass(:,:,:,iheartbelow,l)*circ_class_n(:,:,:),3))
+       CALL xios_orchidee_send_field("ROOT_M"//TRIM(element_str(l)),&
+            SUM(circ_class_biomass(:,:,:,iroot,l)*circ_class_n(:,:,:),3))
+       CALL xios_orchidee_send_field("FRUIT_M"//TRIM(element_str(l)),&
+            SUM(circ_class_biomass(:,:,:,ifruit,l)*circ_class_n(:,:,:),3))
+       CALL xios_orchidee_send_field("LABILE_M"//TRIM(element_str(l)),&
+            SUM(circ_class_biomass(:,:,:,ilabile,l)*circ_class_n(:,:,:),3))
+       CALL xios_orchidee_send_field("RESERVE_M"//TRIM(element_str(l)),&
+            SUM(circ_class_biomass(:,:,:,icarbres,l)*circ_class_n(:,:,:),3))
+
+       !CALL xios_orchidee_send_field("TOTAL_TURN"//TRIM(element_str(l)),tot_turnover(:,:,l))
+       CALL xios_orchidee_send_field("LEAF_TURN"//TRIM(element_str(l)),turnover_daily(:,:,ileaf,l))
+       CALL xios_orchidee_send_field("SAP_AB_TURN"//TRIM(element_str(l)),turnover_daily(:,:,isapabove,l))
+       CALL xios_orchidee_send_field("ROOT_TURN"//TRIM(element_str(l)),turnover_daily(:,:,iroot,l))
+       CALL xios_orchidee_send_field("FRUIT_TURN"//TRIM(element_str(l)),turnover_daily(:,:,ifruit,l))
+
+       !CALL xios_orchidee_send_field("TOTAL_BM_LITTER"//TRIM(element_str(l)),tot_bm_to_litter(:,:,l))
+       CALL xios_orchidee_send_field("LEAF_BM_LITTER"//TRIM(element_str(l)),bm_to_litter(:,:,ileaf,l))
+       CALL xios_orchidee_send_field("SAP_AB_BM_LITTER"//TRIM(element_str(l)),bm_to_litter(:,:,isapabove,l))
+       CALL xios_orchidee_send_field("SAP_BE_BM_LITTER"//TRIM(element_str(l)),bm_to_litter(:,:,isapbelow,l))
+       CALL xios_orchidee_send_field("HEART_AB_BM_LITTER"//TRIM(element_str(l)),bm_to_litter(:,:,iheartabove,l))
+       CALL xios_orchidee_send_field("HEART_BE_BM_LITTER"//TRIM(element_str(l)),bm_to_litter(:,:,iheartbelow,l))
+       CALL xios_orchidee_send_field("ROOT_BM_LITTER"//TRIM(element_str(l)),bm_to_litter(:,:,iroot,l))
+       CALL xios_orchidee_send_field("FRUIT_BM_LITTER"//TRIM(element_str(l)),bm_to_litter(:,:,ifruit,l))
+       CALL xios_orchidee_send_field("LABILE_BM_LITTER"//TRIM(element_str(l)),bm_to_litter(:,:,ilabile,l))
+       CALL xios_orchidee_send_field("RESERVE_BM_LITTER"//TRIM(element_str(l)),bm_to_litter(:,:,icarbres,l))
+
+       ! Litter
+       CALL xios_orchidee_send_field("LITTER_STR_AB"//TRIM(element_str(l)),litter(:,istructural,:,iabove,l))
+       CALL xios_orchidee_send_field("LITTER_MET_AB"//TRIM(element_str(l)),litter(:,imetabolic,:,iabove,l))
+       CALL xios_orchidee_send_field("LITTER_WOD_AB"//TRIM(element_str(l)),litter(:,iwoody,:,iabove,l))
+       CALL xios_orchidee_send_field("LITTER_STR_BE"//TRIM(element_str(l)),litter(:,istructural,:,ibelow,l))
+       CALL xios_orchidee_send_field("LITTER_MET_BE"//TRIM(element_str(l)),litter(:,imetabolic,:,ibelow,l))
+       CALL xios_orchidee_send_field("LITTER_WOD_BE"//TRIM(element_str(l)),litter(:,iwoody,:,ibelow,l))
+
+       ! Soil
+       CALL xios_orchidee_send_field("SOIL_ACTIVE"//TRIM(element_str(l)),som(:,iactive,:,l))
+       CALL xios_orchidee_send_field("SOIL_SLOW"//TRIM(element_str(l)),som(:,islow,:,l))
+       CALL xios_orchidee_send_field("SOIL_PASSIVE"//TRIM(element_str(l)),som(:,ipassive,:,l))
+       CALL xios_orchidee_send_field("SOIL_SURF"//TRIM(element_str(l)),som(:,isurface,:,l))
+
+       ! land cover change
+       CALL xios_orchidee_send_field('FLUX_PROD_S'//TRIM(element_str(l)),flux_prod_s(:,l))
+       CALL xios_orchidee_send_field('FLUX_PROD_M'//TRIM(element_str(l)),flux_prod_m(:,l))
+       CALL xios_orchidee_send_field('FLUX_PROD_L'//TRIM(element_str(l)),flux_prod_l(:,l))
+       CALL xios_orchidee_send_field('PROD_S'//TRIM(element_str(l)),prod_s(:,:,l))
+       CALL xios_orchidee_send_field('PROD_M'//TRIM(element_str(l)),prod_m(:,:,l))
+       CALL xios_orchidee_send_field('PROD_L'//TRIM(element_str(l)),prod_l(:,:,l))
+       CALL xios_orchidee_send_field('FLUX_S'//TRIM(element_str(l)),flux_s(:,:,l))
+       CALL xios_orchidee_send_field('FLUX_M'//TRIM(element_str(l)),flux_m(:,:,l))
+       CALL xios_orchidee_send_field('FLUX_L'//TRIM(element_str(l)),flux_l(:,:,l))
+
+    ENDDO
+
+    !CN longterm ratios
+    IF (spinup_analytic) THEN
+       CALL xios_orchidee_send_field("CN_LONGTERM_ACTIVE",CN_som_litter_longterm(:,:,iactive_pool))
+       CALL xios_orchidee_send_field("CN_LONGTERM_SLOW",CN_som_litter_longterm(:,:,islow_pool))
+       CALL xios_orchidee_send_field("CN_LONGTERM_PASSIVE",CN_som_litter_longterm(:,:,ipassive_pool))
+       CALL xios_orchidee_send_field("CN_LONGTERM_SURF",CN_som_litter_longterm(:,:,isurface_pool))
+       CALL xios_orchidee_send_field("CN_LONGTERM_LITTER_STR_AB",CN_som_litter_longterm(:,:,istructural_above))
+       CALL xios_orchidee_send_field("CN_LONGTERM_LITTER_STR_BE",CN_som_litter_longterm(:,:,istructural_below))
+       CALL xios_orchidee_send_field("CN_LONGTERM_LITTER_MET_AB",CN_som_litter_longterm(:,:,imetabolic_above))
+       CALL xios_orchidee_send_field("CN_LONGTERM_LITTER_MET_BE",CN_som_litter_longterm(:,:,imetabolic_below))
+       CALL xios_orchidee_send_field("CN_LONGTERM_LITTER_WOD_AB",CN_som_litter_longterm(:,:,iwoody_above))
+       CALL xios_orchidee_send_field("CN_LONGTERM_LITTER_WOD_BE",CN_som_litter_longterm(:,:,iwoody_below))
+    ENDIF
+ 
+    ! Stand structure
+    CALL xios_orchidee_send_field("DIAMETER",qm_dia)
+    CALL xios_orchidee_send_field("LAI_PER_LEVEL",lai_per_level)
+    CALL xios_orchidee_send_field("CLEVEL_HEIGHT",z_level_photo)
+    CALL xios_orchidee_send_field("lai_ipcc",SUM(lai*veget_cov_max,dim=2)*contfrac)
+    CALL xios_orchidee_send_field("LAI",lai) ! this is written twice!
+    CALL xios_orchidee_send_field("HEIGHT",qm_height)
+    CALL xios_orchidee_send_field("IND",SUM(circ_class_n(:,:,:),3))
+    CALL xios_orchidee_send_field("WOODMASS_IND",woodmass_ind)
+    CALL xios_orchidee_send_field("AGE",age)
+    CALL xios_orchidee_send_field("DEADLEAF_COVER",deadleaf_cover)
+    CALL xios_orchidee_send_field("TOTAL_SOIL_CARB",tot_litter_soil_carb)
+    CALL xios_orchidee_send_field("CN_IND",cn_ind)
+
+    ! Growth stress and factors
+    CALL xios_orchidee_send_field("MOISTRESS",moiavail_week)
+    CALL xios_orchidee_send_field("VCMAX",vcmax)
+    CALL xios_orchidee_send_field("VCMAX_NEW",vcmax_new)
+    CALL xios_orchidee_send_field("TURNOVER_TIME_LEAF",turnover_time(:,:,ileaf))
+    CALL xios_orchidee_send_field("TURNOVER_TIME_ROOT",turnover_time(:,:,iroot))
+    CALL xios_orchidee_send_field("TURNOVER_TIME_SAP_AB",turnover_time(:,:,isapabove))
+    CALL xios_orchidee_send_field("TURNOVER_TIME_FRUIT",turnover_time(:,:,ifruit))
+
+
+    ! for functional allocation, we have all of this information
+    ! at every step so we can write it out.
+    var_real=REAL(age_stand)
+    CALL xios_orchidee_send_field("AGE_STAND",var_real)
+    var_real=REAL(forest_managed)
+    CALL xios_orchidee_send_field("FOREST_MANAGED",var_real)
+    var_real=REAL(last_cut)
+    CALL xios_orchidee_send_field("LAST_CUT",var_real)
+    var_real=REAL(rotation_n)
+    CALL xios_orchidee_send_field("ROTATION_N",var_real)
+    CALL xios_orchidee_send_field("LITTER_RAKE_FRAC",lrake_frac)
+    CALL xios_orchidee_send_field("MAI",mai)
+    CALL xios_orchidee_send_field("PAI",pai)
+    CALL xios_orchidee_send_field("SIGMA",sigma)
+    CALL xios_orchidee_send_field("GAMMA",gammas)
+
+
+   !! 19.2.2 ipcc history
+    CALL xios_orchidee_send_field('RESOLUTION_X',resolution(:,1))
+    CALL xios_orchidee_send_field('RESOLUTION_Y',resolution(:,2))
+    CALL xios_orchidee_send_field('CONTFRAC_STOMATE',contfrac(:)) 
+  
+    !CALL xios_orchidee_send_field("cVeg",SUM(tot_live_biomass(:,:,icarbon)*veget_cov_max,dim=2)/1e3)
+    !CALL xios_orchidee_send_field("cLitter",SUM(tot_litter_carb*veget_cov_max,dim=2)/1e3)
+    !CALL xios_orchidee_send_field("cSoil",SUM(tot_soil_carb*veget_cov_max,dim=2)/1e3)
+!!$    CALL xios_orchidee_send_field("cProduct",(prod10_total + prod100_total)/1e3)
+   ! CALL xios_orchidee_send_field("cMassVariation",carb_mass_variation/1e3/one_day)
+
+    CALL xios_orchidee_send_field("lai_ipcc",SUM(lai*veget_cov_max,dim=2))  ! m2/m2
+
+    ! Carbon fluxes transformed from gC/m2/d into kgC/m2/s
+    CALL xios_orchidee_send_field("gpp_ipcc",SUM(gpp_daily*veget_cov_max,dim=2)/1e3/one_day)
+    CALL xios_orchidee_send_field("ra",SUM((resp_maint+resp_growth)*veget_cov_max,dim=2)/1e3/one_day)
+    CALL xios_orchidee_send_field("npp_ipcc",SUM(npp_daily*veget_cov_max,dim=2)/1e3/one_day)
+    CALL xios_orchidee_send_field("rh",SUM(resp_hetero*veget_cov_max,dim=2)/1e3/one_day)
+    CALL xios_orchidee_send_field("fFire",SUM(co2_fire*veget_cov_max,dim=2)/1e3/one_day)
+!   As LLC is not acitivated yet, flux_prod_total is not calculated.
+!   Likewise, harvest_above is no longer used. Possibly, it can  be replaced
+!   by harvest_pool? If yes, be careful with the units, and should be done further 
+!   up the code, as harvest_pool is cleared in basic_product_use.
+!    CALL xios_orchidee_send_field("fHarvest",harvest_above/1e3/one_day)
+!    CALL xios_orchidee_send_field("fLuc",flux_prod_total/1e3/one_day)
+!    CALL xios_orchidee_send_field("nbp",(SUM((gpp_daily + atm_to_bm(:,:,icarbon) - &
+!        (resp_maint+resp_growth+resp_hetero)-co2_fire) *veget_cov_max,dim=2)- &
+!        flux_prod_total-harvest_above)/1e3/one_day)
+    !CALL xios_orchidee_send_field("fVegLitter",SUM((tot_bm_to_litter(:,:,icarbon) + tot_turnover(:,:,icarbon))*&
+    !     veget_cov_max,dim=2)/1e3/one_day)
+    CALL xios_orchidee_send_field("fLitterSoil",SUM(SUM(som_input(:,:,:,icarbon),dim=2)*veget_cov_max,dim=2)/1e3/one_day)
+    CALL xios_orchidee_send_field("cLeaf",SUM(SUM(circ_class_biomass(:,:,:,ileaf,icarbon)*&
+        circ_class_n(:,:,:),3)*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cWood",SUM(SUM((circ_class_biomass(:,:,:,isapabove,icarbon)+&
+        circ_class_biomass(:,:,:,iheartabove,icarbon))*circ_class_n(:,:,:),3)*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cRoot",SUM(SUM((circ_class_biomass(:,:,:,iroot,icarbon) + &
+        circ_class_biomass(:,:,:,isapbelow,icarbon) + &
+        circ_class_biomass(:,:,:,iheartbelow,icarbon) )*circ_class_n(:,:,:),3)*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cMisc",SUM(SUM((circ_class_biomass(:,:,:,icarbres,icarbon) + &
+        circ_class_biomass(:,:,:,ifruit,icarbon))*circ_class_n(:,:,:),3)*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cLitterAbove",SUM((litter(:,istructural,:,iabove,icarbon)+&
+         litter(:,imetabolic,:,iabove,icarbon)+ litter(:,iwoody,:,iabove,icarbon))*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cLitterBelow",SUM((litter(:,istructural,:,ibelow,icarbon)+&
+         litter(:,imetabolic,:,ibelow,icarbon)+ litter(:,iwoody,:,ibelow,icarbon))*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cSoilFast",SUM((som(:,iactive,:,icarbon)+som(:,isurface,:,icarbon)) * &
+         veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cSoilMedium",SUM(som(:,islow,:,icarbon)*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cSoilSlow",SUM(som(:,ipassive,:,icarbon)*veget_cov_max,dim=2)/1e3)
+
+    ! Vegetation fractions [0,100] 
+    CALL xios_orchidee_send_field("landCoverFrac",veget_cov_max*100) 
+    vartmp(:)=zero 
+    DO j = 2,nvm 
+       IF (is_deciduous(j)) THEN 
+          vartmp(:) = vartmp(:) + veget_cov_max(:,j)*100 
+       ENDIF 
+    ENDDO 
+
+    CALL xios_orchidee_send_field("treeFracPrimDec",vartmp) 
+    vartmp(:)=zero 
+    DO j = 2,nvm 
+       IF (is_evergreen(j)) THEN 
+          vartmp(:) = vartmp(:) + veget_cov_max(:,j)*100 
+       ENDIF 
+    ENDDO
+    
+    CALL xios_orchidee_send_field("treeFracPrimEver",vartmp) 
+    vartmp(:)=zero 
+    DO j = 2,nvm 
+       IF ( .NOT.(is_c4(j)) ) THEN 
+          vartmp(:) = vartmp(:) + veget_cov_max(:,j)*100 
+       ENDIF 
+    ENDDO
+ 
+    CALL xios_orchidee_send_field("c3PftFrac",vartmp) 
+    vartmp(:)=zero 
+    DO j = 2,nvm 
+       IF ( is_c4(j) ) THEN 
+          vartmp(:) = vartmp(:) + veget_cov_max(:,j)*100 
+       ENDIF 
+    ENDDO 
+
+    CALL xios_orchidee_send_field("c4PftFrac",vartmp)
+
+    ! Carbon fluxes transformed from gC/m2/d into kgC/m2/s
+    CALL xios_orchidee_send_field("rGrowth",SUM(resp_growth*veget_cov_max,dim=2)/1e3/one_day)
+    CALL xios_orchidee_send_field("rMaint",SUM(resp_maint*veget_cov_max,dim=2)/1e3/one_day)
+    CALL xios_orchidee_send_field("nppLeaf",SUM(bm_alloc(:,:,ileaf,icarbon)*&
+         veget_cov_max,dim=2)/1e3/one_day)
+    CALL xios_orchidee_send_field("nppWood",SUM(bm_alloc(:,:,isapabove,icarbon)*&
+         veget_cov_max,dim=2)/1e3/one_day)
+    CALL xios_orchidee_send_field("nppRoot",SUM(( bm_alloc(:,:,isapbelow,icarbon) + &
+         bm_alloc(:,:,iroot,icarbon) )*veget_cov_max,dim=2)/1e3/one_day)     
+
+    ! 19.3 Write to file using histwrite
+    CALL histwrite_p (hist_id_stomate, 'RESOLUTION_X', itime, &
+         resolution(:,1), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'RESOLUTION_Y', itime, &
+         resolution(:,2), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'VEGET_COV_MAX', itime, &
+         veget_cov_max, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'CONTFRAC', itime, &
+         contfrac(:), npts, hori_index)
+    
+    ! Climatic conditions
+    CALL histwrite_p (hist_id_stomate, 'T2M_MONTH', itime, &
+         t2m_month, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'T2M_WEEK', itime, &
+         t2m_week, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'TSEASON', itime, &
+         Tseason, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'TMIN_SPRING_TIME', itime, &
+         Tmin_spring_time, npts*nvm, horipft_index)
+!    CALL histwrite_p (hist_id_stomate, 'ONSET_DATE', itime, &
+!         onset_date(:,:,2), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FPC_MAX', itime, &
+         fpc_max, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'MAXFPC_LASTYEAR', itime, &
+         maxfpc_lastyear, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FIREINDEX', itime, &
+         fireindex(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LITTERHUM', itime, &
+         litterhum_daily, npts, hori_index)
+
+    ! Fire results
+    CALL histwrite_p (hist_id_stomate, 'CO2_FIRE', itime, &
+         co2_fire, npts*nvm, horipft_index)
+    
+    ! Stand structure
+    CALL histwrite_p (hist_id_stomate, 'LAI', itime, &
+         lai, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'DIAMETER', itime, &
+         qm_dia, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEIGHT', itime, &
+         qm_height, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'IND', itime, &
+         SUM(circ_class_n(:,:,:),3), npts*nvm, horipft_index)
+    
+    ! Calculate lai per level.  Also print out the real height of
+    ! the canopy level.
+    DO ivm=1,nvm
+       
+       WRITE(var_name,'(A,I3.3)') 'LAI_PER_LEVEL_',ivm
+       CALL histwrite_p (hist_id_stomate, var_name, itime, &
+            lai_per_level(:,ivm,:), npts*nlevels_tot, horican_index)
+       
+       WRITE(var_name,'(A,I3.3)') 'CLEVEL_HEIGHT_',ivm
+       CALL histwrite_p (hist_id_stomate, var_name, itime, &
+            z_level_photo(:,ivm,:), npts*nlevels_tot, horican_index) 
+       
+    ENDDO
+    
+!!$     CALL histwrite_p (hist_id_stomate, 'CN_IND', itime, &
+!!$          cn_ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'WOODMASS_IND', itime, &
+         woodmass_ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'AGE', itime, &
+         age, npts*nvm, horipft_index)
+    
+    ! Growth stress and factors
+    CALL histwrite_p (hist_id_stomate, 'MOISTRESS', itime, &
+         moiavail_week, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'VCMAX', itime, &
+         vcmax, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'VCMAX_NEW', itime, &
+         vcmax_new, npts*nvm, horipft_index)
+
+     !+++CHECK+++
+     ! New dimensions
+     !! CALL histwrite_p (hist_id_stomate, 'TURNOVER_TIME_LEAF', itime, &
+     !!      turnover_time(:,:,ileaf), npts*nvm, horipft_index)
+     !! CALL histwrite_p (hist_id_stomate, 'TURNOVER_TIME_ROOT', itime, &
+     !!      turnover_time(:,:,iroot), npts*nvm, horipft_index)
+     !! CALL histwrite_p (hist_id_stomate, 'TURNOVER_TIME_SAP', itime, &
+     !!      turnover_time(:,:,isapabove), npts*nvm, horipft_index)
+     !! CALL histwrite_p (hist_id_stomate, 'TURNOVER_TIME_FRUIT', itime, &
+     !!      turnover_time(:,:,ifruit), npts*nvm, horipft_index) 
+     !+++++++++++
+
+    ! for functional allocation, we have all of this information
+    ! at every step so we can write it out.
+    var_real=REAL(age_stand)
+    CALL histwrite_p (hist_id_stomate, 'AGE_STAND', itime, &
+         var_real, npts*nvm, horipft_index) 
+    CALL histwrite_p (hist_id_stomate, 'MAI', itime, &
+         mai, npts*nvm, horipft_index) 
+    CALL histwrite_p (hist_id_stomate, 'PAI', itime, &
+         pai, npts*nvm, horipft_index) 
+    var_real=REAL(rotation_n)
+    CALL histwrite_p (hist_id_stomate, 'ROTATION_N', itime, &
+         var_real, npts*nvm, horipft_index)
+    var_real=REAL(last_cut)
+    CALL histwrite_p (hist_id_stomate, 'LAST_CUT', itime, &
+         var_real, npts*nvm, horipft_index)
+    var_real=REAL(forest_managed)
+    CALL histwrite_p (hist_id_stomate, 'FOREST_MANAGED', itime, &
+         var_real, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LITTER_RAKE_FRAC', itime, &
+         lrake_frac, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SIGMA', itime, &
+         sigma, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'GAMMA', itime, &
+          gammas, npts*nvm, horipft_index)
+    
+    
+    ! Fluxes
+    CALL histwrite_p (hist_id_stomate, 'NPP', itime, &
+         npp_daily, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'GPP', itime, &
+         gpp_daily, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HET_RESP', itime, &
+         resp_hetero(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'CO2_TAKEN', itime, &
+         SUM(atm_to_bm_hist(:,:,:,icarbon),3), npts*nvm, horipft_index)
+    IF(ok_ncycle) CALL histwrite_p (hist_id_stomate, 'N_TAKEN', itime, &
+         SUM(atm_to_bm_hist(:,:,:,initrogen),3), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'RDI', itime, &
+         rdi, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'RDI_TARGET_UPPER', itime, &
+         rdi_target_upper, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'RDI_TARGET_LOWER', itime, &
+         rdi_target_lower, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'MAINT_RESP', itime, &
+         resp_maint, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'GROWTH_RESP', itime, &
+         resp_growth, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'PLANT_STATUS', itime, &
+         plant_status, npts*nvm, horipft_index)
+    
+    ! Soil, litter and biomass
+    CALL histwrite_p (hist_id_stomate, 'DEADLEAF_COVER', itime, &
+         deadleaf_cover, npts, hori_index)
+    ! CALL histwrite_p (hist_id_stomate, 'TOTAL_SOIL_CARB', itime, &
+    !     tot_litter_soil_carb, npts*nvm, horipft_index)
+     ! +++CHECK+++
+    ! If needed declare in ioipscontrol first
+!!$     CALL histwrite_p (hist_id_stomate, 'LIGNIN_STRUC_AB', itime, &
+!!$          lignin_struc(:,:,iabove), npts*nvm, horipft_index)
+!!$     CALL histwrite_p (hist_id_stomate, 'LIGNIN_STRUC_BE', itime, &
+!!$          lignin_struc(:,:,ibelow), npts*nvm, horipft_index)
+!!$     CALL histwrite_p (hist_id_stomate, 'LIGNIN_WOOD_AB', itime, &
+!!$          lignin_wood(:,:,iabove), npts*nvm, horipft_index)
+!!$     CALL histwrite_p (hist_id_stomate, 'LIGNIN_WOOD_BE', itime, &
+!!$          lignin_wood(:,:,ibelow), npts*nvm, horipft_index)
+     ! +++++++++++
+  
+!!$     WRITE(numout,*) 'Back in stomate_lpj - 4'
+     
+     DO l=1,nelements 
+        IF     (l == icarbon) THEN 
+           element_str(l) = '_c' 
+        ELSEIF (l == initrogen) THEN 
+           element_str(l) = '_n' 
+        ELSE 
+           STOP 'Define element_str' 
+        ENDIF
+       
+        ! Soil and litter per element 
+        CALL histwrite_p (hist_id_stomate, 'LITTER_STR_AB'//TRIM(element_str(l)), itime, & 
+             litter(:,istructural,:,iabove,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'LITTER_MET_AB'//TRIM(element_str(l)), itime, & 
+             litter(:,imetabolic,:,iabove,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'LITTER_STR_BE'//TRIM(element_str(l)), itime, & 
+             litter(:,istructural,:,ibelow,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'LITTER_MET_BE'//TRIM(element_str(l)), itime, & 
+             litter(:,imetabolic,:,ibelow,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'LITTER_WOD_AB'//TRIM(element_str(l)), itime, & 
+             litter(:,iwoody,:,iabove,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'LITTER_WOD_BE'//TRIM(element_str(l)), itime, & 
+             litter(:,iwoody,:,ibelow,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'SOIL_ACTIVE'//TRIM(element_str(l)), itime, & 
+             som(:,iactive,:,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'SOIL_SLOW'//TRIM(element_str(l)), itime, & 
+             som(:,islow,:,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'SOIL_PASSIVE'//TRIM(element_str(l)), itime, & 
+             som(:,ipassive,:,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'SOIL_SURF'//TRIM(element_str(l)), itime, & 
+             som(:,isurface,:,l), npts*nvm, horipft_index) 
+
+        ! Biomass per element  (g C m-2)
+        CALL histwrite_p (hist_id_stomate, 'TOTAL_M'//TRIM(element_str(l)), itime, & 
+             tot_live_biomass(:,:,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'LEAF_M'//TRIM(element_str(l)), itime, & 
+             SUM(circ_class_biomass(:,:,:,ileaf,l)*circ_class_n(:,:,:),3),&
+             npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'SAP_M_AB'//TRIM(element_str(l)), itime, & 
+             SUM(circ_class_biomass(:,:,:,isapabove,l)*circ_class_n(:,:,:),3), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'SAP_M_BE'//TRIM(element_str(l)), itime, & 
+             SUM(circ_class_biomass(:,:,:,isapbelow,l)*circ_class_n(:,:,:),3), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'HEART_M_AB'//TRIM(element_str(l)), itime, & 
+             SUM(circ_class_biomass(:,:,:,iheartabove,l)*circ_class_n(:,:,:),3), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'HEART_M_BE'//TRIM(element_str(l)), itime, & 
+             SUM(circ_class_biomass(:,:,:,iheartbelow,l)*circ_class_n(:,:,:),3), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'ROOT_M'//TRIM(element_str(l)), itime, & 
+             SUM(circ_class_biomass(:,:,:,iroot,l)*circ_class_n(:,:,:),3), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'FRUIT_M'//TRIM(element_str(l)), itime, & 
+             SUM(circ_class_biomass(:,:,:,ifruit,l)*circ_class_n(:,:,:),3), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'RESERVE_M'//TRIM(element_str(l)), itime, & 
+             SUM(circ_class_biomass(:,:,:,icarbres,l)*circ_class_n(:,:,:),3), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'LABILE_M'//TRIM(element_str(l)), itime, & 
+             SUM(circ_class_biomass(:,:,:,ilabile,l)*circ_class_n(:,:,:),3), npts*nvm, horipft_index) 
+        !CALL histwrite_p (hist_id_stomate, 'TOTAL_TURN'//TRIM(element_str(l)), itime, & 
+        !     tot_turnover(:,:,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'LEAF_TURN'//TRIM(element_str(l)), itime, & 
+             turnover_daily(:,:,ileaf,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'SAP_AB_TURN'//TRIM(element_str(l)), itime, & 
+             turnover_daily(:,:,isapabove,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'ROOT_TURN'//TRIM(element_str(l)), itime, & 
+             turnover_daily(:,:,iroot,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'FRUIT_TURN'//TRIM(element_str(l)), itime, & 
+             turnover_daily(:,:,ifruit,l), npts*nvm, horipft_index) 
+        !CALL histwrite_p (hist_id_stomate, 'TOTAL_BM_LITTER'//TRIM(element_str(l)), itime, & 
+        !     tot_bm_to_litter(:,:,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'LEAF_BM_LITTER'//TRIM(element_str(l)), itime, & 
+             bm_to_litter(:,:,ileaf,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'SAP_AB_BM_LITTER'//TRIM(element_str(l)), itime, & 
+             bm_to_litter(:,:,isapabove,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'SAP_BE_BM_LITTER'//TRIM(element_str(l)), itime, & 
+             bm_to_litter(:,:,isapbelow,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'HEART_AB_BM_LITTER'//TRIM(element_str(l)), itime, & 
+             bm_to_litter(:,:,iheartabove,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'HEART_BE_BM_LITTER'//TRIM(element_str(l)), itime, & 
+             bm_to_litter(:,:,iheartbelow,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'ROOT_BM_LITTER'//TRIM(element_str(l)), itime, & 
+             bm_to_litter(:,:,iroot,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'FRUIT_BM_LITTER'//TRIM(element_str(l)), itime, & 
+             bm_to_litter(:,:,ifruit,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'RESERVE_BM_LITTER'//TRIM(element_str(l)), itime, & 
+             bm_to_litter(:,:,icarbres,l), npts*nvm, horipft_index) 
+        CALL histwrite_p (hist_id_stomate, 'LABILE_BM_LITTER'//TRIM(element_str(l)), itime, &
+             bm_to_litter(:,:,ilabile,l), npts*nvm, horipft_index)
+
+        ! land cover change
+        CALL histwrite_p (hist_id_stomate, 'FLUX_PROD_S'//TRIM(element_str(l)), itime, &
+             flux_prod_s(:,l), npts, hori_index)
+        CALL histwrite_p (hist_id_stomate, 'FLUX_PROD_M'//TRIM(element_str(l)), itime, &
+             flux_prod_m(:,l), npts, hori_index)
+        CALL histwrite_p (hist_id_stomate, 'FLUX_PROD_L'//TRIM(element_str(l)), itime, &
+             flux_prod_l(:,l), npts, hori_index)
+        CALL histwrite_p (hist_id_stomate, 'PROD_S'//TRIM(element_str(l)), itime, &
+             prod_s(:,:,l), npts*(nshort+1), horip_ss_index)
+        CALL histwrite_p (hist_id_stomate, 'PROD_M'//TRIM(element_str(l)), itime, &
+             prod_m(:,:,l), npts*(nmedium+1), horip_mm_index)
+        CALL histwrite_p (hist_id_stomate, 'PROD_L'//TRIM(element_str(l)), itime, &
+             prod_l(:,:,l), npts*(nlong+1), horip_ll_index)
+        CALL histwrite_p (hist_id_stomate, 'FLUX_S'//TRIM(element_str(l)), itime, &
+             flux_s(:,:,l), npts*nshort, horip_s_index)
+        CALL histwrite_p (hist_id_stomate, 'FLUX_M'//TRIM(element_str(l)), itime, &
+             flux_m(:,:,l), npts*nmedium, horip_m_index)
+        CALL histwrite_p (hist_id_stomate, 'FLUX_L'//TRIM(element_str(l)), itime, &
+             flux_l(:,:,l), npts*nlong, horip_l_index)
+        
+     ENDDO
+
+     ! Wind throw
+     CALL histwrite_p (hist_id_stomate, 'WOOD_VPCUT', itime, &
+          wood_volume_pix_cut, npts*ncut_times, horicut_index)
+     
+     ! IPCC
+     IF ( hist_id_stomate_IPCC > 0 ) THEN
+        vartmp(:)=SUM(tot_live_biomass(:,:,icarbon)*veget_cov_max,dim=2)/1e3
+        CALL histwrite_p (hist_id_stomate_IPCC, "cVeg", itime, &
+             vartmp, npts, hori_index)
+        !vartmp(:)=SUM(tot_litter_carb*veget_cov_max,dim=2)/1e3
+        !CALL histwrite_p (hist_id_stomate_IPCC, "cLitter", itime, &
+        !     vartmp, npts, hori_index)
+        !vartmp(:)=SUM(tot_soil_carb*veget_cov_max,dim=2)/1e3
+        !CALL histwrite_p (hist_id_stomate_IPCC, "cSoil", itime, &
+        !     vartmp, npts, hori_index)
+!!$        vartmp(:)=(prod10_total + prod100_total)/1e3
+!!$        CALL histwrite_p (hist_id_stomate_IPCC, "cProduct", itime, &
+!!$             vartmp, npts, hori_index)
+        !vartmp(:)=carb_mass_variation/1e3/one_day
+        !CALL histwrite_p (hist_id_stomate_IPCC, "cMassVariation", itime, &
+        !     vartmp, npts, hori_index)
+        vartmp(:)=SUM(lai*veget_cov_max,dim=2)
+        CALL histwrite_p (hist_id_stomate_IPCC, "lai", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(gpp_daily*veget_cov_max,dim=2)/1e3/one_day
+        CALL histwrite_p (hist_id_stomate_IPCC, "gpp", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM((resp_maint+resp_growth)*veget_cov_max,dim=2)/1e3/one_day
+        CALL histwrite_p (hist_id_stomate_IPCC, "ra", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(npp_daily*veget_cov_max,dim=2)/1e3/one_day
+        CALL histwrite_p (hist_id_stomate_IPCC, "npp", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(resp_hetero*veget_cov_max,dim=2)/1e3/one_day
+        CALL histwrite_p (hist_id_stomate_IPCC, "rh", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(co2_fire*veget_cov_max,dim=2)/1e3/one_day
+        CALL histwrite_p (hist_id_stomate_IPCC, "fFire", itime, &
+             vartmp, npts, hori_index)
+!!$        vartmp(:)=harvest_above/1e3/one_day
+!!$        CALL histwrite_p (hist_id_stomate_IPCC, "fHarvest", itime, &
+!!$             vartmp, npts, hori_index)
+!!$        vartmp(:)=cflux_prod_total/1e3/one_day
+!!$        CALL histwrite_p (hist_id_stomate_IPCC, "fLuc", itime, &
+!!$             vartmp, npts, hori_index)
+!!$        vartmp(:)=(SUM((gpp_daily + atm_to_bm(:,:,icarbon) -(resp_maint+resp_growth+resp_hetero)-co2_fire) &
+!!$             & * veget_cov_max,dim=2)-cflux_prod_total-harvest_above)/1e3/one_day
+!!$        CALL histwrite_p (hist_id_stomate_IPCC, "nbp", itime, &
+!!$             vartmp, npts, hori_index)
+        !vartmp(:)=SUM((tot_bm_to_litter(:,:,icarbon) + tot_turnover(:,:,icarbon))*&
+        !     veget_cov_max,dim=2)/1e3/one_day
+        !CALL histwrite_p (hist_id_stomate_IPCC, "fVegLitter", itime, &
+        !     vartmp, npts, hori_index)
+        vartmp(:)=SUM(SUM(som_input(:,:,:,icarbon),dim=2)*veget_cov_max,dim=2)/1e3/one_day
+        CALL histwrite_p (hist_id_stomate_IPCC, "fLitterSoil", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(SUM(circ_class_biomass(:,:,:,ileaf,icarbon)*&
+            circ_class_n(:,:,:),3)*veget_cov_max,dim=2)/1e3
+        CALL histwrite_p (hist_id_stomate_IPCC, "cLeaf", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(SUM((circ_class_biomass(:,:,:,isapabove,icarbon)+&
+            circ_class_biomass(:,:,:,iheartabove,icarbon))*circ_class_n(:,:,:),3)* &
+             veget_cov_max,dim=2)/1e3
+        CALL histwrite_p (hist_id_stomate_IPCC, "cWood", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(SUM(( circ_class_biomass(:,:,:,iroot,icarbon) + &
+            circ_class_biomass(:,:,:,isapbelow,icarbon) + &
+            circ_class_biomass(:,:,:,iheartbelow,icarbon) )*circ_class_n(:,:,:),3)*& 
+            veget_cov_max,dim=2)/1e3
+        CALL histwrite_p (hist_id_stomate_IPCC, "cRoot", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(SUM((circ_class_biomass(:,:,:,icarbres,icarbon) + &
+            circ_class_biomass(:,:,:,ilabile,icarbon) + &
+            circ_class_biomass(:,:,:,ifruit,icarbon))*circ_class_n(:,:,:),3)*&
+            veget_cov_max,dim=2)/1e3
+        CALL histwrite_p (hist_id_stomate_IPCC, "cMisc", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM((litter(:,istructural,:,iabove,icarbon)+ &
+             litter(:,imetabolic,:,iabove,icarbon)+litter(:,iwoody,:,iabove,icarbon))*&
+             veget_cov_max,dim=2)/1e3
+        CALL histwrite_p (hist_id_stomate_IPCC, "cLitterAbove", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM((litter(:,istructural,:,ibelow,icarbon)+ &
+             litter(:,imetabolic,:,ibelow,icarbon)+litter(:,iwoody,:,ibelow,icarbon))*&
+             veget_cov_max,dim=2)/1e3
+        CALL histwrite_p (hist_id_stomate_IPCC, "cLitterBelow", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM((som(:,iactive,:,icarbon)+som(:,isurface,:,icarbon))* &
+             veget_cov_max,dim=2)/1e3
+        CALL histwrite_p (hist_id_stomate_IPCC, "cSoilFast", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(som(:,islow,:,icarbon)*veget_cov_max,dim=2)/1e3
+        CALL histwrite_p (hist_id_stomate_IPCC, "cSoilMedium", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(som(:,ipassive,:,icarbon)*veget_cov_max,dim=2)/1e3
+        CALL histwrite_p (hist_id_stomate_IPCC, "cSoilSlow", itime, &
+             vartmp, npts, hori_index)
+        DO j=1,nvm
+           histvar(:,j)=veget_cov_max(:,j)*100
+        ENDDO
+        CALL histwrite_p (hist_id_stomate_IPCC, "landCoverFrac", itime, &
+             histvar, npts*nvm, horipft_index)
+        !-
+        vartmp(:)=zero
+        DO j = 2,nvm
+           IF (is_deciduous(j)) THEN
+              vartmp(:) = vartmp(:) + veget_cov_max(:,j)*100
+           ENDIF
+        ENDDO
+        CALL histwrite_p (hist_id_stomate_IPCC, "treeFracPrimDec", itime, &
+             vartmp, npts, hori_index)
+        !-
+        vartmp(:)=zero
+        DO j = 2,nvm
+           IF (is_evergreen(j)) THEN
+              vartmp(:) = vartmp(:) + veget_cov_max(:,j)*100
+           ENDIF
+        ENDDO
+        CALL histwrite_p (hist_id_stomate_IPCC, "treeFracPrimEver", itime, &
+             vartmp, npts, hori_index)
+        !-
+        vartmp(:)=zero
+        DO j = 2,nvm
+           IF ( .NOT.(is_c4(j)) ) THEN
+              vartmp(:) = vartmp(:) + veget_cov_max(:,j)*100
+           ENDIF
+        ENDDO
+        CALL histwrite_p (hist_id_stomate_IPCC, "c3PftFrac", itime, &
+             vartmp, npts, hori_index)
+        !-
+        vartmp(:)=zero
+        DO j = 2,nvm
+           IF ( is_c4(j) ) THEN
+              vartmp(:) = vartmp(:) + veget_cov_max(:,j)*100
+           ENDIF
+        ENDDO
+        CALL histwrite_p (hist_id_stomate_IPCC, "c4PftFrac", itime, &
+             vartmp, npts, hori_index)
+        !-
+        vartmp(:)=SUM(resp_growth*veget_cov_max,dim=2)/1e3/one_day
+        CALL histwrite_p (hist_id_stomate_IPCC, "rGrowth", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(resp_maint*veget_cov_max,dim=2)/1e3/one_day
+        CALL histwrite_p (hist_id_stomate_IPCC, "rMaint", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(bm_alloc(:,:,ileaf,icarbon)*veget_cov_max,dim=2)/1e3/one_day
+        CALL histwrite_p (hist_id_stomate_IPCC, "nppLeaf", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(bm_alloc(:,:,isapabove,icarbon)*veget_cov_max,dim=2)/1e3/one_day
+        CALL histwrite_p (hist_id_stomate_IPCC, "nppWood", itime, &
+             vartmp, npts, hori_index)
+        vartmp(:)=SUM(( bm_alloc(:,:,isapbelow,icarbon) + bm_alloc(:,:,iroot,icarbon) )*&
+             veget_cov_max,dim=2)/1e3/one_day
+        CALL histwrite_p (hist_id_stomate_IPCC, "nppRoot", itime, &
+             vartmp, npts, hori_index)
+
+        CALL histwrite_p (hist_id_stomate_IPCC, 'RESOLUTION_X', itime, &
+             resolution(:,1), npts, hori_index)
+        CALL histwrite_p (hist_id_stomate_IPCC, 'RESOLUTION_Y', itime, &
+             resolution(:,2), npts, hori_index)
+        CALL histwrite_p (hist_id_stomate_IPCC, 'CONTFRAC', itime, &
+             contfrac(:), npts, hori_index)
+
+    ENDIF
+
+    IF (printlev_loc>=3) WRITE (numout,*) 'soil_n_min(test_grid,test_pft,:):', &
+         soil_n_min(test_grid,test_pft,:)
+
+    IF (printlev>=3) WRITE(numout,*) 'Leaving stomate_lpj'
+
+  END SUBROUTINE stomate_lpj_vegetation
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : debug_write
+!!
+!>\BRIEF        Write a set of variables to the out_orchidee file
+!!
+!! DESCRIPTION  : Write a set of variables to the out_orchidee file after a routine 
+!!                a routine was called.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE debug_write(npts, check_point, circ_class_biomass, &
+    circ_class_n, circ_class_kill, plant_status, veget_cov_max)
+
+ !! 0. Variable and parameter description
+
+    !! 0.1 Input variables
+     INTEGER(i_std), INTENT(in)                   :: npts               !! Domain size (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)       :: plant_status       !! Growth and phenological status of the plant
+                                                                        !! istatus = Phases defined in constantes
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in) :: circ_class_biomass !! Biomass of the componets of the model  
+                                                                        !! tree within a circumference
+                                                                        !! class @tex $(gC ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in) :: circ_class_kill    !! Number of trees within a circ class that needs
+                                                                        !! to be killed @tex $(ind m^{-2})$ @endtex
+                                                                        !! IMPORTANT: See the note in constantes.f90
+                                                                        !! regarding the indicies for this variable.
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)     :: circ_class_n       !! Number of individuals in each circ class
+                                                                        !! @tex $(m^{-2})$ @endtex
+    CHARACTER(*),INTENT(in)                       :: check_point        !! A flag to indicate at which
+                                                                        !! point in the code we're doing
+    REAL(r_std), DIMENSION(:,:), INTENT(in)       :: veget_cov_max          !! "maximal" coverage fraction of a PFT 
+                                                                        !! (LAI -> infinity) on ground. May sum to
+                                                                        !! less than unity if the pixel has
+                                                                        !! nobio area. (unitless; 0-1)
+
+    !! 0.4 Local variables
+    INTEGER                                       :: icut, ifm, ipts, ivm
+!_ ================================================================================================================================
+
+    WRITE(numout,*) check_point
+    WRITE(numout,*) 'test_pft, ', test_pft
+    WRITE(numout,*) 'circ_class_n, ', SUM(circ_class_n(test_grid,test_pft,:))
+    WRITE(numout,*) 'circ_class_biomass - labile N, ',&
+         SUM(circ_class_biomass(test_grid,test_pft,:,ilabile,initrogen)*&
+         circ_class_n(test_grid,test_pft,:),1)
+    WRITE(numout,*) 'circ_class_biomass - C, ',&
+         SUM(SUM(circ_class_biomass(test_grid,test_pft,:,:,icarbon),2)),&
+         SUM(SUM(circ_class_biomass(test_grid,test_pft,:,:,icarbon),2)*&
+         circ_class_n(test_grid,test_pft,:),1)
+    WRITE(numout,*) 'circ_class_biomass - N, ',&
+         SUM(SUM(circ_class_biomass(test_grid,test_pft,:,:,initrogen),2)),&
+         SUM(SUM(circ_class_biomass(test_grid,test_pft,:,:,initrogen),2)*&
+         circ_class_n(test_grid,test_pft,:),1)
+    WRITE(numout,*) 'plant_status, ', plant_status(:,test_pft)
+!    DO ifm = 1, nfm_types
+!       DO icut = 1, ncut_times
+!          WRITE(numout,*) 'circ_class_kill, ifm, icut, ', ifm, icut, &
+!               circ_class_kill(test_grid,test_pft,:,ifm,icut)
+!       ENDDO
+!    ENDDO
+    WRITE(numout,*) 'veget_cov_max, ', veget_cov_max(:,test_pft), SUM(veget_cov_max(:,:),2)
+
+    DO ipts = 1,npts
+       DO ivm = 1,nvm
+          IF (veget_cov_max(ipts,ivm) .GT. min_stomate .AND. &
+               SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1)) .LT. min_stomate .AND.&
+               SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1)) .NE. zero) THEN
+             WRITE(numout,*) check_point
+             WRITE(numout,*) 'veget_cov_max, ',ivm, veget_cov_max(ipts,ivm)
+             WRITE(numout,*) 'biomass -C, ', &
+                  SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1))
+             WRITE(numout,*) 'biomass -N, ', &
+                  SUM(SUM(circ_class_biomass(ipts,ivm,:,:,initrogen),1))
+             WRITE(numout,*) 'WARNING - some very small amount of C left'
+             CALL ipslerr_p(2,'stomate_lpj','Very small amount of C left',&
+                  'Could cause problems elsewhere','')
+          ENDIF
+       ENDDO
+    ENDDO
+    
+
+  END SUBROUTINE debug_write
+
+END MODULE stomate_lpj
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_mark_kill.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_mark_kill.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_mark_kill.f90	(revision 6412)
@@ -0,0 +1,930 @@
+ 
+! =================================================================================================================================
+! MODULE       : stomate_mark_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         Marks vegetation for killing by natural causes.  Replaces
+!                lpj_kill.  Does not work with the DGVM.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) :
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-DOFOCO/ORCHIDEE/src_stomate/stomate_mark_kill.f90 $
+!! $Date: 2013-09-13 17:14:52 +0200 (Fri, 13 Sep 2013) $
+!! $Revision: 1470 $
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE stomate_mark_kill
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE function_library,       ONLY : nmax, wood_to_qmdia, check_surface_area, &
+                                     check_mass_balance
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC mark_to_kill, distribute_mortality_biomass
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE  : mark_to_kill
+!!
+!>\BRIEF       Kills natural pfts that have low biomass or low number of individuals.
+!!             Does not change the biomass or litter pools.
+!!
+!! DESCRIPTION : Kills natural PFTS.  Forests can die through self-thinning or
+!!             environmental conditions.  Crops can die through environmental
+!!             conditions, and grasses don't die at all.  The total number
+!!             of individuals to be killed in each circ class are outputted
+!!             in circ_class_kill, and the biomass is actually killed in
+!!             gap_prognostic.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::circ_class_kill
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE mark_to_kill (npts, whichroutine, lm_lastyearmax, &
+       PFTpresent, npp_longterm, circ_class_biomass, &
+       circ_class_n, circ_class_kill, rue_longterm, turnover_longterm, &
+       dt, veget_cov_max, st_dist, forest_managed)
+
+ !! 0. Variable and parameter description
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                :: npts                !! Domain size (unitless)
+    CHARACTER(LEN=10), INTENT(in)                             :: whichroutine        !! Message (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: veget_cov_max           !! "maximal" coverage fraction of a PFT on
+                                                                                     !! the ground (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lm_lastyearmax      !! Last year's maximum leaf mass, for each
+                                                                                     !! PFT @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: rue_longterm        !! Longterm radiation use efficiency
+                                                                                     !! (??units??)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), &
+                                                   INTENT(in) :: turnover_longterm   !! "Long term" (default 3-year) turnover
+                                                                                     !! rate @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std), 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(:), INTENT(in)                     :: st_dist             !! The probability distribution of trees
+                                                                                     !! removed from a circ class in case of 
+                                                                                     !! self thinning (unitless).
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent          !! Is pft there (true/false)
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), &                         
+                                                INTENT(inout) :: circ_class_biomass  !! Biomass of the componets of the model 
+                                                                                     !! tree within a circumference
+                                                                                     !! class @tex $(gC ind^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(inout)     :: circ_class_n        !! Number of individuals in each circ class
+                                                                                     !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nfm_types,ncut_times),&
+                                            INTENT(inout)     :: circ_class_kill     !! Number of trees within a circ that needs
+                                                                                     !! to be killed @tex $(ind m^{-2})$ @endtex
+    INTEGER(i_std), DIMENSION (:,:), INTENT(inout)            :: forest_managed      !! forest management flag (is the forest
+                                                                                     !! being managed?)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                            :: ipts, ivm,icir,ipar !! Indices       (unitless)
+    INTEGER(i_std)                                            :: iele, imbc, istep   !! Indices       (unitless)
+    INTEGER(i_std)                                            :: ifm                 !! Indices       (unitless)
+    LOGICAL, DIMENSION(npts)                                  :: was_killed          !! Bookkeeping   (true/false)
+    REAL(r_std), DIMENSION(ncirc)                             :: diameters_temp      !! Trunk diameter calculated from allometry
+    REAL(r_std)                                               :: Dg                  !! Quadratic mean diameter of the stand (cm)
+    REAL(r_std)                                               :: bm_difference       !! the difference between self-thinning biomass
+                                                                                     !! and that due to environmental mortality
+    REAL(r_std)                                               :: difference          !! the difference between the self-thinning
+                                                                                     !! density
+                                                                                     !! and the true density (individuals per m**2)
+    REAL(r_std), DIMENSION(npts,nvm)                          :: st_dens             !! the self-thinning density of the stand
+                                                                                     !! (individuals per m**2)
+    REAL(r_std), DIMENSION(npts,nvm)                          :: st_mortality        !! biomass killed due to self-thinning density
+    REAL(r_std), DIMENSION(npts,nvm)                          :: d_mortality         !! biomass killed due to the environment
+    REAL(r_std)                                               :: delta_biomass       !! Net biomass increase for the previous
+                                                                                     !! year @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std)                                               :: vigour              !! Growth efficiency, an indicator of tree
+                                                                                     !! vitality, used to calculate mortality
+    REAL(r_std)                                               :: mortality_greff     !! Mortality rate derived by growth
+                                                                                     !! efficiency @tex $(year^{-1})$ @endtex
+    REAL(r_std)                                               :: mortality           !! Mortality (fraction of trees that is
+                                                                                     !! dying per time step)
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)        :: check_intern        !! Contains the components of the internal
+                                                                                     !! mass balance chech for this routine
+                                                                                     !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                :: closure_intern      !! Check closure of internal mass balance
+                                                                                     !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                :: pool_start, pool_end!! Start and end pool of this routine
+                                                                                     !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std)                                               :: temp 
+    LOGICAL                                                   :: lconverged          !! Checking for loop convergence
+    REAL(r_std), DIMENSION(ncirc)                             :: target_st_kill      !! How many trees from each circumference
+                                                                                     !! class we would like to kill.
+                                                                                     !! @tex $(trees m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                             :: true_st_kill        !! How many trees from each circumference
+                                                                                     !! class that we actually killed.
+                                                                                     !! @tex $(trees m^{-2})$ @endtex
+    REAL(r_std)                                               :: excess_ind          !! THe difference between the amount of
+                                                                                     !! trees we want to kill and how many we
+                                                                                     !! can actually kill based on our
+                                                                                     !! circ_class distribution.
+                                                                                     !! @tex $(trees m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                          :: veget_cov_max_begin     !! temporary storage of veget_cov_max to check area conservation
+
+!_ ================================================================================================================================
+   
+
+   IF (printlev.GE.3) WRITE(numout,*) 'Entering mark_to_kill'
+
+ !! 1. Initialize
+ 
+   !! 1.1 Initialize local printlev
+   !printlev_loc=get_printlev('mark_to_kill')
+
+   !! 1.2 Initialize check for mass balance closure
+   IF (err_act.GT.1) THEN
+
+      check_intern = zero
+      pool_start = zero
+      DO ipar = 1,nparts
+         DO iele = 1,nelements
+            DO icir = 1,ncirc
+             
+               !  Initial biomass pool
+               pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                    circ_class_biomass(:,:,icir,ipar,iele) * &
+                    circ_class_n(:,:,icir) * veget_cov_max(:,:)
+
+            ENDDO
+         ENDDO
+      ENDDO
+   
+      !! 1.3 Initialize check for area conservation
+       veget_cov_max_begin(:,:) = veget_cov_max(:,:)
+
+    ENDIF ! err_act.GT.1
+
+    !! 1.4 Initialize variables
+    d_mortality(:,:)=zero
+    st_mortality(:,:)=zero
+
+
+ !! 2. 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 ivm = 2,nvm ! loop plant functional types
+
+      was_killed(:) = .FALSE.
+      IF ( natural(ivm) ) THEN
+         
+         !! 2.2 Kill natural PFTs when running STOMATE without DGVM
+
+         !! 2.2.1 Kill PFTs
+         !  Kill PFTs but not in the first year because one year
+         !  is needed to fill the long-term and seasonal variables.
+         !  Therefore no leaves are grown in the first year. As
+         !  long as the plant has never grown leaves, ::rue_longterm
+         !  keeps its initial value of 1. Note that the logic of
+         !  this statement differs from the original verison that
+         !  was used for the resource limited allocation where the
+         !  carbohydrate reserves pool was treated differently than
+         !  in the functional allocation.
+         WHERE ( PFTpresent(:,ivm) .AND. &
+              (rue_longterm(:,ivm) .NE. un) .AND. & 
+              (SUM(circ_class_biomass(:,ivm,:,icarbres,icarbon)*circ_class_n(:,ivm,:),2) .LE. min_stomate .AND. & 
+              SUM(circ_class_biomass(:,ivm,:,ilabile,icarbon)*circ_class_n(:,ivm,:),2) .LE. min_stomate .AND. &
+              SUM(circ_class_biomass(:,ivm,:,ileaf,icarbon)*circ_class_n(:,ivm,:),2) .LE. min_stomate ) .AND. & 
+              SUM(circ_class_n(:,ivm,:),2) .GT. zero)
+
+            was_killed(:) = .TRUE.
+           
+         ENDWHERE         
+
+         ! If the density of a forest goes below a certain level,
+         ! the forest dies off. The density limit is referred to
+         ! in Bellasen et al 2010.
+         ! NOTE: this is currently the only mechanism that can kill
+         ! unmanaged forest.         
+         IF(is_tree(ivm))THEN
+                 
+            ! The set-up does not allow for species/management
+            ! changes. Simulate a stand replacing disturbance.
+            WHERE ( PFTpresent(:,ivm) .AND. &
+                 (SUM(circ_class_n(:,ivm,:),2) .LE. dens_target(ivm)*ha_to_m2))
+
+               was_killed(:) = .TRUE.
+                             
+            ENDWHERE
+        
+
+         ENDIF ! checking for trees
+
+         ! Debug
+         IF(printlev_loc>4)THEN
+            IF(is_tree(ivm))THEN
+               DO ipts=1,npts
+                  IF( PFTpresent(ipts,ivm) .AND. &
+                       (SUM(circ_class_n(ipts,ivm,:)) .LE. dens_target(ivm)*ha_to_m2))THEN
+                     
+                     WRITE(numout,*) 'Killing PFT, ipts: ',ivm,ipts
+                     WRITE(numout,*) 'Forest density too low'
+                     WRITE(numout,*) 'circ_class_n(ipts,ivm,:)',circ_class_n(ipts,ivm,:)
+                     WRITE(numout,*) 'dens_target(ivm)*ha_to_m2',dens_target(ivm)*ha_to_m2
+                  ENDIF
+
+               
+               ENDDO
+            ENDIF
+
+            DO ipts=1,npts
+               IF ( PFTpresent(ipts,ivm) .AND. &
+                    (rue_longterm(ipts,ivm) .NE. un) .AND. & 
+                    (SUM(circ_class_biomass(ipts,ivm,:,icarbres,icarbon)) .LE. min_stomate .AND. & 
+                    SUM(circ_class_biomass(ipts,ivm,:,ilabile,icarbon)) .LE. min_stomate .AND. &
+                    SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)) .LE. min_stomate ) .AND. & 
+                    SUM(circ_class_n(ipts,ivm,:)) .GT. zero)THEN
+
+                  WRITE(numout,*) 'Killing PFT, ipts: ',ivm,ipts
+                  WRITE(numout,*) 'No roots, leaves, labile pool.'
+                  WRITE(numout,*) 'circ_class_n(ipts,ivm,:)',SUM(circ_class_n(ipts,ivm,:))
+                  WRITE(numout,*) 'Reserve pool',SUM(circ_class_biomass(ipts,ivm,:,icarbres,icarbon))
+                  WRITE(numout,*) 'Labile pool',SUM(circ_class_biomass(ipts,ivm,:,ilabile,icarbon))
+                  WRITE(numout,*) 'Leaves',SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon))
+                 
+               ENDIF
+            ENDDO
+         ENDIF
+         !-
+
+         !! 2.3 Bookkeeping for PFTs that were killed
+         !  For PFTs that were killed, return biomass pools to litter
+         !  and update biomass pools to zero         
+         DO ipts = 1,npts
+
+            IF ( was_killed(ipts) ) THEN
+
+               ! If a PFT is killed, this just means that we mark all the
+               ! individuals for a natural death (all debris stays on site).
+               ! The killing actually takes place in lpj_gap.f90.
+               ! We have to do this differently for trees and non-trees, since
+               ! circ_class_n is not defined for non-trees.
+               IF(is_tree(ivm))THEN
+
+                  ! In reality, if the forest is managed we will not lose this
+                  ! wood. The forest would be harvested. So, let's put these into
+                  ! different pools depending on the management type.
+                  ifm=forest_managed(ipts,ivm)
+
+                  DO icir=1,ncirc
+                     circ_class_kill(ipts,ivm,icir,ifm,icut_clear)=&
+                          circ_class_n(ipts,ivm,icir)
+                  ENDDO
+
+               ELSE
+
+                  ! Since lpj_gap only knows about circ_class_kill and circ_class_biomass,
+                  ! we need to give values to icir=1 for these variables for grasses
+                  ! and crops so that the correct amount of biomass is killed.
+                  circ_class_kill(ipts,ivm,1,ifm_none,icut_clear) = &
+                       SUM(circ_class_n(ipts,ivm,:))
+
+               ENDIF ! is_tree(ivm)
+
+               !! 2.7 Print sub routine messages
+               IF (printlev_loc>=4) THEN
+
+                  WRITE(numout,*) 'kill: eliminated ',PFT_name(ivm)
+                  WRITE(numout,*) '  pft number: ',ivm
+                  WRITE(numout,*) '  at grid: ',ipts
+
+               ENDIF
+
+            ENDIF ! was_killed
+
+         ENDDO ! loop over points
+
+      ENDIF       ! PFT is natural
+
+      !! We need to enforce two different types of killing at the moment,
+      !! self-thinning and environmental mortality.  Self-thinning is due
+      !! to resouce competition in dense stands, and environmental
+      !! mortality is due to environmental stress.  Self-thinning is
+      !! only applicable to forests. 
+      DO ipts=1,npts
+
+         ! Don't waste time if the whole PFT was already scheduled to die,
+         ! or if the PFT is not here.
+         IF(was_killed(ipts))CYCLE
+         IF(.NOT.PFTpresent(ipts,ivm))CYCLE
+ 
+         !! let's calculate the self-thinning limit first
+         ! Number of indiviudals for trees and grasses are calculated 
+         ! differently
+         IF ( is_tree(ivm) ) THEN
+
+            ! Calculate the self-thinning density.  This is the target density
+            ! for which we will kill small trees until we reach.
+            ! there are unit conversions here because the forestry routines
+            ! prefer to work with trees per hectare.  I convert everything to
+            ! individuals per m**2 when I can. Self-thinning relationship
+            ! is fitted for the aboveground biomass/diameter so wood_to_qmdia 
+            ! should be used here (wood_to_dia_eff accounts for both the above
+            ! and belowground biomass).
+            Dg = wood_to_qmdia(circ_class_biomass(ipts,ivm,:,:,icarbon), &
+                 circ_class_n(ipts,ivm,:),ivm)
+
+!!$            Dg=zero
+!!$            diameters_temp(:) = &
+!!$                 wood_to_dia(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+!!$            diameters_temp(:) = &
+!!$                 diameters_temp(:)*m_to_cm
+!!$
+!!$            DO icir=1,ncirc
+!!$               Dg=Dg+circ_class_n(ipts,ivm,icir)*m2_to_ha*diameters_temp(icir)**2
+!!$            ENDDO
+
+            ! After a coppice at the end of the year, it's possible that all
+            ! the aboveground biomass is killed, but we still have individuals
+            ! because the roots are alive.  This means we don't have
+            ! a diameter, though, and therefore we will divide by zero
+            ! in the next block of code.  So we skip it, which is okay because
+            ! there will be no self-thinning in this case anyways.
+            IF(Dg .LT. min_stomate) CYCLE
+
+!!$            Dg=SQRT(Dg/(ind(ipts,ivm)*m2_to_ha))
+            st_dens(ipts,ivm)=Nmax(Dg*m_to_cm,ivm)*ha_to_m2
+
+            IF(printlev_loc>=4 .AND. ivm == test_pft .AND. &
+                 ipts == test_grid)THEN
+               WRITE(numout,*) 'Does self thinning happen?'
+               WRITE(numout,*) 'ipts,ivm: ',ipts,ivm
+               WRITE(numout,*) 'circ_class_n(ipts,ivm,:),st_dens(ipts,ivm): ',&
+                    SUM(circ_class_n(ipts,ivm,:)),st_dens(ipts,ivm)
+            ENDIF
+
+            IF(SUM(circ_class_n(ipts,ivm,:)) .GT. st_dens(ipts,ivm))THEN
+
+               IF(printlev_loc>=4 .AND. ivm == test_pft)THEN
+                  WRITE(numout,*) 'Self thinning is taking place.'
+                  WRITE(numout,*) 'ipts,ivm: ',ipts,ivm
+                  WRITE(numout,*) 'circ_class_n(ipts,ivm,:),st_dens(ipts,ivm): ',&
+                       SUM(circ_class_n(ipts,ivm,:)),st_dens(ipts,ivm)
+                  WRITE(numout,*) 'difference: ',&
+                       SUM(circ_class_n(ipts,ivm,:))-st_dens(ipts,ivm)
+                  WRITE(numout,*) 'st_dist: ',&
+                       st_dist(:)
+               ENDIF
+
+               ! Here is where we actually do the self thinning.  The number of
+               ! trees that we want to kill is the differnce between the
+               ! self thinning density and the true density.  Originally, we
+               ! killed only small trees until the densities were equal, the
+               ! reason being that self-thinning represents competition
+               ! driven mortality, and small trees are not able to compete for
+               ! resources (e.g. light) as well as larger trees.  However, this
+               ! seemed to cause strange results for both temperate and tropical
+               ! PFTs, so now we kill trees based on a user-defined distribution.
+               difference=SUM(circ_class_n(ipts,ivm,:)) - st_dens(ipts,ivm)
+               
+               ! This is what we want to kill.
+               target_st_kill(:)=st_dist(:)*difference
+
+               ! However, we may not have a sufficient number of trees in each class,
+               ! so we might have to adjust things a bit.
+               true_st_kill(:)=target_st_kill(:)
+
+               istep=1
+               DO
+
+                  lconverged=.FALSE.
+
+                  ! Find out how many indivuals we cannot kill with the current
+                  ! distribution.
+                  excess_ind=zero
+                  DO icir=1,ncirc
+                     IF(circ_class_n(ipts,ivm,icir) .LT. true_st_kill(icir))THEN
+                        excess_ind=excess_ind+true_st_kill(icir)-circ_class_n(ipts,ivm,icir)
+                        true_st_kill(icir)=circ_class_n(ipts,ivm,icir)
+                     ENDIF
+                  ENDDO
+
+                  IF(excess_ind .GT. zero)THEN
+                     ! We have something to redistribute.
+                     ! Put all of the excess in the first class which is not already completely
+                     ! killed.  If we add too much, we'll catch it in the next loop.
+                     DO icir=1,ncirc
+                        IF(circ_class_n(ipts,ivm,icir) .GT. true_st_kill(icir))THEN
+                           true_st_kill(icir)=true_st_kill(icir)+excess_ind
+                           excess_ind=zero
+                        ENDIF
+                     ENDDO
+                  ELSE
+                     ! Done.
+                     lconverged=.TRUE.
+                  ENDIF
+
+                  IF(lconverged)EXIT
+
+                  istep=istep+1
+                  IF(istep .GT. 100)THEN
+
+                     ! This is an arbitrary exit here, just to make sure
+                     ! we don't get stuck in an infinite loop.  We should
+                     ! exit before we ever get here.  Otherwise, you can increase
+                     ! the number in the if statement and try again.
+                     WRITE (numout,*) 'ipts, ivm : ',ipts,ivm
+                     CALL ipslerr_p (3,'stomate_mark_kill', &
+                          'Was not able to distribute self-thinning individuals!', &
+                          'See the comments at this part of the code for a solution','')
+
+                  END IF
+               ENDDO
+
+               circ_class_kill(ipts,ivm,:,ifm_none,icut_thin)=true_st_kill(:)
+
+               ! Debug
+               IF(printlev_loc>=4 .AND. ivm == test_pft)THEN
+                  WRITE(numout,*) 'After self thinning.'
+                  WRITE(numout,*) 'circ_class_kill: ',&
+                       circ_class_kill(ipts,ivm,:,ifm_none,icut_thin)
+               ENDIF
+               !-
+
+            ENDIF ! SUM(circ_class_n(ipts,ivm,:)) .GT. st_dens(ipts,ivm)
+
+            ! now let's look at environmental mortality.  The calculation of this
+            ! rate depends on if it is fixed for the whole simulation or if it's
+            ! allowed to respond to things like NPP.
+
+            !! 3.1 Use growth efficiency or constant mortality?
+            IF ( .NOT. ok_constant_mortality  ) THEN
+
+               ! Was the PFT alive last year?
+               IF ( ( lm_lastyearmax(ipts,ivm) .GT. min_stomate ) ) THEN
+
+                  !! 3.1.1 Estimate net biomass increment
+                  ! Estimate net biomass increment by subtracting turnover from
+                  ! last year's NPP.
+                  ! Note that npp_longterm is the longterm growth efficiency
+                  ! (NPP/LAI) to be fair to deciduous trees
+                  delta_biomass = MAX( npp_longterm(ipts,ivm) - &
+                       ( turnover_longterm(ipts,ivm,ileaf,icarbon) + &
+                       turnover_longterm(ipts,ivm,iroot,icarbon) + &
+                       turnover_longterm(ipts,ivm,ifruit,icarbon) + & 
+                       turnover_longterm(ipts,ivm,isapabove,icarbon) + &
+                       turnover_longterm(ipts,ivm,isapbelow,icarbon) ), zero)
+
+                  !! 3.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(ipts,ivm) * sla(ivm))
+
+                     
+               ELSE
+                 
+                  ! PFT does not exist or is dead
+                  vigour = zero
+
+               END IF ! ( lm_lastyearmax(ipts,ivm) .GT. min_stomate)
+
+               !! 3.1.3 Calculate growth efficiency mortality rate
+               mortality_greff = mortality_max(ivm) / &
+                    ( un + ref_mortality(ivm) * vigour )
+
+               ! Scale mortality rate (fraction, 0-1) by timesteps per year
+               mortality = MAX(mortality_min(ivm), mortality_greff) * dt/&
+                    one_year 
+
+            ELSE ! .NOT. ok_constant_mortality
+
+               !! 3.2 Use constant mortality accounting for the residence time
+               !! of each tree PFT
+
+               !  Scale mortality rate (fraction, 0-1) by timesteps per year
+               !  NOTE: the meaning of residence_time is very different between
+               !  the DOFOCO branch and the trunk. In the trunk biomass has no age
+               !  thus the residence time accounts for all forest dynamics including
+               !  self-thinning, pests, diseases and windthrow. In the DOFOCO branch
+               !  biomass does have an age and self-thinning is explicitly accounted
+               !  for, hence, the residence time should be much higher as it only
+               !  accounts for pest, diseases and windthrow. Even the latter is not
+               !  exact because as long as those disturbances are small scale they
+               !  are probably accounted for in the parametrization of self-thinning.
+               mortality = dt/(residence_time(ivm)*one_year)
+
+            ENDIF ! .NOT.  ok_constant_mortality
+
+            ! Debug
+            IF (printlev_loc>=4 .AND. ivm .EQ. test_pft) THEN
+               WRITE(numout,*) 'Mortality rate (0-1), ', mortality
+            ENDIF
+            !-
+
+            ! Now the mortality is just a percentage of the total biomass
+            ! on the site.  Since the main variable we output here is
+            ! circ_class_kill, we need to convert that biomass into the
+            ! number of individuals that are killed, and from which
+            ! circumference classes.  Mortality in excess of the self-thinning
+            ! mortality will preferenctially kill large trees, since they are
+            ! assumed to be less resistant to climatic change.
+
+            ! Aggregate over the different biomass components
+            DO ipar = 1,nparts
+
+               ! Aggregate over the different circumference classes
+               DO icir = 1,ncirc
+
+                  ! Mortality from self-thinning
+                  ! Note that the unit of st_mortaility (g C m-2 dt-1) differs
+                  ! from that of mortality (rate dt-1)
+                  st_mortality(ipts,ivm) = st_mortality(ipts,ivm) + &
+                       circ_class_kill(ipts,ivm,icir,ifm_none,icut_thin) * &
+                       circ_class_biomass(ipts,ivm,icir,ipar,icarbon)
+
+               ENDDO
+
+               ! Ageing and environmental mortality
+               ! Note that the unit of d_mortaility (g C m-2 dt-1) differs from
+               ! that of mortality (rate dt-1)
+               d_mortality(ipts,ivm) =  d_mortality(ipts,ivm) + &
+                    mortality * SUM(circ_class_biomass(ipts,ivm,:,ipar,icarbon)*&
+                    circ_class_n(ipts,ivm,:))
+
+            ENDDO ! ipar = 1,nparts
+
+            IF(printlev_loc>=4 .AND. test_pft .EQ. ivm .AND. &
+                 test_grid == ipts)THEN
+               WRITE(numout,*) 'Does mortality happen?'
+               WRITE(numout,*) 'ipts,ivm: ',ipts,ivm
+               WRITE(numout,*) 'd_mortality(ipts,ivm): ',d_mortality(ipts,ivm)
+               WRITE(numout,*) 'st_mortality(ipts,ivm): ',st_mortality(ipts,ivm)
+            ENDIF
+
+
+            !+++CHECK+++
+            ! There are different ways to combine these two sources of 
+            ! mortality. First one could argue that self-thinning
+            ! includes the background mortality. If background mortality
+            ! exceeds self-thinning this is due to the simplified way
+            ! background mortality is calculated. 
+            IF (st_mortality(ipts,ivm) .GT. min_stomate) THEN
+               
+               ! There is self-thinning mortality, no need to account
+               ! for environmental mortality
+               bm_difference = zero
+
+            ELSE
+
+               ! There is no self_thinning mortality, use the 
+               ! environmental mortality
+               bm_difference = d_mortality(ipts,ivm)
+
+            ENDIF
+
+!!$            ! The second way of looking at this is that the calculation of
+!!$            ! background mortality is reliable and should therefore always 
+!!$            ! be taken into account. In this reasoning self-thinning is
+!!$            ! considered part of the background mortality. Account for both
+!!$            ! but avoid double counting.
+!!$            bm_difference=d_mortality(ipts,ivm) - st_mortality(ipts,ivm)
+            !+++++++++++
+            
+
+            !+++CHECK +++
+            ! The question still stands of which trees we kill with the
+            ! environmental mortality.  If we only kill the biggest, we
+            ! lose a circ class within the first year sometimes.
+            IF(bm_difference .GT. zero )THEN
+
+               ! We know the total biomass that we want to kill.  Let's partition
+               ! this biomass among all our circumference classes based on an
+               ! exponential distribution which takes more biomass from
+               ! the largest class than the smallest.  There is a chance that we
+               ! will not have enough biomass to kill in some classes, in which
+               ! case we need to rearrange it a bit.
+
+               ! Debug
+               IF(printlev_loc>=4 .AND. ivm == test_pft .AND. &
+                    ipts == test_grid)THEN
+                  WRITE(numout,*) 'Mortality is taking place.'
+                  WRITE(numout,*) 'ipts,ivm: ',ipts,ivm
+                  WRITE(numout,*) 'bm_difference: ',bm_difference
+                  WRITE(numout,*) 'circ_class_kill(ipts,ivm,:,ifm_none,icut_thin): ', &
+                       circ_class_kill(ipts,ivm,:,ifm_none,icut_thin)
+                   WRITE(numout,*) 'circ_class_n(ipts,ivm,:): ', &
+                        circ_class_n(ipts,ivm,:)
+               ENDIF
+               !-
+
+               CALL distribute_mortality_biomass( bm_difference, &
+                    death_distribution_factor(ivm), circ_class_n(ipts,ivm,:), &
+                    circ_class_biomass(ipts,ivm,:,:,icarbon), &
+                    circ_class_kill(ipts,ivm,:,ifm_none,icut_thin) )
+
+               IF(printlev_loc>=4 .AND. ivm == test_pft .AND. &
+                    ipts == test_grid)THEN
+                  WRITE(numout,*) 'after circ_class_kill(ipts,ivm,:,ifm_none,icut_thin): ', &
+                       circ_class_kill(ipts,ivm,:,ifm_none,icut_thin)
+                  WRITE(numout,*) 'circ_class_n(ipts,ivm,:): ', &
+                       circ_class_n(ipts,ivm,:)
+               ENDIF
+
+           ENDIF ! bm_difference .GT. zero
+
+         ELSE ! IF(is_tree(ivm))
+
+            ! we don't seem to use self thinning for grasses, since grasses have
+            ! a constant density of 1/m**2.  This is the original code for the
+            ! mortality.  Notice that it doesn't actually do anything, due to
+            ! Sebastiaan's changes and CHECK statement, so I will leave it
+            ! commented out for now.
+
+            ! one thing I will set is
+            ! circ_class_kill(ipts,ivm,1,ifm_none,icut_thin) and
+            ! circ_class_biomass(:,:,1,:,:), since if we decide to
+            ! use grass/crop mortality later on we will use these variables
+            ! to tell lpj_gap how much biomass to actually kill.
+            circ_class_kill(ipts,ivm,1,ifm_none,icut_thin)=zero
+
+!!$             IF ( ok_dgvm .OR. .NOT. ok_constant_mortality) THEN
+!!$
+!!$                ! +++CHECK+++
+!!$                ! For grasses, if last year's NPP is very small (less than 10 gCm^{-2}year{-1})
+!!$                ! the grasses completely die. Grasses and crops are deciduous so in the first
+!!$                ! year they have no leaves. Consequently npp_longterm is less then
+!!$                ! ::npp_longterm_init. At the beginning of the second year when rue_longterm is
+!!$                ! no longer 1, the PFT is killed immediatly. The IF statement needs to be refined
+!!$                ! to properly allow for this type of PFT killing.
+!!$                ! The more fundamental and conceptual question is whether we want to kill grasses?
+!!$                ! Unless we simulate desertification, it is not clear why we would kill the grass
+!!$                ! most likely to replace it by ... grass. Because grass has hardly any biomass it
+!!$                ! seem unlikely that killing the grass will affect the C-fluxes.
+!!$                ! For both reasons i.e. the technical and conceptual, it was decided NOT to kill
+!!$                ! the grass PFTs
+!!$                IF ( PFTpresent(ipts,ivm) .AND. ( npp_longterm(ipts,ivm) .LE. npp_longterm_init ) ) THEN
+!!$
+!!$                   ! ORIGINAL code - see above to justify the change
+!!$                   !!$mortality = un
+!!$                   mortality = zero
+!!$
+!!$                END IF
+!!$                ! +++++++++++
+!!$
+!!$                ! Update biomass and litter pools
+!!$                DO ielem = 1,nelements
+!!$
+!!$                   DO ipart = 1, nparts
+!!$
+!!$                      IF ( PFTpresent(ipts,ivm) ) THEN
+!!$
+!!$                         d_mortality(ipts,ivm) =  mortality * biomass(ipts,ivm,ipart,ielem)
+!!$                         bm_to_litter(ipts,ivm,ipart,ielem) = bm_to_litter(ipts,ivm,ipart,ielem) + &
+!!$                              d_mortality(ipts,ivm)
+!!$                         biomass(ipts,ivm,ipart,ielem) = biomass(ipts,ivm,ipart,ielem) - &
+!!$                              d_mortality(ipts,ivm)
+!!$
+!!$                      END IF ! PFTpresent(ipts,ivm)
+!!$
+!!$                   ENDDO ! nparts
+!!$
+!!$                END DO ! nelements
+!!$
+!!$             ENDIF ! .NOT.ok_dgvm .AND. .NOT.ok_constant_mortality
+
+         ENDIF ! end check for trees
+
+      ENDDO ! loop over grid points
+
+   ENDDO ! loop over PFTs
+
+
+ !! 4. Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+       
+       ! 4.2 Check surface area
+       CALL check_surface_area("stomate_mark_to_kill", npts, veget_cov_max_begin, &
+            veget_cov_max,'pft')
+       
+       ! 4.3 Mass balance closure
+       ! 4.3.1 Calculate final biomass
+       pool_end = zero
+       DO ipar = 1,nparts
+          DO iele = 1,nelements
+             DO icir = 1,ncirc
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                     circ_class_biomass(:,:,icir,ipar,iele) * &
+                     circ_class_n(:,:,icir) * veget_cov_max(:,:)
+             ENDDO
+          ENDDO
+       ENDDO
+
+       !! 4.2 Calculate components of the mass balance
+       ! 4.3.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(:,:,ipoolchange,iele) = -un * (pool_end(:,:,iele) - &
+               pool_start(:,:,iele)) 
+       ENDDO
+   
+       closure_intern = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) WRITE(numout,*) &
+                  'check_intern, ivm, imbc, iele, ', imbc, &
+                  iele, check_intern(:,test_pft,imbc,iele)
+             !-
+             closure_intern(:,:,iele) = closure_intern(:,:,iele) + &
+                  check_intern(:,:,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 4.3.3 Check mass balance closure
+       CALL check_mass_balance("stomate_mark_to_kill", closure_intern, npts, &
+            pool_end, pool_start, veget_cov_max, 'pft')
+
+    ENDIF ! err_act.GT.1 
+   
+    IF (printlev>=4) WRITE(numout,*) 'Leaving mark_to_kill'
+
+ END SUBROUTINE mark_to_kill
+
+!! ================================================================================================================================
+!! SUBROUTINE  : distribute_mortality_biomass
+!!
+!>\BRIEF       Distributes biomass that is going to be killed by natural
+!!             causes (not self thinning) over circ classes.
+!!
+!! DESCRIPTION : Mortality is going to kill a certain amount of biomass
+!!               in forests every day.  Since we have circumference classes
+!!               now for our forests, we need to determine which classes
+!!               of trees will suffer from this environmental mortality.
+!!               Right now we are taking an exponential distribution.
+!!               Notice that this is NOT the same as redistributing biomass
+!!               after one of the circ classes becomes empty.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::circ_class_kill
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE distribute_mortality_biomass ( bm_difference, ddf_temp, circ_class_n_temp, &
+       circ_class_biomass_temp, circ_class_kill_temp )
+
+ !! 0. Variable and parameter description
+
+    !! 0.1 Input variables
+    REAL(r_std),INTENT(in)                       :: bm_difference           !! the biomass to distribute
+    REAL(r_std),INTENT(in)                       :: ddf_temp                !! the death_distribution_factor for this pft
+    REAL(r_std),DIMENSION(:),INTENT(in)          :: circ_class_n_temp       !! circ_class_n for this point/PFT
+    REAL(r_std),DIMENSION(:,:),INTENT(in)        :: circ_class_biomass_temp !! circ_class_biomass for this point/PFT
+ 
+   !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(ncirc), INTENT(OUT)   :: circ_class_kill_temp    !! Number of trees within a circ that needs
+                                                                            !! to be killed @tex $(ind m^{-2})$ @endtex
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(ncirc)               :: biomass_desired          !! The biomass that dies naturally
+    REAL(r_std), DIMENSION(ncirc)               :: death_distribution       !! The fraction of biomass taken from
+                                                                            !! each circ class for mortality.
+    LOGICAL                                     :: ldone                    !! Flag to exit a loop
+    REAL(r_std)                                 :: scale_factor             !!
+    REAL(r_std)                                 :: sum_total                !!
+    REAL(r_std)                                 :: leftover_bm              !! excess biomass that we need to kill
+    REAL(r_std)                                 :: living_biomass           !! summed biomass
+    REAL(r_std)                                 :: living_trees             !! summed biomass
+    INTEGER                                     :: icir
+
+!_ ================================================================================================================================
+
+    IF(ncirc == 1)THEN
+
+       ! This is the easy case.  All of our biomass will be taken from the only
+       ! circumference class that we have.
+       circ_class_kill_temp(1)=circ_class_kill_temp(1)+&
+            bm_difference/SUM(circ_class_biomass_temp(1,:))
+
+       RETURN
+    ENDIF
+
+    ! Here we assume an exponential distribution, arranged so that
+    ! ddf_temp times more biomass is taken from the largest circ class
+    ! compared to the smallest.
+    biomass_desired(:)=zero
+    death_distribution(:)=un
+    scale_factor=ddf_temp**(un/REAL(ncirc-1))
+    DO icir=2,ncirc
+       death_distribution(icir)=death_distribution(icir-1)*scale_factor
+    ENDDO
+    ! Normalize it
+    sum_total=SUM(death_distribution(:))
+    death_distribution(:)=death_distribution(:)/sum_total
+
+    ! Ideally, how much is killed from each class?  Be careful to include
+    ! what was killed in self-thinning here!  If we don't, we may try to kill
+    ! more biomass than is available in the loop below.
+    DO icir=1,ncirc
+       biomass_desired(icir)=death_distribution(icir)*bm_difference+&
+            circ_class_kill_temp(icir)*SUM(circ_class_biomass_temp(icir,:))
+    ENDDO
+
+    ! Right now, we know how much biomass we want to kill in each
+    ! class (biomass_desired).  What we will do now is to loop through
+    ! all the circ_classes and see if we have this much biomass
+    ! in each class still alive.  The total amount of vegetation still
+    ! alive is circ_class_n_temp(icir)-circ_class_kill_temp(icir).  If
+    ! this number of individuals cannot give us the total biomass that
+    ! we need, we keep track of a residual quantity, leftover_bm, which
+    ! we try to take from other circ_classes.  It's possible that we
+    ! will have to loop several times, which makes things more complicated.
+
+    ldone=.FALSE.
+    leftover_bm=zero
+    DO
+       DO icir=ncirc,1,-1
+
+          living_trees=circ_class_n_temp(icir)-circ_class_kill_temp(icir)
+          living_biomass=&
+               SUM(circ_class_biomass_temp(icir,:))*living_trees
+          biomass_desired(icir)=biomass_desired(icir)+leftover_bm
+
+          IF(living_biomass .LE. biomass_desired(icir))THEN
+
+             ! We can't get everything from this class, so we kill whatever is left.
+             leftover_bm=biomass_desired(icir)-living_biomass
+             biomass_desired(icir)=zero
+             circ_class_kill_temp(icir)=circ_class_kill_temp(icir)+&
+                  living_trees
+
+          ELSE
+
+             ! We have enough in this class.
+             circ_class_kill_temp(icir)=circ_class_kill_temp(icir)+&
+                  biomass_desired(icir)/SUM(circ_class_biomass_temp(icir,:))
+             biomass_desired(icir)=zero
+             leftover_bm=zero
+
+          ENDIF ! living_biomass .LE. biomass_desired(icir)
+
+       ENDDO ! loop over circ classes
+
+       IF(leftover_bm .LE. min_stomate) EXIT
+
+       ! it's possible that we don't have enough biomass left to kill what needs to be
+       ! killed, so everything just dies.  I cannot think of a case where this
+       ! would happen, though, since mortality should always be a percentage of the
+       ! total biomass.
+       ldone=.TRUE.
+       DO icir=1,ncirc
+
+          IF( circ_class_kill_temp(icir) .LT. circ_class_n_temp(icir) ) &
+               ldone=.FALSE. 
+
+       ENDDO
+
+       IF(ldone)EXIT ! All our biomass is dead, and we still want to kill more!
+
+    ENDDO
+
+  END SUBROUTINE distribute_mortality_biomass
+
+END MODULE stomate_mark_kill
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_phenology.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_phenology.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_phenology.f90	(revision 6412)
@@ -0,0 +1,2587 @@
+! =================================================================================================================================
+! MODULE        : stomate_phenology
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module manages the beginning of the growing season (leaf onset).
+!!      
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN          :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ =================================================================================================================================
+
+MODULE stomate_phenology
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+  USE sapiens_agriculture, ONLY: crop_planting
+  USE function_library, ONLY: wood_to_height_eff, calculate_c0_alloc, &
+       cc_to_biomass, check_surface_area, check_mass_balance
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC phenology,phenology_clear
+
+  ! first call
+  LOGICAL, SAVE                           :: firstcall_all_phenology = .TRUE.
+!$OMP THREADPRIVATE(firstcall_all_phenology)
+  LOGICAL, SAVE                           :: firstcall_hum = .TRUE.
+!$OMP THREADPRIVATE(firstcall_hum)
+  LOGICAL, SAVE                           :: firstcall_moi = .TRUE.
+!$OMP THREADPRIVATE(firstcall_moi)
+  LOGICAL, SAVE                           :: firstcall_humgdd = .TRUE.
+!$OMP THREADPRIVATE(firstcall_humgdd)
+  LOGICAL, SAVE                           :: firstcall_moigdd = .TRUE.
+!$OMP THREADPRIVATE(firstcall_moigdd)
+                                      
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : phenology_clear
+!!
+!>\BRIEF          Flags setting   
+!!
+!! DESCRIPTION  : This subroutine sets flags 
+!!                ::firstcall_all_phenology, ::firstcall_hum, ::firstcall_moi, ::firstcall_humgdd, 
+!!                ::firstcall_moigdd to .TRUE., and therefore activates section 1.1 of each 
+!!                subroutine which writes messages to the output. \n
+!!                This subroutine is called at the beginning of ::stomateLpj_clear in the 
+!!                ::stomate_lpj module.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::firstcall_all_phenology, ::firstcall_hum, ::firstcall_moi, ::firstcall_humgdd, 
+!!                ::firstcall_moigdd
+!!
+!! REFERENCE(S)  : None
+!!
+!! FLOWCHART     : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE phenology_clear
+    firstcall_all_phenology=.TRUE.
+    firstcall_hum=.TRUE.
+    firstcall_moi = .TRUE.
+    firstcall_humgdd = .TRUE.
+    firstcall_moigdd = .TRUE.
+  END SUBROUTINE phenology_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : phenology
+!!
+!>\BRIEF          This subroutine controls the detection of the beginning of the growing season 
+!!                (if dormancy has been long enough), leaf onset, given favourable biometeorological 
+!!                conditions, and leaf growth and biomass allocation when leaf biomass is low (i.e. 
+!!                at the start of the growing season.
+!!
+!! DESCRIPTION  : This subroutine is called by the module ::stomate_lpj and deals with the beginning of the  
+!!                growing season. First it is established whether the beginning of the growing season is
+!!                allowed. This occurs if the dormance period has been long enough (i.e. greater 
+!!                than a minimum PFT-dependent threshold, specified by ::lowgpp_time), 
+!!                AND if the last beginning of the growing season was a sufficiently long time ago 
+!!                (i.e. when the growing season length is greater than a minimum threshold, specified
+!!                by ::min_growthinit_time, which is defined in this module to be 300 days. \n
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                ::lowgpp_time is set for each PFT in ::stomate_data from a table of all
+!!                PFT values (::lowgpp_time_tab), which is defined in ::stomate_constants. \n
+!!                The growing season length is given by ::when_growthinit, which increases
+!!                by the stomate time-step at each call to this phenology module, except for when
+!!                leaf onset is detected, when it is set to 0. \n
+!!                If these two conditions are met, leaf onset occurs if the biometeorological 
+!!                conditions are also met. This is determined by the leaf onset models, which are
+!!                biome-specific. Each PFT is looped over (ignoring bare soil).
+!!                The onset phenology model is selected, (according to the parameter 
+!!                ::pheno_model, which is initialised in stomate_data), and called. \n
+!!                There are six leaf onset phenology models currently being used by ORCHIDEE. 
+!!                These are: 'hum' and 'moi', which are based exclusively on moisture conditions,
+!!                'humgdd' and 'moigdd', which are based on both temperature and moisture conditions,
+!!                'ncdgdd', which is based on a "chilling" requirement for leaf onset, and 
+!!                'ngd', which is based on the number of growing days since the temperature was 
+!!                above a certain threshold, to account for the end of soil frost.
+!!                Those models which are based mostly on temperature conditions are used for
+!!                temperate and boreal biomes, and those which include a moisture condition are used
+!!                for tropical biomes. More detail on the biometeorological conditions is provided
+!!                in the sections on the individual onset models. \n
+!!                The moisture conditions are based on the concept of plant "moisture availability".
+!!                This is based on the soil humidity (relative soil moisture), but is moderated by
+!!                the root density profile, as per the equation:
+!!                \latexonly
+!!                \input{phenology_moiavail_eqn1.tex}
+!!                \endlatexonly
+!!                \n
+!!                Although some studies have shown that the length of the photoperiod is important
+!!                in determining onset (and senescence) dates, this is not considered in the current
+!!                versions of the onset models (Krinner et al., 2005). \n
+!!                If conditions are favourable, leaf onset occurs (::plant_status is set to ibudbreak), 
+!!                ::when_growthinit is set to 0.0, and the growing season has begun. \n
+!!                Following the detection of leaf onset, biomass is allocated from the carbohydrate 
+!!                reserves equally to the leaves and roots IF the leaf biomass is lower than a minimum
+!!                threshold, which is calculated in this subroutine from the parameter
+!!                ::lai_initmin, divided by the specific leaf area (both of which are
+!!                PFT-dependent and set in ::stomate_constants). \n
+!!                Finally, if biomass is required to be allocated from the carbohydrate reserve 
+!!                because the leaf biomass is too low, the leaf age and leaf age distribution is 
+!!                re-set. In this case the youngest age class fraction is set to 1 and all other   
+!!                leaf age class fractions are set to 0. All leaf ages are set to 0. If there is 
+!!                no biomass in the carbohydrate reserve, leaf onset will not occur and the PFT
+!!                will disappear from the grid cell (Krinner et al., 2005). \n
+!!                This subrouting is called in ::stomate_lpj.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::biomass, 
+!!                        ::when_growthinit,
+!!                        ::leaf age distribution
+!!                        ::leaf fraction
+!!
+!! REFERENCE(S) :
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{phenology_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE phenology (npts, dt, PFTpresent, &
+       veget_cov_max, &
+       t2m_longterm, t2m_month, t2m_week, gpp, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       moiavail_month, moiavail_week, &
+       gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       plant_status, time_hum_min, &
+       leaf_frac, leaf_age, &
+       when_growthinit, atm_to_bm, circ_class_n, &
+       circ_class_biomass, KF, &
+       tau_eff_leaf, tau_eff_sap, tau_eff_root, age, &
+       everywhere, npp_longterm, lm_lastyearmax, k_latosa_adapt, &
+       cn_leaf_min_season, plant_n_uptake_daily)
+   
+ !! 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)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: veget_cov_max            !! "maximal" coverage fraction of a 
+                                                                                                !! PFT (LAI -> infinity) on ground 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: t2m_longterm         !! "long term" 2 meter reference 
+                                                                                                !! temperatures (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: t2m_month            !! "monthly" 2-meter temperatures 
+                                                                                                !! (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: t2m_week             !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: gpp                  !! daily gross primary productivity 
+                                                                                                !! @tex ($gC m^{-2} of 
+                                                                                                !! ground/day$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: maxmoiavail_lastyear !! last year's maximum moisture 
+                                                                                                !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: minmoiavail_lastyear !! last year's minimum moisture 
+                                                                                                !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: moiavail_month       !! "monthly" moisture availability 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: moiavail_week        !! "weekly" moisture availability 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: gdd_m5_dormance      !! growing degree days above a 
+                                                                                                !! threshold of -5 deg C (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: ncd_dormance         !! number of chilling days since 
+                                                                                                !! leaves were lost (days) 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                             :: tau_eff_root         !! Effective root turnover time that accounts
+                                                                                                !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                             :: tau_eff_sap          !! Effective sapwood turnover time that accounts
+                                                                                                !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                             :: tau_eff_leaf         !! Effective leaf turnover time that accounts
+                                                                                                !! waterstress (days)
+
+
+
+    !! 0.2 Ouput variables
+   
+    !! 0.3 Modified variables
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)        :: PFTpresent           !! PFT exists (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)    :: time_hum_min         !! time elapsed since strongest 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_midwinter        !! growing degree days, since midwinter (C) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: when_growthinit      !! how many days since the 
+                                                                               !! beginning of the growing season (days) 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: atm_to_bm            !! C and N taken up by carbohydrate 
+                                                                               !! reserve at the beginning of the 
+                                                                               !! growing season @tex ($gC m^{-2} 
+                                                                               !! of total ground/day$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ngd_minus5           !! number of growing days above a 
+                                                                               !! threshold of -5 deg C (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: plant_status         !! Growth and phenological status of the plant
+                                                                               !! Different stati are listed in constantes_var 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: everywhere           !! is the PFT everywhere in the grid box or 
+                                                                               !! very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: circ_class_n         !! Number of individuals in each circ class
+                                                                               !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: KF                   !! Scaling factor to convert sapwood mass
+                                                                               !! into leaf mass (m)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: k_latosa_adapt       !! Leaf to sapwood area adapted for long 
+                                                                               !! term water stress (m)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: leaf_frac            !! fraction of leaves in leaf age 
+                                                                               !! class (0-1, unitless)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: leaf_age             !! leaf age (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: age                  !! mean age (years)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: npp_longterm         !! "long term" net primary productivity
+                                                                               !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: lm_lastyearmax       !! last year's maximum leaf mass for each PFT 
+                                                                               !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)   :: circ_class_biomass   !! Biomass components of the model tree  
+                                                                               !! within a circumference class
+                                                                               !! class @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: cn_leaf_min_season   !! Minn leaf nitrogen concentration (C:N) of 
+                                                                               !! the growing season
+    REAL(r_std), DIMENSION(npts,nvm,nionspec), INTENT(inout) :: plant_n_uptake_daily !! Uptake of soil N by plants (units???)   
+ 
+    !! 0.4 Local variables
+    
+    REAL(r_std)                                        :: c0_alloc             !! Root to sapwood tradeoff parameter
+    LOGICAL(r_std), DIMENSION(npts)                     :: age_reset            !! does the leaf age distribution 
+                                                                               !! have to be reset? (true/false)
+    INTEGER(i_std)                                     :: ipts, ivm, ipar      !! indices (unitless)
+    INTEGER(i_std)                                     :: imbc, iele, icir     !! indices (unitless)
+    INTEGER(i_std)                                     :: iage                 !! indices (unitless)
+    REAL(r_std)                                        :: deficit              !! Carbon that needs to be taken from the
+                                                                               !! labile and or reserve pools 
+                                                                               !! @tex $(gC m^{-2})$ @endtex     
+    REAL(r_std)                                        :: LF                   !! Scaling factor to convert sapwood mass
+                                                                               !! into root mass (unitless)
+    REAL(r_std), DIMENSION(npts,nvm)                   :: histvar              !! controls the history output 
+                                                                               !! level - 0: nothing is written; 
+                                                                               !! 10: everything is written 
+                                                                               !! (0-10, unitless)
+    REAL(r_std)                                        :: bm_wanted            !! biomass we would like to have 
+                                                                               !! @tex ($gC m^{-2} of ground$) 
+                                                                               !! @endtex 
+    REAL(r_std)                                        :: bm_use               !! biomass we use (from 
+                                                                               !! carbohydrate reserve or from 
+                                                                               !! atmosphere) @tex ($gC m^{-2} of 
+                                                                               !! ground$) @endtex
+    REAL(r_std)                                        :: bm_wanted_n          !! biomass we would like to have 
+                                                                               !! @tex ($gN m^{-2} of ground$) 
+                                                                               !! @endtex 
+    REAL(r_std)                                        :: bm_use_n             !! nitrogen biomass we use (from  
+                                                                               !! labile or reserve pool @tex ($gN m^{-2} of  
+                                                                               !! ground$) @endtex
+    REAL(r_std)                                        :: cn_leaf_use          !! CN ratio used for allocationg biomass (gC/gN)
+    REAL(r_std), DIMENSION(ncirc)                      :: Cs_tree              !! Individual plant, sapwood compartment
+                                                                               !! @tex $(gC. tree^{-1})$ @endtex
+    REAL(r_std)                                        :: Cs_grass             !! Individual plant, sapwood compartment
+                                                                               !! @tex $(gC. ind^{-1})$ @endtex
+    REAL(r_std)                                        :: Cl_init              !! Initial leaf carbon required to start
+                                                                               !! the growing season
+                                                                               !! @tex $(gC tree^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                      :: Cl_wanted            !! Target stand-level leaf C biomass to 
+                                                                               !! sustain allometric balance.
+                                                                               !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std)                                        :: Cr_init              !! Initial root carbon required to start
+                                                                               !! the growing season
+                                                                               !! @tex $(gC tree^{-1})$ @endtex
+    REAL(r_std)                                        :: lm_min               !! minimum leaf mass @tex ($gC 
+                                                                               !! m^{-2} of ground$) @endtex 
+    REAL(r_std), DIMENSION(ncirc)                      :: height_eff           !! Effective tree height calculated from 
+                                                                               !! allometric 
+                                                                               !! relationships (m) but total biomass (for
+                                                                               !! allocation calculations)
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements) :: check_intern         !! Contains the components of the internal
+                                                                               !! mass balance chech for this routine
+                                                                               !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)         :: closure_intern       !! Check closure of internal mass balance
+                                                                               !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)         :: pool_start           !! Start and end pool of this routine 
+                                                                               !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)         :: pool_end             !! Start and end pool of this routine 
+                                                                               !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                      :: temp_share           !! A weighting factor based on the biomass in a 
+                                                                               !! circ class @tex - @endtex
+    REAL(r_std), DIMENSION(ncirc)                      :: temp_share_bis       !! Temporary variable to store the share
+                                                                               !! of biomass of each circumference class
+                                                                               !! to the total biomass
+    REAL(r_std)                                        :: bm_use_circ          !! biomass we use for a given circ class  
+                                                                               !! $) @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                   :: veget_cov_max_begin      !! temporary storage of veget_cov_max to check 
+                                                                               !! area conservation
+    REAL(r_std)                                        :: reduction            !! Reduction factor to account for possible 
+                                                                               !! nitrogen 
+                                                                               !! limitation on carbon allocation (unitless)
+    REAL(r_std), DIMENSION(ncirc)                      :: overspending         !! Although there is enough C, this C cannot 
+                                                                               !! be allocated because there is not enough N 
+                                                                               !! @tex $(gC tree^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nparts,nelements)           :: tmp_bm               !! Stand level biomass 
+                                                                               !! tex $(gC.m^{-2})$ @endtex
+    REAL(r_std)                                        :: bm_use_correction    !! Ratio between the carbon required for leaf and 
+                                                                               !! root phenology and the carbon available in the
+                                                                               !! reserve pools (unitless)
+!_ ================================================================================================================================
+
+    IF (printlev>=2) WRITE(numout,*) 'Entering phenology'
+
+    !! 1. Write current values to history file
+
+    ! Current values for ::when_growthinit 
+    CALL xios_orchidee_send_field("WHEN_GROWTHINIT",when_growthinit)
+    CALL histwrite_p (hist_id_stomate, 'WHEN_GROWTHINIT', itime, &
+         when_growthinit, npts*nvm, horipft_index)
+
+    ! Set and write values for ::PFTpresent
+    WHERE(PFTpresent)
+       histvar=un
+    ELSEWHERE
+       histvar=zero
+    ENDWHERE
+    CALL xios_orchidee_send_field("PFTPRESENT",histvar)
+    CALL histwrite_p (hist_id_stomate, 'PFTPRESENT', itime, &
+         histvar, npts*nvm, horipft_index)
+
+    ! Set and write values for gdd_midwinter
+    WHERE(gdd_midwinter.EQ.undef)
+       histvar=val_exp
+    ELSEWHERE
+       histvar=gdd_midwinter
+    ENDWHERE
+    CALL xios_orchidee_send_field("GDD_MIDWINTER",histvar)
+    CALL histwrite_p (hist_id_stomate, 'GDD_MIDWINTER', itime, &
+         histvar, npts*nvm, horipft_index)
+
+    ! Set and write values for gdd_m5_dormance
+    WHERE(gdd_m5_dormance.EQ.undef)
+       histvar=val_exp
+    ELSEWHERE
+       histvar=gdd_m5_dormance
+    ENDWHERE
+    CALL xios_orchidee_send_field('GDD_M5_DORMANCE',histvar)
+    CALL histwrite_p (hist_id_stomate, 'GDD_M5_DORMANCE', itime, &
+         histvar, npts*nvm, horipft_index)
+
+    ! Set and write values for ncd_dormance
+    WHERE(ncd_dormance.EQ.undef)
+       histvar=val_exp
+    ELSEWHERE
+       histvar=ncd_dormance
+    ENDWHERE
+    CALL xios_orchidee_send_field("NCD_DORMANCE",histvar)
+    CALL histwrite_p (hist_id_stomate, 'NCD_DORMANCE', itime, &
+         histvar, npts*nvm, horipft_index)
+
+
+    !! 2. first call
+    !! 2.1 Initialize check for mass balance closure
+    !  The mass balance is calculated at the end of this routine
+    !  in section 6
+    !  Initial biomass pool
+    IF (err_act.GT.1) THEN
+
+       check_intern(:,:,:,:) = zero
+       pool_start(:,:,:) = zero
+       DO iele = 1,nelements
+
+          ! atm_to_bm has as intent inout, the variable 
+          ! accumulates carbon over the course of a day. 
+          ! Use the difference between start and the end of 
+          ! this routine
+          check_intern(:,:,iatm2land,iele) = - un * &
+               atm_to_bm(:,:,iele) * veget_cov_max(:,:) * dt
+          DO ipar = 1,nparts
+             DO icir = 1,ncirc
+                ! Initial biomass pool
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                     (circ_class_biomass(:,:,icir,ipar,iele) * &
+                     circ_class_n(:,:,icir) * veget_cov_max(:,:))
+             ENDDO
+          ENDDO
+
+       ENDDO
+
+       pool_start(:,:,initrogen) = pool_start(:,:,initrogen) + &
+            (plant_n_uptake_daily(:,:,iammonium) + plant_n_uptake_daily(:,:,initrate)) * &
+            veget_cov_max(:,:) 
+
+       !! 2.2 Initialize check for surface area conservation
+       !  Veget_max is a INTENT(in) variable and can therefore
+       !  not be changed during the course of this subroutine
+       !  Check it anyway, in case the intent get changed.
+       veget_cov_max_begin(:,:) = veget_cov_max(:,:)
+
+       ENDIF ! err_act.GT.1
+
+    !! 2.3 Initialize local printlev
+    !printlev_loc=get_printlev('phenology')
+
+    !! 2.4 Output messages 
+    !  giving the setting of the ::always_init
+    !  and ::min_growthinit_time parameters.
+    IF (firstcall_all_phenology) THEN
+
+       firstcall_all_phenology = .FALSE.
+
+       ! Debug
+       IF (printlev_loc>=3) 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
+       ENDIF
+       !-
+
+    ENDIF
+
+    !! 2.5 Update labile nitrogen pool from soil nitrogen uptake
+    ! Calculation of plant_uptake in nitrogen_dynamics is now borrowed 
+    ! from OCN-P, which should allow us to avoid negative N_uptake values.  
+
+    DO ipts = 1,npts
+
+       DO ivm = 1,nvm
+
+          IF(SUM(plant_n_uptake_daily(ipts,ivm,:)) .GT. zero) THEN
+
+             IF (SUM( (circ_class_biomass(ipts,ivm,:,ilabile,initrogen) + &
+                  circ_class_biomass(ipts,ivm,:,icarbres,initrogen)) * &
+                  circ_class_n(ipts,ivm,:)) .GT.zero ) THEN
+
+                ! There are trees
+                IF ( is_tree(ivm) ) THEN
+
+                   ! Calculate the shares of ilabile
+                   temp_share_bis(:) = ((circ_class_biomass(ipts,ivm,:,ilabile,initrogen) + &
+                        circ_class_biomass(ipts,ivm,:,icarbres,initrogen)) * &
+                        circ_class_n(ipts,ivm,:))/&
+                        ((SUM(circ_class_biomass(ipts,ivm,:,ilabile,initrogen) + &
+                        circ_class_biomass(ipts,ivm,:,icarbres,initrogen))* &
+                        circ_class_n(ipts,ivm,:)))
+                   temp_share_bis(ncirc) = zero
+                   temp_share_bis(ncirc) = 1 - SUM(temp_share_bis(:))
+
+                   ! Add the N that was taken up by the plant to its labile pool
+                   DO icir = 1,ncirc
+
+                      ! Make the distribution of plant_n_uptake_daily proportional 
+                      ! to the nitrogen. plant_n_uptake_daily is in gN m-2 divide by
+                      ! number of trees to get it in gN tree-1.
+                      circ_class_biomass(ipts,ivm,icir,ilabile,initrogen) = &
+                           circ_class_biomass(ipts,ivm,icir,ilabile,initrogen) + &
+                           (plant_n_uptake_daily(ipts,ivm,iammonium) + &
+                           plant_n_uptake_daily(ipts,ivm,initrate)) * &
+                           temp_share_bis(icir) / circ_class_n(ipts,ivm,icir)
+
+                   ENDDO
+
+                ELSE
+
+                   ! Grass or cropland
+                   circ_class_biomass(ipts,ivm,1,ilabile,initrogen) = &
+                        circ_class_biomass(ipts,ivm,1,ilabile,initrogen) + &
+                        (plant_n_uptake_daily(ipts,ivm,iammonium) + &
+                        plant_n_uptake_daily(ipts,ivm,initrate)) / &
+                        circ_class_n(ipts,ivm,1)
+
+                ENDIF ! tree, grass or crop
+
+                plant_n_uptake_daily(ipts,ivm,iammonium) = zero
+                plant_n_uptake_daily(ipts,ivm,initrate) = zero                
+
+             ELSE
+
+                WRITE(numout,*) 'ERROR: strange. There is n_uptake but there are &
+                     & no plants', plant_n_uptake_daily(ipts,ivm,initrate), &
+                     plant_n_uptake_daily(ipts,ivm,iammonium), &
+                     SUM(circ_class_biomass(ipts,ivm,:,ilabile,initrogen) * &
+                     circ_class_n(ipts,ivm,:)),ivm
+                CALL ipslerr_p(3,'stomate_phenology',&
+                     'Supossedly there is n_uptake but no plants',&
+                     'This should never happen - fix the problem','')
+
+             ENDIF ! There is plant biomass
+
+          ELSEIF ((plant_n_uptake_daily(ipts,ivm,iammonium) .LT. zero) .OR. &
+               (plant_n_uptake_daily(ipts,ivm,initrate) .LT. zero)) THEN
+
+             ! The problem needs to be solved where it 
+             ! is caused. That is to say nitrogen_dynamics in 
+             ! stomate_soilcarbon.f90
+             WRITE(numout,*) 'ERROR: plant_n_uptake_daily has negative values',&
+                  plant_n_uptake_daily(ipts,ivm,initrate),&
+                  plant_n_uptake_daily(ipts,ivm,iammonium)
+             CALL ipslerr_p (3,'phenology', &
+                  'Negative N_uptake values.','','')
+
+          ELSEIF ((plant_n_uptake_daily(ipts,ivm,iammonium) .EQ. zero) .OR. &
+               (plant_n_uptake_daily(ipts,ivm,initrate) .EQ. zero)) THEN
+
+             ! Nothing should be done. This test (.EQ.zero) makes sense
+             ! because n_uptake may have been set to zero in nitrogen_dynamics
+
+          ELSE
+
+             WRITE(numout,*) 'ERROR: overlooked a condition ',ipts,ivm,&
+                  plant_n_uptake_daily(ipts,ivm,initrate),&
+                  plant_n_uptake_daily(ipts,ivm,iammonium)
+             CALL ipslerr_p(3,'stomate_phenology',&
+                  'unexpected case in IF-statement',&
+                  'for n_uptake','')
+
+          ENDIF
+
+       ENDDO ! ivm
+
+    ENDDO ! ipts
+
+
+    !! 3. Detection of the beginning of the growing season 
+
+    !! 3.1 allow detection of the beginning of the growing season 
+    !  If dormance was long enough (i.e. when ::time_lowgpp, which 
+    !  is calculated in ::stomate_season, is above a certain 
+    !  PFT-dependent threshold, ::lowgpp_time, which is given in 
+    !  ::stomate_constants), AND the last beginning of growing season 
+    !  was a sufficiently long time ago (i.e. when ::when_growthinit, 
+    !  which is calculated in this module, is greater than 
+    !  ::min_growthinit_time, which is declared at the beginning of 
+    !  this module). If these conditions are met, allow_initpheno is 
+    !  set to TRUE. Each PFT is looped over.
+    DO ivm = 2,nvm
+
+       ! Debug
+       IF(printlev_loc>=4)THEN
+          DO ipts=1,npts
+             IF(ipts == test_grid .AND. ivm == test_pft)THEN
+                WRITE(numout,*) "Checking for senescence "
+                WRITE(numout,*) "when_growthinit: ",&
+                     when_growthinit(test_grid,test_pft)
+                WRITE(numout,*) "min_growthinit_time: ",&
+                     min_growthinit_time
+             ENDIF
+          ENDDO
+       ENDIF
+       !-
+
+       WHERE ( (when_growthinit(:,ivm) .GT. min_growthinit_time) .AND. &
+            ( (plant_status(:,ivm) .EQ. iprescribe) .OR. & 
+            (plant_status(:,ivm) .EQ. idormant) ) )
+
+          ! Change the values of ::allow_initpheno and ::senescence
+          plant_status(:,ivm) = ibudsavail
+
+       ENDWHERE
+
+       !! 3.2 increase the ::when_growthinit counter
+       WHERE (veget_cov_max(:,ivm) .GT. min_stomate)
+
+          !  The when_growtinit 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.
+          !  CAREFUL: as longs as the unit of dt is day, subsequent if-statements
+          !  using when_growthinit are correct. If the unit of dt would be changed
+          !  to seconds the IF-statements making use of when_growthinit are no
+          !  longer valid.
+          when_growthinit(:,ivm) = when_growthinit(:,ivm) + dt
+
+       ELSEWHERE
+
+          ! There is no vegetation. Hence, days since the start of the growing
+          ! season is set to zero. Only for the first day of the simulation 
+          ! when_growthinit was set to undef to enable the model growing 
+          ! evergreen PFTs starting from day 1.
+          when_growthinit(:,ivm) = zero
+
+       ENDWHERE
+
+    ENDDO
+    
+
+    !! 4. Leaf onset
+
+    ! The onset phenology model is selected, (according to the 
+    ! parameter ::pheno_model, which is initialised in stomate_data), 
+    ! and called. Each PFT is looped over (ignoring bare soil). 
+    ! If conditions are favourable, plant_status is set to ibudbreak
+    ! parameter used in all the differents models of phenology 
+    t_always = ZeroCelsius + t_always_add
+
+    DO ivm = 2,nvm ! Loop over # PFTs
+
+       SELECT CASE ( pheno_model(ivm) )
+
+       CASE ( 'hum' )
+
+          CALL pheno_hum (npts, ivm, PFTpresent, &
+               moiavail_month, moiavail_week, &
+               maxmoiavail_lastyear, minmoiavail_lastyear, &
+               plant_status)
+
+       CASE ( 'moi' )
+
+          CALL pheno_moi (npts, ivm, PFTpresent, &
+               time_hum_min, &
+               moiavail_month, moiavail_week, &
+               plant_status)
+
+       CASE ( 'ncdgdd' )
+
+          CALL pheno_ncdgdd (npts, ivm, PFTpresent, &
+               ncd_dormance, gdd_midwinter, &
+               t2m_month, t2m_week, plant_status)
+
+       CASE ( 'ngd' )
+
+          CALL pheno_ngd (npts, ivm, PFTpresent, ncd_dormance, &
+               ngd_minus5, t2m_month, t2m_week, plant_status)
+
+       CASE ( 'humgdd' )
+
+          CALL pheno_humgdd (npts, ivm, PFTpresent, &
+               gdd_m5_dormance, maxmoiavail_lastyear, minmoiavail_lastyear, &
+               t2m_longterm, t2m_month, t2m_week, &
+               moiavail_week, moiavail_month, &
+               plant_status)
+
+       CASE ( 'moigdd' )
+
+          CALL pheno_moigdd (npts, ivm, PFTpresent, &
+               gdd_m5_dormance, time_hum_min, &
+               t2m_longterm, t2m_month, t2m_week, &
+               moiavail_week, moiavail_month, &
+               plant_status)
+
+       CASE ( 'none' )
+
+          ! no action
+
+       CASE default
+
+          WRITE(numout,*) 'phenology: don''t know how to treat this PFT.'
+          WRITE(numout,*) '  number: (::j)',ivm
+          WRITE(numout,*) '  phenology model (::pheno_model(ivm)) : ', pheno_model(ivm)
+          CALL ipslerr_p(3,'stomate phenology','Cannot treat this PFT','','')
+
+       END SELECT
+
+    ENDDO
+
+  !! 5. Leaf growth and biomass allocation when leaf biomass is low.
+    
+    !  Leaves start to grow if biometeorological conditions are 
+    !  favourable (plant_statuse = ibudbreak)
+    DO ivm = 2,nvm ! Loop over # PFTs
+
+       age_reset(:) = .FALSE.
+       bm_use = zero
+       bm_wanted = zero
+ 
+       DO ipts = 1,npts
+
+          IF ( plant_status(ipts,ivm) .EQ. ibudbreak) THEN
+
+             ! NOTE. Plant_status will be updated in stomate_season
+             ! If it would be updated here, the plant status would
+             ! move from ibudsavail to icanopy within a single day.
+             ! As a consequence the value ibudbreak would never occur
+             ! in stomate_season and therefore several phenological
+             ! counters would not be activated or reset. Hence we
+             ! update the status from ibudsavail to ibudbreak in this
+             ! routine, keep ibudbreak for the rest of this day in
+             ! stomate_lpj, pass it to stomate for the next day,
+             ! where it is passed to stomate_season and updated to 
+             ! icanopy the day after ibudbreak.
+
+             ! We might need the c0_alloc factor, so let's
+             ! calculate it now.
+             c0_alloc = calculate_c0_alloc(ipts, ivm, tau_eff_root(ipts,ivm), &
+                  tau_eff_sap(ipts,ivm))
+ 
+             ! The equations assume that there is no leaf or root
+             ! biomass left. Check whether this assumption is 
+             ! violated
+             IF ( (SUM(circ_class_biomass(ipts,ivm,:,ileaf,initrogen)).GT.min_stomate) .OR. &
+                  (SUM(circ_class_biomass(ipts,ivm,:,iroot,initrogen)).GT.min_stomate) .OR. &
+                  (SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)).GT.min_stomate) .OR. &
+                  (SUM(circ_class_biomass(ipts,ivm,:,iroot,icarbon)).GT.min_stomate) ) THEN
+
+                WRITE(numout,*) 'There is leaf and/or root carbon that should '//&
+                     'not be here, something could have gone wrong in senescence'
+                WRITE(numout,*) 'ivm, ',ivm
+                WRITE(numout,*) 'equation assumes ileaf and iroot are zero', &
+                     SUM(circ_class_biomass(ipts,ivm,:,ileaf,initrogen)), &
+                     SUM(circ_class_biomass(ipts,ivm,:,iroot,initrogen)), &
+                     SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)), &
+                     SUM(circ_class_biomass(ipts,ivm,:,iroot,icarbon))
+                CALL ipslerr_p (3,'stomate_phenology',&
+                     'There is leaf or root carbon that should not be here',&
+                     'No carbon expected when phenology is needed',&
+                     'The problem could be caused during senescence')
+
+             ELSE
+
+                ! Initialize
+                Cl_init = zero
+                Cr_init = zero
+                Cs_tree(:) = zero
+                Cl_wanted(:) = zero
+                height_eff(:) = zero
+                                
+                ! Minimum biomass is calculated 
+                ! Use the following equation:
+                ! \latexonly
+                ! \input{phenology_lm_min_eqn2.tex}
+                ! \endlatexonly
+                ! \n 
+                ! The allocation scheme does not need this parameter
+                ! but without it larger seedlings would have to be
+                ! described. The model runs with only one set of 
+                ! allometric equations so a seedling has very little 
+                ! leaves and needles. By setting lm_min the seedling 
+                ! gets more leaves than prescribed by the allometric 
+                ! relations. The first days/weeks GPP will be higher
+                ! c is allocated to the wood and the seedling becomes
+                ! bigger. The next time phenology is used, the seedling 
+                ! already has enough wood to establish a functional
+                ! canopy when the allometric relationships are 
+                ! respected. In short lm_min could be removed from the
+                ! code but then we would have to introduce dynamic
+                ! allometric relationships that account for the 
+                ! allometric differences between seedlings and mature 
+                ! trees.
+                lm_min = lai_initmin(ivm) / sla(ivm)
+
+                ! The minimum leaf biomass is prescribed by ::lm_min 
+                ! which in turn is basically prescribed through 
+                ! ::lai_initmin. However, lm_min could exceed the leaf 
+                ! mass that is required to respect the allometric 
+                ! relationships therefore this leaf biomass should be 
+                ! calculated. Calculate the allocation factors see 
+                ! stomate_prsecribe.f90 and stomate_prescribe.f90 for 
+                ! more details 
+                LF = c0_alloc * KF(ipts,ivm)
+
+                !+++CHECK+++
+                ! Given the IF-statement above, the first condition should
+                ! never be met.
+                ! Calculate the C/N ratio
+                IF(SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)) .GT. min_stomate) THEN
+
+                   tmp_bm(:,:) = cc_to_biomass(npts,ivm,&
+                        circ_class_biomass(ipts,ivm,:,:,:),&
+                        circ_class_n(ipts,ivm,:))
+                   ! Calculate actual C/N ratio of leaves
+                   cn_leaf_use = tmp_bm(ileaf,icarbon) / &
+                        tmp_bm(ileaf,initrogen)
+                !+++++++++++
+                ELSE
+                   ! +++CHECK+++
+                   ! Two options: the seasonal minmum or a prescribed minimum
+                   cn_leaf_use=cn_leaf_min_season(ipts,ivm)
+!!$                  cn_leaf_use=cn_leaf_min(ivm)
+                   age_reset(npts) = .TRUE.
+                   ! +++++++++++
+                ENDIF
+                !+++++++++++
+
+                IF ( is_tree(ivm) ) THEN
+
+                   ! Calculate the stand structure (gC tree-1)
+                   Cs_tree(:) = &
+                        ( circ_class_biomass(ipts,ivm,:,isapabove,icarbon) + &
+                        circ_class_biomass(ipts,ivm,:,isapbelow,icarbon) )
+                   height_eff(:) = wood_to_height_eff(&
+                        circ_class_biomass(ipts,ivm,:,:,icarbon), ivm)
+
+                   ! Calculate the leaves and roots that need to be grown. See 
+                   ! stomate_growth_fun_alloc.f90 for more details. lm_min
+                   ! is defined in gC m-2 so when using circ_class_biomass 
+                   ! (g tree-1) we need to account for the the number of trees
+                   ! Note that the units for Cl_init and Cr_init are gC m-2
+                   if(SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1),1) .GT. min_stomate) then  
+                    Cl_init = MAX(lm_min, SUM((KF(ipts,ivm) * Cs_tree(:) / &
+                        height_eff(:)) * circ_class_n(ipts,ivm,:)))
+                    Cr_init = Cl_init/LF
+                    Cl_wanted(:) = Cs_tree(:) * KF(ipts,ivm)/height_eff(:)
+                   else
+                    Cl_init = zero
+                    Cr_init = zero
+                    Cl_wanted(:) = zero
+                   endif
+
+                ELSEIF (.NOT. is_tree(ivm) .AND. natural(ivm) ) THEN
+
+                   ! Only used when grasses are described as a mixed phenology.
+                   ! In ORCHIDEE-CAN grasses are simulated as an evergreen
+                   ! biome. Calculate the available biomass in sapwood (gC m-2)
+                   Cs_grass = circ_class_biomass(ipts,ivm,1,isapabove,icarbon)*&
+                        circ_class_n(ipts,ivm,1)
+
+                   ! Calculate structure of the crop/grassland i.e. the leaves 
+                   ! and roots that need to be grown see 
+                   ! stomate_growth_fun_alloc.f90 for more details 
+                   ! Note that the units for Cl_init and Cr_init are gC m-2. 
+                   ! For grasses :: heigh_init(ivm) is the minimal height_eff 
+                   ! and is therefore used at the start of growing season 
+                   ! (it could be considered the height_eff of Cs)
+                   Cl_init = MAX(lm_min, Cs_grass * KF(ipts,ivm))
+                   Cr_init = Cl_init/LF
+
+                ELSEIF ( .NOT. natural(ivm) ) THEN
+
+                   ! Crops get planted the day that plant_status is ibudbreak. 
+                   ! If not, too much of there reserves are used before the 
+                   ! start of the growing season.
+                   CALL crop_planting(npts, dt, ipts, ivm, &
+                        veget_cov_max, PFTpresent, c0_alloc, when_growthinit, &
+                        time_hum_min, everywhere, plant_status, &
+                        circ_class_n, KF, leaf_frac, age, &
+                        npp_longterm, lm_lastyearmax, &
+                        circ_class_biomass, atm_to_bm, k_latosa_adapt)
+
+                ENDIF
+
+                ! Debug
+                IF(printlev_loc>=4)THEN
+                   WRITE(numout,*) "Phenology, getting ready to allocate"//&
+                        " new leaves for trees - nonesensical for crops"
+                   WRITE(numout,*) "i,j: ",ipts,ivm
+                   WRITE(numout,*) "height_eff(:) ",height_eff(:)
+                   WRITE(numout,*) "Cs_tree(:) ",Cs_tree(:)
+                   WRITE(numout,*) "Cl_init carbon ",Cl_init
+                   WRITE(numout,*) "Cr_init carbon ",Cr_init
+                   WRITE(numout,*) "LF(ipts,ivm) ",LF
+                   WRITE(numout,*) "KF(ipts,ivm) ",KF(ipts,ivm)
+                   WRITE(numout,*) "lm_min ",lm_min
+                ENDIF
+                !-
+
+                ! Calculate stand level biomass
+                tmp_bm(:,:) = cc_to_biomass(npts,ivm,&
+                     circ_class_biomass(ipts,ivm,:,:,:),&
+                     circ_class_n(ipts,ivm,:))
+
+                ! Finalize allocation for phenological growth
+                IF ( natural(ivm) ) THEN
+
+                   ! Both trees and grasslands (but grasses are simulated
+                   ! as evergreen PFTs in ORCHIDEE-CAN) are considered to 
+                   ! be natural. Because grasses and trees live on during 
+                   ! dormance they will consume reserves and turnover may 
+                   ! continue. There is no guarantee that the required 
+                   ! amounts of C for phenology are present and can be used. 
+                   ! This is now being checked. Calculate how much biomass 
+                   ! is wanted/required. Substract leaf and root biomass
+                   ! to improve the mass balance closure (but the values
+                   ! should less than min_stomate - see if-statement above).
+                   bm_wanted = MAX(Cl_init - &
+                        tmp_bm(ileaf,icarbon), zero) + &
+                        MAX(Cr_init - tmp_bm(iroot,icarbon), zero)
+                   bm_wanted_n = MAX(Cl_init/cn_leaf_use - &
+                        tmp_bm(ileaf,initrogen), zero) + &
+                        MAX(Cr_init*fcn_root(ivm)/cn_leaf_use - &
+                        tmp_bm(iroot,initrogen), zero)
+
+                   ! Specific setting for forced phenology
+                   ! 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 labile pool. This only occurs 
+                   ! if the parameter ::always_init. Fill-up the reserve pools
+                   ! such that there is enough carbon and nitrogen to support
+                   ! phenology. Once the reserve pools are filled, continue with
+                   ! the phenological code.
+                   IF (always_init) THEN
+
+                      IF (tmp_bm(ilabile,icarbon) + &
+                           tmp_bm(icarbres,icarbon) .LT. bm_wanted ) THEN
+
+                         ! Force phenology - close carbon balance
+                         atm_to_bm(ipts,ivm,icarbon) = atm_to_bm(ipts,ivm,icarbon) + &
+                              (bm_wanted - (tmp_bm(ilabile,icarbon) + &
+                              tmp_bm(icarbres,icarbon) )) / dt
+                         tmp_bm(ilabile,icarbon) = &
+                              tmp_bm(ilabile,icarbon) + &
+                              ( bm_wanted - (tmp_bm(ilabile,icarbon) + &
+                              tmp_bm(icarbres,icarbon)) )
+                         
+                      ENDIF
+
+                      IF (tmp_bm(ilabile,initrogen) + &
+                           tmp_bm(icarbres,initrogen) .LT. bm_wanted_n ) THEN
+                         
+                         ! Force phenology - close nitrogen balance
+                         atm_to_bm(ipts,ivm,initrogen) = atm_to_bm(ipts,ivm,initrogen) + &
+                              (bm_wanted_n - (tmp_bm(ilabile,initrogen) + &
+                              tmp_bm(icarbres,initrogen) )) / dt
+                         tmp_bm(ilabile,initrogen) = &
+                              tmp_bm(ilabile,initrogen) + &
+                              (bm_wanted_n - (tmp_bm(ilabile,initrogen) + &
+                              tmp_bm(icarbres,initrogen) ))
+                         
+                      ENDIF
+                      
+                   ENDIF ! always_init
+
+                   ! The biomass available to use is set to be the minimum of 
+                   ! 90% of the biomass of the labile pool (if carbon not taken 
+                   ! from the atmosphere), and the wanted biomass. 
+                   bm_use = MIN( 0.9 *(tmp_bm(ilabile,icarbon) + &
+                        tmp_bm(icarbres,icarbon)), bm_wanted)
+
+                   ! Calculate C/N ratio
+                   ! Since, we do not have leafs during budbreak, we tried to
+                   ! calculate cn_leaf_use with below formulation.
+                   ! However, this gave problems for the deciduous trees.  
+                   ! cn_leaf_use = ((LF*bm_use)/(1+LF) + (LF*bm_use*fcn_root(ivm)) / &
+                   !     ((1+LF)*LF)) / (0.9 * (SUM(circ_class_n(ipts,ivm,:) * &
+                   !     (circ_class_biomass(ipts,ivm,:,ilabile,initrogen) + &
+                   !     circ_class_biomass(ipts,ivm,:,icarbres,initrogen)))))
+
+        
+                   ! Debug
+                   IF(printlev_loc>=4)THEN
+                      WRITE(numout,*) 'cn_leaf_use, ', cn_leaf_use
+                   ENDIF
+                   !-
+   
+                   ! Avoid crazy cn ratios
+                   IF(cn_leaf_use .GT. cn_leaf_max(ivm)) THEN
+                      
+                      ! Use a threshold instead of the calculated value
+                      cn_leaf_use = cn_leaf_max(ivm)
+                      
+                   ENDIF
+
+                   ! If impose_cn=y we are sure we can fullfil the carbon
+                   ! demand because irrespective of how much nitrogen we 
+                   ! have for the moment we can just take whatever nitrogen
+                   ! is missing from the atmosphere
+                   IF (impose_cn) THEN
+
+                      ! Calculate how much nitrogen we need to satisfy the
+                      ! carbon demand for budburst.
+                      ! => bm_use_n = Cl_int/cn_leaf_use + Cr_init*fcn_root/cn_leaf_use
+                      ! => Cl_init = (LF*bm_use)/(1+LF)
+                      ! => Cr_init = Cl_init/LF
+                      bm_use_n = (LF*bm_use)/(1+LF)/cn_leaf_use + &
+                           (LF*bm_use*fcn_root(ivm))/((1+LF)*LF*cn_leaf_use)
+
+                      ! Check if phenology would exhaust the reserve pools
+                      ! for nitrogen. Using over 90% of the reserve pools
+                      ! is considered as too demanding as it would
+                      ! exhausting the reserve pools (gC m-2).
+                      deficit = 0.9 * (SUM(circ_class_n(ipts,ivm,:) * &
+                           (circ_class_biomass(ipts,ivm,:,ilabile,initrogen) + &
+                           circ_class_biomass(ipts,ivm,:,icarbres,initrogen))) - &
+                           bm_use_n)
+
+                      IF (deficit .LT. zero) THEN
+
+                         ! Calculate the shares of ilabile
+                         temp_share(:) = (circ_class_biomass(ipts,ivm,:,ilabile,initrogen)*&
+                              circ_class_n(ipts,ivm,:))/&
+                              SUM(circ_class_biomass(ipts,ivm,:,ilabile,initrogen)*&
+                              circ_class_n(ipts,ivm,:))
+                         temp_share(ncirc) = zero
+                         temp_share(ncirc) = 1 - SUM(temp_share(:))
+                      
+                         ! The C/N ratio is imposed. To allocate the carbon
+                         ! to new leaves we will have to take the N from
+                         ! somewhere else. Increase the existing pool so it 
+                         ! will be possible to satistfy the demand (gC m-2). 
+                         atm_to_bm(ipts,ivm,initrogen) = atm_to_bm(ipts,ivm,initrogen) - &
+                              deficit
+                         
+                         ! Add the same amount of nitrogen to tmp_bm (g N m-2)
+                         ! because that is the variable we will use to calculate
+                         ! the allocation of the ilabile and icarbres. There is no need to
+                         ! add the deficit to circ_class_biomass(ilabile) because the value
+                         ! from tmp_bm(ilabile) will copies into circ_class_biomass(ilabile)
+                         ! -after unit convertion- towards the end of this subroutine.
+                         tmp_bm(ilabile,initrogen) = tmp_bm(ilabile,initrogen) - &
+                              deficit
+!!$                         circ_class_biomass(ipts,ivm,:,ilabile,initrogen) = &
+!!$                              circ_class_biomass(ipts,ivm,:,ilabile,initrogen) - &
+!!$                              deficit * temp_share(:) / circ_class_n(ipts,ivm,:)
+                         
+                      ENDIF
+                      
+                   ENDIF
+
+                   ! Debug
+                   IF(printlev_loc>=4)THEN
+                      WRITE(numout,*) 'bm_use based on carbon, ',bm_use
+                      WRITE(numout,*) 'bm_use based on nitrogen, ',&
+                           0.9 * cn_leaf_use * (1+LF) * &
+                           (tmp_bm(ilabile,initrogen) + tmp_bm(icarbres,initrogen)) / &
+                           (LF+fcn_root(ivm)) 
+                   ENDIF
+                   !-
+
+                   ! We now have a first estimate of the carbon we can use
+                   ! in support of budburst (gC m-2). Calculate how much carbon we
+                   ! can allocate to budburst if we use 90% of the labile and
+                   ! reserve nitrogen. This is the final bm_use: it accounts for
+                   ! the allometry, the available carbon and the available nitrogen.
+                   ! If impose_cn=y the carbon- and nitrogen-based estimate of the
+                   ! carbon we can allocate to budburst will be identical.
+                   ! => bm_use_n = Cl_int/cn_leaf_use + Cr_init*fcn_root/cn_leaf_use
+                   ! => Cl_init = (LF*bm_use)/(1+LF)
+                   ! => Cr_init = Cl_init/LF
+                   ! Assume bm_use_n = 0.9 * (labile_n + carbres_n)
+                   ! => substitute and solve for bm_use
+                   ! => 0.9 * cn_leaf_use * (1+LF) * &
+                   !      (tmp_bm(ilabile,initrogen) + tmp_bm(icarbres,initrogen)) / &
+                   !      (LF+fcn_root)
+                   bm_use = MIN(bm_use, 0.9 * cn_leaf_use * (1+LF) * &
+                         (tmp_bm(ilabile,initrogen) + tmp_bm(icarbres,initrogen)) / &
+                         (LF+fcn_root(ivm)))
+                   bm_use_n = (LF*bm_use)/(1+LF)/cn_leaf_use + &
+                           (LF*bm_use*fcn_root(ivm))/((1+LF)*LF*cn_leaf_use)
+
+                   ! Debug
+                   IF(printlev_loc>=4)THEN
+                      WRITE(numout,*) 'bm_use based on carbon and nitrogen, ', &
+                           bm_use, bm_use_n
+                   ENDIF
+                   !-
+
+                   ! Consistency checking. Check whether we are not overspending. 
+                   ! bm_use_correction should be 1 or less. If not, something 
+                   ! unexpected happened
+                   bm_use_correction = bm_use / (0.9* &
+                        (tmp_bm(ilabile,icarbon) + tmp_bm(icarbres,icarbon)))
+                   IF (bm_use_correction .GT. un+min_stomate) THEN
+                      WRITE(numout,*) 'bm_use, bm_use_correction', &
+                           ipts,ivm,bm_use,bm_use_correction
+                      WRITE(numout,*) 'not enough carbon'
+                      CALL ipslerr_p(3,'Unexpected - not enough carbon','','','')
+                   ENDIF
+                   bm_use_correction = bm_use_n / (0.9 * &
+                        (tmp_bm(ilabile,initrogen) + tmp_bm(icarbres,initrogen)))
+                   IF (bm_use_correction .GT. un+min_stomate) THEN
+                      WRITE(numout,*) 'bm_use, bm_use_correction', &
+                        ipts,ivm,bm_use,bm_use_correction
+                      WRITE(numout,*) 'not enough nitrogen'
+                      CALL ipslerr_p(3,'Unexpected - not enough nitrogen','','','')
+                   ENDIF
+
+                   ! Debug
+                   IF(printlev_loc>=4)THEN
+                      WRITE(numout,*) 'bm_use based on carbon and nitrogen, ', &
+                           bm_use, bm_use_n
+                   ENDIF
+                   !-
+                   
+                   ! Calculate how much carbon will be left in the labile and reserve
+                   ! pool.
+                   IF (bm_use .LT. tmp_bm(ilabile,icarbon)) THEN
+
+                      ! All carbon needed in support of the budbreak will come
+                      ! from the labile pool
+                      tmp_bm(ilabile,icarbon) = tmp_bm(ilabile,icarbon) - bm_use
+
+                   ELSE
+
+                      ! There is not enough carbon in the labile pool. Use
+                      ! 90% of the labile pool, leave 10% and take the rest
+                      ! from the crabres
+                      tmp_bm(icarbres,icarbon) = tmp_bm(icarbres,icarbon) + &
+                           0.9 * tmp_bm(ilabile,icarbon) - bm_use
+                      tmp_bm(ilabile,icarbon) = 0.1 * tmp_bm(ilabile,icarbon) 
+
+                      ! Check whether we are not overspending
+                      IF (tmp_bm(icarbres,icarbon) .LT. -min_stomate) THEN
+
+                         WRITE(numout,*) 'Error: icarbres became negative'
+                         WRITE(numout,*) 'tmp_bm(icarbres,icarbon) ',&
+                              tmp_bm(icarbres,icarbon)
+                         CALL ipslerr_p(3,'Error icrabes became negative',&
+                              'something went wrong when calculating bm_use',&
+                              'check stomate_phenology','')
+            
+                      ENDIF
+
+                   ENDIF
+
+                   ! Calculate how much nitrogen will be left in the labile and reserve
+                   ! pool.
+                   IF (bm_use_n .LT. tmp_bm(ilabile,initrogen)) THEN
+
+                      ! All carbon needed in support of the budbreak will come
+                      ! from the labile pool
+                      tmp_bm(ilabile,initrogen) = tmp_bm(ilabile,initrogen) - bm_use_n
+
+                   ELSE
+
+                      ! There is not enough carbon in the labile pool. Use 90%
+                      ! from the labile pool, leave 10% and take the rest from 
+                      ! the icarbres pool
+                      tmp_bm(icarbres,initrogen) = tmp_bm(icarbres,initrogen) + &
+                           0.9 * tmp_bm(ilabile,initrogen) - bm_use_n
+                      tmp_bm(ilabile,initrogen) = 0.1 * tmp_bm(ilabile,initrogen)
+
+                      ! Check whether we are not overspending
+                      IF (tmp_bm(icarbres,initrogen) .LT. -min_stomate) THEN
+
+                         WRITE(numout,*) 'Error: icarbres became negative'
+                         WRITE(numout,*) 'tmp_bm(icarbres,initrogen) ',&
+                              tmp_bm(icarbres,initrogen)
+                         CALL ipslerr_p(3,'Error icrabes became negative',&
+                              'something went wrong when calculating bm_use_n',&
+                              'check stomate_phenology','')
+                         
+                      ENDIF
+
+                   ENDIF
+
+                   ! Share of each circumference class to the total biomass
+                   temp_share(:) = Cl_wanted(:) / SUM(Cl_wanted(:))
+                   temp_share(ncirc) = zero
+                   temp_share(ncirc) = 1 - SUM(temp_share(:))
+
+                   ! Calculate the biomass components for the different circ classes  
+                   DO icir =1,ncirc
+
+                      ! If there is no biomass in this circ class, we'll skip it
+                      ! This should ALWAYS be the case for ncirc > 1 for grasses.
+                      IF (Cl_wanted(icir) .EQ. zero) CYCLE
+
+                      ! Biomass that will be allocated to this circumference
+                      ! class. Convert biomass to gC tree-1 so the allometric 
+                      ! relationships can be applied
+                      bm_use_circ = bm_use * temp_share(icir) / &
+                           circ_class_n(ipts,ivm,icir) 
+
+                      ! bm_use_circ is g C / tree for this circumference class. 
+                      ! These are the exact same units as circ_class_biomass.
+                      ! bm_use may differ from Cr_init and Cl_init, the final 
+                      ! allocation will depend on bm_use. Distribute bm_use 
+                      ! over leaves and roots following allometric 
+                      ! relationships. Cl_init and Cr_init take the same units 
+                      ! as bm_use i.e. gC tree-1
+                      ! (i) bm_use = Cl_incp + Cr_incp
+                      ! (ii) Cr_incp = (Cl_incp+Cl)/LF - Cr
+                      ! Substitue (ii) in (i) and solve for Cl_inc
+                      ! <=> Cl_incp = (LF*(b_incp+Cr)-Cl)/(1+LF)
+                      ! Because this is the start of the growing season, 
+                      ! Cr = Cl = 0. Allocate carbon to the leaves and roots in 
+                      ! the given circumference class 
+                      Cl_init = (LF * bm_use_circ)/(un + LF) 
+                      Cr_init = Cl_init/LF
+
+                      ! The sum of Cl_init and Cr_init should equal bm_use_circ 
+                      IF (bm_use_circ - Cl_init - Cr_init .LT. -min_stomate .OR. &
+                           bm_use_circ - Cl_init - Cr_init .GT. min_stomate) THEN
+
+                         WRITE(numout,*) 'over or underspending carbon '//&
+                              'in phenology, ', &
+                              bm_use_circ - Cl_init - Cr_init
+                         CALL ipslerr_p (3,'stomate_phenology',&
+                              'over or underspening carbon in phenology','','')
+
+                      ENDIF
+
+                      ! Distribute the biomass over the leaves and roots 
+                      ! (gC tree-1) Since this whole loop is already over 
+                      ! circ class, Cl_init and Cr_init are exactly what 
+                      ! we need.
+                      circ_class_biomass(ipts,ivm,icir,ileaf,icarbon) = Cl_init
+                      circ_class_biomass(ipts,ivm,icir,ileaf,initrogen) = &
+                           Cl_init / cn_leaf_use 
+                      circ_class_biomass(ipts,ivm,icir,iroot,icarbon) = Cr_init
+                      circ_class_biomass(ipts,ivm,icir,iroot,initrogen) = &
+                           Cr_init * fcn_root(ivm) / cn_leaf_use
+
+                      ! Use this opportunity to redistribute both carbon and nitrogen in
+                      ! the labile and reserve pool. This will likely result in more
+                      ! consistent cn calculations further down this subroutine
+                      circ_class_biomass(ipts,ivm,icir,ilabile,:) = &
+                           tmp_bm(ilabile,:) * temp_share(icir) / &
+                           circ_class_n(ipts,ivm,icir)
+                      circ_class_biomass(ipts,ivm,icir,icarbres,:) = &
+                           tmp_bm(icarbres,:) * temp_share(icir) / &
+                           circ_class_n(ipts,ivm,icir)
+                      
+                      ! Debug
+                      IF(printlev_loc>=4)THEN
+                         WRITE(numout,*) "circ_class_biomass(ipts,ivm,icir,ileaf,:):", &
+                              circ_class_biomass(ipts,ivm,icir,ileaf,:)
+                         WRITE(numout,*) "circ_class_biomass(ipts,ivm,icir,iroot,:):",&
+                              circ_class_biomass(ipts,ivm,icir,iroot,:)
+                         WRITE(numout,*) "circ_class_biomass(ipts,ivm,icir,ilabile,:):",&
+                              circ_class_biomass(ipts,ivm,icir,ilabile,:)
+                         WRITE(numout,*) "circ_class_biomass(ipts,ivm,icir,icarbres,:):",&
+                              circ_class_biomass(ipts,ivm,icir,icarbres,:)
+                      ENDIF
+                      !-
+
+                   ENDDO ! ncirc
+                   
+                   ! Set reset leaf age distribution (::age_reset) flag. 
+                   ! Default is TRUE.
+                   ! done later for better vectorization)
+                   age_reset(ipts) = .TRUE.
+
+                   ! Reset when_growthinit counter: start of the growing 
+                   ! season
+                   when_growthinit(ipts,ivm) = zero
+                   ! This was commented out, as it did not give constant CN
+                   ! ratios for impose_cn yes, and the carbon and nitrogen 
+                   ! leaf biomass moved in opposite directions 
+                   ! cn_leaf_min_season(ipts,ivm) = cn_leaf_max(ivm)
+
+                ELSEIF (.NOT. natural(ivm)) THEN
+                   
+                   ! This are crops and most that needs to
+                   ! be done was already done in crop_planting
+                   age_reset(ipts) = .TRUE.
+
+                   ! Reset when_growthinit counter: start of the growing 
+                   ! season
+                   when_growthinit(ipts,ivm) = zero
+
+                ELSE
+
+                   ! Undefined case
+                   WRITE(numout,*) 'Error: stomate_phenology '//&
+                        'ibudbreak is true but case is undefined'
+                   CALL ipslerr_p (3,'stomate_phenology', &
+                        'ibudbreak is true but case is undefined','','')
+                   
+                END IF ! Is tree(ivm) is natural(ivm)
+
+             ENDIF ! leaf and root biomass is zero
+             
+          ENDIF    ! plant_status is ibudbreak
+          
+       ENDDO      ! loop over grid points
+
+       ! Reset leaf age distribution where necessary (i.e. when 
+       ! age_reset is TRUE) simply say that everything is in the 
+       ! youngest age class. Set the youngest age class fraction 
+       ! to 1 and all other leaf age class fractions to 0.
+       WHERE ( age_reset(:) )
+
+          leaf_frac(:,ivm,1) = un
+
+       ENDWHERE
+
+       DO iage = 2, nleafages
+
+          WHERE ( age_reset(:) )
+
+             leaf_frac(:,ivm,iage) = zero
+
+          ENDWHERE
+
+       ENDDO ! nleafages
+
+       ! Ages - set all leaf ages to 0.
+       DO iage = 1, nleafages
+
+          WHERE ( age_reset(:) )
+
+             leaf_age(:,ivm,iage) = zero
+
+          ENDWHERE
+
+       ENDDO ! nleafages
+
+    ENDDO ! loop over # PFTs
+
+
+ !! 6. Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 6.2 Check surface area
+       CALL check_surface_area("stomate_phenology", npts, veget_cov_max_begin, &
+            veget_cov_max,'pft')
+
+       ! 6.3 Mass balance closure 
+       ! 6.3.1 Calculate final biomass
+       pool_end(:,:,:) = zero 
+       DO ipar = 1,nparts
+          DO iele = 1,nelements
+             DO icir = 1,ncirc
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                     (circ_class_biomass(:,:,icir,ipar,iele) * &
+                     circ_class_n(:,:,icir) * veget_cov_max(:,:))
+             ENDDO
+          ENDDO
+       ENDDO
+
+       ! 6.3.2 Calculate mass balance       
+       ! Common processes for icarbon and initrogen
+       DO iele=1,nelements
+          check_intern(:,:,iatm2land,iele) = check_intern(:,:,iatm2land,iele) + &
+               atm_to_bm(:,:,iele) * veget_cov_max(:,:) * dt
+          check_intern(:,:,ipoolchange,iele) = -un * (pool_end(:,:,iele) - &
+               pool_start(:,:,iele)) 
+       ENDDO
+
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             closure_intern(:,:,iele) = closure_intern(:,:,iele) + &
+                  check_intern(:,:,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 6.3.3 Check mass balance closure
+       CALL check_mass_balance("stomate_phenology", closure_intern, npts, pool_end, &
+            pool_start, veget_cov_max, 'pft')
+      
+    ENDIF ! err_act.GT.1
+
+    IF (printlev>=3) WRITE(numout,*) 'Leaving phenology'
+
+
+  END SUBROUTINE phenology
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_hum 
+!!
+!>\BRIEF          The 'hum' onset model initiate leaf onset based exclusively on moisture 
+!!                availability criteria. 
+!!                Currently no PFTs are assigned to this onset model.
+!!
+!! DESCRIPTION  : This model is for tropical biomes, where temperatures are high but moisture
+!!                might be a limiting factor on growth. It is based on leaf onset model 4a in 
+!!                Botta et al. (2000), which adopts the approach of Le Roux (1995). \n
+!!                Leaf onset occurs if the monthly moisture availability is still quite
+!!                low (i.e. lower than the weekly availability), but the weekly availability is 
+!!                higher than the critical threshold ::availability_crit (as it reacts faster), 
+!!                which indicates the weekly moisture availability is increasing.
+!!                OR if the monthly moisture availability is high enough (i.e. above the 
+!!                threshold value ::moiavail_always), leaf onset is initiated if this has not 
+!!                already happened. This allows vegetation in arid areas to respond to rapidly
+!!                changing soil moisture conditions (Krinner et al., 2005). \n
+!!                The critical weekly moisture availability threshold (::availability_crit), is
+!!                calculated in this subroutine, and is a function of last year's maximum and
+!!                minimum moisture availability and the PFT-dependent parameter
+!!                ::hum_frac, which specifies how much of last year's available 
+!!                moisture is required for leaf onset, as per the equation:
+!!                \latexonly
+!!                \input{phenology_moi_availcrit_eqn3.tex}
+!!                \endlatexonly
+!!                \n
+!!                ::hum_frac is set for each PFT in ::stomate_data from a table
+!!                which contains all the PFT values (::hum_frac_tab) in ::stomate_constants. \n
+!!                Last year's maximum and minimum moisture availability and the monthly and 
+!!                weekly moisture availability are  
+!!                The ::pheno_hum subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::plant_status - 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, ivm, PFTpresent, &
+       moiavail_month, moiavail_week, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       plant_status)
+
+    !
+    !! 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)                                             :: ivm                     !! 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
+    !
+    REAL(r_std),DIMENSION(npts,nvm), INTENT(inout)                         :: plant_status          !! Growth and phenological 
+                                                                                                    !! status of the plant
+                                                                                                    !! Different stati are listed 
+                                                                                                    !! in constantes_var
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                                            :: moiavail_always       !! critical monthly 
+                                                                                                    !! moisture availability - set 
+                                                                                                    !! for tree or grass 
+                                                                                                    !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                                           :: availability_crit     !! critical weekly moisture 
+                                                                                                    !! availability (0-1, unitless)
+    INTEGER(i_std)                                                         :: ipts                     !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering hum'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of onset model and the moisture availability 
+    !!     parameters for tree and grass
+    !
+
+    IF ( firstcall_hum .AND. printlev_loc>=2) 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(:,ivm) = .FALSE.
+
+    !
+    !! 1.3 check the critical value ::hum_frac is defined. If not, stop.
+    !
+
+    IF ( hum_frac(ivm) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'hum: hum_frac is undefined for PFT (::j)',ivm
+       CALL ipslerr_p(3,'stomate phenology','hum_frac is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical monthly moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(ivm) ) 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 ipts = 1, npts
+
+       IF ( PFTpresent(ipts,ivm) .AND. plant_status(ipts,ivm) .EQ. ibudsavail ) THEN
+
+          !! 2.1 Calculate the critical weekly moisture availability: depends linearly on the last year 
+          !! minimum and maximum moisture availabilities, and on the parameter ::hum_frac.
+
+          availability_crit(ipts) = minmoiavail_lastyear(ipts,ivm) + hum_frac(ivm) * &
+               ( maxmoiavail_lastyear(ipts,ivm) - minmoiavail_lastyear(ipts,ivm) )
+
+          !! 2.2 Determine if growing season should start (if so, plant_status = ibudbreak).
+          !!     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(ipts,ivm)  .GE. availability_crit(ipts) ) .AND. &
+               ( moiavail_month(ipts,ivm) .LT. moiavail_week(ipts,ivm) ) ) .OR. &
+               ( moiavail_month(ipts,ivm) .GE. moiavail_always ) ) THEN
+
+             plant_status(ipts,ivm) = ibudbreak
+
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving hum'
+
+  END SUBROUTINE pheno_hum
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_moi
+!!
+!>\BRIEF          The 'moi' onset model (::pheno_moi) initiates leaf onset based exclusively 
+!!                on moisture availability criteria. 
+!!                It is very similar to the 'hum' onset model but instead of the weekly moisture 
+!!                availability being higher than a constant threshold, the condition is that the 
+!!                moisture minimum happened a sufficiently long time ago. 
+!!                Currently PFT 3 (Tropical Broad-leaved Raingreen) is assigned to this model.
+!!
+!! DESCRIPTION  : This model is for tropical biomes, where temperatures are high but moisture
+!!                might be a limiting factor on growth. It is based on leaf onset model 4b in 
+!!                Botta et al. (2000).
+!!                Leaf onset begins if the plant moisture availability minimum was a sufficiently  
+!!                time ago, as specified by the PFT-dependent parameter ::hum_min_time 
+!!                AND if the "monthly" moisture availability is lower than the "weekly"
+!!                availability (indicating that soil moisture is increasing).
+!!                OR if the monthly moisture availability is high enough (i.e. above the threshold 
+!!                value ::moiavail_always), leaf onset is initiated if this has not already 
+!!                happened. \n
+!!                ::hum_min_time is set for each PFT in ::stomate_data, and is 
+!!                defined in the table ::hum_min_time_tab in ::stomate_constants. \n
+!!                ::moiavail_always is defined for both tree and grass in this subroutine 
+!!                (set to 1. and 0.6 respectively). \n
+!!                The ::pheno_moi subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): None
+!!        
+!! MAIN OUTPUT VARIABLE(S): ::plant_status - 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, ivm, PFTpresent, &
+       time_hum_min, &
+       moiavail_month, moiavail_week, &
+       plant_status)
+
+    !
+    !! 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)                               :: ivm             !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (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
+    !
+    REAL(r_std),DIMENSION(npts,nvm), INTENT(inout)           :: plant_status    !! Growth and phenological status of the plant
+                                                                                !! Different stati are listed in constantes_var
+
+    !
+    !! 0.3 Modified variables
+    !
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    INTEGER(i_std)                                           :: ipts                            !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering moi'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of onset model and the moisture availability 
+    !!     parameters for tree and grass
+    !
+
+    IF ( firstcall_moi .AND. printlev_loc>=3) 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(:,ivm) = .FALSE.
+
+    !
+    !! 1.3 check the critical value ::hum_min_time is definded. If not, stop
+    !
+
+    IF ( hum_min_time(ivm) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'moi: hum_min_time is undefined for PFT (:,ivm) ',ivm
+       CALL ipslerr_p(3,'stomate phenology','hum_min_time is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical monthly moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(ivm) ) 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 ipts = 1, npts
+
+       IF ( PFTpresent(ipts,ivm) .AND. plant_status(ipts,ivm) .EQ. ibudsavail ) THEN
+          
+          !! 2.1 Determine if growing season should start (if so plant_status = ibudbreak).
+          !!     The favorable season starts if the moisture minimum (::time_hum_min) was a sufficiently long 
+          !!     time ago, i.e. greater than the threshold specified by the parameter ::hum_min_time 
+          !!     and if the "monthly" moisture availability is lower than the "weekly"
+          !!     availability (indicating that soil moisture is increasing).
+          !!     OR if the monthly moisture availability is high enough (i.e. above the threshold value 
+          !!     ::moiavail_always), initiate the growing season if this has not happened yet.
+
+          IF  ( ( ( moiavail_week(ipts,ivm) .GT. moiavail_month(ipts,ivm) ) .AND. &
+               ( time_hum_min(ipts,ivm) .GT. hum_min_time(ivm) )    ) .OR. &
+               ( moiavail_month(ipts,ivm) .GE. moiavail_always )                     ) THEN
+             plant_status(ipts,ivm) = ibudbreak
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving moi'
+
+  END SUBROUTINE pheno_moi
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_humgdd
+!!
+!>\BRIEF          The 'humgdd' onset model initiates leaf onset based on mixed conditions of 
+!!                temperature and moisture availability criteria. 
+!!                Currently no PFTs are assigned to this onset model. 
+!!
+!! DESCRIPTION  : In this model the Growing Degree Day (GDD) model (Chuine, 2000) is combined 
+!!                with the 'hum' onset model (::pheno_hum), which has previously been described,
+!!                in order to account for dependence on both temperature and moisture conditions 
+!!                in warmer climates. \n. 
+!!                The GDD model specifies that daily temperatures above a threshold of -5  
+!!                degrees C are summed, minus this threshold, giving the GDD, starting from 
+!!                the beginning of the dormancy period (::time_lowgpp>0), i.e. since the leaves 
+!!                were lost. \n.
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                Leaf onset begins when the a PFT-dependent GDD-threshold is reached.
+!!                In addition there are temperature and moisture conditions.
+!!                The temperature condition specifies that the monthly temperature has to be 
+!!                higher than a constant threshold (::t_always) OR
+!!                the weekly temperature is higher than the monthly temperature.
+!!                There has to be at least some moisture. The moisture condition 
+!!                is exactly the same as the 'hum' onset model (::pheno_hum), which has already
+!!                been described. \n
+!!                The GDD (::gdd_m5_dormance) is calculated in ::stomate_season. GDD is set to 
+!!                undef if beginning of the growing season detected, i.e. when there is GPP 
+!!                (::time_lowgpp>0).
+!!                The parameter ::t_always is defined as 10 degrees C in this subroutine, 
+!!                as are the parameters ::moisture_avail_tree and ::moisture_avail_grass 
+!!                (set to 1 and 0.6 respectively), which are used in the moisture condition 
+!!                (see ::pheno_moi onset model description). \n
+!!                The PFT-dependent GDD threshold (::gdd_crit) is calculated as in the onset 
+!!                model ::pheno_humgdd, using the equation:
+!!                \latexonly
+!!                \input{phenology_hummoigdd_gddcrit_eqn4.tex}
+!!                \endlatexonly
+!!                \n
+!!                The three GDDcrit parameters (::gdd(ivm,*)) 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: plant_status - 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, ivm, PFTpresent, gdd, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       t2m_longterm, t2m_month, t2m_week, &
+       moiavail_week, moiavail_month, &
+       plant_status)
+
+    !
+    !! 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)                               :: ivm                     !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent              !! PFT exists (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: gdd                     !! growing degree days, calculated since 
+                                                                                        !! leaves have fallen (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: maxmoiavail_lastyear    !! last year's maximum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: minmoiavail_lastyear    !! last year's minimum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_longterm            !! "long term" 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month               !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week                !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_week           !! "weekly" moisture availability 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_month          !! "monthly" moisture availability 
+                                                                                        !! (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+    REAL(r_std),DIMENSION(npts,nvm), INTENT(inout)           :: plant_status            !! Growth and phenological status of the plant
+                                                                                        !! Different stati are listed in constantes_var
+
+    !
+    !! 0.3 Modified variables
+    !
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                             :: moiavail_crit                   !! critical moisture availability 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                             :: tl                              !! long term temperature (C)
+    REAL(r_std), DIMENSION(npts)                             :: gdd_crit                        !! critical GDD (C)
+    INTEGER(i_std)                                           :: ipts                               !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering humgdd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of the onset model, the values of the  
+    !!     moisture availability parameters for tree and grass, and the value of the 
+    !!     critical monthly temperature.
+    !
+
+    IF ( firstcall_humgdd .AND. printlev_loc>=4) 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(:,ivm) = .FALSE.
+
+    !
+    !! 1.3 check the critical values ::gdd and ::pheno_crit_hum_frac are defined.
+    !!     If not, stop.
+    !
+
+    IF ( ANY(pheno_gdd_crit(ivm,:) .EQ. undef) ) THEN
+
+       WRITE(numout,*) 'humgdd: pheno_gdd_crit is undefined for PFT (::j) ',ivm
+       CALL ipslerr_p(3,'stomate phenology','pheno_gdd_crit is undefined for this PFT','','')
+
+    ENDIF
+
+    IF ( hum_frac(ivm) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'humgdd: hum_frac is undefined for PFT (::j) ',ivm
+       CALL ipslerr_p(3,'stomate phenology','hum_frac is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(ivm) ) 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 ipts = 1, npts
+
+       IF ( PFTpresent(ipts,ivm) .AND. &
+            plant_status(ipts,ivm) .EQ. ibudsavail .AND. &
+            ( gdd(ipts,ivm) .NE. undef ) ) THEN
+
+          !! 2.1 Calculate the critical weekly moisture availability: depends linearly on the last year 
+          !! minimum and maximum moisture availabilities, and on the parameter ::hum_frac.,
+          !! (as in the ::pheno_hum model), as per the equation:
+
+          moiavail_crit(ipts) = minmoiavail_lastyear(ipts,ivm) + hum_frac(ivm) * &
+               ( maxmoiavail_lastyear(ipts,ivm) - minmoiavail_lastyear(ipts,ivm) )
+
+          !! 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(ipts) =  t2m_longterm(ipts) - ZeroCelsius
+          gdd_crit(ipts) = pheno_gdd_crit(ivm,1) + tl(ipts)*pheno_gdd_crit(ivm,2) + &
+               tl(ipts)*tl(ipts)*pheno_gdd_crit(ivm,3)
+          
+          !! 2.3 Determine if the growing season should start (plant_status = ibudbreak).
+          !!     - 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(ipts,ivm) .GE. gdd_crit(ipts) ) .AND. &
+               ( ( t2m_week(ipts) .GT. t2m_month(ipts) ) .OR. &
+               ( t2m_month(ipts) .GT. t_always )          ) .AND. &
+               ( ( ( moiavail_week(ipts,ivm)  .GE. moiavail_crit(ipts) ) .AND. &
+               ( moiavail_month(ipts,ivm) .LT. moiavail_crit(ipts) )        ) .OR. &
+               ( moiavail_month(ipts,ivm) .GE. moiavail_always )                   ) )  THEN
+             plant_status(ipts,ivm) = ibudbreak
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! End loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving humgdd'
+
+  END SUBROUTINE pheno_humgdd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_moigdd
+!!
+!>\BRIEF          The 'moigdd' onset model initiates leaf onset based on mixed temperature 
+!!                and moisture availability criteria.
+!!                Currently PFTs 10 - 13 (C3 and C4 grass, and C3 and C4 agriculture) 
+!!                are assigned to this model. 
+!!
+!! DESCRIPTION  : This onset model combines the GDD model (Chuine, 2000), as described for 
+!!                the 'humgdd' onset model (::pheno_humgdd), and the 'moi' model, in order 
+!!                to account for dependence on both temperature and moisture conditions in
+!!                warmer climates. \n
+!!                Leaf onset begins when the a PFT-dependent GDD threshold is reached.
+!!                In addition there are temperature and moisture conditions.
+!!                The temperature condition specifies that the monthly temperature has to be 
+!!                higher than a constant threshold (::t_always) OR
+!!                the weekly temperature is higher than the monthly temperature.
+!!                There has to be at least some moisture. The moisture condition 
+!!                is exactly the same as the 'moi' onset model (::pheno_moi), which has
+!!                already been described. \n
+!!                GDD is set to undef if beginning of the growing season detected.
+!!                As in the ::pheno_humgdd model, the parameter ::t_always is defined as 
+!!                10 degrees C in this subroutine, as are the parameters ::moisture_avail_tree
+!!                and ::moisture_avail_grass (set to 1 and 0.6 respectively), which are used
+!!                in the moisture condition (see ::pheno_moi onset model description). \n
+!!                The PFT-dependent GDD threshold (::gdd_crit) is calculated as in the onset 
+!!                model ::pheno_humgdd, using the equation:
+!!                \latexonly
+!!                \input{phenology_hummoigdd_gddcrit_eqn4.tex}
+!!                \endlatexonly
+!!                \n
+!!                where i and j are the grid cell and PFT respectively.
+!!                The three GDDcrit parameters (::gdd(ivm,*)) are set for each PFT in 
+!!                ::stomate_data, and three tables defining each of the three critical GDD
+!!                parameters for each PFT is given in ::gdd_crit1_tab, ::gdd_crit2_tab and 
+!!                ::gdd_crit3_tab in ::stomate_constants. \n
+!!                The ::pheno_moigdd subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): Added temperature threshold for C4 grass (pheno_moigdd_t_crit), Dan Zhu april 2015
+!!                
+!! MAIN OUTPUT VARIABLE(S): ::plant_status - specifies whether leaf growth can start
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Chuine, I (2000), A unified model for the budburst of trees, Journal of 
+!! Theoretical Biology, 207, 337-347.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!! - Still et al., Global distribution of C3 and C4 vegetation: Carbon cycle implications, 
+!! 2003, Global Biogeochemmical Cycles, DOI: 10.1029/2001GB001807. 
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_moigdd.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_moigdd (npts, ivm, PFTpresent, gdd, &
+       time_hum_min, &
+       t2m_longterm, t2m_month, t2m_week, &
+       moiavail_week, moiavail_month, &
+       plant_status)
+
+    !
+    !! 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)                               :: ivm             !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (true/false)
+!!$    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno !! are we allowed to decalre the beginning of the 
+!!$                                                                                !! growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: gdd             !! growing degree days, calculated since leaves 
+                                                                                !! have fallen (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: time_hum_min    !! time elapsed since strongest moisture 
+                                                                                !! availability (days) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_longterm    !! "long term" 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month       !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week        !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_week   !! "weekly" moisture availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_month  !! "monthly" moisture availability (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    REAL(r_std),DIMENSION(npts,nvm), INTENT(inout)           :: plant_status    !! Growth and phenological status of the plant
+                                                                                !! Different stati are listed in constantes_var
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                             :: tl                              !! long term temperature (C)
+    REAL(r_std), DIMENSION(npts)                             :: gdd_crit                        !! critical GDD (C)
+    INTEGER(i_std)                                           :: ipts                            !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering moigdd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of the onset model, the values of the  
+    !!     moisture availability parameters for tree and grass, and the value of the 
+    !!     critical monthly temperature.
+    !
+
+    IF ( firstcall_moigdd .AND. printlev_loc>=4) 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.3 check the critical values ::gdd and ::pheno_crit_hum_min_time are defined.
+    !!     If not, stop.
+    !
+
+    IF ( ANY(pheno_gdd_crit(ivm,:) .EQ. undef) ) THEN
+
+       WRITE(numout,*) 'moigdd: pheno_gdd_crit is undefined for PFT',ivm
+       CALL ipslerr_p(3,'stomate phenology','pheno_gdd is undefined for this PFT','','')
+
+    ENDIF
+
+    IF ( hum_min_time(ivm) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'moigdd: hum_min_time is undefined for PFT',ivm
+       CALL ipslerr_p(3,'stomate phenology','hum_min is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(ivm) ) 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 ipts = 1, npts
+
+       IF ( PFTpresent(ipts,ivm) .AND. &
+            plant_status(ipts,ivm) .EQ. ibudsavail .AND. &
+            ( gdd(ipts,ivm) .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(ipts) = t2m_longterm(ipts) - ZeroCelsius
+          gdd_crit(ipts) = pheno_gdd_crit(ivm,1) + tl(ipts)*pheno_gdd_crit(ivm,2) + &
+               tl(ipts)*tl(ipts)*pheno_gdd_crit(ivm,3)
+
+          !! 2.2 Determine if the growing season should start (if so, plant_status = ibudbreak).
+          !!     This occurs if the critical gdd (::gdd_crit) has been reached 
+          !!     AND that is temperature increasing, which is true either if the monthly
+          !!     temperature being higher than the threshold ::t_always, OR if the weekly
+          !!     temperature is higher than the monthly, 
+          !!     AND finally that there is sufficient moisture availability, which is 
+          !!     the same condition as for the ::pheno_moi onset model.
+          !!     AND when pheno_moigdd_t_crit is set(for C4 grass), if the average temperature threshold is reached
+          IF (printlev_loc>=4)THEN
+             WRITE(numout,*) 'ivm, ',ivm
+             WRITE(numout,*) 'gdd, ',gdd(ipts,ivm), gdd_crit(ipts)
+             WRITE(numout,*) 't2m_week, ',t2m_week(ipts),t2m_month(ipts)
+             WRITE(numout,*) 't2m_month, ',t2m_month(ipts),t_always
+!!$          WRITE(numout,*) 'time_hum_mib, ',time_hum_min(ipts,ivm),hum_min_time(ivm)
+!!$          WRITE(numout,*) 'moiavail_week,',moiavail_week(ipts,ivm),moiavail_month(ipts,ivm)
+             WRITE(numout,*) 'moiavail_month, ',moiavail_month(ipts,ivm),moiavail_always
+!!$          WRITE(numout,*) 'pheno_moigdd_t_crit, ',pheno_moigdd_t_crit(ivm) == undef
+!!$          WRITE(numout,*) 't2m_month, ',t2m_month(ipts),ZeroCelsius + pheno_moigdd_t_crit(ivm)
+          ENDIF
+
+!!$          IF ( ( gdd(ipts,ivm) .GE. gdd_crit(ipts) ) .AND. &
+!!$               ( ( t2m_week(ipts) .GT. t2m_month(ipts) ) .OR. &
+!!$                 ( t2m_month(ipts) .GT. t_always )  ) .AND. &
+!!$               ( ( ( time_hum_min(ipts,ivm) .GT. hum_min_time(ivm) ) .AND. &
+!!$                 ( moiavail_week(ipts,ivm) .GT. moiavail_month(ipts,ivm) ) ) .OR. &
+!!$                 ( moiavail_month(ipts,ivm) .GE. moiavail_always )  ) .AND. &
+!!$               ( ( pheno_moigdd_t_crit(ivm) == undef ) .OR. &
+!!$                 (t2m_month(ipts) .GT. (ZeroCelsius + pheno_moigdd_t_crit(ivm))) ) ) THEN
+
+          !+++CHECK+++
+          ! this differs a lot from the trunk.
+          IF ( ( is_temperate(ivm) ) .AND. &
+               ( gdd(ipts,ivm) .GE. gdd_crit(ipts) ) .AND. &
+               ( ( t2m_week(ipts) .GT. t2m_month(ipts) ) .OR. &
+               ( t2m_month(ipts) .GT. 283 ) ) .AND. &
+               ( moiavail_month(ipts,ivm) .GE. moiavail_always ) )   THEN
+
+             ! Note that t_always was set to 283
+             plant_status(ipts,ivm) = ibudbreak
+             
+          ELSEIF( ( is_boreal(ivm) ) .AND. &
+               ( gdd(ipts,ivm) .GE. gdd_crit(ipts) ) .AND. &
+               ( ( t2m_week(ipts) .GT. t2m_month(ipts) ) .OR. &
+               ( t2m_month(ipts) .GT. 279 ) ) .AND. &
+               ( moiavail_month(ipts,ivm) .GE. moiavail_always ) )  THEN
+
+             ! Note that t_always was set to 279
+             plant_status(ipts,ivm) = ibudbreak
+
+          ELSEIF ( ( is_tropical(ivm) ) .AND. &
+               ( gdd(ipts,ivm) .GE. gdd_crit(ipts) ) .AND. &
+               ( ( t2m_week(ipts) .GT. t2m_month(ipts) ) .OR. &
+               ( t2m_month(ipts) .GT. 288 ) ) .AND. &
+               ( moiavail_month(ipts,ivm) .GE. moiavail_always ) )  THEN
+
+             ! Note that t_always was set to 288
+             plant_status(ipts,ivm) = ibudbreak
+
+          ELSEIF(.NOT. is_tropical(ivm) .AND. &
+               .NOT. is_temperate(ivm) .AND. &
+               .NOT. is_boreal(ivm) ) THEN
+
+             WRITE(numout,*) 'ERROR: moigdd not defined for this '//&
+                  'climate zone'
+             CALL ipslerr_p(3,'ERROR: moigdd not defined for this',&
+                  'climate zone','','')
+
+          ENDIF ! budbreak in different climate zones
+
+          ! Debug
+          IF(printlev_loc>=4) WRITE(numout,*) 'plant_status, ',plant_status(ipts,ivm)
+          !-
+
+       ENDIF ! PFT there and start of growing season allowed
+
+    ENDDO
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving moigdd'
+
+  END SUBROUTINE pheno_moigdd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_ncdgdd
+!!
+!>\BRIEF          The Number of Chilling Days - Growing Degree Day (NCD-GDD) model initiates 
+!!                leaf onset if a certain relationship between the number of chilling days (NCD) 
+!!                since leaves were lost, and the growing degree days (GDD) since midwinter, is 
+!!                fulfilled. 
+!!                Currently PFT 6 (Temperate Broad-leaved Summergreen) and PFT 8 (Boreal Broad-
+!!                leaved Summergreen) are assigned to this model.
+!! 
+!! DESCRIPTION  : Experiments have shown that some
+!!                species have a "chilling" requirement, i.e. their physiology needs cold 
+!!                temperatures to trigger the mechanism that will allow the following budburst 
+!!                (e.g. Orlandi et al., 2004). 
+!!                An increase in chilling days, defined as a day with a daily mean air
+!!                temperature below a PFT-dependent threshold, reduces a plant's GDD demand 
+!!                (Cannell and Smith, 1986; Murray et al., (1989); Botta et al., 2000).
+!!                The GDD threshold therefore decreases as NCD 
+!!                increases, using the following empirical negative explonential law:
+!!                \latexonly
+!!                \input{phenology_ncdgdd_gddmin_eqn5.tex}
+!!                \endlatexonly
+!!                \n
+!!                The constants used have been calibrated against data CHECK FOR REFERENCE OR PERSON WHO DID UPDATE.
+!!                Leaf onset begins if the GDD is higher than the calculated minimum GDD
+!!                (dependent upon NCD) AND if the weekly temperature is higher than the monthly 
+!!                temperature. This is to ensure the temperature is increasing. \n
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                The NCD (::ncd_dormance) is calculated in ::stomate_season as  
+!!                the number of days with a temperature below a PFT-dependent constant threshold
+!!                (::ncdgdd_temp), starting from the beginning of the dormancy period
+!!                (::time_lowgpp>0), i.e. since the leaves were lost. \n
+!!                The growing degree day sum of the temperatures higher than 
+!!                ::ncdgdd_temp (GDD) since midwinter (::gdd_midwinter) 
+!!                is also calculated in ::stomate_season.
+!!                Midwinter is detected if the monthly temperature is lower than the weekly
+!!                temperature AND  the monthly temperature is lower than the long-term
+!!                temperature. ::gdd_minter is therefore set to 0 at the beginning of midwinter
+!!                and increased with each temperature greater than the PFT-dependent threshold.
+!!                When midsummer is detected (the opposite of the above conditions), 
+!!                ::gdd_midwinter is set to undef.
+!!                CHECK! WHEN TO START OF DORMANCY BEEN MODIFIED FROM BOTTA- ADD IN?
+!!                The ::pheno_ncdgdd subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): None
+!!                
+!! MAIN OUTPUT VARIABLE(S): ::plant_status - 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, ivm, PFTpresent, &
+       ncd_dormance, gdd_midwinter, &
+       t2m_month, t2m_week, plant_status)
+
+    !
+    !! 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)                               :: ivm             !! 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
+    !
+    REAL(r_std),DIMENSION(npts,nvm), INTENT(inout)           :: plant_status    !! Growth and phenological status of the plant
+                                                                                !! Different stati are listed in constantes_var
+
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                                           :: ipts            !! index (unitless)
+    REAL(r_std)                                              :: gdd_min         !! critical gdd (C)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering ncdgdd'
+
+    !
+    !! 1. Initializations
+    !
+
+!!$    !
+!!$    !! 1.1 initialize output
+!!$    !
+!!$
+!!$    begin_leaves(:,ivm) = .FALSE.
+
+    !
+    !! 1.2 check the critical value ::ncdgdd_temp is defined.
+    !!     If not, stop.
+    !
+
+    IF ( ncdgdd_temp(ivm) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'ncdgdd: ncdgdd_temp is undefined for PFT (::j) ',ivm
+       CALL ipslerr_p(3,'stomate phenology','ncdgdd_temp this PFT','','')
+
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.    
+    !!    PFT has to be there and start of growing season must be allowed.
+    !
+
+    DO ipts = 1, npts ! loop over grid points
+
+       IF(printlev_loc>=4)THEN
+          WRITE(numout,*) 'Phenology, ',ivm
+          WRITE(numout,*) 'Phenology, plant_status, ',plant_status(ipts,ivm)
+          WRITE(numout,*) 'Phenology, gdd_midwinter, ',gdd_midwinter(ipts,ivm)
+          WRITE(numout,*) 'Phenology, ncd_dormance, ',ncd_dormance(ipts,ivm)
+          WRITE(numout,*) 'Phenology, temp, ',t2m_week(ipts),t2m_month(ipts)
+       ENDIF
+
+       IF ( PFTpresent(ipts,ivm) .AND. &
+            plant_status(ipts,ivm) .EQ. ibudsavail .AND. &
+            ( gdd_midwinter(ipts,ivm) .NE. undef ) .AND. &
+            ( ncd_dormance(ipts,ivm) .NE. undef )                  ) THEN
+
+          !! 2.1 Calculate the critical gdd, which is related to ::ncd_dormance
+          !!     using an empirical negative exponential law as described above. 
+          gdd_min = ( gddncd_ref / exp(gddncd_curve*ncd_dormance(ipts,ivm)) - &
+               gddncd_offset )
+
+          ! Debug
+          IF(printlev_loc>=4) WRITE(numout,*) 'Phenology, gdd_min, ',gdd_min
+          !-
+
+          !! 2.2 Determine if the growing season should start 
+          !  (if so, plant_status = ibudbreak).
+          !  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(ipts,ivm) .GE. gdd_min ) .AND. &
+               ( t2m_week(ipts) .GT. t2m_month(ipts) ) ) THEN
+
+             plant_status(ipts,ivm) = ibudbreak
+             gdd_midwinter(ipts,ivm)=undef
+
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving ncdgdd'
+
+  END SUBROUTINE pheno_ncdgdd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_ngd
+!!
+!>\BRIEF          The Number of Growing Days (NGD) leaf onset model initiates leaf onset if the NGD, 
+!!                defined as the number of days with temperature above a constant threshold, 
+!!                exceeds a critical value.
+!!                Currently PFT 9 (Boreal Leedleleaf Summergreen) is assigned to this model. 
+!!
+!! DESCRIPTION    The NGD model is a variant of the GDD model. The model was proposed by Botta et
+!!                al. (2000) for boreal and arctic biomes, and is designed to estimate 
+!!                leaf onset after the end of soil frost. 
+!!                The NDG (::ngd_minus5) is the number of days with a daily mean air 
+!!                temperature of greater than -5 degrees C, 
+!!                starting from the beginning of the dormancy period (i.e. time since the leaves 
+!!                were lost/GPP below a certain threshold).
+!!                Leaf onset begins if the NGD is higher than the PFT-dependent constant threshold, 
+!!                ::ngd,  AND if the weekly temperature is higher than the monthly 
+!!                temperature. \n
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                ::ngd_minus5 is also calculated in ::stomate_season. It is initialised at the
+!!                beginning of the dormancy period (::time_lowgpp>0), and increased by the 
+!!                stomate time step when the temperature > -5 degrees C. \n
+!!                ::ngd is set for each PFT in ::stomate_data, and a 
+!!                table defining the minimum NGD for each PFT is given in ::ngd_crit_tab
+!!                in ::stomate_constants. \n
+!!                The ::pheno_ngd subroutine is called in the subroutine ::phenology.      
+!!
+!! RECENT CHANGE(S): None
+!!                
+!! MAIN OUTPUT VARIABLE(S): ::plantstatus - 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, ivm, PFTpresent, ncd_dormance, &
+       ngd_minus5, t2m_month, t2m_week, plant_status)
+
+    !
+    !! 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)                               :: ivm             !! 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), 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
+    !
+    REAL(r_std),DIMENSION(npts,nvm), INTENT(inout)           :: plant_status    !! Growth and phenological status of the plant
+                                                                                !! Different stati are listed in constantes_var
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)             :: ngd_minus5   !! growing degree since midwinter days (C)
+
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                                           :: ipts               !! index (unitless)
+
+    !! =========================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering ngd'
+
+    !
+    !! 1. Initializations
+
+    !! 1.2 check the critical value ::ngd_crit is defined.
+    !!     If not, stop.
+    !
+
+    IF ( ngd_crit(ivm) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'ngd: ngd_crit is undefined for PFT (::j) ',ivm
+       CALL ipslerr_p(3,'stomate phenology',&
+            'ngd_crit is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !!    PFT has to be there and start of growing season must be allowed.
+    !
+    IF (printlev_loc>=4) THEN
+       WRITE(numout,*) 'phenology PFTpresent, ', ivm, PFTpresent(:,ivm)
+       WRITE(numout,*) 'phenology plant_status, ', plant_status(:,ivm)
+       WRITE(numout,*) 'phenology ngd, ', ngd_minus5(:,ivm)
+       WRITE(numout,*) 'phenology ngd_crit, ',ngd_crit(ivm) 
+       WRITE(numout,*) 'phenology ncd_dormance, ', ncd_dormance(:,ivm)
+       WRITE(numout,*) 'phenology ngd_min_dormance, ',ngd_min_dormance
+       WRITE(numout,*) 'phenology t2m_week, ', t2m_week(:)
+       WRITE(numout,*) 'phenology ncdgdd_temp, ', ncdgdd_temp(ivm)+ZeroCelsius
+       WRITE(numout,*) 'phenology t2m_month, ', t2m_month(:)
+    ENDIF
+
+    DO ipts = 1, npts
+
+       IF ( PFTpresent(ipts,ivm) .AND. &
+            plant_status(ipts,ivm) .EQ. ibudsavail .AND. &
+            ( ngd_minus5(ipts,ivm) .NE. undef ) .AND. &
+            ( ncd_dormance(ipts,ivm) .NE. undef )) THEN
+
+          !! 2.1 Determine if the growing season should start 
+          !  (if so, plant_status = ibudbreak). This occurs if 
+          !  the critical NGD has been reached AND are temperatures 
+          !  increasing.
+
+          !+++CHECK+++
+          ! Trunk phenology
+!!$          IF ( ( ngd(ipts,ivm) .GE. ngd_crit(ivm)) .AND. &
+!!$               ( t2m_week(ipts) .GT. t2m_month(ipts) )        ) THEN
+          !+++++++++++
+
+          IF ( ngd_minus5(ipts,ivm) .GE. ngd_crit(ivm) .AND. &
+               ncd_dormance(ipts,ivm) .GE. ngd_min_dormance .AND. &
+               t2m_week(ipts) .GT. ncdgdd_temp(ivm)+ZeroCelsius .AND. &
+               t2m_week(ipts) .GT. t2m_month(ipts) ) THEN
+
+             plant_status(ipts,ivm) = ibudbreak
+             ngd_minus5(ipts,ivm) = undef
+
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving ngd'
+
+  END SUBROUTINE pheno_ngd
+
+END MODULE stomate_phenology
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_prescribe.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_prescribe.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_prescribe.f90	(revision 6412)
@@ -0,0 +1,1486 @@
+! =================================================================================================================================
+! 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, height, basal area and crown area.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_prescribe
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE function_library,    ONLY: calculate_c0_alloc, cc_to_lai, & 
+       cc_to_biomass, check_surface_area, check_mass_balance, &
+       wood_to_qmdia, Nmax, sort_circ_class_biomass
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC prescribe, make_saplings, prescribe_clear
+
+  ! first call
+  LOGICAL, SAVE             :: firstcall_prescribe = .TRUE.
+!$OMP THREADPRIVATE(firstcall_prescribe)
+
+CONTAINS
+
+! =================================================================================================================================
+!! SUBROUTINE   : prescribe_clear
+!!
+!>\BRIEF        : Set the firstcall_prescribe flag back to .TRUE. to prepare for the next simulation.
+!_=================================================================================================================================
+
+  SUBROUTINE prescribe_clear
+    firstcall_prescribe=.TRUE.
+  END SUBROUTINE prescribe_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : prescribe
+!!
+!>\BRIEF         Works only with static vegetation and agricultural PFTs.
+!!               Initialize biomass, density, presence in the first call
+!!               and update them in the following.
+!!
+!! DESCRIPTION (functional, design, flags): \n
+!! This module works only with static vegetation and agricultural PFTs.
+!! In the first call, initialize density of individuals, biomass,
+!! and leaf age distribution to some reasonable value. In the following calls,
+!! these variables are updated following a stand replacing disturbance or
+!! if the conditions are suitable for recruitment. 
+!!
+!! 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, ::biomass
+!!
+!! 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.
+!! - McDowell, N., Barnard, H., Bond, B.J., Hinckley, T., Hubbard, R.M., Ishii, 
+!!   H., KÃ¶stner, B., Magnani, F. Marshall, J.D., Meinzer, F.C., Phillips, N., 
+!!   Ryan, M.G., Whitehead D. 2002. The relationship between tree height and leaf 
+!!   area: sapwood area ratio. Oecologia, 132:12â20.
+!! - Novick, K., Oren, R., Stoy, P., Juang, F.-Y., Siqueira, M., Katul, G. 2009. 
+!!   The relationship between reference canopy conductance and simplified hydraulic 
+!!   architecture. Advances in water resources 32, 809-819.
+!! - Ruger et al. 2009, J. of Ecol. doi: 10.1111/j.1365-2745.2009.01552.x  
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE prescribe (npts, veget_cov_max, dt, PFTpresent, &
+       everywhere, when_growthinit, leaf_frac, circ_class_dist, &
+       circ_class_n, circ_class_biomass, atm_to_bm, &
+       forest_managed, KF, plant_status, age, npp_longterm, &
+       lm_lastyearmax, tau_eff_leaf, tau_eff_sap, tau_eff_root, &
+       k_latosa_adapt, light_tran_to_level_season, &
+       EndOfYear, lpft_replant,species_change_map)
+
+  !! 0. Parameters and variables declaration
+
+  !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                        :: npts               !! Domain size (unitless)
+    INTEGER(i_std), DIMENSION (:,:), INTENT(in)       :: forest_managed     !! forest management flag
+    REAL(r_std), INTENT(in)                           :: dt                 !! time step (dt_days)   
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: veget_cov_max          !! "maximal" coverage fraction of a PFT 
+                                                                            !! (LAI -> infinity) on ground. May sum to
+                                                                            !! less than unity if the pixel has
+                                                                            !! nobio area. (unitless; 0-1)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: tau_eff_root       !! Effective root turnover time that accounts
+                                                                            !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: tau_eff_sap        !! Effective sapwood turnover time that accounts
+                                                                            !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)           :: tau_eff_leaf       !! Effective leaf turnover time that accounts
+                                                                            !! waterstress (days)
+    LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in)     :: lpft_replant       !! Set to true if a PFT has been clearcut
+                                                                            !! and needs to be replaced by another species
+    INTEGER(i_std), DIMENSION (:,:), INTENT(in)       :: species_change_map !! map which gives the PFT number that each PFT
+    REAL(r_std), DIMENSION (:,:,:), INTENT(in)        :: light_tran_to_level_season !! Seasonal fraction of light transmitted to canopy levels
+    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
+    REAL(r_std), DIMENSION(:), INTENT(in)             :: circ_class_dist    !! The probability distribution of trees 
+                                                                            !! in a circ class in case of a 
+                                                                            !! redistribution (unitless).
+
+  !! 0.2 Output variables
+
+
+  !! 0.3 Modified variables
+
+    LOGICAL, DIMENSION(:,:), INTENT(inout)            :: PFTpresent         !! PFT present (0 or 1)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: plant_status       !! Growth and phenological status of the plant
+                                                                            !! Different stati are listed in in constantes_var
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: everywhere         !! is the PFT everywhere in the grid box or 
+                                                                            !! very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: when_growthinit    !! how many days ago was the beginning of 
+                                                                            !! the growing season (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: npp_longterm       !! "long term" net primary productivity
+                                                                            !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: age                !! mean age (years)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: lm_lastyearmax     !! last year's maximum leaf mass for each PFT 
+                                                                            !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)      :: circ_class_n       !! Number of individuals in each circ class
+                                                                            !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)  :: circ_class_biomass !! Biomass components of the model tree  
+                                                                            !! within a circumference class
+                                                                            !! class @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)      :: atm_to_bm          !! CO2 or N taken from the atmosphere to get
+                                                                            !! the seed C and N
+                                                                            !! to create the seedlings 
+                                                                            !!  @tex (gC.m^{-2}dt^{-1})$ @endtex  
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)      :: leaf_frac          !! fraction of leaves in leaf age 
+                                                                            !! class (unitless;0-1)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: KF                 !! Scaling factor to convert sapwood mass
+                                                                            !! into leaf mass (m) - this variable is 
+                                                                            !! passed to other routines
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: k_latosa_adapt     !! Leaf to sapwood area adapted for long 
+                                                                            !! term water stress (m)
+
+
+  !! 0.4 Local variables
+    REAL(r_std), DIMENSION(nvm)                       :: c0_alloc           !! Root to sapwood tradeoff parameter
+    INTEGER(i_std)                                    :: ipts, ivm          !! index (unitless)
+    INTEGER(i_std)                                    :: ipar, ilev         !! index (unitless)
+    INTEGER(i_std)                                    :: icir, iele, imbc   !! index (unitless)
+    INTEGER(i_std)                                    :: deb,fin, imaxt     !! index (unitless)
+    REAL(r_std), DIMENSION(npts,nvm)                  :: k_latosa           !! Height dependent base value to calculate 
+                                                                            !! KF (-) 
+    REAL(r_std), DIMENSION(nvm,ncirc,nparts,nelements):: bm_sapl            !! Sapling biomass for the functional
+                                                                            !! allocation with a dimension for the 
+                                                                            !! circumference classes
+                                                                            !! @tex $(gC.ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                  :: LF                 !! Scaling factor to convert sapwood mass
+                                                                            !! into root mass (unitless)
+    REAL(r_std), DIMENSION(npts,nvm)                  :: lstress_fac        !! Light stress factor, based on total
+                                                                            !! transmitted light (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)            :: circ_class         !! circumference of individual trees
+    REAL(r_std), DIMENSION(nparts)                    :: bm_init            !! Biomass needed to initiate the next 
+                                                                            !! planting @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(ncirc)                     :: nb_trees_i         !! Number of trees in each twentith 
+                                                                            !! circumference quantile of the 
+                                                                            !! distribution (ind) 
+    REAL(r_std)                                       :: excedent           !! Number of trees after truncation to be 
+                                                                            !! reallocated to smaller quantiles of the 
+                                                                            !! distribution (ind) 
+    REAL(r_std)                                       :: max_circ_init      !! Maximum initial circumferences of the 
+                                                                            !! truncated exponential distribution (cm) 
+    REAL(r_std), DIMENSION(ncirc)                     :: ave_tree_height    !! The height of the ideal tree in each
+                                                                            !! circumference class of the 
+                                                                            !! distribution (ind)...not saved since
+                                                                            !! it should only be used for prescribing
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements):: check_intern       !! Contains the components of the internal
+                                                                            !! mass balance chech for this routine
+                                                                            !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)        :: closure_intern     !! Check closure of internal mass balance
+                                                                            !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)        :: pool_start         !! Start and end pool of this routine 
+                                                                            !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)        :: pool_end           !! Start and end pool of this routine 
+                                                                            !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std)                                       :: delta_KF           !! Difference between new and old estimate 
+                                                                            !! of KF while iterating
+    REAL(r_std), DIMENSION(npts,nvm)                  :: veget_cov_max_begin    !! temporary storage of veget_cov_max to check area conservation    
+    REAL(r_std)                                       :: sapwood_density    !! Sapwood density gC m^{-3}
+    REAL(r_std)                                       :: dia_init           !! Diameter of a sapling (m)
+    REAL(r_std)                                       :: qmd_init           !! Quadratic mean diameter of the initial stand of seedlings (m)
+    REAL(r_std)                                       :: ind_init           !! Maximum number of individuals when establishing a new forest (#/m^{-2})     
+    REAL(r_std)                                       :: wood_init          !! Wood mass of a sapling (g C tree^{-1})                    
+    INTEGER(i_std)                                    :: iloop              !! Index
+    LOGICAL                                           :: establish          !! Logical flag to establish a new young vegetation
+                                                                            !! after a stand replacing disturbance 
+    LOGICAL                                           :: recruite           !! Logical flag to add saplings of a PFT under an
+                                                                            !! existing canopy of the same PFT 
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)            :: old_circ_class_n   !! Old number of individuals in each circ class
+                                                                            !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements) &
+                                                      :: old_circ_class_biomass !! Old biomass components of the model tree  
+                                                                            !! within a circumference class
+                                                                            !! class @tex $(g C ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements)  :: old_biomass       !! Old stand level biomass 
+                                                                            !! tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                      :: height_small      !! Height of the smallest tree in circ_class_biomass
+                                                                            !! tex $(m)$ @endtex
+    REAL(r_std)                                        :: dia_small         !! Diameter of the smallest tree in circ_class_biomass
+                                                                            !! tex $(m)$ @endtex   
+    REAL(r_std)                                        :: height_sapl       !! Height of the recruitment sapling
+                                                                            !! tex $(m)$ @endtex                                                           
+    REAL(r_std)                                        :: new_ind           !! density of new individuals 
+    REAL(r_std)                                        :: old_ind           !! density of old individuals                                        
+    REAL(r_std)                                        :: cn_leaf,cn_root   !! CN ratio of leaves, and roots
+                                                                            !! (gC/gN)
+    REAL(r_std)                                        :: cn_wood           !! CN ratio of wood pool
+                                                                            !! (gC/gN)
+    REAL(r_std)                                        :: coeff 
+    REAL(r_std), DIMENSION(ncirc)                      :: dummy
+   
+    REAL(r_std)                                        :: lambda            !! lambda of the truncated exponential
+                                                                            !! distribution of initial diameters (1/cm**2)
+    REAL(r_std)                                        :: tmp_ind           !! temporary number of individuals per m-2
+    REAL(r_std), DIMENSION(ncirc)                      :: circ_class_n_new  !! variable used to sort circ_class_n
+    REAL(r_std), DIMENSION(ncirc,nparts,nelements)     :: circ_class_biomass_new !! variable used to sort circ_class_biomass
+ 
+!_ ================================================================================================================================
+
+    IF (printlev>=2) WRITE(numout,*) 'Entering stomate_prescribe.f90'
+
+  !! 1. Initialize biomass at first call
+
+    !! 1.1 Initialize local printlev
+    !printlev_loc=get_printlev('prescribe')
+
+    !! 1.2 Store for closing the mass balance with recruitment   
+    old_biomass(:,:,:,:)= cc_to_biomass(npts,nvm,&
+         circ_class_biomass(:,:,:,:,:), & 
+         circ_class_n(:,:,:))
+       
+    
+    !! 1.3 Initialize check for mass balance closure 
+    IF (err_act.GT.1) THEN
+
+       check_intern(:,:,:,:) = zero
+       pool_start(:,:,:) = zero
+       DO iele = 1,nelements
+
+          ! atm_to_bm has as intent inout, the variable 
+          ! accumulates carbon over the course of a day. 
+          ! Use the difference between start and the end of 
+          ! this routine
+          check_intern(:,:,iatm2land,iele) = - un * &
+               atm_to_bm(:,:,iele) * veget_cov_max(:,:) * dt
+
+          DO ipar = 1,nparts
+          
+             DO icir = 1,ncirc
+
+                ! Initial biomass pool. Use circ_class_biomass
+                ! because that variable is the prognostic variable
+                ! biomass is syncronized to circ_class_biomass. If 
+                ! many diameter classes are used, each diameter class
+                ! separatly passes all criteria but when combined
+                ! a mass balance problem occurs.
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                   circ_class_biomass(:,:,icir,ipar,iele) * &
+                   circ_class_n(:,:,icir) * veget_cov_max(:,:)
+
+             ENDDO
+             
+          ENDDO
+
+       ENDDO
+
+       !! 1.3 Initialize check for area conservation
+       veget_cov_max_begin(:,:) = veget_cov_max(:,:)
+
+    ENDIF ! err_act.GT.1
+
+  !! 2. Prescribe carbon and nitrogen biomass
+
+    ! We want the vegetation to regrow after a stand replacing disturbance
+    ! So loop over every point and PFT.  If there is supposed to be 
+    ! vegetation here (according to veget_cov_max) but there isn't (according 
+    ! to ind), then establish a new young vegetation in that PFT.
+    DO ivm = 2,nvm ! Loop over PFTs
+
+       DO ipts = 1, npts ! Loop over pixels
+
+          !! 2.1 Wait for the end of the year to replant
+          !  If we are regrowing different species after managed forests
+          !  are killed/die, we sometimes need to prevent them regrowing.
+          !  This is only true if they die in the middle of the year due 
+          !  to natural causes, in which case they will be replanted at 
+          !  the end of the year. This loop checks to see if we regrow 
+          !  this PFT now or later. We can regrow a PFT after lpft_replant 
+          !  is set back to false so before that we need to process all the 
+          !  information such that the correct species will be regrown. 
+          !  lpft_replant is an optional variable. First test whether it is 
+          !  present.
+          IF(ok_change_species)THEN
+             IF(PRESENT(lpft_replant))THEN
+                IF(lpft_replant(ipts,ivm))THEN
+                    ! .AND. agec_group(ivm)/=species_change_map(ipts,ivm))THEN
+                    CYCLE
+                ENDIF
+             ENDIF
+          ENDIF
+
+          ! Debug
+          IF(printlev_loc.GT.4)THEN
+             WRITE(numout,*) 'PFT ',ivm
+             WRITE(numout,*) 'plant_status ', plant_status(ipts,ivm)
+             WRITE(numout,*) 'veget_cov_max ', veget_cov_max(ipts,ivm)
+             WRITE(numout,*) 'recruitment_pft ',recruitment_pft(ivm)
+             WRITE(numout,*) 'ok_dgvm ',  ok_dgvm
+             WRITE(numout,*) 'ok_recruitment ',ok_recruitment
+             WRITE(numout,*) 'biomass - C, ', &
+                  SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1))
+             WRITE(numout,*) 'biomass - N, ', &
+                  SUM(SUM(circ_class_biomass(ipts,ivm,:,:,initrogen),1))
+             WRITE(numout,*) 'EndOfYear ', EndOfYear
+          ENDIF
+          !
+
+          ! Decide whether we have to establish new vegetation (::establish)
+          ! allow recruitment (::recruite). These two local variables were
+          ! introduced to allow maximal flexibility so within a single
+          ! run, PFTs with and without recruitment can co-exist.         
+          IF( ( (plant_status(ipts,ivm) .EQ. iprescribe) .OR. & 
+               (plant_status(ipts,ivm) .EQ. idead) ) .AND. &
+               (SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1)) .LE. min_stomate) .AND. &
+               (veget_cov_max(ipts,ivm) .GT. min_stomate) .AND. &
+               (.NOT. ok_dgvm) ) THEN
+
+             ! The vegetation just died from replacing disturbances
+             ! (two first conditions). The new vegetation could be 
+             ! of the same or a different PFT than the previous 
+             ! vegetation. 
+             establish = .TRUE.
+             recruite = .FALSE.
+
+             ! Debug
+             IF (printlev_loc>=4) THEN
+                WRITE(numout,*) 'We are calling stomate_prescribe.f90 &
+                     & to initialize PFT  ',ivm
+             ENDIF
+             !-
+
+          ELSEIF( ( (plant_status(ipts,ivm) .NE. iprescribe) .OR. & 
+               (plant_status(ipts,ivm) .NE. idead) ) .AND. &
+               (SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1)) .GT. min_stomate) .AND. &
+               (veget_cov_max(ipts,ivm) .GT. min_stomate) .AND. &
+               (recruitment_pft(ivm)) .AND. &
+               (.NOT. ok_dgvm) .AND. &
+               (ok_recruitment) .AND. &
+               (EndOfYear) ) THEN
+
+             ! There is already vegetation (first three conditions)
+             ! and this specific PFT has recruitment (condition 5)
+             ! Only use recruitment when the recruitment flag is TRUE
+             ! (condition 7)
+             establish = .FALSE.
+             recruite = .TRUE.
+
+             ! Debug
+             IF (printlev_loc>=4) THEN
+                WRITE(numout,*) 'We are calling stomate_prescribe.f90 &
+                     & for sapling recruitment in PFT  ',ivm
+             ENDIF
+             !-
+             
+          ELSEIF( (veget_cov_max(ipts,ivm).LT. min_stomate) .AND. &
+             (SUM(SUM(circ_class_biomass(ipts,ivm,:,:,icarbon),1)) .LT. min_stomate) .AND. &
+             (SUM(circ_class_n(ipts,ivm,:)) .LT. min_stomate) )THEN
+
+             ! The PFT is not defined. Initialize the variables
+             ! to ensure that all goes well when moving and merging 
+             ! different age classes.
+             circ_class_n(ipts,ivm,:) = zero
+             circ_class_biomass(ipts,ivm,:,:,icarbon) = zero 
+
+             ! Conditions are not fullfilled for establishing
+             ! new vegetation
+             establish = .FALSE.
+             recruite = .FALSE.
+
+          ELSEIF (veget_cov_max(ipts,ivm) .GT. min_stomate) THEN
+
+             ! Conditions are not fullfilled for either establishing 
+             ! a new young vegetation or having recruitment under an
+             ! exisisting vegetation of the same PFT.
+             establish = .FALSE.
+             recruite = .FALSE.
+
+             ! Debug
+             IF (printlev_loc>=4) THEN
+                WRITE(numout,*) 'We are calling stomate_prescribe.f90 &
+                     & but nothing should be done for PFT ',ivm
+             ENDIF
+             
+
+          ELSE
+
+             ! Unexpected condition
+             CALL ipslerr_p (3,'stomate_prescribe.f90',&
+                  'Unexpected condition - time to rethink the', &
+                  'IF that choses between establish and recruite','')
+
+          ENDIF
+
+          !! 2.2 Calculate variables that will determine the size of the saplings
+          IF( establish .OR. recruite )THEN
+
+             !! 2.2.1 Calculate c0_alloc
+             ! The calculation starts with c0_alloc, it only depends on PFT and 
+             ! the effective longiveties.
+             c0_alloc(ivm) = calculate_c0_alloc(ipts, ivm, &
+                  tau_eff_root(ipts,ivm),tau_eff_sap(ipts,ivm))
+             
+             !! 2.2.2 Calculate k_latosa for newly established PFTs
+             !  If a new vegetation has to be established we recalculate
+             !  k_latosa from the parameter file (see note on physiological
+             !  memory of k_latosa below). If we add recruits we use the KF of
+             !  the existing vegetation.
+             IF (establish) THEN
+
+                ! Initialize tree level variables
+                circ_class_n(ipts,ivm,:) = zero
+                circ_class_biomass(ipts,ivm,:,:,:) = zero
+
+                ! Assume that there is no physiological memory for k_latosa
+                ! between different generations (this is probably true when
+                ! trees are planted but seems less likely for natural
+                ! regeneration. The first test that implemented memory has
+                ! caused problems with the LAI from the second generation
+                ! onwards. Nevertheless, we still use k_latosa_adapt. In case
+                ! someone want to try again in the future, the structure of
+                ! the code is ready to account for memory
+                k_latosa_adapt(ipts,ivm) = k_latosa_min(ivm)
+
+                ! Debugging
+                IF (printlev_loc>=4) THEN
+                   WRITE(numout,*) 'Establish a PFT (stomate_prescribe.f90):'
+                   WRITE(numout,*) ' Imposing initial biomass for prescribed &
+                        & trees, initial reserve mass for prescribed grasses.'
+                   WRITE(numout,*) ' Declaring prescribed PFTs present.'
+                   WRITE(numout,*) ' Grid point: ',ipts,' PFT Type: ',ivm
+                   WRITE(numout,*) ' Establish ',establish,' Recruite ',recruite 
+                ENDIF
+                !-
+                
+             ENDIF ! establish
+
+             !! 2.2.3 Calculate Lightstress
+             !  Note that light and water stress have an opposite effect on KF. 
+             !  Waterstress will decrease KF because more C should be allocated 
+             !  to the roots. Light stress will increase KF because more C should 
+             !  be allocated to the leaves.
+             !  Lightstress varies from 0 to 1 and is calculated from the canopy 
+             !  structure (veget).
+             IF (establish) THEN
+
+                ! Given that there is no vegetation at this point, the
+                ! lightstress cannot be calculated and is set to 1.
+                ! However, as soon as we grow a canopy it will experience
+                ! light stress and so KF should be adjusted.
+                lstress_fac(ipts,ivm) = un
+
+             ELSEIF (recruite) THEN 
+
+                ! We already have vegetation, so we should do recruitment if 
+                ! we want it for this PFT. First lets compute light stress based 
+                ! on the fraction of light reaching the ground (level 1),
+                ! averaged over all daytime time steps (sinang>0) of the vegetative 
+                ! period (gpp>0). This is based on Pgap and accounts for canopy
+                ! structure. 
+                lstress_fac(ipts,ivm)=light_tran_to_level_season(ipts,ivm,1)
+
+                ! Debug
+                IF(printlev_loc>=4)THEN
+                   WRITE(numout,*) 'Mean seasonal transmitted light used in &
+                        & stomate_prescribe.f90 ' // & 
+                        & '(ivm,ipts,nlevels_tot) ',ivm,ipts,nlevels_tot
+                   DO ilev = nlevels_tot,1,-1
+                      WRITE(numout,*) ilev,light_tran_to_level_season(ipts,ivm,ilev)
+                   ENDDO
+                   WRITE(numout,*) 'lstress_fac from CN-CAN is ', &
+                        lstress_fac(ipts,ivm)*100, ' (%)'
+                ENDIF
+                !-
+
+             ENDIF ! establish/recruite for light
+
+          ENDIF ! establish .OR. recruite for initialization
+          
+          !! 2.3 Initial vegetation has to be prescribed only when the vegetation is 
+          ! static
+          IF (establish .OR. recruite) THEN
+
+             !! 2.3.1 Initialize woody PFT's 
+             !  Use veget_cov_max to check whether the PFT is present. If the PFT 
+             !  is present but it has no biomass, prescribe its biomass (gC m-{2}).
+             IF ( is_tree(ivm) ) THEN
+
+                ! prescribe/recruitment branching for actual process
+                IF (establish) THEN
+
+                   IF (ncirc .EQ. 1) THEN
+                   
+                      ! Calculate the height range based on the prescribed 
+                      ! min/max initial heights. In the general approach
+                      ! we divide by (ncirc-1) which equals to zero if ncirc
+                      ! is one. Therefore a special case was defined.
+                      ave_tree_height(ncirc) = (height_init_min(ivm) + &
+                           height_init_max(ivm))/2
+                   
+                   ELSE
+
+                      DO icir = 1,ncirc
+
+                         ! Calculate the height range based on the prescribed 
+                         ! min/max initial heights. Use the general approach.
+                         ave_tree_height(icir) = height_init_min(ivm) + &
+                              (icir-1) * (height_init_max(ivm) - &
+                              height_init_min(ivm))/(ncirc-1)
+
+                      ENDDO
+
+                   ENDIF !ncirc.EQ.1
+
+                   ! Allocation factors
+                   ! Sapwood to root ratio
+                   ! Following Magnani et al. 2000 "In order to decreases hydraulic 
+                   ! resistance, the investment of carbon in fine roots or sapwood 
+                   ! yields to the plant very different returns, both because of 
+                   ! different hydraulic conductivities and because of the strong 
+                   ! impact of plant height on shoot resistance. On the other hand, 
+                   ! fine roots and sapwood have markedly different longevities and 
+                   ! the cost of production, discounted for turnover, will differ 
+                   ! accordingly. Optimal growth under hydraulic constraints requires 
+                   ! that the ratio of marginal hydraulic returns to marginal annual 
+                   ! cost for carbon investment in either roots or sapwood be the 
+                   ! same (Bloom, Chapin & Mooney 1985; Case & Fair 1989). This
+                   ! is formalized in equation (13) and further derived to obtain 
+                   ! equation (17) in Magnani et al 2000. The latter is implemented 
+                   ! here.Pipe_density is given in gC/m-3, convert to kg/m-3. And 
+                   ! apply equation (17) in Magnani et al 2000. Note that c0_alloc 
+                   ! was calculated at the start of this routine. The calculation 
+                   ! itself is done in function_library
+
+                   ! Calculate leaf area to sapwood area
+                   ! To be consistent with the hydraulic limitations and pipe theory,
+                   ! k_latosa is calculated from equation (18) in Magnani et al.
+                   ! To do so, total hydraulic resistance and tree height need to 
+                   ! known. This poses a problem as the resistance depends on the leaf 
+                   ! area and the leaf area on the resistance. There is no independent 
+                   ! equation and equations 12 and 18 depend on each other and 
+                   ! substitution would be circular. Hence prescribed k_latosa values 
+                   ! were obtained from observational records and are given in 
+                   ! mtc_parameters.f90. 
+
+                   ! The relationship between height and k_latosa as reported in 
+                   ! McDowell et al 2002 and Novick et al 2009 could be implemented 
+                   ! to adjust k_latosa for the height of the stand. This did NOT 
+                   ! result in a realistic model behavior 
+                   ! k_latosa(ipts,ivm) = wstress_fac(ipts,ivm) * &
+                   !    (k_latosa_max(ivm) - (latosa_height(ivm) * &
+                   !    (SUM( nb_trees_i(:) * ave_tree_height(:) ) / &
+                   !       SUM( nb_trees_i(:) ))))
+
+                   ! Also k_latosa has been reported to be a function of CO2 
+                   ! concentration (Atwell et al. 2003, Tree Physiology, 23:13-21 
+                   ! and Pakati et al. 2000, Global Change Biology, 6:889-897). 
+                   ! This effect is not accounted for in the current code
+
+                   ! Finally, k_latosa is also reported to be a function of 
+                   ! diameter (i.e. stand thinning, Simonin et al 2006, Tree 
+                   ! Physiology, 26:493-503). Here the relationship with thinning was 
+                   ! interpreted as a realtionship with light stress. Note that light 
+                   ! stress cannot be calculated at this time in the model because 
+                   ! there is no canopy (that's why we are in prescribe!) and
+                   ! so there is no lightstress. lstress was therefore set to one 
+                   ! (see above). We prefered to keep this redundancy in the code 
+                   ! because it makes it clear that k_latosa is calculated in the 
+                   ! same way in prescribe.f90 and growth_fun_all.f90
+                   k_latosa(ipts,ivm) = (k_latosa_adapt(ipts,ivm) + &
+                        (lstress_fac(ipts,ivm) * &
+                        (k_latosa_max(ivm)-k_latosa_min(ivm))))
+
+                   ! +++CHECK+++
+                   ! Ideally waterstress and lightstress should both
+                   ! affect k_latosa. One of the following approaches could
+                   ! be used as a starting point.
+                   !  k_latosa(ipts,ivm) = k_latosa_min(ivm) + &
+                   !     (wstress_fac(ipts,ivm) * lstress_fac(ipts,ivm) * &
+                   !     (k_latosa_max(ivm)-k_latosa_min(ivm)))
+                   !  k_latosa(ipts,ivm) = wstress_fac(ipts,ivm) * (k_latosa_min(ivm) + &
+                   !      (lstress_fac(ipts,ivm) * &
+                   !      (k_latosa_max(ivm)-k_latosa_min(ivm))))
+                   ! ++++++++++++
+
+                   ! Calculate conversion coefficient for sapwood area to leaf 
+                   ! area 
+                   ! (1) The scaling parameter between leaf and sapwood mass 
+                   ! is derived from LA_ind = k_latosa * SA_ind, where 
+                   ! LA_ind = leaf area of an individual, SA_ind is the sapwood 
+                   ! area of an individual and k_latosa a pipe-model parameter
+                   ! (2) LA_ind = Cl * sla
+                   ! (3) Cs = SA_ind * height * wooddensity * tree_ff
+                   ! Substitute (2) and (3) in (1)
+                   ! Cl = Cs * k1 / (wooddensity * sla * tree_ff * height)
+                   ! Cl = Cs*KF/height, where KF is in (m)
+                   ! KF is passed to the allocation routine and it is saved in the 
+                   ! restart file.
+                   KF(ipts,ivm) = k_latosa(ipts,ivm) / &
+                        ( sla(ivm) * pipe_density(ivm) * tree_ff(ivm))
+
+                   ! Initialize delta_KF to get the DO WHILE started
+                   delta_KF = un
+                   iloop=0
+                   DO WHILE (delta_KF .GT. max_delta_KF)
+
+                      ! If there is a WHILE loop, there always needs to be a check 
+                      ! on the number of loops to make sure we don't get stuck in 
+                      ! an infinite loop. This number is completely arbitrary.
+                      iloop=iloop+1
+                      IF(iloop > 1000)THEN
+
+                         WRITE(numout,*) 'Taking too long to converge the '//&
+                              'delta_KF loop in prescribe!'
+                         WRITE(numout,*) 'iloop,delta_KF,max_delta_KF,ivm,ipts: ',&
+                              iloop,delta_KF,max_delta_KF,ivm,ipts
+                         CALL ipslerr_p (3,'stomate_prescribe',&
+                              'Taking too long to converge the delta_KF','','')
+
+                      ENDIF
+
+
+                      ! Now we create the saplings for each class, based on the 
+                      ! height
+                      DO icir = 1,ncirc
+
+                         ! The assumption we make is that we plant trees of 2 to 3 
+                         ! years old rather than growing trees from seeds. The 
+                         ! allometric relationship between height and diameter is 
+                         ! derived from mature tree and likely unrealistic for 
+                         ! saplings. The height of the saplings is prescribed and 
+                         ! determines the reserves which are especially important 
+                         ! for deciduous species which need to survive on their 
+                         ! reserves for the first year (new phenology scheme requires 
+                         ! annual mean values to get started). These are aboveground
+                         ! values for dia_init and wood_init.
+                         dia_init = ( ave_tree_height(icir) / pipe_tune2(ivm) ) ** &
+                              ( 1. / pipe_tune3(ivm) )
+                         wood_init = ( ave_tree_height(icir) * pi / 4. * &
+                              (dia_init) ** 2. ) * pipe_density(ivm) * tree_ff(ivm)
+
+                         ! Use the variables from the pipe model and the allometric
+                         ! relationships to calculate the different biomass components
+                         ! of the saplings in each diameter class.
+                         CALL make_saplings(wood_init, bm_sapl, &
+                              ave_tree_height(icir), icir, ivm, &
+                              ipts, npts, KF, c0_alloc, plant_status, &
+                              establish)  
+
+                      ENDDO ! ncirc
+
+                      ! Determine the biomass in each circumference class.
+                      ! Calculations are based on the biomass in each sapling and 
+                      ! the number of trees in each circumference class. Total
+                      ! leaf biomass is needed for the light stress calculation
+                      ! below.
+                      DO icir=1,ncirc
+                         circ_class_biomass(ipts,ivm,icir,:,:) = &
+                              bm_sapl(ivm,icir,:,:)
+                      ENDDO
+
+                      ! The light stress should be calculated making use of Pgap so 
+                      ! it accounts for LAI crown dimensions and tree distribution. 
+                      ! However, this would be computationally expensive so we just 
+                      ! use a first order estimate based on light attenuation model 
+                      ! by Lambert-Beer. When LAI is low, a lot of light reaches the 
+                      ! forest floor and so KF should increase to make use of the 
+                      ! available light by growing leaves
+                      lstress_fac = &
+                           exp(-cc_to_lai(circ_class_biomass(ipts,ivm,:,ileaf,icarbon),&
+                           circ_class_n(ipts,ivm,:),ivm))
+
+                      ! Causing large differences between first and second prescribe
+                      delta_KF = ABS (KF(ipts,ivm) - ((k_latosa_adapt(ipts,ivm) + &
+                           (lstress_fac(ipts,ivm) * &
+                           (k_latosa_max(ivm)-k_latosa_min(ivm))))) / &
+                           ( sla(ivm) * tree_ff(ivm) * pipe_density(ivm) ))
+                      KF(ipts,ivm) = ((k_latosa_adapt(ipts,ivm) + &
+                           (lstress_fac(ipts,ivm) * &
+                           (k_latosa_max(ivm)-k_latosa_min(ivm)))) / &
+                           ( sla(ivm) * tree_ff(ivm) * pipe_density(ivm) ))
+
+                      ! Debug
+                      IF(printlev_loc>=4)THEN
+                         WRITE(numout,*) 'prescribe delta_KF, ', delta_KF
+                         WRITE(numout,*) 'prescribe lstress, ', lstress_fac
+                      ENDIF
+                      ! -
+
+                   END DO ! DO WHILE delta_KF
+
+                   ! The biomass of the saplings is known. Calculate the
+                   ! quadratic mean diameter and the max number of trees
+                   ! the stand can carry according to the self-thinning
+                   ! relationship. Calculate the tree distribution by making
+                   ! use of the prescribed number of trees
+                   circ_class_n(ipts,ivm,:) = circ_class_dist(:) / &
+                        SUM(circ_class_dist(:)) * nmaxtrees(ivm) * ha_to_m2
+
+                   ! Calculate the quadratic mean diameter of the prescribed
+                   ! stand.
+                   qmd_init = &
+                        wood_to_qmdia(circ_class_biomass(ipts,ivm,:,:,icarbon),&
+                        circ_class_n(ipts,ivm,:),ivm)
+ 
+                   ! Calculate the expected density under self-thinning.
+                   ! unit is trees.ha-1
+                   ind_init = Nmax(qmd_init*m_to_cm,ivm)
+
+                   ! Take the lowest density. The reason for taking the lowest
+                   ! is that the highest density could be up to 50 10E6 trees
+                   ! per hectare. Given that our allometric rules are for 
+                   ! mature trees, this then results in an LAI of ~980 which
+                   ! makes the albedo routine crash (because of quality checks).
+                   ! Because every individual tree hardly grows, self-thinning 
+                   ! goes way to slow. For these reason we start with a more
+                   ! reasonable number of trees per hectare and will use a
+                   ! background mortality to make the number of trees decrease
+                   IF (nmaxtrees(ivm) .GT. ind_init) THEN
+                      
+                      ! Recalculate stand density and diameter distribution
+                      circ_class_n(ipts,ivm,:) = circ_class_dist(:) / &
+                           SUM(circ_class_dist(:)) * ind_init * ha_to_m2
+
+                   ENDIF
+
+                   ! Debug
+                   IF (printlev_loc>=4) THEN
+                      DO icir=1,ncirc
+                         WRITE(numout,*)'icir, circ_class_n, ', icir, &
+                              circ_class_n(ipts,ivm,icir)
+                         WRITE(numout,*)'Initial biomass distribution - carbon'
+                         WRITE(numout,*) circ_class_biomass(ipts,ivm,icir,:,icarbon)
+                         WRITE(numout,*) circ_class_biomass(ipts,ivm,icir,:,initrogen)
+                      ENDDO
+                      WRITE(numout,*)' Total number of saplings', &
+                           SUM(circ_class_n(ipts,ivm,:))
+                   END IF
+                   !-
+
+                ELSEIF (recruite) THEN
+
+                   !! Calculate the number of recruits
+                   ! Recruitment is based on the light stress factor [0 1] computed
+                   ! above. It makes use of the functional response of recruitment
+                   ! to light described by Ruger et al (2009, J. of Ecol.,
+                   ! doi: 10.1111/j.1365-2745.2009.01552.x) in the 50-ha plot of Barro
+                   ! Colorado Island (BCI) in Panama: 
+                   ! Log10(Nrecruits)= A + B * ( Log10(lstress_fac) - MU )
+                   !
+                   ! Where Nrecruits is the number of recruits for an area of 25 m2.
+                   ! The parameter A is the intercept (mean log10 recruits expected), 
+                   ! B the slope (functional response), and MU=Log10(0.02)=-1.7 
+                   ! Here the recruitment response to light can be negative (B<0),
+                   ! decelerating (0<B<1), accelerating (B>1) or linear (B=1). 
+                   ! MU is needed here to express the fraction of light between 0 and 1
+                   ! centred on mean light 2% at BCI. The linearized (log-log) power
+                   ! model is implemented here for each PFT following the original setup
+                   ! of Ruger et al 2009 to ensure realistic values. IT COULD EASILY BE
+                   ! SIMPLIFIED. The predicted number of recruits is for an area of
+                   ! 25 m2 so we have to compute the antilogarithm and divide by 25 to
+                   ! get the estimate by 1 m2 which is the unit used in ORCHIDEE.
+                   !
+                   ! Add min_stomate (a very small number) to lstress_fac to avoid numerical
+                   ! issues with LOG10(zero) being undefined.
+                   IF (recruitment_alpha(ivm).LT.min_stomate .AND. &
+                        recruitment_beta(ivm).LT.min_stomate) THEN
+                      
+                      ! Sanity check. If the users sets both values to zero
+                      ! new_ind is set to zero. The simulation should be 
+                      ! identical to a simulation without recruitment.
+                      new_ind = zero
+                      
+                   ELSE
+
+                      ! Calculate the number of recruits
+                      new_ind = ( 10**( recruitment_alpha(ivm) + &
+                           recruitment_beta(ivm) * &
+                           ( LOG10(lstress_fac(ipts,ivm)+min_stomate) - &
+                           LOG10(0.02) ) ) )/25
+
+                   ENDIF
+
+                   ! Update the number of individuals
+                   tmp_ind = SUM(circ_class_n(ipts,ivm,:))
+                   old_ind = tmp_ind
+                   tmp_ind = tmp_ind + new_ind
+
+                   ! Debug
+                   IF(printlev_loc>=4)THEN
+                      WRITE(numout,*) 'PFT, ',ivm
+                      WRITE(numout,*) 'canopy cover (LAI), ',&
+                           cc_to_lai(circ_class_biomass(ipts,ivm,:,ileaf,icarbon),&
+                           circ_class_n(ipts,ivm,:),ivm) 
+                      WRITE(numout,*) 'used canopy_gap (%) is, ', lstress_fac(ipts,ivm)*100 
+                      WRITE(numout,*) 'Original ind is, ', (tmp_ind - new_ind)*m2_to_ha
+                      WRITE(numout,*) 'new_ind is, ', new_ind*m2_to_ha
+                      WRITE(numout,*) 'ind+new_ind is, ', tmp_ind*m2_to_ha
+                      qmd_init = &
+                        wood_to_qmdia(circ_class_biomass(ipts,ivm,:,:,icarbon),&
+                        circ_class_n(ipts,ivm,:),ivm)
+                      WRITE(numout,*) 'Dg (m) ', qmd_init
+                      ind_init = Nmax(qmd_init*m_to_cm,ivm)
+                      WRITE(numout,*) 'Nmax, ',ind_init
+                   ENDIF
+                   !-
+
+                   !! Calculate the dimensions of the recruits    
+                   ! The height of the saplings is prescribed and determines the reserves
+                   ! which are especially important for deciduous species, which need to
+                   ! survive on their reserves for the first couple of months to a whole
+                   ! year because the phenology scheme requires annual mean values to get
+                   ! started. Calculate sapling diameter and biomass for prescribed sapling
+                   ! height 
+                   dia_init = ( recruitment_height(ivm) / pipe_tune2(ivm) ) ** &
+                        ( 1. / pipe_tune3(ivm) )
+                   wood_init = (recruitment_height(ivm) * pi / 4. * (dia_init) ** 2. ) * &
+                        pipe_density(ivm) * tree_ff(ivm)
+
+                   ! Use the variables from the pipe model and the allometric
+                   ! relationships to calculate the different biomass components
+                   ! of the saplings in each diameter class.
+                   CALL make_saplings(wood_init, bm_sapl, recruitment_height(ivm), &
+                        1, ivm, ipts, npts, KF, c0_alloc, plant_status, establish)
+
+                   ! Debug
+                   IF (printlev_loc>=4) THEN
+                      WRITE(numout,*)'Prescribed recruitment height (m): ',recruitment_height(ivm)
+                      WRITE(numout,*)'Recruitment diameter (m) for prescribed height: ', dia_init
+                      WRITE(numout,*)'Wood_init recruitment: ',wood_init
+                      WRITE(numout,*)'ind_init ',ind_init
+                      WRITE(numout,*)'bm_sapl after calling make_saplings: ',bm_sapl(ivm,1,:,:)
+                   ENDIF
+                   !-
+
+                   ! Update the number of individuals in the first size class. All
+                   ! recruitment occurs in the circ_class with the smallest diameter
+                   old_circ_class_n(ipts,ivm,:) = circ_class_n(ipts,ivm,:)
+                   circ_class_n(ipts,ivm,1) = circ_class_n(ipts,ivm,1) + new_ind                        
+
+                   !! Determine the biomass in the first circumference class.
+                   ! This is a dillution approach were an average tree is made by making use
+                   ! of the biomass in the available trees and the biomass in the recruits.
+                   ! This is a simple mean weighted by the number of trees. The model needs
+                   ! the biomass in an individual tree (gC tree-1)
+                   DO iele = 1,nelements
+                      old_circ_class_biomass(ipts,ivm,:,:,iele) = &
+                           circ_class_biomass(ipts,ivm,:,:,iele) 
+                      circ_class_biomass(ipts,ivm,1,:,iele) = &
+                           (circ_class_biomass(ipts,ivm,1,:,iele) * &
+                           old_circ_class_n(ipts,ivm,1) + &
+                           bm_sapl(ivm,1,:,iele) * new_ind ) / &
+                           circ_class_n(ipts,ivm,1)
+                   ENDDO
+
+                   ! Debug
+                   IF (printlev_loc>=4) THEN
+                      WRITE(numout,*) "Canopy gap (%)", lstress_fac(ipts,ivm)*100
+                      WRITE(numout,*) "Original density (N/ha): ",&
+                           old_circ_class_n(ipts,ivm,:)*m2_to_ha
+                      WRITE(numout,*) "New density (N/ha): ",circ_class_n(ipts,ivm,:)*m2_to_ha
+                      WRITE(numout,*) "Recruited saplings per ha in first size class ", &
+                           new_ind * m2_to_ha
+                      WRITE(numout,*) "Original biomass per individual", &
+                           SUM(old_circ_class_biomass(ipts,ivm,:,:,icarbon),2),&
+                           SUM(old_circ_class_biomass(ipts,ivm,:,:,initrogen),2)
+                      WRITE(numout,*) "New biomass per individual", &
+                           SUM( circ_class_biomass(ipts,ivm,:,:,icarbon),2 ),&
+                           SUM( circ_class_biomass(ipts,ivm,:,:,initrogen),2 )
+                      WRITE(numout,*) "Biomass of new saplings gC/sapling", &
+                           bm_sapl(ivm,1,:,icarbon)
+                       WRITE(numout,*) "Biomass of new saplings gN/sapling", &
+                           bm_sapl(ivm,1,:,initrogen)
+                      WRITE(numout,*) "KF ", KF(ipts,ivm)
+                   ENDIF
+                   !-
+
+                ENDIF ! end prescribe/recruitment block
+
+                IF (establish) THEN
+
+                   ! Set leaf age classes, all leaves are current year leaves
+                   leaf_frac(ipts,ivm,:) = zero
+                   leaf_frac(ipts,ivm,1) = un
+
+                   ! Set time since last beginning of growing season but only
+                   ! for the first day of the whole simulation. When the model
+                   ! is initialized when_growthinit is set to undef. In subsequent
+                   ! time steps it should have a value. For trees without phenology
+                   ! the growing season starts at the moment the PFT is prescribed
+                   IF (when_growthinit(ipts,ivm) .EQ. undef) THEN
+                      when_growthinit(ipts,ivm) = 200
+                   ENDIF
+
+                ENDIF
+
+                ! The carbon and nitrogen to build the saplings is taken from the 
+                ! atmosphere, keep track of amount to calculate the C-balance 
+                ! closure
+                IF (establish) THEN
+
+                   ! The whole biomass of this PFT was taken from the
+                   ! atmosphere
+                   atm_to_bm(ipts,ivm,:) = atm_to_bm(ipts,ivm,:) + &
+                        (SUM(cc_to_biomass(npts, ivm, &
+                        circ_class_biomass(ipts,ivm,:,:,:), &
+                        circ_class_n(ipts,ivm,:)),1) / dt )
+
+                ELSEIF (recruite) THEN
+
+                   ! Only the increase in biomass of this PFT was taken
+                   ! from the atmosphere
+                   atm_to_bm(ipts,ivm,:) = atm_to_bm(ipts,ivm,:) + &
+                        (SUM(cc_to_biomass(npts, ivm, &
+                        circ_class_biomass(ipts,ivm,:,:,:), &
+                        circ_class_n(ipts,ivm,:)) - &
+                        old_biomass(ipts,ivm,:,:),1)  / dt )
+                   
+                ENDIF
+
+                ! Check whether the order was preserved. We only want to
+                ! preserve the order for the carbon biomass. Nitrogen follows
+                ! carbon. We expect that the biomass of an individual tree 
+                ! increases with an increasing circ class. This is probably 
+                ! not important for the correct functioning of the model. So,
+                ! if this turns out to be computationally expensive it is 
+                ! worth trying without. We try to preserve the order as
+                ! an additional mean to control the quality of the simulations.
+                ! A strict order also helps to interpret the output. Hence, 
+                ! if the order was not preserved we will sort the biomasses. 
+                ! Note that this subroutine first checks whether the order 
+                ! was preseverd.
+                circ_class_biomass_new = circ_class_biomass(ipts,ivm,:,:,:)
+                circ_class_n_new = circ_class_n(ipts,ivm,:)
+                CALL sort_circ_class_biomass(circ_class_biomass_new, &
+                     circ_class_n_new)
+                circ_class_biomass(ipts,ivm,:,:,:) = circ_class_biomass_new
+                circ_class_n(ipts,ivm,:) = circ_class_n_new
+
+             ENDIF ! tree(ivm)
+
+             !! 2.3.2 Initialize grassy PFTs
+             !  Use veget_cov_max to check whether the PFT is present. If the PFT is 
+             !  present but it has no biomass, prescribe its biomass (gC m-{2}). 
+             !  It is assumed that at day 1 grasses have all their biomass in the 
+             !  reserve pool. The criteria exclude crops. Crops are no longer 
+             !  prescribed but planted the day that begin_leaves is true.
+             IF (establish) THEN
+
+                IF ( ( .NOT. is_tree(ivm) ) .AND. &
+                     ( natural(ivm) ) .AND. &
+                     ( veget_cov_max(ipts,ivm) .GT. min_stomate ) .AND. &
+                     ( SUM(circ_class_biomass(ipts,ivm,1,:,icarbon) ) .LE. min_stomate ) ) THEN
+
+                   ! Debug
+                   IF(printlev_loc>=4)THEN
+                      WRITE(numout,*) 'We will prescribe a new grass  '//&
+                           'vegetation, the old one died'
+                   ENDIF
+                   ! -
+
+                   ! For grasses we assume that an individual grass is 1 m2 of grass. 
+                   ! This is set in nmaxtrees in pft_parameters.f90. It could be set 
+                   ! to another value but with the current code this should not have 
+                   ! any meaning. The grassland does not necessarily covers the whole 
+                   ! 1 m2 so adjust for the canopy cover
+                   tmp_ind = nmaxtrees(ivm) * ha_to_m2 * canopy_cover(ivm)
+
+                   !+++CHECK+++
+                   ! We do not deal with circumference classes for grasses
+                   ! and crops, but we want to keep the arrays the same as for the trees 
+                   ! so we put the young grass information into the first circumference 
+                   ! class. Calculate the sapwood to leaf mass in a similar way as has 
+                   ! been done for trees. For trees this approach had been justified by 
+                   ! observations. For grasses such justification is not supported by 
+                   ! observations but we didn't try to find it. Needs more work by 
+                   ! someone interested in grasses. There might be a more elegant
+                   ! solution making use of a well observed parameter. 
+                   k_latosa(ipts,ivm) = (k_latosa_adapt(ipts,ivm) + &
+                        (lstress_fac(ipts,ivm) * &
+                        (k_latosa_max(ivm)-k_latosa_min(ivm))))
+
+                   ! The mass of the structural carbon relates to the mass of the leaves 
+                   ! through a prescribed parameter ::k_latosa
+                   KF(ipts,ivm) = k_latosa(ipts,ivm)
+                   !+++++++++++
+
+                   ! Calculate leaf to root area    
+                   LF(ipts,ivm) = c0_alloc(ivm) * KF(ipts,ivm)
+
+                   ! Debug
+                   IF(printlev_loc>=4.AND. test_pft == ivm)THEN
+                      WRITE(numout,*) 'KF, ', k_latosa(ipts,ivm), KF(ipts,ivm)
+                      WRITE(numout,*) 'LF, c0_alloc, ', c0_alloc(ivm) * KF(ipts,ivm), &
+                           c0_alloc(ivm)
+                   ENDIF
+                   !-
+
+                   ! initialize everything to make sure there are not random values 
+                   ! floating around for ncirc = 1
+                   bm_sapl(ivm,1,:,:) = val_exp
+
+                   ! Similar as for trees, the initial height of the vegetation was 
+                   ! defined 
+                   bm_sapl(ivm,1,ileaf,icarbon) = height_init_min(ivm) / &
+                        lai_to_height(ivm) / sla(ivm)
+
+                   ! Use allometric relationships to define the root mass based on 
+                   ! leaf mass. Some 'sapwood mass' is needed to store the reserves. 
+                   ! An arbitrairy fraction of 5% was used 
+                   bm_sapl(ivm,1,iroot,icarbon) = bm_sapl(ivm,1,ileaf,icarbon) / &
+                        LF(ipts,ivm)
+                   bm_sapl(ivm,1,isapabove,icarbon) = bm_sapl(ivm,1,ileaf,icarbon) / &
+                        KF(ipts,ivm)
+
+                   ! Some of the biomass components that exist for trees are undefined 
+                   ! for grasses
+                   bm_sapl(ivm,1,isapbelow,icarbon) = zero
+                   bm_sapl(ivm,1,iheartabove,icarbon) = zero
+                   bm_sapl(ivm,1,iheartbelow,icarbon) = zero
+                   bm_sapl(ivm,1,ifruit,icarbon) = zero
+                   bm_sapl(ivm,1,icarbres,icarbon) = zero
+
+                   ! Pools that are defined in the same way for trees and grasses
+                   bm_sapl(ivm,1,ilabile,icarbon) = labile_to_total * &
+                        (bm_sapl(ivm,1,ileaf,icarbon) + &
+                        fcn_root(ivm) * bm_sapl(ivm,1,iroot,icarbon) + fcn_wood(ivm) * &
+                        (bm_sapl(ivm,1,isapabove,icarbon) + &
+                        bm_sapl(ivm,1,isapbelow,icarbon) + &
+                        bm_sapl(ivm,1,icarbres,icarbon)))
+
+                   ! Allocate the nitrogen
+                   cn_leaf=cn_leaf_init(ivm) 
+                   cn_wood=cn_leaf/fcn_wood(ivm) 
+                   cn_root=cn_leaf/fcn_root(ivm) 
+
+                   !+++CHECK+++
+                   ! See comments at a similmar block of code for the
+                   ! tree saplings
+                   ! Use the C/N ratio to calculate the N content for
+                   ! all the biomass components.
+                   bm_sapl(ivm,1,:,initrogen) = &
+                        bm_sapl(ivm,1,:,icarbon) / cn_root
+
+                   ! Overwrite the N content for the leaves and wood
+                   ! components. Note that only sapabove is defined the
+                   ! other wood components are zero
+                   bm_sapl(ivm,1,ileaf,initrogen) = &
+                        bm_sapl(ivm,1,ileaf,icarbon) / cn_leaf
+                   bm_sapl(ivm,1,isapabove,initrogen) = &
+                        bm_sapl(ivm,1,isapabove,icarbon) / cn_wood
+                   !++++++++++++
+
+                   ! Avoid deciduous PFTs to have leaves out at establishment
+                   ! Whether the saplings have leaves or don't have leaves the first 
+                   ! year doesn't really matter. Either the approach is correct in the 
+                   ! northern hemisphere or in the southern hemisphere. Note
+                   ! that the resource limitation approach starts with the sapling having 
+                   ! leaves. Anyhow, a spin-up is recommended to avoid issues with the 
+                   ! initial conditions
+                   IF ( pheno_type(ivm) .NE. 1 ) THEN
+
+                      ! Not evergreen. Deciduous PFTs now need to survive half a year 
+                      ! before bud burst. To ensure survival there are several options: 
+                      ! (a) either the height of the initial vegetation is increased 
+                      ! (this results in more reserves) or (b) the reserves could be
+                      ! increased. The second option may result in result in numerical 
+                      ! issues further down the code as the optimal reserve level is 
+                      ! calculated from the other biomass pools
+                      bm_sapl(ivm,1,icarbres,:) = bm_sapl(ivm,1,icarbres,:) + &
+                           bm_sapl(ivm,1,ileaf,:) + &
+                           bm_sapl(ivm,1,iroot,:) + &
+                           bm_sapl(ivm,1,isapabove,:)
+                      bm_sapl(ivm,1,ileaf,:) = zero
+                      bm_sapl(ivm,1,iroot,:) = zero
+                      bm_sapl(ivm,1,isapabove,:) = zero
+
+                      ! When there are no leaves, the crop/grass is dormant
+                      plant_status(ipts,ivm) = idormant
+
+                   ELSE
+
+                      ! Initilize carbohydrate reserves for evergreen PFTs
+                      bm_sapl(ivm,1,icarbres,:) = zero 
+
+                      ! Evergreen plants always have a canopy
+                      plant_status(ipts,ivm) = icanopy
+
+                   ENDIF
+
+                   ! Debug
+                   IF (printlev_loc>=4) THEN
+                      DO iele=1,nelements
+                         WRITE(numout,*) ' young grass biomass (gC):',ivm,ipts
+                         WRITE(numout,*) '  bm_sapl(:,1,ileaf,:,) ',&
+                              bm_sapl(ivm,1,ileaf,iele)
+                         WRITE(numout,*) '  bm_sapl(:,1,ispabove,:) ',&
+                              bm_sapl(ivm,1,isapabove,iele)
+                         WRITE(numout,*) '  bm_sapl(:,1,isapbelow,:) ',&
+                              bm_sapl(ivm,1,isapbelow,iele)
+                         WRITE(numout,*) '  bm_sapl(:,1,iheartabove,:) ',&
+                              bm_sapl(ivm,1,iheartabove,iele)
+                         WRITE(numout,*) '  bm_sapl(:,1,iheartbelow,:) ',&
+                              bm_sapl(ivm,1,iheartbelow,iele)
+                         WRITE(numout,*) '  bm_sapl(:,1,iroot,:) ',&
+                              bm_sapl(ivm,1,iroot,iele)
+                         WRITE(numout,*) '  bm_sapl(:,1,ifruit,:)', &
+                              bm_sapl(ivm,1,ifruit,iele)
+                         WRITE(numout,*) '  bm_sapl(:,1,icarbres,:)', &
+                              bm_sapl(ivm,1,icarbres,iele)
+                         WRITE(numout,*) '  bm_sapl(:,1,ilabile,:)', &
+                              bm_sapl(ivm,1,ilabile,iele)
+                      ENDDO
+                   ENDIF
+                   ! -
+
+                   ! Synchronize biomass and circ_class_biomass (gC tree-1). This 
+                   ! allows to more easily check the mass balance closure
+                   circ_class_biomass(ipts,ivm,1,:,:) = bm_sapl(ivm,1,:,:)
+                   circ_class_n(ipts,ivm,1) = tmp_ind
+
+                   ! Set leaf age classes -> all leaves will be current year leaves
+                   leaf_frac(ipts,ivm,:) = zero
+                   leaf_frac(ipts,ivm,1) = un
+
+                   ! Set time since last beginning of growing season but only
+                   ! for the first day of the whole simulation. When the model
+                   ! is initialized when_growthinit is set to undef. In subsequent
+                   ! time steps it should have a value.
+                   IF (when_growthinit(ipts,ivm) .EQ. undef) THEN
+                      when_growthinit(ipts,ivm) = 200
+                   ENDIF
+
+                   ! The carbon and nitrogen biomass to build the saplings is taken 
+                   ! from the atmosphere, keep track of amount to calculate the mass 
+                   ! balance closure
+                   DO iele = 1,nelements
+                      atm_to_bm(ipts,ivm,iele) = atm_to_bm(ipts,ivm,iele) + &
+                           ((SUM(circ_class_biomass(ipts,ivm,1,:,iele))*&
+                           circ_class_n(ipts,ivm,1)) / dt)
+                   ENDDO
+
+                   ! Debug
+                   IF (printlev_loc>=4) THEN
+                      DO iele=1,nelements
+                         WRITE(numout,*) ' root to sapwood tradeoff (LF) : ', c0_alloc(ivm)
+                         WRITE(numout,*) ' grass sapling biomass: ',bm_sapl(ivm,1,:,iele)
+                      ENDDO
+                   ENDIF
+                   ! -
+
+                ELSEIF (.NOT. natural(ivm)) THEN
+
+                   ! Initialize croplands - else leaves_begin will never become true
+                   ! Set time since last beginning of growing season but only
+                   ! for the first day of the whole simulation. When the model
+                   ! is initialized when_growthinit is set to undef. In subsequent
+                   ! time steps it should have a value.
+                   IF (when_growthinit(ipts,ivm) .EQ. undef) THEN
+                      when_growthinit(ipts,ivm) = 200
+                   ENDIF
+
+                   ! Debug
+                   IF (printlev_loc>=4) WRITE(numout,*) 'Initialize crops',ivm
+                   !-
+
+                ENDIF ! .NOT. tree(ivm)
+
+             ENDIF ! establish (for .NOT. is_tree(ivm)) 
+
+             !! 2.3.3 Declare PFT present 
+             !! Now that the PFT has biomass it should be declared 'present'
+             !! everywhere in that grid box. Assign some additional properties
+             IF (establish) THEN
+                PFTpresent(ipts,ivm) = .TRUE.
+                everywhere(ipts,ivm) = un
+                age(ipts,ivm) = zero
+                npp_longterm(ipts,ivm) = npp_longterm_init
+                lm_lastyearmax(ipts,ivm) = zero
+             ENDIF
+
+          ENDIF ! establish or recruite
+
+       ENDDO ! loop over pixels
+
+    ENDDO ! loop over PFTs
+
+ !! 3. Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 3.1 Check surface area
+       CALL check_surface_area("stomate_prescribe", npts, veget_cov_max_begin, &
+            veget_cov_max,'pft')
+
+       ! 3.2 Mass balance closure 
+       ! 3.2.1 Calculate final biomass
+       pool_end(:,:,:) = zero 
+       DO ipar = 1,nparts
+          DO iele = 1,nelements
+             DO icir = 1,ncirc
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                     (circ_class_biomass(:,:,icir,ipar,iele) * &
+                     circ_class_n(:,:,icir) * veget_cov_max(:,:))
+             ENDDO
+          ENDDO
+       ENDDO
+
+       ! 3.2.2 Calculate mass balance
+       ! Common processes
+       DO iele=1,nelements
+          check_intern(:,:,iatm2land,iele) = check_intern(:,:,iatm2land,iele) + &
+               atm_to_bm(:,:,iele) * veget_cov_max(:,:) * dt
+          check_intern(:,:,ipoolchange,iele) = -un * (pool_end(:,:,iele) - &
+               pool_start(:,:,iele)) 
+       ENDDO
+
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=3) THEN              
+                IF(iele .EQ. 1) WRITE(numout,"(9999(G12.5,:,','))") &
+                  'imbc, test_pft, check_intern', test_grid , imbc, &
+                  test_pft, check_intern(test_grid,test_pft,imbc,iele)
+                ENDIF
+             !-
+             closure_intern(:,:,iele) = closure_intern(:,:,iele) + &
+                  check_intern(:,:,imbc,iele)
+          ENDDO
+       ENDDO
+
+       ! 3.3 Check mass balance closure
+       CALL check_mass_balance("stomate_prescribe", closure_intern, npts, &
+            pool_end, pool_start, veget_cov_max, 'pft')
+      
+    ENDIF ! err_act.GT.1
+
+    IF(printlev>=3) WRITE(numout,*) 'Leaving stomate_prescribe.f90'
+
+    firstcall_prescribe = .FALSE.
+     
+  END SUBROUTINE prescribe
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : make_sapling
+!!
+!>\BRIEF Given the dimensions and the allocation factors, calculate the biomass of a sapling        
+!!
+!! DESCRIPTION (functional, design, flags):
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLES(S): ::bm_sapl, ::KF
+!!
+!! REFERENCES   :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE make_saplings(wood_init, bm_sapl, tree_height, icir, &
+                           ivm, ipts, npts, KF, c0_alloc, plant_status, &
+                           establish)
+
+    !! 0. Parameters and variables declaration
+
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(in)                            :: wood_init
+    REAL(r_std), INTENT(in)                            :: tree_height        !! Tree height (m)
+    INTEGER(i_std), INTENT(in)                         :: ivm, icir, ipts    !! index (unitless)
+    INTEGER(i_std), INTENT(in)                         :: npts               !! Domain size (unitless)
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: c0_alloc           !! Root to sapwood tradeoff parameter
+    LOGICAL, INTENT(in)                                :: establish          !! yes: establish a new young vegetation. 
+                                                                             !! No: add saplings under an existing vegetation
+
+    !! 0.2 Output variables
+    
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(:,:,:,:),INTENT(inout)      :: bm_sapl            !! Sapling biomass for the functional 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: KF                 !! Scaling factor to convert sapwood mass
+                                                                             !! into leaf mass (m) - this variable is 
+                                                                             !! passed to other routines
+    REAL, DIMENSION(:,:), INTENT(inout)                :: plant_status       !! Growth and phenological status of the plant 
+                                                                             !! Different stati defined in constants
+    !! 0.4  Local variables
+    INTEGER(i_std)                                    :: iele                !! index (unitless) 
+    REAL(r_std)                                       :: cn_leaf,cn_root     !! CN ratio of leaves and roots (gC/gN)
+    REAL(r_std)                                       :: cn_wood             !! CN ratio of wood pool (gC/gN)        
+   
+
+
+!_ ================================================================================================================================
+
+      ! The woody biomass is contained in four components. Thus, 
+      ! wood_init = isapabove + isapbelow + iheartabove + iheartbelow. 
+      ! Given that isapbelow = isapbelow and iheartabove = 
+      ! iheartbelow =  bm_sapl_heartabove*isapabove. If 
+      ! bm_sapl_heartbelow = bm_sapl_heartabove = 0.2, then 
+      ! isapabove = wood_init/2.4
+      bm_sapl(ivm,icir,isapabove,icarbon) = wood_init / &
+           (2. + bm_sapl_heartabove + bm_sapl_heartbelow) 
+      bm_sapl(ivm,icir,isapbelow,icarbon) = bm_sapl(ivm,icir,isapabove,icarbon)
+      bm_sapl(ivm,icir,iheartabove,icarbon) =  bm_sapl_heartabove * &
+           bm_sapl(ivm,icir,isapabove,icarbon)
+      bm_sapl(ivm,icir,iheartbelow,icarbon) =  bm_sapl_heartbelow * &
+           bm_sapl(ivm,icir,isapbelow,icarbon)          
+
+      ! Use the allometric relationships to calculate initial leaf 
+      ! and root mass. Note that wstress should be accounted for
+      ! through c0_alloc. There was an inconsistency in the
+      ! original calculation (OCN) - most pools were in gN but 
+      ! leaves were in gC. A correction is proposed. Given that 
+      ! icarbes was just set to zero the equation for ilabile is 
+      ! a bit overkill and icarbes could be omitted.
+      bm_sapl(ivm,icir,ileaf,icarbon) = ( bm_sapl(ivm,icir,isapabove,icarbon) + &
+           bm_sapl(ivm,icir,isapbelow,icarbon) ) * KF(ipts,ivm) /  tree_height 
+      bm_sapl(ivm,icir,iroot,icarbon) = bm_sapl(ivm,icir,ileaf,icarbon) / &
+           ( KF(ipts,ivm) * c0_alloc(ivm) )
+      bm_sapl(ivm,icir,icarbres,icarbon)=zero
+      bm_sapl(ivm,icir,ifruit,icarbon) = zero
+      bm_sapl(ivm,icir,ilabile,icarbon) =  labile_to_total * &
+           (bm_sapl(ivm,icir,ileaf,icarbon)  + &
+           fcn_root(ivm) * bm_sapl(ivm,icir,iroot,icarbon) + &
+           fcn_wood(ivm) * (bm_sapl(ivm,icir,isapabove,icarbon) + &
+           bm_sapl(ivm,icir,isapbelow,icarbon) + &
+           bm_sapl(ivm,icir,icarbres,icarbon)))      
+
+      ! Debug
+      IF (printlev_loc>=4) THEN 
+         WRITE(numout,*) ' +++++ CHECK INSIDE make_sapling ++++ '
+         WRITE(numout,*) 'Circumference class: ',icir,' PFT type: ',ivm
+         WRITE(numout,*) ' root to sapwood tradeoff p :', c0_alloc(ivm)
+         WRITE(numout,*) ' sapling height, sapling diameter, wood_init, ', &
+              tree_height , ( tree_height/pipe_tune2(ivm) ) ** &
+              ( 1. / pipe_tune3(ivm) ), wood_init
+         WRITE(numout,*) 'pipe_density, ',pipe_density(ivm)
+      ENDIF
+      ! -
+
+      ! Allocate the nitrogen
+      cn_leaf=cn_leaf_init(ivm)
+      cn_wood=cn_leaf/fcn_wood(ivm)
+      cn_root=cn_leaf/fcn_root(ivm)
+
+      ! Use the C/N ratio to calculate the N content for
+      ! all the biomass components.
+      bm_sapl(ivm,icir,:,initrogen) = &
+           bm_sapl(ivm,icir,:,icarbon) / cn_root
+
+      ! Overwrite the N content for the leaves and wood
+      ! components.
+      bm_sapl(ivm,icir,ileaf,initrogen) = &
+           bm_sapl(ivm,icir,ileaf,icarbon) / cn_leaf
+      bm_sapl(ivm,icir,isapabove,initrogen) = &
+           bm_sapl(ivm,icir,isapabove,icarbon) / cn_wood
+      bm_sapl(ivm,icir,isapbelow,initrogen) = &
+           bm_sapl(ivm,icir,isapbelow,icarbon) / cn_wood
+      bm_sapl(ivm,icir,iheartabove,initrogen) = &
+           bm_sapl(ivm,icir,iheartabove,icarbon) / cn_wood
+      bm_sapl(ivm,icir,iheartbelow,initrogen) = &
+           bm_sapl(ivm,icir,iheartbelow,icarbon) / cn_wood
+
+      ! Avoid deciduous PFTs to have leaves out at establishment
+      ! Whether the saplings have leaves or don't have leaves the
+      ! first year doesn't really matter. Either the approach is
+      ! correct in the northern hemisphere or in the southern
+      ! hemisphere. Anyhow, a spin-up is needed to avoid issues
+      ! with the initial conditions
+      IF ( pheno_type(ivm) .NE. 1 ) THEN
+         
+         ! Not evergreen. Deciduous PFTs now need to survive an extra
+         ! year before bud burst. To ensure survival there are several
+         ! options: (a) either the height of the initial vegetation is
+         ! increased (this results in more reserves) or (b) the reserves
+         ! could be increased. The second option may result in numerical
+         ! issues further down the code as the optimal reserve level is
+         ! calculated from the other biomass pools. Also some initial
+         ! tests showed that higher reserves simply resulted in more
+         ! respiration.
+         ! Tip: use taller trees to start with if they die between
+         ! prescribe and leaf onset
+         bm_sapl(ivm,icir,icarbres,:) = (bm_sapl(ivm,icir,icarbres,:) + &
+              bm_sapl(ivm,icir,ileaf,:) + bm_sapl(ivm,icir,iroot,:))
+         bm_sapl(ivm,icir,ileaf,:) = zero
+         bm_sapl(ivm,icir,iroot,:) = zero
+      
+         ! When deciduous trees have no leaves they are dormant
+         ! If the code is used for recruitment use the actual 
+         ! plant_status of the overstorey trees for the saplings
+         IF (establish) THEN
+            plant_status(ipts,ivm) = idormant
+         ENDIF
+         
+      ELSE
+         
+         ! Initilize carbohydrate reserves for evergreen PFTs
+         bm_sapl(ivm,icir,icarbres,:) = zero
+
+         ! Evergreen trees always have a canopy. If the code
+         ! is used for recruitment use the actual plant_status 
+         ! of the overstorey trees for the saplings
+         IF (establish) THEN
+            plant_status(ipts,ivm) = icanopy
+         ENDIF
+    
+      ENDIF
+
+      ! Debug
+      IF (printlev_loc>=4) THEN
+         DO iele=1,nelements
+            WRITE(numout,*) ' sapling biomass (gC):',icir,ivm,ipts
+            WRITE(numout,*) '  bm_sapl(:,:,ileaf,:,) ',&
+                 bm_sapl(ivm,icir,ileaf,iele)
+            WRITE(numout,*) '  bm_sapl(:,:,ispabove,:) ',&
+                 bm_sapl(ivm,icir,isapabove,iele)
+            WRITE(numout,*) '  bm_sapl(:,:,isapbelow,:) ',&
+                 bm_sapl(ivm,icir,isapbelow,iele)
+            WRITE(numout,*) '  bm_sapl(:,:,iheartabove,:) ',&
+                 bm_sapl(ivm,icir,iheartabove,iele)
+            WRITE(numout,*) '  bm_sapl(:,:,iheartbelow,:) ',&
+                 bm_sapl(ivm,icir,iheartbelow,iele)
+            WRITE(numout,*) '  bm_sapl(:,:,iroot,:) ',&
+                 bm_sapl(ivm,icir,iroot,iele)
+            WRITE(numout,*) '  bm_sapl(:,:,ifruit,:)', &
+                 bm_sapl(ivm,icir,ifruit,iele)
+            WRITE(numout,*) '  bm_sapl(:,:,icarbres,:)', &
+                 bm_sapl(ivm,icir,icarbres,iele)
+            WRITE(numout,*) '  bm_sapl(:,:,ilabile,:)', &
+                 bm_sapl(ivm,icir,ilabile,iele)
+         ENDDO
+      ENDIF
+      
+   END SUBROUTINE make_saplings
+  
+END MODULE stomate_prescribe
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_resp.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_resp.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_resp.f90	(revision 6412)
@@ -0,0 +1,474 @@
+! =================================================================================================================================
+! MODULE           : stomate_resp
+!
+! CONTACT          : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE          : IPSL (2006)
+!                  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF           Calculates maintenance respiration for different plant components
+!!
+!!\n DESCRIPTION   : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	   :
+!!- McCree KJ. An equation for the respiration of white clover plants grown under controlled conditions. 
+!! In: Setlik I, editor. Prediction and measurement of photosynthetic productivity. Wageningen, The Netherlands: 
+!! Pudoc; 1970. p. 221-229.
+!! - Krinner G, Viovy N, de Noblet-Ducoudre N, Ogee J, Polcher J, Friedlingstein P,
+!! Ciais P, Sitch S, Prentice I C (2005) A dynamic global vegetation model for studies
+!! of the coupled atmosphere-biosphere system. Global Biogeochemical Cycles, 19, GB1015,
+!! doi: 10.1029/2003GB002199.\n
+!! Ruimy A., Dedieu G., Saugier B. (1996), TURC: A diagnostic model
+!! of continental gross primary productivity and net primary productivity,
+!! Global Biogeochemical Cycles, 10, 269-285.\n
+
+!! SVN :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+ 
+MODULE stomate_resp
+
+  ! modules used:
+  USE stomate_data
+  USE pft_parameters
+  USE constantes  
+  USE constantes_soil
+  USE function_library, ONLY : biomass_to_lai
+
+  IMPLICIT NONE
+
+  ! private & public routines
+  PRIVATE
+  PUBLIC maint_respiration,maint_respiration_clear
+
+  LOGICAL, SAVE                                              :: firstcall_resp = .TRUE.                 !! first call
+!$OMP THREADPRIVATE(firstcall_resp)
+
+  CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: maint_respiration_clear
+!!
+!>\BRIEF        : Set the flag ::firstcall_resp to .TRUE. and as such activate section 
+!!                1.1 of the subroutine maint_respiration (see below).
+!_ ================================================================================================================================
+
+  SUBROUTINE maint_respiration_clear
+    firstcall_resp=.TRUE.
+  END SUBROUTINE maint_respiration_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: maint_respiration
+!!
+!>\BRIEF         Calculate PFT maintenance respiration of each living plant part by 
+!! multiplying the biomass of plant part by maintenance respiration coefficient which
+!! depends on long term mean annual temperature. PFT maintenance respiration is carbon flux 
+!! with the units @tex $(gC.m^{-2}dt_sechiba^{-1})$ @endtex, and the convention is from plants to the 
+!! atmosphere.
+!!
+!! DESCRIPTION : The maintenance respiration of each plant part for each PFT is the biomass of the plant 
+!! part multiplied by maintenance respiration coefficient. The biomass allocation to different 
+!! plant parts is done in routine stomate_alloc.f90. The maintenance respiration coefficient is 
+!! calculated in this routine.\n
+!!
+!! The maintenance respiration coefficient is the fraction of biomass that is lost during 
+!! each time step, which increases linearly with temperature (2-meter air temperature for aboveground plant
+!! tissues; root-zone temperature for below-ground tissues). Air temperature is an input forcing variable. 
+!! Root-zone temperature is a convolution of root and soil temperature profiles and also calculated 
+!! in this routine.\n
+!!
+!! The calculation of maintenance respiration coefficient (fraction of biomass respired) depends linearly
+!! on temperature:
+!! - the relevant temperature for different plant parts (air temperature or root-zone temperature)\n
+!! - intercept: prescribed maintenance respiration coefficients at 0 Degree Celsius for 
+!!   different plant parts for each PFT in routine stomate_constants.f90\n
+!! - slope: calculated with a quadratic polynomial with the multi-annual mean air temperature 
+!! (the constants are in routine stomate_constants.f90) as follows\n 
+!!    \latexonly
+!!      \input{resp3.tex} 
+!!    \endlatexonly
+!!   Where, maint_resp_slope1, maint_resp_slope2, maint_resp_slope3 are constant in stomate_constants.f90.
+!!   Then coeff_maint is calculated as follows:\n
+!!    \latexonly
+!!      \input{resp4.tex} 
+!!    \endlatexonly  
+!! If the calculation result is negative, maintenance respiration coefficient will take the value 0.
+!! Therefore the maintenance respiration will also be 0.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): PFT maintenance respiration of different plant parts (::resp_maint_part_radia)
+!!
+!! REFERENCE(S)	:
+!! McCree KJ. An equation for the respiration of white clover plants grown under controlled conditions. In: 
+!! Setlik I, editor. Prediction and measurement of photosynthetic productivity. Wageningen, 
+!! The Netherlands: Pudoc; 1970. p. 221-229.
+!! Krinner G, Viovy N, de Noblet-Ducoudre N, Ogee J, Polcher J, Friedlingstein P,
+!! Ciais P, Sitch S, Prentice I C (2005) A dynamic global vegetation model for studies
+!! of the coupled atmosphere-biosphere system. Global Biogeochemical Cycles, 19, GB1015,
+!! doi: 10.1029/2003GB002199.\n
+!! Ruimy A., Dedieu G., Saugier B. (1996), TURC: A diagnostic model
+!! of continental gross primary productivity and net primary productivity,
+!! Global Biogeochemical Cycles, 10, 269-285.\n
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE maint_respiration (npts, dt, t2m, tlong_ref, &
+       stempdiag, gpp, gpp_week, lab_fac, &
+       veget_cov_max, rprof, resp_maint_part_radia, &
+       circ_class_n, circ_class_biomass)
+
+!! 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(:), INTENT(in)           :: tlong_ref    !! Long term annual mean 2 meter reference air temperatures 
+                                                                    !! calculated in stomate_season.f90 (K)
+    REAL(r_std), DIMENSION(:,:), INTENT (in)        :: stempdiag    !! Soil temperature of each soil layer (K)
+!++++CHECK++++
+! gpp and gpp_week are not used in the code
+! They can perhaps be removed
+    REAL(r_std), DIMENSION(:,:), INTENT(in)         :: gpp          !! Gross primary production per day per unit PFT
+                                                                    !! @tex $ (gC m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)         :: gpp_week     !! Weekly mean gross primary production per day per unit PFT
+                                                                    !! @tex $ (gC m^{-2} dt^{-1})$ @endtex
+!++++++++++++
+    REAL(r_std), DIMENSION(:,:), INTENT(in)         :: veget_cov_max    !! PFT "maximal" coverage fraction of a PFT (unitless)
+    REAL(r_std), DIMENSION(:,:), 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(:,:), INTENT(in)         :: lab_fac      !! Activity of labile pool (??UNITS??)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)       :: circ_class_n !! Number of individuals in each circ class
+                                                                    !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)   :: circ_class_biomass !! Biomass components of the model tree  
+                                                                    !! within a circumference class
+                                                                    !! class @tex $(g C ind^{-1})$ @endtex
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(:,:,:), 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
+    INTEGER(i_std)                          :: ipts,ivm,ipar,ibdl   !! Indeces (unitless)
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)    :: z_soil       !! Variable to store depth of the different soil layers (m)
+!$OMP THREADPRIVATE(z_soil)
+    REAL(r_std), DIMENSION(npts,nvm)        :: t_root               !! PFT root temperature (convolution of root and soil 
+                                                                    !! temperature profiles) (K)
+    REAL(r_std), DIMENSION(npts,nvm,nparts) :: coeff_maint          !! PFT maintenance respiration coefficients of different 
+                                                                    !! plant compartments at 0 deg C 
+    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(nvm,nparts)      :: fcn                  !! C/N ratio in tissue (unitless)
+    REAL(r_std), DIMENSION(npts,nvm)        :: resp_maint_demand    !! Rate of maintanance respiration
+                                                                    !! @tex $(gC.dt^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)        :: resp_maint_supply    !! Rate of growth respiration
+                                                                    !! @tex $(gC.dt^{-1})$ @endtex                                  
+    REAL(r_std), DIMENSION(npts,nvm)        :: resp_maint           !! Effective rate of maintanance respiration
+                                                                    !! @tex $(gC.dt^{-1})$ @endtex   
+    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)
+    REAL(r_std), DIMENSION(npts)            :: rpc                  !! Scaling factor for integrating vertical soil 
+                                                                    !! profiles (unitless)
+    REAL(r_std), DIMENSION(nvm)             :: coeff_maint_temp     !! PFT maintenance respiration coefficients of different 
+                                                                    !! plant compartments at 0 deg C 
+                                                                    !! @tex $(g.g^{-1}dt^{-1})$ @endtex
+    REAL(r_std)                             :: deficit              !! Calculate maintenance respiration based on 
+                                                                    !! tissue pools (or labile pool size) (??UNIT??)
+    REAL(r_std)                             :: temp_share           !! Temporary variable to store the share
+                                                                    !! of biomass of each circumference class
+                                                                    !! to the total biomass            
+    REAL(r_std)                            :: temp_class_biomass    !! Biomass across parts for a single circ
+                                                                    !! class @tex $(gC m^{-2})$ @endtex
+    REAL(r_std)                             :: temp_total_biomass   !! Biomass across parts and circ classes
+                                                                    !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std)                             :: temp                 !! generic temporary variable 
+    REAL(r_std), DIMENSION(npts,nvm)        :: gtemp                !! Temperature response of respiration in the
+                                                                    !! Lloyd-Taylor Model (-)
+    REAL(r_std), DIMENSION(npts)            :: cn                   !! CN ratio of a biomass pool ((gC)(gN)-1) 
+    REAL(r_std)                             :: limit_cn             !! Calculate limiting C/N ratio ((gC)(gN)-1)
+    INTEGER(i_std)                          :: ier                  !! Error handling 
+
+   !! 0.5 Externalize
+   REAL(r_std), PARAMETER                   :: gtemp_ref=1.6        !! Correction factor for respiration calculation, 
+                                                                    !! since ORCHIDEE maintenance respiration rates
+                                                                    !! refer to zero degrees but Lloyd and Taylor assumes 
+                                                                    !! base temperature of 10 degrees (unitless)
+       
+!_ ================================================================================================================================
+        
+    IF (printlev>=3) WRITE(numout,*) 'Entering maintenance respiration'
+   
+ !! 1. Initializations
+    
+    IF ( firstcall_resp ) THEN
+
+       !! 1.1. Soil levels (first call only)
+       !       Set the depth of the different soil layers (number of layers: nbdl) 
+       !       previously calculated as variable diaglev in routines sechiba.f90 and slowproc.f90
+       ALLOCATE(z_soil(0:nbdl), stat=ier)
+       IF ( ier /= 0 ) CALL ipslerr_p(3,'maint_respiration','Pb in allocate of z_soil','','')
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+       ! Set first call to false for all subsequent calls 
+       firstcall_resp = .FALSE.
+
+    ENDIF
+
+    
+    !! 1.2. Calculate root temperature
+    !       Calculate root temperature as the convolution of root and soil temperature profiles
+    DO ivm = 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(:,ivm) ) )
+
+       !! 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(:,ivm) = zero
+
+       DO ibdl = 1, nbdl ! Loop over # soil layers
+
+          t_root(:,ivm) = &
+               t_root(:,ivm) + stempdiag(:,ibdl) * rpc(:) * &
+               ( EXP( -z_soil(ibdl-1)/rprof(:,ivm) ) - EXP( -z_soil(ibdl)/rprof(:,ivm) ) )
+
+       ENDDO ! Loop over # soil layers
+
+    ENDDO ! Loop over # PFTs
+
+    resp_maint_part_radia(:,:,:) = zero
+
+ !! 2. Define maintenance respiration coefficients
+
+    DO ivm = 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(:,ivm)
+       t_maint_radia(:,iroot) = t_root(:,ivm)
+
+       !! 2.1.3 Heartwood biomass
+       !  Heartwood does does not respire (coeff_maint_zero is set to zero). 
+       !  Any temperature could have been set  
+       !  [code cleaning: set t(heartwood) to undef to 'undef']
+
+       t_maint_radia(:,iheartbelow) = t_root(:,ivm)
+       t_maint_radia(:,iheartabove) = t2m(:)
+
+       t_maint_radia(:,ilabile) = t2m(:)
+       !! 2.1.4 Reserve biomass
+       !  Use aboveground temperature for trees and belowground temeperature for grasses
+       IF ( is_tree(ivm) ) THEN
+
+          t_maint_radia(:,icarbres) = t2m(:)
+
+       ELSE
+
+          t_maint_radia(:,icarbres) = t_root(:,ivm)
+
+       ENDIF
+
+       !! 2.1.5 Labile biomass pool
+       !  Use aboveground temperature for the labile biomass pool
+       t_maint_radia(:,ilabile) = t2m(:)
+       
+       !! 2.2 Calculate maintenance respiration coefficients (coeff_maint)
+       !  Maintenance respiration is a fraction of biomass defined by the coefficient 
+       !  coeff_maint [Mc Cree, 1969]. Coeff_maint is defined through a linear relationship of temperature [Ruimy et al, 1996]
+       !  which slope is the coefficient 'slope' and which intercept is 'coeff_maint_zero'.
+       !  - Coeff_maint_zero is defined in stomate_data to cm_zero_plantpartname
+       !  - Slope is calculated here through a second-degree polynomial [Krinner et al, 2005] 
+       !  equation that makes it dependent on the long term temperature (to represent adaptation
+       !  of the ecosystem to long term temperature).
+       !   \latexonly
+       !    \input{resp3.tex} 
+       !   \endlatexonly
+       !  Where, maint_resp_slope1, maint_resp_slope2, maint_resp_slope3 are constant in stomate_constants.f90.
+       !  Then coeff_maint is calculated as follows:\n
+       !   \latexonly
+       !    \input{resp4.tex} 
+       !   \endlatexonly
+       !  If the calculation result is negative, coeff_maint will take the value 0.\n	
+       tl(:) = tlong_ref(:) - ZeroCelsius
+       slope(:) = maint_resp_slope(ivm,1) + tl(:) * maint_resp_slope(ivm,2) + &
+            tl(:)*tl(:) * maint_resp_slope(ivm,3)
+
+       DO ipar = 1, nparts ! Loop over # plant parts
+
+          !+++CHECK+++
+          ! The original code refers to the Sitch et al 2003 as the source of the equations and parameters 
+          ! for modelling maintenance respiration. The equations below are consistent with the paper. The 
+          ! parameter setting for coeff_maint is in the range of 0.066 to 0.011 as reported in the paper but
+          ! exact values are not given. Although, the principle of a climate correction for coeff_maint is
+          ! mentioned in Sitch et al 2003, the reduction factors themselves were not given. As it appears
+          ! now this block of code pretends much more knowledge then we actually have. Rather than using a
+          ! baseline coeff_maint that is later corrected for the climate region, the parameter values for
+          ! coeff_maint could be simply prescribed and made pft-specific.
+          ! Further down in the code C/N ratios are used to constrain respiration. The C/N ratios were reset
+          ! to the values presented in Sitch et al 2003 but still seem on the low side. If pft-specific
+          ! values are to be used, changes in respiration could be compensated for by changing
+          ! coeff_maint_init. Given Vicca et al 2012 (Ecology Letters) an NPP/GPP ratio of 0.5 is 'universal'
+          ! for forests given a sufficient nutrient supply and strictly defining NPP as solely its biomass
+          ! components (thus excluding VOC, exudation and subsidies to myccorrhizae as is the case in ORCHIDEE).
+          ! Unless observation based values are available for coeff_maint_init, these values could be adjusted
+          ! within the range of 0.066 to 0.011 to obtain an NPP/GPP of 0.5 in the absence of nutrient
+          ! limitations.
+          
+          ! LPJ respiration factors based on Sitch et al. 2003 - first part of the calculation
+          IF ( ipar.EQ.ileaf .OR. ipar.EQ.iroot .OR. ipar.EQ.ifruit .OR. &
+               ipar.EQ.isapabove .OR. ipar.EQ.isapbelow .OR. ipar.EQ.ilabile) THEN
+             
+             ! Sonke uses
+             !coeff_maint(:,ivm,ipar) = 0.0548
+             
+             ! The Sitch et al 2003 paper gives a value of 0.066 (Table 3) and 0.011 for tropical systems
+             !coeff_maint(:,ivm,ipar) = 0.066
+             
+             ! Use an effective PFT-specific value - this value has been optimized
+             ! to reproduce observed NPP/GPP ratios
+             coeff_maint(:,ivm,ipar) = coeff_maint_init(ivm)
+             
+             ! heartwood and reserves pool   
+          ELSE
+             
+             coeff_maint(:,ivm,ipar) = zero
+             
+          ENDIF
+
+       ENDDO ! Loop over # plant parts
+           
+    ENDDO ! Loop over # PFTs
+       
+
+!! 3. Calculate maintenance respiration
+ 
+    ! In the allometric based allocation scheme, maintentance respiration is calculated as
+    ! the minimum of supply and demand
+
+    resp_maint_part_radia(:,:,:) = zero
+   
+    DO ivm = 2,nvm ! Loop over # PFTs
+       
+       ! Demand based respiration
+       resp_maint_demand(:,ivm) = 0.0
+       
+       DO ipar = 1, nparts ! Loop over # plant parts  
+
+          ! LPJ respiration factors based on Sitch et al. 2003 - second part of the calculation
+          ! Temperature response, LLoyd and Taylor, 1994. E0 = 308.56 comes from the paper of
+          ! Lloyd and Taylor but was fitted for soil respiration which only partly consists of
+          ! authotrophic (root) respiration.
+         
+          WHERE(t_maint_radia(:,ipar)-ZeroCelsius-tmin_maint_resp(ivm) .GT.min_stomate)
+                 
+             gtemp(:,ivm) = dt/one_day * & 
+                 EXP(e0_maint_resp(ivm)*(1.0/(tref_maint_resp(ivm)-tmin_maint_resp(ivm)) - &
+                 1.0/(t_maint_radia(:,ipar)-ZeroCelsius-tmin_maint_resp(ivm))))
+
+          ! No gtemp below -46.01 degrees Celsius
+
+          ELSEWHERE
+             
+             gtemp(:,ivm) = 0.0
+             
+          ENDWHERE
+
+          WHERE(SUM(circ_class_biomass(:,ivm,:,ipar,initrogen)*circ_class_n(:,ivm,:),2).GT.min_stomate)
+             cn(:)=SUM(circ_class_biomass(:,ivm,:,ipar,icarbon)*circ_class_n(:,ivm,:),2)/&
+                SUM(circ_class_biomass(:,ivm,:,ipar,initrogen)*circ_class_n(:,ivm,:),2)
+          ELSEWHERE
+             cn(:)=zero
+          ENDWHERE
+
+          ! Calculate the limiting C/N ratio
+          IF ( ipar.EQ.ileaf ) THEN
+             
+             limit_cn = cn_leaf_prescribed(ivm)
+             
+          ELSEIF ( ipar.EQ.iroot .OR. ipar.EQ.ifruit ) THEN
+               
+             limit_cn = cn_leaf_prescribed(ivm)/fcn_root(ivm)
+             
+          ELSEIF ( ipar.EQ.isapabove .OR. ipar.EQ.isapbelow ) THEN
+             
+             limit_cn = cn_leaf_prescribed(ivm)/fcn_wood(ivm)
+             
+          ELSE
+             
+             limit_cn = cn_leaf_prescribed(ivm)
+             
+          ENDIF
+          
+          !---TEMP---
+          !IF (ivm.EQ.test_pft) THEN  
+          !   WRITE(numout,*) 'limit - ipar, temp output,', ipar, limit_cn
+          !ENDIF
+          !----------
+         
+          WHERE(cn(:).GT.limit_cn)
+             resp_maint_part_radia(:,ivm,ipar) = coeff_maint(:,ivm,ipar) * gtemp(:,ivm) * & 
+                  SUM(circ_class_biomass(:,ivm,:,ipar,initrogen)*circ_class_n(:,ivm,:),2) 
+          ELSEWHERE
+             !avoid that respiration increases when CN is low -> respiring dead problem
+             ! could in extreme cases cause instability when deactivated
+             resp_maint_part_radia(:,ivm,ipar) = coeff_maint(:,ivm,ipar) * gtemp(:,ivm) * & 
+                  SUM(circ_class_biomass(:,ivm,:,ipar,icarbon)*circ_class_n(:,ivm,:),2)/ limit_cn
+          ENDWHERE
+          resp_maint_demand(:,ivm) = resp_maint_demand(:,ivm) + resp_maint_part_radia(:,ivm,ipar)
+
+       ENDDO ! Loop over # plant parts
+       
+    ENDDO ! Loop over # PFTs
+
+ !! 4. Check consistency of this routine
+
+    !  This routine only calculates respiration factors but respiration itself
+    !  is not accounted for through pools and fluxes. Hence, there is no need to
+    !  CALL check_veget_cov_max
+    !  CALL check_mass_balance 
+
+    IF (printlev>=3) WRITE(numout,*) 'Leaving maintenance respiration'
+
+  END SUBROUTINE maint_respiration
+
+END MODULE stomate_resp
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_season.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_season.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_season.f90	(revision 6412)
@@ -0,0 +1,1666 @@
+! =================================================================================================================================
+! MODULE        : stomate_season
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       This module calculates long-term meteorological parameters from daily temperatures
+!! and precipitations (essentially for phenology). 
+!!      
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN          :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ =================================================================================================================================
+
+MODULE stomate_season
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters 
+  USE solar
+  USE grid
+  USE function_library,    ONLY: lai_to_biomass
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC season,season_clear
+
+  LOGICAL, SAVE              :: firstcall_season = .TRUE.  !! first call (true/false)
+!$OMP THREADPRIVATE(firstcall_season)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : season_clear
+!!
+!>\BRIEF          Flag setting 
+!!
+!! DESCRIPTION  : This subroutine sets flags ::firstcall_season, to .TRUE., and therefore activates   
+!!                section 1.1 of the ::season subroutine which writes messages to the output. \n
+!!                This subroutine is called at the end of the subroutine ::stomate_clear, in the 
+!!                module ::stomate.
+!!
+!! RECENT CHANGE(S):None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::firstcall_season
+!!
+!! REFERENCE(S)  : None 
+!!
+!! FLOWCHART     : None
+!! \n             
+!_ =================================================================================================================================
+
+  SUBROUTINE season_clear
+    firstcall_season=.TRUE.
+  END SUBROUTINE season_clear
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : season
+!!
+!>\BRIEF          This subroutine calculates many of the long-term biometeorological variables
+!!                needed in the phenology subroutines and in the calculation of long-term vegetation
+!!                dynamics in the LPJ DGVM. 
+!!
+!! DESCRIPTION    This subroutine is called by the module ::stomate before LPJ, and mainly deals  
+!!                with the calculation of long-term meteorological variables, carbon fluxes and 
+!!                vegetation-related variables that are used to calculate vegetation dynamics 
+!!                in the stomate modules relating to the phenology and to the longer-term 
+!!                changes in vegetation type and fractional cover in the LPJ DGVM modules. \n
+!!                In sections 2 to 5, longer-term meteorological variables are calculated. The
+!!                long-term moisture availabilities are used in the leaf onset and senescence
+!!                phenological models ::stomate_phenology and ::stomate_turnover that require
+!!                a moisture condition. The long term temperatures are also required for phenology
+!!                but in addition they are used in calculations of C flux and the presence and
+!!                establishment of vegetation patterns on a longer timescale in the LPJ DGVM modules.
+!!                Finally the monthly soil humidity/relative soil moisture is used in the C
+!!                allocation module ::stomate_alloc. \n
+!!                Sections 12 to 14 also calculate long-term variables of C fluxes, including NPP,
+!!                turnover and GPP. The first two are used to calculate long-term vegetation 
+!!                dynamics and land cover change in the LPJ DVGM modules. The weekly GPP is used
+!!                to determine the dormancy onset and time-length, as described below. \n
+!!                The long-term variables described above are are used in certain vegetation
+!!                dynamics processes in order to maintain consistency with the basic hypotheses of the 
+!!                parameterisations of LPJ, which operates on a one year time step (Krinner et al., 2005).
+!!                In order to reduce the computer memory requirements, short-term variables (e.g. daily
+!!                temperatures) are not stored for averaging over a longer period. Instead
+!!                the long-term variables (e.g. monthly temperature) are calculated at each time step
+!!                using a linear relaxation method, following the equation:
+!!                \latexonly
+!!                \input{season_lin_relax_eqn1.tex}
+!!                \endlatexonly
+!!                \n 
+!!                The long-term variables are therefore updated on a daily basis. This method allows for 
+!!                smooth temporal variation of the long-term variables which are used to calculate 
+!!                vegetation dynamics (Krinner et al., 2005). \n
+!!                Sections 6 to 11 calculate the variables required for to determine leaf onset in
+!!                the module ::stomate_phenology. 
+!!                These include :
+!!                - the dormance onset and time-length, when GPP is below a certain threshold \n
+!!                - the growing degree days (GDD), which is the sum of daily temperatures greater than
+!!                -5 degrees C, either since the onset of the dormancy period, or since midwinter \n
+!!                - the number of chilling days, which is the number of days with a daily temperature
+!!                lower than a PFT-dependent threshold since the beginning of the dormancy period \n
+!!                - the number of growing days, which is the the number of days with a temperature
+!!                greater than -5 degrees C since the onset of the dormancy period \n
+!!                - the time since the minimum moisture availability in the dormancy period. \n
+!!                These variables are used to determine the conditions needed for the start of the
+!!                leaf growing season. The specific models to which they correspond are given below. \n
+!!                Sections 15 to 20 are used to update the maximum/minimum or the sum of various 
+!!                meteorological and biological variables during the year that are required for
+!!                calculating either leaf onset or longer-term vegetation dynamics the following year. \n
+!!                At the end of the year, these variables are updated from "thisyear" to "lastyear", 
+!!                in Section 21 of this subroutine, for use the following year. \n
+!!                Finally the probably amount of herbivore consumption is calculated in Section 22,
+!!                following McNaughton et al. (1989).
+!!
+!! RECENT CHANGE(S): None
+!!                
+!! MAIN OUTPUT VARIABLE(S): :: herbivores,
+!!                        :: maxmoiavail_lastyear, :: maxmoiavail_thisyear, 
+!!                        :: minmoiavail_lastyear, :: minmoiavail_thisyear, 
+!!                        :: maxgppweek_lastyear, :: maxgppweek_thisyear, 
+!!                        :: gdd0_lastyear, :: gdd0_thisyear, 
+!!                        :: precip_lastyear, :: precip_thisyear, 
+!!                        :: lm_lastyearmax, :: lm_thisyearmax, 
+!!                        :: maxfpc_lastyear, :: maxfpc_thisyear, 
+!!                        :: moiavail_month, :: moiavail_week, 
+!!                        :: t2m_longterm, :: t2m_month, :: t2m_week, 
+!!                        :: tsoil_month, :: soilhum_month, 
+!!                        :: npp_longterm, :: turnover_longterm, :: gpp_week, 
+!!                        :: gdd_m5_dormance, :: gdd_midwinter, 
+!!                        :: ncd_dormance, :: ngd_minus5, :: time_lowgpp, 
+!!                        :: time_hum_min, :: hum_min_dormance 
+!!      
+!! REFERENCES   : 
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!! - McNaughton, S.J., M. Oesterheld, D.A. Frank and K.J. Williams (1989), 
+!! Ecosystem-level patterns of primary productivity and herbivory in terrestrial
+!! habitats, Nature, 341, 142-144.
+!!                       
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{season_flowchart_part1.png}
+!! \includegraphics[scale = 1]{season_flowchart_part2.png}
+!! \includegraphics[scale = 1]{season_flowchart_part3.png}
+!! \endlatexonly
+!! \n   
+!_ =================================================================================================================================
+
+  SUBROUTINE season (npts, dt, EndOfYear, veget_cov, veget_cov_max, &
+       moiavail_daily, t2m_daily, tsoil_daily, soilhum_daily, lalo,  &
+       precip_daily, npp_daily, circ_class_biomass, circ_class_n, &
+       turnover_daily, gpp_daily, when_growthinit, &
+       maxmoiavail_lastyear, maxmoiavail_thisyear, &
+       minmoiavail_lastyear, minmoiavail_thisyear, &
+       maxgppweek_lastyear, maxgppweek_thisyear, &
+       gdd0_lastyear, gdd0_thisyear, &
+       precip_lastyear, precip_thisyear, &
+       lm_lastyearmax, lm_thisyearmax, &
+       maxfpc_lastyear, maxfpc_thisyear, &
+       moiavail_month, moiavail_week, t2m_longterm, tau_longterm, t2m_month, t2m_week, &
+       tsoil_month, soilhum_month, &
+       npp_longterm, turnover_longterm, gpp_week, plant_status, &
+       gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       time_hum_min, hum_min_dormance, gdd_init_date , & 
+       gdd_from_growthinit, herbivores, &
+       Tseason, Tseason_length, Tseason_tmp, &
+       Tmin_spring_time, t2m_min_daily, onset_date, &
+       cn_leaf_min_season,nstress_season, moiavail_growingseason, &
+       rue_longterm, harvest_area, harvest_5y_area)
+
+    !
+    !! 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_cov             !! coverage fraction of a PFT. Here: fraction of 
+                                                                                !! total ground. (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget_cov_max         !! "maximal" coverage fraction of a PFT (for LAI -> 
+                                                                                !! infinity) (0-1, unitless)Here: fraction of 
+                                                                                !! total ground. 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: moiavail_daily    !! Daily moisture availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: t2m_daily         !! Daily 2 meter temperature (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)          :: tsoil_daily       !! Daily soil temperature (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)          :: soilhum_daily     !! Daily soil humidity (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)             :: lalo              !!  array of lat/lon
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: precip_daily      !! Daily mean precipitation @tex ($mm day^{-1}$) 
+                                                                                !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: npp_daily         !! daily net primary productivity @tex ($gC m^{-2} 
+                                                                                !! day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), INTENT(in) :: circ_class_biomass     !! biomass @tex ($gC m^{-2} of ground$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(in)     :: circ_class_n     !! biomass @tex ($gC m^{-2} of ground$) @endtex
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: turnover_daily  !! Turnover rates @tex ($gC m^{-2} day^{-1}$) 
+                                                                                !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: gpp_daily         !! daily gross primary productivity  
+                                                                                !! (Here: @tex $gC m^{-2} of total ground 
+                                                                                !! day^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: when_growthinit   !! how many days ago was the beginning of the 
+                                                                                !! growing season (days) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: t2m_min_daily     !! Daily minimum 2-meter temperature (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: plant_status      !! Growth and phenological status of the plant
+                                                                                !! istatus = Phases defined in constantes
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: harvest_area      !! Harvested area (m^{2})
+    !
+    !! 0.2 Output variables 
+    ! (diagnostic)
+    !
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)          :: herbivores        !! time constant of probability of a leaf to be 
+                                                                                !! eaten by a herbivore (days) 
+
+    !
+    !! 0.3 Modified variables
+    !
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxmoiavail_lastyear      !! last year's maximum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxmoiavail_thisyear      !! this year's maximum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: minmoiavail_lastyear      !! last year's minimum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: minmoiavail_thisyear      !! this year's minimum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxgppweek_lastyear       !! last year's maximum weekly GPP 
+                                                                                        !! @tex ($gC m^{-2} week^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxgppweek_thisyear       !! this year's maximum weekly GPP 
+                                                                                        !! @tex ($gC m^{-2} week^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: gdd0_lastyear             !! last year's annual GDD0 (C)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: gdd0_thisyear             !! this year's annual GDD0 (C)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: precip_lastyear           !! last year's annual precipitation 
+                                                                                        !! @tex ($mm year^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: precip_thisyear           !! this year's annual precipitation 
+                                                                                        !! @tex ($mm year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: lm_lastyearmax            !! last year's maximum leaf mass, for each 
+                                                                                        !! PFT @tex ($gC m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: lm_thisyearmax            !! this year's maximum leaf mass, for each 
+                                                                                        !! PFT @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxfpc_lastyear           !! last year's maximum fpc for each PFT, on 
+                                                                                        !! ground (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxfpc_thisyear           !! this year's maximum fpc for each PFT, on 
+                                                                                        !! ground (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: moiavail_month            !! "monthly" moisture availability 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: moiavail_week             !! "weekly" moisture availability 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: t2m_longterm              !! "long term" 2-meter temperatures (K)
+    REAL(r_std), INTENT(inout)                             :: tau_longterm     
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: t2m_month                 !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: t2m_week                  !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: Tseason                   !! "seasonal" 2-meter temperatures (K), 
+                                                                                        !! used to constrain boreal treeline
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: Tseason_tmp               !! temporary variable to calculate Tseason 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: Tseason_length            !! temporary variable to calculate Tseason: 
+                                                                                        !! number of days when t2m_week is higher than 0 degree 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: Tmin_spring_time          !! Number of days after begin_leaves (leaf onset)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: onset_date                !! Date in the year at when the leaves started to grow(begin_leaves)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(inout)       :: tsoil_month               !! "monthly" soil temperatures (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(inout)       :: soilhum_month             !! "monthly" soil humidity (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: npp_longterm              !! "long term" net primary productivity 
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: turnover_longterm !! "long term" turnover rate 
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gpp_week                  !! "weekly" GPP @tex ($gC m^{-2} day^{-1}$) 
+                                                                                        !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gdd_m5_dormance           !! growing degree days above threshold -5 
+                                                                                        !! deg. C (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gdd_midwinter             !! growing degree days since midwinter (C)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: ncd_dormance              !! number of chilling days since leaves 
+                                                                                        !! were lost (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: ngd_minus5                !! number of growing days (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: time_hum_min              !! time elapsed since strongest moisture 
+                                                                                        !! availability (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: hum_min_dormance          !! minimum moisture during dormance 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,2), INTENT(inout)          :: gdd_init_date             !! inital date for gdd count
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gdd_from_growthinit       !! growing degree days, threshold 0 deg. C 
+                                                                                        !! since beginning of season
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: cn_leaf_min_season        !! seasonal minimal leaf nitrogen concentratation CN ratio  
+	                                                                                !! ((gC) (gN)-1) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: nstress_season            !! Seasonal nitrogen stress 
+ 	   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: moiavail_growingseason    !! soil moisture during growing season
+                                                                                        !! (used for allometry&allocation)
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: rue_longterm              !! Longterm radiation use efficiency 
+                                                                                        !! (units?)
+    REAL(r_std), DIMENSION(npts,nvm,wind_years), INTENT(inout) :: harvest_5y_area       !! Array with the harvest area of the last 5 years (m2).
+                                                                                        !! used in windthrow calculations
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                                          :: j, iyear                 !! indices (unitless)
+    REAL(r_std)                                             :: ncd_max                  !! maximum ncd (to avoid floating point 
+                                                                                        !! underflows) (days) 
+    REAL(r_std), DIMENSION(npts)                            :: sumfpc_nat               !! sum of natural fpcs (0-1, unitless)
+                                                                                        !! [DISPENSABLE] 
+    REAL(r_std), DIMENSION(npts,nvm)                        :: weighttot                !! weight of biomass @tex ($gC m^{-2}$) 
+                                                                                        !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                        :: nlflong_nat              !! natural long-term leaf NPP 
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                        :: green_age                !! residence time of green tissue (years)
+    REAL(r_std), DIMENSION(npts)                            :: consumption              !! herbivore consumption 
+                                                                                        !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts)                            :: fracnat                  !! fraction of each gridcell occupied by 
+                                                                                        !! natural vegetation (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                            :: solad                    !! maximal radation during current day 
+                                                                                        !! (clear sky condition)
+    REAL(r_std), DIMENSION(npts)                            :: solai                    !! maximal radation during current day
+                                                                                        !! (clear sky condition)
+    REAL(r_std), DIMENSION(npts)                            :: cloud                    !! cloud fraction
+    REAL(r_std), DIMENSION(npts)                            :: nn                       !! Temporary variable for storing biomass(initrogen) for the sum of labile+root+leaf pools (gN m-2) 
+    REAL(r_std), DIMENSION(npts)                            :: cn                       !! CN ration for  labile+root+leaf pools (gC (gN)-1) 
+    REAL(r_std), DIMENSION(npts,nvm,wind_years)             :: tmp_5y_area              !! Temperate array for storing harvested area in last five years (m^{2})
+    CHARACTER(30)                                           :: var_name
+!_ =================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering season'
+
+    !! 1.1 Initialize local printlev
+    !printlev_loc=get_printlev('season')
+    !
+    !! 1. Initializations
+    !! 1.1 Calculate ::ncd_max - the maximum possible NCD (number of chilling days) as:
+    !!     \latexonly
+    !!     \input{season_ncdmax_eqn2.tex}
+    !!     \endlatexonly
+    !!     \n
+    !!     where one_year is 1 year in seconds (defined in ::constantes).
+    !
+    ncd_max = ncd_max_year * one_year
+
+    IF ( firstcall_season ) THEN
+
+       !
+       !! 1.2 first call - output message giving the setting of the ::gppfrac_dormance,
+       !!     ::hvc1, ::hvc2 and ::leaf_frac (as a percentage) parameters which are 
+       !!     defined at the beginning of this subroutine. Also outputs the value of 
+       !!     ::ncd_max.
+       !
+
+       IF ( printlev_loc>=3) THEN
+
+          WRITE(numout,*) 'season: '
+
+          WRITE(numout,*) '   > maximum GPP/GGP_max ratio for dormance (::gppfrac_dormance) :',gppfrac_dormance !*
+
+          WRITE(numout,*) '   > maximum possible ncd(days) (::ncd_max) : ',ncd_max !*
+
+          WRITE(numout,*) '   > herbivore consumption C (gC/m2/d) as a function of NPP (gC/m2/d): (::hvc1) (::hvc2)' !*
+          WRITE(numout,*) '     C=',hvc1,' * NPP^',hvc2
+          WRITE(numout,*) '   > for herbivores, suppose that (::leaf_frac_hvc)',leaf_frac_hvc*100., &
+               '% of NPP is allocated to leaves'
+
+       ENDIF
+
+       !
+       !! 1.3 Check whether longer-term meteorological and phenology-related variables are not initialized
+       !!     to less than zero. If the following meteorological variables are less than ::min_stomate which is set 
+       !!     to 1.E-8 in ::grid, then they are set to the current daily value. If the phenology-
+       !!     related variables are less than ::min_stomate, they are set to "undef". 
+       !!     Warning messages are output in each case, and are also output if "long-term" C fluxes GPP,
+       !!     NPP and turnover are less than ::min_stomate.
+       !
+
+       !! 1.3.1 moisture availabilities (i.e. relative soil moisture, including the root soil profile):
+
+       !! 1.3.1.1 "monthly" (::moiavail_month)
+       !MM PAS PARALLELISE!!
+       IF ( ABS( SUM( moiavail_month(:,2:nvm) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them it today's moisture availability
+          IF(printlev_loc>=2) 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
+          IF(printlev_loc>=2) WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' moisture availabilities. '
+          moiavail_week(:,:) = moiavail_daily(:,:)
+
+       ENDIF
+
+      IF ( ABS( SUM( moiavail_growingseason(:,:) ) ) .LT. min_stomate ) THEN
+
+        ! in this case, set them it today's moisture availability
+        IF(printlev_loc>=2) WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' moisture availabilities.'
+        moiavail_growingseason(:,:) = 1.0
+
+      ENDIF
+
+
+       !! 1.3.2 2-meter temperatures:
+
+       !!  "monthly" (::t2m_month)
+       IF ( ABS( SUM( t2m_month(:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's temperature
+          IF(printlev_loc>=2) WRITE(numout,*) 'Warning! We have to initialize the ''monthly'' 2m temperatures.'
+          t2m_month(:) = t2m_daily(:)
+
+       ENDIF
+
+       !!  "weekly" (::2m_week)
+       IF ( ABS( SUM( t2m_week(:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's temperature
+          IF(printlev_loc>=2) 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
+          IF(printlev_loc>=2) 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
+          IF(printlev_loc>=2) 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
+          IF(printlev_loc>=2) 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
+          IF(printlev_loc>=2) 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
+          IF(printlev_loc>=2) 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
+          IF(printlev_loc>=2) 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
+          IF(printlev_loc>=2) 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
+          IF(printlev_loc>=2) 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
+          IF(printlev_loc>=2) 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
+          IF(printlev_loc>=2) WRITE(numout,*) 'Warning! We have to initialize this year''s minimum '// &
+               'moisture availabilities.'
+          minmoiavail_thisyear(:,:) = large_value
+
+       ENDIF
+
+       !
+       !! 1.4 reset firstcall_season flag
+       !
+
+       firstcall_season = .FALSE.
+
+    ENDIF
+
+    ! determine min yearly clear sky radiation (solstice) as beginning for gdd count
+    cloud(:) = zero
+    CALL downward_solar_flux (npts, lalo(:,1),calendar_str,julian_diff,12.,cloud,1,solad,solai)
+
+    WHERE (solad(:) .LT. gdd_init_date(:,2))
+       gdd_init_date(:,1)= julian_diff
+       gdd_init_date(:,2)= solad(:)
+    ENDWHERE
+
+
+    !
+    !! NOTE: Sections 2. to 5. compute slowly-varying, "long-term" (i.e. weekly/monthly)
+    !! input variables using a linear relaxation method, following the equation:
+    !! \latexonly
+    !! \input{season_lin_relax_eqn1.tex}
+    !! \endlatexonly
+    !! \n 
+    !! as described in the introduction to this subroutine (see Krinner et al., 2005).  
+    !! The time constant in the above equation is given for each of the variables
+    !! described.
+    !
+
+    !
+    !! 2. Moisture availability (relative soil moisture, including the root profile) :
+    !!    The time constants (as in the above equation) for these calculations are 
+    !!    given by the parameters ::tau_hum_month (for the monthly
+    !!    calculation) or ::tau_hum_week (for the weekly),
+    !!    which are set in ::stomate_data to be 20 and 7 days respectively.
+    !!    If the moisture availability is less than zero, it is set to zero. 
+    !!    These variables are mostly used in the phenological leaf onset and senescence
+    !!    models in the modules ::stomate_phenology and ::stomate_turnover, 
+    !!    respectively. They are used in models which require a moisture limitation
+    !!    condition. These are the 'hum', 'moi', 'humgdd' and 'moigdd' onset models,
+    !!    and the 'mixed' and 'dry' (weekly only) senescence models. In addition,
+    !!    the weekly moisture availability is used to calculate the limitation
+    !!    on the fraction of NPP allocated to different compartments in the module
+    !!    ::stomate_alloc. 
+    !
+
+    !
+    !! 2.1 "monthly" (::moiavail_month)
+    !
+
+    moiavail_month = ( moiavail_month * ( tau_hum_month - dt ) + &
+         moiavail_daily * dt ) / tau_hum_month
+
+    DO j = 2,nvm  ! Loop over # PFTs
+       WHERE ( ABS(moiavail_month(:,j)) .LT. EPSILON(zero) )
+          moiavail_month(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 2.2 "weekly" (::moiavail_week)
+    !
+
+    moiavail_week = ( moiavail_week * ( tau_hum_week - dt ) + &
+         moiavail_daily * dt ) / tau_hum_week
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(moiavail_week(:,j)) .LT. EPSILON(zero) ) 
+          moiavail_week(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 3. 2-meter temperatures
+    !!    The time constants for the "long-term", "monthly" and "weekly" 2-meter
+    !!    temperatures are given by the parameters ::tau_longterm_max, 
+    !!    ::tau_t2m_month, and ::tau_t2m_week,
+    !!    which are set in ::stomate_data to be 3 * one year (in seconds, as 
+    !!    described above) and 20 and 7 days respectively.
+    !!    If the temperature is less than zero, it is set to zero.
+    !!    In addition the "long term" temperature is written to the history file. \n
+    !!    These variables are used in many different modules of STOMATE. 
+    !!    The longterm t2m is limied to the intervall [tlong_ref_min, tlong_ref_max]
+    !!    using the equation:
+    !!      \latexonly
+    !!      \input{season_t2m_long_ref_eqn3.tex}
+    !!      \endlatexonly
+    !!      \n
+    !!    The "monthly" and "weekly" temperature is used in the modules 
+    !!    ::stomate_phenology and ::stomate_turnover for the onset and senescence 
+    !!    phenological models which require a temperature condition. In addition
+    !!    the "monthly" temperature is used in ::lpj_constraints to determine 
+    !!    the presence and regeneration of the vegetation and in the module
+    !!    ::stomate_assimtemp to calculate photosynthesis temperatures.
+        
+    ! Update tau_longterm
+    tau_longterm = MIN(tau_longterm+dt,tau_longterm_max)
+    
+    ! Recalculate the reference temperature using the old reference temperature and the current temperature
+    t2m_longterm(:) = ( t2m_longterm(:) * ( tau_longterm - dt ) + &
+         t2m_daily(:) * dt ) / tau_longterm
+
+    ! The longterm reference is not allowed to go outside the interval [tlong_ref_min, tlong_ref_max]
+    t2m_longterm(:) = MAX( tlong_ref_min, MIN( tlong_ref_max, t2m_longterm(:) ) )
+
+    CALL xios_orchidee_send_field("T2M_LONGTERM",t2m_longterm)
+
+    CALL histwrite_p (hist_id_stomate, 'T2M_LONGTERM', itime, &
+         t2m_longterm, npts, hori_index)
+
+    !
+    !! 3.3 "monthly" (::t2m_month)
+    !
+
+    t2m_month = ( t2m_month * ( tau_t2m_month - dt ) + &
+         t2m_daily * dt ) / tau_t2m_month
+
+    WHERE ( ABS(t2m_month(:)) .LT. EPSILON(zero) )
+       t2m_month(:) = zero
+    ENDWHERE
+
+    ! Store the day in onset_date when the leaves started grow. julian_diff is the day in the year [1-366].
+    WHERE ( plant_status(:,:) .EQ. ibudbreak )
+       onset_date(:,:)=julian_diff
+    ELSEWHERE
+       onset_date(:,:)=0
+    ENDWHERE
+    
+    ! Calculate "seasonal" temperature
+    WHERE ( t2m_week (:) .GT. ZeroCelsius )
+       Tseason_tmp(:) = Tseason_tmp(:) + t2m_week(:)
+       Tseason_length(:)=Tseason_length(:) + dt
+    ENDWHERE
+
+    ! calculate Tmin in spring (after onset)
+    DO j=1, nvm
+       IF (leaf_tab(j)==1 .AND. pheno_type(j)==2) THEN
+          ! leaf_tab=broadleaf and pheno_typ=summergreen
+          ! Only treat broadleag and summergreen pfts
+          
+          WHERE ( Tmin_spring_time(:,j)>0 .AND. (Tmin_spring_time(:,j)<spring_days_max) )
+             Tmin_spring_time(:,j)=Tmin_spring_time(:,j)+1
+          ELSEWHERE
+             Tmin_spring_time(:,j)=0
+          ENDWHERE
+          
+          WHERE ( plant_status(:,j) .EQ. ibudbreak )
+             Tmin_spring_time(:,j)=1
+          ENDWHERE
+       END IF
+    END DO
+
+    !
+    !! 3.4 "weekly" (::t2m_week)
+    !
+
+    t2m_week = ( t2m_week * ( tau_t2m_week - dt ) + &
+         t2m_daily * dt ) / tau_t2m_week
+
+    WHERE ( ABS(t2m_week(:)) .LT. EPSILON(zero) )
+       t2m_week(:) = zero
+    ENDWHERE
+
+    !
+    !! 4. "monthly" soil temperatures (::tsoil_month)
+    !!    The time constant is given by the parameter ::tau_tsoil_month, 
+    !!    which is set in ::stomate_data to be 20 days.
+    !!    If the monthly soil temperature is less than zero, it is set to zero. \n
+    !!    This variable is used in the ::stomate_allocation module.
+    !
+
+    tsoil_month = ( tsoil_month * ( tau_tsoil_month - dt ) + &
+         tsoil_daily(:,:) * dt ) / tau_tsoil_month
+
+    WHERE ( ABS(tsoil_month(:,:)) .LT. EPSILON(zero) )
+       tsoil_month(:,:) = zero
+    ENDWHERE
+
+    !
+    !! 5. ''monthly'' soil humidity (or relative soil moisture - ::soilhum_month) 
+    !!    The time constant is given by the parameter ::tau_soilhum_month, 
+    !!    which is set in ::stomate_data to be 20 days.
+    !!    If the monthly soil humidity is less than zero, it is set to zero.
+    !
+
+    soilhum_month = ( soilhum_month * ( tau_soilhum_month - dt ) + &
+         soilhum_daily * dt ) / tau_soilhum_month
+
+    WHERE ( ABS(soilhum_month(:,:)) .LT. EPSILON(zero) )
+       soilhum_month(:,:) = zero
+    ENDWHERE
+
+    !
+    !! 6. Calculate the dormance time-length (::time_lowgpp).
+    !!    The dormancy time-length is increased by the stomate time step when   
+    !!    the weekly GPP is below one of two thresholds, 
+    !!    OR if the growing season started more than 2 years ago AND the amount of biomass
+    !!    in the carbohydrate reserve is 4 times as much as the leaf biomass.
+    !!    i.e. the plant is declared dormant if it is accumulating carbohydrates but not 
+    !!    using them, so that the beginning of the growing season can be detected .
+    !     This last condition was added by Nicolas Viovy.
+    !!    - NV: special case (3rd condition)
+    !!    Otherwise, set ::time_lowgpp to zero. \n
+    !!    The weekly GPP must be below either the parameter ::min_gpp_allowed, which is set at 
+    !!    the beginning of this subroutine to be 0.3gC/m^2/year, 
+    !!    OR it must be less than last year's maximum weekly GPP multiplied by the
+    !!    maximal ratio of GPP to maximum GPP (::gppfrac_dormance), which is set to 0.2 at the 
+    !!    beginning of this subroutine. \n
+    !!    This variable is used in the ::stomate_phenology module to allow the detection of the
+    !!    beginning of the vegetation growing season for different onset models.
+    !!    Each PFT is looped over.
+    !
+    !NVMODIF
+!!$    DO j = 2,nvm ! Loop over # PFTs
+!!$       WHERE ( ( gpp_week(:,j) .LT. min_gpp_allowed ) .OR. & 
+!!$            ( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. &
+!!$            ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. &
+!!$            ( biomass(:,j,icarbres,icarbon) .GT. biomass(:,j,ileaf,icarbon)*4. ) ) )
+!!$          !       WHERE ( ( gpp_week(:,j) .EQ. zero ) .OR. & 
+!!$          !            ( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. &
+!!$          !            ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. &
+!!$          !            ( biomass(:,j,icarbres,icarbon) .GT. biomass(:,j,ileaf,icarbon)*4. ) ) )
+!!$       
+!!$          time_lowgpp(:,j) = time_lowgpp(:,j) + dt
+!!$          
+!!$       ELSEWHERE
+!!$          
+!!$          time_lowgpp(:,j) = zero
+!!$
+!!$       ENDWHERE
+!!$    ENDDO
+
+    !
+    !! 7. Calculate the growing degree days (GDD - ::gdd_m5_dormance).
+    !!    This variable is the GDD sum of the temperatures higher than -5 degrees C.
+    !!    It is inititalised to 0 at the beginning of the dormancy period (i.e.
+    !!    when ::time_lowgpp>0), and is set to "undef" when there is GPP 
+    !!    (::time_lowgpp=0), as it is not used during the growing season. \n 
+    !!    ::gdd_m5_dormance is further scaled by (::tau_gdd -dt / ::tau_gdd), 
+    !!    - ::tau_gdd is set to 40. in the module ::stomate_constants. \n
+    !     Nicolas Viovy - not sure why this is...
+    !!    This variable is used in the ::stomate_phenology module for the 
+    !!    'humgdd' and 'moigdd' leaf onset models. \n
+    !!    Each PFT is looped over but ::gdd_m5_dormance is only calculated for 
+    !!    those PFTs for which a critical GDD is defined, i.e. those which are 
+    !!    assigned to the 'humgdd' or 'moigdd' models. \n
+    !!    Finally if GDD sum is less than zero, then it is set to zero. 
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF (.NOT. natural(j)) THEN
+          ! reset counter: start of the growing season
+          WHERE ((when_growthinit(:,j) .EQ. zero))
+	     gdd_from_growthinit(:,j) = zero
+	  ENDWHERE
+          ! increase gdd counter
+          WHERE ( t2m_daily(:) .GT. (ZeroCelsius)  )
+             gdd_from_growthinit(:,j) = gdd_from_growthinit(:,j) + &
+                                 dt * ( t2m_daily(:) - (ZeroCelsius) )
+          ENDWHERE
+       ELSE
+          gdd_from_growthinit(:,j) = undef
+       ENDIF
+
+       ! only for PFTs for which critical gdd is defined
+       ! gdd_m5_dormance is set to 0 at the end of the growing season. It is set to undef
+       ! at the beginning of the growing season.
+
+       IF ( ALL(pheno_gdd_crit(j,:) .NE. undef) ) THEN
+
+          !
+          !! 7.1 set to zero if undefined and there is no GPP
+          !
+
+          WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+
+             gdd_m5_dormance(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 7.2 set to undef if there is GPP
+          !
+
+          WHERE ( when_growthinit(:,j) .EQ. zero )
+
+             gdd_m5_dormance(:,j) = undef
+
+          ENDWHERE
+
+          !
+          !! 7.3 normal update as described above where ::gdd_m5_dormance is defined (not set to "undef").
+          !
+
+          WHERE ( ( t2m_daily(:) .GT. ( ZeroCelsius - gdd_threshold ) ) .AND. &
+               ( gdd_m5_dormance(:,j) .NE. undef )           )
+             gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) + &
+                  dt * ( t2m_daily(:) - ( ZeroCelsius - gdd_threshold ) )
+          ENDWHERE
+
+          WHERE ( gdd_m5_dormance(:,j) .NE. undef ) 
+             gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) * &
+                  ( tau_gdd - dt ) / tau_gdd
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 7.4 Set to zero if GDD is less than zero.
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(gdd_m5_dormance(:,j)) .LT. EPSILON(zero) )
+          gdd_m5_dormance(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 8. Calculate the growing degree days (GDD) since midwinter (::gdd_midwinter)
+    !!    This variable represents the GDD sum of temperatures higher than a PFT-dependent
+    !!    threshold (::ncdgdd_temp), since midwinter.
+    !!    Midwinter is detected if the monthly temperature (::t2m_month) is lower than the weekly 
+    !!    temperature (::t2m_week) AND if the monthly temperature is lower than the long-term 
+    !!    temperature (t2m_longterm). These variables were calculated earlier in this subroutine. \n
+    !!    ::gdd_midwinter is initialised to 0.0 when midwinter is detected, and from then on 
+    !!    increased with each temperature greater than ::ncdgdd_temp, which is defined
+    !!    in the module ::stomate_constants. \n
+    !!    ::gdd_midwinter is set to "undef" when midsummer is detected, following the opposite
+    !!    conditions to those used to define midwinter. \n
+    !!    The variable is used in the ::stomate_phenology module for the leaf onset model 'ncdgdd'.
+    !!    Each PFT is looped over but the ::gdd_midwinter is only calculated for those
+    !!    PFTs for which a critical 'ncdgdd' temperature is defined, i.e. those which are 
+    !!    assigned to the 'ncdgdd' model. \n
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       ! only for PFTs for which ncdgdd_crittemp is defined
+
+       IF ( ncdgdd_temp(j) .NE. undef ) THEN
+
+          !
+          !! 8.1 set to 0 if undef and if we detect "midwinter"
+          !
+
+!!$          WHERE ( ( gdd_midwinter(:,j) .EQ. undef ) .AND. &
+!!$               ( t2m_month(:) .LT. t2m_week(:) ) .AND. &
+!!$               ( t2m_month(:) .LT. t2m_longterm(:) )    )
+          WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+
+             gdd_midwinter(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 8.2 set to undef if we detect "midsummer"
+          !
+
+!!$          WHERE ( ( t2m_month(:) .GT. t2m_week(:) ) .AND. &
+!!$               ( t2m_month(:) .GT. t2m_longterm(:) )    )
+!!$
+!!$             gdd_midwinter(:,j) = undef
+!!$
+!!$          ENDWHERE
+
+          WHERE ( when_growthinit(:,j) .EQ. zero )
+
+             gdd_midwinter(:,j) = undef
+
+          ENDWHERE
+
+          !
+          !! 8.3 normal update as described above
+          !
+
+          WHERE ( ( gdd_midwinter(:,j) .NE. undef ) .AND. &
+               ( t2m_daily(:) .GT. ncdgdd_temp(j)+ZeroCelsius ) )
+
+             gdd_midwinter(:,j) = &
+                  gdd_midwinter(:,j) + &
+                  dt * ( t2m_daily(:) - ( ncdgdd_temp(j)+ZeroCelsius ) )
+
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 9. Calculate the number of chilling days (NCD) since leaves were lost (::ncd_dormance).
+    !!    This variable is initialised to 0 at the beginning of the dormancy period (::time_lowgpp>0)
+    !!    and increased by the stomate time step when the daily temperature is lower than the 
+    !!    PFT-dependent threshold ::ncdgdd_temp, which is defined for each PFT 
+    !!    in a table (::ncdgdd_temp_tab) in the module ::stomate_data. \n
+    !!    It is set to "undef" when there is GPP (::time_lowgpp=0) as it is not needed during
+    !!    the growing season. \n
+    !!    The variable is used in the ::stomate_phenology module for the leaf onset model 'ncdgdd'.
+    !!    Each PFT is looped over but the ::ncd_dormance is only calculated for those
+    !!    PFTs for which a critical 'ncdgdd' temperature is defined, i.e. those which are 
+    !!    assigned to the 'ncdgdd' model.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( ncdgdd_temp(j) .NE. undef ) THEN
+
+          !
+          !! 9.1 set to zero if undefined and there is no GPP
+          !
+
+          WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+
+             ncd_dormance(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 9.2 set to undef if there is GPP
+          !
+
+          WHERE ( when_growthinit(:,j) .LE. un )
+
+             ncd_dormance(:,j) = undef
+
+          ENDWHERE
+
+          !
+          !! 9.3 normal update, as described above, where ::ncd_dormance is defined
+          !
+
+          WHERE ( ( ncd_dormance(:,j) .NE. undef ) .AND. &
+               ( t2m_daily(:) .LE. ncdgdd_temp(j)+ZeroCelsius ) )
+
+             ncd_dormance(:,j) = MIN( ncd_dormance(:,j) + dt, ncd_max )
+
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 10. Calculate the number of growing days (NGD) since leaves were lost (::ngd_minus5).
+    !!     This variable is initialised to 0 at the beginning of the dormancy period (::time_lowgpp>0)
+    !!     and increased by the stomate time step when the daily temperature is higher than the threshold
+    !!     -5 degrees C. \n    
+    !!     ::ngd_minus5 is further scaled by (::tau_ngd -dt / ::tau_ngd), 
+    !!     - ::tau_ngd is set to 50. in the module ::stomate_constants. \n
+    !      Nicolas Viovy - not sure why this is...
+    !!     The variable is used in the ::stomate_phenology module for the leaf onset model 'ngd'.
+    !!     Each PFT is looped over.
+    !!     If the NGD is less than zero, it is set to zero.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !
+       !! 10.1 Where there is GPP (i.e. ::time_lowgpp=0), set NGD to 0. 
+       !!      This means that we only take into account NGDs when the leaves are off
+       !
+
+       WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+          ngd_minus5(:,j) = zero
+       ENDWHERE
+
+       !
+       !! 10.2 normal update, as described above.
+       !
+
+       WHERE ( t2m_daily(:) .GT. (ZeroCelsius - gdd_threshold) )
+          ngd_minus5(:,j) = ngd_minus5(:,j) + dt
+       ENDWHERE
+
+       ngd_minus5(:,j) = ngd_minus5(:,j) * ( tau_ngd - dt ) / tau_ngd
+
+    ENDDO
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(ngd_minus5(:,j)) .LT. EPSILON(zero) )
+          ngd_minus5(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 11. Calculate the minimum humidity/relative soil moisture since dormance began (::hum_min_dormance) 
+    !!     and the time elapsed since this minimum (::time_hum_min). \n
+    !!     The minimum moisture availability occurs when the monthly moisture availability, which is updated 
+    !!     daily earlier in this subroutine as previously described, is at a minimum during the dormancy period.
+    !!     Therefore the ::hum_min_dormance is initialised to the monthly moisture availability 
+    !!     at the beginning of the dormancy period (i.e. if it was previously set to undefined and the
+    !!     ::time_lowgpp>0) AND then whenever the monthly moisture availability is less than it has previously
+    !!     been. \n
+    !!     Consequently, the time counter (::time_hum_min) is initialised to 0 at the beginning of the dormancy  
+    !!     period (i.e. if it was previously set to undefined and the ::time_lowgpp>0) AND when the minimum 
+    !!     moisture availability is reached, and is increased by the stomate time step every day throughout
+    !!     the dormancy period. \n
+    !!     ::time_hum_min is used in the ::stomate_phenology module for the leaf onset models 'moi' and 'moigdd'.
+    !!     Each PFT is looped over but the two variables are only calculated for those
+    !!     PFTs for which the critical parameter ::hum_min_time is defined, i.e.   
+    !!     those which are assigned to the 'moi' or 'moigdd' models.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( hum_min_time(j) .NE. undef ) THEN
+
+          !
+          !! 11.1 initialize if undefined and there is no GPP
+          !
+
+          WHERE (when_growthinit(:,j) .EQ. zero)
+
+             time_hum_min(:,j) = zero
+             hum_min_dormance(:,j) = moiavail_month(:,j)
+
+          ENDWHERE
+
+          !
+          !! 11.3 normal update, as described above, where ::time_hum_min and ::hum_min_dormance are defined
+          !
+
+          !! 11.3.1 increase time counter by the stomate time step
+
+          WHERE ( hum_min_dormance(:,j) .NE. undef )
+
+             time_hum_min(:,j) = time_hum_min(:,j) + dt
+
+          ENDWHERE
+
+          !! 11.3.2 set time counter to zero if minimum is reached
+
+          WHERE (( hum_min_dormance(:,j) .NE. undef ) .AND. &
+               ( moiavail_month(:,j) .LE. hum_min_dormance(:,j) ) )
+
+             hum_min_dormance(:,j) = moiavail_month(:,j)
+             time_hum_min(:,j) = zero
+
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! NOTE: Sections 12. to 14. compute slowly-varying, "long-term" (i.e. weekly/monthly)
+    !! C fluxes (NPP, turnover, GPP) using the same linear relaxation method as in 
+    !! Sections 2. and 5. and described in the introduction to this section, as given 
+    !! by the following equation:
+    !! \latexonly
+    !! \input{season_lin_relax_eqn1.tex}
+    !! \endlatexonly
+    !! \n 
+    !! The following variables are calculated using the above equation, and the time constant 
+    !! is given for each. 
+    !
+
+    !
+    !! 12. Update the "long term" NPP. (::npp_daily in gC/m^2/day, ::npp_longterm in gC/m^2/year.)
+    !!     The time constant is given by the parameter ::tau_longterm, 
+    !!     which is set in ::stomate_data to be 3 * one year (in seconds, as 
+    !!     described above). If the ::npp_longterm is less than zero then set it to zero. \n
+    !!     ::npp_longterm is used in ::stomate_lpj in the calculation of long-term
+    !!     vegetation dynamics and in ::stomate_lcchange in the calculation of 
+    !!     land cover change. It is also used to calculate diagnose the hebivory activity in 
+    !!     Section 22 of this subroutine.
+    !
+
+    npp_longterm = ( npp_longterm * ( tau_longterm - dt ) + &
+         (npp_daily*one_year) * dt                          ) / &
+         tau_longterm
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(npp_longterm(:,j)) .LT. EPSILON(zero) )
+          npp_longterm(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 13. Update the "long term" turnover rates (in gC/m^2/year).
+    !!     The time constant is given by the parameter ::tau_longterm, 
+    !!     which is set in ::stomate_data to be 3 * one year (in seconds, as 
+    !!     described above). If the ::turnover_longterm is less than zero then set it to zero.\n
+    !!     ::turnover_longterm is used in ::stomate_lpj and :: lpg_gap in the calculation 
+    !!     of long-term vegetation dynamics.
+    !
+
+    turnover_longterm(:,:,:,:) = ( turnover_longterm(:,:,:,:) * ( tau_longterm - dt ) + &
+         (turnover_daily(:,:,:,:)*one_year) * dt                          ) / &
+         tau_longterm
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(turnover_longterm(:,j,:,:)) .LT. EPSILON(zero) )
+          turnover_longterm(:,j,:,:) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 14. Update the "weekly" GPP (where there is vegetation), otherwise set to zero.
+    !!     The time constant is given by the parameter ::tau_gpp_week, 
+    !!     which is set in ::stomate_data to be 7 days. If the ::gpp_week is 
+    !!     less than zero then set it to zero. \n
+    !!     ::gpp_week is used to update the annual maximum weekly GPP (::maxgppweek_thisyear)
+    !!     in Section 16 of this subroutine, which is then used to update the variable
+    !!     ::maxgppweek_lastyear in Section 21 of this subroutine. Both ::gpp_week and 
+    !!     ::maxgppweek_lastyear are used in Section 6 of this subroutine to calculate
+    !!     the onset and time-length of the dormancy period. 
+    !      Note: Used to be weekly GPP divided by veget_cov_max, i.e. per ground covered, but not anymore.
+    !
+
+    WHERE ( veget_cov_max .GT. zero )
+
+       gpp_week = ( gpp_week * ( tau_gpp_week - dt ) + &
+            gpp_daily * dt ) / tau_gpp_week
+
+    ELSEWHERE
+
+       gpp_week = zero
+
+    ENDWHERE
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(gpp_week(:,j)) .LT. EPSILON(zero) )
+          gpp_week(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !! 14.1 longterm radiation use efficiency
+    ! We add an ELSEWHERE condition for the biomass check of longterm radiation use efficiency
+    ! If we don't have the biomass, use the previous value. The additional statements are needed
+    ! to make sure that rue_longterm always has a value (even during severe droughtstress).
+    DO j=2,nvm
+
+       WHERE(SUM(circ_class_biomass(:,j,:,ileaf,icarbon)*circ_class_n(:,j,:),2).GT. min_stomate)
+
+          rue_longterm(:,j) =  ( rue_longterm(:,j) * ( one_year - dt ) + &
+               gpp_daily(:,j) / &
+               (1. - exp(-0.5 * lai_to_biomass(SUM(circ_class_biomass(:,j,:,ileaf,icarbon)*&
+                circ_class_n(:,j,:),2),npts,j))) * dt ) / (one_year)
+         
+       ELSEWHERE
+
+          rue_longterm(:,j) = rue_longterm(:,j)
+
+       ENDWHERE
+	
+       ! Make sure rue_longterm is never less than min_stomate
+       ! else we may get error messages in allocation and other
+       ! routines
+       WHERE (rue_longterm(:,j) .LE. min_stomate)
+
+          rue_longterm(:,j) = min_stomate	
+
+       ENDWHERE
+
+    ENDDO
+
+    !
+    !! 15. Update the maximum and minimum moisture availabilities (::maxmoiavail_thisyear 
+    !!     and ::minmoiavail_thisyear). If the daily moisture availability, ::moiavail_daily,
+    !!     which was calculated earlier in this subroutine, is greater or less than the current
+    !!     value of the maximum or minimum moisture availability, then set the value for the maximum
+    !!     or minimum to the current daily value respectively. \n
+    !!     ::maxmoiavail_thisyear and ::minmoiavail_thisyear are used to update the variables 
+    !!     ::maxmoiavail_lastyear and ::minmoiavail_lastyear in Section 21 of this subroutine, 
+    !!     which are used in the module ::stomate_phenology for the leaf onset models 'hum' and 
+    !!     'humgdd', and in the module ::stomate_turnover for the leaf senescence models 'dry' 
+    !!     and 'mixed'.
+    !
+
+    WHERE ( moiavail_daily .GT. maxmoiavail_thisyear )
+       maxmoiavail_thisyear = moiavail_daily
+    ENDWHERE
+
+    WHERE ( moiavail_daily .LT. minmoiavail_thisyear )
+       minmoiavail_thisyear = moiavail_daily
+    ENDWHERE
+
+    !
+    !! 16. Update the annual maximum weekly GPP (::maxgppweek_thisyear), if the weekly GPP
+    !!     is greater than the current value of the annual maximum weekly GPP.
+    !!     The use of this variable is described in Section 14.
+    !
+
+    WHERE ( gpp_week .GT. maxgppweek_thisyear )
+       maxgppweek_thisyear = gpp_week
+    ENDWHERE
+
+    !
+    !! 17. Update the annual GDD0 by adding the current daily 2-meter temperature 
+    !!     (multiplied by the stomate time step, which is one day), if it is greater
+    !!     than zero degrees C. \n
+    !!     This variable is mostly used in the module ::lpj_establish.
+    !
+
+    WHERE ( t2m_daily .GT. ZeroCelsius )
+       gdd0_thisyear = gdd0_thisyear + dt * ( t2m_daily - ZeroCelsius )
+    ENDWHERE
+
+    !
+    !! 18. Update the annual precipitation by adding the current daily precipitation
+    !!     amount (multiplied by the stomate time step, which is usually one day). \n
+    !
+
+    precip_thisyear = precip_thisyear + dt * precip_daily
+
+    
+!
+    !! 19. Update the annual maximum leaf mass for each PFT (::lm_thisyearmax) and the maximum fractional
+    !!     plant cover if the LPJ DGVM is activated.       
+    !
+    
+    !
+    !! 19.1 If the LPJ DGVM is activated first the fraction of natural vegetation (::fracnat), i.e. non-
+    !!      agricultural vegetation (PFTs 2-11) is calculated for each PFT. Each PFT is looped over.
+    !
+    IF(ok_dgvm ) THEN
+
+       fracnat(:) = un
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( .NOT. natural(j) ) THEN
+             fracnat(:) = fracnat(:) - veget_cov_max(:,j)
+          ENDIF
+       ENDDO
+
+    ENDIF
+
+    !
+    !! 19.2 If LPJ and STOMATE are activated, first the maximum fractional plant cover needs to be updated, 
+    !!      and then this year's leaf biomass. Each PFT is looped over.
+    !!      Both are updated according to the linear relaxation method described above. 
+    !!      \latexonly
+    !!      \input{season_lin_relax_eqn1.tex}
+    !!      \endlatexonly
+    !!      \n
+    !!      The time constant for this process is set as one year (in seconds) divided by the parameter
+    !!      ::leaflife_tab, which gives the leaf lifetime in years and is set for each PFT in the module 
+    !!      ::stomate_constants. Each PFT is looped over. \n
+    !
+
+    IF ( ok_stomate ) THEN
+       IF(ok_dgvm ) THEN
+          DO j=2,nvm ! Loop over # PFTs
+
+             !
+             !! 19.2.1 Calculate maximum fractional plant cover (::maxfpc_lastyear).
+             !!        If natural vegetation is present in the grid cell, and the leaf
+             !!        biomass is greater than three-quarters of last year's leaf biomass, the maximum fractional plant
+             !!        cover for last year is updated. \n 
+             !!        The short-term variable (Xs in the above equation) that is being used to update the long-term 
+             !!        maximum fractional plant cover is the fractional cover of natural vegetation, specified as 
+             !!        ::veget_cov/::fracnat. Last year's value is then set to be this year's value.
+             !
+
+             IF ( natural(j) .AND. ok_dgvm ) THEN
+
+                WHERE ( fracnat(:) .GT. min_stomate .AND. SUM(circ_class_biomass(:,j,:,ileaf,icarbon)*&
+                    circ_class_n(:,j,:),2).GT. lm_lastyearmax(:,j)*0.75 )
+                   maxfpc_lastyear(:,j) = ( maxfpc_lastyear(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
+                        veget_cov(:,j) / fracnat(:) * dt ) / (one_year/leaflife_tab(j))
+                ENDWHERE
+                maxfpc_thisyear(:,j) = maxfpc_lastyear(:,j) ! just to initialise value
+
+             ENDIF
+
+!NV : correct initialization
+!!$             WHERE(biomass(:,j,ileaf,icarbon).GT. lm_lastyearmax(:,j)*0.75)
+!!$                lm_lastyearmax(:,j) = ( lm_lastyearmax(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
+!!$                     biomass(:,j,ileaf,icarbon) * dt ) / (one_year/leaflife_tab(j))
+!!$             ENDWHERE
+!!$             lm_thisyearmax(:,j)=lm_lastyearmax(:,j) ! just to initialise value
+
+             
+             !
+             !! 19.2.2 Update this year's leaf biomass (::lm_thisyearmax).
+             !!        The short-term variable (Xs in the above equation) that is being used to update the long-term 
+             !!        this year's leaf biomass is the leaf biomass pool (::biomass(i,j,ileaf).
+             !
+             WHERE (lm_thisyearmax(:,j) .GT. min_stomate)
+                WHERE( SUM(circ_class_biomass(:,j,:,ileaf,icarbon)*&
+                    circ_class_n(:,j,:),2).GT. lm_thisyearmax(:,j)*0.75)
+                   lm_thisyearmax(:,j) = ( lm_thisyearmax(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
+                         SUM(circ_class_biomass(:,j,:,ileaf,icarbon)*&
+                         circ_class_n(:,j,:),2) * dt ) / (one_year/leaflife_tab(j))
+                ENDWHERE
+             ELSEWHERE
+                lm_thisyearmax(:,j) = SUM(circ_class_biomass(:,j,:,ileaf,icarbon)*&
+                    circ_class_n(:,j,:),2)
+             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 (  SUM(circ_class_biomass(:,j,:,ileaf,icarbon)*&
+                    circ_class_n(:,j,:),2) .GT. lm_thisyearmax(:,j) )
+                lm_thisyearmax(:,j) = SUM(circ_class_biomass(:,j,:,ileaf,icarbon)*&
+                    circ_class_n(:,j,:),2)
+             ENDWHERE
+          ENDDO
+
+       ENDIF !(ok_dgvm)
+    ELSE
+
+          !
+          !! 19.4 If STOMATE is not activated, the maximum leaf biomass is set to be the maximum possible 
+          !!      LAI of the PFT.
+          !
+
+       DO j = 2,nvm ! Loop over # PFTs
+          lm_thisyearmax(:,j) = lai_to_biomass(lai_max(j),j)
+       ENDDO
+
+    ENDIF  !(ok_stomate)
+
+    !
+    !! 20. Update the annual maximum fractional plant cover for each PFT if the current fractional cover 
+    !!     (::veget_cov), is larger than the current maximum value.
+    !!     ::veget_cov is defined as fraction of total ground. Therefore, maxfpc_thisyear has the same unit.
+    !
+
+    WHERE ( veget_cov(:,:) .GT. maxfpc_thisyear(:,:) )
+       maxfpc_thisyear(:,:) = veget_cov(:,:)
+    ENDWHERE
+
+ 
+    ! 20.X leaf nitrogen concentration 
+!    DO j=2,nvm 
+!       WHERE (biomass(:,j,ileaf,initrogen) .GT. min_stomate)  
+!!          cn_leaf_min_season(:,j)= MIN(cn_leaf_min_season(:,j),biomass(:,j,ileaf,icarbon)/biomass(:,j,ileaf,initrogen))
+!          cn_leaf_min_season(:,j)=( cn_leaf_min_season(:,j) * ( one_year/leaflife_tab(j) - dt ) + &  
+!                   biomass(:,j,ileaf,icarbon)/biomass(:,j,ileaf,initrogen) *dt )/ (one_year/leaflife_tab(j) )  
+!       ENDWHERE 
+!    ENDDO 
+ 
+    ! 20.X nitrogen stress for carbon allocation 
+    IF ( Dmax.GT.0.0 ) THEN 
+       DO j=2,nvm 
+          nn(:) = SUM(circ_class_biomass(:,j,:,ileaf,initrogen)*&             
+                    circ_class_n(:,j,:),2) + SUM(circ_class_biomass(:,j,:,iroot,initrogen)*&
+                    circ_class_n(:,j,:),2) + SUM(circ_class_biomass(:,j,:,ilabile,initrogen)*&
+                    circ_class_n(:,j,:),2)   
+          WHERE (nn(:) .GT. min_stomate)  
+             cn(:) = (  SUM(circ_class_biomass(:,j,:,ileaf,icarbon)*&
+                    circ_class_n(:,j,:),2) + SUM(circ_class_biomass(:,j,:,iroot,icarbon)*&
+                    circ_class_n(:,j,:),2) + SUM(circ_class_biomass(:,j,:,ilabile,icarbon)*&
+                    circ_class_n(:,j,:),2) ) / nn(:)   
+          ELSEWHERE 
+             cn(:) = zero 
+          ENDWHERE 
+ 
+          WHERE (cn(:) .GT. min_stomate)  
+             nstress_season(:,j)= ( nstress_season(:,j) * ( one_year - dt ) + & 
+                                    MAX(MIN( (cn_leaf_init(j)/cn(:)),1.),0.3 ) & 
+                  * dt ) / one_year  
+          ENDWHERE 
+       ENDDO 
+ 
+    ELSE 
+       nstress_season(:,:)=1.0 
+    ENDIF 
+       
+    CALL histwrite_p (hist_id_stomate, 'NSTRESS_SEASON', itime, &
+         nstress_season, npts, horipft_index)
+    CALL xios_orchidee_send_field("NSTRESS_SEASON",nstress_season)
+
+    !
+    ! 2.3 "growing season"
+    !
+    DO j=2,nvm
+       IF(is_tree(j))THEN
+         WHERE( SUM(circ_class_biomass(:,j,:,ileaf,icarbon)*&
+                    circ_class_n(:,j,:),2).GT.min_stomate)
+            moiavail_growingseason(:,j) = ( moiavail_growingseason(:,j) * ( tau_sap(j) - dt ) + &
+                        MIN(1.,2.*moiavail_daily(:,j)) * dt ) / tau_sap(j)
+         ENDWHERE
+       ELSE	
+         WHERE( SUM(circ_class_biomass(:,j,:,ileaf,icarbon)*&
+                    circ_class_n(:,j,:),2).GT.min_stomate)
+            moiavail_growingseason(:,j) = ( moiavail_growingseason(:,j) * ( 30.  - dt ) + &
+                        MIN(1.,2.*moiavail_daily(:,j)) * dt ) / 30.
+         ENDWHERE
+       ENDIF
+    ENDDO
+
+    CALL histwrite_p (hist_id_stomate, 'MOIAVAIL_SEASON', itime, &
+         moiavail_growingseason, npts, horipft_index)
+    CALL xios_orchidee_send_field('MOIAVAIL_SEASON',moiavail_growingseason)
+    ! 20.X nitrogen stress for photosynthesis  
+    !    DO j=2,nvm 
+    !       WHERE (biomass(:,j,ileaf,initrogen) .GT. min_stomate)  
+    !          nstress2_season(:,j)= ( nstress2_season(:,j) * ( one_year/leaflife_tab(j) - dt ) + & 
+    !               MAX(1.-(nstress2_daily(:,j)-1.),0.3) *dt )/ (one_year/leaflife_tab(j) )  
+    !       ENDWHERE 
+    !    ENDDO        
+
+    !
+    !! 21. At the end of the every year, last year's maximum and minimum moisture availability,
+    !!     annual GDD0, annual precipitation, annual max weekly GPP, and maximum leaf mass are 
+    !!     updated with the value calculated for the current year, and then their value reset.
+    !!     Either to zero for the maximum variables, or to ::large_value (set to be 1.E33 in ::
+    !!     the module ::stomate_constants) for the minimum variable ::minmoiavail_thisyear.
+    !
+
+    IF ( EndOfYear ) THEN
+
+       !
+       !! 21.1 Update last year's values. \n
+       !!      The variables ::maxmoiavail_lastyear, ::minmoiavail_lastyear and ::maxgppweek_lastyear  
+       !!      are updated using the relaxation method:
+       !!      \latexonly
+       !!      \input{season_lin_relax_eqn1.tex}
+       !!      \endlatexonly
+       !!      \n
+       !!      where Xs is this year's value, dt (Delta-t) is set to 1 (year), and the time constant (tau) !??
+       !!      is set by the parameter ::tau_climatology, which is set to 20 years at the beginning 
+       !!      of this subroutine. \n
+       !!      The other variables (::gdd0_lastyear, ::precip_lastyear, ::lm_lastyearmax and 
+       !!      ::maxfpc_lastyear) are just replaced with this year's value.
+       !
+       !NVMODIF
+       maxmoiavail_lastyear(:,:) = (maxmoiavail_lastyear(:,:)*(tau_climatology-1)+ maxmoiavail_thisyear(:,:))/tau_climatology
+       minmoiavail_lastyear(:,:) = (minmoiavail_lastyear(:,:)*(tau_climatology-1)+ minmoiavail_thisyear(:,:))/tau_climatology
+       maxgppweek_lastyear(:,:) =( maxgppweek_lastyear(:,:)*(tau_climatology-1)+ maxgppweek_thisyear(:,:))/tau_climatology
+       !       maxmoiavail_lastyear(:,:) = maxmoiavail_thisyear(:,:)
+       !       minmoiavail_lastyear(:,:) = minmoiavail_thisyear(:,:)
+       !       maxgppweek_lastyear(:,:) = maxgppweek_thisyear(:,:)
+       
+       gdd0_lastyear(:) = gdd0_thisyear(:)
+
+       precip_lastyear(:) = precip_thisyear(:)
+
+       lm_lastyearmax(:,:) = lm_thisyearmax(:,:)
+
+       maxfpc_lastyear(:,:) = maxfpc_thisyear(:,:)
+
+       ! Calculate Tseason
+       Tseason(:) = zero
+       WHERE ( Tseason_length(:) .GT. zero )
+          Tseason(:) = Tseason_tmp(:) / Tseason_length(:)
+       ENDWHERE
+
+       !
+       !! 21.2 Reset new values for the "this year" variables. \n
+       !!      The maximum variables are set to zero and the minimum variable ::minmoiavail_thisyear
+       !!      is set to ::large_value (set to be 1.E33 in the module ::stomate_constants).
+       !
+
+       maxmoiavail_thisyear(:,:) = zero
+       minmoiavail_thisyear(:,:) = large_value
+
+       maxgppweek_thisyear(:,:) = zero
+
+       gdd0_thisyear(:) = zero
+
+       precip_thisyear(:) = zero
+
+       lm_thisyearmax(:,:) = zero
+
+       maxfpc_thisyear(:,:) = zero
+
+       Tseason_tmp(:) = zero
+       Tseason_length(:) =zero
+       Tmin_spring_time(:,:)=zero
+       onset_date(:,:)=zero
+
+       !
+       ! 21.3 Special treatment for maxfpc. !?? 
+       !! 21.3 Set the maximum fractional plant cover for non-natural vegetation 
+       !!      (i.e. agricultural C3 and C4 - PFT 12 and 13) vegetation for last year to be zero.
+       !
+
+       !
+       ! 21.3.1 Only take into account natural PFTs
+       !
+
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( .NOT. natural(j) ) THEN
+             maxfpc_lastyear(:,j) = zero
+          ENDIF
+       ENDDO
+
+       ! 21.3.2 In Stomate, veget_cov is defined as a fraction of ground, not as a fraction 
+       !        of total ground. maxfpc_lastyear will be compared to veget_cov in lpj_light.
+       !        Therefore, we have to transform maxfpc_lastyear.
+
+
+       ! 21.3.3 The sum of the maxfpc_lastyear for natural PFT must not exceed fpc_crit (=.95).
+       !        However, it can slightly exceed this value as not all PFTs reach their maximum 
+       !        fpc at the same time. Therefore, if sum(maxfpc_lastyear) for the natural PFTs
+       !        exceeds fpc_crit, we scale the values of maxfpc_lastyear so that the sum is
+       !        fpc_crit.
+
+!!$       ! calculate the sum of maxfpc_lastyear
+!!$       sumfpc_nat(:) = zero
+!!$       DO j = 2,nvm ! Loop over # PFTs
+!!$          sumfpc_nat(:) = sumfpc_nat(:) + maxfpc_lastyear(:,j)
+!!$       ENDDO
+!!$
+!!$       ! scale so that the new sum is fpc_crit
+!!$       DO j = 2,nvm ! Loop over # PFTs 
+!!$          WHERE ( sumfpc_nat(:) .GT. fpc_crit )
+!!$             maxfpc_lastyear(:,j) = maxfpc_lastyear(:,j) * (fpc_crit/sumfpc_nat(:))
+!!$          ENDWHERE
+!!$       ENDDO
+
+    ENDIF  ! EndOfYear
+
+    !
+    !! 22. Diagnose herbivore activity (::herbivores), determined as probability for a leaf to be
+    !!     eaten in a day (follows McNaughton et al., 1989). \n
+    !!     The amount of herbivore activity is used in the modules ::lpj_establish  
+    !!     and ::stomate_turnover.
+    !
+
+    !
+    !! 22.1 First calculate the mean long-term leaf NPP in grid box, mean residence
+    !!      time (years) of green tissue to give the biomass available for herbivore consumption.
+    !!      Each PFT is looped over, though the calculation is only made for
+    !!      natural vegetation (PFTs 2-11).
+    !
+
+    nlflong_nat(:,:) = zero
+    weighttot(:,:) = zero
+    green_age(:,:) = zero
+    !
+    DO j = 2,nvm ! Loop over # PFTs
+       !
+       IF ( natural(j) ) THEN
+          !
+          !! 22.1.1 Calculate the total weight of the leaves (::weighttot) as last year's leaf biomass
+          !
+          weighttot(:,j) = lm_lastyearmax(:,j)
+          
+          !
+          !! 22.1.2 Calculate the mean long-term leaf NPP as the long-term NPP calculated in Section 12 of 
+          !!        this subroutine weighted by the leaf fraction (::leaf_frac), which is defined to be 0.33
+          !!        at the beginning of this subroutine.
+          !
+          nlflong_nat(:,j) = npp_longterm(:,j) * leaf_frac_hvc
+          
+          !
+          !! 22.1.3 Calculate the mean residence time of the green tissue (::green_age) 
+          !!        This is calculated as the sum of 6 months 
+          !!        for natural seasonal vegetation (i.e. PFTs 3, 6, 8-11), and 2 years for evergreen 
+          !!        (PFTs 2, 4, 5, 8), multiplied by last year's leaf biomass for each PFT, divided by the 
+          !!        total weight of the leaves for all PFTs.
+          !         This is a crude approximation.  !!?? By whom?
+          !!        The difference between seasonal and evergreen vegetation is determined by the parameter
+          !!        ::pheno_model, which specifies the onset model of the PFT.
+ 
+          !
+          IF ( pheno_model(j) .EQ. 'none' ) THEN
+             green_age(:,j) = green_age_ever * lm_lastyearmax(:,j)
+          ELSE
+             green_age(:,j) = green_age_dec * lm_lastyearmax(:,j)
+          ENDIF
+          !
+       ENDIF
+       !
+    ENDDO
+    !
+    WHERE ( weighttot(:,:) .GT. zero )
+       green_age(:,:) = green_age(:,:) / weighttot(:,:)
+    ELSEWHERE
+       green_age(:,:) = un
+    ENDWHERE
+
+    !
+    !! 22.2 McNaughton et al. (1989) give herbivore consumption as a function of mean, long-term leaf NPP.
+    !!      as it gives an estimate of the edible biomass. The consumption of biomass by herbivores and the 
+    !!      resultant herbivore activity are calculated following the equations:
+    !!      \latexonly
+    !!      \input{season_consumption_eqn4.tex}
+    !!      \endlatexonly
+    !!      \n 
+    !!      and 
+    !!      \latexonly
+    !!      \input{season_herbivore_eqn5.tex}
+    !!      \endlatexonly
+    !!      \n 
+    !       
+
+    DO j = 2,nvm ! Loop over # PFTs
+       !
+       IF ( natural(j) ) THEN
+          !
+          WHERE ( nlflong_nat(:,j) .GT. zero )
+             consumption(:) = hvc1 * nlflong_nat(:,j) ** hvc2
+             herbivores(:,j) = one_year * green_age(:,j) * nlflong_nat(:,j) / consumption(:)
+          ELSEWHERE
+             herbivores(:,j) = 100000.
+          ENDWHERE
+          !
+       ELSE
+          !
+          herbivores(:,j) = 100000.
+          !
+       ENDIF
+       !
+    ENDDO
+    herbivores(:,ibare_sechiba) = zero
+
+    !! 23. Update plant_status
+    ! ibudbreak was kept for one day. It can now be
+    ! upgraded to the next phenological stage, i.e.,
+    ! icanopy. If this is not done the model will
+    ! try to grow new leaves where there are already 
+    ! leaves
+    WHERE ( plant_status(:,:) .EQ. ibudbreak )
+
+       plant_status(:,:) = icanopy
+
+    ENDWHERE
+
+    !!  Update the last 5 year harvest area in the end of year 
+    IF (EndofYear) THEN
+
+       tmp_5y_area(:,:,:) = zero
+
+       ! Drop the last year, keep the other years but move them
+       ! One postion in the array
+       DO iyear = 1, wind_years-1
+
+          ! Copy the harvest_5y_area array to tmp_5y_area with one 
+          ! year time shift   
+          tmp_5y_area(:,:,iyear+1) = harvest_5y_area(:,:,iyear)
+
+       ENDDO ! end of iyear loop
+
+       ! Add this year on the first position
+       tmp_5y_area(:,:,1) = harvest_area(:,:)
+
+       ! Update the harvest_5y_area from tmp_5y_area
+       harvest_5y_area(:,:,:) = tmp_5y_area(:,:,:)
+
+       DO iyear = 1, wind_years
+          WRITE(var_name,'(A,I3.3)') 'HARVEST_5Y_',iyear
+          CALL histwrite_p (hist_id_stomate, var_name, itime, &
+               harvest_5y_area(:,:,iyear), npts*nvm, horipft_index)
+       ENDDO
+    
+    ENDIF ! EndofYear
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving season'
+
+  END SUBROUTINE season
+
+END MODULE stomate_season
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_soilcarbon.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_soilcarbon.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_soilcarbon.f90	(revision 6412)
@@ -0,0 +1,2271 @@
+! =============================================================================================================================
+! MODULE       : stomate_somdynamics
+!
+! 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_som_dynamics
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE xios_orchidee
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE function_library, ONLY : check_mass_balance 
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC som_dynamics,som_dynamics_clear,nitrogen_dynamics,nitrogen_dynamics_clear
+
+  ! Variables shared by all subroutines in this module
+  
+  LOGICAL, SAVE                                    :: firstcall_som = .TRUE.      !! Is this the first call? (true/false)
+!$OMP THREADPRIVATE(firstcall_som)
+  LOGICAL, SAVE                                    :: firstcall_nitrogen = .TRUE. !! Is this the first call? (true/false)
+!$OMP THREADPRIVATE(firstcall_nitrogen)
+  ! flux fractions within carbon pools
+  REAL(r_std),ALLOCATABLE,SAVE, DIMENSION(:,:,:)   :: frac_carb                   !! Flux fractions between carbon pools 
+                                                                                  !! (second index=origin, third index=destination) 
+                                                                                  !! (unitless, 0-1)
+!$OMP THREADPRIVATE(frac_carb)
+  REAL(r_std), ALLOCATABLE,SAVE, DIMENSION(:,:)    :: frac_resp                   !! Flux fractions from carbon pools to the 
+                                                                                  !! atmosphere (respiration) (unitless, 0-1)
+!$OMP THREADPRIVATE(frac_resp)
+
+CONTAINS
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : som_dynamics_clear
+!!
+!>\BRIEF        Set the flag ::firstcall_som to .TRUE. and as such activate sections 1.1.2 and 1.2 of the subroutine som_dynamics 
+!! (see below).
+!! 
+!_ ================================================================================================================================
+  
+  SUBROUTINE som_dynamics_clear
+    firstcall_som=.TRUE.
+  END SUBROUTINE som_dynamics_clear
+
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : som_dynamics
+!!
+!>\BRIEF        Computes the soil respiration and carbon stocks, essentially 
+!! following Parton et al. (1987).
+!!
+!! DESCRIPTION	: The soil is divided into 3 carbon pools, with different 
+!! characteristic turnover times : active (1-5 years), slow (20-40 years) 
+!! and passive (200-1500 years).\n
+!! There are three types of carbon transferred in the soil:\n
+!! - carbon input in active and slow pools from litter decomposition,\n
+!! - carbon fluxes between the three pools,\n
+!! - carbon losses from the pools to the atmosphere, i.e., soil respiration.\n
+!!
+!! The subroutine performs the following tasks:\n
+!!
+!! Section 1.\n
+!! The flux fractions (f) between carbon pools are defined based on Parton et 
+!! al. (1987). The fractions are constants, except for the flux fraction from
+!! the active pool to the slow pool, which depends on the clay content,\n
+!! \latexonly
+!! \input{soilcarbon_eq1.tex}
+!! \endlatexonly\n
+!! In addition, to each pool is assigned a constant turnover time.\n
+!!
+!! Section 2.\n
+!! The carbon input, calculated in the stomate_litter module, is added to the 
+!! carbon stock of the different pools.\n
+!!
+!! Section 3.\n
+!! First, the outgoing carbon flux of each pool is calculated. It is 
+!! proportional to the product of the carbon stock and the ratio between the 
+!! iteration time step and the residence time:\n
+!! \latexonly
+!! \input{soilcarbon_eq2.tex}
+!! \endlatexonly
+!! ,\n
+!! Note that in the case of crops, the additional multiplicative factor 
+!! integrates the faster decomposition due to tillage (following Gervois et 
+!! al. (2008)).
+!! In addition, the flux from the active pool depends on the clay content:\n
+!! \latexonly
+!! \input{soilcarbon_eq3.tex}
+!! \endlatexonly
+!! ,\n
+!! Each pool is then cut from the carbon amount corresponding to each outgoing
+!! flux:\n
+!! \latexonly
+!! \input{soilcarbon_eq4.tex}
+!! \endlatexonly\n
+!! Second, the flux fractions lost to the atmosphere is calculated in each pool
+!! by subtracting from 1 the pool-to-pool flux fractions. The soil respiration 
+!! is then the summed contribution of all the pools,\n
+!! \latexonly
+!! \input{soilcarbon_eq5.tex}
+!! \endlatexonly\n
+!! Finally, each carbon pool accumulates the contribution of the other pools:
+!! \latexonly
+!! \input{soilcarbon_eq6.tex}
+!! \endlatexonly
+!!
+!! Section 4.\n
+!! If the flag SPINUP_ANALYTIC is set to true, the matrix A is updated following
+!! Lardy (2011).
+!!
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUTS VARIABLE(S): carbon, resp_hetero_soil
+!!
+!! REFERENCE(S)   :
+!! - Parton, W.J., D.S. Schimel, C.V. Cole, and D.S. Ojima. 1987. Analysis of 
+!! factors controlling soil organic matter levels in Great Plains grasslands. 
+!! Soil Sci. Soc. Am. J., 51, 1173-1179.
+!! - Gervois, S., P. Ciais, N. de Noblet-Ducoudre, N. Brisson, N. Vuichard, 
+!! and N. Viovy (2008), Carbon and water balance of European croplands 
+!! throughout the 20th century, Global Biogeochem. Cycles, 22, GB2022, 
+!! doi:10.1029/2007GB003018.
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART    :
+!! \latexonly
+!! \includegraphics[scale=0.5]{soilcarbon_flowchart.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE som_dynamics (npts, clay, silt, veget_cov_max, & 
+       som_input, control_temp, control_moist, drainage_pft,&
+       CN_target, som, soil_n_min, resp_hetero_soil, &
+       MatrixA, n_mineralisation, CN_som_litter_longterm, tau_CN_longterm)
+
+!! 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)              :: clay             !! Clay fraction (unitless, 0-1) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)              :: silt             !! Silt fraction (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nelements), INTENT(in) :: som_input !! Amount of Organic Matter going into the SOM 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)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)          :: veget_cov_max        !! Coverage fraction of a PFT within the pixel 
+                                                                              !! (unitless, 0-1) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)          :: drainage_pft     !! daily fraction of water lost from the soil column by leaching 
+                                                                              !! (fraction of water content)
+    REAL(r_std), DIMENSION(npts,nvm,ncarb), INTENT(in)    :: CN_target        !! C to N ratio of SOM flux from one pool to 
+                                                                              !! another (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nnspec),INTENT(in)    :: soil_n_min       !! mineral nitrogen in the soil (gN/m**2) 
+                                                                              !! (first index=npts, second index=nvm, third index=nnspec)  
+
+    !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)         :: resp_hetero_soil !! Soil heterotrophic respiration \f$(gC m^{-2} dt^{-1})$\f
+
+    !! 0.3 Modified variables
+    
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)        :: som              !! SOM pools: active, slow, or passive, \f$(gC m^{2})$\f
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)        :: MatrixA          !! Matrix containing the fluxes between the carbon pools
+                                                                              !! per sechiba time step 
+                                                                              !! @tex $(gC.m^2.day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: n_mineralisation !! Mineral N pool (gN m-2)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)          :: CN_som_litter_longterm !! Longterm CN ratio of litter and som pools (gC/gN)
+    REAL(r_std), INTENT(inout)                            :: tau_CN_longterm  !! Counter used for calculating the longterm CN ratio 
+                                                                              !! of som and litter pools [seconds]
+
+    !! 0.4 Local variables
+    REAL(r_std)                                           :: dt               !! Time step \f$(dt_sechiba one_day^{-1})$\f
+    LOGICAL                                               :: l_error          !! Diagnostic boolean for error allocation (true/false)
+    INTEGER(i_std)                                        :: ier              !! Check errors in netcdf call
+    REAL(r_std), SAVE, DIMENSION(ncarb)                   :: som_turn         !! Residence time in SOM pools (days)
+!$OMP THREADPRIVATE(som_turn)
+    REAL(r_std), DIMENSION(npts,nvm,ncarb,nelements)      :: fluxtot          !! Total flux out of carbon pools \f$(gC m^{2})$\f
+    REAL(r_std), DIMENSION(npts,ncarb,ncarb,nelements)    :: distributed      !!
+    REAL(r_std), DIMENSION(npts,ncarb,nelements)          :: residual         !!
+    REAL(r_std), DIMENSION(npts,nvm,ncarb,ncarb,nelements):: flux             !! Fluxes between carbon pools \f$(gC m^{2})$\f
+    REAL(r_std), DIMENSION(npts,nvm,nelements)            :: total_som_n_flux !! Total flux between all soil pools. Used 
+                                                                              !! to adjust som if overspending 
+                                                                              !! @tex $(N gN m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)            :: old_som_n_flux   !! Total flux between all soil pools. Used 
+                                                                              !! to adjust som if overspending 
+                                                                              !! @tex $(N gN m^{-2})$ @endtex
+    REAL(r_std)                                           :: delta_n_min      !! Amount of nitrogen that was overspend 
+                                                                              !! @tex $(N gN m^{-2})$ @endtex
+    REAL(r_std)                                           :: reduction_factor !! Factor to reduce the som pools in case of 
+                                                                              !! overspending (unitless)
+    REAL(r_std), DIMENSION(ncarb,nelements)               :: share_flux       !! share of the diiferent som components in case of
+                                                                              !! overspending (unitless)
+    REAL(r_std), DIMENSION(nelements)                     :: delta_som        !! Absolute reduction gN m-2 or gC m-2 in case of overspending
+    CHARACTER(LEN=7), DIMENSION(ncarb)                    :: soilpools_str    !! Name of the soil pools for informative outputs (unitless)
+    INTEGER(i_std)                                        :: iicarb           !! Indices (unitless)
+    INTEGER(i_std)                                        :: icarb, imbc      !! Indices (unitless)
+    INTEGER(i_std)                                        :: ipts, ivm,iele   !! Indices (unitless)
+    INTEGER(i_std)                                        :: inbpools         !! Indices (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)    :: check_intern     !! Contains the components of the internal
+                                                                              !! mass balance check for this routine
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)            :: closure_intern   !! Check closure of internal mass balance
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)            :: pool_start       !! Start and end pool of this routine 
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)            :: pool_end         !! Start and end pool of this routine 
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex  
+
+!_ ================================================================================================================================
+
+    !! printlev is the level of diagnostic information, 0 (none) to 4 (full)
+    IF (printlev>=3) WRITE(numout,*) 'Entering som_dynamics' 
+
+    !! 1.1 Initialize local printlev
+    !printlev_loc=get_printlev('soildynamics')
+
+    dt = dt_sechiba/one_day
+
+    !! 0. Initialize check for mass balance closure
+    !  The mass balance is calculated at the end of this routine
+    !  in section 14. Initial biomass and harvest pool and all other
+    !  relevant pools were set to zero before calling this routine.
+    pool_start(:,:,:) = zero
+    DO iele = 1,nelements
+       DO icarb = 1,ncarb
+          pool_start(:,:,iele) = pool_start(:,:,iele) + &
+               ( som(:,icarb,:,iele) + (som_input(:,icarb,:,iele) * dt) ) * &
+               veget_cov_max(:,:)
+       ENDDO
+    ENDDO
+
+    pool_start(:,:,initrogen) = pool_start(:,:,initrogen) + &
+         ( n_mineralisation(:,:) ) * veget_cov_max(:,:)
+    
+
+    !! 1. Initializations
+
+    IF ( firstcall_som ) THEN
+
+       l_error = .FALSE.
+       ALLOCATE (frac_carb(npts,ncarb,ncarb), stat=ier)
+       l_error = l_error .OR. (ier.NE.0)
+       ALLOCATE (frac_resp(npts,ncarb), stat=ier)
+       l_error = l_error .OR. (ier.NE.0)
+       IF (l_error) THEN
+          STOP 'stomate_som_dynamics: error in memory allocation'
+       ENDIF
+
+       frac_carb(:,:,:) = 0.0
+       !! 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,ipassive) = active_to_pass_ref_frac + active_to_pass_clay_frac*clay(:)
+       frac_carb(:,iactive,islow) = un - frac_carb(:,iactive,ipassive) - &
+            (active_to_co2_ref_frac - active_to_co2_clay_silt_frac*(clay(:)+silt(:)))
+
+       ! From slow pool    
+       frac_carb(:,islow,ipassive) = slow_to_pass_ref_frac + slow_to_pass_clay_frac*clay(:)
+
+       ! OCN doesn't use Parton 1993 formulation for frac_carb(:,islow,ipassive) 
+       ! but the one of 1987 : ie = 0.03 ....
+       frac_carb(:,islow,iactive) = un - frac_carb(:,islow,ipassive) - slow_to_co2_ref_frac
+
+       ! From passive pool
+       frac_carb(:,ipassive,iactive) = pass_to_active_ref_frac
+       frac_carb(:,ipassive,islow) = pass_to_slow_ref_frac
+
+       ! From surface pool
+       frac_carb(:,isurface,islow) = surf_to_slow_ref_frac
+
+       !! 1.1.2 Determine the respiration fraction : what's left after
+       ! subtracting all the 'pool-to-pool' flux fractions
+       ! Diagonal elements of frac_carb are zero
+       frac_resp(:,:) = un - frac_carb(:,:,isurface) - frac_carb(:,:,iactive) - frac_carb(:,:,islow) - &
+            frac_carb(:,:,ipassive) 
+
+       !! 1.1.3 Turnover in SOM pools (in days)
+       !! som_turn_ipool is the turnover (in years)
+       !! It is weighted by Temp and Humidity function later
+       som_turn(iactive) = som_turn_iactive / one_year    
+       som_turn(islow) = som_turn_islow / one_year            
+       som_turn(ipassive) = som_turn_ipassive / one_year    
+       som_turn(isurface) = som_turn_isurface / one_year
+
+       !! 1.2 Messages : display the residence times  
+       soilpools_str(iactive) = 'active'
+       soilpools_str(islow) = 'slow'
+       soilpools_str(ipassive) = 'passive'
+       soilpools_str(isurface) = 'surface'
+
+       IF(printlev_loc>=4)THEN
+          WRITE(numout,*) 'som_dynamics:'        
+          WRITE(numout,*) '   > minimal SOM residence time in soil pools (d):'
+          DO icarb = 1, ncarb ! Loop over soil pools
+             WRITE(numout,*) '(1, ::soilpools_str(icarb)):', &
+                  soilpools_str(icarb)
+             WRITE(numout,*) 'FRACCARB icarb=',icarb,' ', &
+                  frac_carb(1,icarb,isurface),frac_carb(1,icarb,iactive),&
+                  frac_carb(1,icarb,islow),frac_carb(1,icarb,ipassive)
+          ENDDO
+          WRITE(numout,*) '   > flux fractions between soil pools: depend on clay content'
+       ENDIF
+
+       firstcall_som = .FALSE.
+
+    ENDIF
+
+    !! 1.3 Initialise
+    resp_hetero_soil(:,:) = zero
+    total_som_n_flux(:,:,:) = zero
+    old_som_n_flux(:,:,:) = zero
+
+    !! 2. Update the SOM stocks with the different soil carbon input
+
+    IF(printlev_loc>=4)THEN
+       WRITE(numout,*) 'som, ',som(:,:,:,:)
+       WRITE(numout,*) 'som_input, ',som_input(:,:,:,:)
+       WRITE(numout,*) 'som_turn, ',som_turn(:)
+       WRITE(numout,*) 'decomp_factor, ',decomp_factor(:)
+    ENDIF
+
+    som(:,:,:,:) = som(:,:,:,:) + som_input(:,:,:,:) * dt 
+
+    !! 3. Fluxes between carbon reservoirs, and to the atmosphere (respiration) \n
+
+    !! 3.2. Calculate fluxes
+    DO ivm = 1,nvm ! Loop over #Â PFTs
+
+       !! 3.2.1. Flux out of pools
+       ! Loop over carbon pools from which the flux comes
+       DO icarb = 1, ncarb 
+
+          DO iele = 1, nelements 
+
+             ! Determine total flux out of pool [gN m-2]
+             fluxtot(:,ivm,icarb,iele) = dt*som_turn(icarb) * &
+                  som(:,icarb,ivm,iele) * control_moist(:,ibelow) * &
+                  control_temp(:,ibelow) * decomp_factor(ivm)
+
+             ! Flux from active pools depends on clay content [gN m-2]
+             IF ( icarb .EQ. iactive ) THEN
+                fluxtot(:,ivm,icarb,iele) = fluxtot(:,ivm,icarb,iele) * &
+                     ( un - som_turn_iactive_clay_frac * clay(:) )
+             ENDIF
+
+             ! Update the loss in each carbon pool [gN m-2]
+             som(:,icarb,ivm,iele) = som(:,icarb,ivm,iele) - &
+                  fluxtot(:,ivm,icarb,iele)
+
+          ENDDO !nelements
+
+          ! Fluxes towards the other pools (icarb -> iicarb)
+          ! Loop over the SOM pools where the flux goes
+          DO iicarb = 1, ncarb 
+
+             ! Carbon flux [gN m-2]
+             flux(:,ivm,icarb,iicarb,icarbon) = frac_carb(:,icarb,iicarb) * &
+                  fluxtot(:,ivm,icarb,icarbon)
+
+             ! Nitrogen flux - Function of the C stock of the 'departure' pool 
+             ! and of the C to N target ratio of the 'arrival' pool [gN m-2]
+             flux(:,ivm,icarb,iicarb,initrogen) = frac_carb(:,icarb,iicarb) * &
+                  fluxtot(:,ivm,icarb,icarbon) / & 
+                  CN_target(:,ivm,iicarb)
+
+          ENDDO ! receiving SOM pools
+
+       ENDDO ! donating SOM pools
+
+       !! 3.2.2 respiration
+       !  Fluxtot is in [gN m-2], resp_hetero_soil is in [gN m-2 dt-1] 
+       !  divide by dt.
+       resp_hetero_soil(:,ivm) = &
+            ( frac_resp(:,iactive) * fluxtot(:,ivm,iactive,icarbon) + &
+            frac_resp(:,islow) * fluxtot(:,ivm,islow,icarbon) + &
+            frac_resp(:,ipassive) * fluxtot(:,ivm,ipassive,icarbon) + &
+            frac_resp(:,isurface) * fluxtot(:,ivm,isurface,icarbon) ) / dt
+
+       !! 3.2.3 add fluxes to active, slow, and passive pools
+       ! Loop over SOM pools
+       DO icarb = 1, ncarb 
+
+          ! Calculate the components of the som fluxes [gN m-2]
+          ! or [gC m-2]
+          som(:,icarb,ivm,:) = som(:,icarb,ivm,:) + &
+               flux(:,ivm,iactive,icarb,:) + &
+               flux(:,ivm,ipassive,icarb,:) + &
+               flux(:,ivm,islow,icarb,:) + &
+               flux(:,ivm,isurface,icarb,:)
+
+          ! Calculate the total flux [gN m-2]
+          total_som_n_flux(:,ivm,:) = total_som_n_flux(:,ivm,:) + &
+               flux(:,ivm,iactive,icarb,:) + &
+               flux(:,ivm,ipassive,icarb,:) + &
+               flux(:,ivm,islow,icarb,:) + &
+               flux(:,ivm,isurface,icarb,:)
+
+       ENDDO ! Loop over SOM pools
+
+    ENDDO ! End loop over PFTs
+ 
+    ! Store to calculate absolute overspending
+    old_som_n_flux(:,:,:) = total_som_n_flux(:,:,:)
+
+    ! If the proposed decomposition consumes more nitrogen
+    ! then currently available in the soil_n_min pool, the
+    ! decomposition needs to be adjusted/reduced.
+    DO ivm = 1,nvm
+
+       DO ipts = 1,npts
+
+          IF ((soil_n_min(ipts,ivm,initrate)+soil_n_min(ipts,ivm,iammonium)) + &
+               n_mineralisation(ipts,ivm) + SUM(fluxtot(ipts,ivm,:,initrogen)) - &
+               total_som_n_flux(ipts,ivm,initrogen) .GE. zero) THEN
+
+             ! There is enough nitrogen in the mineralised pool
+             ! to allow for the immobiolization (if any) in 
+             ! soil_carbon [gN m-2]
+             n_mineralisation(ipts,ivm) = n_mineralisation(ipts,ivm) + &
+                  SUM(fluxtot(ipts,ivm,:,initrogen)) - &
+                  total_som_n_flux(ipts,ivm,initrogen)
+
+          ELSE
+             
+             ! There is not enough soil nitrogen to immobilize later on. 
+             ! Need to decrease the som decomposition. Calculate the 
+             ! amount of nitrogen [gN m-2] that was overspend [gN m-2]
+             delta_n_min = SUM(fluxtot(ipts,ivm,:,initrogen)) - &
+                  total_som_n_flux(ipts,ivm,initrogen) + &
+                  ((soil_n_min(ipts,ivm,initrate)+soil_n_min(ipts,ivm,iammonium)) + &
+                  n_mineralisation(ipts,ivm))
+
+             ! Because total_som_n_flux is subtracted, the most 
+             ! effective method is adjust this variable. However,
+             ! if we decrease total_som_n_flux, we should also decrease
+             ! fluxtot proportionally. 
+             reduction_factor = (SUM(fluxtot(ipts,ivm,:,initrogen)) - &
+                  total_som_n_flux(ipts,ivm,initrogen)-delta_n_min)/&
+                  (SUM(fluxtot(ipts,ivm,:,initrogen)) - &
+                  total_som_n_flux(ipts,ivm,initrogen))
+
+             ! Return the nitrogen and carbon that was decomposed in excess
+             ! of the available nitrogen pools.
+             delta_som(:) = (SUM(fluxtot(ipts,ivm,:,:),1) - &
+                  total_som_n_flux(ipts,ivm,:))*(1-reduction_factor)
+             fluxtot(ipts,ivm,:,:) = fluxtot(ipts,ivm,:,:)*reduction_factor
+             total_som_n_flux(ipts,ivm,initrogen) = reduction_factor * &
+                  total_som_n_flux(ipts,ivm,initrogen)
+
+             ! Recalculate n_mineralisation with the reduced fluxes
+             n_mineralisation(ipts,ivm) = n_mineralisation(ipts,ivm) + &
+                  SUM(fluxtot(ipts,ivm,:,initrogen)) - &
+                  total_som_n_flux(ipts,ivm,initrogen)
+
+             ! Error checking
+             IF (ABS(delta_som(initrogen)-delta_n_min).GT.min_stomate)THEN
+
+                WRITE(numout,*) 'ERROR: inconsistency with nitrogen reduction',&
+                     delta_som(initrogen),delta_n_min
+                CALL ipslerr_p(3,'som_dynamics',&
+                     'inconsistency in calculating nitrogen overspending','','')
+
+             ENDIF
+
+             ! Error checking
+             IF ((soil_n_min(ipts,ivm,initrate)+soil_n_min(ipts,ivm,iammonium)) + &
+                  n_mineralisation(ipts,ivm) .LT. SUM(fluxtot(ipts,ivm,:,initrogen)) - &
+               total_som_n_flux(ipts,ivm,initrogen)) THEN
+                
+                WRITE(numout,*) 'ERROR: failed to solve nitrogen overspending',&
+                     (soil_n_min(ipts,ivm,initrate)+soil_n_min(ipts,ivm,iammonium))+&
+                     n_mineralisation(ipts,ivm), SUM(fluxtot(ipts,ivm,:,initrogen)) - &
+                     total_som_n_flux(ipts,ivm,initrogen)
+                CALL ipslerr_p(3,'som_dynamics','Still overspending',&
+                     'Something wrong with the calculations of the reduction','')
+
+             ENDIF
+
+             ! Proportionaly distribue delta_som over the flux components
+             share_flux(:,:) = zero
+             DO iele = 1,nelements
+                
+                DO icarb = 1,ncarb
+                   
+                   share_flux(icarb,iele) = SUM(flux(ipts,ivm,:,icarb,iele)) / &
+                     SUM(SUM(flux(ipts,ivm,:,:,iele),1))
+
+                ENDDO
+
+             ENDDO
+             
+             ! Avoid introducing mass balance problems. Calculate the last share 
+             ! as the residual of the other shares to make sure that SUM(share)=1
+             share_flux(ncarb,:) = 1
+             DO icarb = 1,ncarb-1
+
+                share_flux(ncarb,:) = share_flux(ncarb,:) - share_flux(icarb,:)
+
+             ENDDO
+
+             ! Error checking
+             DO iele = 1,nelements
+
+                IF (ABS(SUM(share_flux(:,iele))-1).GT.min_stomate) THEN
+
+                   WRITE(numout,*) 'ERROR: sum of shares should equal 1',&
+                        iele, SUM(share_flux(:,iele))
+                   CALL ipslerr_p(3,'som_dynamics','sum of shares should equal','','')
+                   
+                ENDIF
+
+             ENDDO
+ 
+             ! Restore the som pools. The implicit dimension denotes the carbon pools.
+             DO iele = 1,nelements
+
+                som(ipts,:,ivm,iele) = som(ipts,:,ivm,iele) + &
+                     delta_som(iele) * share_flux(:,iele)
+                
+             ENDDO
+
+             ! Some of the nitrogen that was initially mineralized is no longer 
+             ! mineralized. A proportional amount of C has been restored in the 
+             ! soil pools. This implies that there was less decomposition than 
+             ! initially estimated so heterotrophic respiration also needs to be
+             ! adjusted.
+             
+             IF (resp_hetero_soil(ipts,ivm)-delta_som(icarbon)/dt.GT.-min_stomate)THEN
+
+                ! Adjust heterotrophic respiration
+                resp_hetero_soil(ipts,ivm) = resp_hetero_soil(ipts,ivm) - &
+                     delta_som(icarbon)/dt
+
+             ELSE
+
+                ! The decomposition was adjusted but should never become negative
+                WRITE(numout,*) 'ERROR: adjusted heterotrophic respiration &
+                     & became negative',resp_hetero_soil(ipts,ivm), &
+                     delta_som(icarbon)/dt,resp_hetero_soil(ipts,ivm)-delta_som(icarbon)/dt
+                CALL ipslerr_p(3,'stomate_soilcarbon',&
+                     'adjusted heterotrophic respiration became negative','','')
+
+             ENDIF ! resp_hetero_litter .GT. SUM(delta_som_input)
+
+          ENDIF ! overspending nitrogen?
+
+       ENDDO !nvm
+
+    ENDDO !npts
+
+    !! 4. Check mass balance closure
+    !! 4.1 For Carbon 
+    !! 4.1.1 Calculate components of the mass balance
+    pool_end(:,:,:) = zero 
+    pool_end(:,:,initrogen) = pool_end(:,:,initrogen) + &
+         (n_mineralisation(:,:) * veget_cov_max(:,:) ) 
+
+    DO iele = 1,nelements
+       DO icarb = 1,ncarb
+          pool_end(:,:,iele) = pool_end(:,:,iele) + &
+               ( som(:,icarb,:,iele) * veget_cov_max(:,:) )
+       ENDDO
+    ENDDO
+
+    !! 4.1.2 Calculate mass balance
+    !  Note that soilcarbon is transfered to other pools but that the pool
+    !  was not updated. We should not account for it in ::pool_end
+    check_intern(:,:,:,:) = zero
+    check_intern(:,:,iatm2land,icarbon) = zero
+    check_intern(:,:,iland2atm,icarbon) = -un * resp_hetero_soil(:,:) * veget_cov_max(:,:) * dt 
+    check_intern(:,:,ilat2out,icarbon) = -un *zero
+    check_intern(:,:,ilat2in,icarbon) =  zero
+    check_intern(:,:,ipoolchange,icarbon) = -un * (pool_end(:,:,icarbon) - &
+         pool_start(:,:,icarbon))
+    closure_intern = zero
+    DO imbc = 1,nmbcomp
+       closure_intern(:,:,icarbon) = closure_intern(:,:,icarbon) + &
+            check_intern(:,:,imbc,icarbon)
+       IF(printlev_loc>=4)THEN
+          WRITE(numout,*) "check_intern(:,:,imbc,icarbon)",&
+               check_intern(:,:,imbc,icarbon)
+       ENDIF
+    ENDDO
+
+    !! 4.2.2 Calculate mass balance
+    !  Note that soilcarbon is transfered to other pools but that the pool
+    !  was not updated. We should not account for it in ::pool_end
+    ! check_intern(:,:,:,:) = zero
+    check_intern(:,:,iatm2land,initrogen) = zero
+    check_intern(:,:,iland2atm,initrogen) = -un * zero
+    check_intern(:,:,ilat2out,initrogen) = -un* zero
+    check_intern(:,:,ilat2in,initrogen) =  zero
+    check_intern(:,:,ipoolchange,initrogen) = -un * &
+         (pool_end(:,:,initrogen) - pool_start(:,:,initrogen))
+
+    DO imbc = 1,nmbcomp
+       closure_intern(:,:,initrogen) = closure_intern(:,:,initrogen) + &
+            check_intern(:,:,imbc,initrogen)
+       IF(printlev_loc.GT.4) THEN
+          WRITE(numout,*) "check_intern(:,:,imbc,initrogen)",&
+               check_intern(:,:,imbc,initrogen)
+       ENDIF
+    ENDDO
+
+    CALL check_mass_balance("som_dynamics", closure_intern, npts, pool_end, &
+         pool_start, veget_cov_max, 'pft')
+    
+ !! 5. (Quasi-)Analytical Spin-up
+    
+    !! 5.2 Finish to fill MatrixA with fluxes between soil pools
+    
+    IF (spinup_analytic) THEN
+
+       DO ivm = 2,nvm 
+
+          ! flux leaving the active pool
+          MatrixA(:,ivm,iactive_pool,iactive_pool) = moins_un * &
+               dt*som_turn(iactive) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) * &
+               ( 1. - som_turn_iactive_clay_frac * clay(:)) * decomp_factor(ivm)
+
+          ! flux received by the active pool from the slow pool
+          MatrixA(:,ivm,iactive_pool,islow_pool) =  frac_carb(:,islow,iactive)*dt*som_turn(islow) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) * decomp_factor(ivm)
+
+          ! flux received by the active pool from the passive pool
+          MatrixA(:,ivm,iactive_pool,ipassive_pool) =  frac_carb(:,ipassive,iactive)*dt*som_turn(ipassive) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) * decomp_factor(ivm)
+
+          ! flux leaving the slow pool
+          MatrixA(:,ivm,islow_pool,islow_pool) = moins_un * &
+               dt*som_turn(islow) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) * decomp_factor(ivm)
+
+          ! flux received by the slow pool from the active pool
+          MatrixA(:,ivm,islow_pool,iactive_pool) =  frac_carb(:,iactive,islow) *&
+               dt*som_turn(iactive) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) * &
+               ( 1. - som_turn_iactive_clay_frac * clay(:) ) * decomp_factor(ivm)
+
+          ! flux received by the slow pool from the surface pool
+          MatrixA(:,ivm,islow_pool,isurface_pool) =  frac_carb(:,isurface,islow) *&
+               dt*som_turn(isurface) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) * decomp_factor(ivm)
+
+          ! flux leaving the passive pool
+          MatrixA(:,ivm,ipassive_pool,ipassive_pool) =  moins_un * &
+               dt*som_turn(ipassive) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) * decomp_factor(ivm)      
+
+          ! flux received by the passive pool from the active pool
+          MatrixA(:,ivm,ipassive_pool,iactive_pool) =  &
+               frac_carb(:,iactive,ipassive)* &
+               dt*som_turn(iactive) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) *&
+               ( 1. - som_turn_iactive_clay_frac * clay(:) ) * decomp_factor(ivm)
+
+          ! flux received by the passive pool from the slow pool
+          MatrixA(:,ivm,ipassive_pool,islow_pool) =  &
+               frac_carb(:,islow,ipassive) * &
+               dt*som_turn(islow) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) * decomp_factor(ivm)
+
+          ! flux leaving the surface pool
+          MatrixA(:,ivm,isurface_pool,isurface_pool) =  moins_un * &
+               dt*som_turn(isurface) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) * decomp_factor(ivm)      
+
+          WHERE (som(:,isurface,ivm,initrogen) .GT. min_stomate)
+             CN_som_litter_longterm(:,ivm,isurface_pool) = ( CN_som_litter_longterm(:,ivm,isurface_pool) * (tau_CN_longterm-dt) &
+                  + som(:,isurface,ivm,icarbon)/som(:,isurface,ivm,initrogen) * dt)/ (tau_CN_longterm)
+          ENDWHERE
+
+          WHERE (som(:,iactive,ivm,initrogen) .GT. min_stomate)
+             CN_som_litter_longterm(:,ivm,iactive_pool)  = ( CN_som_litter_longterm(:,ivm,iactive_pool) * (tau_CN_longterm-dt) &
+                  + som(:,iactive,ivm,icarbon)/som(:,iactive,ivm,initrogen) * dt)/ (tau_CN_longterm)
+          ENDWHERE
+
+          WHERE(som(:,islow,ivm,initrogen) .GT. min_stomate)
+             CN_som_litter_longterm(:,ivm,islow_pool)    = ( CN_som_litter_longterm(:,ivm,islow_pool) * (tau_CN_longterm-dt) &
+               + som(:,islow,ivm,icarbon)/som(:,islow,ivm,initrogen) * dt)/ (tau_CN_longterm)
+          ENDWHERE
+
+          WHERE(som(:,ipassive,ivm,initrogen) .GT. min_stomate)
+             CN_som_litter_longterm(:,ivm,ipassive_pool) =  ( CN_som_litter_longterm(:,ivm,ipassive_pool) * (tau_CN_longterm-dt) &
+                  + som(:,ipassive,ivm,icarbon)/som(:,ipassive,ivm,initrogen) * dt)/ (tau_CN_longterm)
+          ENDWHERE
+
+          IF (printlev_loc>=4) WRITE(numout,*)'Finish to fill MatrixA'
+      
+       ENDDO ! Loop over # PFTS
+       ! 4.2 Add Identity for each submatrix(7,7) 
+
+       DO inbpools = 1,nbpools
+          MatrixA(:,:,inbpools,inbpools) = MatrixA(:,:,inbpools,inbpools) + un 
+       ENDDO
+    ENDIF ! (spinup_analytic)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving som_dynamics'
+   
+  END SUBROUTINE som_dynamics
+
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : nitrogen_dynamics_clear
+!!
+!>\BRIEF        Set the flag ::firstcall to .TRUE. 
+!! 
+!! 
+!_ ================================================================================================================================
+  
+  SUBROUTINE nitrogen_dynamics_clear
+    firstcall_nitrogen=.TRUE.
+  END SUBROUTINE nitrogen_dynamics_clear
+
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : nitrogen_dynamics
+!!
+!>\BRIEF       
+!!
+!! DESCRIPTION	: This is essentially inspired by DNDC, but very simplified to avoid having
+!! to calculate microbe growth for the moment. Builds on the physico-chemical
+!! reactions with some fixed assumptions. 
+!!
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUTS VARIABLE
+!! FLOWCHART    :
+!_ ================================================================================================================================
+  
+  SUBROUTINE nitrogen_dynamics(npts, clay, sand, &
+       temp_sol, tmc_pft, drainage_pft, swc_pft, veget_cov_max, resp_sol, &
+       som, input, pH, &
+       n_mineralisation, pb, n_fungivores, plant_n_uptake, Bd, soil_n_min, &
+       p_O2, bact, atm_to_bm, leaching, emission, input_dt, ld_redistribute, &
+       circ_class_biomass, circ_class_n)
+    
+    ! 0 declarations
+    
+    ! 0.1 input
+    INTEGER(i_std), INTENT(in)                                         :: npts            !! Domain size
+    REAL(r_std), DIMENSION(npts), INTENT(in)                           :: clay            !! clay fraction (between 0 and 1)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                           :: sand            !! sand fraction (between 0 and 1)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                           :: temp_sol        !! soil temperature (degC)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                       :: tmc_pft         !! Total soil water per PFT (mm/m2)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                       :: drainage_pft    !! Drainage per PFT (mm/m2)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                       :: swc_pft         !! Relative Soil water content [tmcr:tmcs] per pft (-)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                       :: veget_cov_max       !! fraction of a vegetation (0-1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                       :: resp_sol        !! carbon respired from below ground 
+                                                                                          !! (hetero+autotrophic) (gC/m**2/day)
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nelements), INTENT(in)       :: som             !! SOM (gC(or N)/m**2)
+    REAL(r_std), DIMENSION(npts,nvm,ninput), INTENT(in)                :: input           !! nitrogen inputs into the soil  (gN/m**2/day)
+                                                                                          !! NH4 and NOX from the atmosphere, NH4 from BNF,
+                                                                                          !! agricultural fertiliser as NH4/NO3 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                           :: pH              !! soil pH
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements),INTENT(in) :: circ_class_biomass  !! Biomass components of the model tree  
+                                                                                              !! within a circumference class
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(in)                 :: circ_class_n    !! Number of trees in each circumference class
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                    :: n_mineralisation!! net nitrogen mineralisation of decomposing SOM
+                                                                                          !! (gN/m**2/day), supposed to be NH4
+    REAL(r_std), DIMENSION(npts), INTENT(in)                           :: pb              !! Air pressure (hPa)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                           :: Bd              !! Bulk density (kg/m**3)
+    REAL(r_std), DIMENSION(nvm), INTENT(in)                            :: ld_redistribute !! logical set to redistribute som and litter
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                    :: n_fungivores    !! Fraction of N released for plant uptake
+                                                                                          !! due fungivore consumption.
+    REAL(r_std), DIMENSION(npts,nvm,nnspec),INTENT(inout)              :: soil_n_min      !! mineral nitrogen in the soil (gN/m**2) 
+                                                                                          !! (first index=npts, second index=nvm, third index=nnspec)  
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(inout)                     :: p_O2            !! partial pressure of oxigen in the soil (hPa)
+                                                                                          !! (first index=npts, second index=nvm)
+                      
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(inout)                     :: bact            !! denitrifier biomass (gC/m**2)
+                                                                                          !! (first index=npts, second index=nvm)
+    ! 0.2 output
+    REAL(r_std), DIMENSION(npts,nvm,nionspec), INTENT(out)             :: plant_n_uptake    !! Uptake of soil N by plants 
+                                                                                          !! (gN/m**2/timestep)
+    REAL(r_std), DIMENSION(npts,nvm,nelements), INTENT(inout)          :: atm_to_bm       !! Nitrogen and C that is added to the ecosystem to 
+                                                                                          !! support vegetation growth (gN or gC m-2 dt-1)
+    ! 0.3 local
+    REAL(r_std)                                                        :: dt              !! Time step \f$(dt_sechiba one_day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nvm,ninput)                            :: input_dt        !! Used to add pft index to N inputs
+    LOGICAL                                                            :: l_error         !! Diagnostic boolean for error allocation (true/false)
+    INTEGER(i_std)                                                     :: ier             !! Check errors in netcdf call
+    REAL(r_std), DIMENSION(npts,nvm,nionspec)                          :: leaching        !! mineral nitrogen leached from the soil 
+                                                                                          !! (gN/m**2/timestep)
+    REAL(r_std), DIMENSION(npts,nvm)                                   :: immob           !! N immobilized (gN/m**2/day)
+    REAL(r_std), DIMENSION(npts)                                       :: afps_max        !! maximum pore-volume of the soil
+                                                                                          !! Table 2, Li et al., 2000
+                                                                                          !! (fraction)                       
+    REAL(r_std), DIMENSION(npts,nvm)                                   :: afps            !! pore-volume of the soil
+                                                                                          !! Table 2, Li et al., 2000
+                                                                                          !! (fraction)   
+    REAL(r_std), DIMENSION(npts,nvm)                                   :: D_s             !! Oxygen diffusion in soil (m**2/day)
+    REAL(r_std), DIMENSION(npts,nvm)                                   :: mol_O2_resp     !! Density of Moles of O2 related to respiration term 
+                                                                                          !! ((molesO2 m-3) (gC m-2)-1)
+    REAL(r_std), DIMENSION(npts,nvm)                                   :: p_O2_resp       !! O2 partial pressure related to the respiration term 
+                                                                                          !! ((hPa) (gC m-2)-1)
+    REAL(r_std), DIMENSION(npts)                                       :: p_O2air         !! Oxygen partial pressure in air (hPa)
+    REAL(r_std), DIMENSION(npts)                                       :: g_O2            !! gradient of O2 partial pressure (hPa m-1)
+    REAL(r_std), DIMENSION(npts)                                       :: d_O2            !! change in O2 partial pressure (hPa day-1)
+    REAL(r_std), DIMENSION(npts,nvm)                                   :: anvf            !! Volumetric fraction of anaerobic microsites 
+                                                                                          !! (fraction of pore-volume)
+    REAL(r_std), DIMENSION(npts)                                       :: FixNH4          !! Fraction of adsorbed NH4+ (-)
+    REAL(r_std), DIMENSION(npts,nvm)                                   :: n_adsorbed      !! Ammonium adsorpted (gN/m**2)
+                                                                                          !! based on Li et al. 1992, JGR, Table 4
+    REAL(r_std), DIMENSION(npts,nvm)                                   :: fw              !! Effect of soil moisture on nitrification (-)
+                                                                                          !! Zhang et al. 2002, Ecological Modelling, appendix A, page 101
+    REAL(r_std), DIMENSION(npts)                                       :: var_temp_sol    !! Temperature function used for calc. ft_nit (-)
+                                                                                          !! Zhang et al. 2002, Ecological Modelling, appendix A, page 101
+    REAL(r_std), DIMENSION(npts)                                       :: ft_nit          !! Effect of temperature on nitrification (-)
+                                                                                          !! Zhang et al. 2002, Ecological Modelling, appendix A, page 101
+    REAL(r_std), DIMENSION(npts)                                       :: fph             !! Effect of pH on nitrification (-)
+                                                                                          !! Zhang et al. 2002, Ecological Modelling, appendix A, page 101
+    REAL(r_std), DIMENSION(npts)                                       :: ftv             !! Effect of temperature on NO2 or NO production 
+                                                                                          !! during nitrification (-)
+                                                                                          !! Zhang et al. 2002, Ecological Modelling, appendix A, page 102
+    REAL(r_std), DIMENSION(npts,nvm,3)                                 :: nitrification   !! N-compounds production (NO3, N2O, NO) related 
+                                                                                          !! to nitrification process (gN/m**2/tstep)
+    REAL(r_std), DIMENSION(npts)                                       :: ft_denit        !! Temperature response of relative growth rate of 
+                                                                                          !! total denitrifiers (-)
+                                                                                          !! Eq. 2 Table 4 of Li et al., 2000
+    REAL(r_std), DIMENSION(npts)                                       :: fph_no3         !! Soil pH response of relative growth rate of 
+                                                                                          !! NO3 denitrifiers (-)
+                                                                                          !! Eq. 2 Table 4 of Li et al., 2000
+    REAL(r_std), DIMENSION(npts)                                       :: fph_no          !! Soil pH response of relative growth rate of 
+                                                                                          !! NO denitrifiers (-)
+                                                                                          !! Eq. 2 Table 4 of Li et al., 2000
+    REAL(r_std), DIMENSION(npts)                                       :: fph_n2o         !! Soil pH response of relative growth rate of 
+                                                                                          !! N2O denitrifiers (-)
+                                                                                          !! Eq. 2 Table 4 of Li et al., 2000
+    REAL(r_std)                                                        :: Kn_conv         !! Conversion from kgN/m3 to gN/m2
+    REAL(r_std), DIMENSION(npts)                                       :: mu_NO3          !! Relative growth rate of NO3 denitrifiers (hour**-1)
+                                                                                          !! Eq.1 Table 4 Li et al., 2000 
+    REAL(r_std), DIMENSION(npts)                                       :: mu_N2O          !! Relative growth rate of N2O denitrifiers (hour**-1)
+                                                                                          !! Eq.1 Table 4 Li et al., 2000
+    REAL(r_std), DIMENSION(npts)                                       :: mu_NO           !! Relative growth rate of NO denitrifiers (hour**-1)
+                                                                                          !! Eq.1 Table 4 Li et al., 2000  
+    REAL(r_std), DIMENSION(npts)                                       :: sum_n           !! sum of all N species in the soil (gN/m**2)
+    REAL(r_std), DIMENSION(npts,nvm,3)                                 :: denitrification !! N-compounds consumption (NO3, N2O, NO) related 
+                                                                                          !! to denitrificaiton process (gN/m**2/tstep)
+    REAL(r_std), DIMENSION(npts)                                       :: dn_bact         !! denitrifier biomass change (kgC/m**3/timestep)
+    REAL(r_std), DIMENSION(npts)                                       :: ft_uptake       !! Temperature response of N uptake by plants (-)
+    REAL(r_std)                                                        :: conv_fac_vmax   !! Conversion from (umol (gDW)-1 h-1) to (gN (gC)-1 timestep-1)
+    REAL(r_std), DIMENSION(nvm)                                        :: nc_leaf_min     !! Minimal NC ratio of leaf (gN / gC)
+    REAL(r_std), DIMENSION(nvm)                                        :: nc_leaf_max     !! Maximal NC ratio of leaf (gN / gC)
+    REAL(r_std), DIMENSION(npts)                                       :: lab_n           !! Labile nitrogen in plants (gN/m**2) 
+    REAL(r_std), DIMENSION(npts)                                       :: lab_c           !! Labile carbon in plants (gC/m**2) 
+    REAL(r_std), DIMENSION(npts)                                       :: NCplant         !! NC ratio of the plant (gN / gC)
+                                                                                          !! Eq. (9) p. 3 of SM of Zaehle & Friend, 2010
+    REAL(r_std), DIMENSION(npts)                                       :: f_NCplant       !! Response of Nitrogen uptake by plants 
+                                                                                          !! to N/C ratio of the labile pool
+    REAL(r_std)                                                        :: conv_fac_concent!! Conversion factor from (umol per litter) to (gN m-2) 
+    REAL(r_std), DIMENSION(npts)                                       :: frac_nh3        !! dissociation of [NH3] to [NH4+] (-)
+    REAL(r_std), DIMENSION(npts)                                       :: emm_fac         !! Factor for reducing NH3 emissions (-)
+    REAL(r_std), DIMENSION(npts)                                       :: F_clay          !! Response of N-emissions to clay fraction (-)
+    REAL(r_std), DIMENSION(npts)                                       :: ammonium_fert   !! temporary variable to close the mass balance budget when
+                                                                                          !! dividing the fertilizer load into ammonium and nitrate 
+
+    REAL(r_std), DIMENSION(npts,nvm,nnspec)                            :: emission        !! volatile losses of nitrogen 
+                                                                                          !! (gN/m**2/timestep)
+    INTEGER(i_std)                                                     :: ipts,ivm,inspec,ininput,inionspec,imbc,ipar,iele !! Index 
+    REAL(r_std), DIMENSION(npts,nvm)                                   :: f_drain         !! Fraction of tmc which has been drained 
+                                                                                          !! in the last time step
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)                 :: check_intern    !! Contains the components of the internal
+                                                                                          !! mass balance chech for this routine
+                                                                                          !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                         :: closure_intern  !! Check closure of internal mass balance
+                                                                                          !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                         :: pool_start      !! Start and end pool of this routine 
+                                                                                          !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                         :: pool_end        !! Start and end pool of this routine 
+                                                                                          !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                                   :: err             !! Array to store errors (dimensionless)
+!_ ================================================================================================================================
+
+    !! bavard is the level of diagnostic information, 0 (none) to 4 (full)
+    IF (printlev>=3) WRITE(numout,*) 'Entering nitrogen_dynamics' 
+
+    ! Debug
+    IF(printlev_loc>=4)THEN
+       WRITE(numout,*) 'CHECK values in nitrogen dynamics'
+       WRITE(numout,*) 'soil_n_min ',soil_n_min(:,7,:)
+    ENDIF
+    !-
+
+    dt = dt_sechiba/one_day
+
+    IF ( firstcall_nitrogen ) THEN
+        firstcall_nitrogen = .FALSE.
+
+    ENDIF
+
+    !! 1.1 Assign the input values 
+    !  Multiply by dt to convert the daily value in ::input
+    !  to a half-hourly values that is used here.
+    !  When the N input maps are read in slowproc, they have monthly values, but
+    !  we only pass the month the model are in along to stomate_main. And thus,
+    !  the dimension in stomate is (npts,nvm,ninput) with ninputs being
+    !  iatm_ammo=1, iatm_nitr=2, ibnf=3, ifert=4, imanure=5
+ 
+    input_dt(:,:,:) = input(:,:,:) * dt
+    
+    ! Debug
+    IF(printlev_loc.GE.4)THEN
+       WRITE(numout,*) 'dt, ',dt
+       WRITE(numout,*) 'test whether we have negative soil_n_min at the start'
+       DO ivm = 1,nvm
+          WRITE(numout,*) "input_dt, ",SUM(input_dt(test_grid,ivm,:))
+          IF (n_mineralisation(test_grid,ivm).LT.0) THEN
+             WRITE(numout,*)'Negative mineralisation,',ivm,&
+                  n_mineralisation(test_grid,ivm)
+          ENDIF
+          IF (soil_n_min(test_grid,ivm,initrate).LT.0 .OR. &
+               soil_n_min(test_grid,ivm,iammonium).LT.0) THEN
+             WRITE(numout,*)'Hit exception', dt
+             WRITE(numout,*)'PFT, ', ivm 
+             WRITE(numout,*)'soil_n_min_initrate:', &
+                  soil_n_min(test_grid,ivm,initrate)
+             WRITE(numout,*)'soil_n_min_initrate:', &
+                  soil_n_min(test_grid,ivm,iammonium)   
+          ENDIF
+       ENDDO
+    ENDIF
+    !-   
+
+    !! 1.2 Initialize check for mass balance closure 
+    IF (err_act.GT.1) THEN
+
+       check_intern(:,:,:,:) = zero
+       pool_start(:,:,:) = zero
+       DO iele = 1,nelements
+
+          ! atm_to_bm has as intent inout, the variable 
+          ! accumulates carbon over the course of a day. 
+          ! Use the difference between start and the end of 
+          ! this routine
+          check_intern(:,:,iatm2land,iele) = - un * &
+               atm_to_bm(:,:,iele) * veget_cov_max(:,:) * dt
+
+       ENDDO
+
+       DO inspec = 1,nnspec
+          pool_start(:,:,initrogen) = pool_start(:,:,initrogen) + &
+               soil_n_min(:,:,inspec) * veget_cov_max(:,:)
+       ENDDO
+ 
+       !DO ininput = 1,ninput
+       !   pool_start(:,:,initrogen) = pool_start(:,:,initrogen) + &
+       !        input_dt(:,:,ininput) * veget_cov_max(:,:)
+       !ENDDO
+ 
+       pool_start(:,:,initrogen) = pool_start(:,:,initrogen) + &      
+             n_fungivores(:,:) * veget_cov_max(:,:)              
+
+    ENDIF
+
+
+    ! Initialization
+    immob(:,:) = zero
+    leaching(:,:,:) = zero
+    f_drain(:,:) = zero 
+    emission(:,:,:) = zero
+    plant_n_uptake(:,:,:) = zero
+    nitrification(:,:,:) = zero
+    denitrification(:,:,:) = zero
+    n_adsorbed(:,:) = zero
+
+    ! 1.4 Conservation of mass from decomposition
+    ! Immobilisation has absolute priority. To avoid mass 
+    ! conservation problems the code in litter and soilcarbon 
+    ! has to make sure that soil ammonium can never be 
+    ! more than exhausted completely by immobilisation!
+    !
+    ! We could try to correct the issues when it happens in 
+    ! stomate_litter or we could try to fix it here. Because
+    ! less pools are accounted for here, it seems more easy
+    ! to deal with the negative mineralization here but the 
+    ! solution requires that N is taken from the atmosphere.
+    ! This is not a good solution when running the model with
+    ! a dynamic N cycle because this solution adds N to the 
+    ! system.
+
+    DO ipts = 1,npts
+ 
+       DO ivm = 1,nvm 
+
+          IF(veget_cov_max(ipts,ivm).GT.min_stomate .AND. & 
+               n_mineralisation(ipts,ivm).LT.zero) THEN
+
+             ! Move mineralisation to immobilisation to have
+             ! a temporary variable that will be used to update
+             ! the soil pools
+             immob(ipts,ivm) = - n_mineralisation(ipts,ivm)
+      
+             ! There is quite some code in stomate_litter.f90 and
+             ! som_dynamics (in this module) to ensure that there is
+             ! enough soil nitrogen to sustain the immobilisation
+             ! Test whether the previous correction were succesful. 
+             ! If not, we will to go back to the aforementioned subroutines
+             ! and fix the problems there.
+             IF (immob(ipts,ivm)-(soil_n_min(ipts,ivm,initrate)+ &
+                  soil_n_min(ipts,ivm,iammonium)).LT.min_stomate)THEN
+
+                ! In case the N related to immobilisation is higher that the N
+                ! available in the [NH4+] pool, we take the remaining N from the 
+                ! [NO3-] pool. This code is pretty condensed and replaces a set of 
+                ! IF-statements.
+                soil_n_min(ipts,ivm,initrate) = soil_n_min(ipts,ivm,initrate) - &
+                     MAX(zero,(immob(ipts,ivm)-soil_n_min(ipts,ivm,iammonium)))
+                soil_n_min(ipts,ivm,iammonium) = soil_n_min(ipts,ivm,iammonium) - &
+                     MIN(immob(ipts,ivm),soil_n_min(ipts,ivm,iammonium))
+
+             ELSE
+
+                WRITE(numout,*) 'ERROR: immob exceeds the available soil nitrogen &
+                     & pool',ivm,immob(ipts,ivm),(soil_n_min(ipts,ivm,initrate)+&
+                     soil_n_min(ipts,ivm,iammonium))
+                CALL ipslerr_p(3,'nitrogen_dynamics',&
+                     'immob exceeds the available soil nitrogen',&
+                     'this problem should be fixed in stomate_litter',&
+                     'and/or in som_dynamics')
+                
+             ENDIF
+      
+          ELSEIF(veget_cov_max(ipts,ivm).GT.min_stomate .AND. & 
+               n_mineralisation(ipts,ivm).GE.zero) THEN
+
+             ! Add the mineral nitrogen from litter decomposition
+             soil_n_min(ipts,ivm,iammonium) = soil_n_min(ipts,ivm,iammonium) + &
+                  n_mineralisation(ipts,ivm)
+      
+          ELSEIF(veget_cov_max(ipts,ivm).LE.min_stomate) THEN
+
+             soil_n_min(ipts,ivm,initrate) = zero
+             soil_n_min(ipts,ivm,iammonium) = zero
+     
+          ELSE
+
+             WRITE(numout,*)'at ipts veget_cov_max for ivm: ',ipts, ivm, veget_cov_max(ipts,ivm)
+             WRITE(numout,*)'n_mineralisation', n_mineralisation(ipts,ivm)                     
+             CALL ipslerr_p (3,'nitrogen_dynamics', 'Unforeseen case. for mineralization','','')
+ 
+          ENDIF
+
+       ENDDO ! ivm
+
+    ENDDO ! ipts
+
+    ! Debug
+    err(:,:) = zero
+    WHERE(soil_n_min(:,:,initrate) .LT. -min_stomate)
+       err(:,:) = 1.
+    ENDWHERE
+
+    ! Check nummerical consitency 
+    WHERE(soil_n_min(:,:,iammonium) .LT. -min_stomate)
+       err(:,:) = err(:,:) + 1
+    ENDWHERE
+
+    ! Check whether errors occured    
+    IF (SUM(SUM(err(:,:),2)).GT.zero) THEN
+       WRITE(numout,*) 'Number of errors found: ',SUM(SUM(err(:,:),2))
+       WRITE(numout,*) 'Negative soil_n_min_pool, initrate',soil_n_min(:,:,initrate)
+       WRITE(numout,*) 'Negative soil_n_min_pool, iammonium',soil_n_min(:,:,iammonium)
+       WRITE(numout,*) 'That does not make any sense'
+       WRITE(numout,*) 'Have a closer look at nitrogen_dynamics'
+       CALL ipslerr_p(3,'Negative soil_n_min in nitrogen_dynamics',&
+           'Compensated for by taking N from the atmosphere',&
+           'This should not happen','')
+    END IF
+    !-
+
+    ! 1.5  Functions and Parameters for O2 Diffusion and Volumetric Fraction of
+    ! Anaerobic Microsites (ANVF)
+    ! It is taken from Li et al. (2000) Table 2
+    ! but some equations and paremeters values remain unclear -
+    ! No way to find any clarification from any other publication
+  
+    ! Equation (1) - oxygen diffusion coefficient in soil
+    ! Ds = Dair * (afps^3.33) / (afpsmax^2.0)
+  
+    ! afpsmax taken from 
+    ! From Saxton, K.E., Rawls, W.J., Romberger, J.S., Papendick, R.I., 1986
+    ! Estimationg generalized soil-water characteristics from texture. 
+    ! Soil Sci. Soc. Am. J. 50, 1031-1036
+    ! Cited in Table 5 (page 444) of
+    ! Y. Pachepsky, W.J. Rawls
+    ! Development of Pedotransfer Functions in Soil Hydrology
+    ! Elsevier, 23 nov. 2004 - 542 pages
+    ! http://books.google.fr/books?id=ar_lPXaJ8QkC&printsec=frontcover&hl=fr#v=onepage&q&f=false
+    afps_max(:) = h_saxton + j_saxton * (sand(:)*100.) + &
+         k_saxton * log10(clay(:)*100.)
+  
+    ! afps calculation is not defined in Table 2 (Li et al, 2000)
+    ! S. Zaehle defined it with the following equation - but did not use it, finallly 
+    ! In OCN, diffusion is not of afps/afps_max ratio but accounts for soilhum and 
+    ! soil temperature according to Monteith & Unsworth, 1990 
+    ! d_ox(:) = 1.73664 * ( 0.15 * (exp(-(soilhum_av(:)**3.)/0.44)-exp(-1./0.44))) * & 
+    !          (1.+0.007*tsoil_av(:))
+    ! We keep here the original formulation of Li et al., 2000
+    DO ivm = 1,nvm
+       afps(:,ivm) = MAX(0.1,( un - swc_pft(:,ivm) ) * afps_max(:))
+
+       ! Dair : oxygen diffusion rate in the air = 0.07236 m2/h
+       ! Dair = 1.73664 m2/day
+       ! D_air = 1.73664
+       ! D_s, Diffusion in soil m2/day
+       ! diffusionO2_power_1=3.33
+       ! diffusionO2_power_2=2.0
+       D_s(:,ivm) = D_air * ( afps(:,ivm)**diffusionO2_power_1 ) / &
+         ( afps_max(:)**diffusionO2_power_2 )
+  
+       ! Equation (2) - Oxygen diffusion rate affected by frost
+       ! F_nofrost=1.2
+       ! F_frost =0.8
+       WHERE ( temp_sol(:) .GT. zero )
+          D_s(:,ivm) = D_s(:,ivm) * F_nofrost
+       ELSEWHERE
+          D_s(:,ivm) = D_s(:,ivm) * F_frost
+       ENDWHERE
+  
+       ! Equation (3) - Oxygen partial pressure
+       ! The way it is written is relatively unreadable
+   
+       ! Oxygen loss from respiration has to be expressed as a partial pressure
+       ! using PV=nRT relationship with P in Pa, V in m-3 and T in K
+       ! R is the ideal gas constat (J mol-1 K-1) and n a number of moles
+       ! Respiration, one mole of C consumes two moles of oxygen
+       ! Resp_below expressed in gC m-2 day-1
+       ! mol_O2_resp : Density of Moles of O2 related to respiration 
+       ! term (molesO2 m-3) (gC m-2)-1
+       ! In OCN, afps_max is used instead of afps. We keep here the 
+       ! original formulation
+       mol_O2_resp(:,ivm) = (un / C_molar_mass * 2. ) / (zmaxh * afps(:,ivm))
+
+       ! O2 partial pressure related to the respiration term (hPa) (gC m-2)-1
+       p_O2_resp(:,ivm)   = mol_O2_resp(:,ivm) * RR * ( temp_sol(:) + tp_00 ) * Pa_to_hPa
+    ENDDO
+  
+    ! Change in oxygen partial pressure d_O2 - Ds x gradient
+    ! Not sure that we should use z_decomp (could be a fraction of zmaxh, too)
+    ! Volumetric fraction of O2 in air = 0.209476
+    ! V_O2=0.209476
+    ! oxygen partial pressure in air - p_O2air (hPa)
+    p_O2air(:)= V_O2 * pb(:)
+
+    ! Pb is air pressure (in hPa)
+    DO ivm = 1, nvm
+
+       ! g_O2 : gradient of O2 partial pressure (hPa m-1)
+       g_O2(:) = ( p_O2air(:) - p_O2(:,ivm) ) / z_decomp
+       d_O2(:) = D_s(:,ivm) / z_decomp * g_O2(:)
+       
+       ! D_s / z_decomp has the unit of a conductivity (m day-1)
+       p_O2(:,ivm) = p_O2(:,ivm) + d_O2(:)*dt - p_O2_resp(:,ivm)*resp_sol(:,ivm)*dt
+       
+       ! Equation (4) Volumetric fraction of anaerobic microsites 
+       ! a and b constants are not specified in Li et al., 2000
+       ! S. Zaehle used a=0.85 and b=1 without mention to any publication
+       ! a_anvf=0.85
+       ! b_anvf=1.
+       anvf(:,ivm) = a_anvf * ( 1 - b_anvf * p_O2(:,ivm) / p_O2air(:) )
+       anvf(:,ivm) = MAX(zero, anvf(:,ivm))
+
+    ENDDO
+
+    ! Debug
+    IF(printlev_loc>=4 .AND. ivm==test_pft)THEN
+       WRITE(numout,*) 'CHECK values after nitrification nh4 to no3'
+       WRITE(numout,*) 'PFT=',test_pft
+       WRITE(numout,*) 'anvf(:,m)=',anvf(test_grid,test_pft)
+       WRITE(numout,*) 'p_O2(:,m)=',p_O2(test_grid,test_pft)
+       WRITE(numout,*) 'p_O2air(:)=',p_O2air(test_grid)
+       WRITE(numout,*) 'pb(:)=',pb(test_grid)
+       WRITE(numout,*) 'd_O2(:)=',d_O2(test_grid)
+       WRITE(numout,*) 'p_O2_resp(:)=',p_O2_resp(test_grid,:)
+       WRITE(numout,*) 'mol_O2_resp(:)=',mol_O2_resp(test_grid,:)
+       WRITE(numout,*) 'resp_soil(:,m)=',resp_sol(test_grid,test_pft)
+       WRITE(numout,*) 'afps(:)=',afps(test_grid,:)        
+    ENDIF
+    !-
+  
+    ! 1.6 Ammonium adsorption, reduce ammonium concentrations by this 
+    ! ammount in the module 
+    ! based on Li et al. 1992, JGR, Table 4
+    ! Bd : Bulk density kg m-3
+    ! FixNH4 : Fraction of adsorbed NH4+
+    ! FixNH4=[0.41-0.47 log(NH4) clay/clay_max]
+    ! NH4+ concentration in the soil liquid, gN kg-1 soil 
+    ! (p. 9774 of Li et al., 1992)
+    ! but Zhang et al. (2000) use the same equation but NH4+ is defined as
+    ! NH4+ in a soil layer in kgN ha-1
+    ! In OCN, NH4 seems defined as kgN kg-1 or m-3 of water 
+    ! Comment of N. Vuichard: I don't know which definition is the good one ...
+    ! a_FixNH4 = 0.41
+    ! b_FixNH4 = -0.47
+    ! clay_max = 0.63
+    DO ivm = 1, nvm
+
+       WHERE(soil_n_min(:,ivm,iammonium).GT.min_stomate)
+          FixNH4(:) = a_FixNH4 + b_FixNH4 * &
+               log10(soil_n_min(:,ivm,iammonium) / ( zmaxh * Bd(:) ) ) &
+               * MIN(clay(:),clay_max) / clay_max
+       ELSEWHERE
+          FixNH4(:) = 0.0   
+       ENDWHERE
+
+       ! In OCN, we do not multiply by FixNH4 but by FixNH4/(1+FixNH4)
+       ! Comment of N. Vuichard: It is not clear if we should keep the 
+       ! formulation of OCN or not
+       ! So far, we keep the original formulation
+       n_adsorbed(:,ivm) = MIN(soil_n_min(:,ivm,iammonium),&
+            soil_n_min(:,ivm,iammonium) * FixNH4(:))
+    ENDDO
+
+    ! Pool update after ammonium adsorption. The previous line
+    ! of code protects against significant negative values. The
+    ! MAX(zero,x) below protect against insignificant negative 
+    ! values that may cause some tests in stomate_litter to fail.
+    soil_n_min(:,:,iammonium) = MAX(zero,&
+         soil_n_min(:,:,iammonium) - n_adsorbed(:,:))  
+
+    ! Debug
+    IF(printlev_loc>=4)THEN
+       WRITE(numout,*) 'CHECK values after adsorption'
+       WRITE(numout,*) 'soil_n_min ',soil_n_min(test_grid,test_pft,:)
+       WRITE(numout,*) "n_adsorbed(:,:)",n_adsorbed(test_grid,test_pft)
+    ENDIF
+    !-
+
+    ! 2.1 Leaching
+    leaching(:,:,:) = zero
+    f_drain(:,:) = zero
+
+    WHERE((tmc_pft(:,:)-drainage_pft(:,:)) .NE. 0) 
+        f_drain(:,:) = drainage_pft(:,:)/(tmc_pft(:,:)-drainage_pft(:,:))
+    ENDWHERE
+    f_drain(:,:) = MAX(zero, MIN(f_drain(:,:),un))    
+
+    DO ivm = 1, nvm
+       leaching(:,ivm,iammonium) =  leaching(:,ivm,iammonium) + &
+            MIN(soil_n_min(:,ivm,iammonium) * f_drain(:,ivm), &
+            soil_n_min(:,ivm,iammonium))
+       leaching(:,ivm,initrate)  = leaching(:,ivm,initrate) + &
+            MIN(soil_n_min(:,ivm,initrate)  * f_drain(:,ivm), &
+            soil_n_min(:,ivm,initrate))
+    ENDDO
+
+    ! 2.2 Nitrification of NH4 to NO3 in the oxygenated part of the soil  
+    ! 2.2.1 Effect of environmental factors (Temp, Humidity, pH)
+    ! Effect of soil moisture on nitrification
+    ! Zhang et al. 2002, Ecological Modelling, appendix A, page 101
+    ! fw_0 =  -0.0243
+    ! fw_1 =   0.9975
+    ! fw_2 =  -5.5368
+    ! fw_3 =  17.651
+    ! fw_4 = -12.904
+    fw(:,:) = fw_0 + fw_1 * swc_pft(:,:) + fw_2 * swc_pft(:,:)**2 + &
+         fw_3 * swc_pft(:,:)**3 + fw_4 * swc_pft(:,:)**4
+    fw(:,:) = MAX (0., MIN( un, fw(:,:) ) )
+  
+    ! Effect of temperature on nitrification
+    ! Zhang et al. 2002, Ecological Modelling, appendix A, page 101
+    var_temp_sol(:) = temp_sol(:) * 0.1
+    ! ft_nit_0 =  -0.0233
+    ! ft_nit_1 =   0.3094
+    ! ft_nit_2 =  -0.2234
+    ! ft_nit_3 =   0.1566
+    ! ft_nit_4 =  -0.0272
+    ft_nit(:) = ft_nit_0 + ft_nit_1 * var_temp_sol(:) + &
+         ft_nit_2 * var_temp_sol(:)**2 + ft_nit_3 * var_temp_sol(:)**3 + &
+         ft_nit_4 * var_temp_sol(:)**4
+    ft_nit(:) = MAX (0.001, MIN( un, ft_nit(:) ) )
+  
+    ! Effect of pH on nitrification
+    ! Zhang et al. 2002, Ecological Modelling, appendix A, page 101
+    ! fph_0 = -1.2314
+    ! fph_1 = 0.7347
+    ! fph_2 = -0.0604
+    fph(:) = fph_0 + fph_1 * pH(:) + fph_2 * ph(:)**2
+    fph(:) = MAX(0.0, fph(:) )
+  
+    ! Effect of temperature on NO2 or NO production during nitrification
+    ! Zhang et al. 2002, Ecological Modelling, appendix A, page 102
+    ! ftv_0 = 2.72
+    ! ftv_1 = 34.6
+    ! ftv_2 = 9615.
+    ftv(:) = ftv_0 **(ftv_1 - ftv_2 /(temp_sol(:) + tp_00) )
+    ftv(:) = MAX(0.0, ftv(:) )
+  
+    DO ivm = 1, nvm
+       ! i_nh4_to_no3 = 1
+       ! i_nh4_to_n2o = 3
+       ! i_nh4_to_no  = 2
+       !
+       ! 2.2.2 Actual nitrification rate - NH4 to NO3
+       ! 
+       ! Equation for the nitrification rate probably from 
+       ! Schmid et al., 2001, Nutr. Cycl. Agro (eq.1)
+       ! but the environmental factors used are from Zhang (2002) who 
+       ! used an other equation
+       ! I don't know how this can be mixed together ?
+       ! In addition, the formulation mixed the one from Schmid with 
+       ! the use of the anaerobic balloon defined by Li et al., 2000. 
+       ! I don't know how this can be mixed together ?
+       ! Last, in OCN, the default fraction of N-NH4 which is converted
+       ! to N-NO3 appears equal to 2 day-1 (a factor "2" in the equation)
+       ! - In Schmid et al., the nitrification rate at 20 âŠC and field 
+       ! capacity (knitrif,20) was set to 0.2 dâ1 (Ten time less...)
+       ! k_nitrif = 0.2
+       ! nitrification(:,ivm,i_nh4_to_no3) = MIN(fw(:) * fph(:) * &
+       ! ft_nit(:) * k_nitrif * dt * & 
+       ! soil_n_min(:,ivm,iammonium) * (1.0 - anvf(:,ivm)) , &
+       ! soil_n_min(:,ivm,iammonium)- leaching(:,ivm,iammonium))
+       nitrification(:,ivm,i_nh4_to_no3) = MIN(fw(:,ivm) * fph(:) * &
+            ft_nit(:) * k_nitrif * dt * soil_n_min(:,ivm,iammonium) * &
+            (1.0 - anvf(:,ivm)), &
+            soil_n_min(:,ivm,iammonium)-leaching(:,ivm,iammonium))
+
+       ! Debug
+       IF(printlev_loc>=4 .AND. ivm == test_pft)THEN
+          WRITE(numout,*) 'CHECK values after nitrification nh4 to no3'
+          WRITE(numout,*) 'PFT=',ivm
+          WRITE(numout,*) 'nitrification(:,ivm,i_nh4_to_no3) ',&
+               nitrification(test_grid,ivm,i_nh4_to_no3)
+          WRITE(numout,*) 'fw=',fw(test_grid,ivm)
+          WRITE(numout,*) 'fph=',fph(test_grid)
+          WRITE(numout,*) 'ft_nit=',ft_nit(test_grid)
+          WRITE(numout,*) 'anvf=',anvf(test_grid,ivm)
+       ENDIF
+       !-
+      
+       ! 2.2.3 Emission of N2O during nitrification - NH4 to N2O 
+       ! From Zhang et al., 2002 - Appendix A p. 102
+       ! Reference n2o production per N-NO3 produced g N-N2O  (g N-NO3)-1
+       ! n2o_nitrif_p = 0.0006
+       nitrification(:,ivm,i_nh4_to_n2o) = ftv(:) * swc_pft(:,ivm) * &
+            n2o_nitrif_p * nitrification(:,ivm,i_nh4_to_no3)
+
+       ! Debug
+       IF(printlev_loc>=4 .AND. ivm==test_pft)THEN
+          WRITE(numout,*) 'CHECK values after nitrification nh4 to n2o'
+          WRITE(numout,*) 'nitrification(:,ivm,i_nh4_to_n2o) ',&
+               nitrification(test_grid,ivm,i_nh4_to_n2o)
+          WRITE(numout,*) 'ftv=',ftv(test_grid)
+          WRITE(numout,*) 'swc_pft=',swc_pft(test_grid,:)
+       ENDIF
+       !-
+
+       nitrification(:,ivm,i_nh4_to_n2o) = &
+            MIN(nitrification(:,ivm,i_nh4_to_no3), &
+            nitrification(:,ivm,i_nh4_to_n2o))       
+     
+       ! 2.2.4 Production of NO during nitrification - NH4 to NO
+       ! NO production during nitrification - Zhang et al., 2002 - 
+       ! Appendix p.102 Reference NO production per N-NO3 produced 
+       ! g N-NO  (g N-NO3)-1 no_nitrif_p = 0.0025
+       nitrification(:,ivm,i_nh4_to_no) = ftv(:) * no_nitrif_p * &
+            nitrification(:,ivm,i_nh4_to_no3)
+
+       ! Debug
+       IF(printlev_loc>=4 .AND. ivm == test_pft)THEN
+          WRITE(numout,*) 'CHECK values after nitrification nh4 to no'          
+          WRITE(numout,*) 'nitrification(:,ivm,i_nh4_to_no) ',&
+               nitrification(test_grid,ivm,i_nh4_to_no)
+       ENDIF
+       !-
+
+       ! NO production from chemodenitrification
+       ! based on Kesik et al., 2005, Biogeosciences
+       ! BUT Kesik et al. used NO2 concentration and not NO3 production 
+       ! as it is done in OCN and modification of a multiplicative constant
+       ! from 300 (Kesik) to 30 (OCN) without clear motivation - I don't &
+       ! how this is reliable 
+       ! chemo_t0  = -31494.
+       ! R  = 8.3144
+       ! chemo_ph0 = -1.62
+       ! chemo_0   = 30.
+       ! chemo_1   = 16565.
+       nitrification(:,ivm,i_nh4_to_no) = nitrification(:,ivm,i_nh4_to_no) + &
+            ( chemo_0 * chemo_1 * exp(chemo_ph0 * pH(:) ) * & 
+            exp(chemo_t0/((temp_sol(:)+tp_00)*RR))) * &
+            nitrification(:,ivm,i_nh4_to_no3)
+
+       nitrification(:,ivm,i_nh4_to_no) = &
+            MIN(nitrification(:,ivm,i_nh4_to_no3)-&
+            nitrification(:,ivm,i_nh4_to_n2o), &
+            nitrification(:,ivm,i_nh4_to_no))
+
+       ! Debug
+       IF(printlev_loc>=4 .AND. ivm == test_pft)THEN
+          WRITE(numout,*) 'CHECK values after nitrification nh4 '//&
+               'to no chemodenitrification'
+          WRITE(numout,*) 'nitrification(:,ivm,i_nh4_to_no) ',&
+               nitrification(test_grid,ivm,i_nh4_to_no)
+          WRITE(numout,*) 'pH(:)=',pH(test_grid)
+          WRITE(numout,*) 'temp_sol(:)=',temp_sol(test_grid)
+       ENDIF
+       !-
+
+       ! In OCN, NO production and N2O production is deduced from the 
+       ! NO3 production as calculated
+       ! in 2.2.2 (see below) -
+       nitrification(:,ivm,i_nh4_to_no3) = nitrification(:,ivm,i_nh4_to_no3) - &
+            (nitrification(:,ivm,i_nh4_to_no) + &
+            nitrification(:,ivm,i_nh4_to_n2o))
+        
+     ENDDO
+     
+     ! 2.3 Denitrification processes
+     ! Li et al, 2000, JGR Table 4 eq 1, 2 and 4, ignoring NO2 (similar to NO)
+     ! Comment of S. Zaehle: "includes treatment of bacteria dynamics, but I 
+     ! do not have any confidence in this;
+     ! at least it provides rates that appear resonable." 
+  
+     ! Temperature response of relative growth rate of total denitrifiers
+     ! Eq. 2 Table 4 of Li et al., 2000
+     ! ft_denit_0 = 2.
+     ! ft_denit_1 = 22.5
+     ! ft_denit_2 = 10.
+     ft_denit(:) = 2.**((temp_sol(:)-22.5)/10.)
+  
+     ! Soil pH response of relative growth rate of total denitrifiers
+     ! Eq. 2 Table 4 of Li et al., 2000
+     ! See also comment about parenthesis' position in Thesis of Vincent 
+     ! Prieur (page 50)
+     ! fph_no3_0  = 4.25
+     ! fph_no3_1  = 0.5
+     ! fph_no_0  = 5.25
+     ! fph_no_1  = 1.
+     ! fph_n2o_0  = 6.25
+     ! fph_n2o_1  = 1.5
+     fph_no3(:) = 1.0 - 1.0 / ( 1.0 + EXP((pH(:)-fph_no3_0)/fph_no3_1)) 
+     fph_no(:) = 1.0 - 1.0 / ( 1.0 + EXP((pH(:)-fph_no_0)/fph_no_1)) 
+     fph_n2o(:) = 1.0 - 1.0 / ( 1.0 + EXP((pH(:)-fph_n2o_0)/fph_n2o_1))
+     
+     ! Half Saturation of N oxydes (kgN/m3) -  Table 4 of Li et al., 2000
+     ! OCN used the value 0.087.
+     ! Kn = 0.083
+     ! Conversion from kgN/m3 to gN/m2
+     ! In OCN, we account for max_eau_eau. Not clear if this is correct or not.
+     Kn_conv = Kn * zmaxh * 1000
+     
+     ! Relative growth rate of Nox denitrifiers
+     ! Eq.1 Table 4 Li et al., 2000 - but there is an error in eq. 1 
+     ! because it does not 
+     ! account for Temp and ph responses.  
+     ! In OCN it does not account for [DOC] as it is done in 
+     ! Li et al., 2000 - not changed here
+     ! In addition, in OCN the term mu_nox(max) is missing in the equation that
+     ! defines the relative growth rate of total denitrifiers 
+     ! (dn_bact) - corrected here
+ 
+     ! Maximum Relative growth rate of Nox denitrifiers (hour-1)
+     ! mu_no3_max = 0.67
+     ! mu_no_max  = 0.34
+     ! mu_n2o_max = 0.34
+     DO ivm = 1, nvm
+        
+        mu_no3(:) = ft_denit(:) * fph_no3(:) * &
+             mu_no3_max * soil_n_min(:,ivm,initrate) / &
+             (soil_n_min(:,ivm,initrate) + Kn_conv)
+        mu_no(:)  = ft_denit(:) * fph_no(:)  * &
+             mu_no_max  * soil_n_min(:,ivm,inox) / &
+             (soil_n_min(:,ivm,inox) + Kn_conv)
+        mu_n2o(:) = ft_denit(:) * fph_n2o(:) * &
+            mu_n2o_max * soil_n_min(:,ivm,initrous) / &
+            (soil_n_min(:,ivm,initrous) + Kn_conv)
+  
+        ! stocks of all N species (NO3, NO, N2O) (gN/m**2)
+        sum_n(:) = soil_n_min(:,ivm,inox) + soil_n_min(:,ivm,initrous) + & 
+             soil_n_min(:,ivm,initrate)
+    
+        WHERE(sum_n(:).GT.min_stomate)
+           ! Y_nox , maximum growth yield of denitrifiers on NO3,
+           ! NO and N2O (kgC / kgN)
+           ! Table 4 Li et al., 2000
+           ! Y_no3 = 0.401
+           ! Y_no  = 0.428
+           ! Y_n2o = 0.151
+           
+           ! M_nox , maintenance coefficient on N oxyde (kgN/kgC/h)
+           ! Table 4 Li et al., 2000
+           ! M_no3 = 0.09
+           ! M_no  = 0.035
+           ! M_n2o = 0.079
+           ! Table 4 of Li et al., 2000
+           ! Eq. 4 Table 4 of Li et al., 2000
+           ! The term anvf_av is related to the size of the anaerobic balloon
+           ! Conversion from (h-1) to (dt)-1
+          
+           ! NO3 consumption
+           ! In OCN, multiplication by 0.1 of the NO3 consumption - no 
+           ! justification
+           ! This is not kept in the current version
+           ! denitrification(:,ivm,i_no3_to_nox) = &
+           ! MIN(soil_n_min(:,ivm,initrate)-leaching(:,ivm,initrate), &
+           !    anvf(:,ivm) * ( mu_no3(:) / Y_no3 + M_no3 * &
+           !    soil_n_min(:,ivm,initrate) / sum_n(:)) * bact(:,ivm) * &
+           !    24. * dt ).
+           denitrification(:,ivm,i_no3_to_nox) = &
+                MIN(soil_n_min(:,ivm,initrate)-leaching(:,ivm,initrate), &
+                anvf(:,ivm) * ( mu_no3(:) / Y_no3 + M_no3 * &
+                soil_n_min(:,ivm,initrate) / sum_n(:)) * bact(:,ivm) * &
+                24. * dt )
+         
+           ! NO consumption
+           denitrification(:,ivm,i_nox_to_n2o) = &
+                MIN(soil_n_min(:,ivm,inox), &
+                anvf(:,ivm) * ( mu_no(:) / Y_no + M_no * &
+                soil_n_min(:,ivm,inox) / sum_n(:)) * bact(:,ivm) * &
+                24. * dt )        
+          
+           ! N2O consumption
+           denitrification(:,ivm,i_n2o_to_n2) = &
+                MIN(soil_n_min(:,ivm,initrous), &
+                anvf(:,ivm) * ( mu_n2o(:) / Y_n2o + M_n2o * &
+                soil_n_min(:,ivm,initrous) / sum_n(:)) * bact(:,ivm) * &
+                24. * dt )
+  
+           ! Maint_c maintenance coefficient of carbon (kgC/kgC/h)
+           ! Maint_c = 0.0076
+           ! Yc maximum growth yield on soluble carbon (kgC/kgC)
+           ! Yc = 0.503
+          
+           ! denitrifier bacterial population change
+           ! Eq. 3 (Rg-Rd) of Table 4 Li et al., 2000
+           ! In OCN, dn_bact is ranged between ,0.0005* &
+           ! som(:,iactive,m,icarbon) and 
+           ! 0.25 * som(:,iactive,m,icarbon)) - no clear justification.
+           ! This is not kept in the current version
+           ! In addition, in OCN, Only dn_bact is defined, not bact. &
+           ! I don't know how it may work
+           !+++CHECK+++
+           ! Nitrogen in bacteria is calculated, but we do not specify where this
+           ! nitrogen is taken from. Because bacteria are not included in the
+           ! mass balance check, this is not causing a problem but in these
+           ! lines we create bacteria compose from pure N. If bact is ever used, 
+           ! their carbon use must be accounted for. In revision 3460 bact is further 
+           ! determined by the max-min constraint.
+           dn_bact(:) = ( anvf(:,ivm) * ( mu_no3 + mu_no + mu_n2o ) - &
+                Maint_c * Yc ) * bact(:,ivm) * 24. * dt
+           bact(:,ivm) = bact(:,ivm) + dn_bact(:)
+           bact(:,ivm) = MAX(MIN(bact(:,ivm),0.25*som(:,iactive,ivm,icarbon)),&
+                         0.0005*som(:,iactive,ivm,icarbon))
+           !+++++++++++
+
+        ENDWHERE
+  
+    ENDDO
+
+
+    ! 3. Plant uptake of available ionic forms of nitrogen 
+    !
+    ! Comment from OCN : Temperature function of uptake is similar to 
+    ! SOM decomposition
+    ! to avoid N accumulation at low temperatures 
+    ! In addition in the SM of Zaehle & Friend, 2010 P. 3 it is mentioned
+    ! "The uptake rate is observed to be sensitive to root temperature 
+    ! which is included as f(T), 
+    ! thereby following the temperature sensitivity of net N mineralization"
+    ft_uptake(:) = control_temp_func (npts, temp_sol(:)+tp_00)
+  
+    ! Comment of N. Vuichard: Plenty of parameter values used in the 
+    ! formulation of the plant uptake are 
+    ! not reliable to anything. I tend to rely much of the param values 
+    ! to the values reported 
+    ! in the reference publications
+    
+    ! Vmax of nitrogen uptake (in umol (g DryWeight_root)-1 h-1)
+    ! 
+    ! In OCN, the same values are used both for uptake of NH4+ and NO3-
+    ! See p. 3 of the SM of Zaehle & Friend, 2010:
+    ! "As a first approximation average values for vmax, kNmin and KNmin
+    ! are assumed for all PFTs
+    ! (Table S1), and for both ammonium and nitrate"
+    ! However based on the two papers of Kronzucker et al. (1995, 1996), 
+    ! it seems that vmax should be
+    ! much higher for NH4+ than for NO3- . We still use the same here 
+    ! for both NH4+ and NO3- as in OCN
+    ! The value of Vmax reported in Table S1 of Zaehle & Friend, 2010 
+    ! is 5.14 ugN (g-1C) d-1
+    ! Comment of N. Vuichard : I can not relate the value of vmax in 
+    ! OCN expressed in (umol (g DryWeight_root)-1 h-1) (vmax=3) to the 
+    ! one reported in Table S1 :  5.14 ugN (g-1C) d-1
+    ! The use of the conv_fac conversion factor used in OCN should help 
+    ! to convert (umol (g DryWeight_root)-1 h-1)
+    ! in (gN (g-1C) tstep-1). conv_fac is defined as 24. * dt / 2. / &
+    ! 1000000 . * 14. 
+    ! 24 conversion of hour to day
+    ! dt conversion of day to dt 
+    ! 1/2 conversion of g(DryWeight) to gC
+    ! 1000000. conversion of ug to g
+    ! 14 conversion of umol to ugN
+    ! So using conv_fac, vmax expressed in ugN (g-1C) d-1 should be equal to 
+    ! 3*24./2.*14. = 504 ugN (gC)-1 d-1 not 5.14
+    ! In addition, I think there is an error in the conversion 
+    ! from (gDW)-1 to (gC)-1
+    ! When expressed per gC of root, the N uptake should be twice more 
+    ! than the one expressed per gDW of root,
+    ! not twice less. So one should multiply by 2., not divide by 2. 
+    ! (so vmax = 2016 ug (gC)-1 d-1 )
+    !
+    ! Vmax of nitrogen uptake (in umol (g DryWeight_root)-1 h-1)
+    ! vmax_uptake(iammonium) = 3. 
+    ! vmax_uptake(initrate) = 3.
+  
+    ! Conversion from (umol (gDW)-1 h-1) to (gN (gC)-1 timestep-1)
+    conv_fac_vmax= 24. * dt * 2. / 1000000. * 14. 
+  
+    ! minimal and maximal NC ratio of leaf (gN / gC)
+    ! used in the response of N uptake to NC ratio
+    ! see eq. 10 , p. 3 of SM of Zaehle & Friend, 2010
+    nc_leaf_max(1)     = 0.
+    nc_leaf_max(2:nvm) = 1. / cn_leaf_min(2:nvm)
+    nc_leaf_min(1)     = -1./min_stomate
+    nc_leaf_min(2:nvm) = 1. / cn_leaf_max(2:nvm)
+  
+    !+++CHECK+++
+    ! In OCN, lab_n and lab_c are not calculated for bare soil. Why do we do it
+    ! here?
+    DO ivm = 1, nvm
+
+       ! NCplant (gN / gC)
+       ! See equation (9) p. 3 of SM of Zaehle & Friend, 2010
+       lab_n(:) = SUM(circ_class_biomass(:,ivm,:,ilabile,initrogen)*circ_class_n(:,ivm,:),2) + &
+            SUM(circ_class_biomass(:,ivm,:,iroot,initrogen)*circ_class_n(:,ivm,:),2)+ & 
+            SUM(circ_class_biomass(:,ivm,:,ileaf,initrogen)*circ_class_n(:,ivm,:),2)
+       lab_c(:) = SUM(circ_class_biomass(:,ivm,:,ilabile,icarbon)*circ_class_n(:,ivm,:),2) + &
+            SUM(circ_class_biomass(:,ivm,:,iroot,icarbon)*circ_class_n(:,ivm,:),2) + &  
+            SUM(circ_class_biomass(:,ivm,:,ileaf,icarbon)*circ_class_n(:,ivm,:),2)
+
+       WHERE(lab_c(:).GT.min_stomate)
+          NCplant(:) = lab_n(:) / lab_c(:)
+       ELSEWHERE
+          NCplant(:) = fcn_root(ivm)/cn_leaf_init(ivm) 
+       ENDWHERE
+       
+       ! Nitrogen demand responds to N/C ratio of the labile pool for each PFT
+       ! zero uptake at a NC in the labile pool corresponding to maximal leaf NC 
+       ! and 1. for a NC corresponding to a minimal leaf NC
+       ! See equation (10) p. 3 of SM of Zaehle & Friend, 2010
+       f_NCplant(:)=MIN(MAX( ( nc_leaf_max(ivm) - NCplant(:) ) / & 
+           ( nc_leaf_max(ivm) - nc_leaf_min(ivm) ), 0. ), 1.) 
+  
+       ! Plant N uptake (gN m-2 tstep-1)
+       ! See eq. (8) p. 3 of SM of Zaehle & Friend, 2010
+       ! In OCN, there was a multiplicative factor "2" that I can not explain
+       ! It may partly compensate the error mentioned above about conv_fac_vmax
+       !
+       ! Coefficient K_N_min (umol per litter)
+       !
+       ! It corresponds to the [NH4+] (resp. [NO3-]) for which the Nuptake 
+       ! equals vmax/2.
+       ! Kronzucker, 1995 reports values that range between 20 and 40 umol
+       ! for NH4+ uptake
+       ! OCN seems to use 30 umol for both NH4+ and NO3-. The value used is 
+       ! 0.84 expressed in (gN m-2)
+       ! In Kronzucker, 1995 and 1996, the concentrations are always 
+       ! expressed in umol. No clear 
+       ! reference about the standard volume it is related to (litter ?)
+       ! Coefficient K_N_min (umol per litter)
+       ! K_N_min(:) = 30
+       ! Conversion factor from (umol per litter) to (gN m-2) 
+       conv_fac_concent = 14 * 1e3 * 1e-6 * 2
+
+       ! 14   : molar mass for N (gN mol-1)
+       ! 10^3 : conversion factor (dm3 to m3)
+       ! 10-6 : conversion factor (ug to g)
+       ! 2    : m3 per m2 of soil
+       !
+       ! Comment of N. Vuichard : I wonder why it assumes 2 m3 per m2 of 
+       ! soil. The depth of the soil 
+       ! is 2 meter. But it doesn't mean that all the column contains only
+       ! water, there is also soil, no ?
+       ! The question is : what is the volume that is considered for 
+       ! the concentration of NH4+ and NO3-. Is it a
+       ! volume of soil or of solution ? 
+       ! If it is a volume of solution, I would suggest to multiply by a 
+       ! factor corresponding to the relative volume 
+       ! of water within the soil. - Not done yet. 
+       ! 
+       ! K_N_min * conv_fac_concent = 0.84
+       !
+       ! Coefficient low_K_N_min ((gN m-2)-1)
+       !
+       ! See eq. 8 of SM of Zaehle et al. (2010) and Table S1
+       ! In table S1, it is defined as 
+       ! "Rate of N uptake not associated with Michaelis- Menten Kinetics" 
+       ! with a value of 0.05
+       ! It is mentioned also (unitless) but to my opinion (N. Vuichard) 
+       ! it should have
+       ! the same unit that 1/K_N_min or 1/N_min, so ((gN m-2)-1)
+       ! +++CECK+++
+       ! Comment of N. Vuichard
+       ! So far, I cannot relate the value of low_K_N_min (0.05) to 
+       ! any reference 
+       ! especially Kronzucker (1996)
+       ! If I refer to Figure 4 of Kronzucker showing the NH4+ influx as 
+       ! a function of NH4+ 
+       ! concentration, the slope of the relationship could be used to 
+       ! define Vmax*low_K_N_min
+       ! For a concentration of NH4+ of 50 mmol, the influx equals 
+       ! 35 umol g-1 h-1
+       ! For a concentration of NH4+ of 20 mmol, the influx 
+       ! equals 17 umol g-1 h-1
+       ! slope = 10-3 * (35 - 17) / (50 - 20) = 10-3 * 18 / 30 = 0.0006 g-1 h-1 
+       ! low_K_N_min = slope / Vmax = 0.0006 / 3 = 0.0002 (umol)-1 
+       ! using the Conversion factor from (umol per litter) to (gN m-2) 
+       ! conv_fac_concent = 14 * 1e3 * 1e-6 * 2, one should get 
+       ! low_K_N_min = 0.0002 / ( 14 * 1e3 * 1e-6 * 2 ) = 0.007 ((gN m-2)-1)
+       ! The value of 0.007 does not match with the one in OCN (0.05) - 
+       ! This needs to be clarified
+       ! ++++++++++
+       ! low_K_N_min ((umol)-1)
+  
+       ! In eq. 8, I (N. Vuichard) think there is an error. It should not be
+       ! (Nmin X KNmin) but (Nmin + KNmin). The source code of OCN is correct
+       plant_n_uptake(:,ivm,iammonium) = vmax_uptake(iammonium) * &
+            conv_fac_vmax * SUM(circ_class_biomass(:,ivm,:,iroot,icarbon) * &
+            circ_class_n(:,ivm,:),2)*&
+            ft_uptake(:) * soil_n_min(:,ivm,iammonium) * &
+            ( low_K_N_min(iammonium) / conv_fac_concent &
+            + 1. / ( soil_n_min(:,ivm,iammonium) + K_N_min(iammonium) * &
+            conv_fac_concent ) ) * f_NCplant(:)
+  
+       plant_n_uptake(:,ivm,initrate) = vmax_uptake(initrate) * &
+            conv_fac_vmax * SUM(circ_class_biomass(:,ivm,:,iroot,icarbon)* &
+            circ_class_n(:,ivm,:),2)*&
+            ft_uptake(:) * soil_n_min(:,ivm,initrate) * &
+            ( low_K_N_min(initrate) / conv_fac_concent &
+            + 1. / ( soil_n_min(:,ivm,initrate) + K_N_min(initrate) * &
+            conv_fac_concent ) ) * f_NCplant(:)
+
+       ! Debug
+       IF ((printlev_loc>=4).AND.(ivm==test_pft)) THEN
+          WRITE(numout,*) 'plant_n_uptake ', &
+               plant_n_uptake(test_grid,test_pft,:)
+          WRITE(numout,*) 'min plant_n_uptake ammonium', soil_n_min(test_grid,ivm,iammonium) - &
+            (leaching(test_grid,ivm,iammonium) + nitrification(test_grid,ivm,i_nh4_to_no3) + &
+            nitrification(test_grid:,ivm,i_nh4_to_no) + nitrification(test_grid,ivm,i_nh4_to_n2o))   
+          WRITE(numout,*) 'min plant_n_uptake nitrate',soil_n_min(test_grid,ivm,initrate) - &
+            leaching(test_grid,ivm,initrate) - denitrification(test_grid,ivm,i_no3_to_nox) + &
+            nitrification(test_grid,ivm,i_nh4_to_no3)
+        !  WRITE(numout,*) 'vmax_uptake(iammonium) ',vmax_uptake(iammonium)
+        !  WRITE(numout,*) ' biomass(:,ivm,iroot,icarbon)', &
+        !       biomass(test_grid,ivm,iroot,icarbon)
+        !  WRITE(numout,*) ' ft_uptake(test_grid)',ft_uptake(test_grid)
+          WRITE(numout,*) 'soil_n_min ',soil_n_min(test_grid,test_pft,:)
+        !  WRITE(numout,*) 'f_NCplant(test_grid)', f_NCplant(test_grid)
+        !  WRITE(numout,*) 'NCplant(test_grid)', NCplant(test_grid)
+        !  WRITE(numout,*) 'nc_leaf_max(ivm)',nc_leaf_max(ivm)
+        !  WRITE(numout,*) 'nc_leaf_min(ivm)',nc_leaf_min(ivm)
+        !  WRITE(numout,*) 'lab_c(test_grid)',lab_c(test_grid)
+        !  WRITE(numout,*) 'lab_n(test_grid)',lab_n(test_grid)
+          WRITE(numout,*) 'leaching ',leaching(test_grid,test_pft,:)
+          WRITE(numout,*) 'nitrification ',nitrification(test_grid,test_pft,:)
+
+       ENDIF
+       !-
+
+       ! Calculate plant uptake
+       ! This code should prevent plant_n_uptake from being negative. This is
+       ! essential to prevent errors in stomate_growth_fun_all
+       plant_n_uptake(:,ivm,iammonium) = MAX(MIN(soil_n_min(:,ivm,iammonium) - & 
+            (leaching(:,ivm,iammonium) + nitrification(:,ivm,i_nh4_to_no3) + &
+            nitrification(:,ivm,i_nh4_to_no) + nitrification(:,ivm,i_nh4_to_n2o)), &
+            plant_n_uptake(:,ivm,iammonium)), zero)
+
+       emission(:,:,iammonium) = MIN(emission(:,:,iammonium), &
+            soil_n_min(:,:,iammonium) - nitrification(:,:,i_nh4_to_no3) &
+            - nitrification(:,:,i_nh4_to_no) - nitrification(:,:,i_nh4_to_n2o) &
+            - leaching(:,:,iammonium) - plant_n_uptake(:,:,iammonium))
+
+       plant_n_uptake(:,ivm,initrate) = MAX(MIN(soil_n_min(:,ivm,initrate) - &
+            leaching(:,ivm,initrate) - denitrification(:,ivm,i_no3_to_nox) + &
+            nitrification(:,ivm,i_nh4_to_no3), plant_n_uptake(:,ivm,initrate)), zero)
+
+       ! Add N released for plant uptake by fungivores.
+       DO ipts = 1,npts
+          IF((SUM(circ_class_biomass(ipts,ivm,:,ilabile,initrogen)) .GT. zero) &
+             .AND. (SUM(circ_class_n(ipts,ivm,:))) .GT. zero &
+             .AND. (SUM(circ_class_biomass(ipts,ivm,:,ileaf,initrogen)) .GT.zero)) THEN
+
+             plant_n_uptake(ipts,ivm,iammonium) = plant_n_uptake(ipts,ivm,iammonium) + &
+                n_fungivores(ipts,ivm)
+
+             IF(printlev_loc>=3) THEN
+                WRITE(numout,*)"ADDING n_fungivores to plant_n_uptake, ivm:",ivm
+             ENDIF
+
+          ELSE
+
+             soil_n_min(ipts,ivm,iammonium) = soil_n_min(ipts,ivm,iammonium) + &
+                n_fungivores(ipts,ivm)
+             n_fungivores(ipts,ivm) = zero
+
+             IF(printlev_loc>=3) THEN
+                WRITE(numout,*)"ADDING n_fungivores to ammonium pool, ivm:", ivm
+             ENDIF
+
+          ENDIF
+       ENDDO
+
+    ENDDO
+
+    ! 4. Loss of ionic forms of N through drainage and gaseous forms through
+    ! volatilisation (the emission part should eventually be calculated in 
+    ! Sechiba's diffuco routines
+    DO ivm = 1,nvm
+  
+       ! 4.1 Loss of NH4 due to volatilisation of NH3
+       ! See Li et al. 1992, JGR, Table 4
+  
+       ! Current dissociation of [NH3] to [NH4+]
+       ! See Table 4 of Li et al. 1992 and Appendix A of Zhang et al. 2002
+       ! log(K_NH4) - log(K_H20) = log(NH4/NH3) + pH
+       ! See also formula in "DISSOCIATION CONSTANTS OF INORGANIC ACIDS AND 
+       ! BASES" pdf file
+       ! pK_H2O = -log(K_H2O) = 14
+       ! pk_NH4 = -log(K_NH4) = 9.25
+       ! pK_H2O - pK_NH4 = log([NH4+]/[NH3]) + pH
+       ! [NH4+]/[NH3] = 1O^(pK_H2O - pK_NH4 - pH) = 10^(4.75-pH)
+       
+       ! In OCN, one makes use of frac_nh3. That should be the NH3/NH4 
+       ! ratio. It is defined as:
+       ! frac_nh3(:) = 10.0**(4.25-pH(:)) / (1. + 10.0**(4.25-pH(:)))
+       
+       ! CommentS of N. Vuichard : I have several interrogations about 
+       ! the equation and value used
+       ! in OCN. But I have also concerns about the formulation of Li et al. ... 
+       ! 1/ 
+       ! The formulation of Li et al. doesn't match with the formulas in 
+       ! "DISSOCIATION CONSTANTS OF INORGANIC ACIDS AND BASES" or with 
+       ! the formulas
+       ! of http://www.onlinebiochemistry.com/obj-512/Chap4-StudNotes.html
+       ! To my opinion, one should replace log(K_NH4+) by log(K_NH3) in the 
+       ! formulation of Li et al.
+       ! with the relationship pKa + pKb = pKwater (where a and b are acid
+       ! and base)
+       ! this leads to [NH4+]/[NH3] = 10^(pK_NH4 - pH) = 10^(9.25 - pH)
+       ! 2/
+       ! Wether I'm right or not about 1/, I don't understand the value 
+       ! used in OCN (4.25). 
+       ! It should be either 4.75 or 9.25 but 4.25 looks strange
+       ! 3/ 
+       ! OCN used a formulation for [NH3]/[NH4+] of the type: X/(1+X) 
+       ! with X=[NH3]/[NH4+]
+       ! This leads to X/(1+X)=([NH3]/[NH4+])/(([NH4+]/[NH4+])+([NH3]/[NH4+]))
+       ! or X/(1+X) = [NH3] / ( [NH3] + [NH4+] )
+       ! This means that the value stored in soil_n_min(:,:,iammonium) 
+       ! corresponds to the total
+       ! N of both [NH4+] and [NH3]. This makes sense to my opinion. 
+       ! But I wonder if one should not
+       ! account for this partitioning between [NH4+] and [NH3] in other 
+       ! processes. To check.
+       ! 4/ 
+       ! The X value should relate to [NH3]/[NH4+] but to my opinion 
+       ! the X value used 
+       ! in the equation in OCN corresponds to [NH4+]/[NH3]. Is this a bug ? 
+   
+       ! In conclusion, I propose the formulation
+       frac_nh3(:) = 10.0**(pH(:)-pk_NH4) / (1. + 10.0**(pH(:)-pk_NH4))
+  
+       ! This seems a patch added to OCN in order to (as mentioned in OCN) 
+       ! reduced emissions at low concentration (problem of only one soil layer)
+       ! high conentrations are usually associated with fertiliser 
+       ! events -> top layer
+       ! and thus increased emission
+       ! NOT ACTIVATE HERE 
+       ! emm_fac(:) = 0.01
+       ! WHERE(soil_n_min(:,m,iammonium).GT.0.01.AND.&
+       !     soil_n_min(:,m,iammonium).LE.4.)
+       !      emm_fac(:) = MAX(0.01,1-exp(-(soil_n_min(:,m,iammonium)/1.75)**8)) 
+       ! ENDWHERE       
+       ! WHERE(soil_n_min(:,m,iammonium).GT.4.)
+       !      emm_fac(:)=1.0
+       ! ENDWHERE
+       emm_fac(:)=1.0
+  
+       ! 4.2 Volatilisation of gasous species, Table 4, Li et al. 2000 I,
+       !     using diffusivity of oxigen in air as a surrogate (from OCN)
+       !     assumes no effect of air concentration on diffusion
+       !     takes standard depth as reference
+       
+       ! Clay limitation
+       ! F_clay_0 = 0.13
+       ! F_clay_1 = -0.079
+       F_clay(:) = F_clay_0 + F_clay_1 * clay(:)
+  
+       ! In OCN, one used formulation of the type
+       ! emission(:,m,inox-1) = & 
+       !       MIN( d_ox(:) * soil_n_min(:,m,inox) * (0.13-0.079*clay(:)) * 
+       !       dt / z_decomp
+       ! It should have the unit d_ox * soil_n_min * dt / z_decomp
+       !                         m2 day-1 * gN m-2 * day / m
+       !                         gN / m which is not homogeneous with 
+       ! the unit expected (gn m-2)
+       ! To my opinion, one should not use soil_n_min (gN m-2) but a 
+       ! volumetric concentration (gN m-3)
+       ! But I'm not clear what is the appropriate volume to consider 
+       ! (volume of soil ?)
+  
+       ! NH4 emission (gN m-2 per time step)
+       emission(:,ivm,iammonium) = D_s(:,ivm) * emm_fac(:) * frac_nh3(:) * &
+            soil_n_min(:,ivm,iammonium) / zmaxh &
+            * F_clay(:) / z_decomp * dt
+                   
+       ! NO3 emission 
+       emission(:,ivm,initrate) = zero
+         
+       ! NO2 emission (gN m-2 per time step)
+       emission(:,ivm,inox) = D_s(:,ivm) * soil_n_min(:,ivm,inox) / &
+            zmaxh * F_clay(:) / z_decomp * dt
+         
+       ! N2O emission (gN m-2 per time step)
+       emission(:,ivm,initrous) = D_s(:,ivm) * soil_n_min(:,ivm,initrous) /&
+            zmaxh * F_clay(:) / z_decomp * dt
+                         
+       ! N2 emission (gN m-2 per time step)
+       emission(:,ivm,idinitro) = D_s(:,ivm) * soil_n_min(:,ivm,idinitro) /&
+            zmaxh * F_clay(:) / z_decomp * dt
+              
+    ENDDO
+
+    ! Calculate the emissions of the different N-species
+    emission(:,:,iammonium) = MIN(emission(:,:,iammonium), &
+         soil_n_min(:,:,iammonium) - nitrification(:,:,i_nh4_to_no3) &
+         - nitrification(:,:,i_nh4_to_no) - nitrification(:,:,i_nh4_to_n2o) &
+         - leaching(:,:,iammonium) - plant_n_uptake(:,:,iammonium))  
+    emission(:,:,inox) = MIN(emission(:,:,inox), &
+         soil_n_min(:,:,inox) + nitrification(:,:,i_nh4_to_no) & 
+         + denitrification(:,:,i_no3_to_nox) - denitrification(:,:,i_nox_to_n2o))
+    emission(:,:,initrous) = MIN(emission(:,:,initrous), &
+         soil_n_min(:,:,initrous) + nitrification(:,:,i_nh4_to_n2o) & 
+         + denitrification(:,:,i_nox_to_n2o) - denitrification(:,:,i_n2o_to_n2))!
+    emission(:,:,idinitro) = MIN(emission(:,:,idinitro), &
+         soil_n_min(:,:,idinitro)  + denitrification(:,:,i_n2o_to_n2))
+
+
+    ! 5.1 Update pools after emission
+    
+    !+++CHECK+++
+    ! To my [WHO?] opinion, for a better consistency, I would recommand
+    ! to consider the leaching separately when calculating the ammonium
+    ! and nitrate budget. Leaching is calculated from sechiba. Might be
+    ! better to remove leaching at the top of the routine especially due
+    ! to the later calculation of NH4+ and NO3- concentration that will
+    ! vary with the soil water content. Let's imagine that from one time
+    ! step to another, the change in soil water content is only due to
+    ! leaching. We don't want that the NH4+ and NO3- concentration vary
+    ! from one time step to the other. The best way to avoid this is to
+    ! remove first the leaching from the NH4+ and NO3- pools
+    ! THIS IS NOT DONE YET. 
+    ! Note that deposition is added to leaching if there is no active soil
+    ! carbon pool. If leaching is dealt with up front, this issues should
+    ! be considered when checking the mass balance
+    !+++++++++++
+  
+    IF(printlev_loc>=4)THEN
+       WRITE(numout,*) 'CHECK values before update'
+       WRITE(numout,*) 'nitrification ',nitrification(test_grid,test_pft,:)
+       WRITE(numout,*) 'denitrification ',denitrification(test_grid,test_pft,:)
+       WRITE(numout,*) 'leaching ',leaching(test_grid,test_pft,:)
+       WRITE(numout,*) 'emission ',emission(test_grid,test_pft,:)
+       WRITE(numout,*) 'plant_n_uptake ',plant_n_uptake(test_grid,test_pft,:)
+       WRITE(numout,*) 'mineralisation ',n_mineralisation(test_grid,test_pft)
+       WRITE(numout,*) 'immob ',immob(test_grid,test_pft)
+       WRITE(numout,*) 'soil_n_min',soil_n_min(test_grid,test_pft,:)
+       WRITE(numout,*)'soil_n_min(initrate)',soil_n_min(test_grid,test_pft,initrate) + &
+         nitrification(test_grid,test_pft,i_nh4_to_no3) - denitrification(test_grid,test_pft,i_no3_to_nox) - &
+         leaching(test_grid,test_pft,initrate) - plant_n_uptake(test_grid,test_pft,initrate)
+       WRITE(numout,*)'n_fungivores',n_fungivores(test_grid,test_pft)
+    ENDIF
+   
+    ! The mass balance check should catch problems when truncating significant
+    ! negative values. The MAX(zero,x) were added to avoid insignificant 
+    ! negative values that may cause the failure of quality checks in stomate_litter
+    soil_n_min(:,:,iammonium) = MAX(zero,soil_n_min(:,:,iammonium) + n_adsorbed(:,:) & 
+         - nitrification(:,:,i_nh4_to_no3) - nitrification(:,:,i_nh4_to_no) - &
+         nitrification(:,:,i_nh4_to_n2o) - leaching(:,:,iammonium) - &
+         emission(:,:,iammonium) - plant_n_uptake(:,:,iammonium))
+    soil_n_min(:,:,initrate) = MAX(zero,soil_n_min(:,:,initrate) + &
+         nitrification(:,:,i_nh4_to_no3) - denitrification(:,:,i_no3_to_nox) - &
+         leaching(:,:,initrate) - plant_n_uptake(:,:,initrate))
+    soil_n_min(:,:,inox) =  MAX(zero,soil_n_min(:,:,inox) + &
+         nitrification(:,:,i_nh4_to_no) + denitrification(:,:,i_no3_to_nox) - &
+         denitrification(:,:,i_nox_to_n2o) - emission(:,:,inox))
+    soil_n_min(:,:,initrous) = MAX(zero,soil_n_min(:,:,initrous) + &
+         nitrification(:,:,i_nh4_to_n2o) + denitrification(:,:,i_nox_to_n2o) - &
+         denitrification(:,:,i_n2o_to_n2) - emission(:,:,initrous)) 
+    soil_n_min(:,:,idinitro) = MAX(zero,soil_n_min(:,:,idinitro)  + &
+         denitrification(:,:,i_n2o_to_n2) - emission(:,:,idinitro)) 
+
+    ! Debug
+    IF(printlev_loc>=4)THEN
+       WRITE(numout,*) 'CHECK values after update'
+       WRITE(numout,*) 'soil_n_min ',soil_n_min(:,7,:)
+    ENDIF
+    !    
+
+    ! 5.3 add nitrogen either from deposition 
+    ! (read from fields or prescribed in run.def) as
+    ! well as BNF, needs to be revised...
+    ! iatm_ammo=1, iatm_nitr=2, ibnf=3, ifert=4, imanure=5
+
+    DO ipts = 1,npts
+       DO ivm = 1,nvm
+
+          ! Deposition of NHx and NOy
+          IF(veget_cov_max(ipts,ivm).GT.min_stomate .AND. &
+               som(ipts,iactive,ivm,icarbon).GT.min_stomate) THEN
+   
+             ! If there is an active carbon pool, the n-deposition
+             ! is added to the soil pool
+             soil_n_min(ipts,ivm,iammonium) = soil_n_min(ipts,ivm,iammonium) + &
+                  input_dt(ipts,ivm,iatm_ammo)
+             soil_n_min(ipts,ivm,initrate) = soil_n_min(ipts,ivm,initrate) + &
+                  input_dt(ipts,ivm,iatm_nitr)
+   
+          ELSEIF(veget_cov_max(ipts,ivm).GT.min_stomate .AND. & 
+               som(ipts,iactive,ivm,icarbon).LE.min_stomate) THEN
+   
+             ! If there is no active soil carbon pool, the N-deposition
+             ! is leached.
+             leaching(ipts,ivm,iammonium)=leaching(ipts,ivm,iammonium) + &
+                  input_dt(ipts,ivm,iatm_ammo)
+             leaching(ipts,ivm,initrate)=leaching(ipts,ivm,initrate) + &
+                 input_dt(ipts,ivm,iatm_nitr)
+   
+          ELSEIF(veget_cov_max(ipts,ivm).LT.min_stomate) THEN
+   
+             soil_n_min(ipts,ivm,iammonium) = 0.
+             soil_n_min(ipts,ivm,initrate) = 0.
+          
+          ELSE
+
+             WRITE(numout,*)'at ipts veget_cov_max for ivm: ', ipts, ivm,veget_cov_max(ipts,ivm)
+             WRITE(numout,*)'som', som(ipts,iactive,ivm,icarbon)
+             CALL ipslerr_p (3,'nitrogen_dynamics', 'Unforeseen case. for som','','')    
+  
+          ENDIF 
+
+          ! BNF
+          IF(veget_cov_max(ipts,ivm).GT.min_stomate) THEN
+             IF ( natural(ivm) ) THEN
+     
+                ! Consider biological N-fixation in natural PFTs. Note
+                ! that bare soil is considered a natural PFT. 
+                soil_n_min(:,ivm,iammonium) = soil_n_min(:,ivm,iammonium) + &
+                     input_dt(:,ivm,ibnf)
+   
+             ENDIF
+   
+                ! Fertiliser use for agriculture, no BNF, that's already 
+                ! accounted for in fertil using the average global ratio of 
+                ! ammonium to nitrate to separate the two species
+                ! ratio_nh4_fert = 7./8.
+                ammonium_fert(:) = input_dt(:,ivm,ifert)*ratio_nh4_fert
+                soil_n_min(:,ivm,iammonium) = soil_n_min(:,ivm,iammonium) + &
+                     ammonium_fert(:)
+                IF((soil_n_min(1,ivm,initrate) + &
+                     (input_dt(1,ivm,ifert)-ammonium_fert(1))) .LE. 0.0) THEN
+                soil_n_min(:,ivm,initrate) = MAX(zero,soil_n_min(:,ivm,initrate) + & 
+                     (input_dt(:,ivm,ifert)-ammonium_fert(:)))
+                 ELSE
+                soil_n_min(:,ivm,initrate) = soil_n_min(:,ivm,initrate)+  &
+                     (input_dt(:,ivm,ifert)-ammonium_fert(:))
+                ENDIF
+
+                soil_n_min(:,ivm,iammonium) = soil_n_min(:,ivm,iammonium) &
+                   + input_dt(:,ivm,imanure)*ratio_nh4_fert
+                soil_n_min(:,ivm,initrate) = soil_n_min(:,ivm,initrate) &
+                   + input_dt(:,ivm,imanure)*(1.-ratio_nh4_fert)
+          
+   
+          ENDIF   
+
+       ENDDO
+    ENDDO
+  
+    !! 6. Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       !! 6. Mass balance closure
+       !! 6.1 Calculate components of the mass balance
+       pool_end(:,:,:) = zero
+       DO inspec = 1,nnspec
+          pool_end(:,:,initrogen) = pool_end(:,:,initrogen) + &
+               soil_n_min(:,:,inspec) * veget_cov_max(:,:)
+       ENDDO
+
+       pool_end(:,:,initrogen) = pool_end(:,:,initrogen) + &
+            n_fungivores(:,:) * veget_cov_max(:,:)
+
+       !! 6.2 Calculate mass balance
+       !  Note that soilcarbon is transfered to other pools but that the pool
+       !  itself was not updated. We can just use ::pool_end
+       DO iele = 1,nelements
+          check_intern(:,:,iatm2land,iele) = &
+               check_intern(:,:,iatm2land,iele) + &
+               atm_to_bm(:,:,iele) * veget_cov_max(:,:) * dt 
+       ENDDO
+
+       DO ininput = 1,ninput
+          check_intern(:,:,iatm2land,initrogen) = &
+            check_intern(:,:,iatm2land,initrogen) + &
+            input_dt(:,:,ininput) * veget_cov_max(:,:)
+       ENDDO
+      
+       DO inspec= 1, nnspec
+          check_intern(:,:,iland2atm,initrogen) = &
+               check_intern(:,:,iland2atm,initrogen) &
+               -un * (emission(:,:,inspec) * veget_cov_max(:,:)) 
+       ENDDO
+
+       DO inionspec = 1, nionspec
+          check_intern(:,:,ilat2out,initrogen) = &
+               check_intern(:,:,ilat2out,initrogen) &
+               -un * ( plant_n_uptake(:,:,inionspec) + &
+               leaching(:,:,inionspec) ) * veget_cov_max(:,:)
+       ENDDO
+
+       check_intern(:,:,ilat2in,initrogen) = &
+            check_intern(:,:,ilat2in,initrogen) + &
+            n_mineralisation(:,:) * veget_cov_max(:,:)
+       check_intern(:,:,ipoolchange,initrogen) = -un * &
+            (pool_end(:,:,initrogen) - pool_start(:,:,initrogen))
+
+       closure_intern = zero
+       DO imbc = 1,nmbcomp
+          closure_intern(:,:,initrogen) = closure_intern(:,:,initrogen) + &
+               check_intern(:,:,imbc,initrogen)
+       ENDDO
+
+
+       CALL check_mass_balance("nitrogen_dynamics", closure_intern, &
+          npts, pool_end, pool_start, veget_cov_max,'pft')
+
+    ENDIF ! (ERR_ACT.GT.1) 
+
+    CALL histwrite_p (hist_id_stomate, 'N_UPTAKE_NH4', itime, &
+         plant_n_uptake(:,:,iammonium)/dt, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'N_UPTAKE_NO3', itime, &
+         plant_n_uptake(:,:,initrate)/dt, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'N_MINERALISATION', itime, &
+         n_mineralisation(:,:)/dt, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SOIL_NH4', itime, &
+         soil_n_min(:,:,iammonium), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SOIL_NO3', itime, &
+         soil_n_min(:,:,initrate), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SOIL_NOX', itime, &
+         soil_n_min(:,:,inox), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SOIL_N2O', itime, &
+         soil_n_min(:,:,initrous), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SOIL_N2', itime, &
+         soil_n_min(:,:,idinitro), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SOIL_P_OX', itime, &
+         p_O2(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BACT', itime, &
+         bact(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'NH3_EMISSION', itime, &
+         emission(:,:,iammonium)/dt, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'NOX_EMISSION', itime, &
+         emission(:,:,inox)/dt, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'N2O_EMISSION', itime, &
+         emission(:,:,initrous)/dt, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'N2_EMISSION', itime, &
+         emission(:,:,idinitro)/dt, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'NH4_LEACHING', itime, &
+         leaching(:,:,iammonium)/dt, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'NO3_LEACHING', itime, &
+         leaching(:,:,initrate)/dt, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'NITRIFICATION', itime, &
+         nitrification(:,:,i_nh4_to_no3), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'DENITRIFICATION', itime, &
+         denitrification(:,:,i_n2o_to_n2), npts*nvm, horipft_index)  
+    CALL histwrite_p (hist_id_stomate, 'NHX_DEPOSITION', itime, &
+         input_dt(:,nvm,iammonium)/dt, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'NOX_DEPOSITION', itime, &
+         input_dt(:,nvm,initrate)/dt, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BNF', itime, &
+         input_dt(:,nvm,ibnf)/dt, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'N_FERTILISER', itime, &
+         input_dt(:,nvm,ifert)/dt, npts*nvm, horipft_index)
+ 
+    CALL xios_orchidee_send_field("N_UPTAKE_NH4",plant_n_uptake(:,:,iammonium)/dt)
+    CALL xios_orchidee_send_field("N_UPTAKE_NO3",plant_n_uptake(:,:,initrate)/dt)
+    CALL xios_orchidee_send_field("N_MINERALISATION",n_mineralisation(:,:)/dt)
+    CALL xios_orchidee_send_field("SOIL_NH4",soil_n_min(:,:,iammonium))
+    CALL xios_orchidee_send_field("SOIL_NO3",soil_n_min(:,:,initrate))
+    CALL xios_orchidee_send_field("SOIL_NOX",soil_n_min(:,:,inox))
+    CALL xios_orchidee_send_field("SOIL_N2O",soil_n_min(:,:,initrous))
+    CALL xios_orchidee_send_field("SOIL_N2",soil_n_min(:,:,idinitro))
+    CALL xios_orchidee_send_field("SOIL_P_OX",p_o2(:,:))
+    CALL xios_orchidee_send_field("BACT",bact(:,:))
+    CALL xios_orchidee_send_field("NH3_EMISSION",emission(:,:,iammonium)/dt)
+    CALL xios_orchidee_send_field("NOX_EMISSION",emission(:,:,inox)/dt)
+    CALL xios_orchidee_send_field("N2O_EMISSION",emission(:,:,initrous)/dt)
+    CALL xios_orchidee_send_field("N2_EMISSION",emission(:,:,idinitro)/dt)
+    CALL xios_orchidee_send_field("NH4_LEACHING",leaching(:,:,iammonium)/dt)
+    CALL xios_orchidee_send_field("NO3_LEACHING",leaching(:,:,initrate)/dt)
+    CALL xios_orchidee_send_field("NITRIFICATION",nitrification(:,:,i_nh4_to_no3))
+    CALL xios_orchidee_send_field("DENITRIFICATION",denitrification(:,:,i_n2o_to_n2))
+    CALL xios_orchidee_send_field("NHX_DEPOSITION",input(:,:,iammonium))
+    CALL xios_orchidee_send_field("NOX_DEPOSITION",input(:,:,initrate))
+    CALL xios_orchidee_send_field("BNF",input(:,:,ibnf))
+    CALL xios_orchidee_send_field("N_FERTILISER",input(:,:,ifert))  
+    CALL xios_orchidee_send_field("N_MANURE",input(:,:,imanure))
+  END SUBROUTINE nitrogen_dynamics
+
+
+
+
+  !+++CHECK+++
+  ! ADD HEADER
+  !+++++++++++
+
+  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( soil_Q10 * ( temp_in(:) - (ZeroCelsius+tsoil_ref)) / Q10 )
+    tempfunc_result(:) = MIN( un, tempfunc_result(:) )
+
+  END FUNCTION control_temp_func
+
+
+END MODULE stomate_som_dynamics
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_stand_structure.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_stand_structure.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_stand_structure.f90	(revision 6412)
@@ -0,0 +1,163 @@
+! =================================================================================================================================
+! MODULE       : stomate_stand_structure
+!
+! 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: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-DOFOCO/ORCHIDEE/src_stomate/stomate_prescribe.f90 $
+!! $Date: 2013-01-04 16:50:56 +0100 (Fri, 04 Jan 2013) $
+!! $Revision: 1126 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_stand_structure
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE function_library, ONLY:wood_to_height_eff, wood_to_dia_eff, wood_to_cv_eff, wood_to_cn_eff 
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC stand_structure_clear, derive_biomass_quantities
+
+    ! first call
+    LOGICAL, SAVE                                    :: firstcall = .TRUE.
+    
+CONTAINS
+
+! =================================================================================================================================
+!! SUBROUTINE   : stand_structure_clear
+!!
+!>\BRIEF        : Set the firstcall flag back to .TRUE. to prepare for the next simulation.
+!_=================================================================================================================================
+
+  SUBROUTINE stand_structure_clear
+    firstcall=.TRUE.
+  END SUBROUTINE stand_structure_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	:derive_biomass_quantities
+!!
+!>\BRIEF        Use the basal areabiomass and number density to derive various
+!!              distributions of the trees in a single grid point for
+!!              all vegetation types
+!!
+!! DESCRIPTION  : I have chosen to do this for a single grid point instead of 
+!!                the whole map or a single grid point and single PFT because
+!!                of the compromise between speed (subroutine overhead) and
+!!                flexibility
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::height_dist, ::diameter_dist, ::cn_area_dist, ::cn_vol_dist
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE derive_biomass_quantities(npts, nvm, ncirc, circ_class_n, &
+       circ_class_biomass, values)
+
+  !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+    INTEGER,INTENT(IN)                                      :: npts               !! Number of pixels
+    INTEGER,INTENT(IN)                                      :: nvm                !! Number of PFT types
+    INTEGER,INTENT(IN)                                      :: ncirc              !! Number of circumference classes
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), &
+         INTENT(IN)                                         :: circ_class_biomass !! Biomass of the componets of the model  
+                                                                                  !! tree within a circumference
+                                                                                  !! class @tex $(gC ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(IN) &
+                                                            :: circ_class_n       !! Number of trees within each circumference
+                                                                                  !! class @tex $(m^{-2})$ @endtex
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION(npts,nvm,ncirc,ndist_types),INTENT(OUT)  &
+                                                            :: values             !! An array which holds data for
+                                                                                  !! various canopy parameters 
+
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                          :: ipts, ivm, icir, &
+                                                                       idist_type !! index (unitless)
+!_ ================================================================================================================================
+
+    IF (printlev.GE.3) WRITE(numout,*) 'Entering derive_biomass_quantities'
+
+    ! zero everything
+    values(:,:,:,:)=zero
+
+    DO ipts=1,npts
+       DO ivm=1,nvm
+
+          IF (.NOT. is_tree(ivm)) CYCLE
+
+          ! compute the new mean values
+
+          ! for the height
+          values(ipts,ivm,:,iheight)=&
+               wood_to_height_eff(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+
+          ! for the crown area
+          values(ipts,ivm,:,icnarea)=&
+               wood_to_cn_eff(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+
+          ! for the stem diameter
+          values(ipts,ivm,:,idiameter)=&
+               wood_to_dia_eff(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+
+          ! for the crown volume
+          values(ipts,ivm,:,icnvol)=&
+               wood_to_cv_eff(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+
+          ! these next two assume the crowns are ellipsoids...since we are 
+          ! interested in spheres at the moment, we just set the two crown
+          ! diameters to be equal for the verticle crown diameter
+          DO icir=1,ncirc
+             values(ipts,ivm,icir,icndiaver)=&
+                  2.0_r_std*(3.0_r_std*values(ipts,ivm,icir,icnvol)/&
+                  (4.0_r_std*pi))**(un/3.0_r_std)
+          ENDDO
+
+          ! for the horizontal crown diameter
+          values(ipts,ivm,:,icndiahor)=values(ipts,ivm,:,icndiaver)
+
+       ENDDO ! loop over PFT
+
+    ENDDO ! loop over points
+
+    IF (printlev.GE.3) WRITE(numout,*) 'Leaving derive_biomass_quantities'
+
+ END SUBROUTINE derive_biomass_quantities
+
+
+END MODULE stomate_stand_structure
+
+
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_turnover.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_turnover.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_turnover.f90	(revision 6412)
@@ -0,0 +1,1521 @@
+! =================================================================================================================================
+! 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:
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_turnover
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+  USE sapiens_agriculture, ONLY: crop_harvest
+  USE function_library, ONLY : biomass_to_lai, check_biomass_sync, &
+       check_surface_area, check_mass_balance
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC turn_over, turnover_clear
+
+  LOGICAL, SAVE        :: firstcall_turnover = .TRUE.      !! first call (true/false)
+!$OMP THREADPRIVATE(firstcall_turnover)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : turnover_clear
+!!
+!>\BRIEF        Set flag ::firstcall_turnover to .TRUE., and therefore activate section 1 
+!!              of subroutine turn which writes a message to the output.
+!!                
+!_ ================================================================================================================================
+
+  SUBROUTINE turnover_clear
+    firstcall_turnover=.TRUE.
+  END SUBROUTINE turnover_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : turn_over
+!!
+!>\BRIEF         Calculate turnover of leaves, roots, fruits and sapwood
+!!               due to aging or climatic induced senescence. Calculate
+!!               herbivory.
+!!
+!! DESCRIPTION : This subroutine determines the turnover of leaves and fine
+!! roots (and stems for grasses) and simulates following processes:
+!! 1. Mean leaf age is calculated from leaf ages of separate leaf age
+!!    classes. Should actually be recalculated at the end of the routine,
+!!    but it does not change too fast. The mean leaf age is calculated
+!!    using the following equation:
+!!    \latexonly
+!!    \input{turnover_lma_update_eqn1.tex}
+!!    \endlatexonly
+!!    \n 
+!! 2. Meteorological senescence: the detection of the end of the growing
+!!    season and shedding of leaves, fruits and fine roots due to
+!!    unfavourable meteorological conditions. The model distinguishes
+!!    three different types of "climatic" leaf senescence, that do not 
+!!    change the age structure: sensitivity to cold temperatures, to lack
+!!    of water, or both. If meteorological conditions are fulfilled, a
+!!    flag ::senescence is set to TRUE. Note that evergreen species do not
+!!    experience climatic senescence. Climatic senescence is triggered by
+!!    sensitivity to cold temperatures where the critical temperature for
+!!    senescence is calculated using the following equation:
+!!    \latexonly
+!!    \input{turnover_temp_crit_eqn2.tex}
+!!    \endlatexonly
+!!    \n
+!!    Climatic senescence is triggered by sensitivity to lack of water
+!!    availability where the moisture availability critical level is
+!!    calculated using the following equation:
+!!    \latexonly
+!!    \input{turnover_moist_crit_eqn3.tex}
+!!    \endlatexonly
+!!    \n
+!!    Climatic senescence is triggered by sensitivity to temperature or to
+!!    lack of water where critical temperature and moisture availability
+!!    are calculated as above.\n
+!!    Trees in climatic senescence lose their fine roots at the same rate
+!!    as they lose their leaves. The rate of biomass loss of both fine
+!!    roots and leaves is presribed through the equation:
+!!    \latexonly
+!!    \input{turnover_clim_senes_biomass_eqn4.tex}
+!!    \endlatexonly
+!!    \n
+!!    with ::leaffall(j) a PFT-dependent time constant which is given in 
+!!    ::stomate_constants. In grasses, leaf senescence is extended to
+!!    the whole plant (all carbon pools) except to its carbohydrate reserve.    
+!! 3. Senescence due to aging: the loss of leaves, fruits and  biomass due
+!!    to aging At a certain age, leaves fall off, even if the climate
+!!     would allow a green plant all year round. Even if the meteorological
+!!    conditions are favorable for leaf maintenance, plants, and in
+!!    particular, evergreen trees, have to renew their leaves simply because
+!!    the old leaves become inefficient. Roots, fruits (and stems for
+!!    grasses) follow leaves. The ??senescence?? rate varies with leaf
+!!    age. Note that plant is not declared senescent in this case (wchich
+!!    is important for allocation: if the plant loses leaves because of 
+!!    their age, it can renew them). The leaf turnover rate due to aging
+!!    of leaves is calculated using the following equation:
+!!    \latexonly
+!!    \input{turnover_age_senes_biomass_eqn5.tex}
+!!    \endlatexonly
+!!    \n
+!!    Drop all leaves if there is a very low leaf mass during senescence.
+!!    After this, the biomass of different carbon pools both for trees
+!!    and grasses is set to zero and the mean leaf age is reset to zero.
+!!    Finally, the leaf fraction and leaf age of the different leaf age
+!!    classes is set to zero. For deciduous trees: next to leaves, also
+!!    fruits and fine roots are dropped.
+!!    For grasses: all aboveground carbon pools, except the carbohydrate
+!!    reserves are affected:
+!! 4. Update the leaf biomass, leaf age class fraction and the LAI
+!!    Older leaves will fall more frequently than younger leaves and
+!!    therefore the leaf age distribution needs to be recalculated after
+!!    turnover. The fraction of biomass in each leaf class is updated using
+!!    the following equation:
+!!    \latexonly
+!!    \input{turnover_update_LeafAgeDistribution_eqn6.tex}
+!!    \endlatexonly
+!!    \n
+!! 5. Simulate herbivory activity and update leaf and fruits biomass.
+!!    Herbivore activity affects the biomass of leaves and fruits as well
+!!    as stalks (only for grasses). However, herbivores do not modify leaf
+!!    age structure.
+!! 6. Calculates fruit turnover for trees. Trees simply lose their fruits
+!!    with a time constant ::tau_fruit(j), that is set to 90 days for all
+!!    PFTs in ::stomate_constants 
+!! 7. Convert sapwood to heartwood for trees and update heart and softwood
+!!    above and belowground biomass. Sapwood biomass is converted into
+!!    heartwood biomass with a time constant tau ::tau_sap(j) of 1 year.
+!!    Note that this biomass conversion is not added to "turnover" as the
+!!    biomass is not lost. For the updated heartwood, the sum of new
+!!    heartwood above and new heartwood below after converting sapwood to 
+!!    heartwood, is saved as ::hw_new(:). Creation of new heartwood
+!!    decreases the age of the plant ??carbon?? with a factor that is
+!!    determined by: old heartwood ::hw_old(:) divided by the new
+!!    heartwood ::hw_new(:)
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLES: ::Biomass of leaves, fruits, fine roots and
+!!  sapwood above (latter for grasses only), ::Update 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_over (npts, dt, PFTpresent, herbivores, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, moiavail_week, &
+       moiavail_month, t2m_longterm, t2m_month, t2m_week, &
+       veget_cov_max, gdd_from_growthinit, leaf_age, leaf_frac, age, &
+       turnover, plant_status, turnover_time, &
+       circ_class_biomass, circ_class_n, &
+       when_growthinit, tau_eff_leaf, tau_eff_sap, tau_eff_root, &
+       harvest_pool, harvest_type, harvest_cut, harvest_area, &
+       resolution, wstress_month)
+
+ !! 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(:,:), INTENT(in)              :: PFTpresent           !! PFT exists (true/false)
+    REAL(r_std),DIMENSION(:,:), INTENT(in)           :: resolution           !! The length in m of each grid-box in X and Y
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: herbivores           !! time constant of probability of a leaf to 
+                                                                             !! be eaten by a herbivore (days) 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: maxmoiavail_lastyear !! last year's maximum moisture availability 
+                                                                             !! (0-1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: minmoiavail_lastyear !! last year's minimum moisture availability 
+                                                                             !! (0-1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: moiavail_week        !! "weekly" moisture availability 
+                                                                             !! (0-1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: moiavail_month       !! "monthly" moisture availability 
+                                                                             !! (0-1, unitless)
+    REAL(r_std), DIMENSION(:), INTENT(in)            :: t2m_longterm         !! "longterm" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(:), INTENT(in)            :: t2m_month            !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(:), INTENT(in)            :: t2m_week             !! "weekly" 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: veget_cov_max            !! "maximal" coverage fraction of a PFT (LAI 
+                                                                             !! -> infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: gdd_from_growthinit  !! gdd senescence for crop
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: when_growthinit      !! How many days ago was the beginning of 
+                                                                             !! the growing season (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: tau_eff_root         !! Effective root turnover time that accounts
+                                                                             !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: tau_eff_sap          !! Effective sapwood turnover time that accounts
+                                                                             !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: tau_eff_leaf         !! Effective leaf turnover time that accounts
+                                                                             !! waterstress (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: wstress_month        !! Water stress factor, based on hum_rel_daily
+                                                                             !! (unitless, 0-1)
+
+    !! 0.2 Output variables
+   
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: leaf_age             !! age of the leaves (days)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: leaf_frac            !! fraction of leaves in leaf age class 
+                                                                             !! (0-1, unitless)
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)   :: harvest_pool         !! The wood and biomass that have been
+                                                                             !! havested by humans @tex $(gC)$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: harvest_type         !! Type of management that resulted
+                                                                             !! in the harvest (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: harvest_cut          !! Type of cutting that was used for the harvest
+                                                                             !! (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: harvest_area         !! Harvested area (m^{2})
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)       :: age                  !! age (years)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: turnover_time        !! turnover_time of grasses (days) 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)   :: turnover             !! Turnover @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: circ_class_biomass   !! Biomass of the componets of the model  
+                                                                             !! tree within a circumference
+                                                                             !! class @tex $(gC ind^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)  :: plant_status         !! Growth and phenological status of the plant
+                                                                             !! Different stati are defined in constantes
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)     :: circ_class_n         !! Number of individuals in each circ class
+                                                                             !! @tex $(m^{-2})$ @endtex
+
+
+    !! 0.4 Local  variables
+
+    LOGICAL, DIMENSION(npts)                         :: shed_rest            !! shed the remaining leaves? (true/false)
+    INTEGER(i_std)                                   :: ivm,iele,ilage,ipts  !! Index (unitless)
+    INTEGER(i_std)                                   :: ipar,icirc,imbc,ij   !! Index (unitless)
+    INTEGER(i_std), SAVE                             :: turn_count           !!  
+!$OMP THREADPRIVATE(turn_count)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: lai                  !! leaf area index @tex ($m^2 m^{-2}$)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: leaf_meanage         !! mean age of the leaves (days)
+    REAL(r_std), DIMENSION(npts,ncirc)               :: 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) 
+    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)               :: init_biomass         !! Biomass before turnover. This variable is used
+                                                                             !! in IF-statements to ensure that the same 
+                                                                             !! initial biomass is used for N and C 
+                                                                             !! @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)
+    REAL(r_std), DIMENSION(npts,nvm)                 :: harvest_time         !! Prescribed harvest time adjusted for the
+                                                                             !! longterm temperature at the pixel (days)
+    REAL(r_std)                                      :: branch_turn          !! turnover of branches (how much goes 
+                                                                             !! to litter each day) (cf article CO2fix)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements):: bm_old               !! old root mass
+    REAL(r_std), DIMENSION(npts,nvm)                 :: sapwood_age          !! sapwood age (days)
+    REAL(r_std), DIMENSION(npts)                     :: sw_old               !! old sapwood mass 
+                                                                             !! (gC/(m**2 of nat/agri ground))
+    REAL(r_std), DIMENSION(npts)                     :: sw_new               !! new sapwood mass 
+                                                                             !! (gC/(m**2 of nat/agri ground)
+    REAL(r_std), DIMENSION(npts)                     :: pixel_area           !! surface area of the pixel @tex ($m^{2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)&
+                                                     :: check_intern         !! Contains the components of the internal
+                                                                             !! mass balance chech for this routine
+                                                                             !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: closure_intern       !! Check closure of internal mass balance
+                                                                             !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)       :: pool_start, pool_end !! Start and end pool of this routine 
+                                                                             !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                 :: veget_cov_max_begin      !! temporary storage of veget_cov_max to check
+                                                                             !! area conservation (unitless, 0-1)
+    REAL(r_std)                                      :: recycle
+    REAL(r_std),DIMENSION(npts)                      :: temp_w
+    INTEGER(i_std), DIMENSION(4)                     :: parts
+!_ ================================================================================================================================
+
+    IF (printlev>=2) WRITE(numout,*) 'Entering turnover'
+
+ !! 1. first call - output messages
+
+    ! Initialize local printlev
+    !printlev_loc = get_printlev('turnover')
+
+    ! Initialize first call
+    IF ( firstcall_turnover ) THEN
+
+       IF(printlev_loc>=4) THEN
+          WRITE(numout,*) 'turnover:'
+          WRITE(numout,*) ' > minimum mean leaf age for senescence ',&
+               '(days) (::min_leaf_age_for_senescence) : ',&
+               min_leaf_age_for_senescence
+       ENDIF
+
+       turn_count = 0
+       firstcall_turnover = .FALSE.
+
+    ENDIF
+    parts(1)=iroot
+    parts(2)=ileaf
+    parts(3)=ifruit
+    parts(4)=isapabove
+
+ !! 2. Initializations 
+
+    !! 2.1 set output to zero
+    turnover(:,:,:,:) = zero
+    new_turnover_time(:,:) = zero
+    harvest_time(:,:) = zero 
+    !  Surface area (m2) of the pixel
+    pixel_area(:) = resolution(:,1) * resolution(:,2)
+
+    !! 2.2 Initialize check for mass balance closure
+    !  The mass balance is calculated at the end of this routine
+    !  in section 10.
+    ! turnover is always equal to zero, so maybe that term doesn't need
+    ! to be included here.
+    IF (err_act.GT.1) THEN
+
+       pool_start = zero
+
+       DO iele = 1,nelements
+          ! Biomass pool + turnover
+          DO ipar = 1,nparts
+             DO icirc = 1,ncirc
+                ! Initial biomass pool
+                pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                     circ_class_biomass(:,:,icirc,ipar,iele) * &
+                     circ_class_n(:,:,icirc) * veget_cov_max(:,:)
+
+             ENDDO
+             ! Add bm_to_litter to the initial biomass pool
+             pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                  (turnover(:,:,ipar,iele) * veget_cov_max(:,:))
+          ENDDO
+       ENDDO
+
+       ! The biomass harvest pool is expressed in gC pixel-1 So, it 
+       ! shouldn't be multiplied by veget_cov_max but it should be divided
+       ! by pixel_area to obtain gC m-2.
+       DO ivm = 1,nvm
+          DO iele = 1,nelements
+             pool_start(:,ivm,iele) = pool_start(:,ivm,iele) + &
+                  SUM(harvest_pool(:,ivm,:,iele),2) / &
+                  pixel_area(:)
+          ENDDO
+       ENDDO
+
+       !! 1.3 Initialize check for area conservation
+       veget_cov_max_begin(:,:) = veget_cov_max(:,:)
+
+    ENDIF ! err_act.GT.1
+
+    !+++CHECK+++
+    ! No branch turnover in CAN but it is not clear 
+    ! why that would be justified. Could be accounted
+    ! for somewhere else (seems unlikely).
+!!$    ! Compute the turnover of branches 
+!!$    ! (2.5% per year : Orchidee standard, Masera 2003, Lehtonen 2004,
+!!$    ! DeAngelis 1981)
+!!$    branch_turn = 0.025/(one_year/dt)*ss_branch_turn
+    !++++++++++++
+
+    ! Calculate lai
+    DO ivm = 2,nvm
+       DO ipts=1,npts
+          lai(ipts,ivm) = biomass_to_lai(SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)),ivm)
+       ENDDO
+    ENDDO
+    lai(:,1) = zero
+
+    !! 2.3 Initialize check for surface area conservation
+    !  Veget_max is a INTENT(in) variable and can therefore
+    !  not be changed during the course of this subroutine
+    !  No need to check whether the subroutine preserves the
+    !  total surface area of the pixel.
+
+    !! 2.4 Recalculate mean leaf age
+    !  Mean leaf age is recalculated from leaf ages of separate leaf age
+    !  classes. Leaf age is used as a criterion in several of the
+    !  following IF/WHERE loops. The mean leaf age is calculated using
+    !  the following equation:
+    !  \latexonly
+    !  \input{turnover_lma_update_eqn1.tex}
+    !  \endlatexonly
+    !  \n
+    leaf_meanage(:,:) = zero
+
+    DO ilage = 1, nleafages
+       leaf_meanage(:,:) = leaf_meanage(:,:) + &
+            leaf_age(:,:,ilage) * leaf_frac(:,:,ilage)
+    ENDDO
+
+ !! 3. Climatic senescence
+
+    ! Three different types of "climatic" leaf senescence,
+    ! that do not change the age structure. 
+
+    DO ivm = 2,nvm ! Loop over # PFTs
+       !! 3.1 Determine if there is climatic senescence. 
+       !  The climatic senescence can be of three types: sensitivity to
+       !  cold temperatures, to lack of water, or both. If meteorological
+       !  conditions are fulfilled, a flag senescence is set to TRUE.
+       !  Evergreen species do not experience climatic senescence.
+       SELECT CASE ( senescence_type(ivm) )
+
+       CASE ('crop' )
+
+          !+++CHECK+++
+          ! This is the original code. CAN took a different approach
+          ! but that different approach need to be carefuly revisited
+          !  Crop senescence is based on a GDD criterium as in crop models.
+!!$          WHERE ( ( biomass(:,ivm,ileaf,icarbon) .GT. zero ) .AND. &
+!!$               ( leaf_meanage(:,ivm) .GT. min_leaf_age_for_senescence(ivm) )&
+!!$               .AND.( gdd_from_growthinit(:,ivm) .GT.  gdd_senescence(ivm)))
+!!$             
+!!$              plant_status(:,ivm) .EQ. isenescent
+!!$          ENDWHERE
+          
+          ! This is pure plumbing under time pressure (says the one who
+          ! introduced it). Switch senescence to true and it will stay
+          ! true until begin_leaves becomes true. A growing season should
+          ! last about 4 months  where the longterm temperature is 282 K
+          ! (crude observation from N. France) before senescence can set
+          ! in unless the growing degrees are reached. In colder and warmer
+          ! places the growing season is shortened or lengthened. Because
+          ! in warmer places the growing season lasts longer, crop can be
+          ! planted that required more light.
+          harvest_time(:,ivm) = 130 + 3 * ( t2m_longterm(:) - 282)
+   
+          WHERE ( plant_status(:,ivm) .EQ. icanopy  .AND. &
+               leaf_meanage(:,ivm) .GT. min_leaf_age_for_senescence(ivm) .AND. &
+               ( gdd_from_growthinit(:,ivm) .GT. gdd_senescence(ivm) .OR. &
+               when_growthinit(:,ivm) .GT. harvest_time(:,ivm) ) )
+
+             plant_status(:,ivm) = isenescent
+
+          ENDWHERE
+          !+++++++++++
+          
+       CASE ( 'cold' )
+
+          !! 3.1.2 Summergreen species
+          !  Climatic senescence is triggered by sensitivity to cold
+          !  temperatures as follows: 
+          !  If biomass is large enough (i.e. when it is greater than zero), 
+          !  AND (i.e. when leaf mean age is above a certain PFT-dependent
+          !  treshold ::min_leaf_age_for_senescence, which is given in
+          !  constants), AND the monthly temperature is low enough (i.e.
+          !  when monthly temperature ::t2m_month(:) is below a critical 
+          !  temperature ::t_crit(:), which is calculated in this module),
+          !  AND the temperature tendency is negative (i.e. when weekly
+          !  temperatures ::t2m_week(:) are lower than monthly 
+          !  temperatures ::t2m_month(:))
+          !  If these conditions are met, senescence is set to TRUE.
+          !
+          !  The critical temperature for senescence is calculated using
+          !  the following equation:
+          !  \latexonly
+          !  \input{turnover_temp_crit_eqn2.tex}
+          !  \endlatexonly
+          !  \n
+          !  Critical temperature for senescence may depend on long term
+          !  annual mean temperature
+          tl(:) = t2m_longterm(:) - ZeroCelsius
+          t_crit(:) = ZeroCelsius + senescence_temp(ivm,1) + &
+               tl(:) * senescence_temp(ivm,2) + &
+               tl(:)*tl(:) * senescence_temp(ivm,3)
+
+          WHERE ( ( plant_status(:,ivm) .EQ. icanopy ) .AND. &
+               ( leaf_meanage(:,ivm).GT.min_leaf_age_for_senescence(ivm)).AND. &
+               ( t2m_month(:) .LT. t_crit(:) ) .AND. &
+               ( t2m_week(:) .LT. t2m_month(:) ) )
+
+             plant_status(:,ivm) = isenescent
+          
+          ENDWHERE
+          
+          
+       CASE ( 'dry' )
+
+          !! 3.1.3 Raingreen species
+          !  Climatic senescence is triggered by sensitivity to lack of
+          !  water availability as follows:  
+          !  If biomass is large enough (i.e. when it is greater than zero), 
+          !  AND (i.e. when leaf mean age is above a certain PFT-dependent
+          !  treshold ::min_leaf_age_for_senescence, which is given in
+          !  ::stomate_constants), AND the moisture availability drops below
+          !  a critical level (i.e. when weekly moisture availability 
+          !  ::moiavail_week(:,ivm) 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(:,ivm) + hum_frac(ivm) * &
+               ( maxmoiavail_lastyear(:,ivm) - minmoiavail_lastyear(:,ivm) ), &
+               senescence_hum(ivm) ), &
+               nosenescence_hum(ivm) )
+
+          WHERE ( ( plant_status(:,ivm) .EQ. icanopy ) .AND. &
+               (leaf_meanage(:,ivm).GT.min_leaf_age_for_senescence(ivm)).AND.&
+               ( moiavail_week(:,ivm) .LT. moiavail_crit(:) ) )
+
+             plant_status(:,ivm) = isenescent
+
+          ENDWHERE
+
+       CASE ( 'mixed' )
+
+          !! 3.1.4 Mixed criterion: Climatic senescence is triggered
+          !!       by sensitivity to temperature or to lack of water  
+          !  Climatic senescence is triggered by sensitivity to temperature
+          ! or to lack of water availability as follows:
+          !  If biomass is large enough (i.e. when it is greater than zero), 
+          !  AND (i.e. when leaf mean age is above a certain PFT-dependent
+          !  treshold ::min_leaf_age_for_senescence, which is given in
+          !  ::stomate_constants), AND the moisture availability drops below
+          !  a critical level (i.e. when weekly moisture availability 
+          !  ::moiavail_week(:,ivm) 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(:,ivm) + &
+               hum_frac(ivm) * (maxmoiavail_lastyear(:,ivm) - &
+               minmoiavail_lastyear(:,ivm) ), senescence_hum(ivm) ), &
+               nosenescence_hum(ivm) )
+          tl(:) = t2m_longterm(:) - ZeroCelsius
+          t_crit(:) = ZeroCelsius + senescence_temp(ivm,1) + &
+               tl(:) * senescence_temp(ivm,2) + &
+               tl(:)*tl(:) * senescence_temp(ivm,3)
+
+          IF ( is_tree(ivm) ) THEN
+
+             ! critical temperature for senescence may depend on long
+             ! term annual mean temperature
+             WHERE ( ( plant_status(:,ivm) .EQ. icanopy ) .AND. &
+                  (leaf_meanage(:,ivm).GT.min_leaf_age_for_senescence(ivm)).AND.&
+                  ( ( moiavail_week(:,ivm) .LT. moiavail_crit(:) ) .OR. &
+                  ( ( t2m_month(:) .LT. t_crit(:) ) .AND. &
+                  ( t2m_week(:) .LT. t2m_month(:) ) ) ) )
+
+                plant_status(:,ivm) = isenescent
+
+             ENDWHERE
+
+             
+          ELSE
+
+             ! Grasses
+             ! Because the DOFOCO increase of LAI is much slower than in
+             ! the trunk there is a period at the start of the growing
+             ! season where LAI is less than lai_happy. In that period
+             ! ::t2_month is still increasing from its winter values but
+             ! could be below t_crit. That condition resulted in many
+             ! grasslands along the Atlantic and North Sea coast to go
+             ! into senescence in May. If someone wants to put it back in
+             ! be carefull with the brackets. ((t2m_month(:) .LT. t_crit(:))
+             ! .AND. (lai(:,ivm) .GT. lai_happy(ivm)))
+             WHERE ( ( (plant_status(:,ivm) .EQ. icanopy) .AND. &
+                  (leaf_meanage(:,ivm).GT.min_leaf_age_for_senescence(ivm)).AND.&
+                  (t2m_month(:) .LT. ZeroCelsius) .AND. &
+                  (t2m_week(:) .LT. t2m_month(:)) ) )
+               
+                ! Shed leaves, roots and fruits at a high rate = senescence
+                turnover_time(:,ivm,ileaf) = leaffall(ivm)
+                turnover_time(:,ivm,iroot) = leaffall(ivm)
+                turnover_time(:,ivm,ifruit) = leaffall(ivm)
+                
+                ! Slowly turnover the structural carbon this allows to store 
+                ! reserves. This structural pool is essential for the
+                ! functioning of the labile and reserve pools
+                turnover_time(:,ivm,isapabove) = tau_eff_sap(:,ivm)
+                plant_status(:,ivm) = isenescent
+ 
+             ENDWHERE
+            
+          ENDIF
+
+       CASE ( 'none' )
+
+          !! 3.1.5 Evergreen species 
+          !  Evergreen species do not experience climatic senescence
+          
+       CASE default
+
+          !! 3.1.6 Other cases
+          !  In case no climatic senescence type is recognized.
+          WRITE(numout,*) '  turnover: don''t know how to treat this PFT.'
+          WRITE(numout,*) '  number (::ivm) : ',ivm
+          WRITE(numout,*) '  senescence type (::senescence_type(ivm)) : ',&
+               senescence_type(ivm)
+          CALL ipslerr_p (3,'stomate_turnover',&
+               'turnover: don''t know how to treat this PFT','case 1','')
+
+       END SELECT
+
+       ! Debug
+       IF (printlev_loc >= 4 .AND. ivm .EQ. test_pft) THEN
+          WRITE(numout,*) 'phenology, plant_status, ',plant_status(:,ivm)
+       ENDIF
+       !-
+
+       !! 3.2 Drop leaves and roots, plus stems and fruits for grasses
+       IF ( is_tree(ivm) ) THEN
+          !! 3.2.1 Trees in climatic senescence lose their fine roots at
+          !!       the same rate as they lose their leaves. 
+          !  The rate of biomass loss of both fine roots and leaves
+          !  is presribed through the equation:
+          !  \latexonly
+          !  \input{turnover_clim_senes_biomass_eqn4.tex}
+          !  \endlatexonly
+          !  \n
+          !  with ::leaffall(ivm) a PFT-dependent time constant which is
+          !  given in ::stomate_constants),
+          ! Calculate stand-level turnover for
+          ! both carbon and nitrogen (gC tree-1)).
+          ! For nitrogen, we first calculate the turnover that
+          ! is lost from the respective biomass pools, i.e.,
+          ! all the nitrogen is lost from the leaf pool. Then
+          ! recycle some of the leaf nitrogen into the labile pool
+          ! and finaly correct the turnover pool for the recycled
+          ! nitrogen.
+
+          DO iele =1, nelements   
+            DO ij = 1, 2 ! ileaf and iroot
+                ipar=parts(ij)
+                IF (ipar .EQ. ileaf .AND. iele .EQ. initrogen) THEN
+                    recycle=recycle_leaf(ivm)
+                ELSEIF (ipar .EQ. iroot .AND. iele .EQ. initrogen) THEN 
+                    recycle=recycle_root(ivm)
+                ELSE
+                    recycle=zero
+                ENDIF
+                dturnover(:,:) = zero
+                DO icirc=1, ncirc
+                    WHERE ( plant_status(:,ivm) .EQ. isenescent )
+                        dturnover(:,icirc) = dt/ leaffall(ivm)* &
+                            circ_class_biomass(:,ivm,icirc,ipar,iele)
+                    ENDWHERE
+                ENDDO
+                circ_class_biomass(:,ivm,:,ilabile,iele)= &
+                    circ_class_biomass(:,ivm,:,ilabile,iele) + &
+                    dturnover(:,:)*recycle
+                turnover(:,ivm,ipar,iele) = turnover(:,ivm,ipar,iele)+ &
+                    SUM(dturnover(:,:) * circ_class_n(:,ivm,:),2) * &
+                     ( un - recycle )
+                circ_class_biomass(:,ivm,:,ipar,iele) = &
+                    circ_class_biomass(:,ivm,:,ipar,iele) - &
+                    dturnover(:,:)
+            ENDDO
+          ENDDO 
+
+       ELSE    
+          !! 3.2.2.1 crops with 'crop' phenological model
+          IF (senescence_type(ivm) .EQ. 'crop') THEN
+             DO ipts = 1,npts
+                IF (plant_status(ipts,ivm) .EQ. isenescent) THEN
+                   ! Crops are planted every year. So make sure to remove
+                   ! everything at the end of senescence which for crops
+                   ! is actually harvest. Next stomate_prescribe should
+                   ! prescribe a new crop. If sapwood is not removed, some
+                   ! is left on site and the model will try to grow a crop.
+                   ! However, there are not enough reserves left so the 
+                   ! crop will die. This results in one year of normal crop
+                   ! growth (following the prescribe) and then one year of
+                   ! almost no growth (the year starting from the too low
+                   ! reserves). This issue has been fixed.
+                   CALL crop_harvest(npts, ipts, ivm, dt, &
+                        veget_cov_max, turnover, harvest_pool, harvest_type, &
+                        harvest_cut, harvest_area, resolution,&
+                        circ_class_biomass,circ_class_n,leaf_meanage)
+                   
+                   ! Update plant_status. Crops were harvested. No living
+                   ! biomass was left on-site thus we will have to 
+                   ! prescribe a new vegetation during the next growing
+                   ! season.
+                   plant_status(ipts,ivm) = iprescribe
+                ENDIF
+             ENDDO
+
+          !! 3.2.2.2 grass based on 'mixed' phenological model
+          ELSEIF (senescence_type(ivm) .EQ. 'mixed') THEN
+             DO iele = 1,nelements ! carbon and nitrogen (gC m-2)
+                DO ij = 1, 4 ! ileaf, iroot, ifruit, isapabove
+                    ipar=parts(ij)
+                    IF (ipar .EQ. ileaf .AND. iele .EQ. initrogen) THEN
+                        recycle=recycle_leaf(ivm)
+                    ELSEIF (ipar .EQ. iroot .AND. iele .EQ. initrogen) THEN
+                        recycle=recycle_root(ivm)
+                    ELSE
+                        recycle=zero
+                    ENDIF
+                    ! First calculate the total turnover. Part of the
+                    ! turnover will be recycled and stored in the labile
+                    ! pool. The remaining mass is added to the turnover
+                    ! pool that will eventually become litter. Once the
+                    ! turnover is known the biomass pool can be updated.
+                    dturnover(:,:) = zero
+                    WHERE (plant_status(:,ivm) .EQ. isenescent)
+                        dturnover(:,1) = circ_class_biomass(:,ivm,1,ipar,iele)*&
+                            dt/turnover_time(:,ivm,ipar)
+                    ENDWHERE
+                    circ_class_biomass(:,ivm,1,ilabile,iele) = &
+                        circ_class_biomass(:,ivm,1,ilabile,iele) + &
+                        recycle * dturnover(:,1)
+                    turnover(:,ivm,ipar,iele) = turnover(:,ivm,ipar,iele)+ &
+                        dturnover(:,1) * circ_class_n(:,ivm,1)* (un-recycle)
+                    circ_class_biomass(:,ivm,1,ipar,iele) = &
+                        circ_class_biomass(:,ivm,1,ipar,iele) - &
+                        dturnover(:,1)
+                ENDDO   
+             ENDDO
+ 
+             ! Debug
+             IF (printlev_loc>4) THEN
+                WRITE(numout,*) 'test - recycle, ', ivm, recycle_root(ivm), &
+                     recycle_leaf(ivm)
+             ENDIF
+             !-
+          ELSEIF  (senescence_type(ivm) .EQ. 'none') THEN
+             !! 3.2.2.3 Grasses modeled as an evergreen biome
+             turnover(:,ivm,:,:) = zero
+          ELSE
+             !! 3.2.2.4 Conceptual problem
+             WRITE(numout,*) 'ERROR: senenescence type not known - 2'
+             CALL ipslerr_p(3,'stomate_turnover',&
+                  'turnover: senescence type not known','case 2','')
+          END IF
+       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. Another reason for leaf fall may be waterstress. When 
+    !  the plant experiences water stress some of the leaves will die.
+    !  Wstress is calculated from the ratio between stressed and unstressed
+    !  GPP. If the wstress is less than 1, this implies that we have to maintain
+    !  a complete canopy (and therefore have the Ra cost) but that only part 
+    !  of the canopy will contribute to GPP. Although this is exactely what 
+    !  happens on a warm summer day, what we are trying to account for here is
+    !  the impact of a lasting drought (days to weeks). Adaptation to the
+    !  growing conditions are accounted for through KF (see allocation)
+    !  Roots, fruits (and stems) follow leaves. The decay rate varies with 
+    !  leaf  age. Note that the plant is not declared senescent in this case 
+    !  (wchich is important for allocation: if the plant looses leaves because 
+    !  of their age, it can renew them). 
+    !  Notice that we do not change the reserve pools here (ilabile and 
+    !  icarbres). We assume that the tree will move these pools out of old 
+    !  leaves and therefore the carbon will not be lost.  Trees are smart.
+    !  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 ivm = 2,nvm ! Loop over # PFTs
+       !! 4.1 Calculate critical leaf age       !  save old leaf mass
+       lm_old(:) = SUM(circ_class_biomass(:,ivm,:,ileaf,icarbon)* &
+        circ_class_n(:,ivm,:),2)
+
+       !! initialize leaf mass change in age class
+       delta_lm(:,:) = zero
+
+       IF ( is_tree(ivm) .OR. (.NOT. natural(ivm)) ) THEN
+         
+          ! Trees and crops: leaves, roots, fruits roots 
+          ! and fruits follow leaves. Critical age of
+          ! leaves is set to the current leaf age.
+          leaf_age_crit(:,ivm) = tau_eff_leaf(:,ivm)
+
+       ELSEIF ( .NOT. is_tree(ivm) .AND. natural(ivm) ) THEN
+
+          !  Critical leaf age depends on long-term temperature
+          !  generally, lower turnover in cooler climates.
+          leaf_age_crit(:,ivm) = &
+               MIN( tau_eff_leaf(:,ivm) * leaf_age_crit_coeff(1) , &
+               MAX( tau_eff_leaf(:,ivm) * leaf_age_crit_coeff(2) , &
+               tau_eff_leaf(:,ivm) - leaf_age_crit_coeff(3) * &
+               ( t2m_longterm(:)-ZeroCelsius - leaf_age_crit_tref ) ) )
+       
+       ELSE
+
+          ! Overlooked a case in the code
+          WRITE(numout,*) 'ERROR: leag_age_crit is not defined'
+          CALL ipslerr_p(3,'stomate_turnover',&
+                  'turnover: leaf_age_crit is not defined','','')
+
+       END IF
+       
+       !! 4.2 Turnover for different leaf age classes
+       DO ilage = 1,nleafages
+
+          turnover_rate(:) = zero
+          ! Age-driven turnover can only occur when there is a canopy
+          ! and if the leaves exceeds a certain age. The plant_status 
+          ! of a crop is set for only one day to isenescent. Thee crop 
+          ! is harvested on that day. Grasses are now treated as 
+          ! evergreens. For the deciudous trees turn-over during senesce
+          ! is accounted for above. For all these reasons, the turnover
+          ! calculated here was limited to the plant_status = icanopy.
+          WHERE ( plant_status(:,ivm) .EQ. icanopy .AND. &
+               leaf_age(:,ivm,ilage) .GT. leaf_age_crit(:,ivm) / deux)
+
+             ! Not clear where this equation comes from or what it is
+             ! based on. 
+             turnover_rate(:) =  &
+                  MIN( 0.99_r_std, dt / ( leaf_age_crit(:,ivm) * &
+                  ( leaf_age_crit(:,ivm) / leaf_age(:,ivm,ilage) )**quatre ) )
+
+          ENDWHERE
+          
+          IF ( is_tree(ivm) ) THEN
+             ! Debug
+             IF (printlev_loc>=5) THEN
+                WRITE(numout,*) 'test - leaf fall PFT - forest, ',ivm
+                WRITE(numout,*) 'leaf_frac, turnover_rate, ', &
+                     leaf_frac(:,ivm,ilage), turnover_rate(:)
+             ENDIF
+             !-
+             ! Stand level turnover (gC m-2) for leaves
+             ! Water stress is increasing (note that ::wstress is thus 
+             ! decreasing)so the LAI will be lowered if the decrease is 
+             ! small, this will result in a cosmetic change in LAI. 
+             ! If water stress is increasing over a the course of a week, 
+             ! this decrease may become important. The correction is 
+             ! cummulative, for example, ::biomass(ileaf) is decreased 
+             ! by 10% in day one and the remaining fraction of 
+             ! ::biomass(ileaf) can be decreased by another 10% the next 
+             ! day, etc ... The choice to multiply with ::wstress_month
+             ! is arbitrary, we could have well used ::wstress_week. By
+             ! using the monthly value we hope a smoother decrease 
+             ! compared to using ::wstress_week or ::wstress_day.
+             ! Update biomass and turnover. During turnover all carbon
+             ! in leaves, roots and fruits will be lost. This is not the
+             ! case for N. Plants are more careful with teir nitrogen
+             ! part of the nitrogen will be resorbed prior to leaf and
+             ! root turnover. The fraction of nitrogen that is resorbed
+             ! is given by ::recycle_leaf. The resorbed nitrogen is
+             ! moved into the labile pool the rest will be lost in
+             ! turnover. Note that no resorprion happens for fruits so
+             ! all nitrogen in a fruit is lost at turnover.
+             ! It is not clear why roots follow the leaves. A turnover
+             ! rate for roots based on tau_eff_root can be easily calculated
+             ! See crops and grasses where we made use of tau_eff_root
+             ! Note that this turnover is a bit arbitrairy there is
+             ! no reason why the same fraction of roots and leaves
+             ! should die. This formulation will disturb the allometric
+             ! allocation and will need to be restored by phenological
+             ! growth in the allocation routine.
+             delta_lm(:,ilage) = - (leaf_frac(:,ivm,ilage) * &
+                turnover_rate(:)* SUM(circ_class_biomass(:,ivm,:,ileaf,icarbon)*& 
+                circ_class_n(:,ivm,:),2))
+
+             DO iele=1, nelements
+                ! Turnover (gC tree-1): leaves, roots and fruit
+                DO ij =1, 3 !ileaf, iroot, ifruit
+                    ipar=parts(ij)
+                    IF (ipar .EQ. ileaf .AND. iele .EQ. initrogen) THEN
+                        recycle=recycle_leaf(ivm)
+                    ELSEIF (ipar .EQ. iroot .AND. iele .EQ. initrogen) THEN
+                        recycle=recycle_root(ivm)
+                    ELSE
+                        recycle= zero
+                    ENDIF
+                    dturnover(:,:) = zero
+                    DO icirc=1, ncirc
+                        dturnover(:,icirc) = leaf_frac(:,ivm,ilage) * &
+                           turnover_rate(:)*circ_class_biomass(:,ivm,icirc,ipar,iele)
+                    ENDDO
+                    circ_class_biomass(:,ivm,:,ilabile,iele) = &
+                        circ_class_biomass(:,ivm,:,ilabile,iele) + &
+                        recycle * dturnover(:,:)
+                    !the stand level turnover (gC m-2):
+                    turnover(:,ivm,ipar,iele) = turnover(:,ivm,ipar,iele) + &
+                        SUM(dturnover(:,:)* circ_class_n(:,ivm,:),2) * (un - recycle)
+                    ! Update circ_class_biomass
+                    circ_class_biomass(:,ivm,:,ipar,iele) = circ_class_biomass(:,ivm,:,ipar,iele) - &
+                        dturnover(:,:)
+                ENDDO
+             ENDDO
+             
+          ELSEIF ( .NOT. is_tree(ivm) .AND. .NOT. natural(ivm) ) THEN
+             ! For crops the sapwood acts as the structure to supports
+             ! leaves and roots and store the reserves and labile.
+             ! Because the growing season is short for crops, the 
+             ! turnover of tissues should be kept to a minimum or the GPP
+             ! and NPP will be too low.
+             ! Note that dturnover was redefined so that it can be used
+             ! for both N and C
+             ! Tree Circ level turnover (gC tree-1):
+             WHERE ( wstress_month(:,ivm) .GE. un-min_stomate)
+                temp_w(:) = leaf_frac(:,ivm,ilage) * turnover_rate(:) / &
+                     ((min_stomate)**(1/tau_hum_month))
+             ELSEWHERE( wstress_month(:,ivm) .LT. un-min_stomate)
+                temp_w(:) = leaf_frac(:,ivm,ilage) * turnover_rate(:) / &
+                     ((un-wstress_month(:,ivm))**(1/tau_hum_month))
+             END WHERE
+
+             ! Do we have enough biomass to satisfy the turnover?
+             WHERE ( temp_w(:) .GE. un)
+                ! No longer account for wstress
+                temp_w(:) = leaf_frac(:,ivm,ilage) * turnover_rate(:)
+             ENDWHERE
+             delta_lm(:,ilage) = circ_class_biomass(:,ivm,1,ileaf,icarbon)*&
+                                temp_w(:)*circ_class_n(:,ivm,1)
+
+
+             DO iele=1, nelements
+                ! Turnover (gC tree-1):
+                DO ij =1,4 !ileaf, iroot, ifruit, isapabove
+                    ipar=parts(ij)
+                    IF (ipar .EQ. ileaf .AND. iele .EQ. initrogen) THEN
+                        recycle=recycle_leaf(ivm)
+                    ELSEIF (ipar .EQ. iroot .AND. iele .EQ. initrogen) THEN
+                        recycle=recycle_root(ivm)
+                    ELSE
+                        recycle= zero
+                    ENDIF
+                     dturnover(:,:) = zero
+                    IF(ipar .EQ. iroot) THEN
+                        dturnover(:,1) = circ_class_biomass(:,ivm,1,ipar,iele)*&
+                            dt / tau_eff_root(:,ivm)
+                    ELSEIF (ipar .EQ.isapabove .OR. ipar .EQ.ifruit) THEN
+                        dturnover(:,1) = circ_class_biomass(:,ivm,1,ipar,iele)*&
+                            leaf_frac(:,ivm,ilage) * turnover_rate(:)
+                    ELSEIF (ipar .EQ.ileaf) THEN
+                        dturnover(:,1) = circ_class_biomass(:,ivm,1,ipar,iele)*&
+                           temp_w(:)
+                    ENDIF
+                    circ_class_biomass(:,ivm,1,ilabile,iele) = &
+                        circ_class_biomass(:,ivm,1,ilabile,iele) + &
+                        recycle * dturnover(:,1)
+                    turnover(:,ivm,ipar,iele) = turnover(:,ivm,ipar,iele)+ &
+                        dturnover(:,1)*circ_class_n(:,ivm,1)*(un - recycle)
+                    ! Update circ_class_biomass
+                    circ_class_biomass(:,ivm,1,ipar,iele) = &
+                        circ_class_biomass(:,ivm,1,ipar,iele) - &
+                        dturnover(:,1)
+                ENDDO
+             ENDDO
+ 
+          ELSEIF ( .NOT. is_tree(ivm) .AND. natural(ivm) ) THEN
+
+             ! Grasses are now modeled as an evergreen biome, turnover is
+             ! thus needed and can only occur when there is a canopy.
+             ! This section was implemented much later then the
+             ! previous blocks and we therefore followed our own advice and
+             ! used tau_sap and tau_root rather then having all biomass pool
+             ! to follow leaf turnover.
+             ! Note that dturnover was redefined such that it could
+             ! be used for both carbon and nitrogen
+             ! Grasses are no longer considered natural and so it is
+             ! assumed that the aboveground turnover ends up in the
+             ! harvest pool (mowing or grazing). No idea whether this
+             ! is anything close to reality but it is better to 
+             ! assuming that there is no lateral transport at all. After
+             ! testing over Europe the annual harvest_pool for grasses
+             ! was 128 Tg C year compared to the estimated/observed
+             ! 161 Tg C year. It is left to grassland people to further
+             ! improve this. Note that strictly speaking there is still no
+             ! harvest, all we did is moving the natural turnover (due to
+             ! longevity) into the harvest pool.
+             ! Because we pretend it is a harvest we do not resorb nitrogen
+             WHERE ( wstress_month(:,ivm) .GE. un-min_stomate)
+                temp_w(:) = leaf_frac(:,ivm,ilage) * turnover_rate(:) / &
+                     ((min_stomate)**(1/tau_hum_month))
+             ELSEWHERE( wstress_month(:,ivm) .LT. un-min_stomate)
+                temp_w(:) = leaf_frac(:,ivm,ilage) * turnover_rate(:) / &
+                     ((un-wstress_month(:,ivm))**(1/tau_hum_month))
+             END WHERE
+             ! Do we have enough biomass to satisfy the turnover?
+             WHERE ( temp_w(:) .GE. un)
+                ! No longer account for wstress
+                 temp_w(:) = leaf_frac(:,ivm,ilage) * turnover_rate(:)
+             ENDWHERE
+
+             delta_lm(:,ilage) = -(circ_class_biomass(:,ivm,1,ileaf,icarbon)*&
+                                temp_w(:)*circ_class_n(:,ivm,1))
+
+             DO iele=1, nelements
+                DO ij =1,4 !ileaf, iroot, ifruit, isapabove
+                    ipar=parts(ij)
+                        !the stand level turnover (gC m-2):
+                        IF(ipar .EQ. iroot) THEN
+                            dturnover(:,1) = circ_class_biomass(:,ivm,1,ipar,iele)*&
+                                dt / tau_eff_root(:,ivm)
+                            turnover(:,ivm,ipar,iele) = turnover(:,ivm,ipar,iele)+ &
+                                 dturnover(:,1)*circ_class_n(:,ivm,1)
+                        ELSEIF (ipar .EQ.isapabove) THEN
+                                dturnover(:,1) =circ_class_biomass(:,ivm,1,ipar,iele)*&
+                                dt / tau_eff_sap(:,ivm)
+                            turnover(:,ivm,ipar,iele) = turnover(:,ivm,ipar,iele)+ &
+                               0.5*dturnover(:,1)*circ_class_n(:,ivm,1)
+                            harvest_pool(:,ivm,1,iele) = harvest_pool(:,ivm,1,iele) + &
+                               0.5* dturnover(:,1)*circ_class_n(:,ivm,1) * &
+                               veget_cov_max(:,ivm) * pixel_area(:)
+                        ELSEIF (ipar .EQ.ileaf) THEN
+                            dturnover(:,1) = circ_class_biomass(:,ivm,1,ipar,iele)*&
+                                temp_w(:)
+                            harvest_pool(:,ivm,1,iele) = harvest_pool(:,ivm,1,iele) + &
+                            dturnover(:,1)*circ_class_n(:,ivm,1) * veget_cov_max(:,ivm) * pixel_area(:)
+                            ! Make sure the harvest does not enter the turnover pool
+                            turnover(:,ivm,ipar,iele) = zero
+                        ELSE
+                            dturnover(:,1) = circ_class_biomass(:,ivm,1,ipar,iele)*&
+                                dt/tau_eff_leaf(:,ivm)
+                            ! save leaf mass change
+                            harvest_pool(:,ivm,1,iele) = harvest_pool(:,ivm,1,iele) + &
+                                dturnover(:,1)*circ_class_n(:,ivm,1)  *&
+                                veget_cov_max(:,ivm) * pixel_area(:)
+                            ! Make sure the harvest does not enter the turnover pool
+                            turnover(:,ivm,ipar,iele) = zero
+                        ENDIF
+                        ! Update circ_class_biomass
+                        circ_class_biomass(:,ivm,1,ipar,iele) = &
+                            circ_class_biomass(:,ivm,1,ipar,iele) - &
+                            dturnover(:,1)
+                ENDDO
+             ENDDO
+
+             ! Fill associated harvest variables
+             harvest_type(:,ivm) = ifm_grass
+             harvest_cut(:,ivm) = icut_grass
+             harvest_area(:,ivm) = veget_cov_max(:,ivm) * pixel_area(:)
+             
+          ELSE
+             WRITE(numout,*) 'ERROR: turnover has not been defined - 3'
+             CALL ipslerr_p(3,'stomate_turnover',&
+                  'turnover: senescence type not known','case 3','')
+
+          ENDIF ! is_tree(ivm)
+       ENDDO ! # leaf ages
+
+       !! 4.3 Recalculate the fraction of leaf biomass in each leaf age class.
+       !  Older leaves will be dropped more 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(:,ipar))/&
+       !                  new total leaf mass ::biomass(:,ivm,ileaf)
+       DO ilage = 1, nleafages
+          WHERE (SUM(circ_class_biomass(:,ivm,:,ileaf,icarbon)*circ_class_n(:,ivm,:),2) .GT. min_stomate )
+             leaf_frac(:,ivm,ilage) = (leaf_frac(:,ivm,ilage)*lm_old(:)+ & 
+                delta_lm(:,ilage)) / SUM(circ_class_biomass(:,ivm,:,ileaf,icarbon)* &
+                circ_class_n(:,ivm,:),2)
+          ELSEWHERE
+             leaf_frac(:,ivm,ilage) = zero
+          ENDWHERE
+       ENDDO
+    ENDDO         ! loop over PFTs
+      
+    !! 5. Drop all leaves if there is a very low leaf mass during senescence
+    
+    !  Both for deciduous trees and grasses same conditions are checked:
+    !  If biomass is large enough (i.e. when it is greater than zero), 
+    !  AND when senescence is set to true
+    !  AND the leaf biomass drops below a critical minimum biomass level
+    !  (i.e. when it is lower than half the minimum initial LAI
+    !  ::lai_initmin(ivm) divided by the specific leaf area ::sla(ivm),
+    !  ::lai_initmin(ivm) 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 ivm = 2,nvm ! Loop over # PFTs
+       ! Debug
+       IF (ivm .EQ. test_pft .AND. printlev_loc >= 4) THEN
+          WRITE(numout,*) 'low leaf mass, '
+       ENDIF
+       shed_rest(:) = .FALSE.
+       !! 5.1 For deciduous trees: leaves, fruits and fine roots are dropped 
+       !  For deciduous trees: next to leaves, also fruits and fine roots
+       !  are dropped: fruit ::biomass(:,ivm,ifruit) and fine root
+       !  ::biomass(:,ivm,iroot) carbon pools are set to zero.
+       IF ( is_tree(ivm) .AND. ( senescence_type(ivm) .NE. 'none' ) ) THEN
+          ! Check whether we shed the remaining leaves. The condition
+          ! depends on biomass(ileaf) so first calculate the sheding
+          ! at the tree level. because biomass(ileaf) is not changed
+          ! at the tree level the same statement can then be used at
+          ! the stand level.
+          init_biomass(:) = SUM(circ_class_biomass(:,ivm,:,ileaf,icarbon)*&
+            circ_class_n(:,ivm,:),2)
+          DO iele = 1,nelements
+            DO ij =1,3 !ileaf, iroot, ifruit
+                ipar=parts(ij)
+                IF (ipar .EQ. ileaf .AND. iele .EQ. initrogen)THEN
+                    recycle=recycle_leaf(ivm)
+                ELSEIF (ipar .EQ. iroot .AND. iele .EQ. initrogen ) THEN
+                    recycle=recycle_root(ivm)
+                ELSE
+                    recycle=zero
+                ENDIF
+                dturnover(:,:) = zero
+                DO icirc=1, ncirc
+                    WHERE ( ( init_biomass(:) .GT. zero ) .AND.&
+                        plant_status(:,ivm) .EQ. isenescent .AND. &
+                        ( init_biomass(:) .LT. (lai_initmin(ivm)/2.)/slainit(ivm)))
+                            dturnover(:,icirc) = circ_class_biomass(:,ivm,icirc,ipar,iele)
+                            circ_class_biomass(:,ivm,icirc,ipar,iele)= zero
+                            ! Account for resorption at the tree level (gC tree-1)
+                            ! This should be out of the iele loop else labile is
+                            ! calculated twice and the mass balance is no longer preserved.
+                            circ_class_biomass(:,ivm,icirc,ilabile,iele) = &
+                                circ_class_biomass(:,ivm,icirc,ilabile,iele)+ &
+                                recycle * dturnover(:,icirc)
+                            turnover(:,ivm,ipar,iele) = turnover(:,ivm,ipar,iele)+&
+                                dturnover(:,icirc)*circ_class_n(:,ivm,icirc)*(un-recycle)
+                    ENDWHERE
+                ENDDO
+            ENDDO
+          ENDDO 
+          WHERE(( init_biomass(:) .GT. zero ) .AND. &
+            plant_status(:,ivm) .EQ. isenescent .AND. &
+            ( init_biomass(:) .LT. &
+            (lai_initmin(ivm)/2.)/slainit(ivm)))
+                plant_status(:,ivm) = idormant
+                leaf_meanage(:,ivm) = zero
+             shed_rest(:) = .TRUE.
+          ENDWHERE
+          
+       ELSEIF (.NOT. is_tree(ivm)) THEN
+
+          IF (senescence_type(ivm) .EQ. 'crop') THEN
+          
+             ! Nothing should be done because we now
+             ! have a harvest module for crops.
+             
+          ELSEIF (senescence_type(ivm) .EQ. 'mixed') THEN  
+
+             !! 6.2 Drop leaves, roots, fruit and sapwood for grasses
+             !  For grasses all aboveground carbon pools, except the
+             !  carbohydrate reserves are affected: fruit
+             !  ::biomass(:,ivm,ifruit,icarbon), fine root
+             !  ::biomass(:,ivm,iroot,icarbon) and sapwood above 
+             !  ::biomass(:,ivm,isapabove,icarbon) carbon pools are set
+             !  to zero.
+             !  Shed the remaining leaves if LAI very low.
+             init_biomass(:) = circ_class_biomass(:,ivm,1,ileaf,icarbon)*&
+                 circ_class_n(:,ivm,1)
+             DO iele = 1,nelements
+                ! Grasses should live on after senescence. Do not
+                ! shed the sapwood because then the whole 
+                ! system collapse because the reserves are
+                ! calculated based on the sapwood. no sapwood = no 
+                ! reserves = no phenology = no growth.
+                DO ij =1,4 !ileaf, iroot, ifruit isapabove
+                    ipar=parts(ij)
+                    IF (ipar .EQ. ileaf .AND. iele .EQ. initrogen) THEN
+                        recycle=recycle_leaf(ivm)
+                    ELSEIF (ipar .EQ. iroot .AND. iele .EQ. initrogen) THEN
+                        recycle=recycle_root(ivm)
+                    ELSE
+                        recycle=zero
+                    ENDIF
+                    dturnover(:,:) = zero
+                    WHERE ( ( init_biomass(:) .GT. min_stomate ) .AND.&
+                     plant_status(:,ivm) .EQ. isenescent .AND. &
+                     ( init_biomass(:) .LT. &
+                     (lai_initmin(ivm)/2.)/slainit(ivm)))
+                        ! Account for resorption at the tree level (gC tree-1)
+                        ! This should be out of the iele loop else labile is
+                        ! calculated twice and the mass balance is no longer preserved.
+                        dturnover(:,1) = circ_class_biomass(:,ivm,1,ipar,iele)
+                        circ_class_biomass(:,ivm,1,ipar,iele)= zero
+                        circ_class_biomass(:,ivm,1,ilabile,iele) = &
+                            circ_class_biomass(:,ivm,1,ilabile,iele)+ &
+                            recycle * dturnover(:,1)
+                        turnover(:,ivm,ipar,iele) = turnover(:,ivm,ipar,iele)+ &
+                            dturnover(:,1)*circ_class_n(:,ivm,1)*(un-recycle)
+                    ENDWHERE
+                ENDDO    
+            ENDDO
+            WHERE( ( init_biomass(:) .GT. min_stomate ) .AND.&
+                plant_status(:,ivm) .EQ. isenescent .AND. &
+                ( init_biomass(:) .LT.&
+                (lai_initmin(ivm)/2.)/slainit(ivm)))
+                    shed_rest(:) = .TRUE.
+                    plant_status(:,ivm) = idormant
+                    leaf_meanage(:,ivm) = zero
+            ENDWHERE
+
+          ELSEIF (senescence_type(ivm) .EQ. 'none') THEN
+             ! Nothing should be done
+
+          ELSE
+             WRITE(numout,*) 'ERROR: senescence type is not known - 4'
+             CALL ipslerr_p(3,'stomate_turnover',&
+                  'turnover: senescence type not known','case 4','')
+          
+          ENDIF
+
+          ! Debug
+          IF (ivm .EQ. test_pft .AND. printlev_loc >= 4) THEN
+             WRITE(numout,*) 'phenology, shed_rest, ',shed_rest(:)
+          ENDIF
+          !-
+       
+       ENDIF ! is_tree(ivm)
+
+       !! 5.3 Reset the leaf age structure
+       !  The leaf fraction and leaf age of the different leaf
+       !  age classes is set to zero.
+       DO ilage = 1, nleafages
+          WHERE ( shed_rest(:) )
+             leaf_age(:,ivm,ilage) = zero
+             leaf_frac(:,ivm,ilage) = zero
+          ENDWHERE
+       ENDDO
+    ENDDO  ! loop over PFTs
+    
+!! 6. 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(:,ivm) 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(:,ivm,ileaf,icarbon) and 
+       ! the fruit biomass ::biomass(:,ivm,ifruit,icarbon). The daily amount
+       ! consumed equals the biomass multiplied by 1 day divided by the time
+       ! constant ::herbivores(:,ivm).
+       DO ivm = 2,nvm ! Loop over # PFTs
+         IF ( is_tree(ivm) ) THEN
+             ! Debug
+             IF (ivm .EQ. test_pft .AND. printlev_loc >= 4) THEN
+                WRITE(numout,*) 'herbivores, ',herbivores
+             ENDIF
+             !-
+             ! For trees: only the leaves and fruit carbon pools are affected
+             ! No time to re-allocate nitrogen during browsing
+             !+++CHECK+++
+             ! Why is root herbivory not accounted for. Could be difficult
+             ! to parameterize but if leaf browsing is accounted for, there
+             ! is no reason to ignore root browsing
+             init_biomass(:) = SUM(circ_class_biomass(:,ivm,:,ileaf,icarbon)*&
+                circ_class_n(:,ivm,:),2)
+             DO iele=1, nelements
+                ! Turnover (gC tree-1)
+                DO ij =2,3 !ileaf, ifruit
+                    ipar=parts(ij)
+                    dturnover(:,:) = zero
+                    DO icirc=1, ncirc
+                        WHERE (init_biomass(:) .GT. zero .AND.herbivores(:,ivm) .GT. min_stomate)
+                            ! Tree Circ level turnover (gC tree-1):
+                            dturnover(:,icirc) = circ_class_biomass(:,ivm,icirc,ipar,iele) * &
+                                dt/herbivores(:,ivm)
+                        ENDWHERE
+                    ENDDO
+                    !the stand level turnover (gC m-2):
+                    turnover(:,ivm,ipar,iele) = turnover(:,ivm,ipar,iele)+ &
+                        SUM(dturnover(:,:)*circ_class_n(:,ivm,:),2)
+                    ! Update circ_class_biomass
+                    circ_class_biomass(:,ivm,:,ipar,iele) = &
+                        circ_class_biomass(:,ivm,:,ipar,iele)-dturnover(:,:)
+                ENDDO
+             ENDDO
+
+          ELSEIF (.NOT. is_tree(ivm)) THEN 
+
+             init_biomass(:) = circ_class_biomass(:,ivm,1,ileaf,icarbon)*&
+                circ_class_n(:,ivm,1)
+             DO iele=1, nelements
+                ! Turnover (gC tree-1): leaves, roots and fruit
+                DO ij =2,4 !ileaf, ifruit, isapabove
+                    ipar=parts(ij)
+                    dturnover(:,:) = zero
+                    WHERE (init_biomass(:) .GT. zero .AND. herbivores(:,ivm) .GT. min_stomate)
+                        ! Tree Circ level turnover (gC tree-1):
+                        dturnover(:,1) = circ_class_biomass(:,ivm,1,ipar,iele)* &
+                            dt/herbivores(:,ivm)
+                    ENDWHERE
+                    !the stand level turnover (gC m-2):
+                    turnover(:,ivm,ipar,iele) = turnover(:,ivm,ipar,iele)+&
+                        SUM(dturnover(:,:)*circ_class_n(:,ivm,:),2)
+                    ! Update circ_class_biomass
+                    circ_class_biomass(:,ivm,1,ipar,iele) = &
+                        circ_class_biomass(:,ivm,1,ipar,iele)-dturnover(:,1)
+                ENDDO
+             ENDDO
+             
+          ELSE
+             WRITE(numout,*) 'ERROR: vegetation type is not known'
+             CALL ipslerr_p(3,'stomate_turnover',&
+                  'vegetation type is not known','','')
+             
+          ENDIF  ! tree/grass?
+       ENDDO    ! loop over PFT
+    ENDIF ! end herbivores
+
+ !! 7. Fruit turnover for trees
+    !  Fruit turnover for trees: trees simply lose their fruits
+    !  with a time constant ::tau_fruit(ivm), 
+    !  that is set to 90 days for all PFTs in ::constants_mtc
+    !  Again, we assume that the trees do not lose either of the 
+    !  reserve pools (ilabile or icarbres).
+    DO iele = 1,nelements
+       DO ivm = 2,nvm ! Loop over # PFTs
+          IF ( is_tree(ivm) ) THEN
+             ! Stand level (gC m-2)
+             dturnover(:,:) = circ_class_biomass(:,ivm,:,ifruit,iele) * dt / tau_fruit(ivm)
+             turnover(:,ivm,ifruit,iele) = turnover(:,ivm,ifruit,iele) + &
+                SUM(circ_class_n(:,ivm,:)*dturnover(:,:),2)
+             circ_class_biomass(:,ivm,:,ifruit,iele) = &
+                circ_class_biomass(:,ivm,:,ifruit,iele)- dturnover(:,:)
+          ENDIF ! is_tree 
+       ENDDO  ! loop over PFTs
+    ENDDO ! nelements
+
+ !! 8. Conversion of sapwood to heartwood
+
+    !  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(ivm) in years. Note that this biomass conversion
+    !  is not added to "turnover" as the biomass is not lost!
+    DO ivm = 2,nvm ! Loop over # PFTsi
+       IF ( is_tree(ivm) ) THEN
+          ! For the recalculation of age in 9.2 (in case the vegetation is
+          ! not dynamic ie. ::ok_dgvm is FALSE), the heartwood above and
+          ! below is stored in ::hw_old(:).
+          IF ( .NOT. ok_dgvm ) THEN
+             hw_old(:) = SUM(circ_class_biomass(:,ivm,:,iheartabove,icarbon),2) + &
+                  SUM(circ_class_biomass(:,ivm,:,iheartbelow,icarbon),2)
+             sw_old(:) = SUM(circ_class_biomass(:,ivm,:,isapabove,icarbon),2) + &
+                  SUM(circ_class_biomass(:,ivm,:,isapbelow,icarbon),2) 
+          ENDIF
+
+          !! 8.1 Calculate the rate of sapwood to heartwood conversion 
+          !  Calculate the rate of sapwood to heartwood conversion with
+          !  the time constant ::tau_sap(ivm) and update aboveground and
+          !  belowground sapwood ::biomass(:,ivm,isapabove) and
+          !  ::biomass(:,ivm,isapbelow) and heartwood
+          !  ::biomass(:,ivm,iheartabove) and ::biomass(:,ivm,iheartbelow).
+            ! Tree level above and belowground (gC tree-1)
+          DO iele = 1,nelements
+            DO icirc = 1,ncirc
+                circ_class_biomass(:,ivm,icirc,iheartabove,iele) =  &
+                    circ_class_biomass(:,ivm,icirc,iheartabove,iele) + &
+                    circ_class_biomass(:,ivm,icirc,isapabove,iele) * dt / &
+                    tau_eff_sap(:,ivm)
+                circ_class_biomass(:,ivm, icirc,isapabove,iele) = &
+                    circ_class_biomass(:,ivm, icirc,isapabove,iele) * &
+                    (un - dt / tau_eff_sap(:,ivm)) 
+                circ_class_biomass(:,ivm,icirc,iheartbelow,iele) = &
+                    circ_class_biomass(:,ivm, icirc,iheartbelow,iele) + &
+                    circ_class_biomass(:,ivm, icirc,isapbelow,iele) * dt / &
+                    tau_eff_sap(:,ivm)
+                circ_class_biomass(:,ivm, icirc,isapbelow,iele) = &
+                    circ_class_biomass(:,ivm, icirc,isapbelow,iele) * &
+                    (un - dt / tau_eff_sap(:,ivm))
+            ENDDO
+          ENDDO
+          !! 8.2 If the vegetation is not dynamic, the age of the plant
+          !!     is decreased. 
+          !  The updated heartwood, the sum of new heartwood above and new
+          !  heartwood below after converting sapwood to heartwood, is saved
+          !  as ::hw_new(:). Creation of new heartwood decreases the age of
+          !  the plant with a factor that is determined by: old heartwood
+          !  ::hw_old(:) divided by the new heartwood ::hw_new(:)
+          IF ( .NOT. ok_dgvm ) THEN
+             hw_new(:) = SUM(circ_class_biomass(:,ivm,:,iheartabove,icarbon),2) + &
+                  SUM(circ_class_biomass(:,ivm,:,iheartbelow,icarbon),2)
+             sw_new(:) = SUM(circ_class_biomass(:,ivm,:,isapabove,icarbon),2) + &
+                  SUM(circ_class_biomass(:,ivm,:,isapbelow,icarbon),2)
+
+             WHERE ( hw_new(:) .GT. zero )
+                age(:,ivm) = age(:,ivm) * 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 xios_orchidee_send_field("HERBIVORES",herbivores)
+    CALL xios_orchidee_send_field("LEAF_AGE",leaf_meanage)
+    
+    CALL histwrite_p (hist_id_stomate, 'LEAF_AGE', itime, &
+         leaf_meanage, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HERBIVORES', itime, &
+         herbivores, npts*nvm, horipft_index)
+
+ !! 9. Check numerical consistency of this routine
+
+    IF (err_act.GT.1) THEN
+
+       ! 9.1 Check surface area
+       CALL check_surface_area("stomate_turnover", npts, veget_cov_max_begin, &
+            veget_cov_max,'pft')
+
+       ! 9.2 Calculate final biomass
+       pool_end(:,:,:) = zero
+       DO ipar = 1,nparts
+          DO iele = 1,nelements
+            DO icirc =1, ncirc
+                pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                    (circ_class_biomass(:,:,icirc,ipar,iele) * &
+                    circ_class_n(:,:,icirc)* veget_cov_max(:,:))
+            ENDDO
+            pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                (turnover(:,:,ipar,iele) * veget_cov_max(:,:))
+
+          ENDDO
+       ENDDO
+
+       ! The biomass harvest pool is expressed in gC pixel-1 So, it 
+       ! shouldn't be multiplied by veget_cov_max but it should be divided
+       ! by pixel_area to obtain gC m-2.
+       DO ivm = 1,nvm
+          DO iele = 1,nelements
+             pool_end(:,ivm,iele) = pool_end(:,ivm,iele) + &
+                  SUM(harvest_pool(:,ivm,:,iele),2) / &
+                  pixel_area(:)
+          ENDDO
+       ENDDO
+
+       !! 9.3 Calculate components of the mass balance
+       check_intern(:,:,iatm2land,:) = zero
+       check_intern(:,:,iland2atm,:) = -un * zero
+       check_intern(:,:,ilat2out,:) = zero
+       check_intern(:,:,ilat2in,:) = -un * zero
+       check_intern(:,:,ipoolchange,:) = &
+            un * (pool_end(:,:,:) - pool_start(:,:,:))
+       closure_intern(:,:,:) = zero
+       DO imbc = 1,nmbcomp
+          DO iele=1,nelements
+             ! Debug
+             IF (printlev_loc>=4) THEN
+                WRITE(numout,*) 'check_intern, ivm, imbc, iele, ', imbc, &
+                     iele, check_intern(:,test_pft,imbc,iele)
+             ENDIF
+             !-
+             closure_intern(:,:,iele) = closure_intern(:,:,iele) + &
+                  check_intern(:,:,imbc,iele)
+          ENDDO
+       ENDDO
+       
+       ! 9.4 Check mass balance closure
+       CALL check_mass_balance("stomate_turnover", closure_intern, npts, &
+            pool_end, pool_start, veget_cov_max,'pft')
+      
+    ENDIF ! err_act.GT.1
+    
+    IF(printlev>=2) WRITE(numout,*) 'Leaving turnover'
+
+  END SUBROUTINE turn_over
+
+END MODULE stomate_turnover
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_vmax.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_vmax.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_vmax.f90	(revision 6412)
@@ -0,0 +1,354 @@
+! =================================================================================================================================
+! MODULE 	: stomate_vmax
+!
+! CONTACT	: orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        calculates the leaf efficiency.
+!!	
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN		:
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ =================================================================================================================================
+
+MODULE stomate_vmax
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC vmax, vmax_clear
+
+  ! first call
+  LOGICAL, SAVE                                              :: firstcall_vmax = .TRUE.
+!$OMP THREADPRIVATE(firstcall_vmax)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE	: vmax_clear
+!!
+!>\BRIEF	  Flag setting 
+!!
+!!\n DESCRIPTION: This subroutine sets flags ::firstcall_vmax, to .TRUE., and therefore activates   
+!!		  section 1.1 of the ::vmax subroutine which writes messages to the output. \n
+!!		  This subroutine is called at the end of the subroutine ::stomate_clear, in the 
+!!		  module ::stomate.
+!!
+!! RECENT CHANGE(S):None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::firstcall_vmax
+!!
+!! REFERENCE(S)  : None 
+!!
+!! FLOWCHART     : None
+!! \n		  
+!_ =================================================================================================================================
+
+  SUBROUTINE vmax_clear
+    firstcall_vmax=.TRUE.
+  END SUBROUTINE vmax_clear
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : vmax
+!!
+!>\BRIEF         This subroutine computes vcmax photosynthesis parameters 
+!! given optimal vcmax parameter values and a leaf age-related efficiency.
+!!
+!! DESCRIPTION (functional, design, flags): 
+!! Leaf age classes are introduced to take into account the fact that photosynthetic activity depends on leaf age
+!! (Ishida et al., 1999). There are \f$nleafages\f$ classes (constant defined in stomate_constants.f90).
+!! This subroutine first calculates the new age of each leaf age-class based on fraction of leaf 
+!! that goes from one to another class.                                              
+!! Then calculation of the new fraction of leaf in each class is performed.      
+!! Last, leaf efficiency is calculated for each PFT and for each leaf age class.
+!! vcmax is defined as vcmax25 and vjmax_opt weighted by a mean leaf
+!! efficiency. vcmax25 is PFT-dependent constants defined in constants_mtc.f90.
+!!
+!! This routine is called once at the beginning by stomate_var_init and then at each stomate time step by stomateLpj.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): vcmax
+!!
+!! REFERENCE(S)	: 
+!! - Ishida, A., A. Uemura, N. Koike, Y. Matsumoto, and A. Lai Hoe (1999),
+!! Interactive effects of leaf age and self-shading on leaf structure, photosynthetic
+!! capacity and chlorophyll fluorescence in the rain forest tree,
+!! dryobalanops aromatica, Tree Physiol., 19, 741-747
+!!
+!! FLOWCHART    : None
+!!
+!! REVISION(S)	: None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE vmax (npts, dt, &
+       leaf_age, leaf_frac, &
+       vcmax, nue)
+
+    !
+    !! 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)              :: nue                     !! Nitrogen use Efficiency with impact of leaf age (umol CO2 (gN)-1 s-1) 
+    !
+    !! 0.3 Modified variables
+    !
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age                !! Leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac               !! fraction of leaves in leaf age 
+                                                                                          !! classes 
+                                                                                          !! (unitless)
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std), DIMENSION(npts)                               :: leaf_efficiency         !! leaf efficiency (vcmax/vcmax25)
+                                                                                          !! (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages)                 :: d_leaf_frac             !! turnover between age classes
+                                                                                          !! (unitless)
+    REAL(r_std), DIMENSION(npts,nleafages)                     :: leaf_age_new            !! new leaf age (days)
+    REAL(r_std), DIMENSION(npts)                               :: sumfrac                 !! sum of leaf age fractions, 
+                                                                                          !! for normalization
+                                                                                          !! (unitless)
+    REAL(r_std), DIMENSION(npts)                               :: rel_age                 !! relative leaf age (age/critical age)
+                                                                                          !! (unitless)
+    INTEGER(i_std)                                             :: j,m                     !! indices (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering vmax'
+
+    !
+    !! 1 Initialization
+    !
+
+    !
+    !! 1.1 first call: info about flags and parameters.
+    !
+
+    IF ( firstcall_vmax ) THEN
+
+       WRITE(numout,*) 'vmax:'
+
+       WRITE(numout,*) '   > offset (minimum vcmax/vmax_opt):' , vmax_offset
+       WRITE(numout,*) '   > relative leaf age at which vmax reaches vcmax_opt:', leafage_firstmax 
+       WRITE(numout,*) '   > relative leaf age at which vmax falls below vcmax_opt:', leafage_lastmax
+       WRITE(numout,*) '   > relative leaf age at which vmax reaches its minimum:', leafage_old
+
+       firstcall_vmax = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    vcmax(:,:) = zero
+    nue(:,:) = 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
+       nue(:,j) = zero 
+
+       ! sum up over the different age classes
+       IF (ok_dgvm .AND. pheno_type(j)==1 .AND. leaf_tab(j)==2) THEN
+          ! pheno_typ=evergreen and leaf_tab=needleleaf
+          vcmax(:,j) = Vcmax25(j)
+
+       ELSE 
+          ! for deciduous tree
+          DO m = 1, nleafages       ! Loop over age classes
+
+             !
+             !! 3.1 efficiency in each of the age classes
+             !!     it varies from vmax_offset to 1 
+             !!     linearly increases from vmax_offset to 1 for 0 < rel_age < leafage_firstmax
+             !!     is 1 when leafage_firstmax < rel_age < leafage_lastmax
+             !!     linearly decreases from 1 to vmax_offset for leafage_lastmax < rel_age < leafage_firstmax
+             !!     vmax_offset for rel_age >= leafage_old
+             !!     (Ishida et al., 1999)
+             rel_age(:) = leaf_age(:,j,m) / leafagecrit(j)
+
+             leaf_efficiency(:) = MAX( vmax_offset, MIN( un, &
+                  vmax_offset + (un - vmax_offset) * rel_age(:) / leafage_firstmax, &
+                  un - (un - vmax_offset) * ( rel_age(:) - leafage_lastmax ) / &
+                  ( leafage_old - leafage_lastmax ) ) )
+             !
+             !! 3.2 add to mean vmax
+             !             
+             vcmax(:,j) = vcmax(:,j) + Vcmax25(j) * leaf_efficiency(:) * leaf_frac(:,j,m)
+
+
+             nue(:,j)   = nue(:,j) + nue_opt(j) * leaf_efficiency(:) * leaf_frac(:,j,m) 
+          ENDDO     ! loop over age classes
+       ENDIF
+
+    ENDDO       ! loop over PFTs
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving vmax'
+
+  END SUBROUTINE vmax
+
+END MODULE stomate_vmax
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_windthrow.f90
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_windthrow.f90	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/stomate_windthrow.f90	(revision 6412)
@@ -0,0 +1,1973 @@
+! =================================================================================================================================
+! MODULE        : stomate_wind
+!
+! CONTACT	: yiyingchen@gate.sinica.edu.tw
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        : Calculates critical wind speed for tree damage for each half-hourly period of the simulation.
+!                 This wind speed can be compared to the actual wind speed to decide whether a tree damage occurs.
+!!
+!!\streamlining_n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN           :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-DOFOCO/ORCHIDEE/src_stomate/stomate_windthrow.f90 $ 
+!! $Date: 2015               -01-22 13:41:13 +0100 (mer., 22 janv. 2014) $
+!! $Revision:                   1831 $
+!! \streamlining_n
+!_ ================================================================================================================================
+
+MODULE stomate_windthrow
+
+  ! modules used:
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE pft_parameters_var
+  USE function_library, ONLY: wood_to_dia, wood_to_height, &
+       wood_to_cv_eff, cc_to_lai, cc_to_biomass
+
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE 
+  PUBLIC wind_damage
+!!$  wind_clear, streamlining, calculate_force, calculate_bending_moment, &
+!!$       calculate_cws, calculate_wind_process, elevate
+
+  LOGICAL, SAVE                   :: firstcall = .TRUE.        !! first call 
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : wind_clear 
+!!
+!>\BRIEF        Set the firstcall flag to .TRUE. and activate initialization
+!! 
+!_ ================================================================================================================================
+
+  SUBROUTINE wind_clear
+    firstcall = .TRUE.
+  END SUBROUTINE wind_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE     : wind_damage
+!!
+!>\BRIEF          This subroutine calculates the critical wind speeds for both uprooting and stem breakage
+!!                for each half-hourly period of the simulation. The algorithm follows Barry Gardiner's wind 
+!!                damage risk model called GALES (Hale et al. 2015).
+!! 
+!! DESCRIPTION	: The purpose of this module is to describe the actual sensitivity of a given PFT to the wind that is present
+!! at the same pixel. For each circumference class in each PFT, two critical wind speed values (CWS) are calculated in every
+!! half-hourly time step by this subroutine, following the approach of differentiating two types of wind damage of trees:
+!! - uprooting (the whole tree is removed from the soil together with its root plate)
+!! - stem breakage (the root plate and the bottom part of the stem remains attached to the ground).
+!! Whichever threshold (i.e. CWS) is reached first for a tree, the according damage type occurs in the model.
+!!
+!! The module completes the following tasks:
+!! 1. Calculates...
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: Critical wind speed for stem breakage 10 m above the zero-plane displacement (m/s): U_Break_10
+!!                             Critical wind speed for tree overturn 10 m above the zero-plane displacement (m/s): U_Overturn_10
+!!
+!! REFERENCES    :
+!! - Hale, S., Gardiner, B., Nicoll, B., Taylor, P., and Pizzirani, S. (2015). Comparison and validation of three versions
+!! of a forest wind risk model. Environmental Modelling and Software. In Press.
+!! ...
+!!
+!! FLOWCHART     : None
+!! \streamlining_n 
+!_ ================================================================================================================================
+  
+  SUBROUTINE wind_damage (npts, nlevels_tot, circ_class_biomass, &  
+       veget_cov_max, circ_class_n, wind_speed_daily, plant_status, &
+       resolution, circ_class_kill, harvest_5y_area, forest_managed, &
+       soil_temp_daily)
+    
+!root_dens, senescence, &
+    !   circ_class_biomass, circ_class_n, snowdepth, sph, gap_size, snow_depth) 
+    ! OUTPUT VARIABLES SHOULD BE LISTED HERE, AS WELL.
+
+  IMPLICIT NONE
+
+
+
+ !! 0. Variable declarations
+
+ !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                       :: npts                         !! Domain size @tex $(unitless)$ @endtex
+!    INTEGER(i_std), DIMENSION(:), INTENT(in)         :: njsc                         !! Index of the dominant soil textural class in
+                                                                                     !! the grid cell @tex $(unitless)$ @endtex
+    INTEGER(i_std), INTENT(in)                       :: nlevels_tot                  !! Total level numbers in photosynthesis
+    INTEGER(i_std), DIMENSION (:,:), INTENT(in)      :: forest_managed               !! forest management flag (is the forest
+                                                                                     !! being managed?)
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)    :: circ_class_biomass           !! Biomass in of an individual tree in each circ class
+                                                                                     !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)        :: circ_class_n                 !! Number of trees within each circumference
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: veget_cov_max                    !! "maximal" coverage fraction of a PFT on the ground
+                                                                                     !! May sum to less than unity if the pixel has nobio 
+                                                                                     !! area. (unitless, 0-1)
+!    REAL(r_std), DIMENSION(:), INTENT(in)            :: snow                         !! Snow mass @tex $ (kg m^{-2})$ @endtex
+!    LOGICAL, DIMENSION(:,:), INTENT(in)              :: senescence                   !! The PFT is senescent 
+    
+! ++++ the senescence is no longer use in CN-CAN and it is replaced by plant_status
+     REAL(r_std), DIMENSION(:,:), INTENT(in)          :: plant_status                !! Growth and phenological status of the plant
+! +++
+
+!    REAL(r_std), DIMENSION (:,:,:), INTENT(in)       :: z_level_photo               !! Level height of photosynthesis layers (m)
+!                                                                                    !! Dimension in (npts,nvm, nlevels_tot)
+!    REAL(r_std), DIMENSION (:,:,:,:), INTENT(in)     :: biomass                      !! Biomass @tex $(gC m^{-2})$ @endtex  
+!
+!    CN-CAN didn't use biomass anymore, so we need to calculate the biomass from circ_class_biomass
+ 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: resolution                   !! The length in m of each grid-box in X and Y axis
+                                                                                     !! Dimension in (npts,2) 1:X and 2:Y
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)        :: harvest_5y_area              !! total harvested area in the last 5 years
+                                                                                     !! Dimension(npts,nvm,wind_years)
+    REAL(r_std), DIMENSION(:), INTENT(in)            :: soil_temp_daily              !! Daily maximum soil temperature at 0.8 meter below ground (K) 
+ ! 0.2 Output variables
+    
+    ! OUTPUT VARIABLES TO BE DECLARED HERE
+    ! We need to output a flag to indicate the damage type which is classified
+    ! into no damage or damaged (overturning or branch damage)
+ 
+ 
+ !! 0.3 Modified variables (INTENT(inout))
+
+    REAL(r_std), DIMENSION(npts,nvm,ncirc,nfm_types,ncut_times), &
+                                         INTENT(inout) :: circ_class_kill        !! Number of trees within a circ that needs
+                                                                                 !! to be killed @tex $(ind m^{-2})$ @endtex  
+    REAL(r_std), DIMENSION(npts), INTENT(inout)  :: wind_speed_daily             !! Daily maximum wind speed at 2 meter (ms-1)
+!! 0.4 Local variables
+    CHARACTER(30)                                :: var_name                     !! To store variable names for I/O
+    INTEGER(i_std)                               :: ibdl,ipts,ivm,icir,i,iele    !! Index for the loops 
+    INTEGER(i_std), DIMENSION(npts)              :: soil_type                    !! Soil types: 
+                                                                                 !!  1. Free-draining mineral soils;
+                                                                                 !!  2. Gleyed mineral soils; 
+                                                                                 !!  3. Peaty mineral soils; and 
+                                                                                 !!  4. Deep Peats
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: virtual_circ_class_n         !! Virtual number of trees within each circumference
+    REAL(r_std), DIMENSION(ncirc,60)             :: section_height               !! The height of the bottom of the 1-m sections 
+                                                                                 !! of the mean tree @tex $(m)$ @endtex. 60 is the
+                                                                                 !! max number of sections thus max tree height is 60m
+!    REAL(r_std), DIMENSION(npts,nvm,ncirc,60)    :: section_diam                 !! The diameter of the 1-m sections of the mean  
+    REAL(r_std), DIMENSION(ncirc,60)             :: branch_width                 !! Width of canopy) of the 1-m sections of the mean 
+                                                                                 !! tree @tex $(m)$ @endtex 60 is the max number of 
+                                                                                 !! sections thus max tree height is 60m
+    REAL(r_std), DIMENSION(nbdl,nvm)             :: root_dens                    !! Root density per soil layer (what proportion
+                                                                                 !! of the root system is found at the given layer)
+    REAL(r_std), DIMENSION(nbdl+1)               :: z_soil                       !! Variable to store depth of the different
+                                                                                 !! soil layers (m)
+    REAL(r_std), DIMENSION(nvm)                  :: rpc                          !! scaling factor for integral
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: mean_dbh                     !! Diameter at breast height (dbh) of the mean tree
+                                                                                 !! of the circumference-class @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: mean_height                  !! Height of the mean tree of the given dbh-class 
+                                                                                 !! @tex $(m)$ @endtex
+!    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: zp_disp_height               !! zero-plane displacement height (m)
+!    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: roughness_length             !! roughness_length (m)
+
+    REAL(r_std), DIMENSION(ncirc)                :: lai                          !! Leaf area index @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: canopy_breadth               !! Canopy breadth (width of canopy) @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: canopy_depth                 !! Canopy depth (height of canopy) @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: canopy_height                !! The height of the starting point of the canopy from 
+                                                                                 !! below @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: mid_canopy                   !! The middle height of the canopy @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: mean_dbh_height              !! The height of the diameter (by default it is at 
+                                                                                 !! breast height = 1.3 m) @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: snow_mass                    !! Weight of the snow on the tree @tex $(kg)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: diameter_c2                  !! Variable for calculating diameters 
+                                                                                 !! @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: diameter_canopy_base         !! Diameter at the base of the canopy 
+                                                                                 !! @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: diameter_c1                  !! Variable for calculating diameters 
+                                                                                 !! @tex $(unitless)$ @endtex
+!!$    REAL(r_std), DIMENSION(ncirc)                :: no_of_sections               !! The number of one-meter sections that the mean tree 
+!!$                                                                                 !! has @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: crown_depth                  !! Crown depth of the tree in each circumference class 
+    REAL(r_std), DIMENSION(ncirc)                :: crown_width                  !! Crown width of the mean tree (m)  
+    REAL(r_std), DIMENSION(ncirc)                :: crown_volume                 !! Crown volume of the mean tree @tex $(m^{3})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: crown_mass                   !! Mass of the mean tree crown @tex $(kg)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: stem_mass                    !! Mass of the mean tree stem @tex $(kg)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: current_spacing              !! Spacing between trees in the given dbh-class 
+                                                                                 !! @tex $(m)$ @endtex
+    INTEGER(i_std), DIMENSION(npts,nvm)          :: rooting_depth                !! Rooting depth of the mean tree (three categories;
+                                                                                 !! 1: shallow, 2: deep, 3:average 
+                                                                                 !! See constantes_soil_var.f90 for the definitions
+!!$    REAL(r_std)                                  :: canopy_density               !! Density of the tree canopy, i.e. of the
+!!$                                                                                 !! branches and leaves @tex $(kg/m^{3})$ @endtex
+    REAL(r_std)                                  :: streamlining_c               !! Streamlining parameter. @tex $(unitless)$ @endtex. 
+                                                                                 !! Streamlining is the change of shape of the crowns 
+                                                                                 !! due to wind.
+    REAL(r_std)                                  :: streamlining_n               !! Streamlining parameter. @tex $(unitless)$ @endtex. 
+                                                                                 !! Streamlining is the change of shape of the crowns 
+                                                                                 !! due to wind.
+    REAL(r_std)                                  :: streamlining_rb              !! Streamlining parameter. @tex $(unitless)$ @endtex. 
+                                                                                 !! Streamlining is the change of shape of the crowns 
+                                                                                 !! due to wind.    
+
+    REAL(r_std), DIMENSION(ncirc)                :: area_timber_removals_5_years !! Area of the total timber removal in the
+                                                                                 !! previous 5 year @tex $(m^{2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                 :: area_icir                    !! The total area of the circumference class @tex $(m^{2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: tree_heights_from_edge       !! Width of the forest edge area, i.e. area_closer (in number of tree heights)
+                                                                                 !! @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(npts)                 :: n_gap                        !! The number of gaps with an area of clear_cut_max @tex $(unitless)$ @endtex
+    REAL(r_std)                                  :: length_side_gap              !! The length of one side of the square-shaped gap @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: area_around_gap              !! The framing edge area around the gap with different gustiness
+                                                                                 !! @tex $(m^{2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: area_total_closer            !! The total area of forest edge areas affected by wind @tex $(m^{2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: area_total_further           !! The total area of forest without edge areas @tex $(m^{2})$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: ratio_spacing_height         !! Ratio of tree height and tree spacing @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: gap_size                     !! The length (width of the cross-section) of the gap @tex $(m)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: ratio_gap_height             !! Ratio of gap size and tree height @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: mean_gap_factor              !! Variable used for calculating gustiness @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: max_gap_factor               !! Variable used for calculating gustiness @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: term_a                       !! Variable used for calculating gustiness @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: term_b                       !! Variable used for calculating gustiness @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: old_gust_closer              !! Variable used for calculating gustiness @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: old_gust_further             !! Variable used for calculating gustiness @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: old_gust_edge                !! Variable used for calculating gustiness @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: old_gust_edge_gap            !! Variable used for calculating gustiness @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: new_gust_closer              !! Variable used for calculating gustiness @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: new_gust_further             !! Variable used for calculating gustiness @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: new_gust_edge                !! Variable used for calculating gustiness @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: new_gust_edge_gap_closer     !! Variable used for calculating gustiness @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: new_gust_edge_gap_further    !! Variable used for calculating gustiness @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: mean_bm_gust_factor_closer   !! Mean bending moment of the forest edge area (for calculating
+                                                                                 !! the edge factor) @tex $(Nm/kg)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: mean_bm_gust_factor_further  !! Mean bending moment of the inner forest area (for calculating
+                                                                                 !! the edge factor) @tex $(Nm/kg)$ @endtex
+    REAL(r_std), DIMENSION(ncirc)                :: edge_factor                  !! The ratio of the mean bending moment in the forest edge area 
+                                                                                 !! and mean bending moment in the inner forest area
+                                                                                 !! @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: gust_factor_closer           !! Gust factor for calculating the critical wind speed of the forest
+                                                                                 !! edge area @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: gust_factor_further          !! Gust factor for calculating the critical wind speed of the inner
+                                                                                 !! forest area @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: g_closer                     !! Gustiness of the forest edge area @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: g_further                    !! Gustiness of the inner forest area @tex $(unitless)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)             :: overturning_moment_multiplier !! Overturning moment multiplier representing the effects of species,
+                                                                                  !! soil type, soil depths and senescence @tex $(Nm/kg)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: max_overturning_moment       !! The maximum overturning moment the mean tree can withstand
+                                                                                 !! @tex $(Nm/kg)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: max_breaking_moment          !! The maximum breaking moment the mean tree can withstand
+                                                                                 !! @tex $(Nm/kg)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: overturning_moment_closer    !! The maximum overturning moment the mean tree can withstand in the
+                                                                                 !! forest edge area with gustiness taken into account @tex $(Nm/kg)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: overturning_moment_further   !! The maximum overturning moment the mean tree can withstand in the
+                                                                                 !! inner forest area with gustiness taken into account @tex $(Nm/kg)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: breaking_moment_closer       !! The maximum breaking moment the mean tree can withstand in the
+                                                                                 !! forest edge area with gustiness taken into account @tex $(Nm/kg)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: breaking_moment_further      !! The maximum breaking moment the mean tree can withstand in the
+                                                                                 !! inner forest area with gustiness taken into account @tex $(Nm/kg)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: cws_break_closer             !! Critical wind speed for stem breakage in the forest edge area
+                                                                                 !! @tex $(m/s; mean hourly wind speed)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: cws_break_closer_10          !! Critical wind speed for stem breakage in the forest edge area
+                                                                                 !! @tex $(m/s; mean hourly wind speed)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: cws_overturn_closer          !! Critical wind speed for overturning in the forest edge area
+                                                                                 !! @tex $(m/s; mean hourly wind speed)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: cws_overturn_closer_10       !! Critical wind speed for overturning in the forest edge area
+                                                                                 !! @tex $(m/s; mean hourly wind speed)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: cws_final_closer             !! The critical wind speed of the final form of damage (breakage / uprooting)
+                                                                                 !! in the forest edge area @tex $(m/s; mean hourly wind speed)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: d_h_ratio                    !! Array for storing the stand spacing and tree height ratio for output (-)
+    REAL(r_std), DIMENSION(npts)                 :: wind_speed_actual            !! The actual wind speed over the pixel
+                                                                                 !! @tex $(m/s; mean hourly wind speed)$ @endtex
+    LOGICAL                                      :: wind_damage_type_uprooting_closer   !! The final form of damage (breakage / uprooting) in the forest edge area
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: wind_damage_rate_closer      !! Damage rate (%) in the forest edge area in case of damage
+                                                                                 !! @tex $(0-1)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: cws_break_further            !! Critical wind speed for stem breakage in the inner forest area
+                                                                                 !! @tex $(m/s; mean hourly wind speed)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: cws_break_further_10         !! Critical wind speed for stem breakage in the inner forest area
+                                                                                 !! @tex $(m/s; mean hourly wind speed)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: cws_overturn_further         !! Critical wind speed for overturning in the inner forest area
+                                                                                 !! @tex $(m/s; mean hourly wind speed)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: cws_overturn_further_10      !! Critical wind speed for overturning in the inner forest area
+                                                                                 !! @tex $(m/s; mean hourly wind speed)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: cws_final_further            !! The critical wind speed of the final form of damage (breakage / uprooting)
+                                                                                 !! in the inner forest area @tex $(m/s; mean hourly wind speed)$ @endtex
+    LOGICAL                                      :: wind_damage_type_uprooting_further  !! The final form of damage (breakage / uprooting) in the inner forest area
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: wind_damage_rate_further     !! Damage rate (%) in the forest edge area in case
+                                                                                 !! of damage in the inner forest area @tex $(0-1)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: z0_wind                      !! surface roughness calculated from the subroutine streamlining()
+    REAL(r_std), DIMENSION(npts,nvm,ncirc)       :: d_wind                       !! zero plane displacement height calculated from the subroutine streamlining() 
+    INTEGER(i_std), DIMENSION(npts,nvm,ncirc)    :: wind_damage_type_closer      !! Integer store the wind damage type for closer area  ibreakage=1, ioverturning=2
+    INTEGER(i_std), DIMENSION(npts,nvm,ncirc)    :: wind_damage_type_further     !! Integer store the wind damage type for further area
+    INTEGER(i_std)                               :: printlev_loc                 !! Integer for print out for windthrow module   
+    REAL(r_std)                                  :: crown_top                    !! Temporal variable for storing the tallest tree crown height in different PFTs  
+    REAL(r_std)                                  :: crown_bottom                 !! Temporal variable for storing the smallest tree crown height in different PFTs 
+    REAL(r_std)                                  :: distance_from_force          !! The distance from the force was set to 1.3 for breakage and 0.0 for overturning
+    REAL(r_std), DIMENSION(ncirc)                :: closer_area_fraction         !! Closer area fraction 
+    REAL(r_std), DIMENSION(ncirc)                :: further_area_fraction        !! Further area fraction 
+  
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements) :: biomass  
+               
+! Temp output Variables for GALES model intercomparision
+   REAL(r_std), DIMENSION(npts,nvm,ncirc)        :: canopy_depth_out
+   REAL(r_std), DIMENSION(npts,nvm,ncirc)        :: tree_h_edge_out
+   REAL(r_std), DIMENSION(npts,nvm,ncirc)        :: mean_gap_f_out
+   REAL(r_std), DIMENSION(npts,nvm,ncirc)        :: gap_size_out
+   REAL(r_std), DIMENSION(npts,nvm,ncirc)        :: edge_factor_out  
+  
+!_ ============================================================================================================================================================================
+
+   IF (printlev>=2) WRITE(numout,*) 'Entering stomate_windthrow.f90'
+
+   ! 1.1 Initialize local printlev
+   !printlev_loc=get_printlev('windthrow')
+  
+   printlev_loc=5 
+!! 0. Initialized the values of variables
+       wind_damage_rate_closer(:,:,:) = 0.0d0
+       wind_damage_rate_further(:,:,:) = 0.0d0
+       cws_final_further(:,:,:) = 0.0d0 
+       cws_final_closer(:,:,:) = 0.0d0
+       d_h_ratio(:,:,:) = 0.0d0
+
+    !-Debug-
+    IF (printlev_loc .GT. 4) THEN
+      DO ipts = 1, npts
+         WRITE(numout,*) 'Daily maximum windspeed passed from stomate to stomate_winthrow:', wind_speed_daily(ipts)
+         WRITE(numout,*) 'Daily maximum soil temperature at 80cm below ground:', soil_temp_daily(ipts)
+    !   WRITE(numout,*) 'Initial wind damage rate closer, ', wind_damage_rate_closer(:,:,:)
+    !   WRITE(numout,*) 'Initial wind damage rate futther, ',wind_damage_rate_further(:,:,:)
+      ENDDO
+    ENDIF
+    !-
+       
+ !! 1. Getting the input variables in the required form for the actual sub-routine 
+       
+    ! The code is specific for CRU-NCEP. If a different forcing
+    ! is used, the Max Wind Ratio parameters should be adjusted
+    ! CALL ipslerr_p(2,'Wind throw module assumes that CRU-NCEP forcing is used',&
+    !   '','','')
+   
+ ! ++++++
+ ! calculate the total biomass  
+
+      
+    biomass(:,:,:,:) = cc_to_biomass(npts,nvm,circ_class_biomass,circ_class_n)
+
+
+
+    ! Looping over pixels
+    DO ipts = 1, npts 
+    
+       !! 1.1 Convert 6-hr CRU-NCEP into half-hourly wind speed     
+       ! The max_wind_ratio parameters were determined by relating fluxnet
+       ! half-hourly data to 6h CRU-NCEP data. For this reason the
+       ! parameters should be considered specific to the CRU-NCEP forcing.
+       ! The max_wind_ratio parameters were also found to depend on the 
+       ! spatial aggregation, hence, they are specific to the 0.5 degree
+       ! CRU-NCEP data (see Chen et al for details). 
+
+       ! The following relationship to convert CRU-NCEP into half-hourly
+       ! wind speeds was found:
+       ! +++CHANGE+++
+       ! externalise parameters as max_wind_ratio        
+       !wind_speed_daily(ipts) = wind_speed_daily(ipts) - &
+       !    0.077* wind_speed_daily(ipts)**2. + &
+       !    0.015 * wind_speed_daily(ipts)**3.
+       ! ++++++++++++ 
+       wind_speed_daily(ipts) = -5.922*wind_speed_daily(ipts)  &
+           + 2.051*wind_speed_daily(ipts)**2.  &
+           - 0.191*wind_speed_daily(ipts)**3. &
+           + 0.006*wind_speed_daily(ipts)**4.
+ 
+       ! In case this convertion did not result in the observed wind
+       ! damage, we kept a linear tuning parameter. Ideally, no tuning
+       ! should be applied and therefore daily_max_tune should be 1.0
+!       wind_speed_daily(ipts) = wind_speed_daily(ipts) * daily_max_tune 
+
+       wind_speed_daily(ipts) = wind_speed_daily(ipts) 
+
+     
+
+       !! 1.2 Calculate root profile 
+!       z_soil(1) = 0.
+!       z_soil(2:nbdl+1) = diaglev(1:nbdl)
+
+       ! Scaling factor for integration
+!       rpc(:) = un / ( un - EXP( -z_soil(nbdl) / humcste(:) ) )
+
+       ! Calculate root density per layer per pft
+       ! Loop over # soil layers
+!       DO ibdl = 1, nbdl
+
+!          root_dens(nbdl-ibdl,:) = rpc(:) * &
+!               ( EXP( -z_soil(ibdl)/humcste(:)) - &
+!               EXP( -z_soil(ibdl+1)/humcste(:)) )
+
+!       ENDDO ! Loop over # soil layers
+ 
+       !! 1.3 Defining the soil type
+       ! This sub-routine uses 4 types of soil for calculating the 
+       ! critical wind speed, so 12 different soil types present in 
+       ! other modules of ORCHIDEE need to be grouped into these
+       ! 4 generic types.
+
+       ! +++CHECK+++
+       ! For the moment only 3 soil types are distinguished.
+       ! Needs to be checked with all 12 USDA soil types. 
+       ! If more soil type are used it will become possible
+       ! to make use of the different soils distinguished in
+       ! the windthrow module. The code could then look as
+       ! follow:
+!        CASE (x:y)
+!          soil_type(ipts) = ifreedrainage  
+!        CASE (x:y)
+!          soil_type(ipts) = igleyed
+!        CASE (x:y)
+!          soil_type(ipts) = ipeaty
+!       CASE (x:y)
+!          soil_type(ipts) = ipeat 
+ 
+!      SELECT CASE (njsc(ipts))
+!       CASE (1:3) 
+          ! For the moment all soils are assumed to be freely draining
+          soil_type(ipts) = ifree_draining
+
+!       CASE DEFAULT
+!          CALL ipslerr_p(3, 'stomate_windthrow.f90',&
+!               'soil type is not defined','','')
+!       END SELECT
+!       !++++++++++++
+      
+       ! Looping over PFT-s
+       DO ivm = 2, nvm
+
+          ! Don't do the calculations if there is no vegetation
+          ! or the vegetation is bare soil, grass or crop
+          IF ((veget_cov_max(ipts,ivm).LT.min_stomate) .OR. .NOT.is_tree(ivm)) THEN
+             CYCLE
+          ENDIF
+
+          !! 1.4 Calculating the rooting depth
+          !  If root density (proportion of root mass) is higher 
+          !  than 3% in the 11th soil layer (1.024-2.056 m) below 
+          !  the soil surface, then we treat rooting depth as 
+          !  "deep". Otherwise, it's "shallow". Note that the 
+          !  threshold of 3% is arbitrary and it might be needed to
+          !  justify at some point in the future.
+          
+          ! +++CHANGE+++
+          ! solution: change nbdl in the index for the layer that is 
+          ! closest to 2 meters.
+          ! It was hard coded (index = 10). We don't like hard coded
+          ! even if it is unlikely that the 11-layers will change
+          ! any time soon. The depth of the 10th layer depends on
+          ! the total depth of the soil (dpu_max). Would be better
+          ! to use ::dpu_max rather than assuming the 2 m.
+          ! Also, there is new scheme being tested where nbdl may 
+          ! have changed. CHECK when using the new scheme.
+          IF (root_dens(nbdl-1,ivm) > 0.10) THEN
+
+             rooting_depth(ipts,ivm) = ideep
+
+          ELSE
+
+             rooting_depth(ipts,ivm) = ishallow
+
+          END IF
+          ! +++++++++++
+       !--Debug        
+          IF (printlev_loc >= 4) THEN
+              WRITE(numout,*) 'rooting depth ', rooting_depth(ipts,ivm)
+          ENDIF 
+ 
+
+          !!  1.5 Set crown parameters
+          !   To set crown parameters leaf mass needs to be available
+          IF (SUM(circ_class_biomass(ipts,ivm,:,ileaf,icarbon)) .GT. min_stomate) THEN
+  
+             ! There is a canopy
+             streamlining_c = streamlining_c_leaf(ivm)
+             streamlining_n = streamlining_n_leaf(ivm)
+             streamlining_rb = streamlining_rb_leaf(ivm)
+          ELSE
+
+             ! If the tree is leafless, the following parameters 
+             ! become different. The weight of leaves will be absent.
+             ! Streamlining changes as the surface of leaves is absent.
+             streamlining_c = streamlining_c_leafless(ivm)
+             streamlining_n = streamlining_n_leafless(ivm)
+             streamlining_rb = streamlining_rb_leafless(ivm)
+
+          END IF
+
+          !-Debug-
+          IF(printlev_loc .GT. 4)THEN
+             WRITE(numout,*) 'Initialisation of critical windspeed'
+             WRITE(numout,*) 'ipts, ivm, ',ipts, ivm
+             WRITE(numout,*) 'humcste, ', humcste
+             WRITE(numout,*) 'rooting depth(nbdl+1), ', z_soil
+             WRITE(numout,*) 'root_dens(nbdl,ivm), ',root_dens(:,ivm)
+             WRITE(numout,*) 'soil_type(ipts), ',soil_type(ipts)
+             WRITE(numout,*) 'rooting_depth_type,(1:deep, 2:shallow,3:average), ',&
+                  rooting_depth(ipts,ivm)
+             WRITE(numout,*) 'streamlining_c, ', streamlining_c
+             WRITE(numout,*) 'streamlining_n, ', streamlining_n
+             WRITE(numout,*) 'streamlining_rb, ', streamlining_rb
+          ENDIF
+          !-
+
+          !! 1.6 Calculate stand characteristics
+          !  Calculating diameter at breast height (dbh) in m of the
+          !  mean tree of all circ classes.
+          mean_dbh(ipts,ivm,:) = wood_to_dia(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+
+          ! Calculating the height in m of the mean tree of the given 
+          ! dbh-class using
+          mean_height(ipts,ivm,:) = wood_to_height(&
+               circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)
+          
+          ! Crown_volume is calculated as the woody biomass of an individual tree 
+          crown_volume(:) = wood_to_cv_eff( circ_class_biomass(ipts,ivm,:,:,icarbon), ivm)
+
+          ! Crown_width is calculated as(crown_vloume * 6.0/pi)^(1/3)
+          crown_width(:) =  ((crown_volume(:)*6.0)/pi)**(1.0/3.0)      
+
+          ! ORCHIDEE assumes that the crowns are spherical. Hence, width
+          ! breath and depth are all the same. Set canopy_breadth as the 
+          ! crown_width for all circumference classes          
+          canopy_breadth(:) = crown_width(:) 
+          canopy_depth(:) = crown_width(:)  
+          canopy_height(:) = mean_height(ipts,ivm,:)
+
+          !-Debug-
+          IF (printlev_loc .GT. 4) THEN
+              WRITE(numout,*) 'crown_volumn, ', crown_volume(:)
+              WRITE(numout,*) 'crown_width, ', crown_width(:)
+              WRITE(numout,*) 'crown_depth, ', canopy_depth(:)
+              WRITE(numout,*) 'canopy_height, ', mean_height(:,:,:) 
+          ENDIF   
+          !-
+          ! loop over the circ class 
+          DO icir = 1, ncirc
+
+             !! 1.6 Calculating the current tree spacing in the PFT
+             ! The current tree spacing between tree stems are calculated 
+             ! from the number of stems per hectare. circ_class_n is the 
+             ! number of stems per m2; it's converted to stems per hectare 
+             ! with m2_to_ha which has a value of 10000.
+             ! The virtual tree spacing assumes that the LAI remains
+             ! constant and the calculates how many trees of a given 
+             ! circumference class would be needed to result in the set LAI.
+             ! Because lai changes throughout the season because of leaf
+             ! fall, wood mass was used instead. Because LAI is related to 
+             ! wood mass (see allocation). The principle remains the same 
+
+! this part of code need to revised for CN-CAN for using circ
+
+          !-Debug-
+          IF (printlev_loc .GT. 4) THEN
+              WRITE(numout,*) 'biomass, isapabove, ', biomass(ipts,ivm,isapabove,icarbon)
+              WRITE(numout,*) 'biomass, iheartabove, ', biomass(ipts,ivm,iheartabove,icarbon)
+
+              WRITE(numout,*) 'circ_class_biomass, isapabove, ', &
+                               circ_class_biomass(ipts,ivm,icir,isapabove,icarbon)
+              WRITE(numout,*) 'circ_class_biomass, iheatabove, ', &
+                               circ_class_biomass(ipts,ivm,icir,iheartabove,icarbon) 
+          ENDIF   
+ 
+
+             IF (  (circ_class_biomass(ipts,ivm,icir,isapabove,icarbon) + &
+                circ_class_biomass(ipts,ivm,icir,iheartabove,icarbon)) >= zero ) THEN 
+             
+
+             virtual_circ_class_n(ipts,ivm,icir) =  &
+               (biomass(ipts,ivm,isapabove,icarbon) + &
+                biomass(ipts,ivm,iheartabove,icarbon)) / &
+               (circ_class_biomass(ipts,ivm,icir,isapabove,icarbon) + &
+                circ_class_biomass(ipts,ivm,icir,iheartabove,icarbon))
+             ELSE 
+
+              virtual_circ_class_n(ipts,ivm,icir) = zero 
+ 
+             ENDIF
+             
+
+
+
+
+             ! Now the spacing is calculated based on virtual tree numbers ( virtual_circ_class_n)      
+             IF (virtual_circ_class_n(ipts,ivm,icir) .GT. min_stomate) THEN
+                ! The original equation is current_spacing(icir) = 100.0 / &
+                ! SQRT(m2_to_ha * virtual_circ_class_n(ipts,ivm,icir))
+                ! given that m2_to_ha = 10000 it reduces to:
+                current_spacing(icir) = 1.0 / SQRT(virtual_circ_class_n(ipts,ivm,icir))
+             ELSE
+                ! In principle, we should never enter this condition. The
+                ! spacing between 2 trees equals the size of the pixel. It is 
+                ! thus empty. We defined this case such that if we do end here,
+                ! a very large cws will be calculated and the code should not
+                ! suffer from divide by zero.
+                current_spacing(icir) = (resolution(ipts,1) + resolution(ipts,2) )/2.0
+                WRITE(numout,*) 'WARNING from WINDFALL module:'
+                WRITE(numout,*) 'the current spacing set to pixel spacing:', current_spacing(icir)
+                CALL ipslerr_p(2,'Wind throw module',&
+                   'current spacing was set to pixel dimensions',&
+                   'it is therefore assumed to be empty','') 
+             ENDIF
+
+             !! 1.7 Calculate green stem mass
+             ! Stem mass is calculated as the aboveground woody biomass
+             ! minus the branches. circ_class_biomass is the biomass of
+             ! an individual tree (gC/tree)
+             ! Here, we convert the unit to (kgC/tree) by dividing kilo_to_unit (1000)
+             stem_mass(ipts,ivm,icir) = (circ_class_biomass(ipts,ivm,icir,isapabove,icarbon) + &
+                 circ_class_biomass(ipts,ivm,icir,iheartabove,icarbon)) * &
+                 (un - branch_ratio(ivm)) / kilo_to_unit
+          WRITE(numout,*) 'stem_mass,',stem_mass(ipts,ivm,icir)
+          WRITE(numout,*) 'green_density,', green_density(ivm)
+          WRITE(numout,*) 'pipe_sensity,', pipe_density(ivm)
+          WRITE(numout,*) 'kilo to unit,', kilo_to_unit
+          WRITE(numout,*) 'virtual_circ_class', virtual_circ_class_n(ipts,ivm,icir)
+          WRITE(numout,*) 'sla,',sla(ivm)
+             ! Wind throw occurs on living trees so the stem mass should be
+             ! converted from dry biomass in gC to wet biomass in kg to be used
+             ! in the GALES equations. Stem_mass thus converted as follows:
+             ! (green_density / (pipe_density/1000)) from dry wood mass
+             ! (kgC/tree) to wet wood mass (Kg/trees)
+             stem_mass(ipts,ivm,icir) = stem_mass(ipts, ivm,icir) * &
+                 green_density(ivm)/(pipe_density(ivm)/kilo_to_unit)
+   
+             !! 1.8 Calculating leaf area index 
+             ! We need to use the virtual biomass in each circumference class
+             ! to calculate lai, and tree_heights_from_edge was calculated as
+             ! function of lai.
+             lai(icir) = circ_class_biomass(ipts,ivm,icir,ileaf,icarbon)*&
+                virtual_circ_class_n(ipts,ivm,icir) * sla(ivm)
+
+!++++
+! CNCAN cann't find the variable " green_density "
+!++++
+
+             !-Debug-
+             IF (printlev_loc .GT. 4) THEN           
+                WRITE(numout,*) 'check spacing and circ_number in a diameter class'
+                WRITE(numout,*) 'virtual_tree_numbers:', &
+                     virtual_circ_class_n(ipts,ivm,icir), ' for circ class:', icir
+                WRITE(numout,*) 'current spacing: ',&
+                     current_spacing(icir),'mean diameter: ',  mean_dbh(ipts,ivm,icir) 
+            !    WRITE(numout,*) 'PFT No.:',ivm,'green_density (Kg/m^3):', &
+            !         green_density(ivm) 
+            !    WRITE(numout,*) 'dry_density (Kg/m^3):', pipe_density(ivm)/kilo_to_unit
+                WRITE(numout,*) 'resolution_x:', resolution(ipts,1)
+                WRITE(numout,*) 'resolution_y:', resolution(ipts,2)
+                WRITE(numout,*) 'ipts, ',ipts,'ivm, ',ivm,'icir, ',icir
+                WRITE(numout,*) 'mean dbh, ', mean_dbh(ipts,ivm,icir)
+                WRITE(numout,*) 'mean height, ', mean_height(ipts,ivm,icir)
+                WRITE(numout,*) 'stem_mass, ', stem_mass(ipts,ivm,icir)
+                WRITE(numout,*) 'crown_volume, ',crown_volume(icir)
+                WRITE(numout,*) 'crown_mass, ',crown_mass(icir)
+                WRITE(numout,*) 'lai, ',lai(icir)
+                WRITE(numout,*) 'virtual_circ_n, ', virtual_circ_class_n(ipts,ivm,icir) 
+                WRITE(numout,*) 'real_circ_n, ', circ_class_n(ipts,ivm,icir) 
+                WRITE(numout,*) 'current_spacing, ',current_spacing(icir)
+                WRITE(numout,*) 'End of Section 1:  Calculated canopy structure &
+                     & in difffernt circumferences for each PFT' 
+             ENDIF
+             !
+
+             !! 2. Calculating the gustiness of wind in the PFTs
+
+             !! 2.1 Calculate gaps and the surrounding areas 
+             ! IMPORTANT: AS WE DO NOT HAVE INFORMATION ON STAND EDGES IN THE 
+             ! ORCHIDEE SIMULATIONS, A POSSIBLE PROXY TO USE HERE IS A VARIABLE 
+             ! THAT REPRESENTS EARLIER HARVESTS IN THE PREVIOUS 5 YEARS. AFTER 
+             ! SUCH A PERIOD, THE FOREST EDGE IS ASSUMED TO GET ACCLIMATIZED
+             ! TO THE NEW CIRCUMSTANCES, AND IT'S VULNERABILITY DIMINISHES 
+             ! (see Persson, 1975; Valinger and Fridman, 2011)
+             ! There is a big increase in gustiness after a certain distance from 
+             ! the edge of the forest, hence we divide the area of the PFT into two 
+             ! areas:
+             ! - the area which is further than X tree heights from any edge that 
+             ! was created in the previous five years (area_total_further)
+             ! - the area which is closer than X tree heights from any edge that 
+             ! was created in the previous five years (area_total_closer).
+             ! Of course, these smaller areas depend on the fragmentation of the 
+             ! gaps (created in the last five years). As we have no information 
+             ! on this, we assume a fixed gap size representing the most likely 
+             ! size of clear cuts (clear_cut_max) and that the  
+             ! gaps are square-shaped. Then, we divide the area of harvest in the 
+             ! previous five years (area_timber_removals_5_years) by clear_cut_max. 
+             ! Hence, from the number of gaps we can calculate the area_total_closer. 
+             ! As each circumference class will have its forest area divided, we  
+             ! calculate two gustiness values and hence, two critical wind speeds.
+             ! The value of X depends on the leaf area index of the PFT and is 
+             ! calculated as follows:
+             ! tree_heights_from_edge is defined as "X/h", X sets to 28/LAI and h
+             ! is set to meant_tree_height.
+             ! This comes from the equation of calculating canopy penetration depth
+             ! in Pan et al. 2017?. Ying Pan work on the large eddy simulation and 
+             ! is now at Pennsilvania State University   
+
+             ! Here, lai(icir) for each diameter class is calculated by virtual_class_n 
+             ! a threshold "0.1" is used to avoid the issue of divided by small lai < 0.1 
+             ! for the cases of deciduous tree species 
+             IF (lai(icir) .GT. 0.1) THEN
+                tree_heights_from_edge(icir) = (28.0/lai(icir)) / mean_height(ipts,ivm,icir) 
+             ELSE
+                tree_heights_from_edge(icir) = (28.0/0.1) / mean_height(ipts,ivm,icir) 
+             ENDIF
+         
+             ! As suggested by Barry (the father of GALES), the tree height from edge 
+             ! should be limited to 9.0     
+             IF (tree_heights_from_edge(icir) .GT. 9.0)  tree_heights_from_edge(icir) = 9.0
+     
+
+             ! Calculating the total area of timber removals in the previous five years:
+             area_timber_removals_5_years(icir) = SUM(harvest_5y_area(ipts,ivm,1:wind_years)) 
+             area_icir(ipts) = resolution(ipts,1)*resolution(ipts,2) !* veget_cov_max(ipts,ivm) 
+ 
+             ! Number of gaps with the area of the maximum allowed clearfelling:
+             n_gap  = INT(area_timber_removals_5_years(icir)) / clear_cut_max 
+         
+             ! The length of the sides of the squared-shaped gaps:
+             length_side_gap = SQRT(clear_cut_max)
+         
+             ! The frame-shaped area around the clear cut gap with X as the width 
+             ! of the frame:
+             area_around_gap(icir) = ((length_side_gap + &
+                tree_heights_from_edge(icir)*mean_height(ipts,ivm,icir)*2.0)**2.0) - &
+                clear_cut_max
+
+             ! Total area of the "frames" in the particular dbh-class of the particula 
+             ! PFT:the multiplication by 0.25 is because of the assumption that wind 
+             ! direction does not change during the half-hourly time step, therefore 
+             ! only one of the four sides of the gaps are affected.
+             area_total_closer(icir) = n_gap(ipts) * area_around_gap(icir) * 0.25
+
+
+! add a if condiction to check the area_total_closer <= area_icir
+
+
+             ! The total area which is nor gap neither "frame":
+             area_total_further(icir) = area_icir(ipts) - area_total_closer(icir) - &
+                (n_gap(icir) * clear_cut_max)
+
+             ! Get the area fraction
+             closer_area_fraction(icir) = area_total_closer(icir) / area_icir(ipts)
+             further_area_fraction(icir) = area_total_further(icir) / area_icir(ipts)  
+ 
+
+             !-Debug-
+             IF(printlev_loc .GT. 4)THEN 
+                 WRITE(numout,*) 'Section 2.0: Calculating the gustiness of wind &
+                      & in the PFT and area fractions in the grid.'
+                 WRITE(numout,*) 'area_closer_fraction, ', closer_area_fraction(icir)
+                 WRITE(numout,*) 'area_further_fraction, ', further_area_fraction(icir)
+             ENDIF
+             !-
+
+             !! 2.2 Calculate ratio to spacing height 
+             ! The ratio of spacing to height describes the functional (for
+             ! wind) stand density. If there are many tall trees, the spacing 
+             ! is low and thus ratio_spacing_height will be low as well.  
+             ! Values of the ratio of mean tree spacing and height are limited
+             ! between 0.075 and 0.45. Bigger values don't make any difference,
+             ! smaller values are not really possible in real life.
+             ! The D/h  value are presented in Hale et al., 2015 
+             IF (current_spacing(icir) / mean_height(ipts,ivm,icir) < 0.075) THEN
+                ! Many tall trees, ratio has saturated
+                ratio_spacing_height(icir) = 0.075
+             ELSE
+                IF (current_spacing(icir) / mean_height(ipts,ivm,icir) > 0.45) THEN
+                   ! Few short trees, ratio has saturated
+                   ratio_spacing_height(icir) = 0.45
+                ELSE
+                   ! Calculate ratio_spacing_height  
+                   ratio_spacing_height(icir) = current_spacing(icir) / &
+                      mean_height(ipts,ivm,icir)
+                END IF
+             ENDIF
+
+             ! Copy the ratio_spacing_height to the D_H_ratio for output 
+             d_h_ratio(ipts,ivm,icir) = ratio_spacing_height(icir) 
+         
+             !! 2.3 Calculate functional gap size
+             ! Calculate whether the gap is large enough to increase
+             ! the sensitivity of the remaining trees to wind throw.
+             ! GALES uses the length of the edge of the square-shaped
+             ! gaps calculated in the previous section.
+             gap_size(icir) = length_side_gap  
+ 
+             ! If the gap is wider than 10 times the tree height,
+             ! then wind loading on the stand edge does not increase any 
+             ! more. The threshold of 10 is used in the equations below
+             IF (gap_size(icir) > 10.0 * mean_height(ipts,ivm,icir)) THEN
+                mean_gap_factor(icir) = 1.
+                max_gap_factor(icir) = 1. 
+             ELSE
+                ratio_gap_height(icir) = gap_size(icir) / &
+                    mean_height(ipts,ivm,icir)
+                mean_gap_factor(icir) = (0.001 * ratio_gap_height(icir)**0.562) / &
+                    (0.001 * 10.**0.562)
+                max_gap_factor(icir) = (0.0064 * ratio_gap_height(icir)**0.3467) / &
+                    (0.0064 * 10.**0.3467)
+             END IF
+         
+             ! In the following section, there are three types of terms for forest edges:
+             ! the edge (edge), the area around the edge (closer)  and the area further 
+             ! away from the edge (further). Only closer and further are used in
+             ! the calculation of cws. Gustiness is different in both areas. 
+
+             ! Calculating term_a and term_b for the new gust method. The definition of
+             ! the term_a and term_b are in the Hale  et al. (2015) eq(7) 
+             ! D/h is the ratio_spacing_height
+             ! x/h is the tree_heights_from_edge 
+             IF (-2.1 * ratio_spacing_height(icir) + 0.91 < zero) THEN
+                 term_a(icir) = zero 
+             ELSE
+                 term_a(icir) = -2.1 * ratio_spacing_height(icir) + 0.91
+             END IF
+             term_b(icir) = 1.0611 * LOG(ratio_spacing_height(icir)) + 4.2
+        
+             ! New gust factors:
+             ! The gustiness away from the edge is always higher than at the edge.
+             ! We applied term_a*tree_heights_from_edge  + term_b for gustiness calculation.
+             ! The gustiness away from the edge is always higher than at the edge.
+             ! For the further area, tree_height_from_edge is always greater than 9.0
+             ! thus, the above calculation will produce an even higher value for gustiness
+             ! calculation. So, We set tree_heights_from_edge as 9.0.
+             ! The gustiness at the further area will than be higher then the gustiness at 
+             ! the closer area.        
+             new_gust_closer(icir)  = term_a(icir) * tree_heights_from_edge(icir) + term_b(icir)
+             new_gust_further(icir) = term_a(icir) * 9.0  + term_b(icir)
+             new_gust_edge(icir)    = term_a(icir) * zero + term_b(icir)
+       
+             ! Calculating gustiness:
+             g_closer(ipts,ivm,icir) = new_gust_closer(icir)
+             g_further(ipts,ivm,icir) = new_gust_further(icir)
+
+        
+             ! The following section is used to calculate the edge_factor. This section calculates
+             ! how the mean loading on a tree changes as a function of tree height, spacing, distance
+             ! from edge and size of any upwind gap. An upwind gap greater than 10 tree heights
+             ! is assumed to be an infinite gap. The output (edge_factor) is used to modify the
+             ! calculated wind loading on the tree, which assumes a steady wind and a position well
+             ! inside the forest.
+             mean_bm_gust_factor_closer(icir) = (0.68 * ratio_spacing_height(icir) - &
+                0.0385) + (-0.68 * ratio_spacing_height(icir) + 0.4785) * ((1.7239 * &
+                ratio_spacing_height(icir) + 0.0316)**tree_heights_from_edge(icir)) * &
+                mean_gap_factor(icir)
+         
+             mean_bm_gust_factor_further(icir) = (0.68 * ratio_spacing_height(icir) - &
+                0.0385) + (-0.68 * ratio_spacing_height(icir) + 0.4785) * ((1.7239 * &
+                ratio_spacing_height(icir) + 0.0316)**9.0) * mean_gap_factor(icir)
+         
+             
+             edge_factor(icir) = mean_bm_gust_factor_closer(icir) / mean_bm_gust_factor_further(icir)
+             ! Copy array for output 
+             edge_factor_out(ipts,ivm,icir)  = edge_factor(icir)
+             ! Calculating gust_factor accounting for gustiness and edge_factor:
+             gust_factor_closer(ipts,ivm,icir) = g_closer(ipts,ivm,icir) * edge_factor(icir) 
+           
+             ! Suggested by Barry
+             ! For further we force edge_factor = 1. This is because everything is
+             ! compared to wind load on tree in the middle of the forest
+             edge_factor(icir) = 1.0 
+             gust_factor_further(ipts,ivm,icir) = g_further(ipts,ivm,icir) *  edge_factor(icir) 
+         
+         
+             !-Debug-
+             IF(printlev_loc .GT. 4)THEN 
+                 WRITE(numout,*) 'End of Section 2.0: Calculating the &
+                      & gustiness of wind in the PFT'
+                 WRITE(numout,*) 'term_a, ', term_a(icir)
+                 WRITE(numout,*) 'term_b, ', term_b(icir)
+                 WRITE(numout,*) 'new_gust_closer, ', new_gust_closer(icir)
+                 WRITE(numout,*) 'ratio_spacing_height, ', ratio_spacing_height(:) 
+                 WRITE(numout,*) 'new_gust_further, ', new_gust_further(icir)
+                 WRITE(numout,*) 'new_gust_edge, ', new_gust_edge(icir) 
+                 WRITE(numout,*) 'tree_heights_from_edge, ', tree_heights_from_edge(icir)
+                 WRITE(numout,*) 'Correction factor for the forest &
+                      & edge dimension in number of circumference'
+                 WRITE(numout,*) 'edge_factor, ', edge_factor(icir)
+                 WRITE(numout,*) 'gustness_closer, ', g_closer(ipts,ivm,icir)
+                 WRITE(numout,*) 'gustness_futher, ', g_further(ipts,ivm,icir) 
+                 WRITE(numout,*) 'gust_factor_closer, ' , gust_factor_closer(ipts,ivm,icir)
+                 WRITE(numout,*) 'gust_factor_further, ', gust_factor_further(ipts,ivm,icir)
+                 WRITE(numout,*) 'Edge factor:', edge_factor(icir)
+                 WRITE(numout,*) 'Tree height from edge:', tree_heights_from_edge(icir)
+                 WRITE(numout,*) 'Mean bm_gust_factor_closer:',  &
+                      mean_bm_gust_factor_closer(icir)
+                 WRITE(numout,*) 'Mean bm_gust_factor_further:', &
+                      mean_bm_gust_factor_further(icir)
+                 WRITE(numout,*) 'Mean gap_factor:', mean_gap_factor(icir)
+             ENDIF
+             !-
+                  
+             !! 3. Calculating critical moments (tree mechanics section)
+             ! overturning_moment_multiplier: this comes form the species parameters file and is related to the
+             ! depth and type of the soil.
+             ! Rooting depth has three categories: Shallow (less then 0.8 m deep); Deep (deeper than 0.8 m);
+             ! Average (average values to be used when rooting depth is unknown).
+             ! Soil type has four categories: Free-draining mineral soils; Gleyed mineral soils; Peaty mineral
+             ! soils; Deep peats
+             ! As these are generic soil types, a modified soil map of Europe would be needed for the optimal use
+             ! of WINDFALL.
+
+! ++++ This part of code need to revised for changing senescence to plant_status 
+ 
+         
+!              IF (soil_type(ipts) == ifree_draining .AND. rooting_depth(ipts,ivm) == ishallow &
+!                 .AND. .NOT. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_free_draining_shallow(ivm)
+!              ELSE IF (soil_type(ipts) == ifree_draining .AND. rooting_depth(ipts,ivm) == ishallow &
+!                 .AND. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_free_draining_shallow_leafless(ivm)
+!              ELSE IF (soil_type(ipts) == ifree_draining .AND. rooting_depth(ipts,ivm) == ideep &
+!                 .AND. .NOT. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_free_draining_deep(ivm)
+!              ELSE IF (soil_type(ipts) == ifree_draining .AND. rooting_depth(ipts,ivm) == ideep &
+!                 .AND. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_free_draining_deep_leafless(ivm)
+!              ELSE IF (soil_type(ipts) == ifree_draining .AND. rooting_depth(ipts,ivm) == iaverage &
+!                 .AND. .NOT. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_free_draining_average(ivm)
+!              ELSE IF (soil_type(ipts) == ifree_draining .AND. rooting_depth(ipts,ivm) == iaverage &
+!                 .AND. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_free_draining_average_leafless(ivm)
+!              ELSE IF (soil_type(ipts) == igleyed .AND. rooting_depth(ipts,ivm) == ishallow &
+!                 .AND. .NOT. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_gleyed_shallow(ivm)
+!              ELSE IF (soil_type(ipts) == igleyed .AND. rooting_depth(ipts,ivm) == ishallow &
+!                 .AND. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_gleyed_shallow_leafless(ivm)
+!              ELSE IF (soil_type(ipts) == igleyed .AND. rooting_depth(ipts,ivm) == ideep &
+!                 .AND. .NOT. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_gleyed_deep(ivm)
+!              ELSE IF (soil_type(ipts) == igleyed .AND. rooting_depth(ipts,ivm) == ideep &
+!                 .AND. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_gleyed_deep_leafless(ivm)
+!              ELSE IF (soil_type(ipts) == igleyed .AND. rooting_depth(ipts,ivm) == iaverage &
+!                 .AND. .NOT. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_gleyed_average(ivm)
+!              ELSE IF (soil_type(ipts) == igleyed .AND. rooting_depth(ipts,ivm) == iaverage &
+!                 .AND. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_gleyed_average_leafless(ivm)
+!              ELSE IF (soil_type(ipts) == ipeaty .AND. rooting_depth(ipts,ivm) == ishallow &
+!                 .AND. .NOT. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_peaty_shallow(ivm)
+!              ELSE IF (soil_type(ipts) == ipeaty .AND. rooting_depth(ipts,ivm) == ishallow &
+!                 .AND. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_peaty_shallow_leafless(ivm)
+!              ELSE IF (soil_type(ipts) == ipeaty .AND. rooting_depth(ipts,ivm) == ideep &
+!                 .AND. .NOT. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_peaty_deep(ivm)
+!              ELSE IF (soil_type(ipts) == ipeaty .AND. rooting_depth(ipts,ivm) == ideep &
+!                 .AND. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_peaty_deep_leafless(ivm)
+!              ELSE IF (soil_type(ipts) == ipeaty .AND. rooting_depth(ipts,ivm) == iaverage &
+!                 .AND. .NOT. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_peaty_average(ivm)
+!              ELSE IF (soil_type(ipts) == ipeaty .AND. rooting_depth(ipts,ivm) == iaverage &
+!                 .AND. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_peaty_average_leafless(ivm)
+!              ELSE IF (soil_type(ipts) == ipeat .AND. rooting_depth(ipts,ivm) == ishallow &
+!                 .AND. .NOT. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_peat_shallow(ivm)
+!              ELSE IF (soil_type(ipts) == ipeat .AND. rooting_depth(ipts,ivm) == ishallow &
+!                 .AND. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_peat_shallow_leafless(ivm)
+!              ELSE IF (soil_type(ipts) == ipeat .AND. rooting_depth(ipts,ivm) == ideep &
+!                 .AND. .NOT. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_peat_deep(ivm)
+!              ELSE IF (soil_type(ipts) == ipeat .AND. rooting_depth(ipts,ivm) == ideep &
+!                 .AND. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_peat_deep_leafless(ivm)
+!              ELSE IF (soil_type(ipts) == ipeat .AND. rooting_depth(ipts,ivm) == iaverage &
+!                 .AND. .NOT. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_peat_average(ivm)
+!              ELSE IF (soil_type(ipts) == ipeat .AND. rooting_depth(ipts,ivm) == iaverage &
+!                 .AND. senescence(ipts,ivm)) THEN
+!                 overturning_moment_multiplier(ipts,ivm) = overturning_peat_average_leafless(ivm)
+!              ELSE
+                 !average value if parameters are missing
+                 overturning_moment_multiplier(ipts,ivm) = 125.0
+!              END IF
+
+!  +++++ just apply a constant value 125.0  for testing
+
+
+   
+              ! Maximum moment calculated for tree overturning.
+              max_overturning_moment(ipts,ivm,icir) = overturning_moment_multiplier(ipts,ivm) * &
+                 stem_mass(ipts,ivm,icir)
+           
+              ! Maximum moment calculated for stem breakage.
+              max_breaking_moment(ipts,ivm,icir) = modulus_rupture(ivm) * f_knot(ivm) * pi * &
+                 (mean_dbh(ipts,ivm,icir)**3.0) / 32.0
+           
+              ! This is where the gustiness of wind is accounted for so that half hourly mean 
+              ! wind speeds can be used in the simulations.
+              ! In the end, moments and hence, critical wind speeds are calculated
+              ! for both areas (closer & further) with different gustiness.
+              overturning_moment_closer(ipts,ivm,icir) = max_overturning_moment(ipts,ivm,icir) / &
+                  gust_factor_closer(ipts,ivm,icir)
+              overturning_moment_further(ipts,ivm,icir) = max_overturning_moment(ipts,ivm,icir) / &
+                  gust_factor_further(ipts,ivm,icir)
+              breaking_moment_closer(ipts,ivm,icir) = max_breaking_moment(ipts,ivm,icir) / &
+                  gust_factor_closer(ipts,ivm,icir)
+              breaking_moment_further(ipts,ivm,icir) = max_breaking_moment(ipts,ivm,icir) / &
+                  gust_factor_further(ipts,ivm,icir)
+      
+              !-Debug-
+              IF(printlev_loc .GT. 4)THEN
+                 WRITE(numout,*) 'PFT type, ', ivm 
+                 WRITE(numout,*) 'POINT id, ', ipts
+                 WRITE(numout,*) 'SENSCENCE type,', plant_status(ipts,ivm)
+                 WRITE(numout,*) 'Overturning multiplier for free drainage average root leafless all PFTs,', &  
+                                  overturning_free_draining_average_leafless(:)
+                 WRITE(numout,*) 'Overturning multiplier for free drainage average root leaf all PFTs,', &  
+                                  overturning_free_draining_average(:)
+                 WRITE(numout,*) 'Overturning multiplier for free drainage shallow root leafless all PFTs,', &  
+                                  overturning_free_draining_shallow_leafless(:)
+                 WRITE(numout,*) 'Overturning multiplier for free drainage shallow root leaf all PFTs,', &  
+                                  overturning_free_draining_shallow(:)
+                 WRITE(numout,*) 'Overturning multiplier for free drainage deep root leafless all PFTs,', &  
+                                  overturning_free_draining_deep_leafless(:)
+                 WRITE(numout,*) 'Overturning multiplier for free drainage deep root leaf all PFTs,', &  
+                                  overturning_free_draining_deep(:)
+ 
+                 WRITE(numout,*) 'End of Section 3 : Calculating critical moments (tree mechanics section)'
+                 WRITE(numout,*) 'Diameter class:', icir
+                 WRITE(numout,*) 'Overturning moment multiplier, ', &
+                                  overturning_moment_multiplier(ipts,ivm)
+                 WRITE(numout,*) 'maximum moment for overturning, ', max_overturning_moment(ipts,ivm,icir)
+                 WRITE(numout,*) 'maximum moment for stem breakag, ', max_breaking_moment(ipts,ivm,icir)
+                 WRITE(numout,*) 'overturning closer,', overturning_moment_closer(ipts,ivm,icir)
+                 WRITE(numout,*) 'breaking closer, ', breaking_moment_closer(ipts,ivm,icir)
+                 WRITE(numout,*) 'overturning further, ', overturning_moment_further(ipts,ivm,icir)
+                 WRITE(numout,*) 'breaking further, ', breaking_moment_further(ipts,ivm,icir)
+              ENDIF
+              !-
+      
+              !! 4. Calculating critical wind speed and damage rate
+
+              !! 4.1 Calculating critical wind speed in the forest and 10 m above the zero-plane displacement
+           
+              ! +++CHECK+++
+              ! Ideally ORCHIDEE should use only one  surface roughness (z0) and displacement 
+              ! height. This is not straightforward because here surface roughness and 
+              ! displacement height are calculated as a function of wind speed to account for 
+              ! streamlining of the canopy under strong winds. This is done in the subroutine 
+              ! streamlining(...) in the calculate_wind_process(). Nevertheless, the subroutine 
+              ! streamlining uses the canopy structure from ORCHIDEE and when storm damage
+              ! occurs, the canopy structure is adjusted and this new structure will be used 
+              ! in condveg.f90 . The inconsistency is thus between the roughness length 
+              ! calculations in condveg.f90 and stomate_windthrow.f90. 
+              ! +++++++++++
+      
+              ! for the edge area
+              ! Critical wind speed for stem breakage in the edge area (m/s)
+              distance_from_force = 0.0 
+              call calculate_wind_process(breaking_moment_closer(ipts,ivm,icir),    &
+                      current_spacing(icir), canopy_depth(icir), &
+                      canopy_breadth(icir), canopy_height(icir), &
+                      streamlining_n, streamlining_c, &                      
+                      cws_break_closer(ipts,ivm,icir),          &
+                      z0_wind(ipts,ivm,icir), d_wind(ipts,ivm,icir),&
+                      distance_from_force) 
+              
+              ! Critical wind speed for stem breakage 10 m above 
+              ! the zero-plane displacement in the edge area(m/s)
+              call elevate(cws_break_closer(ipts,ivm,icir), & 
+                      z0_wind(ipts,ivm,icir), d_wind(ipts,ivm,icir), canopy_height(icir), &
+                      cws_break_closer_10(ipts,ivm,icir))
+       
+              ! Critical wind speed for tree overturning in the edge area (m/s)
+              distance_from_force = 0.0
+              call calculate_wind_process(overturning_moment_closer(ipts,ivm,icir),  &
+                      current_spacing(icir), canopy_depth(icir), &
+                      canopy_breadth(icir), canopy_height(icir), &
+                      streamlining_n, streamlining_c, &
+                      cws_overturn_closer(ipts,ivm,icir),        &
+                      z0_wind(ipts,ivm,icir), d_wind(ipts,ivm,icir),&
+                      distance_from_force)
+             
+              ! Critical wind speed for tree overturning 10 m above
+              ! the zero-plane displacement in the edge area (m/s)
+              call elevate(cws_overturn_closer(ipts,ivm,icir), &
+                      z0_wind(ipts,ivm,icir), d_wind(ipts,ivm,icir), canopy_height(icir), &
+                      cws_overturn_closer_10(ipts,ivm,icir))
+         
+              ! IF the soil at 80 below ground is frozen, the module only allows the stem breakage
+              IF ( soil_temp_daily(ipts) .GT. 273.15 ) THEN 
+              ! Calculating damage severity in case any of the critical wind speeds is reached 
+              ! in the area around gaps (forest edge area). Whichever of the two damage types 
+              ! (overturning, stem breakage) has the lowest critical wind speed, it will be the 
+              ! occurring one.
+                 IF (cws_overturn_closer_10(ipts,ivm,icir) < cws_break_closer_10(ipts,ivm,icir)) THEN
+                    cws_final_closer(ipts,ivm,icir) = cws_overturn_closer_10(ipts,ivm,icir)
+                    wind_damage_type_closer(ipts,ivm,icir) = ioverturning
+                 ELSE
+                    cws_final_closer(ipts,ivm,icir) = cws_break_closer_10(ipts,ivm,icir)
+                    wind_damage_type_closer(ipts,ivm,icir) = ibreakage
+                 END IF
+              ELSE
+              ! when the soil at 80 cm  is frozen, the only damage type is limited to the
+              ! stem_breakage
+                    cws_final_closer(ipts,ivm,icir) = cws_break_closer_10(ipts,ivm,icir)
+                    wind_damage_type_closer(ipts,ivm,icir) = ibreakage           
+              ENDIF     
+ 
+              ! Based on observations of wind damage in Scotland and how much we had to
+              ! adjust the critical wind speed to get agreement between the wind speed
+              ! above the canopy, the calculated critical wind speed and the presence
+              ! of damage (Hale et al, 2015). I am suggesting the relationship below to
+              ! calculate the percentage of damage at a grid point as a function of the
+              ! meteorological wind speed at 10m above the zero-plane displacement
+              ! (pred_wind), and the critical wind speed for damage (crit_wind)
+              ! calculated by ForestGALES. I would set maximum to 80% for the moment
+              ! (sets the maximum total amount of damage = 80%) and the scaling factor
+              ! (s) to 0.8 (this affects the rate at which damage percentage increases
+              ! with increasing wind speed). We can adjust these if the seem to be
+              ! wrong or I find other data that I can use to make a better assessment.
+              ! We apply a sigmodial function to tune the "damage level" by using a
+              ! function which is dependent on the difference between the actual wind 
+              ! speed and the final_cws (the lower one of the cws from overturning or 
+              ! stem_breakage. 
+              wind_damage_rate_closer(ipts,ivm,icir) = max_damage_closer(ivm) * ( &
+                  (1./(1.+exp(-((wind_speed_daily(ipts)- cws_final_closer(ipts,ivm,icir)) / &
+                  sfactor_closer(ivm))))) - &
+                  (1./(1.+exp(cws_final_closer(ipts,ivm,icir)/sfactor_closer(ivm)))) ) 
+           
+              !-Debug-
+              IF (printlev_loc .GT. 4) THEN 
+                 WRITE(numout,*) 'max_damage_closer:', max_damage_closer(ivm)
+                 WRITE(numout,*) 'sfactor_closer:', sfactor_closer(ivm)
+                 WRITE(numout,*) 'daily_max_wind_speed (m/s):', wind_speed_daily(ipts)
+                 WRITE(numout,*) 'cws_closer (m/s)', cws_final_closer(ipts,ivm,icir)
+                 WRITE(numout,*) 'wind_damage_rate:', wind_damage_rate_closer(ipts,ivm,icir)
+              ENDIF
+              !-
+  
+              !! 4.2 Calculating critical wind speed in the forest and 10 m above the 
+              !! zero-plane displacement for the further forest area
+      
+              ! Whichever of the two damage types (overturning, stem breakage) has the 
+              ! lowest critical wind speed, it will be the occurring one.
+              ! Critical wind speed for stem breakage in the inner forest area (m/s)
+              distance_from_force = 0.0 
+              call calculate_wind_process(breaking_moment_further(ipts,ivm,icir), &
+                      current_spacing(icir), canopy_depth(icir), &
+                      canopy_breadth(icir), canopy_height(icir), &
+                      streamlining_n, streamlining_c, &
+                      cws_break_further(ipts,ivm,icir), &
+                      z0_wind(ipts,ivm,icir), d_wind(ipts,ivm,icir),&
+                      distance_from_force)
+           
+              ! Critical wind speed for stem breakage 10 m above the zero-plane 
+              ! displacement in the inner forest area (m/s)
+              call elevate(cws_break_further(ipts,ivm,icir), &
+                      z0_wind(ipts,ivm,icir), d_wind(ipts,ivm,icir), canopy_height(icir), &
+                      cws_break_further_10(ipts,ivm,icir))
+             
+              ! Critical wind speed for tree overturning in the inner forest area (m/s)
+              distance_from_force = 0.0
+              call calculate_wind_process(overturning_moment_further(ipts,ivm,icir),&
+                      current_spacing(icir), canopy_depth(icir), &
+                      canopy_breadth(icir), canopy_height(icir), &
+                      streamlining_n, streamlining_c, &
+                      cws_overturn_further(ipts,ivm,icir),&
+                      z0_wind(ipts,ivm,icir), d_wind(ipts,ivm,icir),&
+                      distance_from_force)
+    
+              ! Critical wind speed for tree overturning 10 m above the zero-plane 
+              ! displacement in the inner forest area (m/s)
+              call elevate(cws_overturn_further(ipts,ivm,icir), &
+                      z0_wind(ipts,ivm,icir), d_wind(ipts,ivm,icir), canopy_height(icir), &
+                      cws_overturn_further_10(ipts,ivm,icir))
+       
+              ! Whichever of the two damage types (overturning, stem breakage) has the 
+              ! lowest critical wind speed, it will be the occurring one.
+              IF (cws_overturn_further_10(ipts,ivm,icir) < cws_break_further_10(ipts,ivm,icir)) THEN
+                  cws_final_further(ipts,ivm,icir) = cws_overturn_further_10(ipts,ivm,icir)
+                  wind_damage_type_further(ipts,ivm,icir) = ioverturning
+              ELSE
+                  cws_final_further(ipts,ivm,icir) = cws_break_further_10(ipts,ivm,icir)
+                  wind_damage_type_further(ipts,ivm,icir) = ibreakage
+              END IF
+      
+              ! Wind damage level is considered as a logistic function with sigmoidal
+              ! shape, which is calculated as function of a critical wind speed, an actual
+              ! wind speed, a scaling factor(s)=0.8 and a maximum damage rate(80%)=0.8.
+              wind_damage_rate_further(ipts,ivm,icir) = max_damage_further(ivm) * ( &
+                    (1./(1.+exp(-((wind_speed_daily(ipts)- cws_final_further(ipts,ivm,icir)) / &
+                    sfactor_further(ivm))))) - &
+                    (1./(1.+exp(cws_final_further(ipts,ivm,icir)/sfactor_further(ivm)))) ) 
+      
+              !-Debug-
+              IF (printlev_loc .GT. 4) THEN 
+                 WRITE(numout,*) 'max_damage_further:', max_damage_further(ivm)
+                 WRITE(numout,*) 'sfactor_further:', sfactor_further(ivm)
+                 WRITE(numout,*) 'daily_max_wind_speed (m/s):', wind_speed_daily(ipts)
+                 WRITE(numout,*) 'cws_further (m/s)', cws_final_further(ipts,ivm,icir)
+                 WRITE(numout,*) 'wind_damage_rate:', wind_damage_rate_further(ipts,ivm,icir)  
+              ENDIF
+              !-
+      
+              !! 5. Determine which trees are killed by wind damage
+
+              ! We only do the damage for the virtual_circ_class_n GT min_stomate        
+              IF (virtual_circ_class_n(ipts,ivm,icir) .GT. min_stomate) THEN
+  
+                  !! 5.1. Kill trees in closer area  
+                  IF (wind_speed_daily(ipts) >= cws_final_closer(ipts,ivm,icir) ) THEN
+                      IF (wind_damage_type_closer(ipts,ivm,icir) == ibreakage) THEN
+                         circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_break) = &
+                         wind_damage_rate_closer(ipts,ivm,icir) * circ_class_n(ipts,ivm,icir) * &
+                         closer_area_fraction(icir)
+               
+                         ! We assume that there is Only one damage type will occur due to
+                         ! its lower limiting wind speed
+                         circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_uproot) = zero
+
+                      ELSE
+
+                         circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_uproot) = &
+                             wind_damage_rate_closer(ipts,ivm,icir) * &
+                             circ_class_n(ipts,ivm,icir) *  closer_area_fraction(icir)
+
+                         ! We assume that there is Only one damage type will occur due to
+                         ! its lower limited wind speed
+                         circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_break) = zero
+
+                      ENDIF    
+                  ENDIF 
+
+                  !! 5.2 Kill trees in further area  
+                  IF (wind_speed_daily(ipts) >= cws_final_further(ipts,ivm,icir) ) THEN
+                      IF (wind_damage_type_further(ipts,ivm,icir) == ibreakage) THEN
+                         ! Total damage = closer + further  
+                         circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_break) = &
+                             circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_break) + & 
+                             wind_damage_rate_further(ipts,ivm,icir) * &
+                             circ_class_n(ipts,ivm,icir) * further_area_fraction(icir)
+
+                         ! We assume that there is only one damage type will occur due to
+                         ! its lower limited wind speed
+                         circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_uproot) = zero
+
+                      ELSE
+
+                         
+                         ! Total damage = closer + further
+                         circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_uproot) = &
+                             circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_uproot) + &
+                             wind_damage_rate_further(ipts,ivm,icir) * circ_class_n(ipts,ivm,icir) * &
+                             further_area_fraction(icir)
+
+                         ! We assume that there is only one damage type will occur due to
+                         ! its lower limited wind speed
+                         circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_break) = zero
+         
+                      ENDIF    
+                  ENDIF 
+  
+              ELSE
+
+                  ! set no damage for the no vegetation area 
+                  circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_break) = zero
+                  circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_uproot) = zero  
+      
+              END IF
+      
+              ! For the tree height below five meters (7.0m), we assumed that the damage will not
+              ! occur. At the moment, we don't have good solution for the calculation
+              ! of CWS for the small trees, so we just simply keep the small trees. 
+              IF ( mean_height(ipts,ivm,icir) .LT. 7.0 ) THEN
+                   circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_break) = zero
+                   circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_uproot) = zero  
+              ENDIF 
+  
+              !-Debug-
+              IF (printlev_loc .GT. 4 .AND. ipts==test_grid .AND. ivm==test_pft) THEN
+                 WRITE(numout,*) 'End of Section 4: Calculating critical wind speed and damage rate'
+                 WRITE(numout,*) 'critical wind speed further, ', cws_final_further(ipts,ivm,icir)
+                 WRITE(numout,*) 'critical wind speed closer, ',  cws_final_closer(ipts,ivm,icir)
+                 WRITE(numout,*) 'wind damage type further, ', wind_damage_type_further(ipts,ivm,icir)
+                 WRITE(numout,*) 'wind damage type closer, ',  wind_damage_type_closer(ipts,ivm,icir)
+                 WRITE(numout,*) 'forest managed type, ', forest_managed(ipts,ivm) 
+                 WRITE(numout,*) 'circ_class_n(ipts,ivm,icir),',  circ_class_n(ipts,ivm,icir) 
+                 WRITE(numout,*) 'circ_class_kill(ipts,ivm,icir,:,icut_storm_break,', &
+                    circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_break) 
+                 WRITE(numout,*) 'circ_class_kill(ipts,ivm,icir,:,icut_storm_uproot,', &
+                    circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),icut_storm_uproot) 
+                 WRITE(numout,*) 'circ_class_kill, for icut_1:9_:'
+                 WRITE(numout,*) circ_class_kill(ipts,ivm,icir,forest_managed(ipts,ivm),1:9)
+              ENDIF
+              !-
+      
+              ! Copy some values for the output files
+              canopy_depth_out(ipts,ivm,icir) = canopy_depth(icir)
+              tree_h_edge_out(ipts,ivm,icir)  = tree_heights_from_edge(icir)
+              mean_gap_f_out(ipts,ivm,icir)   = mean_gap_factor(icir) 
+              gap_size_out(ipts,ivm,icir)     = gap_size(icir)  
+              !edge_factor_out(ipts,ivm,icir)  = edge_factor(icir)
+      
+           END DO ! loop ncirc
+
+        END DO ! loop nvm
+
+     END DO ! loop npts
+   
+     !! 5. Writing out history variables
+
+!++++ SET lev 5  history files 
+     IF ( printlev_loc .GT. 5 ) THEN
+!+++
+     ! Write the CWS to stomate_history_file
+     DO icir = 1,ncirc
+        !CWS at further area for each diameter class  
+        WRITE(var_name,'(A,I3.3)') 'CWS_FURTHER_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             cws_final_further(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        !CWS at closer area for each diameter class
+        WRITE(var_name,'(A,I3.3)') 'CWS_CLOSER_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             cws_final_closer(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        !CWS at closer area in each diameter class for stem breakage
+        WRITE(var_name,'(A,I3.3)') 'CWS_CLOSER_BK_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             cws_break_closer_10(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        !CWS at closer area in each diameter class for overturning
+        WRITE(var_name,'(A,I3.3)') 'CWS_CLOSER_OV_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             cws_overturn_closer_10(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        !CWS at further  area in each diameter class for stem break
+        WRITE(var_name,'(A,I3.3)') 'CWS_FURTHER_BK_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             cws_break_further_10(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        !CWS at further area in each diameter class for overturning
+        WRITE(var_name,'(A,I3.3)') 'CWS_FURTHER_OV_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             cws_overturn_further_10(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        !CWS at closer area in each diameter class for stem breakage
+        WRITE(var_name,'(A,I3.3)') 'CWS_TOP_CLO_BK_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             cws_break_closer(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        !CWS at closer area in each diameter class for overturning
+        WRITE(var_name,'(A,I3.3)') 'CWS_TOP_CLO_OV_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             cws_overturn_closer(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        !CWS at further  area in each diameter class for stem break
+        WRITE(var_name,'(A,I3.3)') 'CWS_TOP_FUR_BK_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             cws_break_further(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        !CWS at further area in each diameter class for overturning
+        WRITE(var_name,'(A,I3.3)') 'CWS_TOP_FUR_OV_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             cws_overturn_further(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        !D_H_ratio  for each diameter class
+        WRITE(var_name,'(A,I3.3)') 'D_H_RATIO_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             d_h_ratio(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! MEAN_HEIGHT for each diameter class
+        WRITE(var_name,'(A,I3.3)') 'MEAN_HEIGHT_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             mean_height(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! MEAN_DBH for each diameter class
+        WRITE(var_name,'(A,I3.3)') 'MEAN_DBH_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             mean_dbh(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! V_IND virtual individual tree numbers for each diameter class
+        WRITE(var_name,'(A,I3.3)') 'V_IND_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             virtual_circ_class_n(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! G_CLOSER gustiness for closer area in each diameter class
+        WRITE(var_name,'(A,I3.3)') 'G_CLOSER_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             gust_factor_closer(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! G_FURTHER gustiness for further area in  each diameter class
+        WRITE(var_name,'(A,I3.3)') 'G_FURTHER_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             gust_factor_further(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! G_FURTHER gustiness for further area in  each diameter class
+        WRITE(var_name,'(A,I3.3)') 'STEM_MASS_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             stem_mass(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! roughness length
+        WRITE(var_name,'(A,I3.3)') 'WIND_Z0_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             z0_wind(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! displacement height
+        WRITE(var_name,'(A,I3.3)') 'WIND_D_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             d_wind(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! canopy depth
+        WRITE(var_name,'(A,I3.3)') 'CANOPY_DEPTH_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             canopy_depth_out(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! tree heights from edge 
+        WRITE(var_name,'(A,I3.3)') 'TREE_H_EDGE_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             tree_h_edge_out(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! mean gap factor
+        WRITE(var_name,'(A,I3.3)') 'MEAN_GAP_F_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             mean_gap_f_out(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! gap size
+        WRITE(var_name,'(A,I3.3)') 'GAP_SIZE_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             gap_size_out(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! edge factor
+        WRITE(var_name,'(A,I3.3)') 'EDGE_FACTOR_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             edge_factor_out(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! maximum moment for overturning
+        WRITE(var_name,'(A,I3.3)') 'MAX_OV_MOMENT_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             max_overturning_moment(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     DO icir =1,ncirc        
+        ! maximum moment breakage 
+        WRITE(var_name,'(A,I3.3)') 'MAX_BK_MOMENT_',icir
+        CALL histwrite_p(hist_id_stomate, var_name, itime, &
+             max_breaking_moment(:,:,icir), npts*nvm, horipft_index)
+     ENDDO
+     !
+     ! Daily Maximum wind speed
+     CALL histwrite_p(hist_id_stomate, 'DAILY_MAX_WIND', itime, &
+          wind_speed_daily, npts, hori_index)
+ENDIF! 
+ 
+END SUBROUTINE wind_damage
+
+
+  !! =============================================================================================
+  !! SUBROUTINE      : calculate_wind_process
+  !!
+  !>\BRIEF           : This subroutine calculates the breaking and overturning critical wind
+  !!                   speeds
+  !! 
+  !! DESCRIPTION	   : None
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! RETURN VALUE    : 
+  !!
+  !! REFERENCES      :
+  !!
+  !! FLOWCHART       : None
+  !! \streamlining_n 
+  !_ =============================================================================================
+     
+    SUBROUTINE calculate_wind_process(critical_moment,&
+               a_current_spacing, a_canopy_depth, a_canopy_breadth, a_canopy_height, &
+               a_streamlining_n, a_streamlining_c, &
+               guess_wind_speed_sub, surf_rough, zp_displ, a_distance_from_force)
+  
+    IMPLICIT NONE
+  
+  !! 0. Variable and parameter declaration
+  
+      !! 0.1 Input variables
+      REAL, INTENT(in)  :: a_current_spacing
+      REAL, INTENT(in)  :: a_canopy_depth
+      REAL, INTENT(in)  :: a_canopy_breadth 
+      REAL, INTENT(in)  :: a_canopy_height 
+      REAL, INTENT(in)  :: critical_moment
+      REAL, INTENT(in)  :: a_streamlining_n
+      REAL, INTENT(in)  :: a_streamlining_c
+      REAL, INTENT(in)  :: a_distance_from_force
+    
+      !! 0.2 Output variables
+  
+      REAL, INTENT(out) :: guess_wind_speed_sub       !! A guess for the
+                                                      !! critical wind speed
+      REAL, INTENT(out) :: surf_rough
+      REAL, INTENT(out) :: zp_displ                       
+      !! 0.3 Modified variables
+  
+      !! 0.4 Local variables
+      INTEGER           :: loop_count                 !! Counting the iteration
+      INTEGER           :: max_count=20               !! Max iteration times set to 20 iterations              
+      REAL              :: delta                      !! Difference between the guessed
+                                                      !! and the calculated wind speed
+      REAL              :: wind_precision             !! How close we should
+                                                      !! get with the iterations
+      REAL              :: lambda                     !!
+      REAL              :: lambda_capital 
+      REAL              :: gamma_solved
+      REAL              :: psih
+      REAL              :: critical_moment_cws
+      
+      !! 0.5 Variables used in  calculate_force subroutine and  calculate_bending_moment subroutine                  
+      REAL              :: gammaSolved
+      REAL              :: d
+      REAL              :: force_on_tree
+      REAL              :: height_of_force
+      REAL              :: bending_moment  
+      REAL              :: porosity
+      REAL              :: crit_wind_speed
+      
+!_ =============================================================================================
+  
+  !! 1. Subroutine
+  
+  ! This bit belongs to the original form of doing the iterations. For more info, see the notes below.
+  !  guess_wind_speed_sub = 64.0
+  !  delta = guess_wind_speed_sub / 2.0
+ 
+     guess_wind_speed_sub = 25.0
+     delta = guess_wind_speed_sub / 2.0 
+     wind_precision = 0.01
+     loop_count = 0
+     DO WHILE (delta > wind_precision)
+        CALL streamlining(guess_wind_speed_sub, &
+             a_current_spacing, a_canopy_breadth, a_canopy_depth, a_canopy_height, & 
+             a_streamlining_n, a_streamlining_c, &
+             porosity, lambda, lambda_capital, gamma_solved, &
+             zp_displ, psih, surf_rough)
+        ! The input variable of the subroutine is passed towards the call of another subroutine:
+        critical_moment_cws = critical_moment
+  
+        CALL calculate_cws(critical_moment_cws, zp_displ, &
+             gamma_solved, a_current_spacing, &
+             crit_wind_speed, a_distance_from_force)
+
+        ! We use the absolute error as the criteria for stopping the iteration
+        ! loop    
+        delta = abs( guess_wind_speed_sub - crit_wind_speed ) 
+  
+        guess_wind_speed_sub = crit_wind_speed
+        
+        loop_count = loop_count  +1      
+        ! Add the maximum iteration times condition for CWS calculation
+        IF (loop_count .GE. max_count) THEN
+            WRITE(numout,*) 'WARANNING from stomate_windthrow.f90: The maximum iteration times for CWS claculation!!'  
+            EXIT
+        ENDIF
+    END DO
+     
+    END SUBROUTINE calculate_wind_process
+  
+  
+   
+  
+  !! ===========================================================================================
+  !! SUBROUTINE      : streamlining
+  !!
+  !>\BRIEF           : This subroutine calculates the streamlining of tree crowns. Streamlining is
+  !!                   the change of shape of the crowns due to wind.
+  !! 
+  !! DESCRIPTION	   : None
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! RETURN VALUE    : Surface roughness and zero-plane displacement among other variables that
+  !!                   are used in the other subroutines
+  !! REFERENCES      :
+  !!                   Raupach (1994) Simplified expressions for vegetation roughness length and
+  !!                   zero-plane displacement as functions of canopy height and area index, Boundary-Layer Meteorology 
+  !!                   October 1994, Volume 71, Issue 1, pp 211-216, doi: 10.1007/BF00709229
+  !!
+  !! FLOWCHART       : None
+  !! \streamlining_n 
+  !_ ============================================================================================
+     
+    SUBROUTINE streamlining(a_guess_wind_speed, a_current_spacing, &
+               a_canopy_breadth, a_canopy_depth, a_mean_height, &
+               a_streamlining_n, a_streamlining_c, &
+               porosity_sub, lambda_sub, lambda_capital_sub, &
+               gamma_solved_sub, zp_displ_sub, psih_sub, surf_rough_sub)
+  
+    IMPLICIT NONE
+  !! 0. Variable and parameter declaration
+  
+      !! 0.1 Input variables
+  
+      REAL,  INTENT(in)  :: a_guess_wind_speed  !! the guess wind speed (m s{-1})
+      REAL,  INTENT(in)  :: a_current_spacing   !! the average spacing between trees (m)
+      REAL,  INTENT(in)  :: a_canopy_breadth    !! the maximum width of the canopy   (m)
+      REAL,  INTENT(in)  :: a_canopy_depth      !! the length of the live tree crown (m)
+      REAL,  INTENT(in)  :: a_mean_height       !! the mean canopy height (m) 
+      REAL,  INTENT(in)  :: a_streamlining_n    !! streamlining parameter n (-) see Eq. A12 in Hale et al 2015
+      REAL,  INTENT(in)  :: a_streamlining_c    !! streamlining parameter c (-) see Eq. A12 in Hale et al 2015  
+ 
+      !! 0.2 Output variables
+  
+      REAL, INTENT(out)  :: porosity_sub       !! the effective drag ?? (-)
+                                               !! see equation A12 in the supplementary material of Hale et al (2015)
+      REAL, INTENT(out)  :: lambda_sub         !! roughness density, the frontal
+                                               !! area of roughness elements
+      REAL, INTENT(out)  :: lambda_capital_sub !! canopy area index 
+      REAL, INTENT(out)  :: gamma_solved_sub   !! a function for solving surface roughness (-)   
+      REAL, INTENT(out)  :: zp_displ_sub       !! zero plane of displacement height (m)
+      REAL, INTENT(out)  :: psih_sub           !! stability correction function for heat transfer (-)  
+      REAL, INTENT(out)  :: surf_rough_sub     !! surface roughness (m)
+  
+      !! 0.3 Modified variables
+  
+      !! 0.4 Local variables
+!      REAL :: current_spacing                 !! the average spacing between trees (m)
+!      REAL :: canopy_breadth                  !! the maximum width of the canopy   (m)
+!      REAL :: canopy_depth                    !! the length of the live tree crown (m)
+
+      !! The aerodynamic parameter values used here are based on the reference of Raupach (1994)
+      !! --- TEMP ----
+      !! Need to be discussed for the consistency in the ORCHIDEE
+      !! ------------         
+      REAL, PARAMETER :: c_displacement = 7.5   
+      REAL, PARAMETER :: c_surface = 0.003             
+      REAL, PARAMETER :: c_drag = 0.3               
+      REAL, PARAMETER :: c_roughness = 2.0      
+      REAL, PARAMETER :: lambda_capital_max = 0.6
+      REAL, PARAMETER :: wind_streamlining_max = 25.0 
+      REAL, PARAMETER :: wind_streamlining_min = 10.0
+   !_ =============================================================================================
+  
+  !! 1. Subroutine
+  
+     IF (a_guess_wind_speed > wind_streamlining_max) THEN
+     ! Above 25 m/s, tree crowns cannot streamline any further.
+     ! The porosity set to its minimum value 2.35*25^-0.51 ~ 0.46
+        porosity_sub = a_streamlining_c * wind_streamlining_max**(-a_streamlining_n)            
+        ELSE IF ( a_guess_wind_speed < wind_streamlining_min ) THEN
+        ! Below 10 m/s, tree crowns do not streamline and porosity set to its
+        ! maximum value 2.35*10^-0.51 ~ 0.73
+        porosity_sub = a_streamlining_c * wind_streamlining_min**(-a_streamlining_n)            
+        ELSE
+        ! Wind speed between 10 m/s and 25 m/s,  tree crown do the streamlining 
+        porosity_sub = a_streamlining_c * a_guess_wind_speed**(-a_streamlining_n)
+     END IF
+ 
+     ! lambda_sub = (a_canopy_breadth/2.0) * a_canopy_depth *  porosity_sub / a_current_spacing **2.0
+     ! Here, we directly calculated the mean width of canopy from the value of "a_canopy_breadth"  
+     ! The shape of tree crown is not rhomboid anymore. In the ORCHIDEE-CAN
+     ! the shape of tree crown is circle, so the frontal area should be
+     ! calculated as (pi/4 * a_canopy_breadth * a_canopy_depth). 
+     lambda_sub = a_canopy_breadth * a_canopy_depth *  porosity_sub / a_current_spacing **2.0
+     
+     lambda_capital_sub = lambda_sub
+
+     IF (lambda_capital_sub > lambda_capital_max) THEN
+        ! Gamma is needed for the calculation of the roughness length.
+        gamma_solved_sub = 1.0 / ((c_surface + c_drag * lambda_capital_max / 2.0)**0.5)
+        ELSE
+        gamma_solved_sub = 1.0 / ((c_surface + c_drag * lambda_capital_sub / 2.0)**0.5)
+     END IF
+  
+     ! Calculation of the zero-plane displacement: 
+     ! see equations from A7 to A11 in the supplementary material of Hale et al. (2015)  
+     zp_displ_sub = a_mean_height * (1.0 - ((1.0 - EXP(-(c_displacement * &
+     lambda_capital_sub)**0.5)) / (c_displacement * lambda_capital_sub)**0.5))
+      
+     ! Calculation of the aerodynamic roughness length:
+     ! psih = "Profile influence function" at h (height of the roughness elements).
+     psih_sub = LOG(c_roughness) -1.0 + c_roughness**(-1.0)
+
+     surf_rough_sub = (a_mean_height - zp_displ_sub) * EXP(psih_sub - ct_karman * gamma_solved_sub)
+
+  !!++++++++++++++++++
+ 
+    END SUBROUTINE streamlining
+
+  
+  
+  
+  !! ============================================================================================
+  !! SUBROUTINE      : calculate_force
+  !!
+  !>\BRIEF           : This subroutine calculates the force affecting the tree.
+  !! 
+  !! DESCRIPTION	   : None
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! RETURN VALUE    : 
+  !!
+  !! REFERENCES      :
+  !!
+  !! FLOWCHART       : None
+  !! \streamlining_n 
+  !_ ============================================================================================
+     
+    SUBROUTINE calculate_force(a_guess_wind_speed, a_gamma_solved, &
+                               a_zp_displ, a_current_spacing, a_mean_height, & 
+                               force_on_tree_sub, height_of_force_sub)
+  
+    IMPLICIT NONE
+  
+  !! 0. Variable and parameter declaration
+  
+      !! 0.1 Input variables
+  
+      REAL, INTENT(in)  :: a_guess_wind_speed
+      REAL, INTENT(in)  :: a_gamma_solved
+      REAL, INTENT(in)  :: a_zp_displ
+      REAL, INTENT(in)  :: a_current_spacing
+      REAL, INTENT(in)  :: a_mean_height
+      !! 0.2 Output variables
+  
+      REAL, INTENT(out) :: force_on_tree_sub
+      REAL, INTENT(out) :: height_of_force_sub
+  
+      !! 0.3 Modified variables
+  
+      !! 0.4 Local variables
+      REAL,PARAMETER    :: air_density = 1.2226 !!This should call from constant.f90 (kg m^{-3}) 
+  !_ =============================================================================================
+  
+  !! 1. Subroutine
+  
+     force_on_tree_sub = air_density * (a_guess_wind_speed * &
+                                        a_current_spacing / a_gamma_solved)**2.0
+!! --- TEMP ---
+!!   I checked with the reference the force of wind can be calculated as 
+!!   air_density*ustar^{2}*D^{2} as the gamma is defined as  U/ustar , D is the current spacing
+!!   the force of wind should be as 
+!!   force_on_tree_sub = air_density * (U/gamma)^{2} * D^{2}
+!! ------------
+
+     height_of_force_sub = a_zp_displ
+  
+     ! The maximum of the zero-plane displacement height is locked at 0.8 tree height.
+     ! IF (height_of_force_sub > 0.8 * a_mean_height) THEN
+     !    height_of_force_sub = 0.8 * a_mean_height
+     ! END IF
+ 
+    END subroutine calculate_force
+  
+  
+  !! =============================================================================================
+  !! SUBROUTINE      : calculate_bending_moment
+  !!
+  !>\BRIEF           : Subroutine to calculate the bending moment
+  !!                   (to compare with critical moments in the iterative calculation of the critical
+  !!                   wind speeds)
+  !! 
+  !! DESCRIPTION	   : None
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! RETURN VALUE    : 
+  !!
+  !! REFERENCES      :
+  !!
+  !! FLOWCHART       : None
+  !! \streamlining_n 
+  !_ =============================================================================================
+     
+    SUBROUTINE calculate_bending_moment (a_force_on_tree, a_height_of_force, bending_moment_sub)
+  
+    IMPLICIT NONE
+  
+  !! 0. Variable and parameter declaration
+  
+      !! 0.1 Input variables
+  
+      REAL, INTENT(in)  :: a_force_on_tree 
+      REAL, INTENT(in)  :: a_height_of_force
+  
+      !! 0.2 Output variables
+  
+      REAL, INTENT(out) :: bending_moment_sub
+  
+      !! 0.3 Modified variables
+   
+      !! 0.4 Local variables
+      REAL              :: f_crown_mass 
+  !_ =============================================================================================
+  
+  !! 1. Subroutine
+  
+     bending_moment_sub = a_force_on_tree * a_height_of_force * f_crown_mass
+  
+    END SUBROUTINE calculate_bending_moment
+  
+  
+  
+  !! =============================================================================================
+  !! SUBROUTINE      : calculate_cws
+  !!
+  !>\BRIEF           : Subroutine to calculate critical wind speed
+  !!                   (to compare with wind speeds used for calculating streamlining in the
+  !!                   iterative calculation of the final critical wind speed)
+  !! 
+  !! DESCRIPTION	   : None
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! RETURN VALUE    : 
+  !!
+  !! REFERENCES      :
+  !!
+  !! FLOWCHART       : None
+  !! \streamlining_n 
+  !_ =============================================================================================
+     
+    SUBROUTINE calculate_cws(critical_moment_sub, zp_displ_sub, gamma_solved_sub, &
+               current_spacing_sub, crit_wind_speed_sub, distance_from_force_sub)
+  
+    IMPLICIT NONE
+  
+  !! 0. Variable and parameter declaration
+  
+      !! 0.1 Input variables
+  
+      REAL, INTENT(in)  :: critical_moment_sub
+      REAL, INTENT(in)  :: zp_displ_sub
+      REAL, INTENT(in)  :: gamma_solved_sub
+      REAL, INTENT(in)  :: current_spacing_sub
+      REAL, INTENT(in)  :: distance_from_force_sub
+      ! f_crown_mass and rho are parameters.
+  
+      !! 0.2 Output variables
+  
+      REAL, INTENT(out) :: crit_wind_speed_sub
+  
+      !! 0.3 Modified variables
+  
+      !! 0.4 Local variables
+      REAL, PARAMETER :: air_density = 1.2250    
+      REAL, PARAMETER :: f_crown_mass = 1.136
+      REAL, PARAMETER :: f_knots = 1.000
+ !_ =============================================================================================
+  
+  !! 1. Subroutine
+  
+     crit_wind_speed_sub = (gamma_solved_sub / current_spacing_sub) * (critical_moment_sub / &
+     (f_crown_mass * air_density * (zp_displ_sub - distance_from_force_sub) ))**0.5
+  
+     END SUBROUTINE calculate_cws
+  
+  
+  
+ 
+  !! =============================================================================================
+  !! SUBROUTINE      : elevate
+  !!
+  !>\BRIEF           : This subroutine converts the critical wind speeds calculated above to the
+  !!                   wind speed 10 meters above the zero-plane displacement
+  !! 
+  !! DESCRIPTION	   : None
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! RETURN VALUE    : 
+  !!
+  !! REFERENCES      :
+  !!
+  !! FLOWCHART       : None
+  !! \streamlining_n 
+    SUBROUTINE elevate(uh_speed, the_surf_rough, the_zp_displ, the_mean_height,elevate_result_sub)
+  
+    IMPLICIT NONE
+  
+  !! 0. Variable and parameter declaration
+  
+      !! 0.1 Input variables
+  
+      REAL,  INTENT(in)  :: uh_speed
+      REAL,  INTENT(in)  :: the_surf_rough
+      REAL,  INTENT(in)  :: the_zp_displ
+      REAL,  INTENT(in)  :: the_mean_height
+      
+      !! 0.2 Output variables
+  
+      REAL, INTENT(out)  :: elevate_result_sub
+  
+      !! 0.3 Modified variables
+  
+      !! 0.4 Local variables
+  
+  !_ ==============================================================================================
+  
+  !! 1. Subroutine
+  
+     elevate_result_sub = uh_speed * log(10.0 / the_surf_rough) / &
+               log((the_mean_height - the_zp_displ) / the_surf_rough)
+  
+    END SUBROUTINE elevate
+
+
+
+END MODULE stomate_windthrow
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/context_orchidee.xml
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/context_orchidee.xml	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/context_orchidee.xml	(revision 6412)
@@ -0,0 +1,93 @@
+<!-- =========================================================================================================== -->
+<!-- ORCHIDEE context                                                                                            -->
+<!-- context_orchidee.xml : Configuration file for ORCHIDEE for production of output files using XIOS            -->
+<!--                                                                                                             -->
+<!-- $HeadURL$                --> 
+<!-- $Date$                                                     -->
+<!-- $Revision$                                                                                           -->
+<!-- =========================================================================================================== -->
+<context id="orchidee">
+  
+  
+  <!-- =========================================================================================================== -->
+  <!-- Definition of all existing variables                                                                        -->
+  <!-- DO NOT CHANGE THIS FILE                                                                                     -->
+  <!-- =========================================================================================================== -->
+  <field_definition src="./field_def_orchidee.xml"/>
+  
+  
+  <!-- =========================================================================================================== -->
+  <!-- Definition of output files                                                                                  -->
+  <!-- Definition of variables or groups included in the different files                                           -->
+  <!-- CHANGE THIS FILE BY ADDING THE FILES AND/OR VARIABLES YOU WANT TO PRODUCE                                   -->
+  <!-- Only variables and groups existing in field_def_orchidee.xml can be used                                    -->
+  <!-- =========================================================================================================== -->
+  <file_definition src="./file_def_orchidee.xml"/>
+  
+  
+  <!-- =========================================================================================================== -->
+  <!-- Definition of horizontal domain                                                                             -->
+  <!-- =========================================================================================================== -->
+  <domain_definition>
+    <domain id="domain_landpoints"/>
+  </domain_definition>
+  
+  <!-- =========================================================================================================== -->
+  <!-- Definition of vertical axis and extra dimensions                                                            -->
+  <!-- =========================================================================================================== -->
+  <axis_definition>
+    <!-- Vertical axis and extra dimensions in sechiba -->
+    <axis id="nvm" name="veget" standard_name="model_level_number" long_name="Vegetation types" unit="1"/>
+    <axis id="nlaip1" name="laiax" standard_name="model_level_number" long_name="Interface of LAI layers" unit="1"/>
+    <axis id="ngrnd" name="solth" standard_name="model_level_number" long_name="Thermal soil levels" unit="m"/>
+    <axis id="nstm" name="soiltyp" standard_name="model_level_number" long_name="Soil tiles" unit="1"/>
+    <axis id="nnobio" name="nobio" standard_name="model_level_number" long_name="Other surface types" unit="1"/>
+    <axis id="albtyp" standard_name="model_level_number" long_name="Albedo types" unit="1"/>
+    <axis id="nslm" name="solay" standard_name="model_level_number" long_name="Hydrological soil levels" unit="1"/>
+    <axis id="nbdl" name="soildiag" standard_name="model_level_number" long_name="Diagnostic soil levels" unit="m"/>
+    <axis id="nsnow" name="snowlev" standard_name="model_level_number" long_name="Snow levels" unit="1"/>
+    <axis id="nlevels_tot" standard_name="model_level_number" long_name="Total number of vertical levels" unit="1"/>
+
+    <!-- Vertical axis and extra dimensions in stomate -->
+    <axis id="P10" standard_name="model_level_number" long_name="Pool 10 years" unit="1"/>
+    <axis id="P100" standard_name="model_level_number" long_name="Pool 100 years" unit="1"/>
+    <axis id="P11" standard_name="model_level_number" long_name="Pool 10 years + 1" unit="1"/>
+    <axis id="P101" standard_name="model_level_number" long_name="Pool 100 years + 1" unit="1"/>
+    <axis id="nshort" standard_name="model_level_number" long_name="short-lived product pool" unit="yr"/>
+    <axis id="nmedium" standard_name="model_level_number" long_name="medium-lived product pool" unit="yr"/>
+    <axis id="nlong" standard_name="model_level_number" long_name="long-lived product pool" unit="yr"/>
+    <axis id="nshort1" standard_name="model_level_number" long_name="short-lived product pool" unit="yr"/>
+    <axis id="nmedium1" standard_name="model_level_number" long_name="medium-lived product pool" unit="yr"/>
+    <axis id="nlong1" standard_name="model_level_number" long_name="long-lived product pool" unit="yr"/>
+    <axis id="ncirc" standard_name="model_level_number" long_name="circumference classes" unit="1"/>
+    <axis id="ncut" standard_name="model_level_number" long_name="types of cuttings" unit="1"/>
+  </axis_definition>
+
+  <grid_definition>
+    <grid id="grid_nslm_nstm">
+      <domain id="domain_landpoints" />
+      <axis id="nslm" />
+      <axis id="nstm" />
+    </grid>
+
+    <grid id="grid_nvm_nstm">
+      <domain id="domain_landpoints" />
+      <axis id="nvm" />
+      <axis id="nstm" />
+    </grid>
+
+    <grid id="grid_nvm_ncirc">
+      <domain id="domain_landpoints" />
+      <axis id="nvm" />
+      <axis id="ncirc" />
+    </grid>
+
+    <grid id="grid_nvm_nlevelstot">
+      <domain id="domain_landpoints" />
+      <axis id="nvm" />
+      <axis id="nlevels_tot" />
+    </grid>
+
+  </grid_definition>
+
+</context>
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/field_def_orchidee.xml
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/field_def_orchidee.xml	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/field_def_orchidee.xml	(revision 6412)
@@ -0,0 +1,599 @@
+<!-- =========================================================================================================== -->
+<!-- field_def_orchidee.xml : Definition of all existing variables                                               -->
+<!-- This file must only be changed if a call xios_orchidee_send_field is added, changed or removed              -->
+<!--                                                                                                             --> 
+<!-- $HeadURL$              --> 
+<!-- $Date$                                                     --> 
+<!-- $Revision$                                                                                           -->
+<!-- =========================================================================================================== -->
+
+<field_definition id="orchidee" prec="4" operation="average" freq_op="1ts" enabled=".TRUE." default_value="9.96921e+36">
+
+
+  <!-- Definition of all variables in sechiba -->
+  <field_group id="sechiba" domain_ref="domain_landpoints">
+    <field id="Areas" name="Areas" long_name="Mesh areas" unit="m2" operation="once"/>
+    <field id="LandPoints" name="LandPoints" long_name="Land Points" unit="1" operation="once"/>
+    <field id="Contfrac" name="Contfrac" long_name="Continental fraction" unit="1" operation="once"/>
+    <field id="ptn" name="ptn" long_name="Deep ground temperature" unit="K" axis_ref="ngrnd"/>
+    <field id="npp" name="npp" long_name="Net Primary Production (positive from atm to land)" unit="gC/m^2/s" axis_ref="nvm"/>
+    <field id="q_cdrag" name="cdrag" long_name="Drag coefficient for LE and SH" unit="-"/>
+    <field id="bckgrnd_alb" name="bckgrnd_alb" long_name="Background bare soil albedo obained from MODIS related data-set" unit="1" axis_ref="albtyp" operation="once"/>
+    <field id="soilalb_vis" name="soilalb_vis" long_name="Soil Albedo visible" unit="1"/>
+    <field id="soilalb_nir" name="soilalb_nir" long_name="Soil Albedo near infrared" unit="1"/>
+    <field id="vegalb_vis" name="vegalb_vis" long_name="Vegetation Albedo visible" unit="1"/>
+    <field id="vegalb_nir" name="vegalb_nir" long_name="Vegetation Albedo near infrared" unit="1"/>
+    <field id="z0m" name="z0m" long_name="Surface roughness for momentum" unit="m"/>
+    <field id="z0h" name="z0h" long_name="Surface roughness for heat" unit="m"/>
+    <field id="albedo_vis" name="alb_vis" long_name="Albedo visible" unit="1"/>
+    <field id="albedo_nir" name="alb_nir" long_name="Albedo near infrared" unit="1"/>
+    <field id="albedo_glob" name="albedo_glob" long_name="Mean albedo" unit="1"> (albedo_vis + albedo_nir)*0.5 </field>
+    <field id="asoilcol" name="asoilcol" long_name="Availability of data for the soil color interpolation (negative values if no data found)" unit="1"  operation="once"/> 
+    <field id="aalb_bg" name="aalb_bg" long_name="Availability of data for the albedo interpolation from MODIS related data-set (negative values if no data found)" unit="1"  operation="once"/> 
+    <field id="atext" name="atext" long_name="Availability of data for the soil texture interpolation (negative values if no data found)" unit="1"  operation="once"/> 
+    <field id="areftemp" name="areftemp" long_name="Availability of data for the reftemp interpolation (negative values if no data found)" unit="1"  operation="once"/>
+    <field id="evap" name="evap" long_name="Evaporation" unit="mm/d"/>
+    <field id="tsol_rad" name="tsol_rad" long_name="Radiative surface temperature" unit="C"/>
+    <field id="vevapnu" name="vevapnu" long_name="Bare soil evaporation" unit="mm/d"/>
+
+    <field id="temp_sol_C" name="temp_sol" long_name="New Surface Temperature" unit="C"/>
+    <field id="temp_sol_K" name="AvgSurfT" long_name="Average surface temperature" unit="K"/>
+    <field id="tsol_max" name="tsol_max" field_ref="temp_sol_C" long_name="Maximum Surface Temperature" unit="C" operation="maximum"/>
+    <field id="tsol_min" name="tsol_min" field_ref="temp_sol_C" long_name="Minimum Surface Temperature" unit="C" operation="minimum"/>
+    <field id="temp_sol_Cloc" name="temp_sol_Cloc" field_ref="temp_sol_K" long_name="New Surface Temperature" unit="C"> temp_sol_K - 273.15  </field>
+
+    <field id="qsurf" name="qsurf" long_name="Near surface specific humidity" unit="g/g"/>
+    <field id="fluxsens" name="fluxsens" long_name="Sensible Heat Flux" unit="W/m^2"/>
+    <field id="fluxlat" name="fluxlat" long_name="Latent Heat Flux" unit="W/m^2"/>
+    <field id="emis" name="emis" long_name="Surface emissivity" unit="1"/>
+    <field id="precip_rain" name="precip_rain" long_name="Rainfall rate" unit="mm/d"/>
+    <field id="precip_snow" name="precip_snow" long_name="Snowfall rate" unit="mm/d"/>
+    <field id="netrad" name="netrad" long_name="Net radiation" unit="W/m^2"/>
+    <field id="lai" name="lai" long_name="Leaf Area Index" unit="1" axis_ref="nvm"/>
+    <field id="reinf_slope" name="reinf_slope" long_name="Slope index for each grid box" unit="1" operation="once"/>
+    <field id="aslope" name="aslope" long_name="Availability of data for the slope interpolation (negative values if no data found)" unit="1"  operation="once"/>
+    <field id="njsc" name="soilindex" long_name="Index of soil texture" unit="1" operation="once"/>  
+    <field id="runoff" name="runoff_sec" long_name="Surface runoff" unit="mm/s" />  
+    <field id="drainage" name="drainage_sec" long_name="Deep drainage" unit="mm/s"/>  
+    <field id="mrro" name="mrro" long_name="Total Runoff" unit="kg m-2 s-1" > runoff + drainage </field>  
+    <field id="evapnu_soil" name="evapnu_soil" long_name="Bare soil evap for soil type" unit="mm/d" axis_ref="nstm" > this*86400 </field>  
+    <field id="drainage_soil" name="drainage_soil" long_name="Drainage for soil type" unit="mm/d" axis_ref="nstm" > this*86400 </field>  
+    <field id="transpir_soil" name="transpir_soil" long_name="Transpir for soil type" unit="mm/d" axis_ref="nstm" > this*86400 </field>  
+    <field id="runoff_soil" name="runoff_soil" long_name="Runoff for soil type" unit="mm/d" axis_ref="nstm" > this*86400 </field>  
+    <field id="tair" name="tair" long_name="Air Temperature" unit="K"/>
+    <field id="qair" name="qair" long_name="Air Humidity" unit="g/g"/>
+    <field id="q2m" name="q2m" long_name="2m Air Humidity" unit="g/g"/>
+    <field id="t2m" name="t2m" long_name="2m Air temperature" unit="K"/>
+    <field id="roughheight" name="roughheight" long_name="Effective roughness height" unit="m"/>
+    <field id="transpir" name="transpir" long_name="Transpiration" unit="mm/d" axis_ref="nvm"/>
+    <field id="inter" name="inter" long_name="Interception loss" unit="mm/d" axis_ref="nvm"/>
+    <field id="evapnu" name="evapnu" long_name="Bare soil evaporation" unit="mm/d"/>
+    <field id="snow" name="snow" long_name="Snow mass" unit="kg/m^2"/>
+    <field id="snowmelt" name="snowmelt" long_name="Snow melt" unit="kg/m^2/s"/>
+    <field id="tot_melt" name="tot_melt" long_name="Total melt from ice and snow" unit="kg/m^2/s"/>
+    <field id="snowmelt_from_maxmass" name="snowmelt_from_maxmass" long_name="Snow melt above threshold" unit="kg/m^2"/>
+    <field id="soilcap" name="soilcap" long_name="Surface heat capacity considering snow and soil surface" unit="J/m^2/K"/>
+    <field id="snowage" name="snowage" long_name="Snow age" unit="?"/>
+    <field id="snownobio" name="snownobio" long_name="Snow on other surfaces" unit="kg/m^2" axis_ref="nnobio"/>
+    <field id="snownobioage" name="snownobioage" long_name="Snow age on other surfaces" unit="d" axis_ref="nnobio"/>
+    <field id="frac_snow" name="frac_snow" long_name="Snow fraction on total area including snow on vegetation and nobio" unit="1"/>
+    <field id="frac_snow_veg" name="frac_snow_veg" long_name="Snow fraction on vegeted area" unit="1"/>
+    <field id="frac_snow_nobio" name="frac_snow_nobio" long_name="Snow fraction on no vegeted area" unit="1" axis_ref="nnobio"/>
+    <field id="pgflux" name="pgflux" long_name="extra energy used for melting top snow layer" unit="W/m^2" />
+    <field id="vegetfrac" name="vegetfrac" long_name="Fraction of vegetation" unit="1" axis_ref="nvm"/>
+    <field id="maxvegetfrac" name="maxvegetfrac" long_name="Maximum fraction of vegetation" unit="1" axis_ref="nvm"/>
+    <field id="aveget" name="aveget" long_name="Availability of data for the vegetation fraction interpolation (negative values if no data found)" unit="1"  operation="once"/>
+    <field id="aveget5k" name="aveget5k" long_name="Availability of data for the Olson vegetation fraction interpolation (negative values if no data found)" unit="1"  operation="once"/>
+    <field id="tot_bare_soil" name="tot_bare_soil" long_name="Total Bare Soil Fraction" unit="%"/>
+    <field id="nobiofrac" name="nobiofrac" long_name="Fraction of other surface types" unit="1" axis_ref="nnobio"/>
+    <field id="frac_bare" name="frac_bare" long_name="Bare soil fraction for each tile" unit="-" axis_ref="nvm"/>
+    <field id="soiltile" name="soiltile" long_name="Fraction of soil tiles" unit="%" axis_ref="nstm" operation="once"/>
+   <field id="humtot_top" name="mrsos" long_name="Moisture in top 10cm (6 top soil layers with CWRR)" unit="kg m-2"/>  
+    <field id="humtot" name="humtot" long_name="Total soil moisture" unit="Kg/m^2"/>  
+    <field id="tmc" name="humtot_soil" long_name="Soil Moisture for soil tiles" unit="Kg/m^2" axis_ref="nstm"/>  
+    <field id="rstruct" name="rstruct" long_name="Structural resistance" unit="s/m" axis_ref="nvm"/>
+    <field id="r_soil" name="r_soil" long_name="Soil resistance" unit="s/m"/>
+    <field id="gpp" name="gpp" long_name="Net assimilation of carbon by the vegetation" unit="gC/m^2/s" axis_ref="nvm"/>
+    <field id="nee" name="nee" long_name="Net Ecosystem Exchange" unit="gC/m^2/s" axis_ref="nvm"/>
+    <field id="maint_resp" name="maint_resp" long_name="Maintenance respiration" unit="gC/m^2/s" axis_ref="nvm"/>
+    <field id="hetero_resp" name="hetero_resp" long_name="Heterotrophic respiration" unit="gC/m^2/s" axis_ref="nvm"/>
+    <field id="growth_resp" name="growth_resp" long_name="Growth respiration" unit="gC/m^2/s" axis_ref="nvm"/>
+    <field id="precisol" name="precisol" long_name="Throughfall per
+    PFT" unit="mm/d" axis_ref="nvm" > this*8600 </field>
+    <field id="drysoil_frac" name="drysoil_frac" long_name="Fraction of visibly dry soil" unit="1"/>
+    <field id="evapot" name="evapot" long_name="Potential evaporation" unit="mm/s"/>
+    <field id="evapot_corr" name="evapot_corr" long_name="Potential evaporation correction" unit="mm/s"/>
+    <field id="swnet" name="swnet" long_name="Net solar radiation" unit="W/m^2"/>
+    <field id="swdown" name="swdown" long_name="Incident solar radiation" unit="W/m^2"/>
+    <field id="lwdown" name="lwdown" long_name="Absorbed downward longwave radiation" unit="W/m^2"/>
+    <field id="lwnet" name="lwnet" long_name="Net surface longwave radiation" unit="W/m^2"/>
+    <field id="diffevap" name="diffevap" long_name="Difference betwence vevapp and composing fluxes in enerbil" unit="Kg/m^2/s"/>
+    <field id="k_litt" name="k_litt" long_name="Litter cond" unit="mm/d"/>
+    <field id="beta" name="beta" long_name="Beta Function" unit="1"/>
+    <field id="raero" name="raero" long_name="Aerodynamic resistance" unit="s/m"/>
+    <field id="wind" name="Wind" long_name="Wind speed" unit="m/s"/>
+    <field id="qsatt" name="qsatt" long_name="Surface saturated humidity" unit="g/g"/>
+    <field id="vbeta1" name="vbeta1" long_name="Beta for sublimation" unit="1"/>
+    <field id="vbeta4" name="vbeta4" long_name="Beta for bare soil" unit="1"/>
+    <field id="vbeta5" name="vbeta5" long_name="Beta for floodplains" unit="1"/>
+    <field id="gsmean" name="gsmean" long_name="beta for CO2" unit="molCO2 m-2 s-1" axis_ref="nvm"/>
+    <field id="humrel" name="humrel" long_name="Soil moisture stress for transpiration (it is not the relative humidity)" unit="1" axis_ref="nvm"/>
+    <field id="cimean" name="cimean" long_name="Stomatal CO2 concentation" unit="mmole/m2/s" axis_ref="nvm" enabled=".TRUE."/>
+    <field id="vbeta3" name="vbeta3" long_name="Beta for Transpiration" unit="mm/d" axis_ref="nvm"/>
+    <field id="rveget" name="rveget" long_name="Canopy resistance" unit="s/m" axis_ref="nvm"/>
+    <field id="vbeta2" name="vbeta2" long_name="Beta for Interception loss" unit="mm/d" axis_ref="nvm"/>
+    <field id="qsintveg_tot" name="CanopInt" long_name="Water on canopy (grid-cell total)" unit="Kg/m^2"/>    
+    <field id="qsintveg" name="qsintveg" long_name="Water on canopy per PFT" unit="Kg/m^2" axis_ref="nvm"/>  
+    <field id="qsintmax" name="qsintmax" long_name="Maximum Interception capacity per PFT" unit="Kg/m^2" axis_ref="nvm"/>  
+    <field id="prveg" name="prveg" long_name="Rainfall interception by canopy" unit="kg m-2 s-1"/>  
+    <field id="evspsblveg" name="evspsblveg" long_name="Evaporation from canopy" unit="kg m-2 s-1"/>  
+    <field id="evspsblsoi" name="evspsblsoi" long_name="Water Evaporation from Soil" unit="kg m-2 s-1"/>
+    <field id="tran" name="tran" long_name="Transpiration" unit="kg m-2 s-1"/>
+    <field id="treeFrac" name="treeFrac" long_name="Tree Cover Fraction" unit="%"/>
+    <field id="grassFrac" name="grassFrac" long_name="Natural Grass Fraction" unit="%"/>
+    <field id="cropFrac" name="cropFrac" long_name="Crop Fraction" unit="%"/>
+    <field id="baresoilFrac" name="baresoilFrac" long_name="Fraction of bare soil PFT(pft=1)" unit="%"/>
+    <field id="residualFrac" name="residualFrac" long_name="Fraction of Grid Cell that is Land but Neither Vegetation-Covered nor Bare Soil" unit="%"/>
+    <field id="PAR" name="PAR" long_name="Photosynthetic active radiation, half of swdown" unit="umol phot/m^2/s"/>
+    <field id="PARsun" name="PARsun" long_name="PAR received by sun leaves" unit="umol phot/m^2/s" axis_ref="nvm"/>
+    <field id="PARsh" name="PARsh" long_name="PAR received by shaded leaves" unit="umol phot/m^2/s" axis_ref="nvm"/>
+    <field id="laisun" name="laisun" long_name="Sunlit Leaf Area Index" unit="1" axis_ref="nvm"/>
+    <field id="laish" name="laish" long_name="Shaded Leaf Area Index" unit="1" axis_ref="nvm"/>
+    <field id="PARsuntab" name="PARsuntab" long_name="PAR received by sun leaves over LAI layers" unit="umol phot/m^2/s" axis_ref="nlaip1"/>
+    <field id="PARshtab" name="PARshtab" long_name="PAR received by shaded leaves over LAI layers" unit="umol phot/m^2/s" axis_ref="nlaip1"/>
+    <field id="coszang" name="coszang" long_name="Cosine of the solar zenith angle" unit="1"/>
+    <field id="PARdf" name="PARdf" long_name="Diffuse photosynthetic active radiation" unit="umol phot/m^2/s"/>
+    <field id="PARdr" name="PARdr" long_name="Direct photosynthetic active radiation" unit="umol phot/m^2/s"/>
+    <field id="CRF" name="CRF" long_name="Canopy reduction factor for net NO flux calculation" unit="1" axis_ref="nvm" />
+    <field id="flx_co2_bbg_year" name="flx_co2_bbg_year" long_name="CO2 emissions from biomass burning - Read in an input file" unit="kgC/m^2/yr" operation="once"/>
+    <field id="N_qt_WRICE_year" name="N_qt_WRICE_year" long_name="N fertilizers applied on wetland rice - Read in an input file" unit="kgN/yr" operation="once"/>
+    <field id="N_qt_OTHER_year" name="N_qt_OTHER_year" long_name="N fertilizers applied on other crops and grasses - Read in an input file" unit="kgN/yr" operation="once"/>
+    <field id="achem_wrice" name="achem_wrice" long_name="Availability of data for the rice fertilizers interpolation (negative values if no data found)" unit="1"  operation="once"/>
+    <field id="achem_other" name="achem_other" long_name="Availability of data for the other crops fertilizers interpolation (negative values if no data found)" unit="1"  operation="once"/>
+    <field id="achem_co2" name="achem_co2" long_name="Availability of data for the co2 bbg interpolation (negative values if no data found)" unit="1"  operation="once"/>
+    <field id="flx_iso" name="flx_iso" long_name="Isoprene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_mono" name="flx_mono" long_name="Monoterpene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_ORVOC" name="flx_ORVOC" long_name="Other Volatile Organic Compound emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_MBO" name="flx_MBO" long_name="2-methyl-3-buten-2-ol emissions from vegetation (mainly pines in America)" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_methanol" name="flx_methanol" long_name="Methanol emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_acetone" name="flx_acetone" long_name="Acetone emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_acetal" name="flx_acetal" long_name="Acetaldehyde emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_formal" name="flx_formal" long_name="Formaldehyde emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_acetic" name="flx_acetic" long_name="Acetic acid emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_formic" name="flx_formic" long_name="Formic acid emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_apinen" name="flx_apinen" long_name="Alpha pinene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_bpinen" name="flx_bpinen" long_name="Beta pinene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_limonen" name="flx_limonen" long_name="Limonene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_myrcen" name="flx_myrcen" long_name="Myrcene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_sabinen" name="flx_sabinen" long_name="Sabinene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_camphen" name="flx_camphen" long_name="Camphene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_3caren" name="flx_3caren" long_name="3-Carene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_tbocimen" name="flx_tbocimen" long_name="T-beta Ocimene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_othermono" name="flx_othermono" long_name="Emissions of other monoterpenes from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_sesquiter" name="flx_sesquiter" long_name="Sesquiterpene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_fertil_no" name="flx_fertil_no" long_name="Biogenic nitrogen oxide soil emission due to N-fertilisation" unit="ngN/m^2/s" axis_ref="nvm"/>
+    <field id="flx_no_soil" name="flx_no_soil" long_name="Nitrogen Oxide emissions from soil, before deposition on canopy" unit="ngN/m^2/s" axis_ref="nvm"/>
+    <field id="flx_no" name="flx_no" long_name="Net nitrogen Oxide emissions from soil, after deposition on canopy" unit="ngN/m^2/s" axis_ref="nvm"/>
+    <field id="fco2" name="fco2" long_name="Function for CO2 impact on BVOC (isoprene)" unit="1" axis_ref="nvm" />
+    <field id="cim" name="cim" long_name="Intercellular CO2 over nlai" unit="ppm" axis_ref="nvm" />
+    <field id="Psurf" name="Psurf" long_name="Surface pressure" unit="Pa"/>
+    <field id="slowflow" name="Qb" long_name="Slowflow hydrographs of gridbox outflow" unit="m^3/s"/>  
+    <field id="LAImean" name="LAImean" long_name="Mean Leaf Area Index" unit="-"/>
+   <field id="mcs" name="SoilSat" long_name="Mean volumetric water content at saturation" unit="m^3/m^3" axis_ref="nslm" operation="once"/>     
+    <field id="nroot" name="RootDist" long_name="Cumulative root density (grid-cell average)" unit="1"  axis_ref="nslm" operation="once"/>     
+    <field id="dlh" name="SoilThick" long_name="Hydrological soil layer thickness" unit="m"  axis_ref="nslm" operation="once"/>     
+    <field id="water2infilt" name="water2infilt" long_name="Storage of surface runoff kept for future infiltration(already included in humtot)" unit="Kg/m^2" axis_ref="nstm"/>    
+    <field id="pkappa" name="pkappa" long_name="Soil thermal conductivity" unit="W/m/K" axis_ref="ngrnd"/>  
+    <field id="pkappa_snow" name="pkappa_snow" long_name="Snow thermal conductivity" unit="W/m/K" axis_ref="nsnow"/>  
+    <field id="pcapa" name="pcapa" long_name="Soil heat capacity" unit="J/m^3/K" axis_ref="ngrnd"/>  
+    <field id="pcapa_snow" name="pcapa_snow" long_name="Snow heat capacity" unit="J/m^3/K" axis_ref="nsnow"/>  
+    <field id="snowtemp" name="snowtemp" long_name="snow temperature" unit="K" axis_ref="nsnow"/>  
+    <field id="snowliq" name="snowliq" long_name="Snow liquid content" unit="m" axis_ref="nsnow"/>  
+    <field id="snowdz" name="snowdz" long_name="Snow layer thickness" unit="m" axis_ref="nsnow"/>  
+    <field id="snowrho" name="snowrho" long_name="Snow denisty" unit="Kg/m^3" axis_ref="nsnow"/>  
+    <field id="snowheat" name="snowheat" long_name="Snow heat content" unit="J/m^2" axis_ref="nsnow"/>  
+    <field id="snowgrain" name="snowgrain" long_name="Snow grain size" unit="m" axis_ref="nsnow"/>  
+    <field id="vevapp" name="vevapp" long_name="Total evaporation" unit="kg/m^2/d"/>
+
+<!-- Routing -->  
+    <field id="basinmap" name="basinmap" long_name="Aproximate map of the river basins" operation="once"/>  
+    <field id="nbrivers" name="nbrivers" long_name="Number or rivers in the outflow grid box" operation="once"/>  
+    <field id="swampmap" name="swampmap" long_name="Map of swamp areas" unit="m^2" operation="once"/>  
+    <field id="irrigmap" name="irrigmap" long_name="Map of irrigated areas" unit="m^2" operation="once"/>  
+    <field id="floodmap" name="floodmap" long_name="Map of floodplains areas" unit="m^2" operation="once"/>  
+    <field id="mask_coast" name="mask_coast" long_name="Mask of coastal gridcell which can recieve coastalflow" unit="" operation="once"/>  
+    <field id="coastalflow" name="coastalflow" long_name="Diffuse coastal flow" unit="m^3/s"/>  
+    <field id="riverflow" name="riverflow" long_name="River flow to the oceans" unit="m^3/s"/>  
+    <field id="coastalflow_cpl" name="coastalflow_cpl" long_name="Diffuse coastal flow, variable distributed over a time period before sent to ocean." unit="m^3/s"/>
+    <field id="riverflow_cpl" name="riverflow_cpl" long_name="River flow to the oceans, variable distributed over a time period before sent to ocean." unit="m^3/s"/>
+    <field id="hydrographs" name="hydrographs" long_name="Hydrographs of gridbox outflow" unit="m^3/s"/>  
+    <field id="fastr" name="fastr" long_name="Fast flow reservoir" unit="kg/m^2"/>  
+    <field id="slowr" name="slowr" long_name="Slow flow reservoir" unit="kg/m^2"/>  
+    <field id="streamr" name="streamr" long_name="Stream flow reservoir" unit="kg/m^2"/>  
+    <field id="lake_overflow" name="lake_overflow" long_name="Water overflow when lake reservoir exceeds maximum capacity" unit="kg/m2/s"/>  
+    <field id="lake_overflow_coast" name="lake_overflow_coast" long_name="Water overflow when lake reservoir exceeds maximum capacity distributed on coast grid cells" unit="m3/s"/>  
+    <field id="laker" name="lakevol" long_name="Endorheic lake flow reservoir" unit="kg/m^2"/>  
+    <field id="pondr" name="pondr" long_name="Pond flow reservoir" unit="kg/m^2"/>  
+    <field id="delfastr" name="delfastr" long_name="Accumulated storage change for fast flow reservoir" unit="kg/m^2" operation="accumulate"/>  
+    <field id="delfastr_daily" field_ref="delfastr" name="delfastr_daily" long_name="Mean of storage change in fast flow reservoir accumulated over each day" unit="kg/m^2/d" freq_op="1d" operation="average" > @delfastr </field>  
+    <field id="delslowr" name="delslowr" long_name="Accumulated storage change for slow flow reservoir" unit="kg/m^2" operation="accumulate" />  
+    <field id="delslowr_daily" field_ref="delslowr" name="delslowr_daily" long_name="Mean of storage change for slow flow reservoir accumulated over each day" unit="kg/m^2/d" freq_op="1d" operation="average" > @delslowr </field>  
+    <field id="delstreamr" name="delstreamr" long_name="Accumulated storage change for stream flow reservoir" unit="kg/m^2" operation="accumulate" />  
+    <field id="delstreamr_daily" field_ref="delstreamr" name="delstreamr_daily" long_name="Mean of storage change in stream flow reservoir accumulated each day" unit="kg/m^2/d" freq_op="1d" operation="average" > @delstreamr </field>  
+    <field id="dellaker" name="dellakevol" long_name="Accumulated storage change for lake reservoir" unit="kg/m^2" operation="accumulate"/>  
+    <field id="dellaker_daily" field_ref="dellaker" name="dellakevol_daily" long_name="Mean of storage change for lake reservoir accumulated each day" unit="kg/m^2/d" freq_op="1d" operation="average" > @dellaker </field>  
+    <field id="delpondr" name="delpondr" long_name="Accumulated storage change for ponds reservoir" unit="kg/m^2" operation="accumulate"/>  
+    <field id="delpondr_daily" field_ref="delpondr" name="delpondr_daily" long_name="Mean of storage change for ponds reservoir accumulated over each day"  freq_op="1d" unit="kg/m^2/d" operation="average" > @delpondr </field>
+    <field id="delfloodr" name="delfloodr" long_name="Accumulated storage change for floodplains reservoir" unit="kg/m^2" operation="accumulate" />  
+    <field id="delfloodr_daily" field_ref="delfloodr" name="delfloodr_daily" long_name="Mean of storage change for floodplains reservoir accumulated over each day" unit="kg/m^2/d" freq_op="1d" operation="average" > @delfloodr </field>  
+    <field id="delstock_routing" name="delstock_routing" long_name="Mean of storage change in all routing reservoirs accumulated each day" unit="kg/m^2"> delstreamr_daily + delfastr_daily + delslowr_daily + delfloodr_daily + delpondr_daily + dellaker_daily </field>   
+    <field id="wbr_fast" name="wbr_fast" long_name="Water budget residu of the fast reservoir" unit="kg/m^2/s"/>  
+    <field id="wbr_slow" name="wbr_slow" long_name="Water budget residu of the slow reservoir" unit="kg/m^2/s"/>  
+    <field id="wbr_stream" name="wbr_stream" long_name="Water budget residu of the stream reservoir" unit="kg/m^2/s"/>  
+    <field id="wbr_lake" name="wbr_lake" long_name="Water budget residu of the lake reservoir" unit="kg/m^2/s"/>  
+    <field id="irrigation" name="irrigation_sec" long_name="Irrigation" unit="mm/s"/>
+    <field id="netirrig" name="netirrig_sec" long_name="Irrigation requirement" unit="mm/s"/>
+    <field id="floodh" name="floodh" long_name="Floodplains height" unit="mm"/>
+    <field id="floodr" name="floodr" long_name="Floodplains flow reservoir" unit="kg/m^2"/>  
+    <field id="floodout" name="floodout" long_name="Flow out of floodplains" unit="mm/d" > this*86400 </field>  
+    <field id="evapflo" name="evapflo" long_name="Floodplains evaporation" unit="mm/d"/>  
+    <field id="riversret" name="riversret" long_name="Water flow return from lakes and swamps into the soil" unit="mm/d" > this*86400 </field>  
+    <field id="reinfiltration" name="reinfiltration" long_name="Reinfiltration from floodplains and ponds" unit="mm/d" > this*86400 </field>  
+
+    <!-- ALMA -->
+    <field id="twbr" name="TWBR" long_name="Total water budget residu" unit="Kg/m^2/s"/>
+    <field id="soilflx" name="Qg" long_name="Ground heat flux" unit="W/m^2"/>
+    <field id="Qv" name="Qv" long_name="Energy of sublimation" unit="W/m^2"/>
+    <field id="surfheat_incr" name="DelSurfHeat" long_name="Accumulated change in surface layer heat" unit="J/m^2" operation="accumulate"/>
+    <field id="coldcont_incr" name="DelColdCont" long_name="Accumulated change in snow surface layer cold content" unit="J/m^2" operation="accumulate"/>
+    <field id="dr_corrnum" name="Qsb_corrnum" long_name="Adjustement flux added to drainage (numerical errors in tridiag)" unit="kg/m^2/s"/>
+    <field id="delsoilmoist" name="DelSoilMoist" long_name="Accumulated change in soil moisture (grid-cell total)" unit="kg/m^2" operation="accumulate"/>  
+    <field id="delsoilmoist_daily" field_ref="delsoilmoist"  name="DelSoilMoist_daily" long_name="Change in soil moisture acumulated over each day (grid-cell total)" unit="kg/m^2/d" freq_op="1d" operation="average" > @delsoilmoist </field>
+    <field id="delintercept" name="DelIntercept" long_name="Accumulated change in interception storage (grid-cell total)" unit="kg/m^2" operation="accumulate"/>
+    <field id="delintercept_daily" field_ref="delintercept" name="DelIntercept_daily" long_name="Change in interception storage accumulated over each day" unit="kg/m^2/d" freq_op="1d" operation="average" > @delintercept </field>  
+    <field id="delswe" name="DelSWE" long_name="Accumulated change in Snow Water Equivalent (grid-cell total)" unit="kg/m^2" operation="accumulate"/>  
+    <field id="delswe_daily" field_ref="delswe" name="DelSWE_daily" long_name="Change in Snow Water Equivalent accumulated over each day" unit="kg/m^2/d" freq_op="1d" operation="average" > @delswe </field> 
+    <field id="PotSurfT" name="PotSurfT" long_name="Potential (Unstressed) surface temperature" unit="K"/>
+    <field id="SurfStor" name="SurfStor" long_name="Surface water Storage" unit="Kg/m^2"> laker+pondr+floodr </field>
+    <field id="soilmoist" name="SoilMoist" long_name="3D average layer soil moisture" unit="kg/m^2" axis_ref="nslm"/>  
+    <field id="soilwet" name="SoilWet" long_name="Total soil wetness" unit="1"/>
+    <field id="ECanop" name="ECanop" long_name="Interception evaporation" unit="kg/m^2/s"/>
+    <field id="TVeg" name="TVeg" long_name="Transpiration" unit="kg/m^2/s"/>
+    <field id="vevapnu_alma" name="ESoil" long_name="Bare soil evaporation" unit="kg/m^2/s"/>
+    <field id="evapflo_alma" name="EWater" long_name="Floodplains evaporation" unit="kg/m^2/s"/>
+    <field id="vevapsno" name="vevapsno" long_name="Snow sublimation" unit="kg/m^2/s"/>
+    <field id="ACond" name="ACond" long_name="Aerodynamic conductance" unit="m/s"/>
+    <field id="albedo_snow" name="SAlbedo" long_name="Snow albedo" unit="1"/>
+    <field id="temp_hydro" name="temp_hydro" long_name="Temperature profile on hydrological levels" unit="K" axis_ref="nslm"/>
+    <field id="kk_moy" name="kk_moy" long_name="Mean hydraulic conductivity over soiltiles" unit="mm/d" axis_ref="nslm"/>
+    <field id="profil_froz_hydro" name="profil_froz_hydro" long_name="Frozen fraction for each hydrological soil layer average over soil types" unit="1" axis_ref="nslm"/>
+    
+  </field_group>
+
+
+  <!-- Definition of all variables in stomate -->
+  <field_group id="stomate" domain_ref="domain_landpoints">
+    <field id="T2M_MONTH" name="T2M_MONTH" long_name="Monthly 2 m temperature" unit="K"/>
+    <field id="T2M_WEEK" name="T2M_WEEK" long_name="Weekly 2 m temperature" unit="K"/>
+    <field id="TSEASON" name="TSEASON" long_name="Seasonal 2 m temperature" unit="K"/>
+    <field id="TMIN_SPRING_TIME" name="TMIN_SPRING_TIME" long_name="Number of days after onset" unit="-" axis_ref="nvm"/>
+    <field id="ONSET_DATE" name="ONSET_DATE" long_name="The day in the year when leaves start to grow" unit="days" axis_ref="nvm"/>
+    <field id="FPC_MAX" name="FPC_MAX" long_name="Foliage projective cover" unit="-" axis_ref="nvm"/>
+    <field id="MAXFPC_LASTYEAR" name="MAXFPC_LASTYEAR" long_name="Foliage projective cover of last year" unit="-" axis_ref="nvm"/>
+    <field id="HET_RESP" name="HET_RESP" long_name="heterotr. resp. from ground" unit="gC/m^2 tot/pft/day" axis_ref="nvm"/>
+    <field id="FIREFRAC" name="FIREFRAC" long_name="Fire fraction on ground " unit="1/day" axis_ref="nvm"/>
+    <field id="CO2_FIRE" name="CO2_FIRE" long_name="Output CO2 flux from fire " unit="gC/day/m^2/pft" axis_ref="nvm"/>
+    <field id="CO2_TAKEN" name="CO2_TAKEN" long_name="CO2 taken from atmosphere for initiate growth " unit="gC/day/m^2/pft" axis_ref="nvm"/>
+    <field id="LAI" name="LAI" long_name="Leaf Area Index " unit="-" axis_ref="nvm"/>
+    <field id="VEGET_COV_MAX" name="VEGET_COV_MAX" long_name="Maximum vegetation fraction (exc. no bio fraction) " unit="-" axis_ref="nvm"/>
+    <field id="NPP_STOMATE" name="NPP" long_name="Net primary productivity (positive from atm to land)" unit="gC/day/(m^2 tot)" axis_ref="nvm"/>
+    <field id="GPP" name="GPP" long_name="Gross primary productivity (positive from atm to land)" unit="gC/day/m^2" axis_ref="nvm"/>
+    <field id="NBP_pool" name="NBP_pool" long_name="Pool-based net biome production daily average" unit="gC/day/m^2" axis_ref="nvm"/>
+    <field id="NBP_pool_spinup" name="NBP_pool_spinup" long_name="Pool-based net biome production daily average calculated at the end of each spinup period" unit="gC/day/m^2" axis_ref="nvm"/>
+    <field id="LEAF_M_c" name="LEAF_M_c" long_name="Leaf mass" unit="gC/m^2 " axis_ref="nvm"/>
+    <field id="SAP_M_AB_c" name="SAP_M_AB_c" long_name="Sap mass above ground" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="SAP_M_BE_c" name="SAP_M_BE_c" long_name="Sap mass below ground" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="HEART_M_AB_c" name="HEART_M_AB_c" long_name="Heartwood mass above ground" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="HEART_M_BE_c" name="HEART_M_BE_c" long_name="Heartwood mass below ground" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="ROOT_M_c" name="ROOT_M_c" long_name="Root mass" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="FRUIT_M_c" name="FRUIT_M_c" long_name="Fruit mass" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="RESERVE_M_c" name="RESERVE_M_c" long_name="Carbohydrate reserve mass" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="MAINT_RESP" name="MAINT_RESP" long_name="Maintenance respiration" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="GROWTH_RESP" name="GROWTH_RESP" long_name="Growth respiration" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="IND" name="IND" long_name="Density of individuals" unit="1/ m^2" axis_ref="nvm"/>
+    <field id="ADAPTATION" name="ADAPTATION" long_name="Adaptation to climate (DGVM)" unit="-" axis_ref="nvm"/>
+    <field id="REGENERATION" name="REGENERATION" long_name="Probability from regenerative (DGVM)" unit="-" axis_ref="nvm"/>
+    <field id="CN_IND" name="CN_IND" long_name="crown area of individuals" unit="m^2" axis_ref="nvm"/>
+    <field id="WOODMASS_IND" name="WOODMASS_IND" long_name="Woodmass of individuals" unit="gC/pft" axis_ref="nvm"/>
+    <field id="TOTAL_M_c" name="TOTAL_M_c" long_name="Total living biomass" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="MOISTRESS" name="MOISTRESS" long_name="weekly moisture stress" unit="-" axis_ref="nvm"/>
+    <field id="MOIAVAIL_SEASON" name="MOIAVAIL_SEASON" long_name="soil moisture during growing season" unit="-" axis_ref="nvm"/>
+    <field id="NSTRESS_SEASON" name="NSTRESS_SEASON" long_name="Seasonal nitrogen stress" unit="-" axis_ref="nvm"/>
+    <field id="WSTRESS_MONTH" name="WSTRESS_MONTH" long_name="water stress used in allocation" unit="-" axis_ref="nvm"/>
+    <field id="WSTRESS_SEASON" name="WSTRESS_SEASON" long_name="water stress used in allocation" unit="-" axis_ref="nvm"/>
+    <field id="TOTAL_TURN_c" name="TOTAL_TURN_c" long_name="total turnover rate" unit="gC/m^2/day " axis_ref="nvm"/>
+    <field id="LEAF_TURN_c" name="LEAF_TURN_c" long_name="Leaf turnover" unit="gC/m^2/day " axis_ref="nvm"/>
+    <field id="SAP_AB_TURN_c" name="SAP_AB_TURN_c" long_name="Sap turnover above" unit="gC/m^2/day " axis_ref="nvm"/>
+    <field id="ROOT_TURN_c" name="ROOT_TURN_c" long_name="Root turnover" unit="gC/m^2/day " axis_ref="nvm"/>
+    <field id="FRUIT_TURN_c" name="FRUIT_TURN_c" long_name="Fruit turnover" unit="gC/m^2/day" axis_ref="nvm"/>
+    <!--<field id="TOTAL_BM_LITTER_c" name="TOTAL_BM_LITTER_c" long_name="total conversion of biomass to litter" unit="gC/m^2/day" axis_ref="nvm"/>-->
+    <field id="LEAF_BM_LITTER_c" name="LEAF_BM_LITTER_c" long_name="Leaf death" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="SAP_AB_BM_LITTER_c" name="SAP_AB_BM_LITTER_c" long_name="Sap death above ground" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="SAP_BE_BM_LITTER_c" name="SAP_BE_BM_LITTER_c" long_name="Sap death below ground" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="HEART_AB_BM_LITTER_c" name="HEART_AB_BM_LITTER_c" long_name="Heartwood death above ground" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="HEART_BE_BM_LITTER_c" name="HEART_BE_BM_LITTER_c" long_name="Heartwood death below ground" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="ROOT_BM_LITTER_c" name="ROOT_BM_LITTER_c" long_name="Root death" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="FRUIT_BM_LITTER_c" name="FRUIT_BM_LITTER_c" long_name="Fruit death" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="RESERVE_BM_LITTER_c" name="RESERVE_BM_LITTER_c" long_name="Carbohydrate reserve death" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="LITTER_STR_AB_c" name="LITTER_STR_AB_c" long_name="structural litter above ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="LITTER_MET_AB_c" name="LITTER_MET_AB_c" long_name="metabolic litter above ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="LITTER_STR_BE_c" name="LITTER_STR_BE_c" long_name="structural litter below ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="LITTER_MET_BE_c" name="LITTER_MET_BE_c" long_name="metabolic litter below ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="DEADLEAF_COVER" name="DEADLEAF_COVER" long_name="fraction of soil covered by dead leaves" unit="-"/>
+    <field id="TOTAL_SOIL_CARB" name="TOTAL_SOIL_CARB" long_name="total soil and litter carbon" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="CARBON_ACTIVE" name="CARBON_ACTIVE" long_name="active soil carbon in ground " unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="CARBON_SLOW" name="CARBON_SLOW" long_name="slow soil carbon in ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="CARBON_PASSIVE" name="CARBON_PASSIVE" long_name="passive soil carbon in ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="LITTERHUM" name="LITTERHUM" long_name="Litter humidity" unit="-"/>
+    <field id="BM_ALLOC_LEAF_c" name="BM_ALLOC_LEAF_c" long_name="biomass allocated to leaves" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_SAP_AB_c" name="BM_ALLOC_SAP_AB_c" long_name="biomass allocated to sapwood above ground" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_SAP_BE_c" name="BM_ALLOC_SAP_BE_c" long_name="biomass allocated to sapwood below ground" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_ROOT_c" name="BM_ALLOC_ROOT_c" long_name="biomass allocated to roots" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_FRUIT_c" name="BM_ALLOC_FRUIT_c" long_name="biomass allocated to fruits" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_RES_c" name="BM_ALLOC_RES_c" long_name="biomass allocated to carbohydrate reserve" unit="gC/m**2/pft/dt" axis_ref="nvm"/> 
+    <field id="BM_ALLOC_LABILE_c" name="BM_ALLOC_LABILE_c" long_name="biomass allocated to labile pool" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_LEAF_n" name="BM_ALLOC_LEAF_n" long_name="biomass allocated to leaves" unit="gN/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_SAP_AB_n" name="BM_ALLOC_SAP_AB_n" long_name="biomass allocated to sapwood above ground" unit="gN/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_SAP_BE_n" name="BM_ALLOC_SAP_BE_n" long_name="biomass allocated to sapwood below ground" unit="gN/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_ROOT_n" name="BM_ALLOC_ROOT_n" long_name="biomass allocated to roots" unit="gN/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_FRUIT_n" name="BM_ALLOC_FRUIT_n" long_name="biomass allocated to fruits" unit="gN/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_RES_n" name="BM_ALLOC_RES_n" long_name="biomass allocated to carbohydrate reserve" unit="gN/m**2/pft/dt" axis_ref="nvm"/> 
+    <field id="BM_ALLOC_LABILE_n" name="BM_ALLOC_LABILE_n" long_name="biomass allocated to labile pool" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="RESIDUAL" name="RESIDUAL" long_name="residual" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="HERBIVORES" name="HERBIVORES" long_name="time constant of herbivore activity" unit="days" axis_ref="nvm"/>
+    <field id="TURNOVER_TIME_LEAF" name="TURNOVER_TIME_LEAF" long_name="turnover time for leaves of grasses" unit="days" axis_ref="nvm"/>
+    <field id="TURNOVER_TIME_ROOT" name="TURNOVER_TIME_ROOT" long_name="turnover time for roots of grasses" unit="days" axis_ref="nvm"/>
+    <field id="TURNOVER_TIME_SAP_AB" name="TURNOVER_TIME_SAP_AB" long_name="turnover time for SAP above ground of grasses" unit="days" axis_ref="nvm"/>
+    <field id="TURNOVER_TIME_FRUIT" name="TURNOVER_TIME_FRUIT" long_name="turnover time for fruit of grasses" unit="days" axis_ref="nvm"/>
+    <field id="PROD10" name="PROD10" long_name="10 year wood product pool" unit="gC/m**2" axis_ref="P11"/>
+    <field id="FLUX10" name="FLUX10" long_name="annual flux for each 10 year wood product pool" unit="gC/m**2/yr" axis_ref="P10"/>
+    <field id="PROD100" name="PROD100" long_name="100 year wood product pool" unit="gC/m**2" axis_ref="P101"/>
+    <field id="FLUX100" name="FLUX100" long_name="annual flux for each 100 year wood product pool" unit="gC/m**2/yr" axis_ref="P100"/>
+    <field id="CONVFLUX" name="CONVFLUX" long_name="annual release right after deforestation (positive from atm to land)" unit="gC/m**2/day"/>
+    <field id="CFLUX_PROD10" name="CFLUX_PROD10" long_name="annual release from all 10 year wood product pools (positive from atm to land)" unit="gC/m**2/day"/>
+    <field id="CFLUX_PROD100" name="CFLUX_PROD100" long_name="annual release from all 100 year wood product pools (positive from atm to land)" unit="gC/m**2/day"/>
+    <field id="HARVEST_ABOVE" name="HARVEST_ABOVE" long_name="annual release product after harvest (positive from atm to land)" unit="gC/m**2/day"/>
+    <field id="HARVEST_TYPE" name="HARVEST_TYPE" long_name="Type of management that resulted in the harvest" unit="-" axis_ref="nvm"/>
+    <field id="HARVEST_CUT" name="HARVEST_CUT" long_name="Type of cutting that was used for the harvest" unit="-" axis_ref="nvm"/>
+    <field id="HARVEST_AREA" name="HARVEST_AREA" long_name="Harvested area" unit="m^2" axis_ref="nvm"/>
+    <field id="HARVEST_POOL_C" name="HARVEST_POOL_C" long_name="The wood and biomass that have been harvested by humans" unit="units differ, look in code" axis_ref="nvm"/>
+    <field id="HARVEST_POOL_N" name="HARVEST_POOL_N" long_name="The wood and biomass that have been harvested by humans" unit="units differ, look in code" axis_ref="nvm"/>
+    <field id="WOOD_VOL_PIX_CUT" name="WOOD_VOL_PIX_CUT" long_name="The wood volume that was harvested or salvaged" unit="m**3/m**2" axis_ref="ncut" operation="accumulate"/>
+    <field id="TOTAL_M_n" name="TOTAL_M_n" long_name="Total living biomass" unit="gN/m^2/pft" axis_ref="nvm"/>
+    <field id="LEAF_M_n" name="LEAF_M_n" long_name="Leaf mass" unit="gN/m^2 " axis_ref="nvm"/>
+    <field id="SAP_M_AB_n" name="SAP_M_AB_n" long_name="Sap mass above ground" unit="gN/m^2" axis_ref="nvm"/>
+    <field id="SAP_M_BE_n" name="SAP_M_BE_n" long_name="Sap mass below ground" unit="gN/m^2" axis_ref="nvm"/>
+    <field id="HEART_M_AB_n" name="HEART_M_AB_n" long_name="Heartwood mass above ground" unit="gN/m^2" axis_ref="nvm"/>
+    <field id="HEART_M_BE_n" name="HEART_M_BE_n" long_name="Heartwood mass below ground" unit="gN/m^2" axis_ref="nvm"/>
+    <field id="ROOT_M_n" name="ROOT_M_n" long_name="Root mass" unit="gN/m^2" axis_ref="nvm"/>
+    <field id="FRUIT_M_n" name="FRUIT_M_n" long_name="Fruit mass" unit="gN/m^2" axis_ref="nvm"/>
+    <field id="LABILE_M_c" name="LABILE_M_c" long_name="Labile reserve mass" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="LABILE_M_n" name="LABILE_M_n" long_name="Labile reserve mass" unit="gN/m^2" axis_ref="nvm"/>
+    <field id="RESERVE_M_n" name="RESERVE_M_n" long_name="Carbohydrate reserve mass" unit="gN/m^2" axis_ref="nvm"/>
+    <field id="TOTAL_TURN_n" name="TOTAL_TURN_n" long_name="total turnover rate" unit="gN/m^2/day " axis_ref="nvm"/>
+    <field id="LEAF_TURN_n" name="LEAF_TURN_n" long_name="Leaf turnover" unit="gN/m^2/day " axis_ref="nvm"/>
+    <field id="SAP_AB_TURN_n" name="SAP_AB_TURN_n" long_name="Sap turnover above" unit="gN/m^2/day " axis_ref="nvm"/>
+    <field id="ROOT_TURN_n" name="ROOT_TURN_n" long_name="Root turnover" unit="gN/m^2/day " axis_ref="nvm"/>
+    <field id="FRUIT_TURN_n" name="FRUIT_TURN_n" long_name="Fruit turnover" unit="gN/m^2/day" axis_ref="nvm"/>
+    <!--<field id="TOTAL_BM_LITTER_n" name="TOTAL_BM_LITTER_n" long_name="total conversion of biomass to litter" unit="gN/m^2/day" axis_ref="nvm"/>-->
+    <field id="LEAF_BM_LITTER_n" name="LEAF_BM_LITTER_n" long_name="Leaf death" unit="gN/m^2/day" axis_ref="nvm"/>
+    <field id="SAP_AB_BM_LITTER_n" name="SAP_AB_BM_LITTER_n" long_name="Sap death above ground" unit="gN/m^2/day" axis_ref="nvm"/>
+    <field id="SAP_BE_BM_LITTER_n" name="SAP_BE_BM_LITTER_n" long_name="Sap death below ground" unit="gN/m^2/day" axis_ref="nvm"/>
+    <field id="HEART_AB_BM_LITTER_n" name="HEART_AB_BM_LITTER_n" long_name="Heartwood death above ground" unit="gN/m^2/day" axis_ref="nvm"/>
+    <field id="HEART_BE_BM_LITTER_n" name="HEART_BE_BM_LITTER_n" long_name="Heartwood death below ground" unit="gN/m^2/day" axis_ref="nvm"/>
+    <field id="ROOT_BM_LITTER_n" name="ROOT_BM_LITTER_n" long_name="Root death" unit="gN/m^2/day" axis_ref="nvm"/>
+    <field id="FRUIT_BM_LITTER_n" name="FRUIT_BM_LITTER_n" long_name="Fruit death" unit="gN/m^2/day" axis_ref="nvm"/>
+    <field id="LABILE_BM_LITTER_c" name="LABILE_BM_LITTER_c" long_name="Labile reserve death" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="LABILE_BM_LITTER_n" name="LABILE_BM_LITTER_n" long_name="Labile reserve death" unit="gN/m^2/day" axis_ref="nvm"/>
+    <field id="RESERVE_BM_LITTER_n" name="RESERVE_BM_LITTER_n" long_name="Carbohydrate reserve death" unit="gN/m^2/day" axis_ref="nvm"/>
+    <field id="LITTER_STR_AB_n" name="LITTER_STR_AB_n" long_name="structural litter above ground" unit="gN/m^2/pft" axis_ref="nvm"/>
+    <field id="LITTER_MET_AB_n" name="LITTER_MET_AB_n" long_name="metabolic litter above ground" unit="gN/m^2/pft" axis_ref="nvm"/>
+    <field id="LITTER_WOD_AB_c" name="LITTER_WOD_AB_c" long_name="woody litter above ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="LITTER_WOD_AB_n" name="LITTER_WOD_AB_n" long_name="woody litter above ground" unit="gN/m^2/pft" axis_ref="nvm"/>
+    <field id="LITTER_STR_BE_n" name="LITTER_STR_BE_n" long_name="structural litter below ground" unit="gN/m^2/pft" axis_ref="nvm"/>
+    <field id="LITTER_MET_BE_n" name="LITTER_MET_BE_n" long_name="metabolic litter below ground" unit="gN/m^2/pft" axis_ref="nvm"/>
+    <field id="LITTER_WOD_BE_c" name="LITTER_WOD_BE_c" long_name="woody litter below ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="LITTER_WOD_BE_n" name="LITTER_WOD_BE_n" long_name="woody litter below ground" unit="gN/m^2/pft" axis_ref="nvm"/>
+    <field id="SOIL_ACTIVE_c" name="SOIL_ACTIVE_c" long_name="active soil C in ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="SOIL_ACTIVE_n" name="SOIL_ACTIVE_n" long_name="active soil N in ground" unit="gN/m^2/pft" axis_ref="nvm"/>
+    <field id="SOIL_SLOW_c" name="SOIL_SLOW_c" long_name="slow soil C in ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="SOIL_SLOW_n" name="SOIL_SLOW_n" long_name="slow soil N in ground" unit="gN/m^2/pft" axis_ref="nvm"/>
+    <field id="SOIL_PASSIVE_c" name="SOIL_PASSIVE_c" long_name="passive soil C in ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="SOIL_PASSIVE_n" name="SOIL_PASSIVE_n" long_name="passive soil N in ground" unit="gN/m^2/pft" axis_ref="nvm"/>
+    <field id="SOIL_SURF_c" name="SOIL_SURF" long_name="surface soil C in ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="SOIL_SURF_n" name="SOIL_SURF_n" long_name="surface soil N in ground" unit="gN/m^2/pft" axis_ref="nvm"/>
+    <field id="BM_ALLOC_LEAF_n" name="BM_ALLOC_LEAF_n" long_name="biomass allocated to leaves" unit="gN/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_SAP_AB_n" name="BM_ALLOC_SAP_AB_n" long_name="biomass allocated to sapwood above ground" unit="gN/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_SAP_BE_n" name="BM_ALLOC_SAP_BE_n" long_name="biomass allocated to sapwood below ground" unit="gN/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_ROOT_n" name="BM_ALLOC_ROOT_n" long_name="biomass allocated to roots" unit="gN/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_FRUIT_n" name="BM_ALLOC_FRUIT_n" long_name="biomass allocated to fruits" unit="gN/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="FLUX_PROD_S_c" name="FLUX_PROD_S_c" long_name="annual release right after deforestation" unit="gC/yr"/>
+    <field id="FLUX_PROD_S_n" name="FLUX_PROD_S_n" long_name="annual release right after deforestation" unit="gN/yr"/>
+    <field id="FLUX_PROD_M_c" name="FLUX_PROD_M_c" long_name="annual release from all medium wood product pools" unit="gC/yr"/>
+    <field id="FLUX_PROD_M_n" name="FLUX_PROD_M_n" long_name="annual release from all medium wood product pools" unit="gN/yr"/>
+    <field id="FLUX_PROD_L_c" name="FLUX_PROD_L_c" long_name="annual release from all long wood productpools" unit="gC/yr"/>
+    <field id="FLUX_PROD_L_n" name="FLUX_PROD_L_n" long_name="annual release from all long wood productpools" unit="gN/yr"/>
+    <field id="FLUX_S_c" name="FLUX_S_c" long_name="annual flux for short-lived wood product pool" unit="gC/yr" axis_ref="nshort" />
+    <field id="FLUX_S_n" name="FLUX_S_n" long_name="annual flux for short-lived wood product pool" unit="gN/yr" axis_ref="nshort"/>
+    <field id="FLUX_M_c" name="FLUX_M_c" long_name="annual flux for medium-lived wood product pool" unit="gC/yr" axis_ref="nmedium"/>
+    <field id="FLUX_M_n" name="FLUX_M_n" long_name="annual flux for medium-lived wood product pool" unit="gN/yr" axis_ref="nmedium"/>
+    <field id="FLUX_L_c" name="FLUX_L_c" long_name="annual flux for long-lived wood product pool" unit="gC/yr" axis_ref="nlong"/>
+    <field id="FLUX_L_n" name="FLUX_L_n" long_name="annual flux for long-lived wood product pool" unit="gN/yr" axis_ref="nlong"/>
+    <field id="PROD_S_c" name="PROD_S_c" long_name="short-lived wood product pool" unit="gC" axis_ref="nshort1"/>
+    <field id="PROD_S_n" name="PROD_S_n" long_name="short-lived wood product pool" unit="gN" axis_ref="nshort1"/>
+    <field id="PROD_M_c" name="PROD_M_c" long_name="medium-lived wood product pool" unit="gC" axis_ref="nmedium1"/>
+    <field id="PROD_M_n" name="PROD_M_n" long_name="medium-lived wood product pool" unit="gN" axis_ref="nmedium1"/>
+    <field id="PROD_L_c" name="PROD_L_c" long_name="long-lived wood product pool" unit="gC" axis_ref="nlong1"/>
+    <field id="PROD_L_n" name="PROD_L_n" long_name="long-lived wood product pool" unit="gN" axis_ref="nlong1"/>
+
+
+    <field id="N_SUPPORT" name="N_SUPPORT" long_name="nitrogen which is added to the ecosystem to support vegetation growth" unit="gN/m^2/day" axis_ref="nvm"/>
+    <field id="RUE_LONGTERM" name="RUE_LONGTERM" long_name="longterm radiation use efficieny" unit="gC m-2 day-1" axis_ref="nvm"/>
+    <field id="KF" name="KF" long_name="sapwood to leaf allocation factor" unit="1" axis_ref="nvm"/>
+    <field id="LAB_FAC" name="LAB_FAC" long_name="Activity of labile pool" unit="" axis_ref="nvm"/>
+    <field id="BA" name="BA" long_name="basal area of stand" unit="m^2/ha" axis_ref="nvm"/>
+    <field id="WOOD_VOL" name="WOOD_VOL" long_name="standing wood volume" unit="m^3/m^2" axis_ref="nvm"/>
+    <field id="K_LATOSA_ADAPT" name="K_LATOSA_ADAPT" long_name="allocation factor adapted for wstress" unit="m" axis_ref="nvm"/>
+    <field id="RESERVE_POOL_TARGET" name="RESERVE_POOL_TARGET" long_name="The targeted value of the reserve pool" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="LABILE_POOL_TARGET" name="LABILE_POOL_TARGET" long_name="The targeted value of the labile pool" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="CN_LONGTERM_ACTIVE" name="CN_LONGTERM_ACTIVE" long_name="Longterm CN ratio of the active soil pool" unit="" axis_ref="nvm"/>
+    <field id="CN_LONGTERM_SLOW" name="CN_LONGTERM_SLOW" long_name="Longterm CN ratio of the slow soil pool" unit="" axis_ref="nvm"/>
+    <field id="CN_LONGTERM_PASSIVE" name="CN_LONGTERM_PASSIVE" long_name="Longterm CN ratio of the slow soil pool" unit="" axis_ref="nvm"/>
+    <field id="CN_LONGTERM_SURF" name="CN_LONGTERM_SURF" long_name="Longterm CN ratio of the active soil pool" unit="" axis_ref="nvm"/>
+    <field id="CN_LONGTERM_LITTER_STR_AB" name="CN_LONGTERM_LITTER_STR_AB" long_name="Longterm CN ratio of the structural above ground litter pool" unit="" axis_ref="nvm"/>
+    <field id="CN_LONGTERM_LITTER_STR_BE" name="CN_LONGTERM_LITTER_STR_BE" long_name="Longterm CN ratio of the structural below ground litter pool" unit="" axis_ref="nvm"/>
+    <field id="CN_LONGTERM_LITTER_MET_AB" name="CN_LONGTERM_LITTER_MET_AB" long_name="Longterm CN ratio of the metabolic above ground litter pool" unit="" axis_ref="nvm"/>
+    <field id="CN_LONGTERM_LITTER_MET_BE" name="CN_LONGTERM_LITTER_MET_BE" long_name="Longterm CN ratio of the metabolic below ground litter pool" unit="" axis_ref="nvm"/>
+    <field id="CN_LONGTERM_LITTER_WOD_AB" name="CN_LONGTERM_LITTER_WOD_AB" long_name="Longterm CN ratio of the woody above ground litter pool" unit="" axis_ref="nvm"/>
+    <field id="CN_LONGTERM_LITTER_WOD_BE" name="CN_LONGTERM_LITTER_WOD_BE" long_name="Longterm CN ratio of the woody below ground litter pool" unit="" axis_ref="nvm"/>
+
+
+    <field id="N_UPTAKE_NH4" name="N_UPTAKE_NH4" long_name="plant nitrogen uptake" unit="gNH4-N/m**2/day" axis_ref="nvm"/>
+    <field id="N_UPTAKE_NO3" name="N_UPTAKE_NO3" long_name="plant nitrogen uptake" unit="gNO3-N/m**2/day" axis_ref="nvm"/>
+    <field id="N_MINERALISATION" name="N_MINERALISATION" long_name="nitrogen mineralised " unit="gNH4-N/m**2/day" axis_ref="nvm"/>
+    <field id="SOIL_NH4" name="SOIL_NH4" long_name="soil ammonium concentration" unit="gNH4-N/m**2" axis_ref="nvm"/>
+    <field id="SOIL_NO3" name="SOIL_NO3" long_name="soil nitrate concentration" unit="gNO3-N/m**2" axis_ref="nvm"/>
+    <field id="SOIL_NOX" name="SOIL_NOX" long_name="soil NOx concentration" unit="gN2O-N/m**2" axis_ref="nvm"/>
+    <field id="SOIL_N2O" name="SOIL_N2O" long_name="soil nitrous oxide concentration" unit="gN2O-N/m**2" axis_ref="nvm"/>
+    <field id="SOIL_N2" name="SOIL_N2" long_name="soil dinitrogen concentration" unit="gN2-N/m**2" axis_ref="nvm"/>
+    <field id="SOIL_P_OX" name="SOIL_P_OX" long_name="soil oxigen concentration (hPa)" unit="hPaO2" axis_ref="nvm"/>
+    <field id="BACT" name="BACT" long_name="soil bacterial population" unit="gC/m**2" axis_ref="nvm"/>
+    <field id="NH3_EMISSION" name="NH3_EMISSION" long_name="ammonia emitted to atmosphere" unit="gNH3-N/m**2/day" axis_ref="nvm"/>
+    <field id="NOX_EMISSION" name="NOX_EMISSION" long_name="nitric oxides emitted to the atmosphere" unit="gNOx-N/m**2/day" axis_ref="nvm"/>
+    <field id="N2O_EMISSION" name="N2O_EMISSION" long_name="nitrous oxide emitted to the atmosphere" unit="gN2O-N/m**2/day" axis_ref="nvm"/>
+    <field id="N2_EMISSION" name="N2_EMISSION" long_name="nitrogen emitted to the atmosphere" unit="gN2-N/m**2/day" axis_ref="nvm"/>
+    <field id="NH4_LEACHING" name="NH4_LEACHING" long_name="ammonium leached below root zone" unit="gNH4-N/m**2/day" axis_ref="nvm"/>
+    <field id="NO3_LEACHING" name="NO3_LEACHING" long_name="nitrate leached below root zone" unit="gNO3-N/m**2/day" axis_ref="nvm"/>
+    <field id="NITRIFICATION" name="NITRIFICATION" long_name="oxidation of NH4" unit="gN/m**2/day" axis_ref="nvm"/>
+    <field id="DENITRIFICATION" name="DENITRIFICATION" long_name="reduction of NO3" unit="gN/m**2/day" axis_ref="nvm"/>
+    <field id="NHX_DEPOSITION" name="NHX_DEPOSITION" long_name="nitrogen added from deposition of NHx" unit="gN/m**2/day" axis_ref="nvm"/>
+    <field id="NOX_DEPOSITION" name="NOX_DEPOSITION" long_name="nitrogen added from deposition of NOX" unit="gN/m**2/day" axis_ref="nvm"/>
+    <field id="BNF" name="BNF" long_name="nitrogen added from biological N fixation" unit="gN/m**2/day" axis_ref="nvm"/>
+    <field id="N_FERTILISER" name="N_FERTILISER" long_name="nitrogen added from nitrogen fertiliser appl." unit="gN/m**2/day" axis_ref="nvm"/>
+    <field id="N_MANURE" name="N_MANURE" long_name="nitrogen added from nitrogen manure  appl." unit="gN/m**2/day" axis_ref="nvm"/>
+    <field id="N_TAKEN" name="N_TAKEN" long_name="nitrogen that comes virtually in the ecosystem" unit="gN/day/m^2/pft" axis_ref="nvm"/>
+
+    <field id="NOX_FIRE_EMISSION" name="NOX_FIRE_EMISSION" long_name="NOx emitted into the atmosphere by fire (living and dead biomass)" unit="gN/m**2/day" axis_ref="nvm"/>
+
+    <field id="RESOLUTION_X" name="RESOLUTION_X" long_name="E-W resolution" unit="m" operation="once"/>
+    <field id="RESOLUTION_Y" name="RESOLUTION_Y" long_name="N-S resolution" unit="m" operation="once"/>
+    <field id="CONTFRAC_STOMATE" name="CONTFRAC" long_name="Continental fraction" unit="1" operation="once"/>
+    <field id="VCMAX" name="VCMAX" long_name="Maximum rate of carboxylation" unit="-" axis_ref="nvm"/>
+    <field id="VCMAX_NEW" name="VCMAX_NEW" long_name="Maximum rate of carboxylation based on nitrogen" unit="-" axis_ref="nvm"/>
+    <field id="RDI" name="RDI" long_name="Relative density index" unit="-" axis_ref="nvm"/>
+    <field id="RDI_TARGET_UPPER" name="RDI_TARGET_UPPER" long_name="Relative density index upper target" unit="-" axis_ref="nvm"/>
+    <field id="RDI_TARGET_LOWER" name="RDI_TARGET_LOWER" long_name="Relative density index lower target" unit="-" axis_ref="nvm"/>
+    <field id="FOREST_MANAGED" name="FOREST_MANAGED" long_name="Forest management flag" unit="-" axis_ref="nvm"/>
+    <field id="PLANT_STATUS" name="PLANT_STATUS" long_name="Growth and phenological plant status" unit="-" axis_ref="nvm"/>
+    <field id="GAMMA" name="GAMMA" long_name="Slope for individual tree growth" unit="m" axis_ref="nvm"/>
+    <field id="LAST_CUT" name="LAST_CUT" long_name="Years since last thinning" unit="yr" axis_ref="nvm"/>
+    <field id="LITTER_RAKE_FRAC" name="LITTER_RAKE_FRAC" long_name="Relative amount of litter that raked" unit="-" axis_ref="nvm"/>
+    <field id="MAI" name="MAI" long_name="The mean annual increment" unit="m^3/m^2/yr" axis_ref="nvm"/>
+    <field id="PAI" name="PAI" long_name="The period annual increment" unit="m^3/m^2/yr" axis_ref="nvm"/>
+    <field id="ROTATION_N" name="ROTATION_N" long_name="Rotation number" unit="" axis_ref="nvm"/>
+    <field id="SIGMA" name="SIGMA" long_name="Circumference threshold for individual growth" unit="m" axis_ref="nvm"/>
+
+    <field id="LEAF_AGE" name="LEAF_AGE" long_name="leaf age" unit="days" axis_ref="nvm"/>
+    <field id="MORTALITY" name="MORTALITY" long_name="Fraction of trees that dies (gap)" unit="1/day" axis_ref="nvm"/>
+    <field id="FIREDEATH" name="FIREDEATH" long_name="Fraction of plants killed by fire" unit="1/day" axis_ref="nvm"/>
+    <field id="IND_ESTAB" name="IND_ESTAB" long_name="Density of newly established saplings" unit="ind/m**2/day" axis_ref="nvm"/>
+    <field id="ESTABTREE" name="ESTABTREE" long_name="Rate of tree establishement" unit="ind/m**2/day"/>
+    <field id="ESTABGRASS" name="ESTABGRASS" long_name="Rate of grass establishement" unit="ind/m**2/day"/>
+    <field id="LIGHT_DEATH" name="LIGHT_DEATH" long_name="Fraction of plants that dies (light competition)" unit="1/day" axis_ref="nvm"/>
+    <field id="AGE" name="AGE" long_name="age" unit="years" axis_ref="nvm"/>
+    <field id="AGE_STAND" name="AGE_STAND" long_name="age" unit="years" axis_ref="nvm"/>
+    <field id="HEIGHT" name="HEIGHT" long_name="height" unit="m" axis_ref="nvm"/>
+    <field id="DIAMETER" name="DIAMETER" long_name="diameter" unit="m" axis_ref="nvm"/>
+    <field id="WHEN_GROWTHINIT" name="WHEN_GROWTHINIT" long_name="Time elapsed from season beginning" unit="d" axis_ref="nvm"/>
+    <field id="PFTPRESENT" name="PFTPRESENT" long_name="PFT exists" unit="d" axis_ref="nvm"/>
+    <field id="GDD_MIDWINTER" name="GDD_MIDWINTER" long_name="Growing degree days, since midwinter" unit="degK" axis_ref="nvm"/>
+    <field id="GDD_M5_DORMANCE" name="GDD_M5_DORMANCE" long_name="Growing degree days threshold" unit="degK" axis_ref="nvm"/>
+    <field id="NCD_DORMANCE" name="NCD_DORMANCE" long_name="Number of chilling days, since leaves were lost" unit="d" axis_ref="nvm"/>
+    <field id="ALLOW_INITPHENO" name="ALLOW_INITPHENO" long_name="Allow to declare beginning of the growing season" unit="-" axis_ref="nvm"/>
+    <field id="BEGIN_LEAVES" name="BEGIN_LEAVES" long_name="Signal to start putting leaves on" unit="-" axis_ref="nvm"/>
+    <field id="T2M_LONGTERM" name="T2M_LONGTERM" long_name="Longterm 2 m temperature" unit="K"/>
+    <field id="FIREINDEX" name="FIREINDEX" long_name="Fire index on ground" unit="-" axis_ref="nvm"/>
+    <field id="cVeg" name="cVeg" long_name="Carbon in Vegetation" unit="kg C m-2"/>
+    <field id="cLitter" name="cLitter" long_name="Carbon in Litter Pool" unit="kg C m-2"/>
+    <field id="cSoil" name="cSoil" long_name="Carbon in Soil Pool" unit="kg C m-2"/>
+    <field id="cProduct" name="cProduct" long_name="Carbon in Products of Land Use Change" unit="kg C m-2"/>
+    <field id="cMassVariation" name="cMassVariation" long_name="Terrestrial Carbon Mass Variation" unit="kg C m-2 s-1"/>
+    <field id="lai_ipcc" name="lai" long_name="Leaf Area Fraction" unit="1"/>
+    <field id="gpp_ipcc" name="gpp" long_name="Gross Primary Production (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="ra" name="ra" long_name="Autotrophic Respiration (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="npp_ipcc" name="npp" long_name="Net Primary Production (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="rh" name="rh" long_name="Heterotrophic Respiration (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="fFire" name="fFire" long_name="CO2 Emission from Fire (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="fHarvest" name="fHarvest" long_name="CO2 Flux to Atmosphere from Crop Harvesting (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="fLuc" name="fLuc" long_name="CO2 Flux to Atmosphere from Land Use Change (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="nbp" name="nbp" long_name="Net Biospheric Production (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="fVegLitter" name="fVegLitter" long_name="Total Carbon Flux from Vegetation to Litter" unit="kg C m-2 s-1"/>
+    <field id="fLitterSoil" name="fLitterSoil" long_name="Total Carbon Flux from Litter to Soil" unit="kg C m-2 s-1"/>
+    <field id="cLeaf" name="cLeaf" long_name="Carbon in Leaves" unit="kg C m-2"/>
+    <field id="cWood" name="cWood" long_name="Carbon in Wood" unit="kg C m-2"/>
+    <field id="cRoot" name="cRoot" long_name="Carbon in Roots" unit="kg C m-2"/>
+    <field id="cMisc" name="cMisc" long_name="Carbon in Other Living Compartments" unit="kg C m-2"/>
+    <field id="cLitterAbove" name="cLitterAbove" long_name="Carbon in Above-Ground Litter" unit="kg C m-2"/>
+    <field id="cLitterBelow" name="cLitterBelow" long_name="Carbon in Below-Ground Litter" unit="kg C m-2"/>
+    <field id="cSoilFast" name="cSoilFast" long_name="Carbon in Fast Soil Pool" unit="kg C m-2"/>
+    <field id="cSoilMedium" name="cSoilMedium" long_name="Carbon in Medium Soil Pool" unit="kg C m-2"/>
+    <field id="cSoilSlow" name="cSoilSlow" long_name="Carbon in Slow Soil Pool" unit="kg C m-2"/>
+    <field id="landCoverFrac" name="landCoverFrac" long_name="Fractional Land Cover of PFT" unit="%" axis_ref="nvm"/>
+    <field id="treeFracPrimDec" name="treeFracPrimDec" long_name="Total Primary Deciduous Tree Cover Fraction" unit="%"/>
+    <field id="treeFracPrimEver" name="treeFracPrimEver" long_name="Total Primary Evergreen Tree Cover Fraction" unit="%"/>
+    <field id="c3PftFrac" name="c3PftFrac" long_name="Total C3 PFT Cover Fraction" unit="%"/>
+    <field id="c4PftFrac" name="c4PftFrac" long_name="Total C4 PFT Cover Fraction" unit="%"/>
+    <field id="rGrowth" name="rGrowth" long_name="Growth Autotrophic Respiration (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="rMaint" name="rMaint" long_name="Maintenance Autotrophic Respiration (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="nppLeaf" name="nppLeaf" long_name="CO2 Flux from Atmosphere due to NPP Allocation to Leaf (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="nppWood" name="nppWood" long_name="CO2 Flux from Atmosphere due to NPP Allocation to Wood (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="nppRoot" name="nppRoot" long_name="CO2 Flux from Atmosphere due to NPP Allocation to Root (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="nep" name="nep" long_name="Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity (positive from land to atm)" unit="kg C m-2 s-1"/>
+    <field id="wtd" name="WaterTableD" long_name="Water Table Depth" unit="m"/>
+    <field id="undermcr" name="undermcr" long_name="Number of soiltiles under residual moisture" unit="-"/>
+    <field id="tws" name="TWS" long_name="Total Water Storage" unit="Kg/m^2"> humtot+snow+qsintveg_tot+fastr+slowr+streamr+laker+pondr+floodr </field>
+    <field id="check_infilt" name="check_infilt" long_name="check water conservation of infilt" unit="mm/s"/>
+    <field id="check_tr" name="check_tr" long_name="check water conservation of tridiag with diag_tr2" unit="mm/s"/>
+    <field id="check_over" name="check_over" long_name="check water conservation of smooth_over_mcs" unit="mm/s"/>
+    <field id="check_under" name="check_under" long_name="check water conservation of smooth_under_mcs" unit="mm/s"/>
+    <field id="check_top" name="check_top" long_name="check water conservation in top soil layer (imposed - diagnosed flux at the surface)" unit="kg/m^2/s"/>
+    <field id="qflux" name="qflux" long_name="Upward water fluxes at the lowest interface of each soil layer" unit="kg/m^2/s" axis_ref="nslm"/>
+    <field id="ru_corr" name="Qs_corr" long_name="Adjustement flux added to surface runoff" unit="kg/m^2/s"/>
+    <field id="ru_corr2" name="Qs_corr2" long_name="Adjustement flux added to surface runoff (case of negative surface runoff)" unit="kg/m^2/s"/>
+    <field id="dr_corr" name="Qsb_corr" long_name="Adjustement flux added to drainage" unit="kg/m^2/s"/>
+    <field id="dr_force" name="Qforce" long_name="Adjustement flux added to drainage to sustain a forced water table depth" unit="kg/m^2/s"/>
+    <field id="ru_infilt" name="Qs_infilt" long_name="Surface runoff from hydrol_soil_infilt" unit="kg/m^2/s"/>
+    <field id="qinfilt" name="Infilt" long_name="Infiltration flux" unit="kg/m^2/s"/>
+
+    <field id="MB_CLOSURE_c" name="MB_CLOSURE_c" long_name="Daily mass balacne closure in stomate" unit="gC/grid/day"/>
+    <field id="MB_CLOSURE_n" name="MB_CLOSURE_n" long_name="Daily mass balacne closure in stomate" unit="gN/grid/day"/>
+  </field_group>
+
+  <!-- Definition of all variables having more than one vertical axis -->
+  <field id="profil_froz_hydro_ns" name="profil_froz_hydro_ns" long_name="Frozen fraction for each hydrological soil layer on soil types" unit="1" grid_ref="grid_nslm_nstm"/>
+  <field id="mc" name="moistc" long_name="Soil Moisture profile for all soil tiles" unit="m3/m3" grid_ref="grid_nslm_nstm"/>
+  <field id="kfact_root" name="kfactroot" long_name="Root factor to increase Ks towards the surface, for all soil tiles" unit="%" grid_ref="grid_nslm_nstm"/>
+  <field id="vegetmax_soil" name="vegetsoil" long_name="PFT fraction for soil tiles" unit="1" grid_ref="grid_nvm_nstm"/>
+  <field id="psi_soil" name="psi_soil" long_name="Soil water potential per soil layer per soiltile" unit="MPA" grid_ref="grid_nslm_nstm"/>
+
+  <field id="CCBA" name="CCBA" long_name="basal area of a trees in a circ class" unit="m"  grid_ref="grid_nvm_ncirc"/>
+  <field id="CCDELTABA" name="CCDELTABA" long_name="change in basal area of a trees in a circ class" unit="m" grid_ref="grid_nvm_ncirc"/>
+  <field id="CCN" name="CCN" long_name="Number of individuals in each circ class" unit="" grid_ref="grid_nvm_ncirc"/>
+  <field id="CCTRW" name="CCTRW" long_name="Tree ring width in each circ class" unit="m" grid_ref="grid_nvm_ncirc"/>
+  <field id="CCH" name="CCH" long_name="Height of individuals in each circ class" unit="m" grid_ref="grid_nvm_ncirc"/>
+  <field id="LAI_PER_LEVEL" name="LAI_PER_LEVEL" long_name="LAI per vertical level" unit="-" grid_ref="grid_nvm_nlevelstot"/>
+  <field id="LIGHT_TRAN_TO_LEVEL" name="LIGHT_TRAN_TO_LEVEL" long_name="Fraction of light transmitted to a given canopy level" unit="-" grid_ref="grid_nvm_nlevelstot"/>
+  <field id="CLEVEL_HEIGHT" name="CLEVEL_HEIGHT" long_name="Physical height of each canopy level abovethe soil" unit="m" grid_ref="grid_nvm_nlevelstot"/>
+
+</field_definition>
+
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/file_def_orchidee.xml
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/file_def_orchidee.xml	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/file_def_orchidee.xml	(revision 6412)
@@ -0,0 +1,934 @@
+<!-- =========================================================================================================== -->
+<!-- file_def_orchidee.xml : Definition of output files                                                          -->
+<!--                                                                                                             -->
+<!-- Definition of variables or groups included in the different files                                           -->
+<!-- Change this file by adding the files and/or variables you want to produce                                   -->
+<!-- Only variables and groups existing in field_def_orchidee.xml can be used                                    -->
+<!--                                                                                                             -->
+<!-- Note: The keyword _AUTO_ will be changed by the drivers using libIGCM configurations. It can also be        -->
+<!-- changed manually. For example instead of _AUTO_ set :  enabled=".TRUE." or enabled=".FALSE."                -->
+<!-- output_freq="1mo" for monthly, output_freq="1d" for daily, output_freq="10800s" for 3-hour output frequency -->
+<!--                                                                                                             --> 
+<!-- $HeadURL$               --> 
+<!-- $Date$                                                     --> 
+<!-- $Revision$                                                                                           -->
+<!-- =========================================================================================================== -->
+
+<file_definition type="one_file" par_access="collective" enabled=".TRUE." min_digits="4">
+
+  <!-- Definition of files with sechiba diagnostics -->
+
+  <!-- Sechiba file 1 -->
+  <file id="sechiba1" name="sechiba_history" output_level="11" output_freq="_AUTO_" enabled="_AUTO_">
+    <!-- level 1 -->
+    <field field_ref="Areas" level="1"/>
+    <field field_ref="LandPoints" level="1"/>
+    <field field_ref="Contfrac" level="1"/>
+    <field field_ref="coastalflow" level="1"/>
+    <field field_ref="riverflow" level="1"/>
+    <field field_ref="coastalflow_cpl" level="1"/>
+    <field field_ref="riverflow_cpl" level="1"/>
+    <field field_ref="precip_rain" level="1" name="rain" unit="mm/d" > precip_rain*86400  </field>
+    <field field_ref="precip_snow" level="1" name="snowf" unit="mm/d" > precip_snow*86400  </field>
+    <field field_ref="netrad" level="1"/>
+    <field field_ref="lai" level="1"/>
+    <field field_ref="reinf_slope" level="1"/>
+    <field field_ref="njsc" level="1"/>
+    <field field_ref="basinmap" level="1"/>
+    <field field_ref="nbrivers" level="1"/>
+    <field field_ref="npp" level="1"/>
+    <field field_ref="wtd" level="1"/>
+    <field field_ref="tws" level="1"/>
+    <!-- level 2 -->
+    <field field_ref="vevapsno" name="subli" level="2" unit="mm/d" > this*86400  </field>
+    <field field_ref="runoff" name="runoff" level="2" unit="mm/d" > runoff*86400  </field>
+    <!-- <field field_ref="drainage" name="drainage" level="2" unit="mm/d" > drainage*86400  </field> -->
+    <field field_ref="drainage" name="drainage" level="2"/>
+    <field field_ref="riversret" level="2"/>
+    <field field_ref="hydrographs" level="2"/>
+    <field field_ref="evap" level="2"/>
+    <field field_ref="evapnu" level="2"/>
+    <field field_ref="evapnu_soil" level="2"/>
+    <field field_ref="drainage_soil" level="2"/>
+    <field field_ref="transpir_soil" level="2"/>
+    <field field_ref="runoff_soil" level="2"/>
+    <field field_ref="qair" level="2"/>
+    <field field_ref="tair" level="2"/>
+    <field field_ref="bckgrnd_alb" level="2"/>
+    <field field_ref="albedo_vis" level="2"/>
+    <field field_ref="albedo_nir" level="2"/>
+    <field field_ref="soilalb_vis" level="2"/>
+    <field field_ref="soilalb_nir" level="2"/>
+    <field field_ref="vegalb_vis" level="2"/>
+    <field field_ref="vegalb_nir" level="2"/>
+    <field field_ref="z0h" level="2"/>
+    <field field_ref="z0m" level="2"/>
+    <field field_ref="roughheight" level="2"/>
+    <field field_ref="transpir" level="2"/>
+    <field field_ref="inter" level="2"/>
+    <!-- for water budget control -->
+    <field field_ref="delsoilmoist_daily" level="1" />
+    <field field_ref="delintercept_daily" level="1" />
+    <field field_ref="delswe_daily" level="1" />
+    <field field_ref="delfastr_daily" level="1" />
+    <field field_ref="delslowr_daily" level="1" />
+    <field field_ref="delstreamr_daily" level="1" />
+    <field field_ref="dellaker_daily" level="1" />
+    <field field_ref="delpondr_daily" level="1" />
+    <field field_ref="delfloodr_daily" level="1" />
+    <field field_ref="delstock_routing" level="1" />
+    <field field_ref="evapflo" level="2"/>
+
+    <field field_ref="undermcr" level="2"/>
+    <field field_ref="ru_corr" level="2"/>
+    <field field_ref="ru_corr2" level="2"/>
+    <field field_ref="dr_corr" level="2"/>
+    <field field_ref="dr_force" level="2"/>
+    <field field_ref="ru_infilt" level="2"/>
+    <field field_ref="qinfilt" level="2"/>
+    <field field_ref="dr_corrnum" level="2"/>
+    <!-- level 3 -->
+    <field field_ref="tsol_max" level="3"/>
+    <field field_ref="tsol_min" level="3"/>
+    <field field_ref="fluxsens" level="3"/>
+    <field field_ref="fluxlat" level="3"/>
+    <field field_ref="snow" level="3"/>
+    
+    <field field_ref="snowage" level="3"/>
+    <field field_ref="snownobio" level="3"/>
+    <field field_ref="snownobioage" level="3"/>
+    <field field_ref="vegetfrac" level="3"/>
+    <field field_ref="maxvegetfrac" level="3"/>
+    <field field_ref="tot_bare_soil" level="3"/>
+    <field field_ref="nobiofrac" level="3"/>
+    <field field_ref="reinfiltration" level="3"/>
+    <field field_ref="frac_bare" level="3"/>
+    <field field_ref="soiltile" level="3"/>
+    <field field_ref="qflux" level="3"/>  
+    <field field_ref="check_top" level="3"/> 
+    <field field_ref="check_infilt" level="3"/>
+    <field field_ref="check_tr" level="3"/>
+    <field field_ref="check_over" level="3"/>
+    <field field_ref="check_under" level="3"/>
+
+    <!-- level 4 -->
+    <field field_ref="humtot" level="4"/>
+    <field field_ref="tmc" level="4"/>
+    <field field_ref="qsintveg" level="4"/>
+    <field field_ref="rstruct" level="4"/>
+    <field field_ref="r_soil" level="4"/>
+    <field field_ref="gpp" level="4"/>
+    <field field_ref="nee" level="4"/>
+    <field field_ref="maint_resp" level="4"/>
+    <field field_ref="hetero_resp" level="4"/>
+    <field field_ref="growth_resp" level="4"/>
+    <field field_ref="precisol" level="4"/>
+    <field field_ref="drysoil_frac" level="4"/>
+    <field field_ref="evapot" level="4"/>
+    <field field_ref="evapot_corr" level="4"/>
+    <!-- level 5 -->
+    <field field_ref="swnet" level="5"/>
+    <field field_ref="swdown" level="5"/>
+    <field field_ref="lwdown" level="5"/>
+    <field field_ref="lwnet" level="5"/>
+    <field field_ref="diffevap" level="5"/>
+    <field field_ref="temp_hydro" level="5"/>
+    <field field_ref="snowmelt" level="5"/>
+    <field field_ref="tot_melt" level="5"/>
+    <field field_ref="snowmelt_from_maxmass" level="5"/>
+    <field field_ref="soilcap" level="5"/>
+    <!-- level 6 -->
+    <field field_ref="twbr" level="6"/>
+    <field field_ref="ptn" level="6"/>
+    <field field_ref="frac_snow"  level="6"/>
+    <field field_ref="frac_snow_veg"  level="6"/>
+    <field field_ref="frac_snow_nobio"  level="6"/>
+
+    <!-- level 7 -->
+    <field field_ref="fastr" level="7"/>
+    <field field_ref="slowr" level="7"/>
+    <field field_ref="streamr" level="7"/>
+    <field field_ref="laker" level="7"/>
+    <field field_ref="lake_overflow" level="7"/>
+    <field field_ref="lake_overflow_coast" level="7"/>
+    <field field_ref="mask_coast" level="7"/>
+    <!-- level 8 -->
+    <field field_ref="wbr_fast" level="8"/>
+    <field field_ref="wbr_slow" level="8"/>
+    <field field_ref="wbr_stream" level="8"/>
+    <field field_ref="wbr_lake" level="8"/>
+    <field field_ref="pondr" level="8"/>
+    <field field_ref="swampmap" level="8"/>
+    <field field_ref="irrigation" name="irrigation" level="8" unit="mm/d" > this*86400  </field>
+    <field field_ref="netirrig" name="netirrig" level="8" unit="mm/d" > this*86400  </field>
+    <field field_ref="irrigmap" level="8"/>
+    <field field_ref="floodmap" level="8"/>
+    <field field_ref="floodh" level="8"/>
+    <field field_ref="floodr" level="8"/>
+    <field field_ref="floodout" level="8"/>
+    <field field_ref="k_litt" level="8"/>
+    <field field_ref="beta" level="8"/>
+    <field field_ref="raero" level="8"/>
+    <field field_ref="q_cdrag" level="8"/>
+    <field field_ref="wind" level="8"/>
+    <field field_ref="qsatt" level="8"/>
+    <field field_ref="vbeta1" level="8"/>
+    <field field_ref="vbeta4" level="8"/>
+    <field field_ref="vbeta5" level="8"/>
+    <field field_ref="gsmean" level="8"/>
+    <field field_ref="humrel" level="8"/>
+    <!-- level 10 -->
+    <field field_ref="cimean" level="10"/>
+    <field field_ref="vbeta3" level="10"/>
+    <field field_ref="rveget" level="10"/>
+    <field field_ref="vbeta2" level="10"/>
+    <field field_ref="qsintmax" level="10"/>
+    <!-- level 11 -->
+    <field field_ref="humtot_top" level="11"/>
+    <field field_ref="humtot" name="mrso" level="11"/>
+    <field field_ref="runoff" name="mrros" level="11"/>
+    <field field_ref="mrro" level="11"/>
+    <field field_ref="prveg" level="11"/>
+    <field field_ref="evspsblveg" level="11"/>
+    <field field_ref="evspsblsoi" level="11"/>
+    <field field_ref="tran" level="11"/>
+    <field field_ref="treeFrac" level="11"/>
+    <field field_ref="grassFrac" level="11"/>
+    <field field_ref="cropFrac" level="11"/>
+    <field field_ref="baresoilFrac" level="11"/>
+    <field field_ref="residualFrac" level="11"/>
+    <field field_ref="PAR" level="11"/>
+    <field field_ref="PARsun" level="11"/>
+    <field field_ref="PARsh" level="11"/>
+    <field field_ref="laisun" level="11"/>
+    <field field_ref="laish" level="11"/>
+    <field field_ref="PARsuntab" level="11"/>
+    <field field_ref="PARshtab" level="11"/>
+    <field field_ref="coszang" level="11"/>
+    <field field_ref="PARdf" level="11"/>
+    <field field_ref="PARdr" level="11"/>
+    <field field_ref="flx_fertil_no" level="11"/>
+    <field field_ref="CRF" level="11"/>
+    <field field_ref="flx_co2_bbg_year" level="11"/>
+    <field field_ref="N_qt_WRICE_year" level="11"/>
+    <field field_ref="N_qt_OTHER_year" level="11"/>
+    <field field_ref="flx_iso" level="11"/>
+    <field field_ref="flx_mono" level="11"/>
+    <field field_ref="flx_ORVOC" level="11"/>
+    <field field_ref="flx_MBO" level="11"/>
+    <field field_ref="flx_methanol" level="11"/>
+    <field field_ref="flx_acetone" level="11"/>
+    <field field_ref="flx_acetal" level="11"/>
+    <field field_ref="flx_formal" level="11"/>
+    <field field_ref="flx_acetic" level="11"/>
+    <field field_ref="flx_formic" level="11"/>
+    <field field_ref="flx_no_soil" level="11"/>
+    <field field_ref="flx_no" level="11"/>
+    <field field_ref="Psurf" level="11"/>
+    <field field_ref="slowflow" level="11"/>
+    <field field_ref="qsintveg_tot" level="11"/>
+    <field field_ref="LAImean" level="11"/>
+    <field field_ref="mcs" level="11"/>
+    <field field_ref="nroot" level="11"/>
+    <field field_ref="dlh" level="11"/>
+    <field field_ref="water2infilt" level="11"/>
+    <field field_ref="flx_apinen"  level="11" />
+    <field field_ref="flx_bpinen"  level="11" />
+    <field field_ref="flx_limonen" level="11" />
+    <field field_ref="flx_myrcen"  level="11" />
+    <field field_ref="flx_sabinen" level="11" />
+    <field field_ref="flx_camphen" level="11" />
+    <field field_ref="flx_3caren"  level="11" />
+    <field field_ref="flx_tbocimen" level="11"/>
+    <field field_ref="flx_othermono" level="11"/>
+    <field field_ref="flx_sesquiter" level="11"/>
+    <field field_ref="fco2" level="11"/>
+    <field field_ref="cim" level="11"/>
+    <field field_ref="kk_moy" level="11"/>
+    <field field_ref="profil_froz_hydro" level="11"/>
+    <field field_ref="pkappa"  level="11"/>
+    <field field_ref="pkappa_snow" level="11"/>
+    <field field_ref="pcapa"  level="11"/>
+    <field field_ref="pcapa_snow"  level="11"/>
+    <field field_ref="snowtemp"  level="11"/>
+    <field field_ref="snowliq"  level="11"/>
+    <field field_ref="snowdz"  level="11"/>
+    <field field_ref="snowrho"  level="11"/>
+    <field field_ref="snowheat"  level="11"/>
+    <field field_ref="snowgrain"  level="11"/>
+    <field field_ref="asoilcol"  level="11"/> 
+    <field field_ref="aalb_bg"  level="11"/> 
+    <field field_ref="atext"  level="11"/> 
+    <field field_ref="areftemp"  level="11"/> 
+    <field field_ref="aslope"  level="11"/> 
+    <field field_ref="aveget"  level="11"/> 
+    <field field_ref="aveget5k"  level="11"/> 
+    <field field_ref="achem_wrice"  level="11"/> 
+    <field field_ref="achem_other"  level="11"/> 
+    <field field_ref="achem_co2"  level="11"/>
+  </file>
+
+  <!-- Sechiba file 2 -->
+  <file id="sechiba2" name="sechiba_out_2" output_level="2" output_freq="_AUTO_" enabled="_AUTO_">
+    <!-- level 1 -->
+    <field field_ref="Areas" level="1"/>
+    <field field_ref="LandPoints" level="20"/>
+    <field field_ref="Contfrac" level="1"/>
+    <field field_ref="humtot_top" level="1"/>
+    <field field_ref="mrro" level="1"/>
+    <field field_ref="ptn" level="1"/>
+    <field field_ref="wtd" level="1"/>
+    <field field_ref="tws" level="1"/>
+
+    <!-- level 2 -->
+    <field field_ref="q_cdrag" level="2"/>
+    <field field_ref="soilalb_vis" level="2"/>
+    <field field_ref="soilalb_nir" level="2"/>
+    <field field_ref="vegalb_vis" level="2"/>
+    <field field_ref="vegalb_nir" level="2"/>
+    <field field_ref="z0m" level="2"/>
+    <field field_ref="z0h" level="2"/>
+    <field field_ref="coastalflow" level="2"/>
+    <field field_ref="riverflow" level="2"/>
+    <field field_ref="tsol_rad" level="2"/>
+    <field field_ref="vevapnu" level="2"/>
+    <field field_ref="qsurf" level="2"/>
+    <field field_ref="fluxsens" level="2"/>
+    <field field_ref="fluxlat" level="2"/>
+    <field field_ref="emis" level="2"/>
+    <field field_ref="riversret" level="2"/>
+    <field field_ref="hydrographs" level="2"/>
+    <field field_ref="undermcr" level="2"/>
+    <field field_ref="ru_corr" level="2"/>
+    <field field_ref="ru_corr2" level="2"/>
+    <field field_ref="dr_corr" level="2"/>
+    <field field_ref="dr_force" level="2"/>
+    <field field_ref="ru_infilt" level="2"/>
+    <field field_ref="qinfilt" level="2"/>
+    <field field_ref="dr_corrnum" level="2"/>
+    <!-- level 3 -->
+    <field field_ref="precip_rain" level="3" name="rain" unit="mm/d" > precip_rain*86400  </field>
+    <field field_ref="precip_snow" level="3" name="snowf" unit="mm/d" > precip_snow*86400  </field>
+    <field field_ref="netrad" level="3"/>
+    <field field_ref="lai" level="3"/>
+    <field field_ref="basinmap" level="3"/>
+    <field field_ref="nbrivers" level="3"/>
+    <field field_ref="check_infilt" level="3"/>
+    <field field_ref="check_tr" level="3"/>
+    <field field_ref="check_over" level="3"/>
+    <field field_ref="check_under" level="3"/>
+    
+
+    <!-- level 4 -->
+    <field field_ref="vevapsno" name="subli" level="4" unit="mm/d" > this*86400  </field>
+    <field field_ref="runoff" name="runoff" level="4" unit="mm/d" > runoff*86400  </field>
+    <field field_ref="drainage" name="drainage" level="4" unit="mm/d" > drainage*86400  </field>
+    <field field_ref="qair" level="4"/>
+    <field field_ref="albedo_vis" level="4"/>
+    <field field_ref="albedo_nir" level="4"/>
+    <field field_ref="roughheight" level="4"/>
+    <field field_ref="transpir" level="4"/>
+    <field field_ref="inter" level="4"/>
+    <field field_ref="evapnu_soil" level="4"/>
+    <field field_ref="drainage_soil" level="4"/>
+    <field field_ref="transpir_soil" level="4"/>
+    <field field_ref="runoff_soil" level="4"/>
+    <!-- level 5 -->
+    <field field_ref="tsol_max" level="5"/>
+    <field field_ref="tsol_min" level="5"/>
+    <field field_ref="snow" level="5"/>
+    <field field_ref="snowage" level="5"/>
+    <field field_ref="snownobio" level="5"/>
+    <field field_ref="snownobioage" level="5"/>
+    <field field_ref="snowmelt" level="5"/>
+    <field field_ref="tot_melt" level="5"/>
+    <field field_ref="snowmelt_from_maxmass" level="5"/>
+    <field field_ref="soilcap" level="5"/>
+    <field field_ref="vegetfrac" level="5"/>
+    <field field_ref="maxvegetfrac" level="5"/>
+    <field field_ref="nobiofrac" level="5"/>
+    <field field_ref="temp_hydro"  level="5"/>
+    <!-- level 6 -->
+    <field field_ref="humtot" level="6"/>
+    <field field_ref="tmc" level="6"/>
+    <field field_ref="qsintveg" level="6"/>
+    <field field_ref="rstruct" level="6"/>
+    <field field_ref="r_soil" level="6"/>
+    <field field_ref="gpp" level="6"/>
+    <field field_ref="nee" level="6"/>
+    <field field_ref="maint_resp" level="6"/>
+    <field field_ref="hetero_resp" level="6"/>
+    <field field_ref="growth_resp" level="6"/>
+    <field field_ref="npp" level="6"/>
+    <field field_ref="precisol" level="6"/>
+    <field field_ref="drysoil_frac" level="6"/>
+    <field field_ref="evapot" level="6"/>
+    <field field_ref="evapot_corr" level="6"/>
+    <field field_ref="twbr" level="6"/>
+    <!-- level 7 -->
+    <field field_ref="swnet" level="7"/>
+    <field field_ref="swdown" level="7"/>
+    <field field_ref="lwdown" level="7"/>
+    <field field_ref="lwnet" level="7"/>
+    <field field_ref="diffevap" level="7"/>
+    <!-- level 8 -->
+    <field field_ref="fastr" level="8"/>
+    <field field_ref="slowr" level="8"/>
+    <field field_ref="streamr" level="8"/>
+    <field field_ref="floodr" level="8"/>
+    <field field_ref="floodh" level="8"/>
+    <field field_ref="pondr" level="8"/>
+    <field field_ref="laker" level="8"/>
+    <field field_ref="irrigation" name="irrigation" level="8" unit="mm/d" > this*86400  </field>
+    <field field_ref="netirrig" name="netirrig" level="8" unit="mm/d" > this*86400  </field>
+    <field field_ref="irrigmap" level="8"/>
+    <field field_ref="floodmap" level="8"/>
+    <field field_ref="swampmap" level="8"/>
+
+    <!-- for water budget control -->
+    <!-- Note! The _daily variables need an output frequency of at least one day -->
+    <field field_ref="delsoilmoist_daily" level="8" />
+    <field field_ref="delintercept_daily" level="8" />
+    <field field_ref="delswe_daily" level="8" />
+    <field field_ref="delfastr_daily" level="8" />
+    <field field_ref="delslowr_daily" level="8" />
+    <field field_ref="delstreamr_daily" level="8" />
+    <field field_ref="dellaker_daily" level="8" />
+    <field field_ref="delpondr_daily" level="8" />
+    <field field_ref="delfloodr_daily" level="8" />
+    <field field_ref="delstock_routing" level="8" />
+    <field field_ref="evapnu" level="8"/>
+    <field field_ref="evapflo" level="8"/>
+
+    <!-- level 9 -->
+    <field field_ref="beta" level="9"/>
+    <field field_ref="raero" level="9"/>
+    <field field_ref="wind" level="9"/>
+    <field field_ref="qsatt" level="9"/>
+    <field field_ref="vbeta1" level="9"/>
+    <field field_ref="vbeta4" level="9"/>
+    <field field_ref="gsmean" level="9"/>
+    <field field_ref="vbeta5" level="9"/>
+    <field field_ref="reinf_slope" level="9"/>
+    <field field_ref="njsc" level="9"/>
+    <field field_ref="humrel" level="9"/>
+    <!-- level 10 -->
+    <field field_ref="cimean" level="10"/>
+    <field field_ref="vbeta3" level="10"/>
+    <field field_ref="rveget" level="10"/>
+    <field field_ref="vbeta2" level="10"/>
+    <field field_ref="qsintmax" level="10"/>
+    <field field_ref="PAR" level="10"/>
+    <field field_ref="PARsun" level="10"/>
+    <field field_ref="PARsh" level="10"/>
+    <field field_ref="laisun" level="10"/>
+    <field field_ref="laish" level="10"/>
+    <field field_ref="PARsuntab" level="10"/>
+    <field field_ref="PARshtab" level="10"/>
+    <field field_ref="coszang" level="10"/>
+    <field field_ref="PARdf" level="10"/>
+    <field field_ref="PARdr" level="10"/>
+    <field field_ref="flx_fertil_no" level="10"/>
+    <field field_ref="CRF" level="10"/>
+    <field field_ref="flx_co2_bbg_year" level="10"/>
+    <field field_ref="N_qt_WRICE_year" level="10"/>
+    <field field_ref="N_qt_OTHER_year" level="10"/>
+    <field field_ref="flx_iso" level="10"/>
+    <field field_ref="flx_mono" level="10"/>
+    <field field_ref="flx_ORVOC" level="10"/>
+    <field field_ref="flx_MBO" level="10"/>
+    <field field_ref="flx_methanol" level="10"/>
+    <field field_ref="flx_acetone" level="10"/>
+    <field field_ref="flx_acetal" level="10"/>
+    <field field_ref="flx_formal" level="10"/>
+    <field field_ref="flx_acetic" level="10"/>
+    <field field_ref="flx_formic" level="10"/>
+    <field field_ref="flx_no_soil" level="10"/>
+    <field field_ref="flx_no" level="10"/>
+    <field field_ref="Psurf" level="11"/>
+    <field field_ref="slowflow" level="11"/>
+    <field field_ref="qsintveg_tot" level="11"/>
+    <field field_ref="LAImean" level="11"/>
+    <field field_ref="mcs" level="11"/>
+    <field field_ref="nroot" level="11"/>
+    <field field_ref="dlh" level="11"/>
+    <field field_ref="water2infilt" level="11"/>
+    <field field_ref="kk_moy" level="11"/>
+    <field field_ref="profil_froz_hydro" level="11"/>
+    <field field_ref="pkappa"  level="11"/>
+    <field field_ref="pkappa_snow" level="11"/>
+    <field field_ref="pcapa"  level="11"/>
+    <field field_ref="pcapa_snow"  level="11"/>
+    <field field_ref="snowtemp"  level="11"/>
+    <field field_ref="snowliq"  level="11"/>
+    <field field_ref="snowdz"  level="11"/>
+    <field field_ref="snowrho"  level="11"/>
+    <field field_ref="snowheat"  level="11"/>
+    <field field_ref="snowgrain"  level="11"/>
+
+  </file>
+
+  <!-- Sechiba file 3 -->
+  <!-- This files contains all variables having more than one vertical axis -->
+  <file id="sechiba3" name="sechiba_history_4dim" output_level="11" output_freq="_AUTO_" enabled="_AUTO_">
+    <field field_ref="Areas" level="1"/>
+    <field field_ref="Contfrac" level="1"/>
+    <field field_ref="mc" level="3"/>
+    <field field_ref="psi_soil" level="3"/>
+    <field field_ref="kfact_root" level="3"/>
+    <field field_ref="vegetmax_soil" level="3"/>
+    <field field_ref="profil_froz_hydro_ns" level="11"/>
+  </file>
+
+  <!-- Sechiba alma file 1 -->
+  <file id="sechiba1_alma" name="sechiba_history_alma" output_level="10" output_freq="1mo" enabled=".FALSE.">
+    <field field_ref="Areas" level="1"/>
+    <field field_ref="LandPoints" level="20"/>
+    <field field_ref="Contfrac" level="1"/>
+    <field field_ref="soilflx" level="1"/>
+    <field field_ref="Qv" level="1"/>
+    <field field_ref="runoff" name="Qs" level="1"/>
+    <field field_ref="drainage" name="Qsb" level="1"/>
+    <field field_ref="coastalflow" name="CoastalFlow" level="1"/>
+    <field field_ref="riverflow" name="RiverFlow" level="1"/>    
+    <field field_ref="surfheat_incr" level="1"/>
+    <field field_ref="coldcont_incr" level="1"/>
+    <field field_ref="fluxsens" name="Qh" level="1"/>
+    <field field_ref="fluxlat" name="Qle" level="1"/>
+    <field field_ref="lwnet" name="LWnet" level="1"/>
+    <field field_ref="swnet" name="SWnet" level="1"/>
+    <field field_ref="precip_rain" name="Rainf" level="1"/>
+    <field field_ref="precip_snow" name="Snowf" level="1"/>
+    <field field_ref="vevapp" name="Evap" level="1"/>
+    <field field_ref="tot_melt" name="Qsm" level="1"/>
+    <field field_ref="irrigation" name="Qirrig" level="1"/>
+    <field field_ref="netirrig" name="Qirrig_req" long_name="Irrigation requirement" level="1"/>
+    <field field_ref="temp_sol_C" level="1"/>
+    <field field_ref="fastr" level="1"/> 
+    <field field_ref="slowr" level="1"/> 
+    <field field_ref="streamr" level="1"/> 
+    <field field_ref="laker" level="1"/> 
+    <field field_ref="pondr" level="1"/>
+    <field field_ref="PotSurfT" level="1"/>
+    <field field_ref="albedo_glob" level="1"/>
+    <field field_ref="bckgrnd_alb" name="Albedo_Background" level="1"/>
+    <field field_ref="SurfStor" level="1"/>
+    <field field_ref="snow" name="SWE" long_name="Snow Water Equivalent" level="1"/>
+    <field field_ref="soilwet" level="1"/>
+    <field field_ref="evapot_corr" name="PotEvap" long_name="Potential evapotranspiration" unit="kg/m^2/s" level="1"/>
+    <field field_ref="evapot" name="PotEvapOld" long_name="Potential evapotranspiration old method" unit="kg/m^2/s" level="1"/>
+    <field field_ref="ECanop" level="1"/>
+    <field field_ref="TVeg" level="1"/>
+    <field field_ref="vevapsno" name="SubSnow" level="1"/>
+    <field field_ref="irrigmap" name="IrrigationMap" level="1"/>
+    <field field_ref="floodmap" name="FloodplainsMap" level="1"/>
+    <field field_ref="swampmap" name="SwampMap" level="1"/>
+    <field field_ref="hydrographs" name="Dis" level="1"/>
+    <field field_ref="gpp" name="GPP" level="1"/>
+    <field field_ref="nee" name="NEE" level="1"/>
+    <field field_ref="maint_resp" level="1"/>
+    <field field_ref="hetero_resp" level="1"/>
+    <field field_ref="growth_resp" level="1"/>
+    <field field_ref="npp" level="1"/>
+    <field field_ref="z0m" name="Z0m" long_name="Roughness height for momentum" level="1"/>
+    <field field_ref="z0h" name="Z0h" long_name="Roughness height for heat" level="1"/>
+    <field field_ref="roughheight" name="EffectHeight" long_name="Effective displacement height (h-d)" level="1"/>
+    <field field_ref="delsoilmoist" level="1"/>
+    <field field_ref="delintercept" level="1"/>
+    <field field_ref="delswe" level="1"/>
+    <field field_ref="vevapnu_alma" level="1"/>
+    <field field_ref="evapflo_alma" level="1"/>
+    <field field_ref="ACond" level="1"/>
+    <field field_ref="qair" name="Qair" level="2"/>
+    <field field_ref="vegetfrac" level="3"/>
+    <field field_ref="maxvegetfrac" level="3"/>
+    <field field_ref="nobiofrac" level="3"/>
+    <field field_ref="soilmoist" level="7"/>
+    <field field_ref="humtot" name="RootMoist" long_name="Root zone soil water" level="1"/>
+    <field field_ref="ptn" name="SoilTemp" level="7"/>
+    <field field_ref="vbeta1" name="SnowFrac" level="7"/>
+    <field field_ref="albedo_snow" level="7"/>
+    <field field_ref="snowdz" name="SnowDepth" level="7"/>
+    <field field_ref="temp_sol_C" name="RadT" level="1"/>
+    <field field_ref="fastr" level="1"/> 
+    <field field_ref="slowr" level="1"/> 
+    <field field_ref="streamr" level="1"/> 
+    <field field_ref="laker" level="1"/> 
+    <field field_ref="pondr" level="1"/>
+    <field field_ref="twbr" level="1"/>
+  </file>
+
+  <!-- Sechiba alma file 2 -->
+  <file id="sechiba2_alma" name="sechiba_out_2_alma" output_level="10" output_freq="1d" enabled=".FALSE.">
+    <field field_ref="Areas" level="1"/>
+    <field field_ref="LandPoints" level="20"/>
+    <field field_ref="Contfrac" level="1"/>
+    <field field_ref="soilflx" level="1"/>
+    <field field_ref="Qv" level="1"/>
+    <field field_ref="runoff" name="Qs" level="1"/>
+    <field field_ref="drainage" name="Qsb" level="1"/>
+    <field field_ref="coastalflow" name="CoastalFlow" level="1"/>
+    <field field_ref="riverflow" name="RiverFlow" level="1"/>
+    <field field_ref="surfheat_incr" level="1"/>
+    <field field_ref="coldcont_incr" level="1"/>
+    <field field_ref="fluxsens" name="Qh" level="1"/>
+    <field field_ref="fluxlat" name="Qle" level="1"/>
+    <field field_ref="lwnet" name="LWnet" level="1"/>
+    <field field_ref="swnet" name="SWnet" level="1"/>
+    <field field_ref="precip_rain" name="Rainf" level="1"/>
+    <field field_ref="precip_snow" name="Snowf" level="1"/>
+    <field field_ref="vevapp" name="Evap" level="1"/>
+    <field field_ref="tot_melt" name="Qsm" level="1"/>
+    <field field_ref="irrigation" name="Qirrig" level="1"/>
+    <field field_ref="netirrig" name="Qirrig_req" long_name="Irrigation requirement" level="1"/>
+    <field field_ref="albedo_glob" level="1"/>
+    <field field_ref="SurfStor" level="1"/>
+    <field field_ref="snow" name="SWE" long_name="Snow Water Equivalent" level="1"/>
+    <field field_ref="soilwet" level="1"/>
+    <field field_ref="ECanop" level="1"/>
+    <field field_ref="TVeg" level="1"/>
+    <field field_ref="vevapsno" name="SubSnow" level="1"/>
+    <field field_ref="irrigmap" name="IrrigationMap" level="1"/>
+    <field field_ref="floodmap" name="FloodplainsMap" level="1"/>
+    <field field_ref="swampmap" name="SwampMap" level="1"/>
+    <field field_ref="hydrographs" name="Dis" level="1"/>
+    <field field_ref="gpp" name="GPP" level="1"/>
+    <field field_ref="nee" name="NEE" level="1"/>
+    <field field_ref="maint_resp" level="1"/>
+    <field field_ref="hetero_resp" level="1"/>
+    <field field_ref="growth_resp" level="1"/>
+    <field field_ref="npp" level="1"/>
+    <field field_ref="delsoilmoist" level="1"/>
+    <field field_ref="delintercept" level="1"/>
+    <field field_ref="delswe" level="1"/>
+    <field field_ref="vevapnu_alma" level="1"/>
+    <field field_ref="evapflo_alma" level="1"/>
+    <field field_ref="ACond" level="1"/>
+    <field field_ref="soilmoist" level="7"/>
+    <field field_ref="humtot" name="RootMoist" long_name="Root zone soil water" level="1"/>
+    <field field_ref="ptn" name="SoilTemp" level="7"/>
+    <field field_ref="vbeta1" name="SnowFrac" level="7"/>
+    <field field_ref="albedo_snow" level="7"/>
+    <field field_ref="snowdz" name="SnowDepth" level="7"/>
+    <field field_ref="vegetfrac" level="3"/>
+    <field field_ref="maxvegetfrac" level="3"/>
+    <field field_ref="nobiofrac" level="3"/>
+  </file>
+
+  <!-- Definition of files with stomate diagnostics -->
+  <!-- Stomate file 1 -->
+  <file id="stomate1" name="stomate_history" output_level="10" output_freq="_AUTO_" enabled="_AUTO_">
+    <!-- level 1 -->
+    <field field_ref="RESOLUTION_X" level="1"/>
+    <field field_ref="RESOLUTION_Y" level="1"/>
+    <field field_ref="CONTFRAC_STOMATE" level="1"/>
+    <field field_ref="Areas" level="1"/>
+    <field field_ref="T2M_MONTH" level="1"/>
+    <field field_ref="T2M_WEEK" level="1"/>
+    <field field_ref="FIREFRAC" level="1"/>
+    <field field_ref="CO2_FIRE" level="1"/>
+    <field field_ref="CO2_TAKEN" level="1"/>
+    <field field_ref="LAI" level="1"/>
+    <field field_ref="VEGET_COV_MAX" level="1"/>
+    <field field_ref="NPP_STOMATE" level="1"/>
+    <field field_ref="GPP" level="1"/>
+    <field field_ref="NBP_pool" level="1"/>
+    <field field_ref="NBP_pool_spinup" level="1"/>
+    <field field_ref="DIAMETER" level="1"/>
+    <field field_ref="PLANT_STATUS" level="1"/>
+    <field field_ref="WSTRESS_MONTH" level="1"/>
+    <field field_ref="WSTRESS_SEASON" level="1"/>
+    <field field_ref="MB_CLOSURE_c" level="1"/>
+    <field field_ref="MB_CLOSURE_n" level="1"/>
+    <!-- level 2 -->
+    <field field_ref="LEAF_M_c" level="2"/>
+    <field field_ref="SAP_M_AB_c" level="2"/>
+    <field field_ref="SAP_M_BE_c" level="2"/>
+    <field field_ref="HEART_M_AB_c" level="2"/>
+    <field field_ref="HEART_M_BE_c" level="2"/>
+    <field field_ref="ROOT_M_c" level="2"/>
+    <field field_ref="FRUIT_M_c" level="2"/>
+    <field field_ref="RESERVE_M_c" level="2"/>
+    <field field_ref="MAINT_RESP" level="2"/>
+    <field field_ref="GROWTH_RESP" level="2"/>
+    <field field_ref="FOREST_MANAGED" level="2"/>
+    <field field_ref="LAB_FAC" level="2"/>
+    <field field_ref="LITTER_RAKE_FRAC" level="2"/>
+    <field field_ref="RESERVE_POOL_TARGET" level="2"/>
+    <field field_ref="LABILE_POOL_TARGET" level="2"/>
+
+    <!-- level 3 -->
+    <field field_ref="IND" level="3"/>
+    <field field_ref="ADAPTATION" level="3"/>
+    <field field_ref="REGENERATION" level="3"/>
+    <field field_ref="CN_IND" level="3"/>
+    <field field_ref="WOODMASS_IND" level="3"/>
+    <field field_ref="MOISTRESS" level="3"/>
+    <field field_ref="HET_RESP" level="3"/>
+    <field field_ref="GAMMA" level="3"/>
+    <field field_ref="RDI" level="3"/>
+    <field field_ref="RDI_TARGET_LOWER" level="3"/>
+    <field field_ref="RDI_TARGET_UPPER" level="3"/>
+    <field field_ref="SIGMA" level="3"/>
+    <!-- level 4 -->
+    <field field_ref="SAP_AB_TURN_c" level="4"/>
+    <field field_ref="ROOT_TURN_c" level="4"/>
+    <field field_ref="FRUIT_TURN_c" level="4"/>
+    <!--<field field_ref="TOTAL_BM_LITTER_c" level="4"/>-->
+    <field field_ref="LEAF_BM_LITTER_c" level="4"/>
+    <field field_ref="SAP_AB_BM_LITTER_c" level="4"/>
+    <field field_ref="SAP_BE_BM_LITTER_c" level="4"/>
+    <field field_ref="HEART_AB_BM_LITTER_c" level="4"/>
+    <field field_ref="HEART_BE_BM_LITTER_c" level="4"/>
+    <field field_ref="ROOT_BM_LITTER_c" level="4"/>
+    <field field_ref="FRUIT_BM_LITTER_c" level="4"/>
+    <field field_ref="RESERVE_BM_LITTER_c" level="4"/>
+    <field field_ref="TOTAL_M_c" level="4"/>
+    <!--<field field_ref="TOTAL_TURN_c" level="4"/>-->
+    <field field_ref="LEAF_TURN_c" level="4"/>
+    <!-- level 5 -->
+    <field field_ref="LITTER_STR_AB_c" level="5"/>
+    <field field_ref="LITTER_MET_AB_c" level="5"/>
+    <field field_ref="LITTER_STR_BE_c" level="5"/>
+    <field field_ref="LITTER_MET_BE_c" level="5"/>
+    <field field_ref="DEADLEAF_COVER" level="5"/>
+    <field field_ref="TOTAL_SOIL_CARB" level="5"/>
+    <field field_ref="LITTERHUM" level="5"/>
+    <field field_ref="BM_ALLOC_LEAF_c" level="5"/>
+    <field field_ref="BM_ALLOC_SAP_AB_c" level="5"/>
+    <field field_ref="BM_ALLOC_SAP_BE_c" level="5"/>
+    <field field_ref="BM_ALLOC_ROOT_c" level="5"/>
+    <field field_ref="BM_ALLOC_FRUIT_c" level="5"/>
+    <field field_ref="BM_ALLOC_RES_c" level="5"/>
+    <field field_ref="BM_ALLOC_LABILE_c" level="5"/>
+    <field field_ref="RESIDUAL" level="5"/>
+    <field field_ref="HERBIVORES" level="5"/>
+    <field field_ref="TURNOVER_TIME_LEAF" level="5"/>
+    <field field_ref="TURNOVER_TIME_ROOT" level="5"/>
+    <field field_ref="TURNOVER_TIME_SAP_AB" level="5"/>
+    <field field_ref="TURNOVER_TIME_FRUIT" level="5"/>
+    <field field_ref="PROD10" level="5"/>
+    <field field_ref="FLUX10" level="5"/>
+    <field field_ref="PROD100" level="5"/>
+    <field field_ref="FLUX100" level="5"/>
+    <field field_ref="CONVFLUX" level="5"/>
+    <field field_ref="CFLUX_PROD10" level="5"/>
+    <field field_ref="CFLUX_PROD100" level="5"/>
+    <field field_ref="HARVEST_ABOVE" level="5"/>
+    <field field_ref="WOOD_VOL_PIX_CUT" level="5"/>
+
+    <field field_ref="TOTAL_M_n" level="5"/>
+    <field field_ref="LEAF_M_n" level="5"/>
+    <field field_ref="SAP_M_AB_n" level="5"/>
+    <field field_ref="SAP_M_BE_n" level="5"/>
+    <field field_ref="HEART_M_AB_n" level="5"/>
+    <field field_ref="HEART_M_BE_n" level="5"/>
+    <field field_ref="ROOT_M_n" level="5"/>
+    <field field_ref="FRUIT_M_n" level="5"/>
+    <field field_ref="LABILE_M_c" level="5"/>
+    <field field_ref="LABILE_M_n" level="5"/>
+    <field field_ref="RESERVE_M_n" level="5"/>
+    <field field_ref="TOTAL_TURN_n" level="5"/>
+    <field field_ref="LEAF_TURN_n" level="5"/>
+    <field field_ref="SAP_AB_TURN_n" level="5"/>
+    <field field_ref="ROOT_TURN_n" level="5"/>
+    <field field_ref="FRUIT_TURN_n" level="5"/>
+    <!--<field field_ref="TOTAL_BM_LITTER_n" level="5"/>-->
+    <field field_ref="LEAF_BM_LITTER_n" level="5"/>
+    <field field_ref="SAP_AB_BM_LITTER_n" level="5"/>
+    <field field_ref="SAP_BE_BM_LITTER_n" level="5"/>
+    <field field_ref="HEART_AB_BM_LITTER_n" level="5"/>
+    <field field_ref="HEART_BE_BM_LITTER_n" level="5"/>
+    <field field_ref="ROOT_BM_LITTER_n" level="5"/>
+    <field field_ref="FRUIT_BM_LITTER_n" level="5"/>
+    <field field_ref="LABILE_BM_LITTER_c" level="5"/>
+    <field field_ref="LABILE_BM_LITTER_n" level="5"/>
+    <field field_ref="RESERVE_BM_LITTER_n" level="5"/>
+    <field field_ref="LITTER_STR_AB_n" level="5"/>
+    <field field_ref="LITTER_MET_AB_n" level="5"/>
+    <field field_ref="LITTER_WOD_AB_c" level="5"/>
+    <field field_ref="LITTER_WOD_AB_n" level="5"/>
+    <field field_ref="LITTER_STR_BE_n" level="5"/>
+    <field field_ref="LITTER_MET_BE_n" level="5"/>
+    <field field_ref="LITTER_WOD_BE_c" level="5"/>
+    <field field_ref="LITTER_WOD_BE_n" level="5"/>
+    <field field_ref="SOIL_ACTIVE_c" level="5"/>
+    <field field_ref="SOIL_ACTIVE_n" level="5"/>
+    <field field_ref="SOIL_SLOW_c" level="5"/>
+    <field field_ref="SOIL_SLOW_n" level="5"/>
+    <field field_ref="SOIL_PASSIVE_c" level="5"/>
+    <field field_ref="SOIL_PASSIVE_n" level="5"/>
+    <field field_ref="SOIL_SURF_c" level="5"/>
+    <field field_ref="SOIL_SURF_n" level="5"/>
+    <field field_ref="BM_ALLOC_LEAF_n" level="5"/>
+    <field field_ref="BM_ALLOC_SAP_AB_n" level="5"/>
+    <field field_ref="BM_ALLOC_SAP_BE_n" level="5"/>
+    <field field_ref="BM_ALLOC_ROOT_n" level="5"/>
+    <field field_ref="BM_ALLOC_FRUIT_n" level="5"/>
+    <field field_ref="BM_ALLOC_RES_n" level="5"/>
+    <field field_ref="BM_ALLOC_LABILE_n" level="5"/>
+    <field field_ref="FLUX_PROD_S_c" level="5"/>
+    <field field_ref="FLUX_PROD_S_n" level="5"/>
+    <field field_ref="FLUX_PROD_M_c" level="5"/>
+    <field field_ref="FLUX_PROD_M_n" level="5"/>
+    <field field_ref="FLUX_PROD_L_c" level="5"/>
+    <field field_ref="FLUX_PROD_L_n" level="5"/>
+    <field field_ref="FLUX_S_c" level="5"/>
+    <field field_ref="FLUX_S_n" level="5"/>
+    <field field_ref="FLUX_M_c" level="5"/>
+    <field field_ref="FLUX_M_n" level="5"/>
+    <field field_ref="FLUX_L_c" level="5"/>
+    <field field_ref="FLUX_L_n" level="5"/>
+    <field field_ref="PROD_S_c" level="5"/>
+    <field field_ref="PROD_S_n" level="5"/>
+    <field field_ref="PROD_M_c" level="5"/>
+    <field field_ref="PROD_M_n" level="5"/>
+    <field field_ref="PROD_L_c" level="5"/>
+    <field field_ref="PROD_L_n" level="5"/>
+
+    <field field_ref="RUE_LONGTERM" level="5"/>
+    <field field_ref="KF" name="KF" level="5"/>
+    <field field_ref="BA" name="BA" level="5"/>
+    <field field_ref="WOOD_VOL" level="5"/>
+    <field field_ref="K_LATOSA_ADAPT" level="5"/>
+
+    <field field_ref="N_UPTAKE_NH4" level="5"/>
+    <field field_ref="N_UPTAKE_NO3" level="5"/>
+    <field field_ref="N_MINERALISATION" level="5"/>
+    <field field_ref="SOIL_NH4" level="5"/>
+    <field field_ref="SOIL_NO3" level="5"/>
+    <field field_ref="SOIL_NOX" level="5"/>
+    <field field_ref="SOIL_N2O" level="5"/>
+    <field field_ref="SOIL_N2" level="5"/>
+    <field field_ref="SOIL_P_OX" level="5"/>
+    <field field_ref="BACT" level="5"/>
+    <field field_ref="NH3_EMISSION" level="5"/>
+    <field field_ref="NOX_EMISSION" level="5"/>
+    <field field_ref="N2O_EMISSION" level="5"/>
+    <field field_ref="N2_EMISSION" level="5"/>
+    <field field_ref="NH4_LEACHING" level="5"/>
+    <field field_ref="NO3_LEACHING" level="5"/>
+    <field field_ref="NITRIFICATION" level="5"/>
+    <field field_ref="DENITRIFICATION" level="5"/>
+    <field field_ref="NHX_DEPOSITION" level="5"/>
+    <field field_ref="NOX_DEPOSITION" level="5"/>
+    <field field_ref="BNF" level="5"/>
+    <field field_ref="N_FERTILISER" level="5"/>
+    <field field_ref="N_MANURE" level="5"/>
+    <field field_ref="N_TAKEN" level="5"/>
+
+    <field field_ref="NOX_FIRE_EMISSION" level="5"/>
+
+    <!-- level 6 -->
+    <field field_ref="VCMAX" level="6"/>
+    <field field_ref="VCMAX_NEW" level="6"/>
+    <field field_ref="LEAF_AGE" level="6"/>
+    <field field_ref="MORTALITY" level="6"/>
+    <field field_ref="FIREDEATH" level="6"/>
+    <field field_ref="IND_ESTAB" level="6"/>
+    <field field_ref="ESTABTREE" level="6"/>
+    <field field_ref="ESTABGRASS" level="6"/>
+    <field field_ref="LIGHT_DEATH" level="6"/>
+    <field field_ref="HARVEST_TYPE" level="6"/>
+    <field field_ref="HARVEST_CUT" level="6"/>
+    <field field_ref="HARVEST_AREA" level="6"/>
+    <field field_ref="HARVEST_POOL_C" level="6"/>
+    <field field_ref="HARVEST_POOL_N" level="6"/>
+    <!-- level 7 -->
+    <field field_ref="AGE" level="7"/>
+    <field field_ref="AGE_STAND" level="7"/>
+    <field field_ref="HEIGHT" level="7"/>
+    <!-- level 9 -->
+    <field field_ref="WHEN_GROWTHINIT" level="9"/>
+    <field field_ref="PFTPRESENT" level="9"/>
+    <field field_ref="GDD_MIDWINTER" level="9"/>
+    <field field_ref="GDD_M5_DORMANCE" level="9"/>
+    <field field_ref="NCD_DORMANCE" level="9"/>
+    <field field_ref="ALLOW_INITPHENO" level="9"/>
+    <field field_ref="BEGIN_LEAVES" level="9"/>
+    <field field_ref="T2M_LONGTERM" level="9"/>
+    <field field_ref="TSEASON"  level="9"/>
+    <field field_ref="TMIN_SPRING_TIME" level="9"/>
+    <field field_ref="ONSET_DATE" level="9"/>
+    <field field_ref="FPC_MAX" level="9"/>
+    <field field_ref="MAXFPC_LASTYEAR" level="9"/>
+    <field field_ref="MOIAVAIL_SEASON" level="9"/>
+    <field field_ref="NSTRESS_SEASON" level="9"/>
+    <!-- level 10 -->
+    <field field_ref="FIREINDEX" level="10"/>
+    <field field_ref="LAST_CUT" level="10"/>
+    <field field_ref="MAI" level="10"/>
+    <field field_ref="PAI" level="10"/>
+    <field field_ref="ROTATION_N" level="10"/>
+    <field field_ref="CN_LONGTERM_ACTIVE" level="10"/>
+    <field field_ref="CN_LONGTERM_SLOW" level="10"/>
+    <field field_ref="CN_LONGTERM_PASSIVE" level="10"/>
+    <field field_ref="CN_LONGTERM_SURF" level="10"/>
+    <field field_ref="CN_LONGTERM_LITTER_STR_AB" level="10"/>
+    <field field_ref="CN_LONGTERM_LITTER_STR_BE" level="10"/>
+    <field field_ref="CN_LONGTERM_LITTER_MET_AB" level="10"/>
+    <field field_ref="CN_LONGTERM_LITTER_MET_BE" level="10"/>
+    <field field_ref="CN_LONGTERM_LITTER_WOD_AB" level="10"/>
+    <field field_ref="CN_LONGTERM_LITTER_WOD_BE" level="10"/>
+
+  </file>
+
+  <!-- Stomate file 2 -->
+  <file id="stomate2" name="stomate_ipcc_history" output_level="1" output_freq="_AUTO_" enabled=".FALSE.">
+    <!-- level 1 -->
+    <field field_ref="RESOLUTION_X" level="1"/>
+    <field field_ref="RESOLUTION_Y" level="1"/>
+    <field field_ref="CONTFRAC_STOMATE" level="1"/>
+    <field field_ref="Areas" level="1"/>
+    <field field_ref="cVeg" level="1"/>
+    <field field_ref="cLitter" level="1"/>
+    <field field_ref="cSoil" level="1"/>
+    <field field_ref="cProduct" level="1"/>
+    <field field_ref="cMassVariation" level="1"/>
+    <field field_ref="lai_ipcc" level="1"/>
+    <field field_ref="gpp_ipcc" level="1"/>
+    <field field_ref="ra" level="1"/>
+    <field field_ref="npp_ipcc" level="1"/>
+    <field field_ref="rh" level="1"/>
+    <field field_ref="fFire" level="1"/>
+    <field field_ref="fHarvest" level="1"/>
+    <field field_ref="fLuc" level="1"/>
+    <field field_ref="nbp" level="1"/>
+    <field field_ref="fVegLitter" level="1"/>
+    <field field_ref="fLitterSoil" level="1"/>
+    <field field_ref="cLeaf" level="1"/>
+    <field field_ref="cWood" level="1"/>
+    <field field_ref="cRoot" level="1"/>
+    <field field_ref="cMisc" level="1"/>
+    <field field_ref="cLitterAbove" level="1"/>
+    <field field_ref="cLitterBelow" level="1"/>
+    <field field_ref="cSoilFast" level="1"/>
+    <field field_ref="cSoilMedium" level="1"/>
+    <field field_ref="cSoilSlow" level="1"/>
+    <field field_ref="landCoverFrac" level="1"/>
+    <field field_ref="treeFracPrimDec" level="1"/>
+    <field field_ref="treeFracPrimEver" level="1"/>
+    <field field_ref="c3PftFrac" level="1"/>
+    <field field_ref="c4PftFrac" level="1"/>
+    <field field_ref="rGrowth" level="1"/>
+    <field field_ref="rMaint" level="1"/>
+    <field field_ref="nppLeaf" level="1"/>
+    <field field_ref="nppWood" level="1"/>
+    <field field_ref="nppRoot" level="1"/>
+    <field field_ref="nep" level="1"/>
+  </file>
+  
+  <!-- stomate file 3 -->  
+  <!-- This files contains all variables having more than one vertical axis -->
+  <file id="stomate3" name="stomate_history_4dim" output_level="1" output_freq="_AUTO_" enabled=".FALSE.">
+    <!-- level 1 -->
+    <field field_ref="LAI_PER_LEVEL" level="1"/>
+    <field field_ref="LIGHT_TRAN_TO_LEVEL" level="1"/>
+    <field field_ref="CLEVEL_HEIGHT" level="1"/>
+    <field field_ref="CCBA" level="1"/>
+    <field field_ref="CCDELTABA" level="1"/>
+    <field field_ref="CCN" level="1"/>
+    <field field_ref="CCTRW" level="1"/>
+    <field field_ref="CCH" level="1"/>
+  </file>
+</file_definition>
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/iodef.xml
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/iodef.xml	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/iodef.xml	(revision 6412)
@@ -0,0 +1,32 @@
+<?xml version="1.0"?>
+<!-- =========================================================================================================== -->
+<!-- iodef.xml : Main configuration file for production of output files using XIOS                               -->
+<!--             A seperatate file context_orchidee.xml contains all specifications for ORCHIDEE                 -->
+<!--                                                                                                             -->
+<!-- $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/trunk/ORCHIDEE/src_xml/iodef.xml $                      -->
+<!-- $Date: 2017-02-13 18:55:04 +0100 (lun. 13 fÃ©vr. 2017) $                                                     -->
+<!-- $Revision: 4094 $                                                                                           -->
+<!-- =========================================================================================================== -->
+
+<simulation>
+
+  <!-- =========================================================================================================== -->
+  <!-- XIOS context                                                                                                -->
+  <!-- =========================================================================================================== -->
+  <context id="xios">
+    <variable_definition>
+	  <variable id="info_level"                type="int">1</variable>
+	  <variable id="using_server"              type="bool">false</variable>
+	  <variable id="using_oasis"               type="bool">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >LMDZ,oceanx</variable>
+      </variable_definition>
+
+  </context>
+
+  <!-- =========================================================================================================== -->
+  <!-- ORCHIDEE context                                                                                            -->
+  <!-- The file context_orchidee.xml is included here. This file needs to exist during run time.                   -->
+  <!-- =========================================================================================================== -->
+  <context id="orchidee" src="./context_orchidee.xml"/>
+
+</simulation>
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/iodef_xios1.xml
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/iodef_xios1.xml	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/iodef_xios1.xml	(revision 6412)
@@ -0,0 +1,30 @@
+<?xml version="1.0"?>
+<!-- =========================================================================================================== -->
+<!-- iodef.xml : Main configuration file for production of output files using XIOS                               -->
+<!--             A seperatate file context_orchidee.xml contains all specifications for ORCHIDEE                 -->
+<!-- =========================================================================================================== -->
+
+<simulation>
+
+  <!-- =========================================================================================================== -->
+  <!-- XIOS context                                                                                                -->
+  <!-- =========================================================================================================== -->
+  <context id="xios">
+    <variable_definition>
+	  <variable id="buffer_size"               type="integer">10000000</variable>
+	  <variable id="buffer_server_factor_size" type="integer">2</variable>
+	  <variable id="info_level"                type="integer">1</variable>
+	  <variable id="using_server"              type="boolean">false</variable>
+	  <variable id="using_oasis"               type="boolean">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >LMDZ,oceanx</variable>
+      </variable_definition>
+
+  </context>
+
+  <!-- =========================================================================================================== -->
+  <!-- ORCHIDEE context                                                                                            -->
+  <!-- The file context_orchidee.xml is included here. This file needs to exist during run time.                   -->
+  <!-- =========================================================================================================== -->
+  <context id="orchidee" src="./context_orchidee.xml"/>
+
+</simulation>
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/iodef_xios2.xml
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/iodef_xios2.xml	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/src_xml/iodef_xios2.xml	(revision 6412)
@@ -0,0 +1,28 @@
+<?xml version="1.0"?>
+<!-- =========================================================================================================== -->
+<!-- iodef.xml : Main configuration file for production of output files using XIOS                               -->
+<!--             A seperatate file context_orchidee.xml contains all specifications for ORCHIDEE                 -->
+<!-- =========================================================================================================== -->
+
+<simulation>
+
+  <!-- =========================================================================================================== -->
+  <!-- XIOS context                                                                                                -->
+  <!-- =========================================================================================================== -->
+  <context id="xios">
+    <variable_definition>
+	  <variable id="info_level"                type="int">1</variable>
+	  <variable id="using_server"              type="bool">false</variable>
+	  <variable id="using_oasis"               type="bool">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >LMDZ,oceanx</variable>
+      </variable_definition>
+
+  </context>
+
+  <!-- =========================================================================================================== -->
+  <!-- ORCHIDEE context                                                                                            -->
+  <!-- The file context_orchidee.xml is included here. This file needs to exist during run time.                   -->
+  <!-- =========================================================================================================== -->
+  <context id="orchidee" src="./context_orchidee.xml"/>
+
+</simulation>
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/COPYRIGHT.txt
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/COPYRIGHT.txt	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/COPYRIGHT.txt	(revision 6412)
@@ -0,0 +1,109 @@
+!------------------------------------------------------------------------------!
+!              Flexible Configuration Management Software License              !
+!                                                                              !
+!     Please read this Software Licence as you will be bound by its terms      !
+!                           if you use the Software                            !
+!------------------------------------------------------------------------------!
+
+The Licensor:
+-------------
+
+The Met Office of FitzRoy Road, Exeter EX1 3PB, United Kingdom
+--------------------------------------------------------------------------------
+
+1. Licence.
+-----------
+
+The Met Office grants you a non-exclusive, royalty free; world-wide,
+transferable Licence to use, modify, copy and distribute the Flexible
+Configuration Management software ("the software") accompanying this License
+providing:
+
+a. you undertake to provide to the Met Office a copy of any modifications made
+   by you on the same terms contained within this licence agreement;
+
+b. modified files carry prominent notices stating that you changed the files
+   and the date of change;
+
+c. distribution of original or modified files is made free of charge under the
+   terms of this Licence;
+
+d. the appropriate copyright notices, the above copyright notice and a
+   disclaimer of warranty is included with the distribution.
+
+2. Ownership.
+-------------
+
+The Flexible Configuration Management software is Crown copyright and is
+reproduced with the permission of Met Office under delegated authority from
+the Controller of HMSO. The software and documentation are provided to you to
+allow you to exercise your rights under this License, which is granted to you.
+
+3. Duration.
+------------
+
+This license will remain in effect until terminated.
+ 
+4. Termination.
+---------------
+
+You may terminate this license at any time by removing all copies of the
+software from your system.  This License will terminate immediately without
+notice from us if you fail to comply with any of the provisions of this
+License or in the event of your breaching the terms of this licence you are
+given notice that the license has been terminated.  Upon termination you will
+delete all copies of the software and any related documentation.
+
+5. Disclaimer of Warranty.
+--------------------------
+
+a. THE MET OFFICE DISCLAIMS ALL WARRANTIES, REPRESENTATIONS AND PROMISES,
+   INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF SATISFACTORY QUALITY
+   AND FIT FOR THE PURPOSE.  NEITHER DOES THE MET OFFICE MAKE ANY
+   REPRESENTATIONS AS TO COMPATABILITY WITH YOUR OPERATING SYSTEMS AND
+   PLATFORMS.
+
+b. In no event does the Met Office warrant that the software or related
+   documentation will satisfy your requirements, that the software and
+   documentation will be without errors or defects or that the operation of
+   the software will be uninterrupted.
+
+c. IN NO EVENT WILL THE MET OFFICE BE LIABLE FOR ANY OTHER DAMAGES, INCLUDING
+   BUT NOT LIMITED TO DAMAGES FOR LOSS OF PROFITS DATA OR USE OF THE SOFTWARE
+   OR FOR ANY INDIRECT, INCIDENTAL OR CONSEQUENTIAL DAMAGES, EVEN IF THE MET
+   OFFICE HAS BEEN SPECIFICALLY ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+6. General Provisions.
+----------------------
+
+a. You will not do anything, relating to this software that will bring the Met
+   Office into disrepute.
+
+b. You will not use the name of the Met Office or any other contributor to
+   endorse or promote any products derived from the software without the
+   written permission of the Met Office.
+
+7. Acknowledgements.
+--------------------
+
+The Fortran 9X Interface Generator found in file
+./src/lib/Ecmwf/Fortran90_stuff.pm is adapted from a script developed at ECMWF
+and is provided by kind permission of ECMWF under the same terms of this
+Licence.
+
+8. Entire Agreement.
+--------------------
+
+This License constitutes the entire agreement between us with respect to your
+rights or warranties for using the software and related documentation.  If any
+provision of this agreement is determined to be invalid or unenforceable the
+remaining provisions shall continue in full force.
+
+9. Governing Law.
+-----------------
+
+This Agreement is governed by and construed in accordance with the Laws of
+England.
+
+--------------------------------------------------------------------------------
+                                               © British Crown copyright 2006-7.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/LICENSE.html
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/LICENSE.html	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/LICENSE.html	(revision 6412)
@@ -0,0 +1,150 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+
+<html>
+<head>
+  <title>Flexible Configuration Management Software License</title>
+  <meta name="copyright" content="&copy; British Crown Copyright">
+  <style type="text/css">
+  <!--
+  body {
+    font: normal normal 10pt Arial, sans-serif;
+  }
+
+  h1 {
+    text-align: center;
+    text-decoration: underline;
+    font: normal bold 14pt Arial, sans-serif;
+  }
+
+  h2 {
+    text-align: left;
+    text-decoration: none;
+    font: normal normal 14pt Arial, sans-serif;
+  }
+
+  h3 {
+    text-align: left;
+    text-decoration: none;
+    font: normal bold 10pt Arial, sans-serif;
+  }
+
+  .copyright {
+    text-align: right;
+    font: normal bold 11pt Arial, sans-serif;
+  }
+
+  ol li {
+    list-style: lower-alpha;
+  }
+  //-->
+  </style>
+</head>
+
+<body>
+  <h1>Flexible Configuration Management Software License</h1>
+
+  <h1>Please read this Software Licence as you will be bound by its terms if
+  you use the Software</h1>
+
+  <h2>The Licensor:</h2>
+
+  <h2>The Met Office of FitzRoy Road, Exeter EX1 3PB, United Kingdom</h2>
+
+  <h3>1. Licence.</h3>
+
+  <p>The Met Office grants you a non-exclusive, royalty free; world-wide,
+  transferable Licence to use, modify, copy and distribute the Flexible
+  Configuration Management software ("the software") accompanying this License
+  providing:</p>
+
+  <ol>
+    <li>you undertake to provide to the Met Office a copy of any modifications
+    made by you on the same terms contained within this licence agreement;</li>
+
+    <li>modified files carry prominent notices stating that you changed the
+    files and the date of change;</li>
+
+    <li>distribution of original or modified files is made free of charge under
+    the terms of this Licence;</li>
+
+    <li>the appropriate copyright notices, the above copyright notice and a
+    disclaimer of warranty is included with the distribution.</li>
+  </ol>
+
+  <h3>2. Ownership.</h3>
+
+  <p>The Flexible Configuration Management software is Crown copyright and is
+  reproduced with the permission of Met Office under delegated authority from
+  the Controller of HMSO. The software and documentation are provided to you to
+  allow you to exercise your rights under this License, which is granted to
+  you.</p>
+
+  <h3>3. Duration.</h3>
+
+  <p>This license will remain in effect until terminated.</p>
+
+  <h3>4. Termination.</h3>
+
+  <p>You may terminate this license at any time by removing all copies of the
+  software from your system. This License will terminate immediately without
+  notice from us if you fail to comply with any of the provisions of this
+  License or in the event of your breaching the terms of this licence you are
+  given notice that the license has been terminated. Upon termination you will
+  delete all copies of the software and any related documentation.</p>
+
+  <h3>5. Disclaimer of Warranty.</h3>
+
+  <ol>
+    <li>THE MET OFFICE DISCLAIMS ALL WARRANTIES, REPRESENTATIONS AND PROMISES,
+    INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF SATISFACTORY QUALITY
+    AND FIT FOR THE PURPOSE. NEITHER DOES THE MET OFFICE MAKE ANY
+    REPRESENTATIONS AS TO COMPATABILITY WITH YOUR OPERATING SYSTEMS AND
+    PLATFORMS.</li>
+
+    <li>In no event does the Met Office warrant that the software or related
+    documentation will satisfy your requirements, that the software and
+    documentation will be without errors or defects or that the operation of
+    the software will be uninterrupted.</li>
+
+    <li>IN NO EVENT WILL THE MET OFFICE BE LIABLE FOR ANY OTHER DAMAGES,
+    INCLUDING BUT NOT LIMITED TO DAMAGES FOR LOSS OF PROFITS DATA OR USE OF THE
+    SOFTWARE OR FOR ANY INDIRECT, INCIDENTAL OR CONSEQUENTIAL DAMAGES, EVEN IF
+    THE MET OFFICE HAS BEEN SPECIFICALLY ADVISED OF THE POSSIBILITY OF SUCH
+    DAMAGES.</li>
+  </ol>
+
+  <h3>6. General Provisions.</h3>
+
+  <ol>
+    <li>You will not do anything, relating to this software that will bring the
+    Met Office into disrepute.</li>
+
+    <li>You will not use the name of the Met Office or any other contributor to
+    endorse or promote any products derived from the software without the
+    written permission of the Met Office.</li>
+  </ol>
+
+  <h3>7. Acknowledgements.</h3>
+
+  <p>The Fortran 9X Interface Generator found in file
+  ./src/lib/Ecmwf/Fortran90_stuff.pm is adapted from a script developed at
+  ECMWF and is provided by kind permission of ECMWF under the same terms of
+  this Licence.</p>
+
+  <h3>8. Entire Agreement.</h3>
+
+  <p>This License constitutes the entire agreement between us with respect to
+  your rights or warranties for using the software and related documentation.
+  If any provision of this agreement is determined to be invalid or
+  unenforceable the remaining provisions shall continue in full force.</p>
+
+  <h3>9. Governing Law.</h3>
+
+  <p>This Agreement is governed by and construed in accordance with the Laws of
+  England.</p>
+
+  <div class="copyright">
+    <p>&copy; British Crown copyright 2006-7.</p>
+  </div>
+</body>
+</html>
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/README
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/README	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/README	(revision 6412)
@@ -0,0 +1,4 @@
+FCM release 1-2 created from revision 2131
+
+For further details please refer to the release notes
+which can be found in the directory doc/release_notes.
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm	(revision 6412)
@@ -0,0 +1,794 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm
+#
+# SYNOPSIS
+#   fcm SUBCOMMAND [OPTIONS...] ARGS...
+#
+# DESCRIPTION
+#   The fcm command is the frontend of the FCM system. The first argument to the
+#   command must be a recognised subcommand. See "fcm help" for a full list of
+#   functionalities.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas:
+use warnings;
+use strict;
+
+# Standard modules:
+use File::Basename;
+use File::Spec;
+use Getopt::Long;
+use Cwd;
+
+# FCM component modules:
+use lib File::Spec->catfile (dirname (dirname ($0)), 'lib');
+use Fcm::Config;
+use Fcm::Extract;
+use Fcm::Build;
+use Fcm::Util;
+
+BEGIN {
+  eval {
+    require Fcm::Cm;
+    import Fcm::Cm;
+
+    require Fcm::CmUrl;
+    import Fcm::CmUrl;
+  }
+}
+
+# Function declaration:
+sub cmp_ext_cfg;
+sub invoke_build_system;
+sub invoke_extract_system;
+sub invoke_cfg_printer;
+sub invoke_cm_system;
+sub invoke_www_browser;
+sub invoke_help;
+
+# ------------------------------------------------------------------------------
+
+my $prog      = basename $0;
+my $year      = (localtime)[5] + 1900;
+my $copyright = <<EOF;
+
+(C) Crown copyright $year Met Office. All rights reserved.
+EOF
+
+# List of sub-commands recognised by FCM
+my %subcommand = (
+  HLP => [qw/help ? h/],
+  BLD => [qw/build bld/],
+  EXT => [qw/extract ext/],
+  CFG => [qw/cfg/],
+  GUI => [qw/gui/],
+  CM  => [qw/
+    branch    br
+    conflicts cf
+    add
+    blame     praise annotate ann
+    cat
+    checkout  co
+    cleanup
+    commit    ci
+    copy      cp
+    delete    del    remove   rm
+    diff      di
+    export
+    import
+    info
+    list      ls
+    lock
+    log
+    merge
+    mkdir
+    mkpatch
+    move      mv     rename   ren
+    propdel   pdel   pd
+    propedit  pedit  pe
+    propget   pget   pg
+    proplist  plist  pl
+    propset   pset   ps
+    resolved
+    revert
+    status    stat   st
+    switch    sw
+    unlock
+    update    up
+  /],
+  CMP => [qw/cmp-ext-cfg/],
+  WWW => [qw/www trac/],
+);
+
+# Get configuration settings
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+# Determine the functionality of this invocation of the command
+my $function = @ARGV ? shift @ARGV : '';
+
+# Run command accordingly
+if (grep {$_ eq $function} @{ $subcommand{BLD} }) {
+  invoke_build_system;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{EXT} }) {
+  invoke_extract_system;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{CFG} }) {
+  invoke_cfg_printer;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{GUI} }) {
+  &run_command (['fcm_gui', @ARGV], METHOD => 'exec');
+
+} elsif (grep {$_ eq $function} @{ $subcommand{CM} }) {
+  invoke_cm_system;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{CMP} }) {
+  cmp_ext_cfg;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{WWW} }) {
+  invoke_www_browser;
+
+} elsif ($function =~ /^\s*$/ or grep {$_ eq $function} @{ $subcommand{HLP} }) {
+  invoke_help;
+
+} else {
+  w_report 'Unknown command: ', $function;
+  e_report 'Type "', $prog, ' help" for usage';
+}
+
+exit;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfg = &main::cfg ();
+#
+# DESCRIPTION
+#   Return the $config variable.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  return $config;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &cmp_ext_cfg ();
+#
+# DESCRIPTION
+#   Compare two similar extract configuration files.
+# ------------------------------------------------------------------------------
+
+sub cmp_ext_cfg {
+  # Check options
+  # ----------------------------------------------------------------------------
+  my ($wiki, $verbose);
+
+  GetOptions ('wiki|w=s' => \$wiki, 'verbose|v' => \$verbose);
+
+  # Check arguments
+  # ----------------------------------------------------------------------------
+  e_report $prog, ' ', $function,
+           ': 2 extract config files must be specified, abort.'
+    if @ARGV < 2;
+
+  # Invoke 2 new instances of the Fcm::Extract class
+  # ----------------------------------------------------------------------------
+  my (@cfg, $rc);
+  for my $i (0 .. 1) {
+    $cfg[$i] = Fcm::Extract->new (CFG_SRC => $ARGV[$i]);
+
+    # Read the extract configuration file
+    $rc = $cfg[$i]->decipher_cfg;
+    $rc = $cfg[$i]->expand_cfg if $rc;
+
+    last if not $rc;
+  }
+
+  # Throw error if command has failed
+  # ----------------------------------------------------------------------------
+  e_report $prog, ' ', $function,
+           ': cannot read extract configuration file, abort' if not $rc;
+
+  # Get list of URLs
+  # ----------------------------------------------------------------------------
+  my @urls = ();
+  for my $i (0 .. 1) {
+    # List of branches in each extract configuration file
+    my @branches = $cfg[$i]->branches;
+
+    for my $branch (@branches) {
+      # Ignore declarations of local directories
+      next if $branch->type eq 'user';
+
+      # List of SRC declarations in each branch
+      my %dirs = $branch->dirs;
+
+      for my $dir (values %dirs) {
+        # Set up a new instance of Fcm::CmUrl object for each SRC declaration
+        my $cm_url = Fcm::CmUrl->new (
+          URL => $dir . ($branch->version ? '@' . $branch->version : ''),
+        );
+
+        $urls[$i]{$cm_url->branch_url}{$dir} = $cm_url;
+      }
+    }
+  }
+
+  # Compare
+  # ----------------------------------------------------------------------------
+  my %log;
+  for my $i (0 .. 1) {
+    # Compare the first file with the second one and then vice versa
+    my $j = ($i == 0) ? 1 : 0;
+
+    for my $branch (sort keys %{ $urls[$i] }) {
+      if (exists $urls[$j]{$branch}) {
+        # Same REPOS declarations in both files
+        for my $dir (sort keys %{ $urls[$i]{$branch} }) {
+          if (exists $urls[$j]{$branch}{$dir}) {
+            # Same SRC declarations in both files, only need to compare once
+            next if $i == 1;
+
+            my $this_url = $urls[$i]{$branch}{$dir};
+            my $that_url = $urls[$j]{$branch}{$dir};
+
+            # Check whether their last changed revisions are the same
+            my $this_rev = $this_url->svninfo (FLAG => 'Last Changed Rev');
+            my $that_rev = $that_url->svninfo (FLAG => 'Last Changed Rev');
+
+            # Make sure last changed revisions differ
+            next if $this_rev eq $that_rev;
+
+            # Not interested in the log before the minimum revision
+            my $min_rev = ($this_url->pegrev > $that_url->pegrev)
+                          ? $that_url->pegrev : $this_url->pegrev;
+
+            $this_rev = $min_rev if $this_rev < $min_rev;
+            $that_rev = $min_rev if $that_rev < $min_rev;
+
+            # Get list of changed revisions using the commit log
+            my $u   = ($this_rev > $that_rev) ? $this_url : $that_url;
+            my %revs = $u->svnlog (REV => [$this_rev, $that_rev]);
+
+            for my $rev (keys %revs) {
+              # Check if revision is already in the list
+              next if exists $log{$branch}{$rev};
+
+              # Not interested in the minimum revision
+              next if $rev == $min_rev;
+
+              # Get list of changed paths. Accept this revision only if it
+              # contains changes in the current branch
+              my %paths  = %{ $revs{$rev}{paths} };
+
+              for my $path (keys %paths) {
+                my $change_url = Fcm::CmUrl->new (URL => $u->root . $path);
+
+                if ($change_url->branch eq $u->branch) {
+                  $log{$branch}{$rev} = $u;
+                  last;
+                }
+              }
+            }
+
+          } else {
+            # Report SRC declaration in one file but not in another
+            print $urls[$i]{$branch}{$dir}->url_peg, ':', "\n";
+            print '  in    : ', $ARGV[$i], "\n";
+            print '  not in: ', $ARGV[$j], "\n\n";
+          }
+        }
+
+      } else {
+        # Report REPOS declaration in one file but not in another
+        print $branch, ':', "\n";
+        print '  in    : ', $ARGV[$i], "\n";
+        print '  not in: ', $ARGV[$j], "\n\n";
+      }
+    }
+  }
+
+  # Report modifications
+  # ----------------------------------------------------------------------------
+  print 'Revisions at which declared source directories are modified:', "\n\n"
+    if keys %log;
+
+  if (defined $wiki) {
+    # Output in wiki format
+    my $wiki_url  = Fcm::CmUrl->new (URL => &expand_url_keyword (URL => $wiki));
+    my $base_trac = $wiki
+                    ? &get_browser_url (URL => $wiki_url->project_url)
+                    : $wiki_url;
+    $base_trac    = $wiki_url if not $base_trac;
+
+    for my $branch (sort keys %log) {
+      # Name of the branch
+      my $branch_trac = &get_browser_url (URL => $branch);
+      $branch_trac =~ s#^$base_trac(?:/*|$)#source:#;
+
+      print '[', $branch_trac, ']:', "\n";
+
+      # Revision table
+      for my $rev (sort {$b <=> $a} keys %{ $log{$branch} }) {
+        print $log{$branch}{$rev}->display_svnlog ($rev, $base_trac), "\n";
+      }
+
+      print "\n";
+    }
+
+  } else {
+    my $separator = '-' x 80 . "\n";
+
+    for my $branch (sort keys %log) {
+      # Output in plain text format
+      print $branch, ':', "\n";
+
+      if ($verbose or &cfg->verbose > 1) {
+        # Verbose mode, print revision log
+        for my $rev (sort {$b <=> $a} keys %{ $log{$branch} }) {
+          print $separator, $log{$branch}{$rev}->display_svnlog ($rev), "\n";
+        }
+
+      } else {
+        # Normal mode, print list of revisions
+        print join (' ', sort {$b <=> $a} keys %{ $log{$branch} }), "\n";
+      }
+
+      print $separator, "\n";
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_build_system ();
+#
+# DESCRIPTION
+#   Invoke the build system.
+# ------------------------------------------------------------------------------
+
+sub invoke_build_system {
+  my ($archive, $full, $ignore_lock, $jobs, $stage, @targets, $verbose);
+
+  GetOptions (
+    'archive|a'   => \$archive,     # switch on archive mode?
+    'full|f'      => \$full,        # full build?
+    'ignore-lock' => \$ignore_lock, # ignore lock file?
+    'jobs|j=i'    => \$jobs,        # number of parallel jobs in make
+    'stage|s=s'   => \$stage,       # build up to and including this stage
+    'targets|t=s' => \@targets,     # make targets
+    'verbose|v=i' => \$verbose,     # verbose level
+  );
+
+  # Verbose level
+  $config->verbose ($verbose) if defined $verbose;
+
+  # Invoke a new instance of the Fcm::Build class
+  my $bld = Fcm::Build->new (CFG_SRC  => @ARGV ? join (' ', @ARGV) : cwd ());
+
+  # Perform build
+  $bld->build (
+    ARCHIVE     => $archive,
+    FULL        => $full,
+    IGNORE_LOCK => $ignore_lock,
+    JOBS        => $jobs ? $jobs : 1,
+    STAGE       => $stage ? $stage : 5,
+    TARGETS     => (@targets ? [split (/:/, join (':', @targets))] : [qw/all/]),
+  );
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_extract_system ();
+#
+# DESCRIPTION
+#   Invoke the extract system.
+# ------------------------------------------------------------------------------
+
+sub invoke_extract_system {
+  my ($full, $ignore_lock, $verbose);
+
+  GetOptions (
+    'full|f'      => \$full,        # full extract?
+    'ignore-lock' => \$ignore_lock, # ignore lock file?
+    'verbose|v=i' => \$verbose,     # verbose level
+  );
+
+  $config->verbose ($verbose) if defined $verbose;
+
+  # Invoke a new instance of the Fcm::Extract class
+  my $ext = Fcm::Extract->new (CFG_SRC => @ARGV ? join (' ', @ARGV) : cwd ());
+
+  # Perform extract
+  $ext->extract (FULL => $full, IGNORE_LOCK => $ignore_lock);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_cfg_printer ();
+#
+# DESCRIPTION
+#   Invoke the CFG file pretty printer.
+# ------------------------------------------------------------------------------
+
+sub invoke_cfg_printer {
+
+  use Fcm::CfgFile;
+
+  my $out_file;
+  GetOptions (
+    'output|o=s'  => \$out_file,  # output file for print
+  );
+
+  my $file = join (' ', @ARGV);
+  e_report $prog, ' ', $function, ': file not specified, abort.' if ! $file;
+
+  # Invoke a new Fcm::CfgFile instance
+  my $cfg = Fcm::CfgFile->new (SRC => $file);
+
+  # Read the cfg file
+  my $read = $cfg->read_cfg;
+  e_report if not $read;
+
+  # Pretty print CFG file
+  $cfg->print_cfg ($out_file);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_cm_system ();
+#
+# DESCRIPTION
+#   Invoke a code management system command.
+# ------------------------------------------------------------------------------
+
+sub invoke_cm_system {
+
+  &cm_command ($function);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_www_browser ();
+#
+# DESCRIPTION
+#   Invoke a web browser on the specified PATH.
+# ------------------------------------------------------------------------------
+
+sub invoke_www_browser {
+
+  # Options
+  my ($browser);
+  GetOptions (
+    'browser|b=s' => \$browser, # browser command
+  );
+
+  $browser = &cfg->setting (qw/MISC WEB_BROWSER/) unless $browser;
+
+  # Arguments
+  my ($arg) = @ARGV ? $ARGV[0] : (&is_wc () ? '.' : '');
+  e_report $prog, ' ', $function,
+           ': input URL not specified and . not a working copy, abort.'
+    if not $arg;
+
+  # Local PATH?
+  $arg = &expand_tilde ($arg);
+  $arg = &get_url_of_wc ($arg) if -e $arg;
+
+  # Expand URL and revision keywords
+  my $www_url = &expand_url_keyword (URL => $arg);
+  my $rev     = 'HEAD';
+
+  if ($www_url =~ m#^(\w+://\S+)@(\S+)$#) {
+    $www_url = $1;
+    $rev     = $2;
+  }
+
+  $rev = &expand_rev_keyword (URL => $www_url, REV => $rev, HEAD => 1)
+    unless uc ($rev) eq 'HEAD';
+
+  # Get web browser URL
+  $www_url = &get_browser_url (URL => $www_url);
+  die 'WWW URL not defined for "', $arg, '", abort' unless $www_url;
+
+  $www_url = $www_url . '?rev=' . $rev;
+
+  # Execute command
+  my @command = (split (/\s+/, $browser), $www_url);
+  &run_command (\@command, METHOD => 'exec', PRINT => 1);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_help ();
+#
+# DESCRIPTION
+#   Invoke help.
+# ------------------------------------------------------------------------------
+
+sub invoke_help {
+
+  my $cmd = @ARGV ? shift @ARGV : undef;
+
+  if ($cmd) {
+    if (grep {$_ eq $cmd} @{ $subcommand{BLD} }) {
+      print <<EOF;
+$prog $cmd: invoke the build system.
+usage: $prog $cmd [OPTIONS...] [CFGFILE]
+
+  The path to a CFG file may be provided. Otherwise, the build system
+  searches the default locations for a bld cfg file.
+
+  If no option is specified, the options "-s 5 -t all -j 1 -v 1" are assumed.
+
+  If the option for full build is specified, the sub-directories created by
+  previous builds will be removed, so that the current build can start cleanly.
+
+  The -s option can be used to limit the actions performed by the build system
+  up to a named stage. The stages are:
+    "1", "s" or "setup"                - stage 1, setup
+    "2", "pp" or "pre_process"         - stage 2, pre-process
+    "3", "gd" or "generate_dependency" - stage 3, generate dependency
+    "4", "gi" or "generate_interface"  - stage 4, generate Fortran 9X interface
+    "5", "m", "make"                   - stage 5, make
+
+  If a colon separated list of targets is specified using the -t option, the
+  default targets specified in the configuration file will not be used.
+
+  If archive mode is switched on, build sub-directories that are only used
+  in the build process will be archived to TAR files. The default is off.
+
+  If specified, the verbose level must be an integer greater than 0. Verbose
+  level 0 is the quiet mode. Increasing the verbose level will increase the
+  amount of diagnostic output.
+
+  When a build is invoked, it sets up a lock file in the build root directory.
+  The lock is normally removed at the end of the build. While the lock file is
+  in place, othe build commands invoked in the same root directory will fail.
+  If you need to bypass this check for whatever reason, you can invoke the
+  build system with the --ignore-lock option.
+
+Valid options:
+  -a [--archive]     : archive build sub-directories?
+  -f [--full]        : full build
+  --ignore-lock      : ignore lock files in build root directory
+  -j [--jobs] arg    : number of parallel jobs that "make" can handle
+  -s [--stage] arg   : perform build up to a named stage
+  -t [--targets] arg : build a colon (:) separated list of targets
+  -v [--verbose] arg : verbose level
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{EXT} }) {
+      print <<EOF;
+$prog $cmd: invoke the extract system.
+usage: $prog $cmd [OPTIONS...] [CFGFILE]
+
+  The path to a CFG file may be provided. Otherwise, the extract system
+  searches the default locations for an ext cfg file.
+
+  If no option is specified, the system will attempt an incremental extract
+  where appropriate.
+
+  If specified, the verbose level must be an integer greater than 0. Verbose
+  level 0 is the quiet mode. Increasing the verbose level will increase the
+  amount of diagnostic output.
+
+  When an extract is invoked, it sets up a lock file in the extract destination
+  root directory. The lock is normally removed at the end of the extract. While
+  the lock file is in place, othe extract commands invoked in the same
+  destination root directory will fail. If you need to bypass this check for
+  whatever reason, you can invoke the extract system with the --ignore-lock
+  option.
+
+Valid options:
+  -f [--full]        : perform a full/clean extract
+  --ignore-lock      : ignore lock files in build root directory
+  -v [--verbose] arg : verbose level
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{CFG} }) {
+      print <<EOF;
+$prog $cmd: invoke the CFG file pretty printer.
+usage: $prog $cmd [OPTIONS...] FILE
+
+  If no option is specified, the output will be sent to standard output.
+
+Valid options:
+  -o [--output] arg : send output to a file as specified by arg.
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{GUI} }) {
+      print <<EOF;
+$prog $cmd: invoke the GUI wrapper for CM commands.
+usage: $prog $cmd DIR
+
+  The optional argument DIR modifies the initial working directory.
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{CM} }) {
+      @ARGV = qw(--help);
+      cm_command ($cmd);
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{CMP} }) {
+      print <<EOF;
+$prog $cmd: compare two similar extract configuration files.
+usage: $prog $cmd [OPTIONS...] CFG1 CFG2
+
+  Compares the extract configurations of two similar extract configuration
+  files CFG1 and CFG2.
+
+Valid options:
+  -v [--verbose]  : print revision tables in verbose mode. In particular,
+                    display the change log of each revision.
+  -w [--wiki] arg : print revision tables in wiki format. The argument to this
+                    option must be the Subversion URL or FCM URL keyword of a
+                    FCM project associated with the intended Trac system. This
+                    option overrides the -v option.
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{WWW} }) {
+      print <<EOF;
+$prog $cmd: invoke the web repository browser on a Subversion URL.
+usage: $prog $cmd [OPTIONS...] [PATH]
+
+  If PATH is specified, it must be a FCM URL keyword, a Subversion URL or the
+  PATH to a local working copy. If not specified, the current working directory
+  is assumed to be a working copy. If the --browser option is specified, the
+  specified web browser command is used to launch the repository browser.
+  Otherwise, it attempts to use the default browser from the configuration
+  setting.
+
+Valid options:
+  -b [--browser] arg : specify a command arg for the web browser.
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{HLP} }) {
+      print <<EOF;
+help (?, h): Describe the usage of $prog or its subcommands.
+usage: $prog help [SUBCOMMAND...]
+$copyright
+EOF
+
+      &run_command ([qw/svn help/, $cmd, @ARGV], PRINT => 1);
+
+    } else {
+      warn $prog, ' help: "', $cmd, '" not recognised';
+      $cmd = undef;
+    }
+  }
+
+  if (not $cmd) {
+    # Get output from "svn help"
+    my @lines = &run_command (
+      [qw/svn help/], DEVNULL => 1, METHOD => 'qx', ERROR => 'ignore',
+    );
+
+    # Get release number, (and revision number from revision number file)
+    my $release  = &cfg->setting ('RELEASE');
+    my $rev_file = &cfg->setting ('REV_FILE');
+
+    if (-r $rev_file) {
+      open FILE, '<', $rev_file;
+      my $rev = readline 'FILE';
+      close FILE;
+
+      chomp $rev;
+      $release .= '-dev (r' . $rev . ')' if $rev;
+    }
+
+    # Print common help
+    print <<EOF;
+usage: $prog <subcommand> [options] [args]
+Flexible configuration management system, release $release.
+Type "$prog help <subcommand>" for help on a specific subcommand.
+
+Available subcommands:
+  help       (h, ?) - help
+  build      (bld)  - build system
+EOF
+
+    # The following are only available on platforms with "svn" installed
+    if (@lines) {
+      print <<EOF;
+  branch     (br)   - cm system: branch info & creation
+  cfg               - CFG file pretty printer
+  cmp-ext-cfg       - compare two similar extract configuration files
+  conflicts  (cf)   - cm system: resolve conflicts
+  extract    (ext)  - extract system
+  mkpatch           - create patches from specified revisions of a URL
+  trac       (www)  - cm system: browse a path using the web browser
+  <SVN COMMANDS>    - any Subversion sub-commands
+EOF
+    }
+
+    # Print FCM copyright notice
+    print $copyright;
+
+    # Print output from "svn help"
+    if (@lines) {
+      print "\n";
+      &print_command ([qw/svn help/]);
+      print @lines;
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ans = &main::get_input (MESSAGE => $mesg, TYPE => $type, DEFAULT => $def);
+#
+# DESCRIPTION
+#   Get an input string from the user and return it as $ans. MESSAGE is the
+#   main message printed on screen to prompt the user for an input.  If TYPE is
+#   'YN', print message to prompt user to enter either 'y' or 'n'. If TYPE is
+#   'YNA', then 'a' is given as a third option. If DEFAULT is set, print message
+#   to inform user that the return value will be set to the $def (if nothing is
+#   entered).
+# ------------------------------------------------------------------------------
+
+sub get_input {
+  my %args = @_;
+  my $type  = exists $args{TYPE}    ? $args{TYPE}    : '';
+  my $mesg  = exists $args{MESSAGE} ? $args{MESSAGE} : '';
+  my $def   = exists $args{DEFAULT} ? $args{DEFAULT} : '';
+
+  my $ans;
+
+  while (1) {
+    # Print the prompt
+    print $mesg;
+    print "\n", 'Enter "y" or "n"' if uc ($type) eq 'YN';
+    print "\n", 'Enter "y", "n" or "a"' if uc ($type) eq 'YNA';
+    print ' (or just press <return> for "', $def, '")' if $def;
+    print ': ';
+
+    # Get answer from STDIN
+    $ans = <STDIN>;
+    chomp $ans;
+
+    # Set answer to default, if necessary
+    $ans = $def if ($def and not $ans);
+
+    if ($type =~ /^yna?$/i) {
+      # For YN and YNA type dialog boxes,
+      # check that the answer is in the correct form
+      my $pat = (uc ($type) eq 'YN' ? 'y|n' : 'y|n|a');
+      last if $ans =~ /^(?:$pat)/i;
+
+    } else {
+      last;
+    }
+  }
+
+  return $ans;
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_graphic_diff
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_graphic_diff	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_graphic_diff	(revision 6412)
@@ -0,0 +1,90 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_graphic_diff
+#
+# SYNOPSIS
+#   fcm_graphic_diff [-u] [-L OLD_DESC] [-L NEW_DESC] OLD NEW
+#
+# DESCRIPTION
+#   Wrapper script which invokes a graphical diff tool. Its interface is
+#   compatible with the "svn diff" command and can be used in combination with
+#   its "--diff-cmd" option. The command prints the OLD_DESC and NEW_DESC if
+#   they are both set. The two arguments OLD and NEW must be set and are the
+#   files to compare. The graphical diff tool invoked depends on the value of
+#   the FCM_GRAPHIC_DIFF environment variable. The command exits if the
+#   environment variable is not set.
+#
+# COPYRIGHT
+#   This program is part of the FCM system.
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas:
+use warnings;
+use strict;
+
+use Getopt::Long;
+
+# ------------------------------------------------------------------------------
+
+my ($u, @label);
+GetOptions ('u' => \$u, 'L=s' => \@label);
+
+# Check existence of files
+for my $i (0 .. 1) {
+  die $ARGV[$i], ': not found, abort' unless $ARGV[$i] and -f $ARGV[$i];
+}
+
+my ($old, $new) = @ARGV;
+
+if ($old =~ m#.svn/empty-file$#) {
+  print 'Skipping new file', "\n\n";
+
+} elsif ($new =~ m#.svn/empty-file$#) {
+  print 'Skipping deleted file', "\n\n";
+
+} elsif (-z $old) {
+  print 'Skipping as old file is empty (or does not exist)', "\n\n";
+
+} elsif (-z $new) {
+  print 'Skipping as new file is empty (or deleted)', "\n\n";
+
+} elsif (-B $new) {
+  print 'Skipping binary file', "\n\n";
+
+} else {
+  # Print descriptions of files
+  if (@label >= 2) {
+    print '--- ', $label[0], "\n", '+++ ', $label[1], "\n\n";
+  }
+
+  # FCM_GRAPHIC_DIFF is the graphical diff tool command
+  my $cmd = (exists $ENV{FCM_GRAPHIC_DIFF} ? $ENV{FCM_GRAPHIC_DIFF} : 'xxdiff');
+
+  if ($cmd) {
+    my @options = ();
+
+    # Set options for labels if appropriate
+    if (@label >= 2) {
+      if ($cmd eq 'tkdiff') {
+        # Use tkdiff
+        @options = ('-L', $label[0], '-L', $label[1]);
+
+      } elsif ($cmd eq 'xxdiff') {
+        # Use xxdiff
+        @options = ('--title1', $label[0], '--title2', $label[1]);
+      }
+    }
+
+    # Execute the command
+    my @command = ($cmd, @options, $old, $new);
+    exec (@command) or die 'Cannot execute: ', join (' ', @command);
+  }
+
+  exit;
+}
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_gui
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_gui	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_gui	(revision 6412)
@@ -0,0 +1,1321 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_gui
+#
+# SYNOPSIS
+#   fcm_gui [DIR]
+#
+# DESCRIPTION
+#   The fcm_gui command is a simple graphical user interface for some of the
+#   commands of the FCM system. The optional argument DIR modifies the initial
+#   working directory.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas
+use warnings;
+use strict;
+
+# Standard modules
+use File::Basename;
+use File::Spec::Functions;
+use Cwd;
+use Tk;
+use Tk::ROText;
+
+# FCM component modules:
+use lib catfile (dirname (dirname ($0)), 'lib');
+use Fcm::Config;
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+
+# Argument
+if (@ARGV) {
+  my $dir = shift @ARGV;
+  chdir $dir if -d $dir;
+}
+
+# Get configuration settings
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+# ------------------------------------------------------------------------------
+
+# FCM subcommands
+my @subcmds = qw/CHECKOUT BRANCH STATUS DIFF ADD DELETE MERGE CONFLICTS COMMIT
+                 UPDATE SWITCH/;
+
+# Subcommands allowed when CWD is not a WC
+my @nwc_subcmds = qw/CHECKOUT BRANCH/;
+
+# Subcommands allowed, when CWD is a WC
+my @wc_subcmds = qw/STATUS BRANCH DIFF ADD DELETE MERGE CONFLICTS COMMIT UPDATE
+                    SWITCH/;
+
+# Subcommands that apply to WC only
+my @wco_subcmds = qw/BRANCH STATUS DIFF ADD DELETE MERGE CONFLICTS COMMIT UPDATE
+                     SWITCH/;
+
+# Subcommands that apply to top level WC only
+my @wcto_subcmds = qw/BRANCH MERGE COMMIT UPDATE SWITCH/;
+
+# Selected subcommand
+my $selsubcmd = '';
+
+# Selected subcommand is running?
+my $cmdrunning = 0;
+
+# PID of running subcommand
+my $cmdpid = undef;
+
+# List of subcommand frames
+my %subcmd_f;
+
+# List of subcommand buttons
+my %subcmd_b;
+
+# List of subcommand button help strings
+my %subcmd_help = (
+  BRANCH    => 'list information about, create or delete a branch.',
+  CHECKOUT  => 'check out a working copy from a repository.',
+  STATUS    => 'print the status of working copy files and directories.',
+  DIFF      => 'display the differences in modified files.',
+  ADD       => 'put files and directories under version control.',
+  DELETE    => 'remove files and directories from version control.',
+  MERGE     => 'merge changes into your working copy.',
+  CONFLICTS => 'use "xxdiff" to resolve any conflicts within your working copy.',
+  COMMIT    => 'send changes from your working copy to the repository.',
+  UPDATE    => 'bring changes from the repository into your working copy.',
+  SWITCH    => 'update your working copy to a different URL.',
+);
+
+for (keys %subcmd_help) {
+  $subcmd_help{$_} = 'Select the "' . lc ($_) . '" sub-command - ' .
+                     $subcmd_help{$_};
+}
+
+# List of subcommand button bindings (key name and underline position)
+my %subcmd_bind = (
+  BRANCH    => {KEY => '<Alt-Key-b>', U => 0},
+  CHECKOUT  => {KEY => '<Alt-Key-o>', U => 5},
+  STATUS    => {KEY => '<Alt-Key-s>', U => 0},
+  DIFF      => {KEY => '<Alt-Key-d>', U => 0},
+  ADD       => {KEY => '<Alt-Key-a>', U => 0},
+  DELETE    => {KEY => '<Alt-Key-t>', U => 4},
+  MERGE     => {KEY => '<Alt-Key-m>', U => 0},
+  CONFLICTS => {KEY => '<Alt-Key-f>', U => 3},
+  COMMIT    => {KEY => '<Alt-Key-c>', U => 0},
+  UPDATE    => {KEY => '<Alt-Key-u>', U => 0},
+  SWITCH    => {KEY => '<Alt-Key-w>', U => 1},
+);
+
+# List of subcommand variables
+my %subcmdvar = (
+  CWD       => cwd (),
+  WCT       => '',
+  CWD_URL   => '',
+  WCT_URL   => '',
+
+  BRANCH    => {
+    OPT     => 'info',
+    URL     => '',
+    NAME    => '',
+    TYPE    => 'DEV',
+    REVFLAG => 'NORMAL',
+    REV     => '',
+    TICKET  => '',
+    SRCTYPE => 'trunk',
+    S_CHD   => 0,
+    S_SIB   => 0,
+    S_OTH   => 0,
+    VERBOSE => 0,
+    OTHER   => '',
+  },
+
+  CHECKOUT  => {
+    URL     => '',
+    REV     => 'HEAD',
+    PATH    => '',
+    OTHER   => '',
+  },
+
+  STATUS    => {
+    USEWCT  => 0,
+    UPDATE  => 0,
+    VERBOSE => 0,
+    OTHER   => '',
+  },
+
+  DIFF      => {
+    USEWCT  => 0,
+    GRAPHIC => 1,
+    BRANCH  => 0,
+    URL     => '',
+    OTHER   => '',
+  },
+
+  ADD       => {
+    USEWCT  => 0,
+    CHECK   => 1,
+    OTHER   => '',
+  },
+
+  DELETE    => {
+    USEWCT  => 0,
+    CHECK   => 1,
+    OTHER   => '',
+  },
+
+  MERGE     => {
+    USEWCT  => 1,
+    SRC     => '',
+    MODE    => 'automatic',
+    DRYRUN  => 0,
+    VERBOSE => 0,
+    REV     => '',
+    OTHER   => '',
+  },
+
+  CONFLICTS => {
+    USEWCT  => 0,
+    OTHER   => '',
+  },
+
+  COMMIT    => {
+    USEWCT  => 1,
+    DRYRUN  => 0,
+    OTHER   => '',
+  },
+
+  UPDATE    => {
+    USEWCT  => 1,
+    OTHER   => '',
+  },
+
+  SWITCH    => {
+    USEWCT  => 1,
+    URL     => '',
+    OTHER   => '',
+  },
+);
+
+# List of action buttons
+my %action_b;
+
+# List of action button help strings
+my %action_help = (
+  QUIT  => 'Quit fcm gui',
+  HELP  => 'Print help to the output text box for the selected sub-command',
+  CLEAR => 'Clear the output text box',
+  RUN   => 'Run the selected sub-command',
+);
+
+# List of action button bindings
+my %action_bind = (
+  QUIT  => {KEY => '<Control-Key-q>', U => undef},
+  HELP  => {KEY => '<F1>'           , U => undef},
+  CLEAR => {KEY => '<Alt-Key-l>'    , U => 1},
+  RUN   => {KEY => '<Alt-Key-r>'    , U => 0},
+);
+
+# List of branch subcommand options
+my %branch_opt = (
+  INFO   => undef,
+  CREATE => undef,
+  DELETE => undef,
+  LIST   => undef,
+);
+
+# List of branch create types
+my %branch_type = (
+  'DEV'         => undef,
+  'DEV::SHARE'  => undef,
+  'TEST'        => undef,
+  'TEST::SHARE' => undef,
+  'PKG'         => undef,
+  'PKG::SHARE'  => undef,
+  'PKG::CONFIG' => undef,
+  'PKG::REL'    => undef,
+);
+
+# List of branch create source type
+my %branch_srctype = (
+  TRUNK  => undef,
+  BRANCH => undef,
+);
+
+# List of branch create revision prefix option
+my %branch_revflag = (
+  NORMAL => undef,
+  NUMBER => undef,
+  NONE   => undef,
+);
+
+# List of branch info/delete options
+my %branch_info_opt = (
+  S_CHD   => 'Show children',
+  S_SIB   => 'Show siblings',
+  S_OTH   => 'Show other',
+  VERBOSE => 'Print extra information',
+);
+
+# Text in the status bar
+my $statustext = '';
+
+# ------------------------------------------------------------------------------
+
+my $mw = MainWindow->new ();
+
+my $mw_title = 'FCM GUI';
+$mw->title ($mw_title);
+
+# Frame containing subcommand selection buttons
+my $top_f = $mw->Frame ()->grid (
+  '-row'    => 0,
+  '-column' => 0,
+  '-sticky' => 'w',
+);
+
+# Frame containing subcommand options
+my $mid_f = $mw->Frame ()->grid (
+  '-row'    => 1,
+  '-column' => 0,
+  '-sticky' => 'ew',
+);
+
+# Frame containing action buttons
+my $bot_f = $mw->Frame ()->grid (
+  '-row'    => 2,
+  '-column' => 0,
+  '-sticky' => 'ew',
+);
+
+# Text box to display output
+my $out_t  = $mw->Scrolled ('ROText', '-scrollbars' => 'osow')->grid (
+  '-row'    => 3,
+  '-column' => 0,
+  '-sticky' => 'news',
+);
+
+# Text box - allow scroll with mouse wheel
+$out_t->bind (
+  '<4>' => sub {
+    $_[0]->yview ('scroll', -1, 'units') unless $Tk::strictMotif;
+  },
+);
+
+$out_t->bind (
+  '<5>' => sub {
+    $_[0]->yview ('scroll', +1, 'units') unless $Tk::strictMotif;
+  },
+);
+
+# Status bar
+$mw->Label (
+  '-textvariable' => \$statustext,
+  '-relief'       => 'groove',
+)->grid (
+  '-row'    => 4,
+  '-column' => 0,
+  '-sticky' => 'ews',
+);
+
+# Main window grid configure
+{
+  my ($cols, $rows) = $mw->gridSize ();
+  $mw->gridColumnconfigure ($_, '-weight' => 1) for (0 .. $cols - 1);
+  $mw->gridRowconfigure    ( 3, '-weight' => 1);
+}
+
+# Frame grid configure
+{
+  my ($cols, $rows) = $mid_f->gridSize ();
+  $bot_f->gridColumnconfigure (3, '-weight' => 1);
+}
+
+$mid_f->gridRowconfigure    (0, '-weight' => 1);
+$mid_f->gridColumnconfigure (0, '-weight' => 1);
+
+# ------------------------------------------------------------------------------
+
+# Buttons to select subcommands
+{
+  my $col = 0;
+  for my $name (@subcmds) {
+    $subcmd_b{$name} = $top_f->Button (
+      '-text'    => uc (substr ($name, 0, 1)) . lc (substr ($name, 1)),
+      '-command' => [\&button_clicked, $name],
+      '-width'   => 8,
+    )->grid (
+      '-row'    => 0,
+      '-column' => $col++,
+      '-sticky' => 'w',
+    );
+
+    $subcmd_b{$name}->bind ('<Enter>', sub {$statustext = $subcmd_help{$name}});
+    $subcmd_b{$name}->bind ('<Leave>', sub {$statustext = ''});
+
+    $subcmd_b{$name}->configure ('-underline' => $subcmd_bind{$name}{U})
+      if defined $subcmd_bind{$name}{U};
+
+    $mw->bind ($subcmd_bind{$name}{KEY}, sub {$subcmd_b{$name}->invoke});
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+# Frames to contain subcommands options
+{
+  my %row = ();
+
+  for my $name (@subcmds) {
+    $subcmd_f{$name} = $mid_f->Frame ();
+    $subcmd_f{$name}->gridColumnconfigure (1, '-weight' => 1);
+
+    $row{$name} = 0;
+
+    # Widgets common to all sub-commands
+    $subcmd_f{$name}->Label ('-text' => 'Current working directory: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Label ('-textvariable' => \($subcmdvar{CWD}))->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'w',
+    );
+  }
+
+  # Widgets common to all sub-commands that apply to working copies
+  for my $name (@wco_subcmds) {
+    my @labtxts = (
+      'Corresponding URL: ',
+      'Working copy top: ',
+      'Corresponding URL: ',
+    );
+    my @varrefs = \(
+      $subcmdvar{URL_CWD},
+      $subcmdvar{WCT},
+      $subcmdvar{URL_WCT},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Label ('-text' => $labtxts[$i])->grid (
+        '-row'    => $row{$name},
+        '-column' => 0,
+        '-sticky' => 'w',
+      );
+      $subcmd_f{$name}->Label ('-textvariable' => $varrefs[$i])->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+    }
+
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Apply sub-command to working copy top',
+      '-variable' => \($subcmdvar{$name}{USEWCT}),
+      '-state'    => (grep ({$_ eq $name} @wcto_subcmds) ? 'disabled' : 'normal'),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Branch sub-command
+  {
+    my $name = 'BRANCH';
+
+    # Radio buttons to select the sub-option of the branch sub-command
+    my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    my $col = 0;
+    for my $key (sort keys %branch_opt) {
+      my $opt = lc $key;
+
+      $branch_opt{$key} = $opt_f->Radiobutton (
+        '-text'     => $opt,
+        '-value'    => $opt,
+        '-variable' => \($subcmdvar{$name}{OPT}),
+        '-state'    => 'normal',
+      )->grid (
+        '-row'      => 0,
+        '-column'   => $col++,
+        '-sticky'   => 'w',
+      );
+    }
+
+    # Label and entry box for specifying URL
+    $subcmd_f{$name}->Label ('-text' => 'URL: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry box for specifying create branch name
+    $subcmd_f{$name}->Label (
+      '-text' => 'Branch name (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{NAME}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry box for specifying create branch source revision
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source revision (create/list only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{REV}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and radio buttons box for specifying create branch type
+    $subcmd_f{$name}->Label (
+      '-text' => 'Branch type (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_type) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{TYPE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and radio buttons box for specifying create source type
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source type (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_srctype) {
+        my $txt = lc $key;
+        my $opt = lc $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{SRCTYPE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and radio buttons box for specifying create prefix option
+    $subcmd_f{$name}->Label (
+      '-text' => 'Prefix option (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_revflag) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{REVFLAG}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and entry box for specifying ticket number
+    $subcmd_f{$name}->Label (
+      '-text' => 'Related Trac ticket(s) (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{TICKET}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Check button for info/delete
+    # --show-children, --show-siblings, --show-other, --verbose
+    $subcmd_f{$name}->Label (
+      '-text' => 'Options for info/delete only: ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+
+      for my $key (sort keys %branch_info_opt) {
+        $opt_f->Checkbutton (
+          '-text'     => $branch_info_opt{$key},
+          '-variable' => \($subcmdvar{$name}{$key}),
+        )->grid (
+          '-row'    => 0,
+          '-column' => $col++,
+          '-sticky' => 'w',
+        );
+      }
+    }
+  }
+
+  # Widget for the Checkout sub-command
+  {
+    my $name = 'CHECKOUT';
+
+    # Label and entry boxes for specifying URL and revision
+    my @labtxts = (
+      'URL: ',
+      'Revision: ',
+      'Path: ',
+    );
+    my @varrefs = \(
+      $subcmdvar{$name}{URL},
+      $subcmdvar{$name}{REV},
+      $subcmdvar{$name}{PATH},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Label ('-text' => $labtxts[$i])->grid (
+        '-row'    => $row{$name},
+        '-column' => 0,
+        '-sticky' => 'w',
+      );
+      $subcmd_f{$name}->Entry (
+        '-textvariable' => $varrefs[$i],
+      )->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'ew',
+      );
+    }
+  }
+
+  # Widget for the Status sub-command
+  {
+    my $name = 'STATUS';
+
+    # Checkbuttons for various options
+    my @labtxts = (
+      'Display update information',
+      'Print extra information',
+    );
+    my @varrefs = \(
+      $subcmdvar{$name}{UPDATE},
+      $subcmdvar{$name}{VERBOSE},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Checkbutton (
+        '-text'     => $labtxts[$i],
+        '-variable' => $varrefs[$i],
+      )->grid (
+        '-row'        => $row{$name}++,
+        '-column'     => 0,
+        '-columnspan' => 2,
+        '-sticky'     => 'w',
+      );
+    }
+  }
+
+  # Widget for the Diff sub-command
+  {
+    my $name = 'DIFF';
+
+    # Checkbuttons for various options
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Use xxdiff to display differences',
+      '-variable' => \($subcmdvar{$name}{GRAPHIC}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    my $entry;
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Show differences relative to the base of the branch',
+      '-variable' => \($subcmdvar{$name}{BRANCH}),
+      '-command'  => sub {
+        $entry->configure (
+          '-state' => ($subcmdvar{$name}{BRANCH} ? 'normal' : 'disabled'),
+        );
+      },
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    $subcmd_f{$name}->Label ('-text' => 'Branch URL')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    $entry = $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+      '-state'        => ($subcmdvar{$name}{BRANCH} ? 'normal' : 'disabled'),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widget for the Add/Delete sub-command
+  for my $name (qw/ADD DELETE/) {
+
+    # Checkbuttons for various options
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Check for files or directories not under version control',
+      '-variable' => \($subcmdvar{$name}{CHECK}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Merge sub-command
+  {
+    my $name = 'MERGE';
+
+    # Label and radio buttons box for specifying merge mode
+    $subcmd_f{$name}->Label (
+      '-text' => 'Mode: ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (qw/automatic custom reverse/) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{MODE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Check buttons for dry-run
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Dry run',
+      '-variable' => \($subcmdvar{$name}{DRYRUN}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    # Check buttons for verbose mode
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Print extra information',
+      '-variable' => \($subcmdvar{$name}{VERBOSE}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    # Label and entry boxes for specifying merge source
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source (automatic/custom only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{SRC}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry boxes for specifying merge revision (range)
+    $subcmd_f{$name}->Label (
+      '-text' => 'Revision (custom/reverse only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{REV}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widget for the Commit sub-command
+  {
+    my $name = 'COMMIT';
+
+    # Checkbuttons for various options
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Dry run',
+      '-variable' => \($subcmdvar{$name}{DRYRUN}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Switch sub-command
+  {
+    my $name = 'SWITCH';
+
+    # Label and entry boxes for specifying switch URL
+    $subcmd_f{$name}->Label ('-text' => 'URL: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widgets common to all sub-commands
+  for my $name (@subcmds) {
+    $subcmd_f{$name}->Label ('-text' => 'Other options: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{OTHER}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+# Buttons to perform main actions
+{
+  my $col = 0;
+  for my $name (qw/QUIT HELP CLEAR RUN/) {
+    $action_b{$name} = $bot_f->Button (
+      '-text'    => uc (substr ($name, 0, 1)) . lc (substr ($name, 1)),
+      '-command' => [\&button_clicked, $name],
+      '-width'   => 8,
+    )->grid (
+      '-row'    => 0,
+      '-column' => $col++,
+      '-sticky' => ($name eq 'RUN' ? 'ew' : 'w'),
+    );
+
+    $action_b{$name}->bind ('<Enter>', sub {$statustext = $action_help{$name}});
+    $action_b{$name}->bind ('<Leave>', sub {$statustext = ''});
+
+    $action_b{$name}->configure ('-underline' => $action_bind{$name}{U})
+      if defined $action_bind{$name}{U};
+
+    $mw->bind ($action_bind{$name}{KEY}, sub {$action_b{$name}->invoke});
+  }
+}
+
+&change_cwd ($subcmdvar{CWD});
+
+# ------------------------------------------------------------------------------
+
+# Handle the situation when the user attempts to quit the window while a
+# sub-command is running
+
+$mw->protocol ('WM_DELETE_WINDOW', sub {
+  if (defined $cmdpid) {
+    my $ans = $mw->messageBox (
+      '-title'   => $mw_title,
+      '-message' => $selsubcmd . ' is still running. Really quit?',
+      '-type'    => 'YesNo',
+      '-default' => 'No',
+    );
+
+    if ($ans eq 'Yes') {
+      kill 9, $cmdpid; # Need to kill the sub-process before quitting
+
+    } else {
+      return; # Do not quit
+    }
+  }
+
+  exit;
+});
+
+MainLoop;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfg = &main::cfg ();
+#
+# DESCRIPTION
+#   Return the $config variable.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  return $config;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &change_cwd ($dir);
+#
+# DESCRIPTION
+#   Change current working directory to $dir
+# ------------------------------------------------------------------------------
+
+sub change_cwd {
+  my $dir = $_[0];
+  my @allowed_subcmds = (&is_wc ($dir) ? @wc_subcmds : @nwc_subcmds);
+
+  for my $subcmd (@subcmds) {
+    if (grep {$_ eq $subcmd} @allowed_subcmds) {
+      $subcmd_b{$subcmd}->configure ('-state' => 'normal');
+
+    } else {
+      $subcmd_b{$subcmd}->configure ('-state' => 'disabled');
+    }
+  }
+
+  &display_subcmd_frame ($allowed_subcmds[0])
+    if not grep {$_ eq $selsubcmd} @allowed_subcmds;
+
+  chdir $dir;
+  $subcmdvar{CWD} = $dir;
+
+  if (&is_wc ($dir)) {
+    $subcmdvar{WCT}     = &get_wct ($dir);
+    $subcmdvar{URL_CWD} = &get_url_of_wc ($dir);
+    $subcmdvar{URL_WCT} = &get_url_of_wc ($subcmdvar{WCT});
+
+    $branch_opt{INFO}  ->configure ('-state' => 'normal');
+    $branch_opt{DELETE}->configure ('-state' => 'normal');
+    $subcmdvar{BRANCH}{OPT} = 'info';
+
+  } else {
+    $branch_opt{INFO}  ->configure ('-state' => 'disabled');
+    $branch_opt{DELETE}->configure ('-state' => 'disabled');
+    $subcmdvar{BRANCH}{OPT} = 'create';
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &button_clicked ($name);
+#
+# DESCRIPTION
+#   Call back function to handle a click on a command button named $name.
+# ------------------------------------------------------------------------------
+
+sub button_clicked {
+  my $name = $_[0];
+
+  if (grep {$_ eq $name} keys %subcmd_b) {
+    &display_subcmd_frame ($name);
+
+  } elsif ($name eq 'CLEAR') {
+    $out_t->delete ('1.0', 'end');
+
+  } elsif ($name eq 'QUIT') {
+    exit;
+
+  } elsif ($name eq 'HELP') {
+    &invoke_cmd ('help ' . lc ($selsubcmd));
+
+  } elsif ($name eq 'RUN') {
+    &invoke_cmd (&setup_cmd ($selsubcmd));
+
+  } else {
+    $out_t->insert ('end', $name . ': function to be implemented' . "\n");
+    $out_t->yviewMoveto (1);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &display_subcmd_frame ($name);
+#
+# DESCRIPTION
+#   Change selected subcommand to $name, and display the frame containing the
+#   widgets for configuring the options and arguments of that subcommand.
+# ------------------------------------------------------------------------------
+
+sub display_subcmd_frame {
+  my $name = $_[0];
+
+  if ($selsubcmd ne $name and not $cmdrunning) {
+    $subcmd_b{$name     }->configure ('-relief' => 'sunken');
+    $subcmd_b{$selsubcmd}->configure ('-relief' => 'raised') if $selsubcmd;
+
+    $subcmd_f{$name     }->grid ('-sticky' => 'new');
+    $subcmd_f{$selsubcmd}->gridForget if $selsubcmd;
+
+    $selsubcmd = $name;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $pos = &get_wm_pos ();
+#
+# DESCRIPTION
+#   Returns the position part of the geometry string of the main window.
+# ------------------------------------------------------------------------------
+
+sub get_wm_pos {
+  my $geometry = $mw->geometry ();
+  $geometry =~ /^=?(?:\d+x\d+)?([+-]\d+[+-]\d+)$/;
+  return $1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $command = &setup_cmd ($name);
+#
+# DESCRIPTION
+#   Setup the the system command for the sub-command $name.
+# ------------------------------------------------------------------------------
+
+sub setup_cmd {
+  my $name = $_[0];
+  my $cmd  = '';
+
+  if ($name eq 'BRANCH') {
+    $cmd .= lc ($name);
+    if ($subcmdvar{$name}{OPT} eq 'create') {
+      $cmd .= ' -c --svn-non-interactive';
+      $cmd .= ' -n '     . $subcmdvar{$name}{NAME} if $subcmdvar{$name}{NAME};
+      $cmd .= ' -t '     . $subcmdvar{$name}{TYPE};
+      $cmd .= ' --rev-flag ' . $subcmdvar{$name}{REVFLAG};
+      $cmd .= ' -r ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+      $cmd .= ' -k ' . $subcmdvar{$name}{TICKET} if $subcmdvar{$name}{TICKET};
+      $cmd .= ' --branch-of-branch ' if $subcmdvar{$name}{SRCTYPE} eq 'branch';
+
+    } elsif ($subcmdvar{$name}{OPT} eq 'delete') {
+      $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+      $cmd .= ' -d --svn-non-interactive';
+
+    } elsif ($subcmdvar{$name}{OPT} eq 'list') {
+      $cmd .= ' -l';
+      $cmd .= ' -r ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+
+    } else {
+      $cmd .= ' -i';
+      $cmd .= ' --show-children' if $subcmdvar{$name}{S_CHD};
+      $cmd .= ' --show-siblings' if $subcmdvar{$name}{S_SIB};
+      $cmd .= ' --show-other'    if $subcmdvar{$name}{S_OTH};
+      $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+    }
+    $cmd .= ' ' . $subcmdvar{$name}{URL}   if $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'CHECKOUT') {
+    $cmd .= lc ($name);
+    $cmd .= ' -r' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+    $cmd .= ' ' . $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{PATH} if $subcmdvar{$name}{PATH};
+
+  } elsif ($name eq 'STATUS') {
+    $cmd .= lc ($name);
+    $cmd .= ' -u' if $subcmdvar{$name}{UPDATE};
+    $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'DIFF') {
+    $cmd .= lc ($name);
+    $cmd .= ' -g' if $subcmdvar{$name}{GRAPHIC};
+
+    if ($subcmdvar{$name}{BRANCH}) {
+      $cmd .= ' -b';
+      $cmd .= ' ' . $subcmdvar{$name}{URL} if $subcmdvar{$name}{URL};
+    }
+
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'ADD' or $name eq 'DELETE') {
+    $cmd .= lc ($name);
+    $cmd .= ' -c' if $subcmdvar{$name}{CHECK};
+    $cmd .= ' --non-interactive'
+      if $name eq 'DELETE' and not $subcmdvar{$name}{CHECK};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'MERGE') {
+    $cmd .= lc ($name);
+
+    if ($subcmdvar{$name}{MODE} ne 'automatic') {
+      $cmd .= ' --' . $subcmdvar{$name}{MODE};
+      $cmd .= ' --revision ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+    }
+
+    $cmd .= ' --dry-run' if $subcmdvar{$name}{DRYRUN};
+    $cmd .= ' -v'        if $subcmdvar{$name}{VERBOSE};
+    $cmd .= ' ' . $subcmdvar{$name}{SRC}   if $subcmdvar{$name}{SRC};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'CONFLICTS') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'COMMIT') {
+    $cmd .= lc ($name);
+    $cmd .= ' --dry-run' if $subcmdvar{$name}{DRYRUN};
+    $cmd .= ' --svn-non-interactive';
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'SWITCH') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{URL}   if $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'UPDATE') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  }
+
+  return $cmd;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_cmd ($cmd);
+#
+# DESCRIPTION
+#   Invoke the command $cmd.
+# ------------------------------------------------------------------------------
+
+sub invoke_cmd {
+  my $cmd      = $_[0];
+  return unless $cmd;
+
+  my $disp_cmd = 'fcm ' . $cmd;
+  $cmd         = (index ($cmd, 'help ') == 0)
+                 ? $disp_cmd
+                 : ('fcm_gui_internal ' . &get_wm_pos () . ' ' . $cmd);
+
+  # Change directory to working copy top if necessary
+  if ($subcmdvar{$selsubcmd}{USEWCT} and $subcmdvar{WCT} ne $subcmdvar{CWD}) {
+    chdir $subcmdvar{WCT};
+    $out_t->insert ('end', 'cd ' . $subcmdvar{WCT} . "\n");
+    $out_t->yviewMoveto (1);
+  }
+
+  # Report start of command
+  $out_t->insert ('end', timestamp_command ($disp_cmd, 'Start'));
+  $out_t->yviewMoveto (1);
+
+  # Open the command as a pipe
+  if ($cmdpid = open CMD, '-|', $cmd . ' 2>&1') {
+    # Disable all action buttons
+    $action_b{$_}->configure ('-state' => 'disabled') for (keys %action_b);
+    $cmdrunning = 1;
+
+    # Set up a file event to read output from the command
+    $mw->fileevent (\*CMD, readable => sub {
+      if (sysread CMD, my ($buf), 1024) {
+        # Insert text into the output text box as it becomes available
+        $out_t->insert ('end', $buf);
+        $out_t->yviewMoveto (1);
+
+      } else {
+        # Delete the file event and close the file when the command finishes
+        $mw->fileevent(\*CMD, readable => '');
+        close CMD;
+        $cmdpid = undef;
+
+        # Check return status
+        if ($?) {
+          $out_t->insert (
+            'end', '"' . $disp_cmd . '" failed (' . $? . ')' . "\n",
+          );
+          $out_t->yviewMoveto (1);
+        }
+
+        # Report end of command
+        $out_t->insert ('end', timestamp_command ($disp_cmd, 'End'));
+        $out_t->yviewMoveto (1);
+
+        # Change back to CWD if necessary
+        if ($subcmdvar{$selsubcmd}{USEWCT} and
+            $subcmdvar{WCT} ne $subcmdvar{CWD}) {
+          chdir $subcmdvar{CWD};
+          $out_t->insert ('end', 'cd ' . $subcmdvar{CWD} . "\n");
+          $out_t->yviewMoveto (1);
+        }
+
+        # Enable all action buttons again
+        $action_b{$_}->configure ('-state' => 'normal') for (keys %action_b);
+        $cmdrunning = 0;
+
+        # If the command is "checkout", change directory to working copy
+        if (lc ($selsubcmd) eq 'checkout') {
+          my $url = expand_url_keyword (URL => $subcmdvar{CHECKOUT}{URL});
+          my $dir = $subcmdvar{CHECKOUT}{PATH}
+                  ? $subcmdvar{CHECKOUT}{PATH}
+                  : basename $url;
+          $dir    = File::Spec->rel2abs ($dir);
+          &change_cwd ($dir);
+
+        # If the command is "switch", change URL
+        } elsif (lc ($selsubcmd) eq 'switch') {
+          $subcmdvar{URL_CWD} = &get_url_of_wc ($subcmdvar{CWD}, 1);
+          $subcmdvar{URL_WCT} = &get_url_of_wc ($subcmdvar{WCT}, 1);
+        }
+      }
+      1;
+    });
+
+  } else {
+    $mw->messageBox (
+      '-title'   => 'Error',
+      '-message' => 'Error running "' . $cmd . '"',
+      '-icon'    => 'error',
+    );
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_gui_internal
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_gui_internal	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_gui_internal	(revision 6412)
@@ -0,0 +1,272 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_gui_internal
+#
+# SYNOPSIS
+#   fcm_gui_internal POS FUNCTION
+#
+# DESCRIPTION
+#   The fcm_gui_internal command is part of a simple graphical user interface
+#   for some of the commands of the FCM system. The argument POS is a geometry
+#   string used by the &Main::get_input method to determine the location of the
+#   pop up window. The argument FUNCTION must be a keyword recognised by the
+#   &Fcm::Cm::cm_command function.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas
+use warnings;
+use strict;
+
+# Standard modules
+use Tk;
+use File::Basename;
+use File::Spec::Functions;
+
+# FCM component modules:
+use lib catfile (dirname (dirname ($0)), 'lib');
+use Fcm::Cm;
+use Fcm::Config;
+
+# ------------------------------------------------------------------------------
+
+# Get configuration settings
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+my $pos      = shift @ARGV;
+my $function = shift @ARGV;
+cm_command $function;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfg = &main::cfg ();
+#
+# DESCRIPTION
+#   Return the $config variable.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  return $config;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ans = &main::get_input (
+#     TITLE   => $title,
+#     MESSAGE => $mesg,
+#     TYPE    => $type,
+#     DEFAULT => $def,
+#   );
+#
+# DESCRIPTION
+#   Get an input string from the user and return it as $ans. If TYPE is 'YN', a
+#   'YesNo' type message box will be displayed to prompt the user to click
+#   either the 'yes' or 'no' button. If TYPE is 'YNA', then an 'all' button is
+#   provided as a third option. Otherwise, a dialog box with an entry box for
+#   the user to type in a string will be displayed. TITLE is the title of the
+#   dialog box, and MESSAGE is the main message of the dialog box. If DEFAULT is
+#   set, $ans is set to the default value when the dialog box is invoked.
+# ------------------------------------------------------------------------------
+
+sub get_input {
+  my %args  = @_;
+  my $title = exists $args{TITLE}   ? $args{TITLE}   : '';
+  my $mesg  = exists $args{MESSAGE} ? $args{MESSAGE} : '';
+  my $type  = exists $args{TYPE}    ? $args{TYPE}    : '';
+  my $def   = exists $args{DEFAULT} ? $args{DEFAULT} : '';
+  my $ans   = '';
+
+  # Create a main window
+  my $mw = MainWindow->new;
+  $mw->title ($title);
+
+  # Define the default which applies if the dialog box is just closed or
+  # the user selects 'cancel'
+  $ans = $def ? $def : '';
+
+  if ($type =~ /^yn/i) {
+    # Create a yes-no(-all) dialog box
+
+    # If TYPE is YNA then add a third button: 'all'
+    my $buttons;
+    if ($type =~ /a$/i) {
+      $buttons = 3;
+
+    } else {
+      $buttons = 2;
+    }
+
+    # Message of the dialog box
+    $mw->Label ('-text' => $mesg)->grid (
+      '-row'        => 0,
+      '-column'     => 0,
+      '-columnspan' => $buttons,
+      '-padx'       => 10,
+      '-pady'       => 10,
+    );
+
+    # The "yes" button
+    my $y_b = $mw->Button (
+      '-text'      => 'Yes',
+      '-underline' => 0,
+      '-command'   => sub {$ans = 'y'; $mw->destroy},
+    )->grid (
+      '-row'    => 1,
+      '-column' => 0,
+      '-padx'   => 5,
+      '-pady'   => 5,
+    );
+
+    # The "no" button
+    my $n_b = $mw->Button (
+      '-text'      => 'No',
+      '-underline' => 0,
+      '-command'   => sub {$ans = 'n'; $mw->destroy},
+    )->grid (
+      '-row'    => 1,
+      '-column' => 1,
+      '-padx'   => 5,
+      '-pady'   => 5,
+    );
+
+    # The "all" button
+    my $a_b;
+    if ($buttons == 3) {
+      $a_b = $mw->Button (
+        '-text'      => 'All',
+        '-underline' => 0,
+        '-command'   => sub {$ans = 'a'; $mw->destroy},
+      )->grid (
+        '-row'    => 1,
+        '-column' => 2,
+        '-padx'   => 5,
+        '-pady'   => 5,
+      );
+    }
+
+    # Keyboard binding
+    if ($buttons == 3) {
+      $mw->bind ('<Key>' => sub {
+	if ($Tk::event->K eq 'Y' or $Tk::event->K eq 'y') {
+	  $y_b->invoke;
+
+	} elsif ($Tk::event->K eq 'N' or $Tk::event->K eq 'n') {
+	  $n_b->invoke;
+
+	} elsif ($Tk::event->K eq 'A' or $Tk::event->K eq 'a') {
+	  $a_b->invoke;
+	}
+      });
+
+    } else {
+      $mw->bind ('<Key>' => sub {
+	if ($Tk::event->K eq 'Y' or $Tk::event->K eq 'y') {
+	  $y_b->invoke;
+
+	} elsif ($Tk::event->K eq 'N' or $Tk::event->K eq 'n') {
+	  $n_b->invoke;
+	}
+      });
+    }
+
+    # Handle the situation when the user attempts to quit the window
+    $mw->protocol ('WM_DELETE_WINDOW', sub {
+      $ans = $def if $def;
+      $mw->destroy;
+    });
+
+  } else {
+    # Create a dialog box to obtain an input string
+
+    # Message of the dialog box
+    $mw->Label ('-text' => $mesg)->grid (
+      '-row'    => 0,
+      '-column' => 0,
+      '-padx'   => 5,
+      '-pady'   => 5,
+    );
+
+    # Entry box for the user to type in the input string
+    my $entry   = $ans;
+    my $input_e = $mw->Entry (
+      '-textvariable'    => \$entry,
+      '-width'           => 40,
+    )->grid (
+      '-row'    => 0,
+      '-column' => 1,
+      '-sticky' => 'ew',
+      '-padx'   => 5,
+      '-pady'   => 5,
+    );
+
+    my $b_f = $mw->Frame->grid (
+      '-row'        => 1,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'e',
+    );
+
+    # An OK button to accept the input string
+    my $ok_b = $b_f->Button (
+      '-text' => 'OK',
+      '-command' => sub {$ans = $entry; $mw->destroy},
+    )->grid (
+      '-row'        => 0,
+      '-column'     => 0,
+      '-padx'       => 5,
+      '-pady'       => 5,
+    );
+
+    # A Cancel button to reject the input string
+    my $cancel_b = $b_f->Button (
+      '-text' => 'Cancel',
+      '-command' => sub {$ans = undef; $mw->destroy},
+    )->grid (
+      '-row'        => 0,
+      '-column'     => 1,
+      '-padx'       => 5,
+      '-pady'       => 5,
+    );
+
+    # Keyboard binding
+    $mw->bind ('<Key>' => sub {
+      if ($Tk::event->K eq 'Return' or $Tk::event->K eq 'KP_Enter') {
+        $ok_b->invoke;
+
+      } elsif ($Tk::event->K eq 'Escape') {
+        $cancel_b->invoke;
+      }
+    });
+
+    # Allow the entry box to expand
+    $mw->gridColumnconfigure (1, '-weight' => 1);
+
+    # Set initial focus on the entry box
+    $input_e->focus;
+    $input_e->icursor ('end');
+  }
+
+  $mw->geometry ($pos);
+
+  # Switch on "always on top" property for $mw
+  $mw->property (
+    qw/set _NET_WM_STATE ATOM/,
+    32,
+    ['_NET_WM_STATE_STAYS_ON_TOP'],
+    ($mw->toplevel->wrapper)[0],
+  );
+
+  MainLoop;
+
+  return $ans;
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_internal
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_internal	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_internal	(revision 6412)
@@ -0,0 +1,581 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_internal
+#
+# SYNOPSIS
+#   fcm_internal SUBCOMMAND ARGS
+#
+# DESCRIPTION
+#   The fcm_internal command is a frontend for some of the internal commands of
+#   the FCM build system. The subcommand can be "compile", "load" or "archive"
+#   for invoking the compiler, loader and library archiver respectively. If
+#   "compile" is specified, it can be suffixed with ":TYPE" to specify the
+#   nature of the source file. If TYPE is not specified, it is set to F by
+#   default (for Fortran source). For compile and load, the other arguments are
+#   the 1) name of the container package of the source file, 2) the path to the
+#   source file and 3) the target name after compiling or loading the source
+#   file. For compile, the 4th argument is a flag to indicate whether
+#   pre-processing is required for compiling the source file. For load, the 4th
+#   and the rest of the arguments is a list of object files that cannot be
+#   archived into the temporary load library and must be linked into the target
+#   through the linker command. (E.g. Fortran BLOCKDATA program units must be
+#   linked this way.) If archive is specified, the first argument should be the
+#   name of the library archive target and the rest should be the object files
+#   to be included in the archive. This command is invoked via the build system
+#   and should never be called directly by the user.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas:
+use warnings;
+use strict;
+
+# FCM component modules
+use Fcm::Timer;
+
+# Function declarations
+sub catfile;
+sub basename;
+sub dirname;
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %unusual_tool_name = ();
+
+# ------------------------------------------------------------------------------
+
+MAIN: {
+  # Name of program
+  my $this = basename $0;
+
+  # Arguments
+  my $subcommand = shift @ARGV;
+  my ($function, $type) = split /:/, $subcommand; 
+  my ($srcpackage, $src, $target, $requirepp, @objects, @blockdata);
+  
+  if ($subcommand eq 'archive') {
+    ($target, @objects) = @ARGV;
+
+  } elsif ($subcommand eq 'load') {
+    ($srcpackage, $src, $target, @blockdata) = @ARGV;
+
+  } else {
+    ($srcpackage, $src, $target, $requirepp) = @ARGV;
+  }
+
+  # Set up hash reference for all the required information
+  my %info = (
+    SRCPACKAGE => $srcpackage,
+    SRC        => $src,
+    TYPE       => $type,
+    TARGET     => $target,
+    REQUIREPP  => $requirepp,
+    OBJECTS    => \@objects,
+    BLOCKDATA  => \@blockdata,
+  );
+
+  # Get list of unusual tools
+  my $i = 0;
+  while (my $label = &get_env ('FCM_UNUSUAL_TOOL_LABEL' . $i)) {
+    my $value = &get_env ('FCM_UNUSUAL_TOOL_VALUE' . $i);
+    $unusual_tool_name{$label} = $value;
+    $i++;
+  }
+
+  # Invoke the action
+  my $rc = 0;
+  if ($function eq 'compile') {
+    $rc = &compile (\%info);
+
+  } elsif ($function eq 'load') {
+    $rc = &load (\%info);
+
+  } elsif ($function eq 'archive') {
+    $rc = &archive (\%info);
+
+  } else {
+    print STDERR $this, ': incorrect usage, abort';
+    $rc = 1;
+  }
+
+  # Throw error if action failed
+  if ($rc) {
+    print STDERR $this, ' ', $function, ' failed (', $rc, ')', "\n";
+    exit 1;
+
+  } else {
+    exit;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &compile (\%info);
+#
+# DESCRIPTION
+#   This method invokes the correct compiler with the correct options to
+#   compile the source file into the required target. The argument $info is a
+#   hash reference set up in MAIN. The following environment variables are
+#   used, where * is the source file type (F for Fortran, and C for C/C++):
+# 
+#   *C          - compiler command
+#   *C_OUTPUT   - *C option to specify the name of the output file
+#   *C_DEFINE   - *C option to declare a pre-processor def
+#   *C_INCLUDE  - *C option to declare an include directory
+#   *C_COMPILE  - *C option to ask the compiler to perform compile only
+#   *CFLAGS     - *C user options
+#   *PPKEYS     - list of pre-processor defs (may have sub-package suffix)
+#   FCM_VERBOSE - verbose level
+#   FCM_OBJDIR  - destination directory of object file
+#   FCM_TMPDIR  - temporary destination directory of object file
+# ------------------------------------------------------------------------------
+
+sub compile {
+  my $info = shift;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  my @command = ();
+
+  # Only support C and Fortran source files at the moment
+  my $type = $info->{TYPE};
+  $type    = ($info->{SRC} =~ /\.c(\w+)?$/i) ? 'C' : 'F' if not $type;
+
+  # Compiler
+  push @command, &get_env ($type . 'C', 1);
+
+  # Compile output target (typical -o option)
+  push @command, &get_env ($type . 'C_OUTPUT', 1), $info->{TARGET};
+
+  # Pre-processor definition macros
+  if ($info->{REQUIREPP}) {
+    my @ppkeys = split /\s+/, &select_flags ($info, $type . 'PPKEYS');
+    my $defopt = &get_env ($type . 'C_DEFINE', 1);
+
+    push @command, (map {$defopt . $_} @ppkeys);
+  }
+
+  # Include search path
+  my $incopt  = &get_env ($type . 'C_INCLUDE', 1);
+  my @incpath = split /:/, &get_env ('FCM_INCPATH');
+  push @command, (map {$incopt . $_} @incpath);
+
+  # Other compiler flags
+  my $flags = &select_flags ($info, $type . 'FLAGS');
+  push @command, $flags if $flags;
+
+  my $compile_only = &get_env ($type . 'C_COMPILE');
+  if ($flags !~ /(?:^|\s)$compile_only\b/) {
+    push @command, &get_env ($type . 'C_COMPILE');
+  }
+
+  # Name of source file
+  push @command, $info->{SRC};
+
+  # Execute command
+  my $objdir = &get_env ('FCM_OBJDIR', 1);
+  my $tmpdir = &get_env ('FCM_TMPDIR', 1);
+  chdir $tmpdir;
+
+  my $command = join ' ', @command;
+  if ($verbose > 1) {
+    print 'cd ', $tmpdir, "\n";
+    print &timestamp_command ($command, 'Start');
+
+  } elsif ($verbose) {
+    print $command, "\n";
+  }
+
+  my $rc = system $command;
+
+  print &timestamp_command ($command, 'End  ') if $verbose > 1;
+
+  # Move temporary output to correct location on success
+  # Otherwise, remove temporary output
+  if ($rc) { # error
+    unlink $info->{TARGET};
+
+  } else {   # success
+    print 'mv ', $info->{TARGET}, ' ', $objdir, "\n" if $verbose > 1;
+    rename $info->{TARGET}, &catfile ($objdir, $info->{TARGET});
+  }
+
+  # Move any Fortran module definition files to the INC directory
+  my @modfiles = <*.mod *.MOD>;
+  for my $file (@modfiles) {
+    rename $file, &catfile ($incpath[0], $file);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &load (\%info);
+#
+# DESCRIPTION
+#   This method invokes the correct loader with the correct options to link
+#   the main program object into an executable. The argument $info is a hash
+#   reference set up in MAIN. The following environment variables are used:
+# 
+#   LD           - linker command
+#   LD_OUTPUT    - LD option to specify the name of the output file
+#   LD_LIBSEARCH - LD option to declare a directory in the library search path
+#   LD_LIBLINK   - LD option to declare an object library
+#   LDFLAGS      - LD user options
+#   FCM_VERBOSE  - verbose level
+#   FCM_LIBDIR   - destination directory of object libraries
+#   FCM_OBJDIR   - destination directory of object files
+#   FCM_BINDIR   - destination directory of executable file
+#   FCM_TMPDIR   - temporary destination directory of executable file
+# ------------------------------------------------------------------------------
+
+sub load {
+  my $info = shift;
+
+  my $rc = 0;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  # Create temporary object library
+  (my $name   = $info->{TARGET}) =~ s/\.\S+$//;
+  my $libname = '__fcm__' . $name;
+  my $lib     = 'lib' . $libname . '.a';
+  my $libfile = catfile (&get_env ('FCM_LIBDIR', 1), $lib);
+  $rc = &archive ({TARGET => $lib});
+
+  unless ($rc) {
+    my @command = ();
+
+    # Linker
+    push @command, &select_flags ($info, 'LD');
+
+    # Linker output target (typical -o option)
+    push @command, &get_env ('LD_OUTPUT', 1), $info->{TARGET};
+
+    # Name of main object file
+    my $mainobj = (basename ($info->{SRC}) eq $info->{SRC})
+                  ? catfile (&get_env ('FCM_OBJDIR'), $info->{SRC})
+                  : $info->{SRC};
+    push @command, $mainobj;
+
+    # Link with Fortran BLOCKDATA objects if necessary
+    if (@{ $info->{BLOCKDATA} }) {
+      my @blockdata = @{ $info->{BLOCKDATA} };
+      my @objpath   = split /:/, &get_env ('FCM_OBJPATH');
+
+      # Search each BLOCKDATA object file from the object search path
+      for my $file (@blockdata) {
+        for my $dir (@objpath) {
+          my $full = catfile ($dir, $file);
+
+          if (-r $full) {
+            $file = $full;
+            last;
+          }
+        }
+
+        push @command, $file;
+      }
+    }
+
+    # Library search path
+    my $libopt  = &get_env ('LD_LIBSEARCH', 1);
+    my @libpath = split /:/, &get_env ('FCM_LIBPATH');
+    push @command, (map {$libopt . $_} @libpath);
+
+    # Link with temporary object library if it exists
+    push @command, &get_env ('LD_LIBLINK', 1) . $libname if -f $libfile;
+
+    # Other linker flags
+    my $flags = &select_flags ($info, 'LDFLAGS');
+    push @command, $flags;
+
+    # Execute command
+    my $tmpdir = &get_env ('FCM_TMPDIR', 1);
+    my $bindir = &get_env ('FCM_BINDIR', 1);
+    chdir $tmpdir;
+
+    my $command = join ' ', @command;
+    if ($verbose > 1) {
+      print 'cd ', $tmpdir, "\n";
+      print &timestamp_command ($command, 'Start');
+
+    } elsif ($verbose) {
+      print $command, "\n";
+    }
+
+    $rc = system $command;
+
+    print &timestamp_command ($command, 'End  ') if $verbose > 1;
+
+    # Move temporary output to correct location on success
+    # Otherwise, remove temporary output
+    if ($rc) { # error
+      unlink $info->{TARGET};
+
+    } else {   # success
+      print 'mv ', $info->{TARGET}, ' ', $bindir, "\n" if $verbose > 1;
+      rename $info->{TARGET}, &catfile ($bindir, $info->{TARGET});
+    }
+  }
+
+  # Remove the temporary object library
+  unlink $libfile if -f $libfile;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &archive (\%info);
+#
+# DESCRIPTION
+#   This method invokes the library archiver to create an object library. The
+#   argument $info is a hash reference set up in MAIN. The following
+#   environment variables are used:
+# 
+#   AR           - archiver command
+#   ARFLAGS      - AR options to update/create an object library
+#   FCM_VERBOSE  - verbose level
+#   FCM_LIBDIR   - destination directory of object libraries
+#   FCM_OBJPATH  - search path of object files
+#   FCM_OBJDIR   - destination directory of object files
+#   FCM_TMPDIR   - temporary destination directory of executable file
+# ------------------------------------------------------------------------------
+
+sub archive {
+  my $info = shift;
+
+  my $rc = 0;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  # Set up the archive command
+  my $lib     = &basename ($info->{TARGET});
+  my $tmplib  = &catfile (&get_env ('FCM_TMPDIR', 1), $lib);
+  my @ar_cmd  = ();
+  push @ar_cmd, (&get_env ('AR', 1), &get_env ('ARFLAGS', 1));
+  push @ar_cmd, $tmplib;
+
+  # Get object directories and their files
+  my %objdir;
+  if (exists $info->{OBJECTS}) {
+    # List of objects set in the argument, sort into directory/file list
+    for my $name (@{ $info->{OBJECTS} }) {
+      my $dir = (&dirname ($name) eq '.')
+                ? &get_env ('FCM_OBJDIR', 1) : &dirname ($name);
+      $objdir{$dir}{&basename ($name)} = 1;
+    }
+
+  } else {
+    # Objects not listed in argument, search object path for all files
+    my @objpath  = split /:/, &get_env ('FCM_OBJPATH', 1);
+    my %objbase  = ();
+
+    # Get registered objects into a hash (keys = objects, values = 1)
+    my %objects = map {($_, 1)} split (/\s+/, &get_env ('OBJECTS'));
+
+    # Seach object path for all files
+    for my $dir (@objpath) {
+      next unless -d $dir;
+
+      chdir $dir;
+
+      # Use all files from each directory in the object search path
+      for ((glob ('*'))) {
+        next unless exists $objects{$_}; # consider registered objects only
+        $objdir{$dir}{$_} = 1 unless exists $objbase{$_};
+        $objbase{$_} = 1;
+      }
+    }
+  }
+
+  for my $dir (keys %objdir) {
+    next unless -d $dir;
+
+    # Go to each object directory and executes the library archive command 
+    chdir $dir;
+    my $command = join ' ', (@ar_cmd, sort keys %{ $objdir{$dir} });
+
+    if ($verbose > 1) {
+      print 'cd ', $dir, "\n";
+      print &timestamp_command ($command, 'Start');
+
+    } else {
+      print $command, "\n" if exists $info->{OBJECTS};
+    }
+
+    $rc = system $command;
+
+    print &timestamp_command ($command, 'End  ')
+      if $verbose > 1;
+    last if $rc;
+  }
+
+  # Move temporary output to correct location on success
+  # Otherwise, remove temporary output
+  if ($rc) { # error
+    unlink $tmplib;
+
+  } else {   # success
+    my $libdir = &get_env ('FCM_LIBDIR', 1);
+
+    print 'mv ', $tmplib, ' ', $libdir, "\n" if $verbose > 1;
+    rename $tmplib, &catfile ($libdir, $lib);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flags = &select_flags (\%info, $set);
+#
+# DESCRIPTION
+#   This function selects the correct compiler/linker flags for the current
+#   sub-package from the environment variable prefix $set. The argument $info
+#   is a hash reference set up in MAIN.
+# ------------------------------------------------------------------------------
+
+sub select_flags {
+  my ($info, $set) = @_;
+
+  (my $srcroot = &basename ($info->{SRC})) =~ s/\.\S+$//;
+  my @names    = ($set);
+  push @names, split (/__/, $info->{SRCPACKAGE} . '__' . $srcroot);
+
+  my $string   = '';
+  while (@names) {
+    my $name = join '__', @names;
+    my $var  = &get_env ($name);
+
+    if (defined $var) {
+      $string = $var;
+      last;
+
+    } else {
+      pop @names;
+    }
+  }
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $variable = &get_env ($name);
+#   $variable = &get_env ($name, $compulsory);
+#
+# DESCRIPTION
+#   This internal method gets a variable from $ENV{$name}. If $compulsory is
+#   set to true, it throws an error if the variable is a not set or is an empty
+#   string. Otherwise, it returns C<undef> if the variable is not set.
+# ------------------------------------------------------------------------------
+
+sub get_env {
+  (my $name, my $compulsory) = @_;
+  my $string;
+
+  if ($name =~ /^\w+$/) {
+    # $name contains only word characters, variable is exported normally
+    die 'The environment variable "', $name, '" must be set, abort'
+      if $compulsory and not exists $ENV{$name};
+
+    $string = exists $ENV{$name} ? $ENV{$name} : undef;
+
+  } else {
+    # $name contains unusual characters
+    die 'The environment variable "', $name, '" must be set, abort'
+      if $compulsory and not exists $unusual_tool_name{$name};
+
+    $string = exists $unusual_tool_name{$name}
+              ? $unusual_tool_name{$name} : undef;
+  }
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = &catfile (@paths);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Spec module.
+# ------------------------------------------------------------------------------
+
+sub catfile {
+  my @names = split (m!/!, join ('/', @_));
+  my $path  = shift @names;
+
+  for my $name (@names) {
+    $path .= '/' . $name if $name;
+  }
+
+  return $path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $basename = &basename ($path);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Basename module.
+# ------------------------------------------------------------------------------
+
+sub basename {
+  my $name = $_[0];
+
+  $name =~ s{/*$}{}; # remove trailing slashes
+
+  if ($name =~ m#.*/([^/]+)$#) {
+    return $1;
+
+  } else {
+    return $name;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dirname = &dirname ($path);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Basename module.
+# ------------------------------------------------------------------------------
+
+sub dirname {
+  my $name = $_[0];
+
+  if ($name =~ m#^/+$#) {
+    return '/'; # dirname of root is root
+
+  } else {
+    $name =~ s{/*$}{}; # remove trailing slashes
+
+    if ($name =~ m#^(.*)/[^/]+$#) {
+      my $dir = $1;
+      $dir =~ s{/*$}{}; # remove trailing slashes
+      return $dir;
+
+    } else {
+      return '.';
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_setup_konqueror
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_setup_konqueror	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_setup_konqueror	(revision 6412)
@@ -0,0 +1,44 @@
+#!/usr/bin/ksh
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_setup_konqueror
+#
+# SYNOPSIS
+#   fcm_setup_konqueror
+#
+# DESCRIPTION
+#   Set up Konqueror to use "fcm gui".
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Check number of arguments
+script=$(basename $0)
+usage="$script: no argument required"
+if (( $# != 0 )); then
+  echo "$usage, abort..." >&2
+  exit 1
+fi
+
+filename=fcm_gui.desktop
+
+file=$(dirname $0)
+file=${file%/bin}/etc/$filename
+
+if [[ ! -f $file ]]; then
+  echo "$script: $file not found, abort..." >&2
+  exit 1
+fi
+
+dir=$HOME/.kde/share/applnk/.hidden
+mkdir -p $dir
+cd $dir
+rm -f $filename             # Always remove.
+ln -s $file .
+
+echo "$script: finished"
+
+#EOF
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_update_version_dir.pl
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_update_version_dir.pl	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/bin/fcm_update_version_dir.pl	(revision 6412)
@@ -0,0 +1,302 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_update_version_dir.pl
+#
+# SYNOPSIS
+#   fcm_update_version_dir.pl [OPTIONS] [CFGFILE]
+#
+# DESCRIPTION
+#   See $usage for detail.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas
+use strict;
+use warnings;
+
+# Standard modules
+use Getopt::Long;
+use Cwd;
+use File::Basename;
+use File::Path;
+use File::Spec;
+
+# FCM component modules:
+use lib File::Spec->catfile (dirname (dirname ($0)), 'lib');
+use Fcm::Config;
+use Fcm::Util;
+
+# Usage
+# ------------------------------------------------------------------------------
+my $this  = basename $0;
+my $usage = <<EOF;
+NAME
+  $this
+
+SYNOPSIS
+  $this [OPTIONS] [CFGFILE]
+
+DESCRIPTION
+  Update the version directories for a list of relative paths in the source
+  repository URL.
+
+OPTIONS
+  -d [--dest] arg: Specify a destination for the extraction. If not specified,
+                   the command extracts to the current working directory.
+  -h [--help]    : Print help and exit.
+  -f [--full]    : Specify the full mode. If not specified, the command runs
+                   in incremental mode.
+  -u [--url]  arg: Specify the source repository URL. No default.
+
+ARGUMENTS
+  A configuration file may be given to this command, or it will attempt to
+  read from the standard input. Each line in the configuration must contain
+  a relative path that resides under the given source repository URL. (Empty
+  lines and lines beginning with a "#" are ignored.) Optionally, each
+  relative path may be followed by a list of space separated "conditions".
+  Each condition is a conditional operator (>, >=, <, <=, == or !=) followed
+  by a revision number or the keyword HEAD. The command uses the revision
+  log to determine the revisions at which the relative path has been updated
+  in the source repository URL. If these revisions also satisfy the
+  "conditions" set by the user, they will be considered in the extraction.
+  In full mode, everything is re-extracted. In incremental mode, the version
+  directories are only updated if they do not already exist.
+
+COPYRIGHT
+  This program is part of the FCM system.
+  (C) Crown copyright Met Office. All rights reserved.
+  For further details please refer to the file COPYRIGHT.txt
+  which you should have received as part of this distribution.
+EOF
+
+# Options
+# ------------------------------------------------------------------------------
+my ($dest, $full, $help, $url);
+GetOptions (
+  'dest|d=s' => \$dest,
+  'full|f'   => \$full,
+  'help'     => \$help,
+  'url|u=s'  => \$url,
+);
+
+if ($help) {
+  print $usage;
+  exit;
+}
+
+$dest = cwd () unless $dest;
+
+die 'An URL must be specified with the --url option, abort' unless $url;
+
+# Arguments
+# ------------------------------------------------------------------------------
+if (@ARGV) {
+  die 'Cannot read: ', $ARGV[0], ', abort' unless -f $ARGV[0] and -r $ARGV[0];
+}
+
+# Get configuration settings
+# ------------------------------------------------------------------------------
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+# Expand URL keyword
+$url = &expand_url_keyword (URL => $url);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfg = &main::cfg ();
+#
+# DESCRIPTION
+#   Return the $config variable.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  return $config;
+}
+
+# ------------------------------------------------------------------------------
+
+MAIN: {
+  my $date = localtime;
+  print $this, ': started on ', $date, "\n";
+
+  my %dirs;
+
+  # Read input (file) for a list directories and update conditions
+  while (<>) {
+    chomp;
+
+    # Ignore empty and comment lines
+    next if /^\s*(?:#|$)/;
+
+    # Each line must contain a relative path, and optionally a list of
+    # space delimited conditions
+    my @words = split /\s+/;
+    my $dir   = shift @words;
+
+    # Check that the conditions are valid
+    my @conditions;
+    for my $word (@words) {
+      if ($word =~ /^([<>]=?|[!=]=)(.+)$/i) {
+        # Condition must be a conditional operator followed by a revision
+        my ($operator, $rev) = ($1, $2);
+        $rev = &expand_rev_keyword (REV => $rev, URL => $url, HEAD => 1);
+        push @conditions, $operator . $rev;
+
+      } else {
+        print STDERR 'Warning: ignore unknown syntax for update condition: ',
+                     $word, "\n";
+      }
+    }
+
+    # Add directory and its conditions to a hash
+    if ($dir =~ s#/\*$##) { # Directory finishes with wildcard
+
+      # Run "svn ls" in recursive mode
+      my $dirurl  = join ('/', ($url, $dir));
+      my @files   = &run_command ([qw/svn ls -R/, $dirurl], METHOD => 'qx');
+
+      # Find directories containing regular files
+      while (my $file = shift @files) {
+	# Skip directories
+	next if $file =~ m#/$#;
+
+	# Get "dirname" of regular file and add to hash
+	my $subdir = join ('/', ($dir, dirname ($file)));
+	$dirs{$subdir} = \@conditions;
+      }
+
+    } else {
+      $dirs{$dir} = \@conditions;
+    }
+
+  }
+
+  # Update each directory, if required
+  for my $dir (sort keys %dirs) {
+    # Use "svn log" to determine the revisions that need to be updated
+    my %allversions;
+    {
+      my $command = 'svn log -q ' . join ('/', ($url, $dir));
+      my @log     = &run_command (
+        [qw/svn log -q/, join ('/', ($url, $dir))], METHOD => 'qx',
+      );
+      @log        = grep /^r\d+/, @log;
+
+      # Assign a sequential "version" number to each sub-directory
+      my $version = scalar @log;
+      for (@log) {
+        m/^r(\d+)/;
+        $allversions{$1} = 'v' . $version--;
+      }
+    }
+    my %versions = %allversions;
+
+    # Extract only revisions matching the conditions
+    if (@{ $dirs{$dir} }) {
+      my @conditions = @{ $dirs{$dir} };
+
+      for my $condition (@conditions) {
+        for my $rev (keys %versions) {
+          delete $versions{$rev} unless eval ($rev . $condition);
+        }
+      }
+    }
+
+    # Destination directory
+    my $dirpath = File::Spec->catfile ($dest, $dir);
+
+    if (-d $dirpath) {
+      if ($full or not keys %versions) {
+        # Remove destination directory top, in full mode
+        # or if there are no matching revisions
+        &run_command ([qw/rm -rf/, $dirpath], PRINT => 1);
+
+      } else {
+        # Delete excluded revisions if they exist, in incremental mode
+        if (opendir DIR, $dirpath) {
+          while (my $rev = readdir 'DIR') {
+            next unless $rev =~ /^\d+$/;
+
+            if (not grep {$_ eq $rev} keys %versions) {
+              my @command = (qw/rm -rf/, File::Spec->catfile ($dirpath, $rev));
+              &run_command (\@command, PRINT => 1);
+
+              # Remove "version" symlink
+              my $verlink = File::Spec->catfile ($dirpath, $allversions{$rev});
+              unlink $verlink if -l $verlink;
+            }
+          }
+          closedir DIR;
+        }
+      }
+    }
+
+    # Create container directory of destination if it does not already exist
+    if (keys %versions and not -d $dirpath) {
+      print '-> mkdir -p ', $dirpath, "\n";
+      my $rc = mkpath $dirpath;
+      die 'mkdir -p ', $dirpath, ' failed' unless $rc;
+    }
+
+    # Update each version directory that needs updating
+    for my $rev (keys %versions) {
+      my $revpath = File::Spec->catfile ($dest, $dir, $rev);
+
+      # Create version directory if it does not exist
+      if (not -e $revpath) {
+        # Use "svn export" to create the version directory
+        my @command = (
+          qw/svn export -q -r/,
+          $rev,
+          join ('/', ($url, $dir)),
+          $revpath,
+        );
+
+        &run_command (\@command, PRINT => 1);
+
+        # Run GenScr_GenRule on any component directories
+        # This can be removed once old versions of the SCSUI are no longer used
+	if ($dir =~ m#(?:^|/)components/#) {
+          my @command = (
+            "GenScr_GenRule",
+            File::Spec->catfile ($revpath, join ('.', (basename ($dir), "rule")))
+          );
+
+          &run_command (\@command, PRINT => 1);
+	}
+      }
+
+      # Create "version" symlink if necessary
+      my $verlink = File::Spec->catfile ($dest, $dir, $versions{$rev});
+      symlink $rev, $verlink unless -l $verlink;
+    }
+
+    # Symbolic link to the "latest" version directory
+    my $headlink = File::Spec->catfile ($dest, $dir, 'latest');
+    my $headrev  = 0;
+    for my $rev (keys %versions) {
+      $headrev = $rev if $rev > $headrev;
+    }
+
+    if (-l $headlink) {
+      # Remove old symbolic link if there is no revision to update or if it
+      # does not point to the correct version directory
+      my $org = readlink $headlink;
+      unlink $headlink if (! $headrev or $org ne $headrev);
+    }
+
+    # (Re-)create the "latest" symbolic link, if necessary
+    symlink $headrev, $headlink if ($headrev and not -l $headlink);
+  }
+
+  $date = localtime;
+  print $this, ': finished normally on ', $date, "\n";
+}
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/etc/fcm.cfg.eg
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/etc/fcm.cfg.eg	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/etc/fcm.cfg.eg	(revision 6412)
@@ -0,0 +1,266 @@
+# ------------------------------------------------------------------------------
+# FCM central configuration file
+# ------------------------------------------------------------------------------
+
+# ------------------------------------------------------------------------------
+# Standard repository locations
+# ------------------------------------------------------------------------------
+
+# AMV repository
+set::url::amv                svn://fcm7/AMV_svn/AMV
+
+set::trac::amv               http://fcm7/projects/AMV/browser/AMV
+
+# ANCIL repository
+set::url::ancil              svn://fcm8/ANCIL_svn/ANCIL
+
+set::trac::ancil             http://fcm8/projects/ANCIL/browser/ANCIL
+
+# ATSR repository
+set::url::atsr               svn://fcm7/ATSR_svn/ATSR
+
+set::trac::atsr              http://fcm7/projects/ATSR/browser/ATSR
+
+# CICE repository
+set::url::cice               svn://fcm3/CICE_svn/CICE
+
+set::trac::cice              http://fcm3/projects/CICE/browser/CICE
+
+# CVC repository
+set::url::cvc_admin          svn://fcm6/CVC_svn/Admin
+set::url::bullseye           svn://fcm6/CVC_svn/Bullseye
+set::url::cat                svn://fcm6/CVC_svn/CAT
+set::url::deicing            svn://fcm6/CVC_svn/Deicing
+set::url::ea                 svn://fcm6/CVC_svn/EA  
+set::url::ensemble           svn://fcm6/CVC_svn/Ensemble
+set::url::gales              svn://fcm6/CVC_svn/Gales
+set::url::ifv                svn://fcm6/CVC_svn/IFV
+set::url::mogreps            svn://fcm6/CVC_svn/MOGREPS
+set::url::openroad           svn://fcm6/CVC_svn/OpenRoad
+set::url::powertable         svn://fcm6/CVC_svn/PowerTable
+set::url::qnh                svn://fcm6/CVC_svn/QNH
+
+set::trac::cvc_admin         http://fcm6/projects/CVC/browser/Admin
+set::trac::bullseye          http://fcm6/projects/CVC/browser/Bullseye
+set::trac::cat               http://fcm6/projects/CVC/browser/CAT
+set::trac::deicing           http://fcm6/projects/CVC/browser/Deicing
+set::trac::ea                http://fcm6/projects/CVC/browser/EA
+set::trac::ensemble          http://fcm6/projects/CVC/browser/Ensemble
+set::trac::gales             http://fcm6/projects/CVC/browser/Gales
+set::trac::ifv               http://fcm6/projects/CVC/browser/IFV
+set::trac::mogreps           http://fcm6/projects/CVC/browser/MOGREPS
+set::trac::openroad          http://fcm6/projects/CVC/browser/OpenRoad
+set::trac::powertable        http://fcm6/projects/CVC/browser/PowerTable
+set::trac::qnh               http://fcm6/projects/CVC/browser/QNH
+
+# DA repository
+set::url::da                 svn://fcm5/DA_svn/DA
+
+set::trac::da                http://fcm5/projects/DA/browser/DA
+
+# ENS repository
+set::url::ens                svn://fcm9/ENS_svn/ENS
+
+set::trac::ens               http://fcm9/projects/ENS/browser/ENS
+
+# FCM repository
+set::url::fcm                svn://fcm1/FCM_svn/FCM
+set::url::fcm_admin          svn://fcm1/FCM_svn/Admin
+
+set::trac::fcm               http://fcm1/projects/FCM/browser/FCM
+set::trac::fcm_admin         http://fcm1/projects/FCM/browser/Admin
+
+# FLUME repository
+set::url::flume_metadata     svn://fcm2/FLUME_svn/metadata
+
+set::trac::flume_metadata    http://fcm2/projects/FLUME/browser/metadata
+
+# GEN repository
+set::url::gen                svn://fcm1/GEN_svn/GEN
+
+set::trac::gen               http://fcm1/projects/GEN/browser/GEN
+
+# LEM repository
+set::url::lem                svn://fcm2/LEM_svn/LEM
+
+set::trac::lem               http://fcm2/projects/LEM/browser/LEM
+
+# LINK repository
+set::url::link               svn://fcm1/LINK_svn/LINK
+
+set::trac::link              http://fcm1/projects/LINK/browser/LINK
+
+# NEMO repository
+set::url::nemosys            svn://fcm3/NEMO_svn/NEMOSYS
+
+set::trac::nemosys           http://fcm3/projects/NEMO/browser/NEMOSYS
+
+# NWPWEB repository
+set::url::www_nwp            svn://fcm1/NWPWEB_svn/www_nwp
+
+set::trac::www_nwp           http://fcm1/projects/NWPWEB_svn/browser/www_nwp
+
+# obsmon repository
+set::url::obsmon_dc          svn://fcm4/obsmon_svn/DC
+set::url::obsmon_rtm         svn://fcm4/obsmon_svn/RTM
+
+set::trac::obsmon_dc         http://fcm4/projects/obsmon/browser/DC
+set::trac::obsmon_rtm        http://fcm4/projects/obsmon/browser/RTM
+
+# OCN repository
+set::url::polcoms            svn://fcm3/OCN_svn/POLCOMS
+
+set::trac::polcoms           http://fcm3/projects/OCN/browser/POLCOMS
+
+# OPFC repository
+set::url::opfc               svn://fcm9/OPFC_svn/OPFC
+
+set::trac::opfc              http://fcm9/projects/OPFC/browser/OPFC
+
+# OPS repository
+set::url::ops                svn://fcm4/OPS_svn/OPS
+set::url::ops_admin          svn://fcm4/OPS_svn/Admin
+set::url::ops_data           svn://fcm4/OPS_svn/Data
+
+set::trac::ops               http://fcm4/projects/OPS/browser/OPS
+set::trac::ops_admin         http://fcm4/projects/OPS/browser/Admin
+set::trac::ops_data          http://fcm4/projects/OPS/browser/Data
+
+# OSTIA repository
+set::url::ostia              svn://fcm3/OSTIA_svn/OSTIA
+
+set::trac::ostia             http://fcm3/projects/OSTIA/browser/OSTIA
+
+# PF repository
+set::url::pf                 svn://fcm5/PF_svn/PF
+
+set::trac::pf                http://fcm5/projects/PF/browser/PF
+
+# PostProc repository
+set::url::pp                 svn://fcm9/PostProc_svn/PostProc
+set::url::ppancil            svn://fcm9/PostProc_svn/PostProcAncil
+
+set::trac::pp                http://fcm9/projects/PostProc/browser/PostProc
+set::trac::ppancil           http://fcm9/projects/PostProc/browser/PostProcAncil
+
+# PRISM repository
+set::url::oasis4             svn://fcm2/PRISM_svn/oasis4
+
+set::trac::oasis4            http://fcm2/projects/PRISM/browser/oasis4
+
+# radarnet repository
+set::url::radarnet4          svn://fcm9/radarnet_svn/radarnet4
+
+set::trac::radarnet4         http://fcm7/projects/radarnet/browser/radarnet4
+
+# ROPP repository
+set::url::ropp_doc           svn://fcm7/ROPP_svn/ropp_doc
+set::url::ropp_src           svn://fcm7/ROPP_svn/ropp_src
+set::url::ropp_test          svn://fcm7/ROPP_svn/ropp_test
+set::url::ropp_web           svn://fcm7/ROPP_svn/ropp_web
+
+set::trac::ropp_doc          http://fcm7/projects/ROPP/browser/ropp_doc
+set::trac::ropp_src          http://fcm7/projects/ROPP/browser/ropp_src
+set::trac::ropp_test         http://fcm7/projects/ROPP/browser/ropp_test
+set::trac::ropp_web          http://fcm7/projects/ROPP/browser/ropp_web
+
+# RTTOV repository
+set::url::rttov8             svn://fcm7/RTTOV_svn/RTTOV8
+set::url::rttov9             svn://fcm7/RTTOV_svn/RTTOV9
+
+set::trac::rttov8            http://fcm7/projects/RTTOV/browser/RTTOV8
+set::trac::rttov9            http://fcm7/projects/RTTOV/browser/RTTOV9
+
+# SAUtils repository
+set::url::autoscat_global      svn://fcm7/SAUtils_svn/AUTOSCAT_Global
+set::url::autoscat_nae         svn://fcm7/SAUtils_svn/AUTOSCAT_NAE
+set::url::gpsiwv_mon           svn://fcm7/SAUtils_svn/GPSIWV_Mon
+set::url::gpsro_mon            svn://fcm7/SAUtils_svn/GPSRO_Mon
+set::url::iasi_mon             svn://fcm7/SAUtils_svn/IASI_Mon
+set::url::metstrike            svn://fcm7/SAUtils_svn/METSTRIKE
+set::url::scatwind_mon         svn://fcm7/SAUtils_svn/Scatwind_Mon
+
+set::trac::autoscat_global     http://fcm7/projects/SAUtils/browser/AUTOSCAT_Global
+set::trac::autoscat_nae        http://fcm7/projects/SAUtils/browser/AUTOSCAT_NAE
+set::trac::gpsiwv_mon          http://fcm7/projects/SAUtils/browser/GPSIWV_Mon
+set::trac::gpsro_mon           http://fcm7/projects/SAUtils/browser/GPSRO_Mon
+set::trac::iasi_mon            http://fcm7/projects/SAUtils/browser/IASI_Mon
+set::trac::metstrike           http://fcm7/projects/SAUtils/browser/METSTRIKE
+set::trac::scatwind_mon        http://fcm7/projects/SAUtils/browser/Scatwind_Mon
+
+# SBV repository
+set::url::sbv                svn://fcm6/SBV_svn/SBV
+set::url::sbv_admin          svn://fcm6/SBV_svn/Admin
+
+set::trac::sbv               http://fcm6/projects/SBV/browser/SBV
+set::trac::sbv_admin         http://fcm6/projects/SBV/browser/Admin
+
+# SCS repository
+set::url::scs                svn://fcm1/SCS_svn/SCS
+set::url::tik                svn://fcm1/SCS_svn/TIK
+set::url::tt                 svn://fcm1/SCS_svn/TT
+
+set::trac::scs               http://fcm1/projects/SCS/browser/SCS
+set::trac::tik               http://fcm1/projects/SCS/browser/TIK
+set::trac::tt                http://fcm1/projects/SCS/browser/TT
+
+# SPS repository
+set::url::sps                svn://fcm7/SPS_svn/SPS
+set::url::sps_archive        svn://fcm7/SPS_svn/Archive
+
+set::trac::sps               http://fcm7/projects/SPS/browser/SPS
+set::trac::sps_archive       http://fcm7/projects/SPS/browser/Archive
+
+# SURF repository
+set::url::surf               svn://fcm8/SURF_svn/SURF
+
+set::trac::surf              http://fcm8/projects/SURF/browser/SURF
+
+# test repository
+set::url::test               svn://fcm1/test_svn/OPS
+
+set::trac::test              http://fcm1/projects/test/browser/OPS
+
+# tutorial repository
+set::url::tutorial           svn://fcm1/tutorial_svn/tutorial
+
+set::trac::tutorial          http://fcm1/projects/tutorial/browser/tutorial
+
+# TRUI repository
+set::url::trui               svn://fcm1/TRUI_svn/TRUI
+
+set::trac::trui              http://fcm1/projects/TRUI/browser/TRUI
+
+# UM repository
+set::url::um                 svn://fcm2/UM_svn/UM
+set::url::um_admin           svn://fcm2/UM_svn/Admin
+set::url::gcom               svn://fcm2/UM_svn/GCOM
+
+set::trac::um                http://fcm2/projects/UM/browser/UM
+set::trac::um_admin          http://fcm2/projects/UM/browser/Admin
+set::trac::gcom              http://fcm2/projects/UM/browser/GCOM
+
+# UM tutorial repository
+set::url::um_tutorial        svn://fcm2/UM_TUTORIAL_svn/UM
+
+set::trac::um_tutorial       http://fcm2/projects/UM_TUTORIAL/browser/UM
+
+# VAR repository
+set::url::var                svn://fcm5/VAR_svn/VAR
+set::url::var_admin          svn://fcm5/VAR_svn/Admin
+set::url::var_data           svn://fcm5/VAR_svn/Data
+
+set::trac::var               http://fcm5/projects/VAR/browser/VAR
+set::trac::var_admin         http://fcm5/projects/VAR/browser/Admin
+set::trac::var_data          http://fcm5/projects/VAR/browser/Data
+
+# VER repository
+set::url::ver                svn://fcm6/VER_svn/VER
+set::url::ver_admin          svn://fcm6/VER_svn/Admin
+set::url::ver_archive        svn://fcm6/VER_svn/Archive
+
+set::trac::ver               http://fcm6/projects/VER/browser/VER
+set::trac::ver_admin         http://fcm6/projects/VER/browser/Admin
+set::trac::ver_archive       http://fcm6/projects/VER/browser/Archive
+
+# EOF
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/etc/fcm_gui.desktop
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/etc/fcm_gui.desktop	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/etc/fcm_gui.desktop	(revision 6412)
@@ -0,0 +1,13 @@
+[Desktop Entry]
+Comment=
+Exec=fcm gui %f
+Hidden=false
+Icon=wizard
+MimeType=inode/directory
+Name=FCM GUI
+Path=
+Terminal=0
+TerminalOptions=
+Type=Application
+X-KDE-SubstituteUID=false
+X-KDE-Username=
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Ecmwf/Fortran90_stuff.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Ecmwf/Fortran90_stuff.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Ecmwf/Fortran90_stuff.pm	(revision 6412)
@@ -0,0 +1,2736 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Ecmwf::Fortran90_stuff
+#
+# DESCRIPTION
+#   This is a module for analysing Fortran 9X code. It is used by the FCM
+#   system to generate interface blocks for Fortran 9X free source files.
+#
+# ABOUT THIS MODULE:
+#   The original version of this module was developed by the European Centre
+#   for Medium-Range Weather Forecasts (ECMWF). This version has been modified
+#   by UK Met Office to become part of the FCM system.
+# ------------------------------------------------------------------------------
+
+package Ecmwf::Fortran90_stuff;
+
+# Standard pragmas
+use strict;
+use warnings;
+
+# Standard modules
+require Exporter;
+
+our @ISA      = qw(Exporter);
+our @EXPORT   = qw(study setup_parse pre_tidy remove_macro expcont 
+                   process_include_files tidy tidy_decl getvars 
+		   find_unused_vars remove_unused_vars doctor_viol
+		   fix_doctor_viol various cont_lines f90_indent
+		   writefile readfile create_interface_block
+		   add_interface_blocks change_var_names insert_hook
+		   remake_arg_decl remove_some_comments parse_prog_unit
+		   get_calls_inc);
+
+# ------------------------------------------------------------------------------
+
+# Module variables
+
+my $fname = '';
+
+# ------------------------------------------------------------------------------
+# SYNPOSIS
+#   $file = &Ecmwf::Fortran90_stuff::fname ();
+#   &Ecmwf::Fortran90_stuff::fname ($file);
+#
+# DESCRIPTION
+#   This function returns the value in the module variable $fname, which is the
+#   name of the input Fortran source file from FCM. If an argument exists, the
+#   value of $fname is set to the value of the argument.
+#
+# ------------------------------------------------------------------------------
+
+sub fname {
+  $fname = $_[0] if @_;
+  return $fname;
+}
+
+#==========================================================================
+sub study{
+# Study statements and put attributes into array $statements
+# Attributes assigned:
+# $href->{content}       - What statement it is
+# $href->{decl}       - true if declaration,
+#                       5 means statement function
+#                       4 means USE statement,
+#                       2 means type decleration
+#                       3 means FORMAT statement
+#                       1 means the rest
+# $href->{in_contain} - true while in internal procedure(s)
+# $href->{exec}       - true if executable statement
+#                     - 2 means first executable statement in program unit
+#                     - 3 means last executable statement in program unit
+#                     - 23 means first and last executable statement in program unit
+# $href->{prog_unit}  - program unit number (numbered from 0)
+# $href->{number}     - statement number (numbered from 0)
+ 
+# Further attributes will be assigned later (action attributes)
+
+  my($statements,$prog_info) = @_;
+
+  our ($name,$nest_par);
+  my ($unit_name,@args,$prog_unit,$href,@punit,$current_punit);
+  my ($content,$decl,$exec);
+  my($type_def)=0;
+  my($unit_count)=-1;
+  @punit=();
+  $current_punit='';
+  my $number=-1;
+  my $in_contain=0;
+  my $in_interface=0;
+  my $contain_host='';
+  my $current_unit_name='';
+  our($study_called);
+#  if(! $study_called) {
+#    $$prog_info{has_interface_block}=0;
+#  }
+# Initial "parsing" loop
+
+  foreach $href (@$statements) {
+    $href->{in_contain}=$in_contain;
+    $href->{contain_host}=$contain_host if($in_contain);
+    $number++;
+    $_=$href->{statement};
+    $content='unknown';
+    my $content2='';
+    $decl=0;
+    $exec=0;
+
+    if($type_def) {
+ #     $href->{content}='typedef';
+    }
+    
+# Comment
+CRACK:    {
+      if(/^\s*(?:!|$)/) {
+	$content='comment';
+	last CRACK;
+      }
+
+      $_ = uc unless /^#/;
+      s/^\s*//;
+      s/\!.*\n/\n/g; # Remove trailing comments in all lines
+#      print "AA $_";
+ 
+# Program name statement 
+      if($content eq 'unknown' and ! $in_interface) {
+	$prog_unit=&parse_prog_unit(\$unit_name,\@args);
+	if($prog_unit) {
+          $current_unit_name=$unit_name;
+	  $content=uc($prog_unit);
+	  push(@punit,$prog_unit);
+	  $current_punit=$prog_unit;
+	  $unit_count++;
+	  if(! $study_called) {
+	    $$prog_info{'unit_name'}[$unit_count]=uc($unit_name);
+	    $$prog_info{'unit_name'}[$unit_count]=uc($unit_name);
+#	  $$prog_info{'tokens'}[$unit_count]=[];
+	    if($prog_unit eq 'module') {
+	      $$prog_info{'is_module'}=1;
+	      $$prog_info{'module_name'}=$unit_name;
+	    }
+	  }
+	  last CRACK;
+	}
+      }
+      if($content eq 'unknown') {
+	$decl=0;
+	$exec=1;
+# Executable constructs
+	&study_exec(\$content,$prog_info,\$study_called);
+	if($content eq 'IF') {
+	  s/^IF\s*$nest_par\s*//;
+	  &study_exec(\$content2,$prog_info,\$study_called);
+	}
+      }
+      
+
+      if($content eq 'unknown') {
+# Specification statemnts
+	$exec=0;
+	$decl=1;
+	if(/^USE\b/) {
+	  $content='USE';
+	  $decl=4;
+	}
+	elsif(/^INTEGER\b/) {
+	  $content='INTEGER';
+	  $decl=2;
+	}
+	elsif(/^REAL\b/) {
+	  $content='REAL';
+	  $decl=2;
+	}
+	elsif(/^LOGICAL\b/) {
+	  $content='LOGICAL';
+	  $decl=2;
+	}
+	elsif(/^CHARACTER\b/) {
+	  $content='CHARACTER';
+	  $decl=2;
+	}
+	elsif(/^DOUBLE\s*PRECISION\b/) {
+	  $content='DOUBLE PRECISION';
+	  $decl=2;
+	}
+	elsif(/^COMPLEX\b/) {
+	  $content='COMPLEX';
+	  $decl=2;
+	}
+	elsif(/^TYPE *\(/) {
+	  $content='type_decl';
+	  $decl=2;
+	}
+	elsif(/^ALLOCATABLE\b/) {
+	  $content='ALLOCATABLE';
+	}
+	elsif(/^COMMON\b/) {
+	  $content='COMMON';
+	}
+	elsif(/^DATA\b/) {
+	  $content='DATA';
+	}
+	elsif(/^DIMENSION\b/) {
+	  $content='DIMENSION';
+	}
+	elsif(/^EQUIVALENCE\b/) {
+	  $content='EQUIVALENCE';
+	}
+	elsif(/^EXTERNAL\b/) {
+	  $content='EXTERNAL';
+	}
+	elsif(/^\d+\s+FORMAT\b/) {
+	  $content='FORMAT';
+	  $decl=3;
+	}
+	elsif(/^IMPLICIT\b\s+NONE\b/) {
+	  $content='IMPLICIT NONE';
+	}
+	elsif(/^IMPLICIT\b/) {
+	  $content='IMPLICIT';
+	}
+	elsif(/^INTENT\b/) {
+	  $content='INTENT';
+	}
+	elsif(/^INTRINSIC\b/) {
+	  $content='INTRINSIC';
+	}
+	elsif(/^NAMELIST\b/) {
+	  $content='NAMELIST';
+	}
+	elsif(/^OPTIONAL\b/) {
+	  $content='OPTIONAL';
+	}
+	elsif(/^PARAMETER\b/) {
+	  $content='PARAMETER';
+          $decl = 2;
+	}
+	elsif(/^POINTER\b/) {
+	  $content='POINTER';
+	}
+	elsif(/^PUBLIC\b/) {
+	  $content='PUBLIC';
+	}
+	elsif(/^PRIVATE\b/) {
+	  $content='PRIVATE';
+	}
+	elsif(/^SAVE\b/) {
+	  $content='SAVE';
+	}
+	elsif(/^TARGET\b/) {
+	  $content='TARGET';
+	}
+	elsif(/^SEQUENCE\b/) {
+	  $content='SEQUENCE';
+	}
+	elsif(/^INTERFACE\b/) {
+	  $content='INTERFACE';
+	  if(! $study_called) {
+	    $$prog_info{has_interface_block}=1;
+	    $in_interface=1;
+	  }
+	}
+	elsif(/^END ?INTERFACE\b/) {
+	  $content='END INTERFACE';
+	    $in_interface=0;
+	}
+	elsif(/^TYPE *[^\( ]/i) {
+	  $content='type_def';
+	  $type_def=1;
+	}
+	elsif(/^END\s*TYPE\b/){
+	  $content='type_def';
+	  $type_def=0;
+	}
+        elsif( $in_interface ) {
+          if(/^MODULE PROCEDURE\b/) {
+            $content='MODULE PROCEDURE';
+          }
+        }
+      }
+# Other constructs
+      if($content eq 'unknown') {
+	$decl=0;
+	$exec=0;
+	
+	if(/^CONTAINS\b/) {
+	  $content='CONTAINS';
+	  $in_contain=1;
+          $contain_host=uc($current_unit_name);
+	  if(! $study_called) {
+	    $$prog_info{has_contain}=1;
+	    $$prog_info{containing}=1;
+	  }
+	}
+	elsif(/^(?:INCLUDE|#include)\b/) {
+	  $content='include';
+	  if(! $study_called) {
+	    $$prog_info{has_include}=1;
+	  }
+	}
+	elsif(/^\#/) {
+	  $content='cpp';
+	}
+	elsif(/^\@/) {
+	  $content='compiler_directive';
+	}
+	
+	else{
+	  if(/^END\b/ and ! $in_interface) {
+	    $prog_unit=pop(@punit);
+	    $content='END '.uc($prog_unit);
+	    if($in_contain) {
+	      unless(@punit) {
+		$unit_count=0;
+		$href->{in_contain}=0;
+		$in_contain=0;
+	      }
+	    }
+	  }
+	} 
+      }
+    }
+    
+    if($in_interface and $content ne 'INTERFACE') {
+      $content='in_interface';
+      $exec=0;
+      $decl=1;
+    }
+
+#    print "BB $unit_count $content $_";
+    if($content  eq 'unknown') {
+      print STDERR $fname, ': failed to crack statement starting at line ',
+                   $href->{first_line}, ', - syntax error?', "\n";
+      print STDERR ' ', $_, "\n";
+#      print STDERR "study_called $study_called in_interface $in_interface \n";
+#      print STDERR Dumper($statements);
+      #die "Failed in study";
+    }
+#    unless($content eq 'comment') {
+#      my @tmpvar=/\b$name\b/g;
+#      my $i=0;
+#      foreach my $tmp (@tmpvar){ 
+#	$href->{'tokens'}[$i]=$tmp;
+#	$i++;
+#	if(! $study_called and $unit_count > -1) {
+#	  $$prog_info{'token_hash'}[$unit_count]{$tmp}++;
+#	}
+#      }
+#    }
+               
+    $href->{content}=$content;
+    $href->{content2}=$content2 if($content2);
+    $href->{decl}=$decl;
+    $href->{exec}=$exec;
+#    $href->{type_decl}=$type_decl;
+    $href->{prog_unit}=$unit_count;
+    $href->{number}=$number;
+    unless($content eq 'comment') {
+      $href->{multi_line} = 1 if(tr/\n// > 1);
+    }
+  }
+
+
+# Find first executable statement in each program unit
+# Also repair statement functions wrongly assigned as executable
+  my $prev_unit_count=-2;
+  my $stat_func_suspicion=0;
+  my @lastexec=();
+
+  foreach $href (@$statements) {
+    $exec=$href->{exec};
+    $unit_count=$href->{prog_unit};
+    if($exec) {
+      if($unit_count > $prev_unit_count) {
+	$content=$href->{content};
+	if($content eq 'array_assign') {
+	  $stat_func_suspicion=1;
+	  $_=$href->{statement};
+	  if(/^\s*$name\s*\(\s*:/){
+	    $stat_func_suspicion=0;
+#	    print " A $_";
+	   } 
+	  elsif(/^\s*$name\s*\(\s*$name\s*:/){
+	    $stat_func_suspicion=0;
+#	    print " B $_";
+	  } 
+	  elsif(/^\s*$name\s*\(\s*\d+/){
+	    $stat_func_suspicion=0;
+#	    print " C $_";
+	  }
+	  else {
+	    $href->{exec}=0;
+	    $href->{decl}=5;
+	    $href->{content}='statmf';
+#	    print " D $_";
+	    next;
+	  }
+	}
+	$href->{exec}=2;
+	$prev_unit_count=$unit_count;
+	$content=$href->{content};
+      }
+      $lastexec[$unit_count]=$href->{number}  unless ($unit_count < 0);  
+# No prog_unit assigned, include file?
+    }
+  }
+
+# Assign last executable statement
+  if(@lastexec) {
+    foreach my $last (@lastexec) {
+      if(defined ($last)) {
+	if($$statements[$last]->{exec} == 1) {
+	  $$statements[$last]->{exec}=3;
+	}
+	else{
+	  $$statements[$last]->{exec}=23;
+	}      
+      }
+    }
+  }
+# Consistency checks
+  my $fail=0;
+  my $prev_exec=0;
+  $prev_unit_count=-1;
+  foreach $href (@$statements) {
+    $content=$href->{content};
+    next if($content eq 'comment');
+    $unit_count=$href->{prog_unit};
+    $exec=$href->{exec};
+    $decl=$href->{decl};
+    if($unit_count == $prev_unit_count) {
+      if($decl and $prev_exec) {
+	unless ($content eq 'FORMAT' | $content eq 'DATA' ) {
+          die $fname, ': declaration after executable statement', "\n",
+              $href->{first_line}, ' ', $href->{statement}, "\n";
+	}
+      }
+    }
+    $prev_unit_count=$unit_count;
+    $prev_exec=$exec;
+  }
+
+  $study_called=1;
+}
+
+#==========================================================================
+sub study_exec{
+  my($content,$prog_info,$study_called) = @_;
+  our ($name,$nest_par);
+  if(/^(\w+\s*:\s*)*IF\s*$nest_par\s*THEN/) {
+    $$content='IF_construct';
+  }
+  elsif(/^ELSE\s*IF\s*\(/) {
+    $$content='ELSEIF';
+  }
+  elsif(/^ELSE\b\s*($name)*/) {
+    $$content='ELSE';
+  }
+  elsif(/^END\s*IF\b\s*($name)*/) {
+    $$content='ENDIF';
+  }
+  elsif(/^(?:\d+\s+)?($name\s*:\s*)*DO(\s+WHILE)?\b/) {
+    $$content='DO';
+  }
+  elsif(/^(?:\d+\s+)?END\s*DO\b/) {
+    $$content='ENDDO';
+  }
+  elsif(/^(?:\d+\s+)?ALLOCATE\b/) {
+    $$content='ALLOCATE';
+  }
+  elsif(/^ASSIGN\b/) {
+    $$content='ASIGN';
+  }
+  elsif(/^(?:\d+\s+)?BACKSPACE\b/) {
+    $$content='BACKSPACE';
+  }
+  elsif(/^(?:\d+\s+)?CALL\b/) {
+    $$content='CALL';
+    if(!$$study_called) {
+      $$prog_info{no_calls}++;
+    }
+  }
+  elsif(/^(?:\d+\s+)?CLOSE\b/) {
+    $$content='CLOSE';
+  }
+  elsif(/^(?:\d+\s+)?CONTINUE\b/) {
+    $$content='CONTINUE';
+  }
+  elsif(/^(?:\d+\s+)?CYCLE\b/) {
+    $$content='CYCLE';
+  }
+  elsif(/^(?:\d+\s+)?DEALLOCATE\b/) {
+    $$content='DEALLOCATE';
+  }
+  elsif(/^ENDFILE\b/) {
+    $$content='ENDFILE';
+  }
+  elsif(/^(?:\d+\s+)?EXIT\b/) {
+    $$content='EXIT';
+  }
+  elsif(/^(?:\d+\s+)?GO\s*TO\b/) {
+    $$content='GOTO';
+  }
+  elsif(/^(?:\d+\s+)?IF\s*\(/) {
+    $$content='IF';
+  }
+  elsif(/^(?:\d+\s+)?INQUIRE\b/) {
+    $$content='INQUIRE';
+  }
+  elsif(/^(?:\d+\s+)?NULLIFY\b/) {
+    $$content='NULLIFY';
+  }
+  elsif(/^(?:\d+\s+)?OPEN\b/) {
+    $$content='OPEN';
+  }
+  elsif(/^(?:\d+\s+)?PAUSE\b/) {
+    $$content='PAUSE';
+  }
+  elsif(/^(?:\d+\s+)?PRINT\b/) {
+    $$content='PRINT';
+  }
+  elsif(/^(?:\d+\s+)?(?:READ|BUFFER\s*IN)\b/) {
+    $$content='READ';
+  }
+  elsif(/^(?:\d+\s+)?RETURN\b/) {
+    $$content='RETURN';
+  }
+  elsif(/^(?:\d+\s+)?REWIND\b/) {
+    $$content='REWIND';
+  }
+  elsif(/^(?:\d+\s+)?STOP\b/) {
+    $$content='STOP';
+  }
+  elsif(/^(?:\d+\s+)?(?:WRITE|BUFFER\s*OUT)\s*\(/) {
+    $$content='WRITE';
+  }
+  elsif(/^(?:\d+\s+)?($name\s*:\s*)*SELECT\s*CASE\b/) {
+    $$content='SELECT CASE';
+  }
+  elsif(/^(?:\d+\s+)?CASE\b/) {
+    $$content='CASE';
+  }
+  elsif(/^(?:\d+\s+)?END\s*SELECT\b/) {
+    $$content='END SELECT';
+  }
+  elsif(/^(?:\d+\s+)?WHERE\s*$nest_par\s*$name.*=/) {
+    $$content='WHERE';
+  }
+  elsif(/^(?:\d+\s+)?WHERE\s*\(/) {
+    $$content='WHERE_construct';
+  }
+  elsif(/^ELSE\s*WHERE\b/) {
+    $$content='ELSEWHERE';
+  }
+  elsif(/^END\s*WHERE\b/) {
+    $$content='ENDWHERE';
+  }
+  elsif(/^(?:\d+\s+)?FORALL\s*\(/) {
+    $$content='FORALL';
+  }
+  elsif(/^END\s*FORALL\b/) {
+    $$content='ENDFORALL';
+  }
+  elsif(/^(?:\d+\s+)?$name(?:\s*%\s*$name)*\s*=/o) {
+    $$content='scal_assign';
+  }
+  elsif(/^(?:\d+\s+)?$name(?:\s*$nest_par)*(?:\s*%\s*$name(?:\s*$nest_par)?)*\s*=/o) {
+    $$content='array_assign';
+  }
+}
+#===================================================================================
+sub pre_tidy {
+
+# Initial tidying to make the rest work
+
+  my($lines)=@_;
+  foreach (@$lines) {
+
+# Substitute tab with four blanks
+    s/\t/    /g;
+    s/^ *INTEGER /INTEGER_M /i;
+    s/^ *REAL /REAL_B /i;
+  }
+}
+#==========================================================================
+sub remove_macro {
+
+# Remove INTEGER_M, _ONE_ etc. macros and replace by expanded statement
+
+  my($lines)=@_;
+
+  my($im)=1; # Until I start checking include files
+  my($ia)=0;
+  my($ib)=0;
+  my($rb)=1; # Until I start checking include files
+  my($is)=0;
+  my($rh)=0;
+  my($rm)=0;
+  my(@pars,$string);
+  for (@$lines) {
+    next if(/^ *$/ | /^ *!/);
+# The following two substitutions should be restored at end of processing
+    s/(\'[^!]*)!+(.*\')/$1\£$2/;   # Protect against mischief 
+    s/(["][^!]*)!+(.*["])/$1\£$2/;      # Protect against mischief
+    $im=$im+/JPIM\b/i unless($im);
+    $rb=$rb+/JPRB\b/i unless($rb);
+    $rm=$rm+/JPRM\b/i unless($rm);
+    $im=$im+s/\bINTEGER_M\b/INTEGER(KIND=JPIM)/o;
+    $ia=$ia+s/\bINTEGER_A\b/INTEGER(KIND=JPIA)/o;
+    $ib=$ib+s/\bINTEGER_B\b/INTEGER(KIND=JPIB)/o;
+    $is=$is+s/\bINTEGER_S\b/INTEGER(KIND=JPIS)/o;
+    $rb=$rb+s/\bREAL_B\b/REAL(KIND=JPRB)/o;
+    $rh=$rh+s/\bREAL_H\b/REAL(KIND=JPRH)/o;
+    $rm=$rm+s/\bREAL_M\b/REAL(KIND=JPRM)/o;
+    $rb=$rb+s/\b_ZERO_\b/0.0_JPRB/og;
+    $rb=$rb+s/\b_ONE_\b/1.0_JPRB/og;
+    $rb=$rb+s/\b_TWO_\b/2.0_JPRB/og;
+    $rb=$rb+s/\b_HALF_\b/0.5_JPRB/og;
+  }
+  @pars=();
+  push(@pars,"JPIM") if $im;
+  push(@pars,"JPRB") if $rb;
+  push(@pars,"JPRM") if $rm;
+  push(@pars,"JPIA") if $ia;
+  push(@pars,"JPIB") if $ib;
+  push(@pars,"JPIS") if $is;
+  ($string=join('     ,',@pars))=~s/ *$//;
+  for (@$lines) {
+    next unless (/^\#/);
+    if(@pars) {
+      s/^#include +"tsmbkind.h"/USE PARKIND1  ,ONLY : $string/ ;
+    }
+    else {
+      s/^#include +"tsmbkind.h"//;
+    }
+#    if($rh) {
+      s/^#include +"hugekind.h"/USE PARKIND2  ,ONLY : JPRH/ ;
+#    }
+#    else {
+#      s/^#include +"hugekind.h"// ;
+#    }
+  }
+}
+
+#==========================================================================
+sub readfile  {
+# Read file 
+  my($fname)=@_;
+  my(@lines);
+  if(!open(INFIL,$fname)) {
+    print STDERR "Can't open $fname for reading\n";
+    die("Can't open $fname for reading\n");
+  }
+  @lines=<INFIL>;
+  close INFIL;
+  (@lines);
+}
+
+#==========================================================================
+sub writefile  {
+# Write file
+  my($fname,$lines)=@_;
+  if(!open(OUTFIL,">".$fname)) {
+    print STDERR "Can't open $fname for writing\n";
+    exit;
+  }
+  print OUTFIL @$lines;
+  close OUTFIL;
+}
+
+#==========================================================================
+sub expcont {
+#
+# Expand continuation lines into statements for free-format Fortran while
+# maintaining line-breaking and all comments
+# Put statements onto array of references to anonymous hashes as key 'statement'
+# Also put into the hash the linenumber of first line of statement as key 'first_line'
+  my ($lines, $statements) = @_;
+  my ($statm, $first_line);
+
+  my $prev        = 0;
+  my $line_number = 0;
+
+  for (@$lines) {
+    $line_number++;
+
+    s/^([^'"]*)(?:\s*!.*)$/$1/; # Remove trailing comments
+
+    s/^(\s*)&(.*)$/$1$2/s;
+
+    if (!/^\s*!.*$/ && /^.+?&(?:\s*!.*)*\s*$/) {
+      s/(.+?)&(.+)/$1\n/s;
+
+      $statm     .= $_;
+      $first_line = $line_number unless $prev;
+      $prev       = 1;
+      next;
+
+    } elsif ($prev && /^\s*(?:!|$)/) { # ignore blank/comment lines
+      next;
+
+    } else {
+      s/!.*?$//;
+
+      $statm     .= $_;
+      push @$statements, {
+        'statement'  => $statm,
+        'first_line' => $prev ? $first_line : $line_number,
+      };
+
+      $statm = "";
+      $prev  = 0;
+    }
+  }
+}
+#==========================================================================
+
+sub cont_lines {
+#
+# Put back continuation character in correct place and execute delayed actions
+#
+  my($statements,$lines,$line_hash) = @_;
+  my(@temp,$i,$iup,$href);
+
+
+# Put back continuation characters and split statements into lines as they were
+  @$lines=();
+  @$line_hash=();
+  foreach $href (@$statements) {
+    $_=$href->{statement};
+    if (/\n.*\n/){                      # This is a multi-line statement
+      @temp=split /\n/;                 # Split statement into lines (removes EOL)
+      $iup=scalar(@temp);               # Number of lines in statement
+      for ($i=0;$i < $iup;$i++) {       # Loop through lines
+	$_=$temp[$i];
+	if($i == 0 ){                   # First line
+	  if(/^([^!]+)(!.*)$/) {        # Line has trailing comment
+	    s/^([^!]+)(!.*)$/$1&$2\n/;  # Put back & at end of line before comment
+	  }
+	  else {                        # No trailing comment
+	    s/^([^!]+)$/$1&\n/;         # Put back & and EOL at end of line
+	  }	    
+	}
+	elsif ($i == ($iup-1)) {        # Last line
+	  s/^( *)(.*)$/$1& $2 \n/;      # Put back & at beginning of line
+	}
+	else {                          # Other lines
+	  if (/^ *!/) {                 # Line is comment line
+	    $_=$_."\n";                 # Restore EOL for comments
+	  }
+	  else {
+	    if(/^( *)([^!]*)(!.*)$/) {  # Line has trailing comment
+	      s/^( *)([^!]*)(!.*)*$/$1& $2&$3\n/;  # & at beginning and end of line
+	    }
+	    else {                      # No trailing comment
+	      s/^( *)([^!]*)$/$1& $2&\n/; # & at beggining and end of line
+	    }	 
+	  }  
+	}
+	if($i == 0        && exists $href->{pre_insert}) {
+	  my @templines=split('\n',$href->{pre_insert});
+	  foreach my $tline (@templines) {
+	    my $rec={};
+	    $rec->{'content'}='unknown';
+	    $rec->{'line'}=$tline."\n";
+	    push(@$lines,$rec->{'line'});
+	    push(@$line_hash,$rec);
+	  }
+	}
+	unless(exists $href->{remove}) {
+	  my $rec={};
+	  $rec->{'line'}=$_;
+	  if($i == 0) {
+	    $rec->{'content'}=$href->{content};
+	  }
+	  else {
+	    $rec->{'content'}='cont_line';
+	  }
+	  push(@$lines,$rec->{'line'});
+	  push(@$line_hash,$rec);
+	}
+	if($i == ($iup-1) && exists $href->{post_insert}) {
+	  my @templines=split('\n',$href->{post_insert});
+	  foreach my $tline (@templines) {
+	    my $rec={};
+	    $rec->{'content'}='unknown';
+	    $rec->{'line'}=$tline."\n";
+	    push(@$lines,$rec->{'line'});
+	    push(@$line_hash,$rec);
+	  }
+	}
+      }
+    }
+    else {  # Not multiline statement
+      if(exists $href->{pre_insert}) {
+	my @templines=split('\n',$href->{pre_insert});
+	foreach my $tline (@templines) {
+	  my $rec={};
+	  $rec->{'content'}='unknown';
+	  $rec->{'line'}=$tline."\n";
+	  push(@$lines,$rec->{'line'});
+	  push(@$line_hash,$rec);
+	}
+      }
+      unless(exists $href->{remove}) {
+	my $rec={};
+	$rec->{'line'}=$_;
+	$rec->{'content'}=$href->{content};
+	push(@$lines,$rec->{'line'});
+	push(@$line_hash,$rec);
+#	print $rec;
+      }
+      if(exists $href->{post_insert}) {
+	my @templines=split('\n',$href->{post_insert});
+	foreach my $tline (@templines) {
+	  my $rec={};
+	  $rec->{'content'}='unknown';
+	  $rec->{'line'}=$tline."\n";
+	  push(@$lines,$rec->{'line'});
+	  push(@$line_hash,$rec);
+	}
+      }
+    }
+  }
+}
+#==========================================================================
+sub getvars {
+# Return list of locally declared variables with type and scope information
+# 
+  my($statements,$prog_info,$vars,$use_vars) = @_;
+  my ($test,$type,@vars1,$func,$prog_unit,$dum,$tmp_name,@pu_args);
+  my ($preserve,$rank,$href);
+  our($nest_par,$name);
+
+  %$vars=();
+  $func="";
+  $prog_unit=0;
+  %$use_vars=();
+  foreach $href (@$statements) {
+    next if($href->{content} eq 'comment');           # Skip comments
+    next if($href->{exec});                        # Don't look in executable statements
+    next if($$prog_info{is_module} and ! $href->{in_contain}); # Unless inside CONTAIN skip module 
+    $prog_unit=$href->{prog_unit};
+    if($href->{content} eq 'FUNCTION') {
+      $_=$href->{statement};
+      my $dum=&parse_prog_unit(\$func,\@pu_args);          # Get name of FUNCTION
+#      print "GETVARS FUNCTION $func \n";
+      $func=uc($func);
+    }
+    if($href->{decl} == 2 or $href->{content} eq 'EXTERNAL'){  # Real parse starts
+      $_=$href->{statement};
+      $_=uc($_);                                   # Upcase to avoid /.../i
+      s/^ *//;                                     # remove leading blanks
+      if($href->{decl} == 2) {
+	$type=lc(substr($href->{content},0,1));
+      }
+      else {
+	$type='e';
+      }
+      s/\!.*\n/\n/g;                               # Remove trailing comments in all lines
+      $preserve=$_;
+      s/(.+)::(.+)/$2/s;                           #REAL(KIND=JPRB) :: zsig(:) -> zsig(:),
+      s/^EXTERNAL (.+)$/$1/;
+      s/\s+//g;                                    # Remove all white-space
+      if($href->{content} eq 'CHARACTER') {
+	s/($name)\*\d+/$1/g;
+	s/($name)\*$nest_par/$1/g;
+	s/($name)$nest_par\*\w+/$1/g;
+      }
+      s#=\(/.+/\)##;      # ZVAL(1:2)=(/1.0,2.0/) -> ZVAL(1:2)
+#?      s/=[^,\n]+//g;
+      s/$nest_par//g;     # ISEC3(SIZE(NSEC3)),ISEC4(SIZE(NSEC4)) -> ISEC3,ISEC4
+      s/=\w+//g;          # ZVAL=1.0 -> ZVAL
+      s@/.*/@@;           # What?
+      @vars1=split(',',$_);
+      for(@vars1) {
+	next unless /^$name$/;          # A bit of security
+	if($preserve =~ /\b$_\b *\(/ | $preserve =~ /DIMENSION/) {
+	  $rank=1;        # Variable is array
+	}
+	else {
+	  $rank=0;        # Variable is scalar
+	}
+	if($_ eq $func) {
+	  $$vars{$_}{type_spec}="f";
+	} 
+	else {
+	  if($href->{content} eq 'FUNCTION') {
+	    $$vars{$_}{type_spec}='f';
+	  }
+	  else {
+	    $$vars{$_}{type_spec}=$type;
+	  }
+	}
+	$$vars{$_}{scope}=$prog_unit;
+	$$vars{$_}{rank}=$rank;
+	$$vars{$_}{usage}='local';
+      }
+    }
+# Perhaps the variable is really a statement function?
+    if($href->{decl} == 5) {
+      $_=$href->{statement};
+      s/\s+//g;                                    # Remove all white-space
+      /^($name)\((.+)\)=/i;
+      my $tvar=uc($1);
+      my @stmf_args=split(',',$2);
+      if (exists($$vars{$tvar})) {
+	$$vars{$tvar}{type_spec}='s';
+#	print "STATMF OK $tvar \n ";
+      }
+      for (@stmf_args) {
+	if (exists($$vars{$_})) {
+	  $$vars{$_}{type_spec}='s';
+#	  print "STATMF ARG OK $_ \n ";
+	}
+      }
+    }
+  }
+# Perhaps instead the variable is a declaration of an external function?
+  my @extract=();                  # Extract part of statements for efficiency
+  foreach $href (@$statements) {
+    if($href->{exec}) {                 # Function call must be in executable stat.
+      next if($href->{content} eq 'CALL'); # A call can't contain an undeclared function
+      push(@extract,$href->{statement});
+    }
+  }
+  
+  foreach my $var (keys (%$vars)) {
+    next if($$vars{$var}{rank} > 0);   # Can't be a function if rank > 0
+    next if($$vars{$var}{type_spec} eq 's' | $$vars{$var}{type_spec} eq 'f');
+    my $dec_unit=$$vars{$var}{scope};
+    my $regex1=qr/\b$var\b\s*\(/i;      # As var's rank=0 this could be function call
+    for(@extract) {
+      if(/${regex1}/) {
+	s/\!.*\n/\n/g;                       # Remove trailing comments in all lines
+	s/\s+//g;                            # Remove all white-space
+	if(/${regex1}/) {
+	  if($$vars{$var}{type_spec} eq 'c') {   # Avoid CLVAR(1:3) etc.
+	    next if(/${regex1}\s*(\d+|$name)*\s*:\s*(\d+|$name)*\s*\)/);
+	  }
+#	  print "TYPE changed to function $var $_ \n";
+	  $$vars{$var}{type_spec}='f';
+	  last;
+	}
+      }
+    }
+  }
+# ---------------------------------------------------------------------
+# Assign  "usage" in Doctor sense to variable (default usage is 'local')
+# 
+  foreach $href (@$statements) {
+# Is the varaible a dummy argument
+    if($href->{content} eq 'FUNCTION' or $href->{content} eq 'SUBROUTINE') {
+      $_=$href->{statement};
+      @pu_args=();
+      my $dum=&parse_prog_unit(\$func,\@pu_args);   # Get arguments
+      for(@pu_args) {
+	if( exists $$vars{$_} ) {
+	  if($$vars{$_}{scope} == $href->{prog_unit}) {
+	    $$vars{$_}{usage}='arg';
+	  }
+
+	} else {
+          print STDERR "Argument $_ has not got a corresponding declaration " .
+                       "statement\n";
+          print STDERR "Bailing out at this point\n";
+          die "Bailing out";
+	}
+      }
+    }
+# Does the variable appear in a NAMELIST
+# We want to distinguish this for more lenient Doctor check
+    if($href->{content} eq 'NAMELIST') {
+      $_=$href->{statement};
+      s/\!.*\n/\n/g;     # Remove trailing comments in all lines
+      s/\s+//g;          # Remove all white-space
+      m:NAMELIST/\w+/(.+):;
+      my @namvars=split(',',uc($1));
+      for (@namvars) {
+	if( exists $$vars{$_} ) {
+	  if($$vars{$_}{scope} == $href->{prog_unit}) {
+	    $$vars{$_}{usage}='namvar';
+	  }
+	}
+      }
+    }
+    if(exists $href->{inc_statm}) { # We also have to look in include files
+      my $incs=$href->{inc_statm};
+      foreach my $hrefi (@$incs) {
+	if($hrefi->{content} eq 'NAMELIST') {
+	  $_=$hrefi->{statement};
+	  s/\!.*\n/\n/g;     # Remove trailing comments in all lines
+	  s/\s+//g;          # Remove all white-space
+	m:NAMELIST/\w+/(.+):;
+	  my @namvars=split(',',uc($1));
+	  for (@namvars) {
+	    if( exists $$vars{$_} ) {
+	      if($$vars{$_}{scope} == $href->{prog_unit}) {
+		$$vars{$_}{usage}='namvar';
+	      }
+	    }
+	  }
+	}
+      }
+    }
+  }
+# -----------------------------------------------------------------------------
+# Find use variables
+  my %use_count=();
+  foreach $href (@$statements) {
+    if($href->{content} eq 'USE') {
+      $prog_unit=$href->{prog_unit};
+      $_=$href->{statement};
+      s/\!.*\n/\n/g;                               # Remove trailing comments in all lines
+      s/\s+//g;                                    # Remove all white-space
+      $_=uc($_);                                   # Upcase to avoid /.../i
+      if(/^USE($name),ONLY:(.+)$/){
+	my $modname=$1;
+	if( exists $use_count{$modname}) {
+	  if($prog_unit == $use_count{$modname}) {
+	    print STDERR "-> $href->{statement}";
+            print STDERR "USE $modname appears more than once in program unit $prog_unit \n\n";
+
+	  }
+	}
+	$use_count{$modname} = $prog_unit;
+	my @usevars = split /,/ ,$2;
+	my %usevars=();
+	foreach my $usevar (@usevars) {
+	  $usevars{$usevar}++;
+	  $$use_vars{$usevar}{module}=$modname;
+	  $$use_vars{$usevar}{scope}=$prog_unit;
+	  $$use_vars{$usevar}{count}++;
+	}
+	foreach my $usevar (keys (%usevars)) {
+	  if($usevars{$usevar} >1) {
+	    print STDERR "DUPLICATE USE ONLY VARIABLE ",
+	    "$modname $usevar $prog_unit \n";
+	    $_=$href->{statement};
+	    s/\b$usevar\b//i;
+	    s/,\s*,/,/;
+	    s/,\s*\n$/\n/;
+	    s/\n *\n/\n/;
+	    s/^(.+:\s*),/$1/;
+	    $href->{statement}=$_;
+	  }
+	}
+      }
+      else {
+#	print "WARNING:USE without ONLY \n";
+      }
+    }
+  }
+}
+#==========================================================================
+sub find_unused_vars {
+# Find declared variables not used
+  my($statements,$vars,$unused_vars,$use_vars,$unused_use_vars) = @_;
+  my ($var,@tokens,$href);
+  @tokens=();
+# Find all tokens in file
+  foreach $href (@$statements) {
+    next if($href->{content} eq 'comment');
+    if(exists $href->{inc_statm}) {  # Look also in include files
+      my $incs=$href->{inc_statm};
+      foreach my $hrefi (@$incs) {
+	die "FUV $href->{content} $href->{statement}" unless exists $hrefi->{statement};
+	$_=$hrefi->{statement};
+	if(/\b[a-zA-Z]\w*\b/) {
+	  push(@tokens,/\b[a-zA-Z]\w*\b/g);
+	}
+      }
+    }
+    else {
+      $_=$href->{statement};
+      push(@tokens,/\b[a-zA-Z]\w*\b/g);
+    }
+  }
+  @tokens= map {uc} @tokens; # Upcase array of tokens, the variables are upper-case
+
+# Find out how many times the variable appears in array tokens
+  foreach $var (keys (%$vars)) {
+    $$vars{$var}{uses}=0;
+  }
+  foreach $var (keys (%$use_vars)) {
+    $$use_vars{$var}{uses}=0;
+  }
+  for (@tokens) {
+    if(exists($$vars{$_})){
+      $$vars{$_}{uses}++; 
+    }
+    if(exists($$use_vars{$_})){
+      $$use_vars{$_}{uses}++; 
+    }
+  }
+# If it appears only one time (which must be in a declaration) it is unused
+  @$unused_vars=();
+  foreach $var (keys (%$vars)) {
+    push(@$unused_vars,$var) if($$vars{$var}{uses} < 2);
+  }
+  @$unused_use_vars=();
+  foreach $var (keys (%$use_vars)) {
+    push(@$unused_use_vars,$var) if($$use_vars{$var}{uses} < 2);
+  }
+}
+#==========================================================================
+sub remove_unused_vars {
+# Does what it says on the tin
+  my($statements,$unused_vars,$unused_use_vars) = @_;
+  my ($var,$href);
+  our $nest_par;
+  for (@$unused_vars) {
+    $var=$_;
+    foreach $href (@$statements) {
+      $_=$href->{statement};
+      next unless(($href->{decl}) | ($href->{content} eq 'comment'));
+      if($href->{content} eq 'comment') {
+	next unless(/^ *!\$OMP/);
+      }
+      if(/\b$var\b/i) {
+#	print $_;
+	
+	if(/\b$var\b *\(/i) {
+#	  print "ZYZ $var $_";
+	  s/\b$var\b *$nest_par *(=\s*\(\/.*\/\))*//si;
+#	  print "ZZZ $var $_";
+	}
+	s/\b$var\b\s*=\s*\d+(\.\d*)*//i;
+	s/\b$var\b *(\* *\d+)*//i if($href->{content} eq 'CHARACTER') ;
+	s/\b$var\b//i; 
+#	print $_;
+        s/^.+:: *\n$//;
+        s/^.+:: *\!.*\n$//;
+#	print $_;
+        s/,\s*,/,/;
+#	print $_;
+	s/, *\n$/\n/;
+#	print $_;
+        s/(::\s*),(.+)$/$1$2/s;
+        s/\n *\n/\n/;
+        s/\n *!.*\n/\n/;
+	s/, *\n$/\n/;
+# Remove "empty" lines
+        s/^.+::\s*$//;
+        s/^.+::\s*=.*$//;
+        s/^.+::\s*!.*$//;
+#	print $_;
+        s/^CHARACTER *\*\d+ *\n$//i if($href->{content} eq 'CHARACTER') ;
+	$href->{statement}=$_;
+      }
+    }
+  }
+  for (@$unused_use_vars) {
+    $var=$_;
+    foreach $href (@$statements) {
+      next unless($href->{decl} == 4);
+      $_=$href->{statement};
+      next if(/PARKIND/); #I am sure this could be done betterh
+
+      if(/\b$var\b/i) {
+	s/\b$var\b//i;
+        s/,\s*,/,/;
+        s/,\s*\n$/\n/;
+        s/\n *\n/\n/;
+	s/^(.+:\s*),/$1/;
+	s/^.+:\s*$//;
+	$href->{statement}=$_;
+      }
+    }
+  }
+}
+#==========================================================================
+sub tidy_decl {
+# Tidy up declarions
+  my($statements) = @_;
+  my($href,$content);
+
+  foreach $href (@$statements) {
+    next unless($href->{decl} == 2);
+    $_=$href->{statement};
+    $content=$href->{content};
+    
+    if($content eq 'CHARACTER') {
+      s/CHARACTER *\* *(\w+)/CHARACTER \(LEN = $1\)/i; 
+      s/CHARACTER *\* *\(\*\)/CHARACTER \(LEN = \*\)/i;
+      s/CHARACTER *\* *\( *(\w+) *\)/CHARACTER \(LEN = $1)/i;
+    }
+    if($content eq 'INTEGER') {
+      if(/^ *INTEGER[^\(]/i) {
+	s/INTEGER\b/INTEGER(KIND=JPIM)/;
+      }
+    }
+    unless (/::/) {
+      s/^( *LOGICAL )/$1:: /i;
+      s/^( *INTEGER\(KIND=JPI\w\) )/$1:: /;
+      s/^( *REAL\(KIND=JPR\w\) )/$1:: /;
+      if(/^ *CHARACTER/i) {
+	if( s/^( *CHARACTER *\( *LEN *= *\w+ *\))/$1 :: /i) {
+	  $href->{statement}=$_;
+	  next;
+	}
+	if(s/^( *CHARACTER *\( *LEN *= *\* *\))/$1 :: /i) {
+	  $href->{statement}=$_;
+	  next;
+	}
+	s/^( *CHARACTER )/$1:: /i;
+      }
+    }
+    $href->{statement}=$_;
+  }
+}
+#==========================================================================
+
+sub doctor_viol {
+# Find Doctor violations
+
+  my($vars,$fix_doc) = @_;
+  my ($var,$type,$zz,$prog_unit,$usage);
+  %$fix_doc=();
+
+  foreach $var (keys (%$vars)) {
+    $type=$$vars{$var}{type_spec};
+    $prog_unit=$$vars{$var}{scope};
+    $usage=$$vars{$var}{usage};
+#    print "DOC $var $type $prog_unit $usage \n";
+    if($zz=&doc_char($type,$usage,$var)) {
+#      print "DOCTOR VIOL - ",$var," $type $zz $prog_unit\n";
+      $$fix_doc{$var}=$zz.'_'.$var.','.$prog_unit
+    }
+  }  
+}
+#==========================================================================
+
+sub fix_doctor_viol {
+# Fix Doctor violations
+  my($statements,$fix_doc) = @_;
+  my($doc_viol,$repl,$prog_unit,$cur_prog_unit,@allowed,$href,$content);
+  my($tmp_name,@pu_args);
+
+  @allowed=('NRGRI'); # Hack
+
+  VIOL:foreach $doc_viol (keys (%$fix_doc)) {
+    # Let's allow some violations
+    for (@allowed){ 
+      next VIOL if($doc_viol eq $_);
+    }
+
+    ($repl,$prog_unit)=split(',',$$fix_doc{$doc_viol});
+
+    print "FIX $repl $prog_unit \n";
+    foreach $href (@$statements) {
+      $content=$href->{content};
+      $_=$href->{statement};
+      if($href->{content} eq 'comment') {
+	next unless(/^ *!\$OMP/);
+      }
+      $cur_prog_unit=$href->{prog_unit};
+      if($prog_unit == $cur_prog_unit) {  # Could be fine in other program units
+	if(/\b$doc_viol\b/i) {
+	  s/%$doc_viol\b/_X_$doc_viol/ig; # Protect type-components
+	  s/\b$doc_viol\b/$repl/ig;
+	  s/_X_$doc_viol\b/%$doc_viol/ig; # Restore type-components
+	}
+      }
+      $href->{statement}=$_;
+    }
+  }
+  
+}
+#==========================================================================
+sub various{
+# 
+  my($statements,$prog_info,$vars) = @_;
+  my($punit,@args,$tmp_name,$cont,$statm);
+  my($href,$exec);
+  our $nest_par;
+#------------------------------------------------------------------
+# Remove unneccesary RETURN statement
+  foreach $href (@$statements) {
+    $cont=$href->{content};
+    if($cont eq 'RETURN') {
+      if($href->{exec} == 3) {   # $href->{exec} == 3 means last executable statement
+	$href->{remove} = 1;     # Post remove line for later
+      }
+    }
+  }
+
+
+# Make sure all CALL MPL_... has a CDSTRING argument
+  foreach $href (@$statements) {
+    $cont=$href->{content};
+    if($href->{content} eq 'CALL' ) {
+      $_=$href->{statement};
+      if(/^\s*CALL\s+MPL_/i) {
+	next if(/^\s*CALL\s+MPL_ABORT/i);
+	next if(/^\s*CALL\s+MPL_WRITE/i);
+	next if(/^\s*CALL\s+MPL_READ/i);
+	next if(/^\s*CALL\s+MPL_OPEN/i);
+	next if(/^\s*CALL\s+MPL_CLOSE/i);
+	next if(/^\s*CALL\s+MPL_INIT/i);
+	next if(/^\s*CALL\s+MPL_GROUPS_CREATE/i);
+	next if(/^\s*CALL\s+MPL_BUFFER_METHOD/i);
+	next if(/^\s*CALL\s+MPL_IOINIT/i);
+	next if(/^\s*CALL\s+MPL_CART_COORD/i);
+#	print "CDSTRING=$$prog_info{'unit_name'}[$href->{prog_unit}]: \n";
+	unless(/CDSTRING\s*=/i) {
+	  s/\)(\s)$/,CDSTRING=\'$$prog_info{'unit_name'}[$href->{prog_unit}]:\'\)$1/;
+	  $href->{statement}=$_;
+	}
+      }
+    }
+  }
+	
+
+
+#------------------------------------------------------------------
+# Add Standard Modification Line
+
+  my $start=0;
+  foreach $href (@$statements) {
+    $cont=$href->{content};
+    if($cont eq 'comment') {
+      $_=$href->{statement};
+      if($start) {                        # Found header - look for end of mod lines
+	if(/^ *$/ || /^! *------------------------/) {
+	  $href->{pre_insert} = "!        M.Hamrud      01-Oct-2003 CY28 Cleaning\n";
+	  last;
+	}
+	next;
+      }
+      $start=1 if(/^! +Modifications/i) ;  # This how the header should look
+      next;
+    }
+    last if($href->{exec});                # We have failed - bail out
+  }
+
+# Change subroutine and call multi-line statements so that the comma
+# beetwen variables comes at the end of the line
+  my @lines=();
+  foreach $href (@$statements) {
+    if(exists $href->{multi_line}) {
+      $cont=$href->{content};
+      if($cont eq 'SUBROUTINE' | $cont eq 'CALL' ) {
+	$statm=$href->{statement};
+	@lines=split "\n", $statm;
+	@lines = reverse @lines;
+	my $append_comma=0;
+	for (@lines) {
+#	  print "A $append_comma $_ \n";
+	  next if(/^ *!/);
+	  if($append_comma) {
+	    if(/\S *!.*$/) {
+	      s/(\S)( *!.*)$/$1,$2/;
+	    }
+	    else {
+	      s/(\S) *$/$1,/;
+	    }
+	  }
+	  $append_comma=s/^ *,//;
+#	  print "B $append_comma $_ \n";
+	}
+	@lines = reverse @lines;
+	$statm=join  "\n",@lines;
+	$statm=$statm."\n";
+	$href->{statement}=$statm;
+      }
+    }
+  }
+  our $name;
+  foreach $href (@$statements) {
+    if($href->{content} eq 'USE') {
+      $_=$href->{statement};
+      unless(/^\s*USE\s+$name\s*,\s*ONLY\s*:/i){
+	print $_;
+	print "WARNING:USE without ONLY \n";
+      }
+    }
+  }    
+}
+#==========================================================================
+sub insert_hook{
+# 
+  my($statements,$prog_info,$vars) = @_;
+  my($punit,@args,$tmp_name,$cont,$statm);
+  my($href,$exec);
+  our $nest_par;
+#------------------------------------------------------------------
+# Add HOOK function
+  my $unit_name='';
+  my $last_use=0;
+  my $hook_status=0;
+  my $in_contain=0;
+  my $prev_prog=0;
+  my ($decl,$remember);
+  foreach $href (@$statements) {
+    $cont=$href->{content};
+    next if($cont eq 'comment');
+
+    $decl=$href->{decl};
+    $exec=$href->{exec};
+    $in_contain=$href->{in_contain};
+    if(! $in_contain and $href->{prog_unit} > $prev_prog) {
+      $hook_status=0;
+      $prev_prog=$href->{prog_unit};
+      print "resetting hook status \n";
+    }
+
+    if($cont eq 'FUNCTION' or $cont eq 'SUBROUTINE' or 
+       $cont eq 'PROGRAM'){ # Need name of routine
+      $_=$href->{statement};
+      &parse_prog_unit(\$unit_name,\@args);
+      $unit_name=uc($unit_name);
+# If in module pre-pend module name
+      $unit_name=$$prog_info{module_name}.':'.$unit_name if($$prog_info{is_module}); 
+      $remember=0;
+    }
+
+    if($hook_status == 0) {   # $hook_status == 0 means we have not done anything yet
+      if($cont eq 'USE') {    # Add USE YOMHOOK as second use statement
+	$href->{post_insert}="USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\n";
+	$hook_status=1;
+      }
+      elsif($cont eq 'IMPLICIT NONE') { # No previous USE, add USE YOMHOOK before IMPLICIT NONE
+	$href->{pre_insert} ="USE PARKIND1  ,ONLY : JPRB\n".
+	  "USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\n";
+	$hook_status=1;
+      } 
+    }
+    $remember=$href->{number} if($decl == 2); 
+
+#   Use statement added ($hook_status == 1), now insert HOOK switch on statement
+#   before first executable statement in program unit ($exec == 2)
+    if($hook_status == 1 && $exec == 2) {
+      if($remember) {
+	$$statements[$remember]->{post_insert}="REAL(KIND=JPRB) :: ZHOOK_HANDLE\n";
+	$href->{pre_insert}="IF (LHOOK) CALL DR_HOOK(\'${unit_name}\',0,ZHOOK_HANDLE)\n";
+      }
+      else {
+	$href->{pre_insert}="REAL(KIND=JPRB) :: ZHOOK_HANDLE\n".
+	    "IF (LHOOK) CALL DR_HOOK(\'${unit_name}\',0,ZHOOK_HANDLE)\n";
+      }   
+      if($cont eq 'IF') {
+	if($href->{content2} eq 'RETURN') {
+	  $_=$href->{statement};
+	  s/(\s*IF\s*$nest_par).*\n/$1/i;
+	  s/\)$/ .AND. LHOOK\)/;
+	  $href->{pre_insert}=$href->{pre_insert}."$_ CALL DR_HOOK(\'${unit_name}\',1,ZHOOK_HANDLE)\n";
+	}
+      }
+      $hook_status=2;
+    }
+#   Hook switched on($hook_status == 2), switch off after last executable statement
+#   ($exec == 3)
+    elsif($hook_status == 2) {
+      if($exec == 3 or $exec == 23) {
+	$href->{post_insert}="IF (LHOOK) CALL DR_HOOK(\'${unit_name}\',1,ZHOOK_HANDLE)\n";
+	$hook_status=3;
+      }
+      elsif($cont eq 'RETURN') {
+	$href->{pre_insert}="IF (LHOOK) CALL DR_HOOK(\'${unit_name}\',1,ZHOOK_HANDLE)\n";
+      }
+      elsif($cont eq 'IF') {
+	if($href->{content2} eq 'RETURN') {
+	  $_=$href->{statement};
+	  s/(\s*IF\s*$nest_par).*\n/$1/i;
+	  s/\)$/ .AND. LHOOK\)/;
+	  $href->{pre_insert}="$_ CALL DR_HOOK(\'${unit_name}\',1,ZHOOK_HANDLE)\n";
+	}
+      }	
+    }
+    $hook_status=1 if($in_contain && $hook_status==3); # Reset hook status in CONTAIN region
+  }
+  die "Adding HOOK function failed " if($hook_status == 2);
+}
+#==========================================================================
+
+sub doc_char{
+# Returns suggested prefix in case of DOCTOR violation (otherwise null string)
+  my($type,$usage,$var) = @_;
+  my $prefix="";
+# INTEGER variables
+  if( $type eq "i") {
+    if($usage eq "arg") {
+      $prefix="K" unless($var=~/^K/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="I" unless($var=~/^[IJ]/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="N" unless($var=~/^[MN]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="I" unless($var=~/^[MNIJ]/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+# REAL variables
+  elsif( $type eq "r") {
+    if($usage eq "arg") {
+      $prefix="P" unless($var=~/^P/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="Z" unless($var=~/^Z|^PP/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="R" if ($var=~/^[ZPIJKLMNCY]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="Z" if ($var=~/^[PIJKLMNCY]/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+#LOGICAL variables
+  elsif( $type eq "l") {
+    if($usage eq "arg") {
+      $prefix="LD" unless($var=~/^LD/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="LL" unless($var=~/^LL/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="L" unless($var=~/^L[^LD]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="LL" unless($var=~/^L/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+#CHARACTER variables
+  elsif( $type eq "c") {
+    if($usage eq "arg") {
+      $prefix="CD" unless($var=~/^CD/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="CL" unless($var=~/^CL/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="C" unless($var=~/^C[^LD]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="CL" unless($var=~/^C/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+# USER DEFINED TYPES
+  elsif( $type eq 't') {
+    if($usage eq "arg") {
+      $prefix="YD" unless($var=~/^YD/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="YL" unless($var=~/^YL/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="Y" unless($var=~/^Y[^LD]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="YL" unless($var=~/^Y/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+# FUNCTION/EXTERNAL declarations
+  elsif( $type eq 'f' || $type eq 'e' || $type eq 's') {
+# Everything is OK
+  }
+  else {
+    die "Unknown type $type"
+  }
+  ($prefix);
+}
+#==========================================================================
+     
+sub parse_prog_unit {
+  # Find out type (return), name ($$unit_name) and arguments (@$args)
+  # from a program unit statement ($_)
+  my ($unit_name, $args) = @_;
+  $$unit_name = '';
+  @$args      = ();
+
+  my $type = '';
+
+  our ($name, $type_spec, $attribute);
+
+  if (/^\s*(MODULE|PROGRAM|BLOCK\s*DATA)\s+($name)\s*$/io) {
+    $type       = lc ($1);
+    $$unit_name = $2;
+
+    # Remove space from "block data"
+    $type       =~ s/\s*//;
+
+  } elsif (/^\s*(?:$attribute)?\s*(SUBROUTINE)\s+($name)\b/io or
+           /^\s*(?:$attribute)?\s*(?:$type_spec)?\s*(FUNCTION)\s+($name)\b/io) {
+    $type       = lc ($1);
+    $$unit_name = $2;
+
+    # Get arguments/keywords from SUBROUTINE/FUNCTION
+    if(/^[^\(]+\([^\)]+\)/) {
+      my $tstatm = $_;
+
+      # Remove trailing comment
+      $tstatm =~ s/\!.*\n/\n/g;
+
+      # Remove space characters
+      $tstatm =~ s/\s//g;
+
+      # Add the RESULT clause to the argument/keyword list
+      $tstatm =~ s/\)result\((\w+\))$/,$1/i if $type eq 'function';
+
+      # Remove the parenthesis around the argument list
+      $tstatm =~ s/.+\((.+)\)/$1/;
+
+      @$args = split (',', uc ($tstatm));
+
+      # For FUNCTION, add its name to the list if necessary
+      push @$args, uc ($$unit_name)
+        if $type eq 'function' and not grep {$_ eq uc ($$unit_name)} @$args;
+    }
+  }
+
+  return $type;
+}
+
+#==========================================================================
+
+sub setup_parse {
+  # Set up some "global" variables that helps with parsing statements
+
+  # Pattern for nested parenthesis
+  our $nest_par;
+  $nest_par = qr/\((?:(?>[^()]+)|(??{$nest_par}))*\)/; #Camel p214
+
+  # Patterns for variable name and natural digit
+  our $name='[a-zA-Z]\w*';
+  our $digit_string='\d+';
+  our $type_name=$name;
+
+  # Patterns for specification
+  our $specification_expr='(?:'.$name.'|'.$digit_string.')'; # Simplification
+  our $type_param_value='(?:\*|'.$specification_expr.')';
+
+  # Patterns for length/kind attributes
+  our $char_selector='LEN *= *'.$type_param_value; # Simplification
+  our $kind_selector='\( *KIND *= *'.$name.' *\)';    # Simplification
+
+  # Pattern for type specification
+  our $type_spec='INTEGER *(?:'.$kind_selector.')?|REAL *(?:'.$kind_selector.
+    ')?|DOUBLE PRECISION|COMPLEX *(?:'.$kind_selector.')?|CHARACTER *'.
+    $char_selector.'|LOGICAL *(?:'.$kind_selector.')?|TYPE\s*\(\s*'.$type_name.
+    '\s*\)';
+
+  # Pattern for function/subroutine attribute
+  our $attribute = 'ELEMENTAL|(?:RECURSIVE(?:\s+PURE)?|PURE(?:\s+RECURSIVE)?)';
+
+  return;
+}
+
+#==========================================================================
+
+sub f90_indent {
+# Indent free-format F90 program to our standards
+  my($line_hash,$lines)=@_;
+  my($delta)='  '; 
+  my($cur_indent)='';
+  @$lines=();
+  foreach my $href (@$line_hash) {
+    $_=$href->{line};
+    if($href->{content} eq 'comment') {
+      push(@$lines,$_);
+      next;
+    }
+    s/^ *//; # Remove current indentation
+    my($post_chg)=0;
+    my($pre_chg)=0;
+    my($cont_line)='';
+    exit if (! exists $href->{content});
+    if($href->{content} eq 'DO') {
+      $post_chg=1 unless /^DO\s+\d/;
+    }
+    elsif($href->{content} eq 'ENDDO') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'IF_construct') {
+      $post_chg=1;
+    }
+    elsif($href->{content} eq 'ELSEIF') {
+      $post_chg=1;
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ELSE') {
+      $post_chg=1;
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ENDIF') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ENDIF') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'WHERE_construct') {
+      $post_chg=1;
+    }
+    elsif($href->{content} eq 'ELSEWHERE') {
+      $post_chg=1;
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ENDWHERE') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ENDIF') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'SELECT CASE') {
+      $post_chg=1;
+    }
+    elsif($href->{content} eq 'CASE') {
+      $post_chg=1;
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'END SELECT') {
+      $pre_chg=1;
+    }
+    $cont_line=' ' if($href->{content} eq 'cont_line');
+    if( $pre_chg ) {
+      unless($cur_indent=~s/^$delta//o) {
+	print STDERR $_;
+	die  "f90_indent: something wrong, indent negative\n";;
+      }
+    }
+#    print "$cur_indent$cont_line$_";
+    
+    $_=$cur_indent.$cont_line.$_;
+    push(@$lines,$_);
+    $cur_indent.=$delta if( $post_chg );
+  }
+
+  if(! ($cur_indent eq '')) {
+    die "f90_indent: something wrong, indent=XX${cur_indent}XX\n";
+  }
+}
+
+#==========================================================================
+
+sub tidy {
+# Straigthforward tidiyng of statements
+  my($statements) = @_;
+  my($href,$content);
+  foreach $href (@$statements) {
+    $_=$href->{statement};
+    $content=$href->{content};
+# Substitute tab with four blanks
+    s/\t/    /g;
+    if($content eq 'comment') {
+# Substitute empty comment line with empty line
+      s/^[!] *\n$/\n/;
+      $href->{statement}=$_;
+      next;
+    }
+    if($href->{exec}) {
+      if($content eq 'ENDDO') {
+	s/\bEND DO\b/ENDDO/i;
+	$href->{statement}=$_;
+	next;
+      }
+      if($content eq 'ENDIF') {
+	s/\bEND IF\b/ENDIF/i;
+	$href->{statement}=$_;
+	next;
+      }
+      if($content eq 'ENDWHERE') {
+	s/\bEND WHERE\b/ENDWHERE/i;
+	$href->{statement}=$_;
+	next;
+      }
+
+      s/\bELSE IF\b/ELSEIF/i  if($content eq 'ELSEIF');
+
+      if(/\./) {
+	s/ *\.EQ\. */ == /gi;
+	s/ *\.NE\. */ \/= /gi;
+	s/ *\.LT\. */ < /gi;
+	s/ *\.LE\. */ <= /gi;
+	s/ *\.GT\. */ > /gi;
+	s/ *\.GE\. */ >= /gi;
+      }
+
+#
+      s/\bA?MAX[01]\b/MAX/gi;
+      s/\bA?MIN[01]\b/MIN/gi;
+      s/\bAMOD\b/MOD/gi;
+      s/\bALOG\b/LOG/gi;
+      s/\bALOG10\b/LOG10/gi;
+#      s/\bI(SIGN *\()/$1/gi; # Goes wrong in larcinad etc.
+      s/\bFLOAT\b/REAL/g;
+      s/\bfloat\b/real/g;
+    }
+    
+    $href->{statement}=$_;
+  }
+}
+
+#==========================================================================
+
+sub process_include_files {
+# Read include files and put reference to the anonomys array
+# holding the array of "statement" hashes in $href->{inc_statm}
+  my($statements,$prog_info,$inc_statements) = @_;
+  my ($content,$fname,$href);
+  return unless ($$prog_info{has_include});
+  my @lines=();
+  foreach $href (@$statements) {
+    $content=$href->{content};
+    if($content eq 'include'){
+      $_=$href->{statement};
+      /["](\S+)["]/;
+      $fname=$1;
+      &get_inc_lines($fname,\@lines);
+# Macro-removal
+      &remove_macro(\@lines);
+# Expand lines into statements and put refernce to this
+# array of hashes into $href->{inc_statm}
+      my @inc_statms=();
+      my $dum={};
+      &expcont(\@lines,\@inc_statms);
+      $href->{inc_statm}=[@inc_statms];
+      my $incs=$href->{inc_statm};
+# Study the read in file and add more attributes
+      &study($incs);
+#      print Dumper($incs,$dum);
+      
+    }
+  }
+}
+#==========================================================================
+sub get_inc_lines{
+# Recurcivly get lines from include files, flatten into array of lines
+  my ($fname,$lines) = @_;
+  my ($VPATH,@vpath,@tmp_lines);
+
+  $VPATH=$ENV{VPATH} or die "VPATH not defined ";
+# IFS VPATH /tmp/27/ifs/function:/tmp/27/ifs/common:/tmp/27/ifs/interface:/tmp/27/ifs/namelist:/tmp/27/ifsaux/include:/tmp/27/trans/interface:/tmp/27/obsort/interface:/tmp/27/ifs/ald_inc/function:/tmp/27/ifs/ald_inc/interface:/tmp/27/ifs/ald_inc/namelist
+  @vpath=split(":",$VPATH);
+# Look for include file in VPATH
+  foreach my $path (@vpath) {
+    my $ffname=$path.'/'.$fname;
+    if( -f $ffname) {
+# Read lines from include file
+      @tmp_lines = &readfile($ffname);
+#      print "$ffname \n";
+      for (@tmp_lines) {
+	if(/^\#include\b/){
+	  /["](\S+)["]/;
+	  my $fname2=$1;
+	  &get_inc_lines($fname2,$lines);
+	}
+	else {
+	  push(@$lines,$_);
+	}
+      }
+      last;
+    }
+  }
+  die "Include file $fname not found in VPATH=$VPATH " unless(@$lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &create_interface_block (\@statements, \@interface_block);
+#
+# DESCRIPTION
+#   This function analyses the Fortran statements in \@statements and returns
+#   an interface block in \@interface_block.
+# ------------------------------------------------------------------------------
+
+sub create_interface_block {
+  # Create a "minimal" interface block for subroutines
+  my  ($statements, $interface_block) = @_;
+  my  (%pu_args, %tokens);
+  our ($name, $nest_par);
+
+  @$interface_block = ();
+
+  my @tokens_in_lines = (); # List of tokens in each line
+
+  # Gather information needed to create interface block for routine
+  for my $href (@$statements) {
+    last if $href->{exec}; # exit loop at beginning of executable statements
+
+    # Get arguments of subroutine or function
+    if ($href->{content} eq 'SUBROUTINE' or $href->{content} eq 'FUNCTION') {
+      my $func;
+      my @pu_args;
+      $_ = $href->{statement};
+      &parse_prog_unit (\$func, \@pu_args);
+      $pu_args{uc ($_)} = 1 for @pu_args;
+      next;
+    }
+
+    # Get tokens from lines where arguments are present
+    # Inspect only type declaration statements
+    next unless $href->{decl} == 2;
+
+    my $statement = uc $href->{statement};
+    $statement =~ s/!.*$//; # Remove trailing comment
+
+    my @line_tokens = ();
+    if ($statement =~ s/^(.*?):://) {
+      # New style declaration statement contains "::"
+
+      # Tokens in specification part
+      my $spec = $1;
+      my @tokens = ($spec =~ /\b$name\b/g);
+      shift @tokens; # Remove leading token
+
+      for (@tokens) {
+        push @line_tokens, $_
+          unless /^(?:KIND|LEN|ALLOCATABLE|POINTER|TARGET|DIMENSION|OPTIONAL|
+                  SAVE|INTENT|IN|OUT|INOUT|PARAMETER)$/x;
+      }
+
+      # Tokens in declaration part
+      push @line_tokens, ($statement =~ /\b$name\b/g);
+
+    } else {
+      # Old style declaration statement does not contain "::"
+      @line_tokens = ($statement =~ /\b$name\b/g);
+      shift @line_tokens; # Remove leading token
+    }
+
+    push @tokens_in_lines, \@line_tokens;
+
+    # Check whether each token matches an argument
+    for my $token (@line_tokens) {
+      if (exists $pu_args{$token}) {
+        $tokens{$_} = 1 for @line_tokens;
+        last;
+      }
+    }
+  }
+
+  # Parse statements one more time to ensure all required tokens are included
+  for (@tokens_in_lines) {
+    my @line_tokens = @{ $_ };
+
+    # Check whether line contains an essential token
+    for my $token (@line_tokens) {
+      if (exists $tokens{$token}) {
+        $tokens{$_} = 1 for @line_tokens;
+        last;
+      }
+    }
+  }
+
+  # Create the interface block
+  for my $href (@$statements) {
+    my %myhref  = %$href;
+    my $content = $myhref{content};
+
+    # Ignore comment, executable statements and items in CONTAINS block
+    next if $content eq 'comment';
+    next if $myhref{exec};
+    next if $myhref{in_contain};
+
+    # Delete existing pre- and post -inserts
+    delete $myhref{pre_insert}  if exists $myhref{pre_insert};
+    delete $myhref{post_insert} if exists $myhref{post_insert};
+
+    # Put SUBROUTINE/FUNCTION statement into interface block
+    if ($content =~ /^(?:SUBROUTINE|FUNCTION)$/) {
+      $myhref{pre_insert} = 'INTERFACE' . "\n"; # Insert INTERFACE statement
+      push @$interface_block, \%myhref;
+    }
+
+    # Add USE statement in interface block, if necessary
+    if($myhref{decl} == 4) {
+      $_ = uc $myhref{statement};
+      tr/ \n//d;
+
+      if(/^USE$name,ONLY:(.+)$/) {
+        # USE statement with ONLY, check token to see if it is necessary
+	my @line_tokens = /\b$name\b/g;
+
+	for (@line_tokens) {
+	  if (exists $tokens{$_}) {
+	    push @$interface_block, \%myhref;
+	    last;
+	  }
+	}
+
+      } else {
+        # Always add USE statement without ONLY
+	push @$interface_block, \%myhref;
+      }  
+    }
+
+    if ($myhref{decl} == 1 or $myhref{decl} == 2) {
+      $_ = uc ($myhref{statement});
+      s/\s*!.*$//;
+
+      if ($content eq 'INTEGER' or $content eq 'PARAMETER') {
+        # INTEGER and PARAMETER may be used for dimensioning
+	my @line_tokens = /\b$name\b/g;
+
+	for (@line_tokens) {
+	  if (exists $tokens{$_}) {
+	    push @$interface_block, \%myhref;
+	    last;
+	  }
+	}
+      } else {
+        # Add line only if an argument is present
+	s/$nest_par//g;
+	my @line_tokens = /\b$name\b/g;
+
+	for (@line_tokens) {
+	  if (exists $pu_args{$_}) {
+	    push @$interface_block, \%myhref;
+	    last;
+	  }
+	}
+      }
+    }
+
+    # Add END statement to interface block
+    if ($content =~ /^END\s+(?:SUBROUTINE|FUNCTION)/) {
+      $myhref{post_insert} = 'END INTERFACE' . "\n";
+      push @$interface_block, \%myhref;
+    }
+  }
+
+  # Beautify the interface block
+  for my $href (@$interface_block) {
+    $_ = $href->{statement};
+
+    s/\!.*\n/\n/g; # Remove trailing comments
+    s/ +/ /g;      # Only one space
+    s/\n *\n/\n/g; # Remove empty lines
+    s/\n *\n/\n/g; # Remove empty lines again
+    s/ +\n/\n/g;   # No trailing spaces
+
+    $href->{statement} = $_;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub change_var_names{
+  my($statements) = @_;
+  foreach my $href (@$statements) {
+    $_=$href->{statement};
+    s/\bVAZX\b/YVAZX/ig;
+    s/\bPVAZX\b/YDVAZX/ig;
+    s/\bVAZG\b/YVAZG/ig;
+    s/\bPVAZG\b/YDVAZG/ig;
+    s/\bSCALP_DV\b/YSCALP/ig;
+    s/\bRSCALP_DV\b/YRSCALP/ig;
+    s/\bSCALPSQRT_DV\b/YSCALPSQRT/ig;
+    s/\bRSCALPSQRT_DV\b/YRSCALPSQRT/ig;
+    s/\bPYBAR\b/YDYBAR/ig;
+    s/\bPSBAR\b/YDSBAR/ig;
+    s/\bVCGLPC\b/YVCGLPC/ig;
+    s/\bVCGLEV\b/YVCGLEV/ig;
+    s/\bSKFROT\b/YSKFROT/ig;
+    s/\bSKFMAT\b/YSKFMAT/ig;
+    s/\bSTATE_VECTOR_4D\b/YSTATE_VECTOR_4D/ig;
+    s/\bVAZX0\b/YVAZX0/ig;
+    s/\bVAZG0\b/YVAZG0/ig;
+    s/\bRSPFORCE\b/YSPFORCE/ig;
+    $href->{statement}=$_;
+  }
+}
+# =========================================================================
+sub remake_arg_decl{
+  my($statements,$prog_info) = @_;
+  my($href,$content,@pu_args,$func,%tokens);
+  my($left,$right,%arghash,$dim);
+  our($nest_par,$name);
+
+  my $dims='';
+# Crack existing dummy declarations, build hash arghash
+  foreach $href (@$statements) {
+    last if($href->{prog_unit} >0);
+    if($href->{content} eq 'SUBROUTINE') {   # Get arguments of subroutine
+      $_=$href->{statement};
+      my $dum=&parse_prog_unit(\$func,\@pu_args);
+#      print Dumper(\@pu_args);
+      for(@pu_args) {
+	$_=uc($_);
+	$arghash{$_}{other}='';
+	$arghash{$_}{dimuse}=0;
+	$arghash{$_}{intent}='';
+	$arghash{$_}{used}=0;
+	$arghash{$_}{set}=0;
+	$arghash{$_}{reallyset}=0;
+	$arghash{$_}{type}='';
+	$arghash{$_}{comment}='';
+	$arghash{$_}{inif}=0;
+      }
+      next;
+    }
+    if($href->{decl} == 2) {
+      $_=$href->{statement};
+      my $comment='';
+      $comment=$1 if(/.*(\!.*)$/);
+      s/\!.*\n/\n/g;                        # Remove trailing comments in all lines
+      $_=uc($_);
+      s/\s//g;
+      if(/^(.+)::(.+)$/){
+	$left=$1;
+	$right=$2;
+	$_=$right;
+	s/$nest_par//g;
+	s/($name)\*\w+/$1/g;
+#	print "XX  $_ \n";
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/) {
+#	    print "ARG $arg $left $_ \n";
+	    $arghash{$arg}{linedec}=$href->{number};
+	    $arghash{$arg}{comment}=$comment;
+	    my @locdec =split ',',$left;
+	    my $i=0;
+	    foreach my $locdec (@locdec) {
+	      if($i == 0) {
+		$arghash{$arg}{type}=$locdec;
+	      }
+	      elsif($locdec=~/\bINTENT/) {
+		$arghash{$arg}{intent}=','.$locdec;
+	      }
+	      else {
+		$arghash{$arg}{other}=$arghash{$arg}{other}.','.$locdec;
+	      }
+	      $i++;
+	    }
+	    if($right=~/\b$arg\b(\*\w+)/) {
+	      $dim=$1;
+	    }
+	    elsif($right=~/\b$arg\b($nest_par\*$nest_par)/) {
+	      $dim=$1;
+	    }
+	    elsif($right=~/\b$arg\b($nest_par\*\w+)/) {
+	      $dim=$1;
+	    }
+	    elsif($right=~/\b$arg\b(\*$nest_par)/) {
+	      $dim=$1;
+	    }
+	    elsif($right=~/\b$arg\b($nest_par)/) {
+	      $dim=$1;
+	    }
+	    else {
+	      $dim='';
+	    }
+	    $arghash{$arg}{dim}=$dim;
+	    $dims=$dims.$dim
+	      }
+	}
+	foreach my $arg (@pu_args) {  # Is arg. used for dimensioning other args?
+	  if($dims=~/\b$arg\b/i) {
+	    $arghash{$arg}{dimuse}=1;
+	  }
+	}  
+      }
+    }
+  }
+  my $insert_line=0;
+  foreach $href (@$statements) {
+    last if($href->{prog_unit} >0);
+    if($href->{decl} == 2 or $href->{content} eq 'PARAMETER') {                 
+      $_=uc($href->{statement});
+      next unless /\bPARAMETER\b/;
+      my @tmpvar=/\b$name\b/g;
+      foreach my $token (@tmpvar) {
+	if($dims=~/\b$token\b/) {
+	  $insert_line=$href->{number};
+	}
+      }
+    }
+  }
+      
+# Gather info to decide INTENT status
+  my $inif=0;
+  my @inif_stack=();
+  my $cur_inif=0;
+  foreach $href (@$statements) {
+    last if($href->{prog_unit} >0);
+    if($href->{exec}) {
+      if($href->{content} eq 'ENDIF') {
+	$inif--;
+	$cur_inif=pop @inif_stack;
+	next;
+      }
+      elsif($href->{content} eq 'ELSEIF' or $href->{content} eq 'ELSE') {
+	$cur_inif=pop @inif_stack;
+	$cur_inif=$href->{number};
+	push @inif_stack,$cur_inif;
+      }
+      my ($left,$right);
+      $_=$href->{statement};
+      s/\!.*\n/\n/g;                        # Remove trailing comments in all lines
+      my %setnow=();
+      foreach my $arg (@pu_args) {
+	$setnow{$arg}=0;
+	$setnow{$arg}=1 if($arghash{$arg}{reallyset});
+	unless ($setnow{$arg}) {
+	  foreach my $xx (@inif_stack) {
+	    $setnow{$arg}=1 if($xx == $arghash{$arg}{inif});
+	  }
+	}
+      }
+      
+      if($href->{content} eq 'scal_assign' or $href->{content} eq 'array_assign') {
+	s/\s//g;
+	($left,$right)=/^(.+)=(.+)$/;
+	$_=$right;
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/i) {
+	    $arghash{$arg}{used}=1 unless $setnow{$arg};
+	  }
+	}
+	$_=$left;
+	if(/($nest_par)/) {
+	  $_=$1;
+	  foreach my $arg (@pu_args) {
+	    if(/\b$arg\b/i) {
+	      $arghash{$arg}{used}=1 unless $setnow{$arg};
+	    }
+	  }
+	}
+	$_=$left;
+	foreach my $arg (@pu_args) {
+	  if(/^$arg\b/i) {
+	    $arghash{$arg}{set}=1;
+	    $arghash{$arg}{inif}=$cur_inif;
+	    $arghash{$arg}{reallyset}=1 unless($inif);
+	  }
+	}
+      }
+      elsif($href->{content} eq 'IF' ) {
+	if($href->{content2} eq 'scal_assign' or $href->{content2} eq 'array_assign' or 
+	   $href->{content2} eq 'CALL') {
+	  s/\n//g;
+	  ($left,$right)=/^\s*(IF\b\s*$nest_par)(.+)/i;
+	  $_=$left;
+	  foreach my $arg (@pu_args) {
+	    if(/\b$arg\b/i) {
+	      $arghash{$arg}{used}=1 unless $setnow{$arg};
+	    }
+	  }
+	  $_=$right;
+	  if($href->{content2} eq 'CALL') {
+	    my $statement=$right;
+	    my $inifx=1;
+	    &propag_arg(\$statement,\%arghash,\$inifx,\%setnow);
+	  }
+	  else {
+	    s/\s//g;
+	    ($left,$right)=/^(.+)=(.+)$/;
+	    $_=$right;
+	    foreach my $arg (@pu_args) {
+	      if(/\b$arg\b/i) {
+		$arghash{$arg}{used}=1 unless $setnow{$arg};
+	      }
+	    }
+	    $_=$left;
+	    if(/($nest_par)/) {
+	      $_=$1;
+	      foreach my $arg (@pu_args) {
+		if(/\b$arg\b/i) {
+		  $arghash{$arg}{used}=1 unless $setnow{$arg};
+		}
+	      }
+	    }
+	    $_=$left;
+	    foreach my $arg (@pu_args) {
+	      if(/^$arg\b/i) {
+		$arghash{$arg}{inif}=$cur_inif;
+		$arghash{$arg}{set}=1;
+	      }
+	    }
+	  }
+	}
+	else {
+	  foreach my $arg (@pu_args) {
+	    if(/\b$arg\b/i) {
+	      $arghash{$arg}{used}=1 unless $setnow{$arg};
+	    }
+	  }
+	}
+      }
+      elsif($href->{content} eq 'WHERE' ) {
+	s/\s//g;
+	($left,$right)=/^(WHERE$nest_par)(.+)/i;
+	$_=$left;
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/i) {
+	    $arghash{$arg}{used}=1 unless $setnow{$arg};
+	  }
+	}
+	$_=$right;
+	($left,$right)=/^(.+)=(.+)$/;
+	$_=$right;
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/i) {
+	    $arghash{$arg}{used}=1 unless $setnow{$arg};
+	  }
+	}
+	$_=$left;
+	foreach my $arg (@pu_args) {
+	  if(/^$arg\b/i) {
+	    $arghash{$arg}{inif}=$cur_inif;
+	    $arghash{$arg}{set}=1;
+	  }
+	}
+      }
+      elsif($href->{content} eq 'CALL') {
+	my $statement=$_;
+	&propag_arg(\$statement,\%arghash,\$inif);
+      }
+      else{
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/i) {
+	    $arghash{$arg}{used}=1 unless $setnow{$arg};
+	  }
+	}
+      }
+      if($href->{content} eq 'IF_construct') {
+	$inif++;
+	$cur_inif=$href->{number};
+	push @inif_stack,$cur_inif;
+      }
+    }	  
+  }
+
+# Create INTENT statemant based on gathered info
+  foreach my $arg (@pu_args) {
+    if($arghash{$arg}{linedec}) {
+      if($arghash{$arg}{nointent}) {
+	unless($arghash{$arg}{intent}) {
+	  $arghash{$arg}{intent}=' ';
+	  $arghash{$arg}{comment}='! UNDETERMINED INTENT';
+	}
+      }
+      else{
+	my $intent='';
+	$intent='IN' if($arghash{$arg}{used} or $arghash{$arg}{dimuse});
+	$intent=$intent.'OUT' if($arghash{$arg}{set});
+	if($intent) {
+	  if($arghash{$arg}{intent} and $intent eq 'OUT') {
+	    $intent='INOUT' if $arghash{$arg}{intent}=~/INOUT/i;
+	  }
+	  $arghash{$arg}{intent}=',INTENT('.$intent.')';
+	}
+	else {
+	  $arghash{$arg}{intent}=' ';
+	  $arghash{$arg}{comment}='! Argument NOT used';
+	}
+      }
+    }
+  }
+
+# Remove existing argument declarations
+  foreach my $arg (@pu_args) {
+    if($arghash{$arg}{linedec}) {
+      $_=$$statements[$arghash{$arg}{linedec}]->{statement};
+      #   print "BEFORE $arg $_";
+      if(/.*::\s*\b$arg\b\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*$nest_par\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*\*\s*\w+\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*\*\s*$nest_par\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*$nest_par\s*\*\s*\w+\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*$nest_par\s*\*\s*$nest_par\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      else{
+	/^(.*::)(.*)$/s;
+	my $left=$1;
+	$_=$2;
+	s/\b$arg\b\s*$nest_par//i;
+	s/\b$arg\b\s*\*\s*\w+//i;
+	s/\b$arg\b\s*\*\s*$nest_par//i;
+	s/\b$arg\b//i;
+	s/,\s*,/,/;
+	s/,(\s*)$/$1/;
+	s/\n\s*\n/\n/g;
+	$_=$left.$_;
+	s/::\s*,/::/;
+      }
+ #   print "AFTER $arg $_\n";
+      $$statements[$arghash{$arg}{linedec}]->{statement}=$_; 
+    }
+  }
+
+ # Write out
+
+  my $newdecl='';
+  my $linedec;
+  foreach my $arg (@pu_args) {
+    if($arghash{$arg}{linedec}) {
+      if($arghash{$arg}{other} and ! $arghash{$arg}{dim}) {
+	$arghash{$arg}{other}=~s/\s//g;
+	if($arghash{$arg}{other}=~/^,DIMENSION($nest_par)$/i) {
+	  $arghash{$arg}{other}='';
+	  $arghash{$arg}{dim}=$1;
+	}
+      }
+      if($arghash{$arg}{dimuse}) { # Put declerations of args first
+	$linedec=sprintf "%-18s%s%-14s%s%s%s%s %s",
+	$arghash{$arg}{type},$arghash{$arg}{other},$arghash{$arg}{intent},
+	    ' :: ',$arg,$arghash{$arg}{dim},$arghash{$arg}{comment},"\n";
+	$newdecl=$newdecl.$linedec;
+      }
+    }
+  }
+  foreach my $arg (@pu_args) {
+    if($arghash{$arg}{linedec}) {
+      unless($arghash{$arg}{dimuse}) {
+	$linedec=sprintf "%-18s%s%-14s%s%s%s %s%s",
+	$arghash{$arg}{type},$arghash{$arg}{other},$arghash{$arg}{intent},
+	    ' :: ',$arg,$arghash{$arg}{dim},$arghash{$arg}{comment},"\n";
+	$newdecl=$newdecl.$linedec;
+      }
+    }
+  }
+#  print "INSERT_LINE $insert_line \n";
+  if($insert_line) {
+    $$statements[$insert_line]->{post_insert}=$newdecl;
+  }
+  else{
+    foreach $href (@$statements) {
+      if($href->{decl} == 2) {                 
+	$href->{pre_insert}=$newdecl;
+	last;
+      }
+    }
+  }
+
+#  print $newdecl;
+#  print Dumper(\%arghash);
+}
+
+sub propag_arg{
+  my ($statement,$arghash,$inif,$setnow) = @_;
+  our ($name,$nest_par);
+  my (%argpos);
+  $_=$$statement;
+  s/^\s*CALL\s+($name)//i;
+  my $called=lc($1);
+  s/\s//g;
+  s/^\((.*)\)$/$1/s;
+  my @inpars=/$nest_par/g;
+  s/$nest_par//g;
+  s/($name)%$name/$1/g;
+  $_=uc($_);
+#  print "PROPAG $called $_ ££ @inpars \n";
+  my @call_args=split ',' , $_;
+  my $i=0;
+  my $interesting=0;
+  %argpos=();
+  foreach my $call (@call_args) {
+    
+#    print "CALL $called $call \n" ;
+    if($call=~/(.+)=(.+)/) {
+      $call=$2; #This just by-passes the problem
+    }
+    if(exists $$arghash{$call}) {
+      if(exists $argpos{$call}) {
+	push @{$argpos{$call}},$i;
+      }
+      else {
+	my @i=($i);
+	$argpos{$call}=[@i];
+      }
+      $interesting=1;
+    }
+    $i++;
+  }
+  if($interesting) {
+    my $fname='/tmp/intblocks/'.$called.'.intfb.h';
+    if( -f $fname ) {
+      my @dumargs=();
+      my $unit_name;
+      print "FILE $fname FOUND \n";
+      my @lines = &readfile($fname);
+      my @loc_statements=(); 
+      &expcont(\@lines,\@loc_statements);
+      foreach my $href (@loc_statements) {
+	$_=$href->{statement};
+	if(/^\s*SUBROUTINE/i) {
+	  my $dum=&parse_prog_unit(\$unit_name,\@dumargs);
+	  next;
+	}
+	if(/::/) {
+	  s/\s//g;
+	  foreach my $arg (keys (%argpos)) {
+	    my $set_before=$$setnow{$arg};
+	    foreach my $i (@{$argpos{$arg}}){
+	      if(/::$dumargs[$i]/) {
+		if(/INTENT\(IN\)/i) {
+		  $$arghash{$arg}{used}=1 unless $set_before;
+		}
+		elsif(/INTENT\(OUT\)/i) {
+		  $$arghash{$arg}{set}=1;
+		  $$setnow{$arg}=1 unless($$inif);
+		}
+		elsif(/INTENT\(INOUT\)/i) {
+		  $$arghash{$arg}{set}=1;
+		  $$arghash{$arg}{used}=1 unless $set_before;;
+		  $$arghash{$arg}{reallyset}=1 unless($$inif);
+		}
+		elsif(/\! UNDETERMINED INTENT/) {
+		  $$arghash{$arg}{nointent}=1;
+		}
+	      }
+	    }
+	  }
+	}
+      }
+    }
+    else {
+      foreach my $arg (keys (%argpos)) {
+	$$arghash{$arg}{nointent}=1;
+      }
+    }
+  }
+  for (@inpars) {
+    foreach my $arg (keys (%$arghash)) {
+      if(exists $$arghash{$arg}) {
+	if(/\b$arg\b/i) {
+	  $$arghash{$arg}{used}=1 unless $$setnow{$arg};
+	}
+      }
+    }
+  }
+}
+  
+sub add_interface_blocks {
+# Add interface block for called routines
+  use File::Find;
+  my($statements,$prog_info) = @_;
+  my($href,$call);
+  our($name,$nest_par);
+  our(@call_names,@call_names_found,%call_names);
+
+  return unless ($$prog_info{no_calls}); # Skip if there are no calls
+  @call_names=();
+  %call_names=();
+
+  my $last_decl=0;
+  my $in_intfblk=0;
+  my %already_in=();
+  ST:foreach $href (@$statements) {
+    last if($href->{prog_unit} > 0);  # Only consider first program unit (no contains)
+    if($href->{content} eq 'INTERFACE') {
+      $in_intfblk=1;
+      next;
+    }
+    if($href->{content} eq 'END INTERFACE') {
+      $in_intfblk=0;
+      next;
+    }
+    if($in_intfblk) {
+      $_=$href->{statement};
+      s/\#include\s*\"(\w+)\.h\"\s*$/$1/;
+      $_=lc($_);
+      $already_in{$_}++;
+      next;
+    }
+    
+# Find last declaration
+    if($href->{decl}) {
+      next if($href->{content} eq 'FORMAT');
+      next if($href->{content} eq 'DATA');
+      $last_decl = $href->{number} ;
+    }
+# Find calls
+    next unless($href->{exec});
+    if($href->{content} eq 'CALL' or 
+       (exists  $href->{content2} and$ href->{content2} eq 'CALL') ) {
+      $_=$href->{statement};
+      /\s*\bCALL\b\s*($name)/i;
+      my $call=lc($1);
+      next if($already_in{$call}); # Exclude already existing interface block
+      next if($call eq 'packmsg'); # A couple of special exceptions
+      next if($call eq 'unpkmsg');
+      $call_names{$call}++;
+    }
+  }
+  
+
+# Check that routine exists in IFS
+  @call_names_found=();
+  find(\&calls_wanted,'/tmp/27/ifs/');
+#  find(\&calls_wanted,'/home/mats/work/cy28/ifs/');
+#  find(\&calls_wanted,'/tmp/27/trans/');
+  @call_names_found=sort(@call_names_found);
+#  print "P2 @call_names_found \n";
+  @call_names=@call_names_found;
+
+# Contruct include block
+  my $block='';
+  for (@call_names) {
+    $block=$block.'#include "'.$_.'.intfb.h"'."\n";
+  }
+#  print $block;
+
+  my $clean=0;
+  if(@call_names) {
+    if($$prog_info{has_interface_block}) {
+      foreach $href (@$statements) {
+# Add interface block to routine that already has INTERFACE statement
+	if($href->{content} eq 'END INTERFACE'){
+	  if($href->{post_insert}) {
+	    $href->{post_insert}=$href->{post_insert}."\n".$block;
+	  }
+	  else {
+	    $href->{post_insert}="\n".$block;
+	  }	    
+	  last;
+	}
+      }
+    }
+# Add interface block to routine that does not have previous INTERFACE statement
+    else {
+      $href=@$statements[$last_decl];
+      if($href->{post_insert}) {
+	$href->{post_insert}=$href->{post_insert}."\n".$block;
+      }
+      else {
+	$href->{post_insert}="\n".$block;
+      }	    
+    }
+# Remove from EXTERNAL statement where interface block has been added
+    foreach $href (@$statements) {
+      if($href->{content} eq 'EXTERNAL') {
+	$_=$href->{statement};
+	foreach my $ext (@call_names) {
+	  s/\b$ext\b//i;
+	}
+	s/,\s*,/,/g;
+	s/^(\s*EXTERNAL\s*),/$1/i;
+	s/^(\s*EXTERNAL.*),\s*$/$1/i;
+	s/^\s*EXTERNAL\s*,*\s*$//i;
+	$href->{statement}=$_;	
+      }
+    }
+  }
+}
+#======================================================================================
+sub calls_wanted {
+  # Used by Find as called from add_interface_blocks
+  our(%call_names,@call_names_found);
+  return unless (/^(\w+)\.F90$/);
+  my $call=$1;
+  if($call_names{$call}) {
+    push(@call_names_found,$call);
+  }    
+}
+sub remove_some_comments{
+  my($statements) = @_;
+  my $prev_empty=0;
+  foreach my $href (@$statements) {
+    if($href->{content} eq 'comment'){
+      $_=$href->{statement};
+      if(/^\s*$/) {
+	if($prev_empty) {
+	  s/\s*//;
+	  $href->{statement}=$_;
+	}
+	else {
+	  $prev_empty=1;
+	} 
+	next;
+      }
+      $prev_empty=0;
+      s/^\s*![\s\*]*\bLOCAL\s+(INTEGER|REAL|LOGICAL|CHARACTER)\s+(SCALARS|ARRAYS).*\n$//i;
+      s/^\s*![\s\*]*\bDUMMY\s+(INTEGER|REAL|LOGICAL|CHARACTER)\s+(SCALARS|ARRAYS).*\n$//i;
+      s/^\s*![\s\*]*\bLOCAL\s+(INTEGER|REAL|LOGICAL|CHARACTER).*\n$//i;
+      s/^\s*![\s\*]*\bDUMMY\b\s*$//i;
+      s/^\s*![\s\*]*\bLOCAL\b\s*$//i;
+      s/^\s*![\s\*]*\bLOCAL\b:\s*$//i;
+      s/^\s*![\s\*]*\bLOCAL ARRAYS\b[\s\*]*$//i;
+      s/^\s*![\s\*]*\bLOCAL SCALARS\b\s*$//i;
+      s/^\s*![\s\*]*\s*\d\.\d+\s*\bLOCAL ARRAYS\b\s*$//i;
+      s/^\s*![\s\*]*\s*=== LOCAL ARRAYS ===\s*$//i;
+      $href->{statement}=$_;
+    }
+    else {
+      $prev_empty=0;
+    }
+  }
+}      
+sub get_calls_inc {
+  my($statements,$calls,$intfb) = @_;
+  foreach my $href (@$statements) {
+    if($href->{content} eq 'CALL') {
+      $_=$href->{statement};
+      /^\s*CALL\s+([A-Z]\w*)/i;
+      $$calls{lc($1)}++;
+    }
+    elsif($href->{content} eq 'IF') {
+      if($href->{content2} eq 'CALL') {
+	$_=$href->{statement};
+	/\bCALL\s+([A-Z]\w*)/i;
+	$$calls{lc($1)}++;
+      }
+    }
+    elsif($href->{content} eq 'include') {
+      $_=$href->{statement};
+      $$intfb{$1}=1 if(/["](\S+)\.intfb\.h["]/);
+      $$intfb{$1}=2 if(/["](\S+)\.h["]/); # For old-style interface blocks
+    }
+  }
+}
+
+1;
+      
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Build.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Build.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Build.pm	(revision 6412)
@@ -0,0 +1,2428 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Build
+#
+# DESCRIPTION
+#   The main purpose of this class is to process the build configuration,
+#   generate the required files for the build and invoke make to create the
+#   build.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Build;
+
+# Standard pragma
+use strict;
+use warnings;
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Basename;
+use File::Path;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::CfgFile;
+use Fcm::SrcPackage;
+use Fcm::BuildTask;
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $bld = Fcm::Build->new (
+#     CONFIG  => $config,
+#     CFG_SRC => $cfg_src,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Build class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   CFG_SRC    - source path to the build configuration file
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $cfg    = exists $args{CFG_SRC} ? $args{CFG_SRC} : undef;
+  my $config = exists $args{CONFIG}  ? $args{CONFIG}  : &main::cfg;
+
+  my $self  = {
+    CONFIG   => $config,            # configuration settings
+    CFG      => Fcm::CfgFile->new ( # bld cfg
+      TYPE   => 'bld',              # config file type
+      SRC    => $cfg,               # source path of the bld cfg
+      CONFIG => $config,            # configuration settings
+    ),
+    NAME     => '',                 # name of this build
+    DIR      => {                   # directory tree of this build
+      ROOT    => '',                # root directory of this build
+    },
+    PATH     => {},                 # search paths of this build
+    SEARCH   => 1,                  # search for source directories in src/?
+    SRCDIR   => {},                 # source directories of this build
+    PP       => {},                 # pre-process flags
+    PACKAGE  => {},                 # source directory packages of this build
+    TARGET   => [],                 # targets of this build
+    USE      => [],                 # list of inherited builds
+    INHERIT  => {                   # inheritance flags
+      SRCDIR => 1,                  # inherit source directories?
+      PP     => 1,                  # inherit pre-process flags?
+      TARGET => 0,                  # inherit targets?
+    },
+    LIB      => {'' => ''},         # name of libraries
+    LOCK     => undef,              # lock file
+  };
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->DESTROY;
+#
+# DESCRIPTION
+#   This method is called automatically when a Fcm::Build object is
+#   destroyed.
+# ------------------------------------------------------------------------------
+
+sub DESTROY {
+  my $self = shift;
+
+  # Remove the lock if it is set
+  unlink $self->{LOCK} if $self->{LOCK} and -e $self->{LOCK};
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $bld->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile = $bld->cfg;
+#
+# DESCRIPTION
+#   This method returns a reference to a Fcm::CfgFile instance for the build
+#   configuration file.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  my $self = shift;
+
+  return $self->{CFG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %allpcks = $bld->allpcks ();
+#
+# DESCRIPTION
+#   This method returns a hash table with keys representing all the packages
+#   declared in the current build. The value of each element in the hash is a
+#   reference to a list of children of the current package.
+# ------------------------------------------------------------------------------
+
+sub allpcks {
+  my $self        = shift;
+  my %allpcks = ();
+
+  for my $pckname (keys %{ $self->{PACKAGE} }) {
+    $allpcks{$pckname} = [];
+  }
+
+  for my $pckname (keys %{ $self->{PACKAGE} }) {
+    my @names = split /__/, $pckname;
+
+    my $cur = $pckname;
+    while ($cur) {
+      pop @names;
+      my $depend = @names ? join '__', @names : '';
+      $allpcks{$depend} = [] unless exists $allpcks{$depend};
+
+      push @{ $allpcks{$depend} }, $cur
+        unless grep {$_ eq $cur} @{ $allpcks{$depend} };
+
+      $cur = $depend;
+    }
+  }
+
+  return %allpcks;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $bld->build (
+#     [ARCHIVE     => $archive,]
+#     [FULL        => $full,]
+#     [IGNORE_LOCK => $ignore_lock,]
+#     [JOBS        => $jobs,]
+#     [STAGE       => $stage,]
+#     [TARGETS     => \@targets,]
+#   );
+#
+# DESCRIPTION
+#   This method performs a build based on the current configuration. The
+#   method returns 1 on success.
+#
+# ARGUMENTS
+#   ARCHIVE      - If set to "true", invoke the "archive" mode. Most build files
+#                  and directories created by this build will be archived using
+#                  the "tar" command. If not set, the default is not to invoke
+#                  the "archive" mode.
+#   FULL         - If set to "true", invoke the build in "full" mode. Build files
+#                  and directories created by previous builds in the same
+#                  location will be removed before the current build is
+#                  performed. If not set, the default is to perform the build
+#                  in "incremental" mode.
+#   IGNORE_LOCK  - If set to "true", it ignores any lock files that may exist in
+#                  the build root directory. 
+#   JOBS         - Specify number of jobs that can be handled by "make". If set,
+#                  the value must be a natural integer. If not set, the default
+#                  value is 1 (i.e. run "make" in serial mode).
+#   STAGE        - If set, it should be an integer number or a recognised
+#                  keyword or abbreviation. If set, the build is performed up
+#                  to the named stage. If not set, the default is to perform
+#                  all stages of the build. Allowed values are:
+#                  1, setup or s
+#                  2, pre_process or pp
+#                  3, generate_dependency or gd
+#                  4, generate_interface or gi
+#                  5, all, a, make or m
+#   TARGETS      - Specify targets to be built. If set, these targets will be
+#                  built instead of the ones specified in the build
+#                  configuration file.
+# ------------------------------------------------------------------------------
+
+sub build {
+  my $self = shift;
+  my %args = @_;
+
+  # Process arguments
+  my $archive     = exists $args{ARCHIVE}     ? $args{ARCHIVE}     : 0;
+  my $full        = exists $args{FULL}        ? $args{FULL}        : 0;
+  my $ignore_lock = exists $args{IGNORE_LOCK} ? $args{IGNORE_LOCK} : 0;
+  my $jobs        = exists $args{JOBS}        ? $args{JOBS}        : 1;
+  my $stage       = exists $args{STAGE}       ? $args{STAGE}       : 5;
+  my $targets     = exists $args{TARGETS}     ? $args{TARGETS}     : [qw/all/];
+
+  # Resolve named stages
+  $stage = 5 unless $stage;
+  if ($stage !~ /^\d$/) {
+    my %stagenames = (
+      'S(?:ETUP)?'                      => 1,
+      'P(?:RE)?_?P(?:ROCESS)?'          => 2,
+      'G(?:ENERATE)?_?D(?:ENPENDENCY)?' => 3,
+      'G(?:ENERATE)?_?I(?:NTERFACE)?'   => 4,
+      '(?:A(?:LL)|M(?:AKE)?)'           => 5,
+    );
+
+    for my $name (keys %stagenames) {
+      if ($stage =~ /$name/i) {
+        $stage = $stagenames{$name};
+        last;
+      }
+    }
+
+    if ($stage !~ /^\d$/) {
+      w_report 'Warning: invalid build stage: ', $stage, ', default to "5"';
+      $stage = 5;
+    }
+  }
+
+  # Get verbose mode
+  my $verbose = $self->config->verbose;
+
+  # Stage 1: setup
+  my $date = localtime;
+  print 'Build command started on ', $date, '.', "\n" if $verbose;
+  my $otime = time;
+
+  print '->Setup              : start', "\n" if $verbose;
+  my $stime = time;
+
+  # Read configurations
+  my $rc = $self->decipher_cfg;
+
+  # Check directories are set
+  $rc = $self->check_dir if $rc;
+
+  # Check for lock files
+  $rc = $self->check_lock if $rc and not $ignore_lock;
+
+  # Set a lock file
+  $rc = $self->_set_lock if $rc;
+
+  # Create build root directory if necessary
+  $rc = $self->_create_build_dir if $rc;
+
+  # Set up directory inheritance
+  $rc = $self->_setup_dir (FULL => $full) if $rc;
+
+  # Set up source directories, targets, etc
+  $rc = $self->_update_bld_info if $rc;
+
+  # Set up PP flag cache
+  $rc = $self->_update_pp_info if $rc;
+
+  # Set up build tools cache
+  $rc = $self->_update_tool_info if $rc;
+
+  # Set up regenerate make rule cache
+  $rc = $self->_update_regen_rule_info if $rc;
+
+  my $ftime = time;
+  my $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+  print '->Setup              : ', $ftime - $stime, ' ', $s_str, "\n";
+
+  # Stage 2: Pre-process
+  if ($rc and $stage >= 2) {
+    print '->Pre-process        : start', "\n" if $verbose;
+    my $stime = time;
+
+    $rc = $self->_pre_process;
+
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Pre-process        : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  # Stage 3: Scan dependency and write make rules
+  if ($rc and $stage >= 3) {
+    print '->Scan dependency    : start', "\n" if $verbose;
+    my $stime = time;
+
+    $rc = $self->_scan_dependency;
+    $rc = $self->_write_make_rules if $rc;
+    $rc = $self->_write_makefile if $rc;
+
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Scan dependency    : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  # Stage 4: Generate Fortran 9x interface block
+  if ($rc and $stage >= 4) {
+    print '->Generate interface : start', "\n" if $verbose;
+    my $stime = time;
+
+    $rc = $self->_generate_f9x_interface;
+
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Generate interface : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  # Stage 5: Make the build
+  if ($rc and $stage >= 5) {
+    print '->Make               : start', "\n" if $verbose;
+    my $stime = time;
+
+    $rc = $self->_invoke_make (
+      TARGETS => $targets,
+      JOBS    => $jobs,
+      ARCHIVE => $archive,
+    );
+
+    # Remove empty build directories
+    $rc = $self->_remove_empty_dirs () if $rc;
+
+    # Create TAR archives if necessary
+    $rc = $self->_tar_build_dirs () if $rc and $archive;
+
+    # Create run time environment script if necessary
+    $rc = $self->_create_runenv_script () if $rc;
+
+    # Create exclude dependency configurations for libraries
+    $rc = $self->_create_lib_excl_dep () if $rc;
+
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Make               : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  if ($verbose) {
+    $s_str = $ftime - $otime > 1 ? 'seconds' : 'second';
+    print '->TOTAL              : ', $ftime - $otime, ' ', $s_str, "\n";
+  }
+
+  $date = localtime;
+  if ($rc) {
+    print 'Build command finished on ', $date, '.', "\n" if $verbose;
+
+  } else {
+    e_report 'Build command failed on ', $date, '.';
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $bld->decipher_cfg ();
+#
+# DESCRIPTION
+#   This method deciphers the build configuration file and assigns the
+#   configurations to the variables of the current build.
+# ------------------------------------------------------------------------------
+
+sub decipher_cfg {
+  my $self = shift;
+
+  my $read = $self->cfg->read_cfg;
+
+  # Check config file type
+  if ($read) {
+    if ($self->cfg->type ne 'bld') {
+      w_report 'Error: ', $self->cfg->src, ': not a build config file.';
+      return;
+    }
+
+  } else {
+    return;
+  }
+
+  my %cfg_label = %{ $self->config->setting ('CFG_LABEL') };
+  my %tools     = %{ $self->config->setting ('TOOL') };
+
+  # Get lines from cfg file
+  my @cfg_lines  = $self->cfg->lines;
+
+  LINE: for my $line (@cfg_lines) {
+    # Label and value of each line
+    my $label = $line->{LABEL};
+    my $value = $line->{VALUE};
+
+    next LINE unless $label; # ignore blank or comment line
+
+    # Strip out BLD prefix from all labels
+    my $prefix = $cfg_label{BDECLARE} . '::';
+    $label = substr ($label, length ($prefix))
+      if index (uc ($label), $prefix) == 0;
+
+    next LINE unless $label; # ignore blank or comment line
+
+    # Configuration file type/version, ignore
+    next LINE if uc $label eq $cfg_label{CFGFILE}{TYPE};
+    next LINE if uc $label eq $cfg_label{CFGFILE}{VERSION};
+
+    # User variable, ignore
+    next LINE if index (uc ($label), '%') == 0;
+
+    # Build name
+    if (uc $label eq $cfg_label{NAME}) {
+      $self->{NAME} = $value;
+      next LINE;
+    }
+
+    # Build directory tree
+    $prefix = $cfg_label{DIR} . '::';
+    if (index (uc ($label), $prefix) == 0) {
+      my $name = substr uc ($label), length ($prefix);
+      $self->{DIR}{$name} = expand_tilde $value;
+      next LINE;
+    }
+
+    # Source directory
+    $prefix = $cfg_label{SRCDIR} . '::';
+    if (index (uc ($label), $prefix) == 0) {
+      my $name = substr $label, length ($prefix);
+      $name    =~ s/::/__/g;
+      $self->{SRCDIR}{$name} = expand_tilde $value;
+      next LINE;
+    }
+
+    # Automatic source directory search?
+    if (uc $label eq $cfg_label{SEARCH_SRC}) {
+      $self->{SEARCH} = $value;
+      next LINE;
+    }
+
+    # Pre-process flag, directory/file requires pre-processing before all tasks
+    $prefix = $cfg_label{PP};
+    if (index (uc ($label), $prefix) == 0) {
+      my @flds = split /::/, $label;
+      my $name = uc shift @flds;
+      $name    = join '__', ($name, @flds) if @flds;
+      $self->{PP}{$name} = $value;
+      next LINE;
+    }
+
+    # Specify name of top level or package library
+    $prefix = $cfg_label{LIB};
+    if (index (uc ($label), $prefix) == 0) {
+      my @flds = split /::/, $label;
+      shift @flds;
+      my $name = @flds ? join ('__', @flds) : '';
+      $self->{LIB}{$name} = $value;
+
+      next LINE;
+    }
+
+    # Specify extra executable dependencies and BLOCKDATA dependency
+    for my $name (qw/EXE_DEP BLOCKDATA/) {
+      $prefix = $cfg_label{$name};
+
+      if (index (uc ($label), $prefix) == 0) {
+        my @flds = split /::/, $label;
+        shift @flds;
+        my $target = @flds ? $flds[0] : '';
+        my @deps   = split /\s+/, $value;
+
+        # If $value is a null string, set executable to depend on all objects
+        if (not @deps) {
+          if ($name eq 'BLOCKDATA') {
+
+            # Label not recognised
+            w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
+                     ': "', $label, '" declaration must have a value';
+            next LINE;
+
+          } else {
+            push @deps, '';
+          }
+        }
+
+        for my $dep (@deps) {
+          $dep =~ s/::/__/g;
+
+          $self->config->assign_setting (
+            LABELS => [$name, $target, $dep],
+            VALUE  => 1,
+          );
+        }
+
+        next LINE;
+      }
+    }
+
+    # Build target
+    if (uc $label eq $cfg_label{TARGET}) {
+      push @{ $self->{TARGET} }, split (/\s+/, $value);
+      next LINE;
+    }
+
+    # Rename a main program target
+    $prefix = $cfg_label{EXE_NAME};
+    if (index (uc ($label), $prefix) == 0) {
+      my @flds = split /::/, $label;
+      shift @flds;
+      my $name = shift @flds;
+
+      if ($name and $value) {
+        $self->config->assign_setting (
+          LABELS => ['EXE_NAME', $name],
+          VALUE  => $value,
+        );
+
+        next LINE;
+      }
+    }
+
+    # Build tool
+    $prefix = $cfg_label{TOOL} . '::';
+    if (index (uc ($label), $prefix) == 0) {
+      my $name = substr $label, length ($prefix);
+      my @flds = split /::/, $name;
+
+      $name = uc (shift @flds);
+
+      if (exists $tools{$name}) {
+        $name = join '__', ($name, @flds) if @flds;
+
+        $self->config->assign_setting (
+          LABELS => ['TOOL', $name],
+          VALUE  => $value,
+        );
+        next LINE;
+      }
+    }
+
+    # File name extension and type
+    for my $name (qw/INFILE_EXT OUTFILE_EXT/) {
+      $prefix = $cfg_label{$name};
+      if (index (uc ($label), $prefix) == 0) {
+        my $key = (split /::/, $label)[1];
+        $key    = uc $key if $name eq 'OUTFILE_EXT';
+
+        my $val = ($name eq 'INFILE_EXT') ? uc $value : $value;
+
+        $self->config->assign_setting (
+          LABELS => [$name, $key],
+          VALUE  => $val,
+        );
+        next LINE;
+      }
+    }
+
+    # Dependency scan exclusion
+    $prefix = $cfg_label{EXCL_DEP};
+    if (index (uc ($label), $prefix) == 0) {
+      my @flds = split /::/, $label;
+      shift @flds;
+
+      my $pk = @flds ? join ('__', @flds) : '';
+      $self->config->assign_setting (
+        LABELS => ['EXCL_DEP', uc ($value), $pk],
+        VALUE  => 1,
+      );
+      next LINE;
+    }
+
+    # Use (inherit from) another build
+    if (uc $label eq $cfg_label{USE}) {
+      my $use = Fcm::Build->new (
+        CONFIG  => $self->config,
+        CFG_SRC => expand_tilde ($value),
+      );
+      $use->decipher_cfg;
+      $use->check_dir;
+      push @{ $self->{USE} }, $use;
+      next LINE;
+    }
+
+    # Inheritance flag
+    $prefix = $cfg_label{INHERIT} . '::';
+    if (index (uc ($label), $prefix) == 0) {
+      my $name = substr $label, length ($prefix);
+      my @flds = split /::/, $name;
+
+      $name = uc (shift @flds);
+
+      for my $flag (qw/SRCDIR PP LIB TARGET/) {
+        if ($name eq $cfg_label{$flag}) {
+          $name = @flds ? join ('__', ($flag, @flds)) : $flag;
+          $self->{INHERIT}{$name} = $value;
+          next LINE;
+        }
+      }
+    }
+
+    # Label not recognised
+    w_report 'ERROR: ', $line->{SRC}, ': LINE ', $line->{NUMBER}, ': label "',
+             $label, '" not recognised';
+    return;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $bld->check_dir ();
+#
+# DESCRIPTION
+#   This method checks whether the build directories are set correctly.
+# ------------------------------------------------------------------------------
+
+sub check_dir {
+  my $self = shift;
+
+  # Make sure build root directory is set
+  if (not $self->{DIR}{ROOT}) {
+    w_report 'Error: build root directory not set.';
+    return;
+  }
+
+  # Set value of build sub-directories if necessary
+  for my $name (keys %{ $self->config->setting ('DIR') }) {
+    next if $self->{DIR}{$name};
+
+    $self->{DIR}{$name} = catfile (
+      $self->{DIR}{ROOT},
+      $self->config->setting ('DIR', $name),
+    );
+  }
+
+  # Search src/ sub-directory if necessary
+  if ($self->{SEARCH} and -d $self->{DIR}{SRC}) {
+    my %dir = find_srcdir ($self->{DIR}{SRC});
+    for my $name (keys %dir) {
+      $self->{SRCDIR}{$name} = $dir{$name} unless $self->{SRCDIR}{$name};
+    }
+  }
+
+  # Expand source directory paths if necessary
+  for my $name (keys %{ $self->{SRCDIR} }) {
+    if ($self->{SRCDIR}{$name} =~ /^\w/) {
+      my $src_search  = catfile $self->{DIR}{SRC} , $self->{SRCDIR}{$name};
+      my $root_search = catfile $self->{DIR}{ROOT}, $self->{SRCDIR}{$name};
+
+      if ($self->{DIR}{SRC} and -d $src_search) {
+        $self->{SRCDIR}{$name} = $src_search;
+
+      } elsif (-d $root_search) {
+        $self->{SRCDIR}{$name} = $root_search;
+
+      } else {
+        w_report 'Warning: cannot locate declared source directory: ',
+                 $self->{SRCDIR}{$name};
+        next;
+      }
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $bld->check_lock ();
+#
+# DESCRIPTION
+#   This method checks whether a lock is set in the current build.
+# ------------------------------------------------------------------------------
+
+sub check_lock {
+  my $self = shift;
+
+  my $rootdir  = $self->{DIR}{ROOT};
+  my $lock_ext = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_EXT/));
+  my $lock_bld = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_BLD/));
+
+  # Always throw error if extract lock exists
+  if (-e $lock_ext) {
+    w_report 'ERROR: extract lock file exists: ', $lock_ext, ',';
+    w_report '       an extract may be running at ', $rootdir, ', abort.';
+    return;
+  }
+
+  # Always throw error if build lock exists
+  if (-e $lock_bld) {
+    w_report 'ERROR: build lock file exists: ', $lock_bld, ',';
+    w_report '       a build may be running at ', $rootdir, ', abort.';
+    return;
+  }
+
+  # Check locks in inherited build
+  for my $use (@{ $self->{USE} }) {
+    return unless $use->check_lock;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_set_lock ();
+#
+# DESCRIPTION
+#   This method sets a lock is set in the current build.
+# ------------------------------------------------------------------------------
+
+sub _set_lock {
+  my $self = shift;
+
+  $self->{LOCK} = catfile (
+    $self->{DIR}{ROOT}, $self->config->setting (qw/MISC LOCK_BLD/),
+  );
+
+  &touch_file ($self->{LOCK});
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_setup_dir (FULL => $full);
+#
+# DESCRIPTION
+#   This internal method sets up the build directories.
+# ------------------------------------------------------------------------------
+
+sub _setup_dir {
+  my $self = shift;
+  my %args = @_;
+
+  my $full = exists $args{FULL} ? $args{FULL} : 0;
+
+  my $tar      = $self->config->setting (qw/OUTFILE_EXT TAR/);
+  my @tar_dirs = split /,/, $self->config->setting (qw/TAR_DIRS/);
+  my $verbose  = $self->config->verbose;
+
+  if ($full) {
+    # Remove sub-directories/archives created from previous builds
+    for my $name (qw/BIN BLD DONE ETC FLAGS INC LIB PPSRC OBJ TMP/) {
+      &run_command ([qw/rm -rf/, $self->{DIR}{$name}], PRINT => $verbose)
+        if -d $self->{DIR}{$name};
+
+      &run_command ([qw/rm -f/, $self->{DIR}{$name} . $tar], PRINT => $verbose)
+        if -f $self->{DIR}{$name} . $tar;
+    }
+
+    # Remove cache
+    my @files;
+    if (-d $self->{DIR}{CACHE} and opendir DIR, $self->{DIR}{CACHE}) {
+      @files = grep {$_ ne '.' and $_ ne '..'} readdir 'DIR';
+      closedir DIR;
+    }
+
+    my $extension = '\\' . $self->config->setting (qw/CACHE PCKFILE/) . '|' .
+                    '\\' . $self->config->setting (qw/CACHE PCKPPDEPEND/) . '|' .
+                    '\\' . $self->config->setting (qw/CACHE PCKDEPEND/);
+
+
+    for my $file (@files) {
+      next unless $file eq $self->config->setting (qw/CACHE BLDTOOL/) or
+                  $file eq $self->config->setting (qw/CACHE PPOPTION/) or
+                  $file eq $self->config->setting (qw/CACHE EXE_DEP/) or
+                  $file =~ /$extension$/;
+
+      my $path = File::Spec->catfile ($self->{DIR}{CACHE}, $file);
+      &run_command ([qw/rm -f/, $path], PRINT => $verbose);
+    }
+
+  } else {
+    # Extract archives if necessary
+    for my $name (@tar_dirs) {
+      my $tar_file = $self->{DIR}{$name} . $tar;
+
+      if (-f $tar_file) {
+        &run_command ([qw/tar -x -f/, $tar_file], PRINT => $verbose > 1);
+        &run_command ([qw/rm -f/, $tar_file], PRINT => $verbose > 1);
+      }
+    }
+  }
+
+  # Set up search paths
+  for my $name (keys %{ $self->{DIR} }) {
+    $self->{PATH}{$name} = [$self->_get_inherited_paths ($name)];
+
+    $self->config->assign_setting (
+      LABELS => ['PATH', $name],
+      VALUE  => $self->{PATH}{$name},
+    )
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_bld_info ();
+#
+# DESCRIPTION
+#   This internal method sets up the inheritance relationship for source
+#   directories and targets, and other configurations required by the build.
+# ------------------------------------------------------------------------------
+
+sub _update_bld_info {
+  my $self = shift;
+
+  # Set up build targets
+  $self->{TARGET} = [$self->_get_inherited_items ('TARGET')];
+
+  # Set up PP switches
+  $self->{PP} = {$self->_get_inherited_items ('PP')};
+
+  # Set up source directory packages for this build
+  my %srcdir = $self->_get_inherited_items ('SRCDIR');
+  for my $name (keys %srcdir) {
+    my $package = Fcm::SrcPackage->new (
+      CONFIG     => $self->config,
+      NAME       => $name,
+      CURRENT    => exists $self->{SRCDIR}{$name},
+      REQUIREPP  => $self->_require_pp ($name),
+      SEARCHPATH => [$self->_get_inherited_srcdirs ($name)],
+    );
+
+    $package->update_file_info ();
+
+    $self->{PACKAGE}{$name} = $package;
+  }
+
+  # Set up runtime dependency scan patterns
+  my %dep_pattern = %{ $self->config->setting ('DEP_PATTERN') };
+  for my $key (keys %dep_pattern) {
+    my $pattern = $dep_pattern{$key};
+
+    while ($pattern =~ /##([\w:]+)##/g) {
+      my $match = $1;
+      my $val   = $self->config->setting (split (/::/, $match));
+
+      last unless defined $val;
+      $val =~ s/\./\\./;
+
+      $pattern =~ s/##$match##/$val/;
+    }
+
+    $self->config->assign_setting (
+      LABELS => ['DEP_PATTERN', $key],
+      VALUE  => $pattern,
+    ) unless $pattern eq $dep_pattern{$key};
+  }
+
+  # Set up top level library name
+  {
+    $self->{LIB} = {$self->_get_inherited_items ('LIB')};
+
+    my $lib = $self->{LIB}{''};
+    $lib    = ($self->{NAME} ? $self->{NAME} : 'fcm_default') unless $lib;
+    $self->{LIB}{''} = $lib;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_regen_rule_info ();
+#
+# DESCRIPTION
+#   This internal method compares the current EXE_DEP, BLOCKDATA and EXE_NAME
+#   declarations and the previous. If changed, the REGEN_MAKERULE flag will be
+#   set to true and the cache will be updated.
+# ------------------------------------------------------------------------------
+
+sub _update_regen_rule_info {
+  my $self = shift;
+
+  # Look for an extra executable dependency cache file
+  my $cachebase = $self->config->setting (qw/CACHE EXE_DEP/);
+  my $incache   = find_file_in_path $cachebase, $self->{PATH}{CACHE};
+
+  my $uptodate = 0;
+  my @inlines  = ();
+
+  # Read cache if it exists
+  if ($incache and -r $incache) {
+    my $incfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $incache);
+    $incfg->read_cfg;
+
+    @inlines  = $incfg->lines;
+    $uptodate = 1;
+  }
+
+  # Prepare output lines
+  my $outcfg = Fcm::CfgFile->new (CONFIG => $self->config);
+  $outcfg->add_line (COMMENT => 'EXE_DEP cache');
+
+  # List of extra executable dependencies
+  my %exe_dep   = %{ $self->config->setting ('EXE_DEP') };
+  for my $target (sort keys %exe_dep) {
+    $outcfg->add_line (
+      LABEL => ($target ? 'OBJECTS__' . $target : 'OBJECTS'),
+      VALUE => join (' ', sort keys %{ $exe_dep{$target} }),
+    );
+  }
+
+  # List of BLOCKDATA dependencies
+  my %blockdata = %{ $self->config->setting ('BLOCKDATA') };
+  for my $target (sort keys %blockdata) {
+    $outcfg->add_line (
+      LABEL => ($target ? 'BLOCKDATA__' . $target : 'BLOCKDATA'),
+      VALUE => join (' ', sort keys %{ $blockdata{$target} }),
+    );
+  }
+
+  # List of EXE_NAME
+  my %exe_name = %{ $self->config->setting ('EXE_NAME') };
+  for my $target (sort keys %exe_name) {
+    $outcfg->add_line (
+      LABEL => 'EXE_NAME__' . $target,
+      VALUE => $exe_name{$target},
+    );
+  }
+
+  # Compare cache with current output
+  my @outlines = $outcfg->lines ();
+
+  $uptodate = 0 if @inlines != @outlines;
+
+  if ($uptodate) {
+    for my $i (0 .. $#outlines) {
+      next unless $inlines[$i]->{LABEL} and $outlines[$i]->{LABEL};
+
+      if ($inlines[$i]->{LABEL} ne $outlines[$i]->{LABEL} or
+          $inlines[$i]->{VALUE} ne $outlines[$i]->{VALUE}) {
+        $uptodate = 0;
+        last;
+      }
+    }
+  }
+
+  # Update cache if it is out of date
+  $outcfg->print_cfg (catfile ($self->{DIR}{CACHE}, $cachebase))
+    unless $uptodate;
+
+  # If out to date, set regenerate make rule flag to true
+  $self->config->assign_setting (
+    LABELS => [qw/REGEN_MAKERULE/],
+    VALUE  => ! $uptodate,
+  );
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_pp_info ();
+#
+# DESCRIPTION
+#   This internal method compares the current set of pre-processor options
+#   with that of the previous build using a "cache" file. If some
+#   pre-processor options have changed, the method updates the cache file and
+#   remove the "make" rules for the appropriate source packages.
+# ------------------------------------------------------------------------------
+
+sub _update_pp_info {
+  my $self = shift;
+
+  # Look for a PP option cache file
+  my $cachebase = $self->config->setting (qw/CACHE PPOPTION/);
+  my $incache   = find_file_in_path $cachebase, $self->{PATH}{CACHE};
+
+  my @chgpp = ();
+  my %newpp = %{ $self->{PP} };
+
+  # Read config if exists, otherwise marked all current PP flags as "changed"
+  if ($incache and -r $incache) {
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $incache);
+    $cfg->read_cfg;
+
+    my @lines   = $cfg->lines;
+    my %oldpp = ();
+
+    for my $line (@lines) {
+      next unless $line->{LABEL};
+
+      $oldpp{$line->{LABEL}} = $line->{VALUE};
+    }
+
+    # Compare new and old, mark as "changed" if changed or does not exist in old
+    @chgpp = (grep {
+      exists $oldpp{$_} ? $oldpp{$_} ne $newpp{$_} : 1;
+    } keys %newpp);
+
+    # Compare old and new, mark as "changed" if not exist in new
+    push @chgpp, (grep {not exists $newpp{$_}} keys %oldpp);
+
+  } else {
+    @chgpp = keys %newpp;
+  }
+
+  if (@chgpp) {
+    for my $name (@chgpp) {
+      for my $package (values %{ $self->{PACKAGE} }) {
+        next if $package->newpp;
+
+        if (('PP__' . $package->name) =~ /^$name(?:__|$)/) {
+          $package->current (1);
+          $package->newpp   (1);
+        }
+      }
+    }
+
+    # Update the PP cache file if necessary
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+    for my $name (keys %newpp) {
+      $cfg->add_line (LABEL => $name, VALUE => $newpp{$name});
+    }
+    $cfg->add_line unless $cfg->lines;
+
+    $cfg->print_cfg (catfile ($self->{DIR}{CACHE}, $cachebase));
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_tool_info ();
+#
+# DESCRIPTION
+#   This internal method compares the current set of build tools with that of
+#   the previous build using a "cache" file. If some build tools have changed,
+#   the method updates the cache file and (the time stamps of) dummy "flags"
+#   files to denote changes in build tools from the previous build.
+# ------------------------------------------------------------------------------
+
+sub _update_tool_info {
+  my $self = shift;
+
+  # Look for a build tool cache file
+  my $cachebase = $self->config->setting (qw/CACHE BLDTOOL/);
+  my $incache   = find_file_in_path $cachebase, $self->{PATH}{CACHE};
+
+  my @chgtool = ();
+  my %newtool = %{ $self->config->setting ('TOOL') };
+
+  # Read config if exists, otherwise marked all current tools as "changed"
+  if ($incache and -r $incache) {
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $incache);
+    $cfg->read_cfg;
+
+    my @lines   = $cfg->lines;
+    my %oldtool = ();
+
+    for my $line (@lines) {
+      next unless $line->{LABEL};
+
+      $oldtool{$line->{LABEL}} = $line->{VALUE};
+    }
+
+    # Compare new and old, mark as "changed" if changed or does not exist in old
+    @chgtool = (grep {
+      exists $oldtool{$_} ? $oldtool{$_} ne $newtool{$_} : 1;
+    } keys %newtool);
+
+    # Compare old and new, mark as "changed" if not exist in new
+    push @chgtool, (grep {not exists $newtool{$_}} keys %oldtool);
+
+  } else {
+    @chgtool = keys %newtool;
+  }
+
+  if (@chgtool) {
+    # Update the time stamps of dummy files for changed tools
+    $self->_create_build_dir ('FLAGS');
+
+    my $ext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+    for my $name (@chgtool) {
+      my $file = catfile $self->{DIR}{FLAGS}, $name . $ext;
+
+      # Create/touch the file
+      touch_file $file or croak 'Unable to update: ', $file, ', abort';
+
+      print 'Updated: ', $file, "\n" if $self->config->verbose > 2;
+    }
+
+    # Update the build tool cache file if necessary
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+    for my $name (keys %newtool) {
+      $cfg->add_line (LABEL => $name, VALUE => $newtool{$name});
+    }
+
+    $cfg->print_cfg (catfile ($self->{PATH}{CACHE}->[0], $cachebase));
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_pre_process ();
+#
+# DESCRIPTION
+#   This internal method obtains a list of source files that require
+#   pre-processing in the source packages of this build, and attempts to
+#   pre-process them. The method returns 1 on success.
+# ------------------------------------------------------------------------------
+
+sub _pre_process {
+  my $self = shift;
+
+  # Go through source packages/files to see if PP is required
+  my @srcfiles = ();
+  for my $package (values %{ $self->{PACKAGE} }) {
+    next unless $package->requirepp;
+
+    $package->scan_dependency (HEADER_ONLY => 1);
+
+    push @srcfiles, grep ({$_->is_type_or (qw/FPP C/)} $package->srcfile);
+  }
+
+  return 1 unless @srcfiles;
+
+  my %task     = ();
+  my $flagsext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+  my $pdoneext = $self->config->setting (qw/OUTFILE_EXT PDONE/);
+
+  # Set up tasks for each source file
+  for my $srcfile (@srcfiles) {
+    my $command  = $srcfile->is_type ('FPP') ? 'FPP' : 'CPP';
+    my @pck_list = $srcfile->get_package_list;
+    my @pknames  = split '__', pop (@pck_list);
+
+    # Set up a PP build task for each source file
+    my $target    = $srcfile->base . $pdoneext;
+    my $ppkeyname = join ('__', ($command . 'KEYS' , @pknames)) . $flagsext;
+    my $flagsname = join ('__', ($command . 'FLAGS', @pknames)) . $flagsext;
+
+    # Issue warning for duplicated tasks
+    if (exists $task{$target}) {
+      w_report 'Warning: ', $target, ': unable to create task for: ',
+               $srcfile->src, ': task already exists for: ',
+               $task{$target}->srcfile->src;
+      next;
+    }
+
+    $task{$target} = Fcm::BuildTask->new (
+      CONFIG     => $self->config,
+      TARGET     => $target,
+      TARGETPATH => $self->{PATH}{DONE},
+      SRCFILE    => $srcfile,
+      DEPENDENCY => [$ppkeyname, $flagsname, ($srcfile->dep ('H'))],
+      ACTIONTYPE => 'PP',
+    );
+
+    # Set up update ppkeys/flags build tasks for each source file/package
+    for my $i (0 .. $#pknames) {
+      my $name  = join '__', @pknames [0 .. $i];     # package name
+      my $dname = join '__', @pknames [0 .. $i - 1]; # dependent package name
+
+      for my $flag (qw/KEYS FLAGS/) {
+        my $fullflag = $command . $flag;
+        my $target   = join '__', ($fullflag, $name);
+        my $depend   = $dname ? join '__', ($fullflag, $dname) : $fullflag;
+
+        $target .= $flagsext;
+        $depend .= $flagsext;
+
+        next if exists $task{$target};
+
+        $task{$target} = Fcm::BuildTask->new (
+          CONFIG     => $self->config,
+          TARGET     => $target,
+          TARGETPATH => $self->{PATH}{FLAGS},
+          DEPENDENCY => [$depend],
+          ACTIONTYPE => 'UPDATE',
+        );
+      }
+    }
+  }
+
+  # Set up update global ppkeys/flags build tasks
+  for my $command (qw/CPP FPP/) {
+    for my $flag ('', qw/KEYS FLAGS/) {
+      my $target = $command . $flag . $flagsext;
+
+      $task{$target} = Fcm::BuildTask->new (
+        CONFIG     => $self->config,
+        TARGET     => $target,
+        TARGETPATH => $self->{PATH}{FLAGS},
+        ACTIONTYPE => 'UPDATE',
+      );
+    }
+  }
+
+  # Set up build tasks to copy all header files
+  for my $package (values %{ $self->{PACKAGE} }) {
+    my @files = grep {$_->is_type (qw/CPP INCLUDE/)} $package->srcfile;
+
+    # Author's note: may also want to issue warning for duplicated tasks
+
+    for my $file (@files) {
+      $task{$file->base} = Fcm::BuildTask->new (
+        CONFIG     => $self->config,
+        TARGET     => $file->base,
+        TARGETPATH => $self->{PATH}{INC},
+        SRCFILE    => $file,
+        DEPENDENCY => [$file->dep ('H')],
+        ACTIONTYPE => 'COPY',
+      );
+    }
+  }
+
+  # Build all PP tasks
+  my $count = 0;
+
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'PP';
+
+    my $rc = $task->action (TASKLIST => \%task);
+    $count++ if $rc;
+  }
+
+  print 'Number of pre-processed files: ', $count, "\n"
+    if $self->config->verbose and $count;
+
+  # Change path and file type of pre-processed source files
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'PP';
+
+    # Remove header dependencies from source file
+    my %dep = $task->srcfile->dep ();
+    for my $key (keys %dep) {
+      delete $dep{$key} if $dep{$key} eq 'H';
+    }
+    $task->srcfile->dep (\%dep);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_generate_f9x_interface ();
+#
+# DESCRIPTION
+#   This internal method obtains a list of Fortran 9X source files in the
+#   source packages of this build, and attempts to generate an interface block
+#   file for each of the Fortran 9X source files. The method returns 1 on
+#   success.
+# ------------------------------------------------------------------------------
+
+sub _generate_f9x_interface {
+  my $self = shift;
+
+  # Go through source packages/files for Fortran 9x source files with
+  # standalone subroutines or functions
+  my @srcfiles = ();
+  for my $package (values %{ $self->{PACKAGE} }) {
+    next unless $package->current;
+
+    push @srcfiles, grep {
+      $_->is_type_or (qw/FORTRAN9X FPP9X/) and
+      uc ($_->select_tool ('GENINTERFACE')) ne 'NONE' and
+      not $_->is_type_or (qw/PROGRAM MODULE INCLUDE/)
+    } $package->srcfile;
+  }
+
+  my $flagsext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+  my $pdoneext = $self->config->setting (qw/OUTFILE_EXT PDONE/);
+
+  # Set up build task to generate interface files for all selected Fortran 9x
+  # sources
+  my %task         = ();
+  for my $srcfile (@srcfiles) {
+    my $target  = $srcfile->interfacebase . $pdoneext;
+    my @pknames = split '__', ($srcfile->get_package_list)[-1];
+    my $flag    = join ('__', ('GENINTERFACE', @pknames)) . $flagsext;
+
+    $task{$target} = Fcm::BuildTask->new (
+      CONFIG     => $self->config,
+      TARGET     => $target,
+      TARGETPATH => $self->{PATH}{DONE},
+      SRCFILE    => $srcfile,
+      DEPENDENCY => [$flag],
+      ACTIONTYPE => 'GENINTERFACE',
+    );
+
+    # Set up build tasks for each source file/package flags file for interface
+    # generator tool
+    for my $i (0 .. $#pknames) {
+      my $name   = join '__', @pknames [0 .. $i];     # package name
+      my $dname  = join '__', @pknames [0 .. $i - 1]; # dependent package name
+
+      my $target = join '__', ('GENINTERFACE', $name);
+      my $depend = $dname ? join '__', ('GENINTERFACE', $dname) : 'GENINTERFACE';
+
+      $target .= $flagsext;
+      $depend .= $flagsext;
+
+      next if exists $task{$target};
+
+      $task{$target} = Fcm::BuildTask->new (
+        CONFIG     => $self->config,
+        TARGET     => $target,
+        TARGETPATH => $self->{PATH}{FLAGS},
+        DEPENDENCY => [$depend],
+        ACTIONTYPE => 'UPDATE',
+      );
+    }
+  }
+
+  # Set up build task to update the flags file for interface generator tool
+  {
+    my $target     = 'GENINTERFACE' . $flagsext;
+    $task{$target} = Fcm::BuildTask->new (
+      CONFIG     => $self->config,
+      TARGET     => $target,
+      TARGETPATH => $self->{PATH}{FLAGS},
+      ACTIONTYPE => 'UPDATE',
+    );
+  }
+
+  my $count = 0;
+
+  # Performs task
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'GENINTERFACE';
+
+    my $rc = $task->action (TASKLIST => \%task);
+    $count++ if $rc;
+  }
+
+  print 'Number of generated interfaces: ', $count, "\n"
+    if $self->config->verbose and $count;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_scan_dependency ();
+#
+# DESCRIPTION
+#   This internal method goes through each source package to obtain dependency
+#   information from their source files. It returns 1 on success.
+# ------------------------------------------------------------------------------
+
+sub _scan_dependency {
+  my $self = shift;
+
+  # Go through source packages/files
+  my $count = 0;
+
+  for my $package (values %{ $self->{PACKAGE} }) {
+    my $rc = $package->scan_dependency;
+    $count++ if $rc;
+  }
+
+  print 'Scanned files in ', $count, ' package(s) for dependency', "\n"
+    if $self->config->verbose and $count;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_set_targets ();
+#
+# DESCRIPTION
+#   This internal method determines the default targets to be built.
+# ------------------------------------------------------------------------------
+
+sub _set_targets {
+  my $self = shift;
+
+  # Targets of the build
+  if (not @{ $self->{TARGET} }) {
+    # Build targets not specified by user, default to building all main programs
+    my @programs = ();
+
+    # Get all main programs from all packages
+    for my $package (values %{ $self->{PACKAGE} }) {
+      my @srcfiles = grep {$_->exebase} $package->srcfile;
+
+      for (@srcfiles) {
+        push @programs, $_->exebase;
+      }
+    }
+
+    @programs = sort (@programs);
+
+    if (@programs) {
+      # Build main programs, if there are any
+      @{ $self->{TARGET} } = @programs;
+
+    } else {
+      # No main program in source tree, build the default library
+      @{ $self->{TARGET} } = (
+        'lib' . $self->{LIB}{''} . $self->config->setting (qw/OUTFILE_EXT LIB/),
+      );
+    }
+  }
+
+  return @{ $self->{TARGET} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_write_make_rules ();
+#
+# DESCRIPTION
+#   This internal method writes the included make rules if necessary.
+# ------------------------------------------------------------------------------
+
+sub _write_make_rules {
+  my $self   = shift;
+  my $return = 1;
+
+  # Get list of all packages
+  my %allpcks = $self->allpcks;
+
+  # Get list of types that cannot have duplicated targets
+  my @no_duplicated_target_types = split (
+    /,/, $self->config->setting ('NO_DUPLICATED_TARGET_TYPE'),
+  );
+
+  my $unusual = 0;
+  my $count   = 0;
+  my %targets;
+  for my $name (sort keys %allpcks) {
+    # Check whether package is an actual package of the build
+    my $package  = exists $self->{PACKAGE}{$name} ? $self->{PACKAGE}{$name} : '';
+
+    # Regenerate make rules if this flag is set to true
+    my $regen_mk;
+
+    # Register non-word package name
+    if (not $name =~ /^\w*$/) {
+      $self->config->assign_setting (
+        LABELS => ['FCM_PCK_OBJECTS', $name],
+        VALUE  => 'FCM_PCK_OBJECTS' . $unusual++,
+      );
+
+      # Set regenerate make rule flag to true
+      $regen_mk = 1;
+    }
+
+    # Cycle loop if not an actual package of the build
+    next unless $package;
+
+    # Check whether make rule for each source package needs updating. Yes if:
+    # 1. package name contains non-word characters
+    # 2. the config setting REGEN_MAKERULE is set to true
+    # 3. package is current and the make rule for the package is out of date
+    $regen_mk = (
+      $regen_mk or
+      $self->config->setting ('REGEN_MAKERULE') or
+      ($package->current and not $package->makerule_uptodate)
+    );
+
+    # Update make rule for source package, if necessary
+    $count += $package->write_makerule () if $regen_mk;
+
+    # Check for duplicated rules
+    for my $srcfile (sort $package->srcfile) {
+      next unless $srcfile->type;
+
+      my %rules = $srcfile->required_rules;
+
+      for my $key (sort keys %rules) {
+        if (exists $targets{$key}) {
+          # Duplicated target: warning for most file types
+          my $status = 'WARNING';
+
+          # Duplicated target: error for the following file types
+          if (@no_duplicated_target_types and
+              $srcfile->is_type_or (@no_duplicated_target_types) and
+              $targets{$key}->is_type_or (@no_duplicated_target_types)) {
+            $status = 'ERROR';
+            $return = 0;
+          }
+
+          # Report the warning/error
+          w_report $status, ': ', $key, ': duplicated targets for building:';
+          w_report '       ', $targets{$key}->src;
+          w_report '       ', $srcfile->src;
+
+        } else {
+          $targets{$key} = $srcfile;
+        }
+      }
+    }
+  }
+
+  # Diagnostic
+  print 'Updated make rules for ', $count, ' package(s).', "\n"
+    if $count and $self->config->verbose;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_write_makefile ();
+#
+# DESCRIPTION
+#   This internal method writes the "Makefile" for this build.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile {
+  my $self = shift;
+
+  # Makefile header
+  # ----------------------------------------------------------------------------
+  my $makefile = '# Automatic Makefile' . "\n\n";
+
+  # Name of the build
+  $makefile .= 'FCM_BUILD_NAME = ' . $self->{NAME} . "\n" if $self->{NAME};
+  
+  # Location of FCM config file
+  $makefile .= 'FCM_BLD_CFG = ' . $self->cfg->src . "\n";
+
+  # Targets of the build
+  $makefile .= 'FCM_BLD_TARGETS = ' . join (' ', ($self->_set_targets)) . "\n\n";
+
+  # Perl library
+  # ----------------------------------------------------------------------------
+  {
+    my $libdir  = dirname (dirname ($INC{'Fcm/Build.pm'}));
+    my @libpath = split /:/, ($ENV{PERL5LIB} ? $ENV{PERL5LIB} : '');
+
+    if (not grep (m/$libdir/, @libpath)) {
+      $makefile .= 'export PERL5LIB := ' . $libdir;
+      $makefile .= ':$(PERL5LIB)' if exists $ENV{PERL5LIB};
+      $makefile .= "\n\n";
+    }
+  }
+
+  # Build directories
+  # ----------------------------------------------------------------------------
+  my @keys    = ('ROOT', sort grep {$_ ne 'ROOT'} keys (%{ $self->{DIR} }));
+  my $rootdir = $self->{DIR}{ROOT};
+
+  # Build sub-directories
+  for my $name (@keys) {
+    my $dir = $self->{DIR}{$name};
+    $dir    =~ s/^$rootdir/\$(FCM_ROOTDIR)/ unless $name eq 'ROOT';
+
+    $makefile .= 'export FCM_' . $name . 'DIR = ' . $dir . "\n";
+  }
+
+  $makefile .= "\n";
+
+  # Build sub-directory paths
+  for my $name (@keys) {
+    my @path = @{ $self->{PATH}{$name} };
+    shift @path;
+
+    $makefile .= 'export FCM_' . $name . 'PATH = ' .
+                 join (':', ('$(FCM_' . $name . 'DIR)', @path)) . "\n";
+  }
+
+  $makefile .= "\n";
+
+  # Build tools
+  # ----------------------------------------------------------------------------
+  # List of build tools
+  my $tool          = $self->config->setting ('TOOL');
+
+  # List of tools local to FCM, (will not be exported)
+  my %localtool     = map {($_, 1)} split (    # map into a hash table
+    /,/, $self->config->setting ('LOCALTOOL'), # split comma separated list
+  );
+
+  # Export required tools
+  my $unusual_count = 0;
+  for my $name (sort keys %$tool) {
+    # Ignore local tools
+    my $topname = (split (/__/, $name))[0];
+    next if exists $localtool{$topname};
+
+    if ($name =~ /^\w+$/) {
+      # Tools with normal name, just export it as an environment variable
+      $makefile .= 'export ' . $name . ' = ' . $tool->{$name} . "\n";
+
+    } else {
+      # Tools with unusual characters, export using a label/value pair
+      $makefile .= 'export FCM_UNUSUAL_TOOL_LABEL' . $unusual_count . ' = ' .
+                   $name . "\n";
+      $makefile .= 'export FCM_UNUSUAL_TOOL_VALUE' . $unusual_count . ' = ' .
+                   $tool->{$name} . "\n";
+      $unusual_count++;
+    }
+  }
+
+  $makefile .= "\n";
+
+  # Verbose mode
+  # ----------------------------------------------------------------------------
+  $makefile .= 'export FCM_VERBOSE ?= ' . $self->config->verbose . "\n\n";
+
+  # VPATH
+  # ----------------------------------------------------------------------------
+  # $name is internal name of build sub-directories
+  # $type is the type of files
+  for my $name (sort keys %{ $self->config->setting ('VPATH') }) {
+    my @types = split /,/, $self->config->setting ('VPATH', $name);
+
+    for my $type (sort @types) {
+      # If $type is EMPTY, it is a file with no file name extension
+      if (uc ($type) eq 'EMPTY') {
+        $makefile .= 'vpath % $(FCM_' . $name . 'PATH)' . "\n";
+
+      } elsif ($type =~ s/^(in|out)://i) {
+        if (uc ($1) eq 'IN') {
+          # If $type begins with IN:<type>, it is a list of file extensions that
+          # can be found under the INFILE_EXT hash in the configuration setting,
+          # with <type> matching a keyword in the values of the hash.
+          my %infile_ext = %{ $self->config->setting ('INFILE_EXT') };
+
+          for my $ext (sort keys %infile_ext) {
+            $makefile .= 'vpath %.' . $ext . ' $(FCM_' . $name . 'PATH)' . "\n"
+              if grep {$_ eq $type} split /::/, $infile_ext{$ext};
+          }
+
+        } else {
+          # If $type begins with OUT:<type>, it is the value of a hash element
+          # in the OUTFILE_EXT hash in the configuration setting, with <type>
+          # matching the key.
+          my $ext    = $self->config->setting ('OUTFILE_EXT', $type);
+          $makefile .= 'vpath %' . $ext . ' $(FCM_' . $name . 'PATH)' . "\n";
+        }
+
+      } else {
+        # Otherwise, $type is a VPATH pattern recognised by "make".
+        $makefile .= 'vpath ' . $type . ' $(FCM_' . $name . 'PATH)' . "\n";
+      }
+    }
+  }
+
+  # VPATH for dummy files
+  $makefile .= 'vpath %.dummy $(FCM_DONEDIR)' . "\n";
+  $makefile .= "\n";
+
+  # Default targets
+  # ----------------------------------------------------------------------------
+  $makefile .= '.PHONY : all clean' . "\n\n";
+  $makefile .= 'all : $(FCM_BLD_TARGETS)' . "\n\n";
+  $makefile .= 'clean : ' . "\n";
+  $makefile .= "\t" . 'rm -rf';
+  for my $dir (qw/BIN LIB OBJ DONE/) {
+    $makefile .= ' $(FCM_' . $dir . 'DIR)' if exists $self->{DIR}{$dir};
+  }
+  $makefile .= "\n";
+  $makefile .= "\t" . 'rm -f lib__*' .
+               $self->config->setting (qw/OUTFILE_EXT LIB/) .
+               ' *' . $self->config->setting (qw/OUTFILE_EXT OBJ/) . "\n";
+  $makefile .= "\n";
+
+  # Targets for copy dummy
+  $makefile .= $self->config->setting (qw/MISC CPDUMMY/) . ' :' . "\n";
+  $makefile .= "\t" . 'touch $@' . "\n\n";
+
+  # Targets for all (non-main-program) objects and libraries
+  # ----------------------------------------------------------------------------
+  my %allpcks = $self->allpcks;
+  for my $key (reverse sort keys %allpcks) {
+    # Objects variable
+    my $var;
+    if ($self->config->setting ('FCM_PCK_OBJECTS', $key)) {
+      # Package name contains unusual characters, use predefined variable
+      $var = $self->config->setting ('FCM_PCK_OBJECTS', $key);
+
+    } else {
+      # Normal package name, prefix the package name with "OBJECTS__"
+      # Top level package, simply set to "OBJECTS"
+      $var = $key ? join ('__', ('OBJECTS', $key)) : 'OBJECTS';
+    }
+
+    # Export top level OBJECTS variable
+    # but keep sub-package OBJECTS variables local to the Makefile
+    $makefile .= ($var eq 'OBJECTS' ? 'export ' : '') . $var . ' =';
+
+    # Add objects from children
+    if (@{ $allpcks{$key} }) {
+      # List of sub-packages of current package
+      my @deps   = map {
+        if ($self->config->setting ('FCM_PCK_OBJECTS', $_)) {
+          # Package name contains unusual characters, use predefined variable
+          '$(' . $self->config->setting ('FCM_PCK_OBJECTS', $_) . ')';
+
+        } else {
+          # Normal package name, prefix the package name with "OBJECTS__"
+          '$(OBJECTS__' . $_ . ')';
+        }
+      } @{ $allpcks{$key} };
+
+      $makefile .= ' ' . join (' ', sort @deps);
+    }
+
+    # Add its own objects
+    if (exists $self->{PACKAGE}{$key}) {
+      # List of source files in the current package
+      my @files = sort {$a->base cmp $b->base} $self->{PACKAGE}{$key}->srcfile;
+
+      for my $file (@files) {
+        # Consider compilable source files only
+        next unless $file->objbase;
+
+        # Ignore main programs and Fortran BLOCKDATA program units
+        next if $file->is_type_or (qw/PROGRAM BLOCKDATA/);
+
+        # Add to object list
+        $makefile .= ' ' . $file->objbase;
+      }
+    }
+
+    $makefile .= "\n\n";
+
+    # Library target
+    my $lib = exists ($self->{LIB}{$key}) ? $self->{LIB}{$key} : $key;
+    $lib    = 'lib' . $lib . $self->config->setting (qw/OUTFILE_EXT LIB/);
+
+    $makefile .= $lib . ' : $(' . $var . ')' . "\n";
+    $makefile .= "\t" . 'fcm_internal archive $@ $(^F)' . "\n\n";
+  }
+
+  # Targets for top level and package flags files and dummy dependencies
+  my %src_tool   = %{ $self->config->setting ('SRC_TOOL') };
+  my %flags_tool = (LD => '', LDFLAGS => '');
+
+  for my $key (keys %src_tool) {
+    $flags_tool{$src_tool{$key}{FLAGS}} = $src_tool{$key}{COMPILER}
+      if exists $src_tool{$key}{FLAGS};
+
+    $flags_tool{$src_tool{$key}{PPKEYS}} = ''
+      if exists $src_tool{$key}{PPKEYS};
+  }
+
+  my $ext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+  for my $name (sort keys %flags_tool) {
+    # Flags files for tool command
+    if ($flags_tool{$name}) {
+      $makefile .= $flags_tool{$name} . $ext . ' :' . "\n";
+      $makefile .= "\t" . 'touch ' . catfile ('$(FCM_FLAGSDIR)', '$@') . "\n\n";
+    }
+
+    # Top level flags files
+    $makefile .= $name . $ext . ' :';
+    $makefile .= ' ' . $flags_tool{$name} . $ext if $flags_tool{$name};
+    $makefile .= "\n\t" . 'touch ' . catfile ('$(FCM_FLAGSDIR)', '$@') . "\n\n";
+
+    # Package level flags files
+    for my $key (sort keys %allpcks) {
+      next unless @{ $allpcks{$key} }; # ignore packages without children
+
+      my $depend  = $key ? join '__', ($name, $key) : $name;
+      my @targets = sort map {$name . '__' . $_ . $ext} @{ $allpcks{$key} };
+
+      $makefile .= join (' ', @targets) . ' : ' . $depend . $ext . "\n";
+      $makefile .= "\t" . 'touch ' . catfile ('$(FCM_FLAGSDIR)', '$@') .
+                   "\n\n";
+    }
+  }
+
+  # Include source package make rules
+  # ----------------------------------------------------------------------------
+  for my $package (sort {$a->name cmp $b->name} values %{ $self->{PACKAGE} }) {
+    my $mkbase = $package->name . $self->config->setting (qw/OUTFILE_EXT MK/);
+    my $mkfile = find_file_in_path ($mkbase, $self->{PATH}{BLD});
+
+    if ($mkfile) {
+      if (index ($mkfile, $self->{DIR}{BLD}) == 0) {
+        $mkfile = catfile '$(FCM_BLDDIR)',
+                  substr ($mkfile, length ($self->{DIR}{BLD}) + 1);
+
+      } elsif (index ($mkfile, $self->{DIR}{ROOT}) == 0) {
+        $mkfile = catfile '$(FCM_ROOTDIR)',
+                  substr ($mkfile, length ($self->{DIR}{ROOT}) + 1);
+      }
+
+      $makefile .= 'include ' . $mkfile . "\n";
+
+    } else {
+      my $pck = join ('::', split (/__/, $package->name));
+      w_report 'Warning: no make rule file for source package: ', $pck;
+    }
+  }
+
+  $makefile .= "\n" . '# EOF' . "\n";
+
+  # Print Makefile
+  # ----------------------------------------------------------------------------
+  $self->_create_build_dir ('BLD');
+  my $out = catfile (
+    $self->{DIR}{BLD}, $self->config->setting (qw/MISC MAKEFILE/),
+  );
+
+  # Check whether an old file exists, if so compare current contents with it
+  my $old = '';
+
+  if (-r $out) {
+    open OLD, '<', $out or croak 'Cannot open "', $out, '" (', $!, '), abort';
+    my @lines = readline 'OLD';
+    close OLD;
+
+    $old = join ('', @lines);
+  }
+
+  # Update Makefile if changed
+  if ($old ne $makefile) {
+    open OUT, '>', $out or croak 'Cannot open "', $out, '" (', $!, '), abort';
+    print OUT $makefile;
+    close OUT or croak 'Cannot close "', $out, '" (', $!, '), abort';
+
+    print 'Updated Makefile: ', $out, "\n" if $self->config->verbose;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_invoke_make (
+#     TARGETS => \@targets,
+#     JOBS    => $jobs,
+#     ARCHIVE => $archive,
+#   );
+#
+# DESCRIPTION
+#   This internal method invokes the "make" command to make the build.
+#
+# ARGUMENTS
+#   TARGETS - Specify targets to be built. If set, these targets will be built
+#             instead of the ones specified in the build configuration file.
+#   JOBS    - Specify number of jobs that can be handled by "make". If set,
+#             the value must be a natural integer. If not set, the default
+#             value is 1 (i.e. run "make" in serial mode).
+#   ARCHIVE - If set to "true", invoke the "archive" mode. Most build files and
+#             directories created by this build will be archived using the
+#             "tar" command. If not set, the default is not to invoke the
+#             "archive" mode.
+# ------------------------------------------------------------------------------
+
+sub _invoke_make {
+  my $self = shift;
+  my %args = @_;
+
+  # Build the make command from the specified targets
+  my @targets  = exists $args{TARGETS} ? @{ $args{TARGETS} } : qw/all/;
+  my $jobs     = exists $args{JOBS}    ? $args{JOBS}         : 1;
+  my $archive  = exists $args{ARCHIVE} ? $args{ARCHIVE}      : 0;
+  my $verbose  = $self->config->verbose;
+
+  # Create the required build directories
+  for my $dir (qw/BIN DONE ETC INC FLAGS LIB OBJ TMP/) {
+    $self->_create_build_dir ($dir);
+  }  
+
+  my @commands = ();
+  my @make_cmd = ($self->config->setting (qw/TOOL MAKE/));
+  push @make_cmd, split (/\s+/, $self->config->setting (qw/TOOL MAKEFLAGS/));
+  push @make_cmd, $self->config->setting (qw/TOOL MAKE_SILENT/)
+    unless $verbose > 2;
+
+  if ($jobs > 1) { # multi-process "make"
+    my $make_job = $self->config->setting (qw/TOOL MAKE_JOB/);
+
+    # Setup the "make" commands for each target
+    while (my $target = shift @targets) {
+      if ($target eq 'clean') { # Do not run "clean" in parallel
+        push @commands, [@make_cmd, $target];
+
+      } else {
+        push @commands, [@make_cmd, $make_job, $jobs, $target];
+      }
+    }
+
+  } else { # single process "make"
+
+    # Setup the "make" command
+    push @commands, [@make_cmd, @targets];
+
+  }
+  
+  # Run the make command
+  my $rc  = 0;
+  my $cwd = cwd;
+  print 'cd ', $self->{DIR}{BLD}, "\n" if $verbose > 2;
+  chdir $self->{DIR}{BLD};
+  while (my $cmd = shift @commands) {
+    $| = 1; # flush STDOUT before running "make"
+    print timestamp_command (&get_command_string ($cmd)) if $verbose > 2;
+    $| = 0;
+    &run_command ($cmd, ERROR => 'warn', RC => \$rc);
+    print timestamp_command (&get_command_string ($cmd), 'End') if $verbose > 2;
+    last if $rc;
+  }
+  print 'cd ', $cwd, "\n" if $verbose > 2;
+  chdir $cwd;
+
+  return $rc ? undef : 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_remove_empty_dirs ();
+#
+# DESCRIPTION
+#   This internal method removes empty build directories.
+# ------------------------------------------------------------------------------
+
+sub _remove_empty_dirs {
+  my $self = shift;
+
+  for my $name (qw/BIN CACHE DONE ETC FLAGS INC LIB PPSRC OBJ TMP/) {
+    opendir DIR, $self->{DIR}{$name};
+    my @files = readdir DIR;
+    @files    = grep !/^\.\.?$/, @files;
+    closedir DIR;
+
+    if (not @files) {
+      print 'Remove directory: ', $self->{DIR}{$name}, "\n"
+        if $self->config->verbose > 1;
+      rmdir $self->{DIR}{$name};
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_tar_build_dirs ();
+#
+# DESCRIPTION
+#   This internal method creates TAR archives for selected build directories.
+# ------------------------------------------------------------------------------
+
+sub _tar_build_dirs {
+  my $self = shift;
+
+  # Create TAR archives if necessary
+  my $cwd = cwd;
+
+  my $tar      = $self->config->setting (qw/OUTFILE_EXT TAR/);
+  my @tar_dirs = split /,/, $self->config->setting (qw/TAR_DIRS/);
+  my $verbose  = $self->config->verbose;
+
+  for my $name (@tar_dirs) {
+    my $dir = $self->{DIR}{$name};
+
+    if (-d $dir) {
+      my $base = basename ($dir);
+      print 'cd ', dirname ($dir), "\n" if $verbose > 2;
+      chdir dirname ($dir);
+
+      my $rc = &run_command (
+        [qw/tar -c -f/, $base . $tar, $base],
+        PRINT => $verbose > 1, ERROR => 'warn',
+      );
+
+      &run_command ([qw/rm -rf/, $base], PRINT => $verbose > 1) if not $rc;
+    }
+  }
+
+  print 'cd ', $cwd, "\n" if $verbose > 2;
+  chdir $cwd;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_create_runenv_script ();
+#
+# DESCRIPTION
+#   This internal method creates the runtime environment script if necessary.
+# ------------------------------------------------------------------------------
+
+sub _create_runenv_script {
+  my $self = shift;
+
+  # More diagnostic on how to use the build
+  my @bin_dirs = grep {-d} @{ $self->{PATH}{BIN} };
+  my $etc_dir  = -d $self->{DIR}{ETC} ? $self->{DIR}{ETC} : undef;
+
+  if (@bin_dirs or $etc_dir) {
+    # Create a runtime environment script if necessary
+    my $run_env_sh_base = $self->config->setting (qw/MISC RUN_ENV_SH/);
+    my $run_env_sh      = catfile $self->{DIR}{ROOT}, $run_env_sh_base;
+
+    open FILE, '>', $run_env_sh
+      or croak $run_env_sh, ': cannot open (', $!, '), abort';
+    print FILE '#!/usr/bin/ksh', "\n";
+    print FILE 'export PATH=', join (':', @bin_dirs), ':$PATH', "\n"
+      if @bin_dirs;
+    print FILE 'export FCM_ETCDIR=', $self->{DIR}{ETC}, "\n" if $etc_dir;
+    close FILE or croak $run_env_sh, ': cannot close (', $!, '), abort';
+
+    # Create symbolic link in bin/ sub-directory for backward compatibility
+    if (-d $self->{DIR}{BIN}) {
+      my $file = catfile ($self->{DIR}{BIN}, $run_env_sh_base);
+      
+      # Remove old link if necessary
+      unlink $file if -l $file and readlink ($file) ne $run_env_sh;
+
+      # Create the new link
+      symlink $run_env_sh, $file if not -l $file;
+    }
+
+    # Information on the location/usage of the runtime environment script
+    if ($self->config->verbose > 1 and $run_env_sh) {
+      print '# ', '-' x 78, "\n";
+      print '# To use this build, source the following shell script:', "\n";
+      print '. ', $run_env_sh, "\n";
+      print '# ', '-' x 78, "\n";
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_create_lib_excl_dep ();
+#
+# DESCRIPTION
+#   This internal method creates a set of exclude dependency configurations for
+#   libraries of this build.
+# ------------------------------------------------------------------------------
+
+sub _create_lib_excl_dep {
+  my $self = shift;
+
+  if (-d $self->{DIR}{LIB}) {
+    $self->_create_build_dir ('ETC');
+    
+    my %allpcks  = $self->allpcks;
+    my $cfgext   = $self->config->setting (qw/OUTFILE_EXT CFG/);
+    my %cfglabel = %{ $self->config->setting ('CFG_LABEL') };
+
+    for my $key (reverse sort keys %allpcks) {
+      my $outcfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+      # Include configurations from sub-packages
+      for my $subpck (@{ $allpcks{$key} }) {
+        my $base = 'lib' . $subpck . $cfgext;
+        ($base = $self->{LIB}{$subpck}) =~ s/\.\w+$/$cfgext/
+          if exists ($self->{LIB}{$subpck});
+        my $file = catfile ('$HERE', $base);
+
+        $outcfg->add_line (LABEL => $cfglabel{INC}, VALUE => $file)
+          if -r catfile ($self->{DIR}{ETC}, $base);;
+      }
+
+      # Exclude dependency for source files in current package
+      if (exists $self->{PACKAGE}{$key}) {
+        my @srcfiles = $self->{PACKAGE}{$key}->srcfile;
+
+        for my $srcfile (@srcfiles) {
+          if ($srcfile->is_type ('INCLUDE')) {
+            if ($srcfile->is_type ('CPP')) {
+              $outcfg->add_line (
+                LABEL => $cfglabel{EXCL_DEP},
+                VALUE => 'H::' . $srcfile->base,
+              );
+
+            } elsif ($srcfile->is_type ('INTERFACE')) {
+              $outcfg->add_line (
+                LABEL => $cfglabel{EXCL_DEP},
+                VALUE => 'INTERFACE::' . $srcfile->base,
+              );
+
+            } else {
+              $outcfg->add_line (
+                LABEL => $cfglabel{EXCL_DEP},
+                VALUE => 'INC::' . $srcfile->base,
+              );
+            }
+
+          } elsif ($srcfile->is_type ('SOURCE')) {
+            next if $srcfile->is_type_or (qw/PROGRAM BLOCKDATA/);
+
+            if ($srcfile->is_type ('FORTRAN')) {
+              if ($srcfile->is_type (qw/FORTRAN MODULE/)) {
+                $outcfg->add_line (
+                  LABEL => $cfglabel{EXCL_DEP},
+                  VALUE => 'USE::' . $srcfile->root,
+                );
+
+              } else {
+                $outcfg->add_line (
+                  LABEL => $cfglabel{EXCL_DEP},
+                  VALUE => 'INTERFACE::' . $srcfile->interfacebase,
+                ) if $srcfile->interfacebase;
+
+                $outcfg->add_line (
+                  LABEL => $cfglabel{EXCL_DEP},
+                  VALUE => 'OBJ::' . $srcfile->root,
+                );
+              }
+
+            } else {
+              $outcfg->add_line (
+                LABEL => $cfglabel{EXCL_DEP},
+                VALUE => 'OBJ::' . $srcfile->root,
+              );
+            }
+          }
+        }
+      }
+
+      # Name of configuration file, follows the name of library
+      my $outbase ='lib' . $key . $cfgext;
+      ($outbase = $self->{LIB}{$key}) =~ s/\.\w+$/$cfgext/
+        if exists ($self->{LIB}{$key});
+      my $outfile = catfile ($self->{DIR}{ETC}, $outbase);
+
+      # Write to configuration file
+      $outcfg->print_cfg ($outfile);
+    }
+
+    # Information on the location/usage of the exclude dependency configurations
+    if ($self->config->verbose > 1) {
+      my $etcdir = $self->{DIR}{ETC};
+      print '# ', '-' x 78, "\n";
+      print <<EOF;
+# To use a library archive of this build in another FCM build, you need to
+# include in the new build configuration the corresponding configuration file
+# that has the relevant exclude dependency information. These configurations
+# files can be found in $etcdir.
+EOF
+      print '# ', '-' x 78, "\n";
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_create_build_dir ();
+#   $self->_create_build_dir ($label);
+#
+# DESCRIPTION
+#   This internal method creates a build directory. If $label is specified,
+#   the method will attempt to create a named sub-directory according to
+#   $label. Otherwise, the method attempts to create the build root
+#   directory. Returns the name of the directory if it is created successfully
+#   or if it already exists.
+# ------------------------------------------------------------------------------
+
+sub _create_build_dir {
+  my $self  = shift;
+  my $label = $_[0] ? uc $_[0] : 'ROOT';
+
+  my $dir = undef;
+
+  # Make sure the variable is set
+  if ($self->{DIR}{$label}) {
+    $dir = $self->{DIR}{$label};
+
+    # Expand relative path if necessary
+    $dir = catfile $self->{DIR}{ROOT}, $dir if $dir =~ /^\w/;
+
+  } else {
+    if ($label eq 'ROOT') {
+      w_report 'Error: build root directory not set.';
+      return;
+
+    } elsif ($self->config->setting ('DIR', $label)) {
+      $dir = catfile $self->{DIR}{ROOT}, $self->config->setting ('DIR', $label);
+
+    } else {
+      carp 'Directory label "', $label, '" not recognised';
+      return undef;
+    }
+  }
+
+  # Set up the bld directory, if required
+  if (not -d $dir) {
+    print 'Make directory: ', $dir, "\n" if $self->config->verbose > 1;
+    mkpath $dir or croak 'Cannot create directory "', $dir, '"';
+  }
+
+  $self->{DIR}{$label} = $dir unless $self->{DIR}{$label};
+
+  return $dir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_inherited_paths ($name);
+#
+# DESCRIPTION
+#   This recursive internal method returns a list containing the search path
+#   for a build directory named by the internal label $name. (Please note that
+#   a build directory will only be placed into the search path if the
+#   directory exists.)
+# ------------------------------------------------------------------------------
+
+sub _get_inherited_paths {
+  my $self = shift;
+  my $name = shift;
+
+  return () unless $name and exists $self->{DIR}{$name};
+
+  my @path = ();
+
+  # Recursively inherit the search path for a this type of build directory
+  for my $use (@{ $self->{USE} }) {
+    my @cur_path = $use->_get_inherited_paths ($name);
+    unshift @path, @cur_path;
+  }
+
+  # Place the path of the current build in the front
+  unshift @path, $self->{DIR}{$name};
+
+  return @path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_inherited_srcdirs ($name);
+#
+# DESCRIPTION
+#   This recursive internal method returns a list containing the search path
+#   for a source directory named by the internal package label $name. (Please
+#   note that a source directory will only be placed into the search path if
+#   the directory exists.)
+# ------------------------------------------------------------------------------
+
+sub _get_inherited_srcdirs {
+  my $self = shift;
+  my $name = shift;
+
+  return () unless $name;
+
+  my @path = ();
+
+  # Recursively inherit the search path for this source directory
+  my $key = 'SRCDIR__' . $name;
+  if ($self->_inherit_ok ($key)) {
+    for my $use (@{ $self->{USE} }) {
+      my @cur_path = $use->_get_inherited_srcdirs ($name);
+      unshift @path, @cur_path;
+    }
+  }
+
+  # Place the path of the current source in the front
+  unshift @path, $self->{SRCDIR}{$name}
+    if exists $self->{SRCDIR}{$name} and -d $self->{SRCDIR}{$name};
+
+  return @path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_inherited_items ($type);
+#
+# DESCRIPTION
+#   This recursive internal method returns a list containing an inherited
+#   build item of the type $type. (Depending of $type, the returned list can
+#   be an array or a hash.)
+# ------------------------------------------------------------------------------
+
+sub _get_inherited_items {
+  my $self = shift;
+  my $type = shift;
+
+  return () if not exists $self->{$type};
+
+  if (ref $self->{$type} eq 'ARRAY') {
+
+    my @items = ();
+
+    # Recursively inherit from used builds
+    if ($self->{INHERIT}{$type}) {
+      for my $use (@{ $self->{USE} }) {
+        my @cur_items = $use->_get_inherited_items ($type);
+
+        for my $item (@cur_items) {
+          my $type_item = $type . '__' . $item;
+
+          # Check inheritance option of current item
+          next unless $self->_inherit_ok ($type_item);
+
+          # The statement ensures that there is no duplication
+          push @items, $item unless grep {$_ eq $item} @items;
+        }
+      }
+    }
+
+    # Items in current build
+    if (@{ $self->{$type} }) {
+      for my $item (@{ $self->{$type} }) {
+        # The statement ensures that there is no duplication
+        push @items, $item unless grep {$_ eq $item} @items;
+      }
+    }
+
+    return @items;
+
+  } elsif (ref $self->{$type} eq 'HASH') {
+
+    my %items = ();
+
+    # Recursively inherit from used builds
+    if ($self->{INHERIT}{$type}) {
+      for my $use (@{ $self->{USE} }) {
+        my %cur_items = $use->_get_inherited_items ($type);
+
+        for my $name (keys %cur_items) {
+          my $type_name = $type . '__' . $name;
+
+          # Check inheritance option of current item
+          next unless $self->_inherit_ok ($type_name);
+
+          # "Closer" ancestors overrides more "distant" ones
+          $items{$name} = $cur_items{$name};
+        }
+      }
+    }
+
+    # Items in current build
+    if (%{ $self->{$type} }) {
+      for my $name (keys %{ $self->{$type} }) {
+        # Settings in current build override inherited settings
+        $items{$name} = $self->{$type}{$name};
+      }
+    }
+
+    return %items;
+
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_require_pp ($name);
+#
+# DESCRIPTION
+#   This internal method returns true if source package $name requires
+#   pre-processing.
+# ------------------------------------------------------------------------------
+
+sub _require_pp {
+  my $self = shift;
+  my $name = $_[0];
+
+  my $rc    = 0;
+  my @names = 'PP';
+  push @names, (split /__/, $name);
+
+  # Check whether pre-process flag exists, going up the source package hierarchy
+  do {
+    my $cur_name = join '__', @names;
+    if (exists $self->{PP}{$cur_name}) {
+      $rc = $self->{PP}{$cur_name};
+      return $rc;
+    }
+  } while pop @names;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_inherit_ok ($name);
+#
+# DESCRIPTION
+#   This internal method returns true if it is OK to inherit an item specified
+#   by $name, (where $name is a double underscore "__" delimited positional
+#   list of source package names).
+# ------------------------------------------------------------------------------
+
+sub _inherit_ok {
+  my $self  = shift;
+  my $name  = $_[0];
+
+  my $rc    = 1;
+  my @names = split /__/, $name;
+
+  # Check whether INHERIT flag exists, going up the source package hierarchy
+  do {
+    my $cur_name = join '__', @names;
+    if (exists $self->{INHERIT}{$cur_name}) {
+      $rc = $self->{INHERIT}{$cur_name};
+      return $rc;
+    }
+  } while pop @names;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/BuildTask.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/BuildTask.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/BuildTask.pm	(revision 6412)
@@ -0,0 +1,406 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::BuildTask
+#
+# DESCRIPTION
+#   This class hosts information of a build task in the FCM build system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::BuildTask;
+
+# Standard pragma
+use strict;
+use warnings;
+
+# Standard modules
+use Carp;
+use File::Compare;
+use File::Basename;
+use File::Path;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $task = Fcm::BuildTask->new (
+#     CONFIG     => $config,
+#     TARGET     => $target,
+#     TARGETPATH => \@targetpath,
+#     SRCFILE    => $srcfile,
+#     DEPENDENCY => \@dependency,
+#     TASKTYPE   => $tasktype,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::BuildTask class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   TARGET     - target name for this task
+#   TARGETPATH - search path for the target
+#   SRCFILE    - reference to input Fcm::SrcFile instance
+#   DEPENDENCY - list of dependencies for this target
+#   TASKTYPE   - type of task to build the target
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self  = {
+    CONFIG      => exists $args{CONFIG}     ? $args{CONFIG}     : &main::cfg,
+    TARGET      => exists $args{TARGET}     ? $args{TARGET}     : undef,
+    TARGETPATH  => exists $args{TARGETPATH} ? $args{TARGETPATH} : [],
+    SRCFILE     => exists $args{SRCFILE}    ? $args{SRCFILE}    : undef,
+    DEPENDENCY  => exists $args{DEPENDENCY} ? $args{DEPENDENCY} : [],
+    ACTIONTYPE  => exists $args{ACTIONTYPE} ? $args{ACTIONTYPE} : undef,
+
+    OUTPUT      => undef,
+    OUTPUTMTIME => undef,
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $task->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcfile = $task->srcfile;
+#   $task->srcfile ($srcfile);
+#
+# DESCRIPTION
+#   This method returns the reference to the input Fcm::SrcFile instance
+#   associated with this task. If an argument is specified, the reference is
+#   modified to the value given by the argument.
+# ------------------------------------------------------------------------------
+
+sub srcfile {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SRCFILE} = $_[0];
+  }
+
+  return $self->{SRCFILE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $actiontype = $task->actiontype;
+#   $task->actiontype ($actiontype);
+#
+# DESCRIPTION
+#   This method returns the action type of this task. If an argument is
+#   specified, the action type of this task is set to the value of the
+#   argument.
+# ------------------------------------------------------------------------------
+
+sub actiontype {
+  my $self = shift;
+
+  if (@_) {
+    $self->{ACTIONTYPE} = $_[0];
+  }
+
+  return $self->{ACTIONTYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $output = $task->output;
+#   $task->output ($output);
+#
+# DESCRIPTION
+#   This method returns the name of the output file after the task has been
+#   performed successfully. If an argument is specified, it sets the output
+#   file (and its last modified time) to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub output {
+  my $self = shift;
+
+  if (@_) {
+    $self->{OUTPUT}      = $_[0];
+    $self->{OUTPUTMTIME} = (stat $self->{OUTPUT}) [9];
+  }
+
+  return $self->{OUTPUT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $time = $task->outputmtime;
+#
+# DESCRIPTION
+#   This method returns the modified time of the output file.
+# ------------------------------------------------------------------------------
+
+sub outputmtime {
+  my $self = shift;
+
+  return $self->{OUTPUTMTIME};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $task->action (TASKLIST => \%tasklist);
+#
+# DESCRIPTION
+#   This method performs the task action and sets the output accordingly. The
+#   argument TASKLIST must be a reference to a hash containing the other tasks
+#   of the build, which this task may depend on. The keys of the hash must the
+#   name of the target names of the tasks, and the values of the hash must be
+#   the references to the corresponding Fcm::BuildTask instances. The method
+#   returns true if the task has been performed to create a new version of the
+#   target.
+# ------------------------------------------------------------------------------
+
+sub action {
+  my $self     = shift;
+  my %args     = @_;
+  my $tasklist = exists $args{TASKLIST} ? $args{TASKLIST} : {};
+
+  return unless $self->actiontype;
+
+  my $uptodate     = 1;
+  my $dep_uptodate = 1;
+
+  # Check if dependencies are up to date
+  # ----------------------------------------------------------------------------
+  for my $depend (@{ $self->{DEPENDENCY} }) {
+    if (exists $tasklist->{$depend}) {
+      if (not $tasklist->{$depend}->output) {
+        # Dependency task output is not set, performs its task action
+        if ($tasklist->{$depend}->action (TASKLIST => $tasklist)) {
+          $uptodate     = 0;
+          $dep_uptodate = 0;
+        }
+      }
+
+    } elsif ($self->config->verbose > 1) {
+      w_report 'Warning: Task for "', $depend,
+               '" does not exist, may be required by ', $self->{TARGET};
+    }
+  }
+
+  # Check if the target exists in the search path
+  # ----------------------------------------------------------------------------
+  if (@{ $self->{TARGETPATH} }) {
+    my $output = find_file_in_path ($self->{TARGET}, $self->{TARGETPATH});
+    $self->output ($output) if $output;
+  }
+
+  # Target is out of date if it does not exist
+  if ($uptodate) {
+    $uptodate = 0 if not $self->output;
+  }
+
+  # Check if current target is older than its dependencies
+  # ----------------------------------------------------------------------------
+  if ($uptodate) {
+    for my $depend (@{ $self->{DEPENDENCY} }) {
+      next unless exists $tasklist->{$depend};
+
+      if ($tasklist->{$depend}->outputmtime > $self->outputmtime) {
+        $uptodate     = 0;
+        $dep_uptodate = 0;
+      }
+    }
+
+    if ($uptodate and ref $self->srcfile) {
+      $uptodate = 0 if $self->srcfile->mtime > $self->outputmtime;
+    }
+  }
+
+  if ($uptodate) {
+    # Current target and its dependencies are up to date
+    # --------------------------------------------------------------------------
+    if ($self->actiontype eq 'PP') {
+      # "done" file up to date, set name of pre-processed source file
+      # ------------------------------------------------------------------------
+      my $base     = $self->srcfile->root . lc ($self->srcfile->ext);
+      my @pck_list = $self->srcfile->get_package_list;
+      pop @pck_list;
+      my @pknames  = split '__', pop (@pck_list);
+      my @path     = map {
+        catfile ($_, @pknames);
+      } @{ $self->config->setting (qw/PATH PPSRC/) };
+      my $oldfile = find_file_in_path ($base, \@path);
+      $self->srcfile->ppsrc ($oldfile);
+    }
+
+  } else {
+    # Perform action is not up to date
+    # --------------------------------------------------------------------------
+    # (For GENINTERFACE and PP, perform action if "done" file not up to date)
+    my $new_output = @{ $self->{TARGETPATH} }
+                     ? catfile ($self->{TARGETPATH}[0], $self->{TARGET})
+                     : $self->{TARGET};
+
+    # Create destination container directory if necessary
+    my $destdir = dirname $new_output;
+
+    if (not -d $destdir) {
+      print 'Make directory: ', $destdir, "\n" if $self->config->verbose > 2;
+      mkpath $destdir;
+    }
+
+    # List of actions
+    if ($self->actiontype eq 'UPDATE') {
+      # Action is UPDATE: Update file
+      # ------------------------------------------------------------------------
+      print 'Update: ', $new_output, "\n" if $self->config->verbose > 2;
+      touch_file $new_output
+        or croak 'Unable to update "', $new_output, '", abort';
+      $self->output ($new_output);
+
+    } elsif ($self->actiontype eq 'COPY') {
+      # Action is COPY: copy file to destination if necessary
+      # ------------------------------------------------------------------------
+      my $copy_required = ($dep_uptodate and $self->output and -r $self->output)
+                          ? compare ($self->output, $self->srcfile->src)
+                          : 1;
+
+      if ($copy_required) {
+        # Set up copy command
+        &run_command (
+          ['cp', $self->srcfile->src, $destdir],
+          TIME => $self->config->verbose > 2,
+        );
+
+        $self->output ($new_output);
+
+      } else {
+        $uptodate = 1;
+      }
+
+    } elsif ($self->actiontype eq 'PP' or $self->actiontype eq 'GENINTERFACE') {
+      # Action is PP or GENINTERFACE: process file
+      # ------------------------------------------------------------------------
+      my ($newlines, $base, @path);
+
+      if ($self->actiontype eq 'PP') {
+        # Invoke the pre-processor on the source file
+        # ----------------------------------------------------------------------
+        # Get lines in the pre-processed source
+        $newlines = $self->srcfile->pre_process;
+        $base     = $self->srcfile->root . lc ($self->srcfile->ext);
+
+        # Get search path for the existing pre-processed file
+        my @pck_list = $self->srcfile->get_package_list;
+        pop @pck_list;
+        my @pknames  = split '__', pop (@pck_list);
+        @path        = map {
+          catfile ($_, @pknames);
+        } @{ $self->config->setting (qw/PATH PPSRC/) };
+
+      } else { # if ($self->actiontype eq 'GENINTERFACE')
+        # Invoke the interface generator
+        # ----------------------------------------------------------------------
+        # Get new interface lines
+        $newlines = $self->srcfile->gen_interface;
+
+        # Get search path for the existing interface file
+        $base     = $self->srcfile->interfacebase;
+        @path     = @{ $self->config->setting (qw/PATH INC/) },
+      }
+
+
+      # If pre-processed or interface file exists,
+      # compare its content with new lines to see if it has been updated
+      my $update_required = 1;
+      my $oldfile = find_file_in_path ($base, \@path);
+
+      if ($oldfile and -r $oldfile) {
+        # Read old file
+        open FILE, '<', $oldfile;
+        my @oldlines = readline 'FILE';
+        close FILE;
+
+        # Compare old contents and new contents
+        if (@oldlines eq @$newlines) {
+          $update_required = grep {
+            $oldlines[$_] ne $newlines->[$_];
+          } (0 .. $#oldlines);
+        }
+      }
+
+      if ($update_required) {
+        # Update the pre-processed source or interface file
+        # ----------------------------------------------------------------------
+        # Determine container directory of the  pre-processed or interface file
+        my $newfile = @path ? catfile ($path[0], $base) : $base;
+
+        # Create the container directory if necessary
+        if (not -d $path[0]) {
+          print 'Make directory: ', $path[0], "\n"
+            if $self->config->verbose > 1;
+          mkpath $path[0];
+        }
+
+        # Update the pre-processor or interface file
+        open FILE, '>', $newfile
+          or croak 'Cannot write to "', $newfile, '" (', $!, '), abort';
+        print FILE @$newlines;
+        close FILE
+          or croak 'Cannot write to "', $newfile, '" (', $!, '), abort';
+        print 'Generated: ', $newfile, "\n" if $self->config->verbose > 1;
+
+        # Set the name of the pre-processed file
+        $self->srcfile->ppsrc ($newfile) if $self->actiontype eq 'PP';
+
+        # Set the "current" flag of the container source package to "true"
+        $self->srcfile->srcpackage->current (1);
+
+      } else {
+        # Content in pre-processed source or interface file is up to date
+        # ----------------------------------------------------------------------
+        $uptodate = 1;
+
+        # Set the name of the pre-processed file
+        $self->srcfile->ppsrc ($oldfile) if $self->actiontype eq 'PP';
+      }
+
+      # Update the "done" file
+      print 'Update: ', $new_output, "\n" if $self->config->verbose > 2;
+      touch_file $new_output
+        or croak 'Unable to update "', $new_output, '", abort';
+      $self->output ($new_output);
+
+    } else {
+      carp 'Action type "', $self->actiontype, "' not supported";
+    }
+  }
+
+  return not $uptodate;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/CfgFile.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/CfgFile.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/CfgFile.pm	(revision 6412)
@@ -0,0 +1,861 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CfgFile
+#
+# DESCRIPTION
+#   This class is used for reading and writing FCM config files. A FCM config
+#   file is a line-based text file that provides information on how to perform
+#   a particular task using the FCM system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CfgFile;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Basename;
+use File::Path;
+use File::Spec;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::Util;
+
+# Local module variables
+my $expand_type   = 'bld|ext'; # config file type that needs variable expansions
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile = Fcm::CfgFile->new (CONFIG=> $config, SRC => $src, TYPE => $type);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CfgFile class.
+#
+# ARGUMENTS
+#   CONFIG - reference to a Fcm::Config instance
+#   SRC    - configuration file source
+#   TYPE   - type of expected configuration file
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG     => exists $args{CONFIG} ? $args{CONFIG} : &main::cfg,
+    SRC        => exists $args{SRC}    ? $args{SRC}    : undef,
+    TYPE       => exists $args{TYPE}   ? $args{TYPE}   : undef,
+
+    # Version of the configuration file
+    VERSION    => undef,
+
+    # List of references to hash tables for each line in the file
+    LINES      => [],
+
+    # Actual source of configuration file
+    ACTUAL_SRC => undef,
+    PEGREV     => undef,
+  };
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $cfgfile->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $src = $cfgfile->src ();
+#   $cfgfile->src ($src);
+#
+# DESCRIPTION
+#   This method returns the specified source of the configuration file. If an
+#   argument is specified, the source of the configuration file is modified to
+#   the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub src {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SRC} = shift;
+  }
+
+  return $self->{SRC};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $src = $cfgfile->actual_src ();
+#
+# DESCRIPTION
+#   This method returns the actual source of the configuration file. If an
+#   argument is specified, the source of the configuration file is modified to
+#   the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub actual_src {
+  my $self = shift;
+
+  return $self->{ACTUAL_SRC};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cfgfile->pegrev ();
+#
+# DESCRIPTION
+#   This method returns the peg revision of the configuration file.
+# ------------------------------------------------------------------------------
+
+sub pegrev {
+  my $self = shift;
+
+  return $self->{PEGREV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $cfgfile->type ();
+#   $cfgfile->type ($type);
+#
+# DESCRIPTION
+#   This method returns the configuration file type. If an argument is
+#   specified, the type is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub type {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TYPE} = shift;
+  }
+
+  return $self->{TYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version = $cfgfile->version ();
+#
+# DESCRIPTION
+#   This method returns the version of the configuration file.
+# ------------------------------------------------------------------------------
+
+sub version {
+  my $self = shift;
+
+  return $self->{VERSION};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @lines = $cfgfile->lines ();
+#
+# DESCRIPTION
+#   This method returns an array containing all "lines" in the configuration
+#   file. Each "line" is a reference to a hash table with the following keys:
+#
+#   SRC     - the source of the configuration file
+#   NUMBER  - the line number in the source
+#   LABEL   - the label of the of the configuration line
+#   VALUE   - the value of the configuration line
+#   COMMENT - comment in the configuration line
+# ------------------------------------------------------------------------------
+
+sub lines {
+  my $self = shift;
+
+  return @{ $self->{LINES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $line = $cfgfile->line ($line_number);
+#
+# DESCRIPTION
+#   This method return a "line" at $line_number in the configuration file. A
+#   "line" is a reference to a hash table with the following keys:
+#
+#   SRC     - the source of the configuration file
+#   NUMBER  - the line number in the source
+#   LABEL   - the label of the of the configuration line
+#   VALUE   - the value of the configuration line
+#   COMMENT - comment in the configuration line
+# ------------------------------------------------------------------------------
+
+sub line {
+  my $self     = shift;
+  my $line_num = shift;
+
+  if (exists $self->{LINES}[$line_num]) {
+    return $self->{LINES}[$line_num]; # returns a ref to a label:value pair hash
+
+  } else {
+    return undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile->add_line (
+#     LABEL   => $label,
+#     VALUE   => $value,
+#     COMMENT => $comment,
+#     SRC     => $src,
+#     NUMBER  => $line_number
+#   );
+#
+# DESCRIPTION
+#   This method adds a "line" to the configuration file. LABEL is the
+#   configuration line label. VALUE is the configuration line value. COMMENT
+#   is the comment in the line. VALUE should only be specified if LABEL is
+#   specified. COMMENT can be specified without LABEL. In such case, the whole
+#   line is a comment line. A blank line is inserted if no argument is
+#   specified. SRC can be specified to indicate the name of the source file
+#   from which this line is obtained. If not specified, the source file of the
+#   current configuration file is used. NUMBER can be specified to indicate
+#   the line number of the source file from which this line is obtained.
+# ------------------------------------------------------------------------------
+
+sub add_line {
+  my $self = shift;
+  my %args = @_;
+
+  my $line = {
+    SRC     => exists $args{SRC    } ? $args{SRC    } : $self->actual_src,
+    NUMBER  => exists $args{NUMBER } ? $args{NUMBER } : 0,
+    LABEL   => exists $args{LABEL  } ? $args{LABEL  } : '',
+    VALUE   => exists $args{VALUE  } ? $args{VALUE  } : '',
+    COMMENT => exists $args{COMMENT} ? $args{COMMENT} : '',
+  };
+
+  push @{ $self->{LINES} }, $line;
+
+  return $line;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile->add_comment_block ($line1, [$line2, ...]);
+#
+# DESCRIPTION
+#   This method adds a comment block to the configuration file. Each argument
+#   represents a line in the comment block.
+# ------------------------------------------------------------------------------
+
+sub add_comment_block {
+  my $self = shift;
+
+  $self->add_line (COMMENT => '-' x 78,);
+
+  while (my $line = shift @_) {
+    $self->add_line (COMMENT => $line,)
+  }
+
+  $self->add_line (COMMENT => '-' x 78,);
+  $self->add_line;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile->add_header ();
+#
+# DESCRIPTION
+#   This method adds a header to the configuration file, with its type and
+#   type version. It returns 1 on success.
+# ------------------------------------------------------------------------------
+
+sub add_header {
+  my $self = shift;
+
+  return undef unless $self->{TYPE};
+
+  $self->{VERSION} = $self->config->setting ('CFG_VERSION', uc ($self->{TYPE}))
+    if not $self->{VERSION};
+
+  $self->add_comment_block ('File header');
+
+  $self->add_line (
+    LABEL => $self->config->setting (qw/CFG_LABEL CFGFILE TYPE/),
+    VALUE => $self->{TYPE},
+  );
+
+  $self->add_line (
+    LABEL => $self->config->setting (qw/CFG_LABEL CFGFILE VERSION/),
+    VALUE => $self->{VERSION},
+  );
+
+  $self->add_line;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $exist = $cfg->label_exists ($label);
+#   @lines = $cfg->label_exists ($label);
+#
+# DESCRIPTION
+#   This method returns the (number of) "lines" with their LABEL matching the
+#   argument $label.
+# ------------------------------------------------------------------------------
+
+sub label_exists {
+  my $self  = shift;
+  my $label = shift;
+
+  return grep {$_->{LABEL} eq $label} @{ $self->{LINES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mtime = $cfgfile->mtime ();
+#
+# DESCRIPTION
+#   This method returns the modified time of the configuration file source.
+# ------------------------------------------------------------------------------
+
+sub mtime {
+  my $self  = shift;
+  my $mtime = undef;
+
+  if (-f $self->{SRC}) {
+    $mtime = (stat $self->{SRC})[9];
+  }
+
+  return $mtime;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $read = $cfgfile->read_cfg ();
+#
+# DESCRIPTION
+#   This method reads the current configuration file. It returns the number of
+#   lines read from the config file, or "undef" if it fails. The result is
+#   placed in the LINES array of the current instance, and can be accessed via
+#   the "lines" method.
+# ------------------------------------------------------------------------------
+
+sub read_cfg {
+  my $self = shift;
+
+  my @lines = $self->_get_cfg_lines;
+
+  # List of CFG labels
+  my %cfg_labels = %{ $self->config->setting ('CFG_LABEL') };
+
+  # List of CFG types that need INC declarations expansion
+  my %exp_inc    = ();
+  for (split (/,/, $self->config->setting ('CFG_EXP_INC'))) {
+    $exp_inc{uc ($_)} = 1;
+  }
+
+  # List of CFG labels that are reserved keywords
+  my %cfg_keywords = ();
+  for (split (/,/, $self->config->setting ('CFG_KEYWORD'))) {
+    $cfg_keywords{$cfg_labels{$_}} = 1;
+  }
+
+  # Loop each line, to separate lines into label : value pairs
+  my $cont = undef;
+  my $here = undef;
+  for my $line_num (1 .. @lines) {
+    my $line = $lines[$line_num - 1];
+    chomp $line;
+
+    my $label   = '';
+    my $value   = '';
+    my $comment = '';
+
+    # If this line is a continuation, set $start to point to the line that
+    # starts this continuation. Otherwise, set $start to undef
+    my $start   = defined ($cont) ? $self->line ($cont) : undef;
+
+    if ($line =~ /^(\s*#.*)$/) { # comment line
+      $comment = $1;
+
+    } elsif ($line =~ /\S/) {    # non-blank line
+      if (defined $cont) {
+        # Previous line has a continuation mark
+        $value = $line;
+
+        # Separate value and comment
+        if ($value =~ s/((?:\s+|^)#\s+.*)$//) {
+          $comment = $1;
+        }
+
+        # Remove leading spaces
+        $value =~ s/^\s*\\?//;
+
+        # Expand environment variables
+        $value = $self->_expand_variable ($value, 1) if $value;
+
+        # Expand internal variables
+        $value = $self->_expand_variable ($value) if $value;
+
+        # Get "line" that begins the current continuation
+        ($start->{VALUE} .= $value) =~ s/\\$//;
+
+      } else {
+        # Previous line does not have a continuation mark
+        if ($line =~ /^\s*(\S+)(?:\s+(.*))?$/) {
+          # Check line contains a valid label:value pair
+          $label = $1;
+          $value = defined ($2) ? $2 : '';
+
+          # Separate value and comment
+          if ($value =~ s/((?:\s+|^)#\s+.*)$//) {
+            $comment = $1;
+          }
+
+          # Remove trailing spaces
+          $value =~ s/\s+$//;
+
+          # Value begins with $HERE?
+          $here  = ($value =~ /\$\{?HERE\}?(?:[^A-Z_]|$)/);
+
+          # Expand environment variables
+          $value = $self->_expand_variable ($value, 1) if $value;
+
+          # Expand internal variables
+          $value = $self->_expand_variable ($value) if $value;
+        }
+      }
+
+      # Determine whether current line ends with a continuation mark
+      if ($value =~ s/\\$//) {
+        $cont = scalar ($self->lines) unless $cont;
+
+      } else {
+        $cont = undef;
+      }
+    }
+
+    if (exists $exp_inc{uc ($self->type)} and
+        uc ($start ? $start->{LABEL} : $label) eq $cfg_labels{INC} and
+        not defined $cont) {
+      # Current configuration file requires expansion of INC declarations
+      # The start/current line is an INC declaration
+      # The current line is not a continuation or is the end of the continuation
+
+      # Get lines from an "include" configuration file
+      my $src = ($start ? $start->{VALUE} : $value);
+      $src   .= '@' . $self->pegrev if $here and $self->pegrev;
+
+      if ($src) {
+        # Invoke a new instance to read the source
+        my $cfg = Fcm::CfgFile->new (
+          SRC    => expand_tilde ($src),
+          TYPE   => $self->type,
+          CONFIG => $self->config,
+        );
+
+        $cfg->read_cfg;
+
+        # Add lines to the "LINES" array in the current configuration file
+        $comment = 'INC ' . $src . ' ';
+        $self->add_line (
+          COMMENT => $comment . '# Start',
+          NUMBER  => ($start ? $start->{NUMBER} : $line_num),
+        );
+        $self->add_line (%{ $_ }) for (($cfg->lines));
+        $self->add_line (COMMENT => $comment . '# End');
+
+      } else {
+        $self->add_line (NUMBER  => $line_num);
+        w_report 'Warning: ', $self->actual_src, ': line ', $line_num,
+                 ': empty INC declaration.' if $self->config->verbose > 2;
+      }
+
+    } else {
+      # Push label:value pair into "LINES" array
+      $self->add_line (
+        LABEL   => $label,
+        VALUE   => ($label ? $value : ''),
+        COMMENT => $comment,
+        NUMBER  => $line_num,
+      );
+    }
+
+    next if defined $cont; # current line not a continuation
+
+    my $slabel = ($start ? $start->{LABEL} : $label);
+    my $svalue = ($start ? $start->{VALUE} : $value);
+    next unless $slabel;
+
+    # Check config file type and version
+    if (uc ($slabel) eq $cfg_labels{CFGFILE}{TYPE}) {
+      $self->type ($svalue);
+
+    } elsif (uc ($slabel) eq $cfg_labels{CFGFILE}{VERSION}) {
+      $self->version ($svalue);
+    }
+
+    # Set internal variable
+    $slabel =~ s/^\%//; # Remove leading "%" from label
+
+    $self->config->assign_variable (
+      LABEL => $slabel,
+      VALUE => $svalue,
+    ) unless exists $cfg_keywords{$slabel};
+  }
+
+  return $self->lines;
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $cfgfile->print_cfg ($file);
+#
+# DESCRIPTION
+#   This method prints the content of current configuration file. If no
+#   argument is specified, it prints output to the standard output. If $file
+#   is specified, and is a writable file name, the output is sent to the file.
+#   If the file already exists, its content is compared to the current output.
+#   Nothing will be written if the content is unchanged. Otherwise, for typed
+#   configuration files, the existing file is renamed using a prefix that
+#   contains its last modified time. The method returns 1 if there is no
+#   error.
+# ------------------------------------------------------------------------------
+
+sub print_cfg {
+  my $self = shift;
+  my $file = shift;
+
+  # Count maximum number of characters in the labels, (for pretty printing)
+  my $max_label_len = 0;
+  for my $line (@{ $self->{LINES} }) {
+    next unless $line->{LABEL};
+    my $label_len  = length $line->{LABEL};
+    $max_label_len = $label_len if $label_len > $max_label_len;
+  }
+
+  # Output string
+  my $out = '';
+
+  # Append each line of the config file to the output string
+  for my $line (@{ $self->{LINES} }) {
+    my $label   = $line->{LABEL};
+    my $value   = $line->{VALUE};
+    my $comment = $line->{COMMENT};
+
+    if ($label) {
+      # Line up label/value for pretty printing
+      $label   = $label . ' ' x ($max_label_len - length ($label));
+      $comment =~ s/^\s+/ / if $comment;
+
+      $out .= $label;
+      $out .= ' ' . $value if defined $value;
+
+    } else {
+      # Make sure comments begin with a "#"
+      $comment = '# ' . $comment if $comment and $comment !~ /^\s*($|#)/;
+      $comment =~ s/^\s*//;
+    }
+
+    $out .= $comment if $comment;
+    $out .= "\n";
+  }
+
+  if ($out) {
+
+    my $old_select = select;
+
+    # Open file if necessary
+    if ($file) {
+      # Make sure the host directory exists and is writable
+      my $dirname = dirname $file;
+      if (not -d $dirname) {
+        print 'Make directory: ', $dirname, "\n" if $self->config->verbose;
+        mkpath $dirname;
+      }
+      croak 'Cannot write to config file directory: "', $dirname, '", abort'
+        unless -d $dirname and -w $dirname;
+
+      # If config file already exists, make sure it is writable
+      if (-f $file) {
+        if (-r $file) {
+          # Read old config file to see if content has changed
+          open IN, '<', $file;
+          my $in_lines = '';
+          while (my $line = <IN>) {
+            $in_lines .= $line;
+          }
+          close IN;
+
+          # Return if content is up-to-date
+          if ($in_lines eq $out) {
+            print 'No change in ', lc ($self->{TYPE}), ' cfg: ', $file,
+                  "\n" if $self->config->verbose > 1 and $self->{TYPE};
+            return;
+          }
+        }
+
+        if (-w $file) {
+          if ($self->{TYPE}) {
+            # Existing config file writable, rename it using its time stamp
+            my $mtime = (stat $file)[9];
+            my ($sec, $min, $hour, $mday, $mon, $year) = (gmtime $mtime)[0 .. 5];
+            my $timestamp = sprintf '%4d%2.2d%2.2d_%2.2d%2.2d%2.2d_',
+                            $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
+            my $oldfile   = catfile $dirname, $timestamp . basename ($file);
+            rename $file, $oldfile;
+            print 'Renamed existing ', lc ($self->{TYPE}), ' cfg: ',
+                  $oldfile, "\n" if $self->config->verbose > 1;
+          }
+        } else {
+          # Existing config file not writable, throw an error
+          croak 'Config file "', $file, '" not writable, abort';
+        }
+      }
+
+      # Open file and select file handle
+      open OUT, '>', $file
+        or croak 'Cannot write to config file "', $file, '" (', $!, '), abort';
+      select OUT;
+    }
+
+    # Print output
+    print $out;
+
+    # Close file if necessary
+    if ($file) {
+      select $old_select;
+      close OUT;
+
+      if ($self->{TYPE} and $self->config->verbose > 1) {
+        print 'Generated ', lc ($self->{TYPE}), ' cfg: ', $file, "\n";
+      } elsif ($self->config->verbose > 2) {
+        print 'Generated cfg: ', $file, "\n";
+      }
+    }
+
+  } else {
+
+    # Warn if nothing to print
+    my $warning = 'Empty configuration';
+    $warning   .= ' - nothing written to file: "' . $file . '"' if $file;
+    carp $warning if $self->{TYPE};
+
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @lines = $self->_get_cfg_lines ();
+#
+# DESCRIPTION
+#   This internal method reads from a configuration file residing in a
+#   Subversion repository or in the normal file system.
+# ------------------------------------------------------------------------------
+
+sub _get_cfg_lines {
+  my $self  = shift;
+  my @lines = ();
+
+  my $verbose = $self->config->verbose;
+
+  # Expand URL keywords if necessary
+  {
+    my $src = expand_url_keyword (URL => $self->src, CFG => $self->config);
+    $self->src ($src) if $src ne $self->src;
+  }
+
+  if (&is_url ($self->src)) {
+    # Config file resides in a SVN repository
+    # --------------------------------------------------------------------------
+    # Set URL source and version
+    my $src = $self->src;
+    my $rev = 'HEAD';
+
+    # Extract version from source if it exists
+    if ($src =~ s/@(.+)$//) {
+      $rev = $1;
+    }
+
+    # Expand revision keyword, if required
+    $rev = expand_rev_keyword (REV => $rev, URL => $src, HEAD => 1);
+
+    # Check whether URL is a config file
+    my $rc;
+    my @cmd = (qw/svn cat/, $src . '@' . $rev);
+    @lines = &run_command (
+      \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+    );
+
+    # Error in "svn cat" command
+    if ($rc) {
+      # See whether specified config file is a known type
+      my %cfgname = %{ $self->config->setting ('CFG_NAME') };
+      my $key     = uc $self->type;
+      my $file    = exists $cfgname{$key} ? $cfgname{$key} : '';
+
+      # If config file is a known type, specified URL may be a directory
+      if ($file) {
+        # Check whether a config file with a default name exists in the URL
+        my $sep  = $self->config->setting (qw/MISC DIR_SEPARATOR/);
+        my $path = $src . $sep . $file;
+        my @cmd  = (qw/svn cat/, $path . '@' . $rev);
+
+        @lines = &run_command (
+          \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+        );
+
+        # Check whether a config file with a default name exists under the "cfg"
+        # sub-directory of the URL
+        if ($rc) {
+          my $cfgdir = $self->config->setting (qw/DIR CFG/);
+          $path   = $src . $sep . $cfgdir . $sep . $file;
+          my @cmd = (qw/svn cat/, $path . '@' . $rev);
+
+          @lines  = &run_command (
+            \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+          );
+        }
+
+        $src = $path unless $rc;
+      }
+    }
+
+    if ($rc) {
+      # Error in "svn cat"
+      croak 'Unable to locate config file from "', $self->src, '", abort';
+
+    } else {
+      # Print diagnostic, if necessary
+      if ($verbose and $self->type and $self->type =~ /$expand_type/) {
+        print '# Config file (', $self->type, '): ', $src;
+        print '@', $rev if $rev;
+        print "\n";
+      }
+    }
+
+    # Record the actual source location
+    $self->{PEGREV    } = $rev;
+    $self->{ACTUAL_SRC} = $src;
+
+  } else {
+    # Config file resides in the normal file system
+    # --------------------------------------------------------------------------
+    my $src = $self->src;
+
+    if (-d $src) { # Source is a directory
+      croak 'Config file "', $src, '" is a directory, abort' if not $self->type;
+
+      # Get name of the config file by looking at the type
+      my %cfgname = %{ $self->config->setting ('CFG_NAME') };
+      my $key     = uc $self->type;
+      my $file    = exists $cfgname{$key} ? $cfgname{$key} : '';
+
+      if ($file) {
+        my $cfgdir = $self->config->setting (qw/DIR CFG/);
+
+        # Check whether a config file with a default name exists in the
+        # specified path, then check whether a config file with a default name
+        # exists under the "cfg" sub-directory of the specified path
+        if (-f catfile $self->src, $file) {
+          $src = catfile $self->src, $file;
+
+        } elsif (-f catfile ($self->src, $cfgdir, $file)) {
+          $src = catfile $self->src, $cfgdir, $file;
+
+        } else {
+          croak 'Unable to locate config file from "', $self->src, '", abort';
+        }
+
+      } else {
+        croak 'Unknown config file type "', $self->type, '", abort';
+      }
+    }
+
+    if (-r $src) {
+      open FILE, '<', $src;
+      print '# Config file (', $self->type, '): ', $src, "\n"
+        if $verbose and $self->type and $self->type =~ /$expand_type/;
+
+      @lines = readline 'FILE';
+      close FILE;
+
+    } else {
+      croak 'Unable to read config file "', $src, '", abort';
+    }
+
+    # Record the actual source location
+    $self->{ACTUAL_SRC} = $src;
+  }
+
+  return @lines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_expand_variable ($string[, $env]);
+#
+# DESCRIPTION
+#   This internal method expands variables in $string. If $env is specified
+#   and is true, it expands environment variables. Otherwise, it expands
+#   local variables.
+# ------------------------------------------------------------------------------
+
+sub _expand_variable {
+  my ($self, $string, $env) = @_;
+
+  # Pattern for environment/local variable
+  my $pattern = $env ? '\$\{?([A-Z][A-Z0-9_]+)\}?' : '%\{?([\w:]+)\}?';
+
+  while ($string and $string =~ /$pattern/) {
+    my $var_label = $1; # variable label
+
+    # Get variable value from environment or local configuration
+    my $variable = $env
+                   ? (exists $ENV{$var_label} ? $ENV{$var_label} : undef)
+                   : $self->config->variable ($var_label);
+
+    $variable = dirname ($self->actual_src)
+      if $env and $var_label eq 'HERE' and not defined $variable;
+
+    # Substitute match with value of variable
+    if (defined $variable) {
+      $string =~ s/$pattern/$variable/;
+
+    } else {
+      w_report 'Warning: ', $self->actual_src, ': variable "',
+               ($env ? '$' : '%'), $var_label, '" not expanded.';
+      last;
+    }
+  }
+
+  return $string;
+}
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Cm.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Cm.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Cm.pm	(revision 6412)
@@ -0,0 +1,2243 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Cm
+#
+# DESCRIPTION
+#   This module contains the FCM code management functionalities and wrappers
+#   to Subversion commands.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Cm;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+our (@ISA, @EXPORT, @EXPORT_OK);
+use Getopt::Long;
+use File::Basename;
+use File::Path;
+use File::Spec;
+use File::Temp qw/tempfile/;
+use Cwd;
+
+# FCM component modules
+use Fcm::CmBranch;
+use Fcm::CmUrl;
+use Fcm::Util;
+
+sub cm_command;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(
+  cm_command
+);
+
+# Function declaration:
+sub cm_add;
+sub cm_branch;
+sub cm_commit;
+sub cm_conflicts;
+sub cm_delete;
+sub cm_diff;
+sub cm_merge;
+sub cm_mkpatch;
+sub cm_svn;
+sub cm_switch;
+sub _construct_branch_url;
+
+# ------------------------------------------------------------------------------
+
+my @subcommand_url = qw/
+  blame     praise annotate ann
+  branch    br
+  cat
+  checkout  co
+  copy      cp
+  delete    del    remove   rm
+  diff      di
+  export
+  import
+  info
+  list      ls
+  lock
+  log
+  merge
+  mkdir
+  mkpatch
+  move      mv     rename   ren
+  propdel   pdel   pd
+  propedit  pedit  pe
+  propget   pget   pg
+  proplist  plist  pl
+  propset   pset   ps
+  switch    sw
+  unlock
+/; # List of subcommands that accept URL inputs
+
+my @subcommand_rev = qw/
+  blame     praise annotate ann
+  branch    br
+  cat
+  checkout  co
+  copy      cp
+  diff      di
+  export
+  info
+  list      ls
+  log
+  merge
+  mkpatch
+  move      mv     rename   ren
+  propdel   pdel   pd
+  propedit  pedit  pe
+  propget   pget   pg
+  proplist  plist  pl
+  propset   pset   ps
+  switch    sw
+  update    up
+/; # List of subcommands that accept revision inputs
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &cm_command ($function);
+#
+# DESCRIPTION
+#   This is the generic FCM code management wrapper. It calls the correct FCM
+#   code management function or a wrapper to a Subversion command based on the
+#   value of the argument $function.
+# ------------------------------------------------------------------------------
+
+sub cm_command {
+
+  my ($function) = shift @_;
+
+  # Expand URL keywords if necessary
+  if (grep {$_ eq $function} @subcommand_url) {
+    for my $arg (@ARGV) {
+      my $var = expand_url_keyword (URL => $arg);
+      $arg = $var if $arg ne $var;
+    }
+  }
+
+  # Expand revision keywords (for -r or --revision options) if necessary
+  if (grep {$_ eq $function} @subcommand_rev) {
+    my @new_argv = ();
+
+    while (defined (my $arg = shift @ARGV)) {
+      if ($arg eq '--revision') {
+        # Long --revision option, must be followed by a space before the
+        # revision argument
+        push @new_argv, $arg;
+
+      } elsif ($arg =~ s/^-r//) {
+        # Short -r option, may be followed by the revision argument with or
+        # without a space in between
+        push @new_argv, '--revision';
+        unshift @ARGV, $arg if $arg;
+
+      } else {
+        # Other option or argument
+        push @new_argv, $arg;
+        next;
+      }
+
+      # First revision number/keyword
+      my $rev1 = '';
+
+      # Get the next argument from the list
+      $arg = shift @ARGV;
+
+      if (index ($arg, '{') == 0) {
+        # A revision date argument may contain a space. Therefore, it may need
+        # the next argument(s) from the list
+        while (index ($arg, '}') == -1) {
+          my $shift = shift @ARGV;
+          last unless $shift;
+          $arg     .= ' ' . $shift;
+        }
+
+        $arg  =~ s/^(\{.+?\})//;
+        $rev1 = $1;
+
+      } else {
+        # Other revision argument
+        $arg  =~ s/^(\S+?)(?::|$)//;
+        $rev1 = $1;
+      }
+
+      # The rest of $arg is the second revision number/keyword
+      my $rev2 = $arg;
+      $rev2 =~ s/^:*//;
+
+      # A revision date argument may contain a space. Therefore, it may need
+      # the next argument(s) from the list
+      if (index ($rev2, '{') == 0) {
+        while (index ($rev2, '}') == -1) {
+          my $shift = shift @ARGV;
+          last unless $shift;
+          $rev2    .= ' ' . $shift;
+        }
+      }
+
+      # Expand revision keyword if necessary
+      if ($rev1 !~ /^(?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\})$/i or
+          $rev2 !~ /^(?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\})$/i) {
+        # Find out the associated URLs by inspecting the argument list
+        my $url1 = '';
+        my $url2 = '';
+
+        for (@new_argv, @ARGV) {
+          my $arg = Fcm::CmUrl->new (URL => $_);
+          next unless $arg->is_url;
+
+          if ($url1) {
+            $url2 = $arg->url_peg;
+            last;
+
+          } else {
+            $url1 = $arg->url_peg;
+          }
+        }
+
+        # Argument list does not contain a URL, try "svn info" on WC
+        $url1 = &get_url_of_wc () if not $url1;
+        $url2 = $url1 if not $url2;
+
+        # Expand 1st revision keyword if necessary
+        $rev1 = expand_rev_keyword (REV => $rev1, URL => $url1)
+          if $rev1 !~ /^(?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\})$/i;
+
+        # Expand 2nd revision keyword if necessary
+        $rev2 = expand_rev_keyword (REV => $rev2, URL => $url2)
+          if $rev2 and $rev2 !~ /^(?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\})$/i;
+      }
+
+      # Append revision argument to argument list
+      push @new_argv, ($rev2 ? $rev1 . ':' . $rev2 : $rev1);
+    }
+
+    @ARGV = @new_argv;
+  }
+
+  # Expand revision keywords (for peg revision TARGET@REVSION) if necessary
+  for (@ARGV) {
+    if (m#^(\w+://\S+)@(\S+)$#) {
+      my $url = $1;
+      my $rev = $2;
+
+      my $new_rev = expand_rev_keyword (URL => $url, REV => $rev, HEAD => 1);
+
+      $_ = $url . '@' . $new_rev if $new_rev ne $rev;
+    }
+  }
+
+  # List of special sub-commands recognised by FCM
+  my %subcommand = (
+    ADD       => [qw/add/],
+    BRANCH    => [qw/branch br/],
+    COMMIT    => [qw/commit ci/],
+    CONFLICTS => [qw/conflicts cf/],
+    CHECKOUT  => [qw/checkout co/],
+    DELETE    => [qw/delete del remove rm/],
+    DIFF      => [qw/diff di/],
+    MERGE     => [qw/merge/],
+    MKPATCH   => [qw/mkpatch/],
+    SWITCH    => [qw/switch sw/],
+  );
+
+  if (grep {$_ eq $function} @{ $subcommand{ADD} }) {
+    cm_add;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{BRANCH} }) {
+    cm_branch;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{CHECKOUT} }) {
+    # Check whether the last argument is a PATH.
+    # If so, check whether it is a working copy.
+    # Otherwise, check whether the current directory is a working copy.
+    # If current working direcory (or PATH) is a working copy, fail the command.
+    if (@ARGV) {
+      my $arg  = Fcm::CmUrl->new (URL => $ARGV [-1]);
+      my $path = $arg->is_url ? cwd () : $ARGV [-1];
+
+      e_report $path, ': already a working copy, abort checkout.'
+        if &is_wc ($path);
+    }
+
+    # Invoke checkout
+    cm_svn ('checkout');
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{COMMIT} }) {
+    cm_commit;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{CONFLICTS} }) {
+    cm_conflicts;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{DELETE} }) {
+    cm_delete;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{DIFF} }) {
+    cm_diff;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{MERGE} }) {
+    cm_merge;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{MKPATCH} }) {
+    cm_mkpatch;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{SWITCH} }) {
+    cm_switch;
+
+  } else {
+    cm_svn ($function);
+  }
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_add ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn add". It adds an extra functionality to check
+#   for any files or directories reported by "svn status" as not under version
+#   control, and to prompt the user whether these files or directories should
+#   be added.
+# ------------------------------------------------------------------------------
+
+sub cm_add {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+usage: fcm add [options] [args]
+
+Valid options:
+  -c [--check]  : Check for any files or directories reported by svn status as
+                  not under version control and add them.
+  <SVN options> : Standard options to svn add as described below ...
+
+EOF
+
+    &run_command ([qw/svn add --help/], PRINT => 1, METHOD => 'exec');
+  }
+
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--check -c)) {
+    # The --check option is specified, add any new files
+    # Execute "svn status", print lines starting with a "?"
+    my $pat    = '^\?.{4}\s*';
+    my @status = grep /$pat.*/, &run_command ([qw/svn status/], METHOD => 'qx');
+    print @status if @status;
+
+    # Get list of "?" files
+    my @files  = map {chomp; s/$pat//; $_} @status;
+    my $reply  = '';
+
+    # Execute "add" command depending on user reply
+    for my $file (@files) {
+      # Get a user reply, unless previous reply is "a" for "all"
+      $reply = &main::get_input (
+        TITLE   => 'fcm add',
+        MESSAGE => "Add file '$file'?",
+        TYPE    => 'yna',
+        DEFAULT => 'n',
+      ) unless $reply eq "a";
+
+      # Add current $file if reply is "y" for "yes" or "a" for "all"
+      &run_command ([qw/svn add/, $file]) if $reply =~ /^[ya]$/;
+    }
+
+  } else {
+    # The --check option is not specified, just call "svn add"
+    cm_svn ("add");
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_branch ();
+#
+# DESCRIPTION
+#   This is a FCM command to check information, create or delete a branch in
+#   a Subversion repository.
+# ------------------------------------------------------------------------------
+
+sub cm_branch {
+  my $usage = <<EOF;
+branch: Create, delete or display information of a branch
+usage: 1. fcm branch [--info] [OPTIONS] [TARGET]
+       2. fcm branch --delete [OPTIONS] [TARGET]
+       3. fcm branch --create [OPTIONS] [SOURCE]
+       4. fcm branch --list   [OPTIONS] [SOURCE]
+
+  1. --info or -i: Display information about a branch. This is the default
+     option if --create, --delete and --list are not specified.
+
+  2. --delete or -d: Delete a branch.
+
+  3. --create or -c: Create a new branch from SOURCE. The --name option must be
+     used to specify a short name for the new branch.
+
+  4. --list or -l: List all the branches owned by the current user in SOURCE. If
+     the --user option is specified with a list of users, list all the branches
+     owned by these users instead of the current user.
+
+  TARGET (and SOURCE) can be an URL or a Subversion working copy. Otherwise,
+  the current working directory must be a working copy. For --info and
+  --delete, the specified URL (or the URL of the working copy) must be a URL
+  under a valid branch in a standard FCM project. For --create and --list, it
+  must be a URL under a standard FCM project.
+
+Valid options with --info and --delete:
+  -v [--verbose]        : Print extra information.
+  -a [--show-all]       : Set --show-children, --show-other and --show-siblings.
+  --show-children       : Report children of the current branch.
+  --show-other          : Report custom/ reverse merges into the current branch.
+  --show-siblings       : Report merges with siblings of the current branch.
+
+Valid options with --delete and --create:
+  --non-interactive     : Do no interactive prompting. This option implies
+                          --svn-non-interactive.
+  --password arg        : Specify a password for write access to the repository.
+  --svn-non-interactive : Do no interactive prompting at commit time. This
+                          option is implied by --non-interactive.
+
+Valid options with --create and --list:
+  -r [--revision] arg   : Specify the operative revision of the SOURCE for
+                          creating the branch.
+
+Valid options with --create:
+  --branch-of-branch    : If this option is specified and the SOURCE is a
+                          branch, it will create a new branch from the SOURCE
+                          branch. Otherwise, the branch is created from the
+                          trunk.
+  -k [--ticket] arg     : Specify one (or more) Trac ticket. If specified, the
+                          command will add to the commit log the line "Relates
+                          to ticket #<ticket>". Multiple tickets can be set by
+                          specifying this option multiple times, or by
+                          specifying the tickets in a comma-separated list.
+  -n [--name] arg       : Specify a short name for the branch, which should
+                          contain only word characters, i.e. [A-Za-z0-9_].
+  --rev-flag arg        : Specify a flag for determining the prefix of the
+                          branch name. The flag can be the the string "NORMAL",
+                          "NUMBER" or "NONE".  "NORMAL" is the default
+                          behaviour, in which the branch name will be prefixed
+                          with a Subversion revision number if the revision is
+                          not associated with a registered FCM revision
+                          keyword. If the revision is registered with a FCM
+                          revision keyword, the keyword will be used in place
+                          of the number. If "NUMBER" is specified, the branch
+                          name will always be prefixed with a Subversion
+                          revision number. If "NONE" is specified, the branch
+                          name will not be prefixed by a revision number or
+                          keyword.
+  -t [--type] arg       : Specify the type of the branch to be created. It must
+                          be one of the following:
+                            DEV::USER   - a development branch for the user
+                            DEV::SHARE  - a shared development branch
+                            DEV         - same as DEV::USER
+                            TEST::USER  - a test branch for the user
+                            TEST::SHARE - a shared test branch
+                            TEST        - same as TEST::USER
+                            PKG::USER   - a package branch for the user
+                            PKG::SHARE  - a shared package branch
+                            PKG::CONFIG - a configuration branch
+                            PKG::REL    - a release branch
+                            PKG         - same as PKG::USER
+                            CONFIG      - same as PKG::CONFIG
+                            REL         - same as PKG::REL
+                            SHARE       - same as DEV::SHARE
+                            USER        - same as DEV::USER
+                          If not specified, the default is to create a
+                          development branch for the current user, i.e.
+                          DEV::USER.
+
+Valid options with --list:
+  -u [--user] arg       : Specify a colon-separated list of users. List branches
+                          owned by these users instead of the current user.
+  -v [--verbose]        : Print Subversion URL instead of FCM URL keywords.
+EOF
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print $usage;
+    return 1;
+  }
+
+  # Process command line options
+  # ----------------------------------------------------------------------------
+  my (
+    $info,
+    $delete,
+    $create,
+    $list,
+    $branch_of_branch,
+    $name,
+    $non_interactive,
+    $password,
+    $rev,
+    $rev_flag,
+    $show_all,
+    $show_children,
+    $show_other,
+    $show_siblings,
+    $svn_non_interactive,
+    @tickets,
+    $type,
+    @userlist,
+    $verbose,
+  );
+  GetOptions (
+    'info|i'              => \$info,
+    'delete|d'            => \$delete,
+    'create|c'            => \$create,
+    'list|l'              => \$list,
+    'branch-of-branch'    => \$branch_of_branch,
+    'name|n=s'            => \$name,
+    'non-interactive'     => \$non_interactive,
+    'password=s'          => \$password,
+    'revision|r=s'        => \$rev,
+    'rev-flag=s'          => \$rev_flag,
+    'show-all|a'          => \$show_all,
+    'show-children'       => \$show_children,
+    'show-other'          => \$show_other,
+    'show-siblings'       => \$show_siblings,
+    'svn-non-interactive' => \$svn_non_interactive,
+    'ticket|k=s'          => \@tickets,
+    'type|t=s'            => \$type,
+    'user|u=s'            => \@userlist,
+    'verbose|v'           => \$verbose,
+  );
+
+  my $num_options = 0;
+  $num_options++ if defined $info;
+  $num_options++ if defined $delete;
+  $num_options++ if defined $create;
+  $num_options++ if defined $list;
+
+  # Report invalid usage
+  # ----------------------------------------------------------------------------
+  e_report $usage if $num_options > 1;
+
+  # Get URL of repository or branch
+  # ----------------------------------------------------------------------------
+  my $url;
+  if ($ARGV[0]) {
+    $url = Fcm::CmUrl->new (URL => $ARGV[0]);
+
+    if (not $url->is_url) {
+      # An argument is specified and is not a URL
+      # Assume that it is a path with a working copy
+      if (&is_wc ($ARGV[0])) {
+        $url = Fcm::CmUrl->new (URL => &get_url_of_wc ($ARGV[0]));
+
+      } else {
+        e_report $ARGV[0], ': is not a working copy, abort.';
+      }
+    }
+
+  } else {
+    # An argument is not specified
+    # Assume that the current directory is a working copy
+    if (&is_wc ()) {
+      $url = Fcm::CmUrl->new (URL => &get_url_of_wc ());
+
+    } else {
+      e_report 'The current directory is not a working copy, please specify a ',
+               'URL or a path to a working copy, abort.';
+    }
+  }
+
+  # Ensure $url->url_peg is a URL of a standard FCM project
+  e_report $url->url_peg, ': not a URL of a standard FCM project, abort.'
+    if not $url->project_url;
+
+  if ($create) {
+    # The --create option is specified, create a branch
+    # --------------------------------------------------------------------------
+
+    # Check branch type flags
+    if ($type) {
+      $type = uc ($type);
+
+      if ($type =~ /^(USER|SHARE)$/) {
+        $type = 'DEV::' . $1;
+
+      } elsif ($type =~ /^(CONFIG|REL)$/) {
+        $type = 'PKG::' . $1;
+
+      } elsif ($type =~ /^(DEV|TEST|PKG)$/) {
+        $type = $1 . '::USER';
+
+      } elsif ($type !~ /^(?:DEV|TEST|PKG)::(?:USER|SHARE)$/ and
+               $type !~ /^PKG::(?:CONFIG|REL)/) {
+        e_report $type, ': is not a valid type flag, abort.';
+      }
+
+    } else {
+      $type = 'DEV::USER';
+    }
+
+    # Check branch name
+    e_report 'The option --name must be used to specify a branch name, abort.'
+      if not $name;
+
+    e_report $name, ': invalid characters in name, abort.' if $name !~ /^\w+$/;
+
+    # Check revision flag is valid
+    if ($rev_flag) {
+      $rev_flag = uc ($rev_flag);
+
+      e_report $rev_flag, ': invalid argument to the --rev-flag option, abort.'
+        if $rev_flag !~ /^(?:NORMAL|NUMBER|NONE)$/;
+
+    } else {
+      $rev_flag = 'NORMAL';
+    }
+
+    # Handle multiple tickets
+    @tickets = split (/,/, join (',', @tickets));
+    s/^#// for (@tickets);
+    @tickets = sort {$a <=> $b} @tickets;
+
+    # Determine whether to create a branch of a branch
+    $url->branch ('trunk') unless $branch_of_branch;
+
+    # Create the branch
+    my $branch = Fcm::CmBranch->new;
+    $branch->create (
+      SRC                 => $url,
+      TYPE                => $type,
+      NAME                => $name,
+      PASSWORD            => $password,
+      REV_FLAG            => $rev_flag,
+      TICKET              => \@tickets,
+      REV                 => $rev,
+      NON_INTERACTIVE     => $non_interactive,
+      SVN_NON_INTERACTIVE => $svn_non_interactive,
+    );
+
+  } elsif ($list) {
+    # The option --list is specified
+    # List branches owned by current or specified users
+    # --------------------------------------------------------------------------
+    # Get URL of the project "branches/" sub-directory
+    $url->subdir ('');
+    $url->branch ('');
+    my @list = map {$_, 1} $url->branch_list ($rev);
+
+    if (@userlist) {
+      # Sort list of users
+      @userlist = sort (split /:/, join (':', @userlist));
+
+    } else {
+      # No user specified, add currrent user to list
+      push @userlist, $ENV{LOGNAME} unless @userlist;
+    }
+
+    # Filter branches matching user list
+    my @branches;
+    for my $branch (@list) {
+      next unless $branch =~ m#/([^/]+)/[^/]+/*$#;
+
+      my $user = $1;
+
+      push @branches, $branch if grep {$user eq $_} @userlist;
+    }
+
+    # Output, number of branches found
+    print scalar (@branches), ' ',
+          (scalar (@branches) > 1 ? 'branches' : 'branch'), ' found for ',
+          join (', ', @userlist), ' in ', $url->project_url_peg,
+          ($rev ? (' at r', $rev) : ()), "\n";
+
+    if (@branches) {
+      # Output the URL of each branch
+      if (not $verbose) {
+        my $project = $url->project_url;
+        my $keyword = &get_url_keyword (URL => $project);
+        @branches = map {s#^$project/+branches#$keyword-br#; $_} @branches
+          if defined $keyword;
+      }
+      @branches = map {$_ . "\n"} sort @branches;
+      print @branches;
+
+    } else {
+      # No branch found, exit with an error code
+      exit 1;
+    }
+
+  } else {
+    # The option --info or --delete is specified
+    # Report branch information (and/or delete a branch)
+    # --------------------------------------------------------------------------
+    # Set verbose level
+    &main::cfg->verbose ($verbose ? 1 : 0);
+
+    # Set up the branch, report any error
+    my $branch = Fcm::CmBranch->new (URL => $url->url_peg);
+    e_report $branch->url_peg, ': not a branch, abort.' unless $branch->branch;
+
+    e_report $branch->url_peg, ': does not exist, abort.'
+      unless $branch->url_exists;
+
+    # Remove the sub-directory part of the URL
+    $branch->subdir ('');
+
+    # Report branch info
+    $branch->display_info (
+      SHOW_CHILDREN => ($show_all || $show_children),
+      SHOW_OTHER    => ($show_all || $show_other   ),
+      SHOW_SIBLINGS => ($show_all || $show_siblings),
+    );
+
+    # Delete branch if --delete is specified
+    $branch->del (
+      PASSWORD            => $password,
+      NON_INTERACTIVE     => $non_interactive,
+      SVN_NON_INTERACTIVE => $svn_non_interactive,
+    ) if $delete;
+  }
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_commit ();
+#
+# DESCRIPTION
+#   This is a FCM wrapper to the "svn commit" command.
+# ------------------------------------------------------------------------------
+
+sub cm_commit {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+commit (ci): Send changes from your working copy to the repository.
+usage: fcm commit [PATH]
+
+  Invoke your favourite editor to prompt you for a commit log message. Send
+  changes from your working copy to the repository. Update your working copy
+  following the commit.
+
+Valid options:
+  --dry-run             : Allows you to add to the commit message without
+                          committing.
+  --svn-non-interactive : Do no interactive prompting at commit time.
+  --password arg        : Specify a password ARG.
+EOF
+    return 1;
+  }
+
+  my ($dry_run, $svn_non_interactive, $password);
+  GetOptions (
+    'dry-run'             => \$dry_run,
+    'svn-non-interactive' => \$svn_non_interactive,
+    'password'            => \$password,
+  );
+
+  # The remaining argument is the path to a working copy
+  my ($path) = @ARGV;
+
+  if ($path) {
+    # Check that specified path exists
+    e_report $path, ': does not exist, abort.' if not -e $path;
+
+  } else {
+    # No argument specified, use current working directory
+    $path = cwd ();
+  }
+
+  # Make sure we are in a working copy
+  e_report $path, ': not a working copy, abort.' if not &is_wc ($path);
+
+  # Make sure we are at the top level of the working copy
+  # (otherwise we might miss any template commit message)
+  my $dir = &get_wct ($path);
+
+  if ($dir ne cwd ()) {
+    chdir $dir or die 'Cannot change directory to: ', $dir;
+    print 'Committing changes from ', $dir, ' ...', "\n";
+  }
+
+  # Get update status of working copy
+  # Check working copy files are not in conflict, missing, or out of date
+  my @status = &run_command ([qw/svn status --show-updates/], METHOD => 'qx');
+  unless (defined $dry_run) {
+    my (@conflict, @missing, @outdate);
+
+    for (@status) {
+      if (/^C/) {
+        push @conflict, $_;
+        next;
+      }
+
+      if (/^!/) {
+        push @missing, $_;
+        next;
+      }
+
+      if (/^.{7}\*/) {
+        push @outdate, $_;
+        next;
+      }
+
+      # Check that all files which have been added have the svn:executable
+      # property set correctly (in case the developer adds a script before they
+      # remember to set the execute bit)
+      next unless /^A.{7} *\d+ +(.*)/;
+      my $file = $1;
+
+      next unless -f $file;
+      my @command = (-x $file)
+                    ? (qw/svn propset -q svn:executable */, $file)
+                    : (qw/svn propdel -q svn:executable/  , $file);
+      &run_command (\@command);
+    }
+
+    # Abort commit if files are in conflict, missing, or out of date
+    if (@conflict or @missing or @outdate) {
+      w_report 'File(s) in conflict:', "\n", @conflict if @conflict;
+      w_report 'File(s) missing:'    , "\n", @missing  if @missing;
+      w_report 'File(s) out of date:', "\n", @outdate  if @outdate;
+      e_report 'Abort commit.';
+    }
+  }
+
+  # Read in any existing message
+  my $ci_mesg = Fcm::CmCommitMessage->new ();
+  $ci_mesg->read_file;
+
+  # Execute "svn status" for a list of changed items
+  @status = grep !/^\?/, &run_command ([qw/svn status/], METHOD => 'qx');
+
+  # Abort if there is no change in the working copy
+  if (not @status) {
+    print 'No change in working copy, abort.', "\n";
+    return;
+  }
+
+  # Get associated URL of current working copy
+  my $url = Fcm::CmUrl->new (URL => &get_url_of_wc ());
+
+  # Include URL, or project, branch and sub-directory info in @status
+  unshift @status, "\n";
+
+  if ($url->project and $url->branch) {
+    unshift @status, (
+      '[Project: ' . $url->project                           . ']' . "\n",
+      '[Branch : ' . $url->branch                            . ']' . "\n",
+      '[Sub-dir: ' . ($url->subdir ? $url->subdir : '<top>') . ']' . "\n",
+    );
+
+  } else {
+    unshift @status, '[URL: ' . $url->url . ']' . "\n";
+  }
+
+  # Use a temporary file to store the final commit log message
+  $ci_mesg->ignore_mesg (@status);
+  my $logfile = $ci_mesg->edit_file (TEMP => 1);
+
+  # Check with the user to see if he/she wants to go ahead
+  my $reply = 'n';
+  if (not defined $dry_run) {
+    # Add extra warning for trunk commit
+    my $mesg = $url->is_trunk
+      ? "\n" .
+        '*** WARNING: YOU ARE COMMITTING TO THE TRUNK.' . "\n" .
+        '*** Please ensure that your change conforms to your project\'s ' .
+        'working practices.' . "\n\n"
+      : '';
+    $mesg   .= 'Would you like to commit this change?';
+
+    # Prompt the user
+    $reply = &main::get_input (
+      TITLE   => 'fcm commit',
+      MESSAGE => $mesg,
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+  }
+
+  if ($reply eq 'y') {
+    # Commit the change if user replies "y" for "yes"
+    my @command = (
+      qw/svn commit -F/, $logfile,
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+    );
+    my $rc;
+    &run_command (\@command, RC => \$rc, ERROR => 'warn');
+
+    if ($rc) {
+      # Commit failed
+      # Write temporary commit log content to commit log message file
+      $ci_mesg->write_file;
+
+      # Fail the command
+      e_report;
+    }
+
+    # Remove commit message file
+    unlink $ci_mesg->file;
+
+    # Update the working copy
+    print 'Performing update to make sure your working copy is at this new ',
+          'revision ...', "\n";
+    &run_command ([qw/svn update/]);
+
+  } else {
+    # Abort commit if dry run or user replies "n" for "no"
+    w_report 'Commit aborted by user.' unless $dry_run;
+
+    # Write temporary commit log content to commit log message file
+    $ci_mesg->write_file;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_conflicts ();
+#
+# DESCRIPTION
+#   This is a FCM command for resolving conflicts within working copy using a
+#   graphical merge tool.
+# ------------------------------------------------------------------------------
+
+sub cm_conflicts {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+conflicts: Use graphical tool to resolve any conflicts within your working copy.
+usage: fcm conflicts [PATH]
+
+  Invoke the xxdiff graphical merge tool to help you resolve conflicts in your
+  working copy. It prompts you to run "svn resolved" each time you have
+  resolved the conflicts in a file.
+EOF
+    return 1;
+  }
+
+  # Path to the working copy
+  my $path = $ARGV[0];
+  $path    = cwd () if not $path;
+
+  # Check for any files with conflicts
+  my @status = grep /^C.{4} *(.*)/, &run_command (
+    [qw/svn st/, ($path eq cwd () ? () : $path)], METHOD => 'qx',
+  );
+  my @files  = map {m/^C.{4} *(.*)/; $1} @status;
+
+  # Save current working directory
+  my $topdir = cwd ();
+
+  for my $file (@files) {
+    # Print name of file in conflicts
+    print "Conflicts in file: $file\n";
+
+    # Determine directory and base name of file in conflicts
+    my $base = basename $file;
+    my $dir  = dirname $file;
+
+    # Change to container directory of file in conflicts
+    chdir File::Spec->catfile ($topdir, $dir) or die "Directory change to $dir failed";
+
+    # Use "svn info" to determine conflict marker files
+    my @info = &run_command ([qw/svn info/, $base], METHOD => 'qx');
+
+    # Ignore if $base is a binary file
+    if (-B $base) {
+      w_report $base,
+               ': ignoring binary file, please resolve conflicts manually.';
+      next;
+    }
+
+    # Get conflicts markers files
+    my ($older, $mine, $yours);
+
+    for (@info) {
+      $older = $1 if (/^Conflict Previous Base File: (.*)/);
+      $mine  = $1 if (/^Conflict Previous Working File: (.*)/);
+      $yours = $1 if (/^Conflict Current Base File: (.*)/);
+    }
+
+    if ((stat $base)[9] > (stat $mine)[9]) {
+      # If $base is newer, it may contain saved changes
+      my $reply = &main::get_input (
+        TITLE   => 'fcm conflicts',
+        MESSAGE => 'Existing changes in ' . $base . ' will be overwritten.' .
+                   "\n" . 'Do you wish to continue?',
+        TYPE    => 'yn',
+        DEFAULT => 'n',
+      );
+
+      next if $reply ne 'y';
+    }
+
+    # Launch "xxdiff" to allow user to perform graphical merging
+    my $xxdiffrc;
+    my @command  = (qw/xxdiff -m -M/, $base, qw/-O -X/, $mine, $older, $yours);
+    my ($decision) = &run_command (
+      \@command, METHOD => 'qx', RC => \$xxdiffrc, ERROR => 'ignore',
+    );
+    die &get_command_string (\@command), ' failed' if $xxdiffrc and ! $decision;
+    chomp $decision;
+
+    # Perform different actions depending on the user's decision
+    if ($decision eq "NODECISION") {
+      print "No decision taken\n";
+
+    } elsif ($decision eq "MERGED" and $xxdiffrc != 0) {
+      print "Merge conflicts were not all resolved\n";
+
+    } else {
+      # User has MERGED, ACCEPTED or REJECTED all changes
+      if ($decision eq "MERGED") {
+        print "All merge conflicts resolved\n";
+
+      } else {
+        print "You have chosen to $decision all the changes\n";
+      }
+
+      # Prompt user to run "svn resolved" on the file
+      my $reply = &main::get_input (
+        TITLE   => 'fcm conflicts',
+        MESSAGE => 'Would you like to run "svn resolved"?',
+        TYPE    => 'yn',
+        DEFAULT => 'n',
+      );
+
+      # If reply is "yes"...
+      &run_command ([qw/svn resolved/, $base]) if $reply eq 'y';
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_delete ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn delete". It adds an extra functionality to check
+#   for any files or directories reported by "svn status" as missing, and to
+#   prompt the user whether these files or directories should be deleted.
+# ------------------------------------------------------------------------------
+
+sub cm_delete {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+usage: fcm delete [options] [args]
+
+Valid options:
+  -c [--check]  : Check for any files or directories reported by svn status as
+                  missing and delete them.
+  <SVN options> : Standard options to svn delete as described below ...
+
+EOF
+
+    &run_command ([qw/svn delete --help/], PRINT => 1, METHOD => 'exec');
+  }
+
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--check -c)) {
+    # The --check option is specified, delete any missing files
+    # Execute "svn status", print lines starting with a "!"
+    my $pat    = '^!.{4}\s*';
+    my @status = grep /$pat.*/, &run_command ([qw/svn status/], METHOD => 'qx');
+    print @status if @status;
+
+    # Get list of "!" files
+    my @files  = map {chomp; s/$pat//; $_} @status;
+    my $reply  = '';
+
+    # Execute "delete" command depending on user reply
+    for my $file (@files) {
+      # Get a user reply, unless previous reply is "a" for "all"
+      $reply = &main::get_input (
+        TITLE   => 'fcm delete',
+        MESSAGE => "Delete file '$file'?",
+        TYPE    => 'yna',
+        DEFAULT => 'n',
+      ) unless $reply eq "a";
+
+      # Delete current $file if reply is "y" for "yes" or "a" for "all"
+      &run_command ([qw/svn delete/, $file]) if $reply =~ /^[ya]$/;
+    }
+
+  } else {
+    # The --check option is not specified, just call "svn delete"
+    cm_svn ("delete");
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_diff ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn diff". It adds two extra functionalities. The
+#   first one allows the command to show differences relative to the base of
+#   the branch. The second one allows differences to be displayed via a
+#   graphical tool.
+# ------------------------------------------------------------------------------
+
+sub cm_diff {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+usage: 1. fcm diff --branch [OPTIONS] [TARGET]
+       2. fcm diff [OPTIONS] [ARGS]
+
+  1. --branch or -b: Show differences relative to the base of the target branch,
+     i.e. the changes available for merging from the target branch into its
+     parent. If TARGET is specified, it must either be a URL or a working copy.
+     Otherwise, the target is the the current directory which must be a working
+     copy. The target URL must be a branch in a standard FCM project.
+
+  2. See description of "svn diff" below.
+
+Valid options:
+  -g [--graphical] : Use a graphical diff tool to display the differences. This
+                     option should not be used in combination with --diff-cmd.
+  <SVN options>    : Standard options to "svn diff" as described below.
+
+Valid options with --branch:
+  --diff-cmd arg        : As described below in the help for "svn diff".
+  -g [--graphical]      : As described above.
+  -t [--trac]           : If TARGET is a URL, use Trac to display the diff.
+  --wiki                : If TARGET is a URL, print Trac link for the diff.
+  -x [--extensions] arg : As described below in the help for "svn diff".
+
+EOF
+
+    &run_command ([qw/svn diff --help/], PRINT => 1, METHOD => 'exec');
+  }
+
+  # Set up environment for graphical diff
+  # Use environment variable if set, otherwise use default setting
+  my $env = 'FCM_GRAPHIC_DIFF';
+  $ENV{$env} = &main::cfg->setting (qw/TOOL GRAPHIC_DIFF/)
+    unless exists $ENV{$env} or not &main::cfg->setting (qw/TOOL GRAPHIC_DIFF/);
+
+  # Check for the --branch options
+  # ----------------------------------------------------------------------------
+  my $branch = grep {$_ eq '-b' or $_ eq '--branch'} @ARGV;
+
+  if (not $branch) {
+    # The --branch option not specified, just call "svn diff"
+    # Convert the --graphical to qw/--diff-cmd fcm_graphical_diff/
+    @ARGV = map {
+      ($_ eq '-g' or $_ eq '--graphical')
+      ? (qw/--diff-cmd fcm_graphic_diff/)
+      : $_
+    } @ARGV;
+
+    # Execute the command
+    cm_svn ('diff');
+  }
+
+  # The --branch option is specified
+  # ----------------------------------------------------------------------------
+
+  # Determine whether the --graphical option is specified,
+  # if so set the appropriate command
+  # ----------------------------------------------------------------------------
+  my ($diff_cmd, $extensions, $graphical, $trac, $wiki);
+  GetOptions (
+    'b|branch'       => \$branch,
+    'diff-cmd=s'     => \$diff_cmd,
+    'x|extensions=s' => \$extensions,
+    'g|graphical'    => \$graphical,
+    't|trac'         => \$trac,
+    'wiki'           => \$wiki,
+  );
+
+  my @diff_cmd = ();
+  
+  if ($graphical) {
+    @diff_cmd = (qw/--diff-cmd fcm_graphic_diff/);
+
+  } elsif ($diff_cmd) {
+    @diff_cmd = ('--diff-cmd', $diff_cmd);
+
+    push @diff_cmd, '--extensions', split (/\s+/, $extensions) if $extensions;
+  }
+
+  # The remaining argument should either be a URL or a PATH
+  my ($url_arg, $path_arg);
+
+  if (@ARGV) {
+    my $arg = Fcm::CmUrl->new (URL => $ARGV[0]);
+
+    if ($arg->is_url) {
+      $url_arg = $ARGV[0];
+
+    } else {
+      $path_arg = $ARGV[0];
+    }
+  }
+
+  # Get repository and branch information
+  # ----------------------------------------------------------------------------
+  my ($url, $path);
+  if (defined $url_arg) {
+    # If a URL is specified, get repository and branch information from it
+    $url = Fcm::CmBranch->new (URL => $url_arg);
+
+  } else {
+    # Get repository and branch information from the specified path or the
+    # current directory if it is a working copy
+    $path = $path_arg ? $path_arg : cwd ();
+    e_report $path, ': not a working copy, abort.' unless &is_wc ($path);
+
+    $url  = Fcm::CmBranch->new (URL => &get_url_of_wc ($path));
+  }
+
+  # Check that URL is a standard FCM branch
+  e_report $url->url_peg, ': not a standard FCM branch, abort.'
+    unless $url->is_branch;
+
+  # Save and remove sub-directory part of the URL
+  my $subdir = $url->subdir ();
+  $url->subdir ('');
+
+  # Check that $url exists
+  e_report $url->url_peg, ': not a valid URL, abort.' unless $url->url_exists;
+
+  # Compare current branch with its parent
+  # ----------------------------------------------------------------------------
+  my $parent = Fcm::CmBranch->new (URL => $url->parent->url);
+  $parent->pegrev ($url->pegrev) if $url->pegrev;
+
+  e_report $parent->url, ': branch parent no longer exists',
+           ($parent->pegrev ? ' at ' . $parent->pegrev : ''), ', abort.'
+    unless $parent->url_exists;
+
+  my $base = $parent->base_of_merge_from ($url);
+
+  # Ensure the correct diff (syntax) is displayed
+  # ----------------------------------------------------------------------------
+  # Reinstate the sub-tree part into the URL
+  $url->subdir ($subdir);
+  $base->subdir ($subdir);
+
+  # Ensure the branch URL has a peg revision
+  $url->pegrev ($url->svninfo (FLAG => 'Last Changed Rev')) if not $url->pegrev;
+
+  if ($trac or $wiki) {
+    # Trac/wiki
+    # --------------------------------------------------------------------------
+    if (not $url_arg) {
+      if (&run_command ([qw/svn status/], METHOD => 'qx')) {
+        w_report 'WARNING: the working copy at "', ($path_arg ? $path_arg : '.'),
+                 '" contains local changes, which cannot be displayed in Trac.';
+      }
+    }
+
+    # Trac wiki syntax
+    my $wiki_syntax = 'diff:' . $base->path_peg . '//' . $url->path_peg;
+
+    if ($wiki) {
+      # Print Trac wiki syntax only
+      print $wiki_syntax, "\n";
+
+    } else { # if $trac
+      # Use Trac to view "diff"
+      my $browser  = &main::cfg->setting (qw/MISC WEB_BROWSER/);
+      die 'ERROR: web browser not set, abort' if not $browser;
+
+      my $trac_url = &get_browser_url (URL => $url->project_url);
+      e_report 'ERROR: ', $url->project_url,
+               ': not associated with a Trac URL, abort.'
+        if not $trac_url;
+
+      $trac_url =~ s#/browser/.*$#/intertrac/$wiki_syntax#;
+
+      &run_command ([$browser, $trac_url], METHOD => 'exec', PRINT => 1);
+    }
+
+  } else {
+    # Execute the "diff" command
+    # --------------------------------------------------------------------------
+    my @command = (
+      qw/svn diff/, @diff_cmd,
+      '--old', $base->url_peg,
+      '--new', ($url_arg ? $url->url_peg : ($path_arg ? $path_arg : '.')),
+    );
+    &run_command (\@command, PRINT => 1);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_merge ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn merge".
+# ------------------------------------------------------------------------------
+
+sub cm_merge {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+merge: Merge changes from a source into your working copy.
+usage: 1. fcm merge SOURCE
+       2. fcm merge --custom  --revision N[:M] SOURCE
+          fcm merge --custom  URL[\@REV1] URL[\@REV2]
+       3. fcm merge --reverse --revision [M:]N
+
+  1. If neither --custom nor --reverse is specified, the command merges changes
+     automatically from SOURCE into your working copy. SOURCE must be a valid
+     URL[\@REV] of a branch in a standard FCM project. The base of the merge
+     will be calculated automatically based on the common ancestor and latest
+     merge information between the SOURCE and the branch of the working copy.
+
+  2. If --custom is specified, the command can be used in two forms.
+  
+     In the first form, it performs a custom merge from the specified
+     changeset(s) of SOURCE into your working copy. SOURCE must be a valid
+     URL[\@REV] of a branch in a standard FCM project. If a single revision is
+     specified, the merge delta is (N - 1):N of SOURCE. Otherwise, the merge
+     delta, is N:M of SOURCE, where N < M.
+     
+     In the second form, it performs a custom merge using the delta between the
+     two specified branch URLs. For each URL, if a peg revision is not
+     specified, the command will peg the URL with its last changed revision.
+
+  3. If --reverse is specified, the command performs a reverse merge of the
+     changeset(s) specified by the --revision option. If a single revision is
+     specified, the merge delta is N:(N - 1). Otherwise, the merge delta is
+     M:N, where M > N. Note that you do not have to specify a SOURCE for a
+     reverse merge, because the SOURCE should always be the branch your working
+     copy is pointing to.
+  
+  The command provide a commit log message template following the merge.
+
+Valid options:
+  --dry-run          : Try operation but make no changes.
+  --non-interactive  : Do no interactive prompting.
+  -r [--revision] arg: Specify a (range of) revision number(s).
+  --verbose          : Print extra information.
+EOF
+    return 1;
+  }
+
+  # Options
+  # ----------------------------------------------------------------------------
+  my ($custom, $dry_run, $non_interactive, $reverse, $rev, $verbose);
+  GetOptions (
+    'custom'          => \$custom,
+    'dry-run'         => \$dry_run,
+    'non-interactive' => \$non_interactive,
+    'reverse'         => \$reverse,
+    'revision|r=s'    => \$rev,
+    'verbose|v'       => \$verbose,
+  );
+
+  # Find out the URL of the working copy
+  # ----------------------------------------------------------------------------
+  my ($target, $wct);
+  if (&is_wc ()) {
+    $wct = &get_wct ();
+
+    if ($wct ne cwd ()) {
+      print 'Change directory to top of working copy: ', $wct, "\n";
+      chdir $wct or die 'Cannot change directory to: ', $wct;
+    }
+
+    $target = Fcm::CmBranch->new (URL => &get_url_of_wc ($wct));
+
+  } else {
+    e_report 'The current directory is not a working copy, abort.';
+  }
+
+  e_report 'Your working copy URL does not exist at the HEAD revision, abort.'
+    unless $target->url_exists;
+
+  # The target must be at the top of a branch
+  # $subdir will be used later to determine whether the merge is allowed or not
+  my $subdir = $target->subdir;
+  $target->subdir ('') if $subdir;
+
+  # Check for any local modifications
+  # ----------------------------------------------------------------------------
+  return
+    if ! ($dry_run or $non_interactive) and &_abort_modified_wc ('fcm merge');
+
+  # Determine the SOURCE URL
+  # ----------------------------------------------------------------------------
+  my $source;
+
+  if ($reverse) {
+    # Reverse merge, the SOURCE is the the working copy URL
+    $source = Fcm::CmBranch->new (URL => $target->url);
+
+  } else {
+    # Automatic/custom merge, argument 1 is the SOURCE of the merge
+    my $source_url = shift (@ARGV);
+    e_report 'Error: argument 1 must be the URL/name of a source branch in ',
+             'automatic/custom mode, abort.'
+      if not $source_url;
+
+    $source = &_construct_branch_url ($source_url, $target);
+  }
+
+  # Parse the revision option
+  # ----------------------------------------------------------------------------
+  my @revs;
+  if ($reverse or $custom) {
+    if ($reverse and not $rev) {
+      e_report 'Error: a revision (range) must be specified with ',
+               '--revision in reverse mode, abort.'
+    }
+
+    @revs = split (/:/, $rev) if $rev;
+  }
+
+  # Determine the merge delta and the commit log message
+  # ----------------------------------------------------------------------------
+  my (@delta, $mesg);
+  my $separator = '-' x 80 . "\n";
+
+  if ($reverse) {
+    # Reverse merge
+    # --------------------------------------------------------------------------
+    if (@revs == 1) {
+      $revs[1] = ($revs[0] - 1);
+
+    } else {
+      @revs = sort {$b <=> $a} @revs;
+    }
+
+    $source->pegrev ($source->svninfo (FLAG => 'Last Changed Rev'))
+      unless $source->pegrev;
+    $source->subdir ($subdir);
+
+    # "Delta" of the "svn merge" command
+    @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg);
+
+    # Template message
+    $mesg = 'Reversed r' . $revs[0] .
+            (($revs[1] < $revs[0] - 1) ? ':' . $revs[1] : '') . ' of ' .
+            $source->path . "\n";
+
+  } elsif ($custom) {
+    # Custom merge
+    # --------------------------------------------------------------------------
+    if (@revs) {
+      # Revision specified
+      # ------------------------------------------------------------------------
+      # Only one revision N specified, use (N - 1):N as the delta
+      unshift @revs, ($revs[0] - 1) if @revs == 1;
+
+      $source->pegrev ($source->svninfo (FLAG => 'Last Changed Rev'))
+        unless $source->pegrev;
+      $source->subdir ($subdir);
+      $target->subdir ($subdir);
+
+      # "Delta" of the "svn merge" command
+      @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg);
+
+      # Template message
+      $mesg = 'Custom merge into ' . $target->path . ': r' . $revs[1] .
+              ' cf. r' . $revs[0] . ' of ' . $source->path_peg . "\n";
+
+    } else {
+      # Revision not specified
+      # ------------------------------------------------------------------------
+      # Get second source URL
+      my $source2_url = shift (@ARGV);
+      e_report 'Error: argument 2 must be the URL/name of a source branch in ',
+               'custom mode when --revision is not specified, abort.'
+        if not $source2_url;
+
+      my $source2 = &_construct_branch_url ($source2_url, $target);
+
+      $source->pegrev  ($source->svninfo  (FLAG => 'Last Changed Rev'))
+        unless $source->pegrev;
+      $source2->pegrev ($source2->svninfo (FLAG => 'Last Changed Rev'))
+        unless $source2->pegrev;
+      $source->subdir  ($subdir);
+      $source2->subdir ($subdir);
+      $target->subdir  ($subdir);
+
+      # "Delta" of the "svn merge" command
+      @delta = ($source->url_peg, $source2->url_peg);
+
+      # Template message
+      $mesg = 'Custom merge into ' . $target->path . ': ' . $source->path_peg .
+              ' cf. ' . $source2->path_peg . "\n";
+    }
+
+  } else {
+    # Automatic merge
+    # --------------------------------------------------------------------------
+    # Check to ensure source branch is not the same as the target branch
+    e_report 'Error: cannot merge ', $source->branch,
+             ' to its own working copy, abort.'
+      if $source->branch eq $target->branch;
+
+    # Only allow the merge if the source and target are "directly related"
+    # --------------------------------------------------------------------------
+    my $anc = $target->ancestor ($source);
+    e_report 'Error: source and target are not directly related' unless
+      ($anc->url eq $target->url and $anc->url_peg eq $source->parent->url_peg)
+      or
+      ($anc->url eq $source->url and $anc->url_peg eq $target->parent->url_peg)
+      or
+      ($anc->url eq $source->parent->url and $anc->url eq $target->parent->url);
+
+    # Check for available merges from the source
+    # --------------------------------------------------------------------------
+    my @revs = $target->avail_merge_from ($source, 1);
+
+    if (@revs) {
+      print 'Available Merge', (@revs > 1 ? 's' : ''), ' From ',
+            $source->path_peg, ':';
+
+      if ($verbose) {
+        # Verbose mode, print log messages of available merges
+        print "\n";
+
+        for (@revs) {
+          print $separator, $source->display_svnlog ($_);
+        }
+
+        print $separator;
+
+      } else {
+        # Normal mode, list revisions of available merges
+        print ' ', join (' ', @revs), "\n";
+      }
+
+    } else {
+      w_report 'No merge available from ', $source->path_peg, ', abort.';
+      return;
+    }
+
+    # If more than one merge available, prompt user to enter a revision number
+    # to merge from, default to $revs [0]
+    # --------------------------------------------------------------------------
+    my $reply = ($non_interactive or @revs == 1) ? $revs[0] : &main::get_input (
+      TITLE   => 'fcm merge',
+      MESSAGE => 'Please enter the revision you wish to merge from',
+      DEFAULT => $revs [0],
+    );
+
+    if (not defined ($reply)) {
+      w_report 'Merge aborted by user.';
+      return;
+    }
+
+    # Expand revision keyword if necessary
+    if ($reply) {
+      $reply = expand_rev_keyword (REV => $reply, URL => $target->project_url);
+    }
+
+    # Check that the reply is a number in the available merges list
+    e_report $reply, ': not a revision in the list of available merges.'
+      unless (grep {$_ == $reply} @revs);
+
+    $source->pegrev ($1) if ($reply =~ /^(\d+)/);
+
+    # If the working copy top is pointing to a sub-directory of a branch,
+    # we need to check whether the merge will result in losing changes made in
+    # other sub-directories of the source.
+    if ($subdir and not $target->allow_subdir_merge_from ($source, $subdir)) {
+      e_report 'SOURCE contains changes outside the current sub-directory.', "\n",
+               'Please use a full tree for the merge, abort.';
+    }
+
+    # Calculate the base of the merge
+    my $base = $target->base_of_merge_from ($source);
+
+    # $source and $base must take into account the sub-directory
+    my $s = Fcm::CmBranch->new (URL => $source->url_peg);
+    my $b = Fcm::CmBranch->new (URL => $base->url_peg);
+
+    $s->subdir ($subdir) if $subdir;
+    $b->subdir ($subdir) if $subdir;
+
+    # Diagnostic
+    print 'About to merge in changes from ', $s->path_peg, ' compared with ',
+          $b->path_peg, "\n";
+
+    # Delta of the "svn merge" command
+    @delta = ($b->url_peg, $s->url_peg);
+
+    # Template message
+    $mesg = 'Merged into ' . $target->path . ': ' . $source->path_peg .
+            ' cf. ' . $base->path_peg . "\n";
+  }
+
+  # Run "svn merge" in "--dry-run" mode to see the result
+  # ----------------------------------------------------------------------------
+  my @out   = &run_command (
+    [qw/svn merge --dry-run/, @delta],
+    METHOD => 'qx', PRINT => ($dry_run and $verbose),
+  );
+
+  # Abort merge if it will result in no change
+  if (not @out) {
+    print 'This merge will not result in any change, abort.', "\n";
+    return;
+  }
+
+  # Report result of "svn merge --dry-run"
+  if (not $non_interactive) {
+    print 'This merge will result in the following change',
+          (@out > 1 ? 's' : ''), ':', "\n";
+    print $separator, @out, $separator;
+  }
+
+  return if $dry_run;
+
+  # Prompt the user to see if (s)he would like to go ahead
+  # ----------------------------------------------------------------------------
+  my $reply = $non_interactive ? 'y' : &main::get_input (
+    TITLE   => 'fcm merge',
+    MESSAGE => 'Would you like to go ahead with the merge?',
+    TYPE    => 'yn',
+    DEFAULT => 'n',
+  );
+
+  # Go ahead with merge only if user replies "y"
+  if ($reply eq "y") {
+    print "Performing merge ...\n";
+    &run_command ([qw/svn merge/, @delta], PRINT => $verbose);
+
+  } else {
+    w_report 'Merge aborted by user.';
+    return;
+  }
+
+  # Prepare the commit log
+  # ----------------------------------------------------------------------------
+  # Read in any existing message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->read_file;
+  $ci_mesg->auto_mesg ($mesg, ($ci_mesg->auto_mesg));
+  $ci_mesg->write_file;
+
+  if ($verbose) {
+    print <<EOF;
+${separator}The following line has been added to your commit message file:
+$mesg
+EOF
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_mkpatch ();
+#
+# DESCRIPTION
+#   This is a FCM command to create a patching script from particular revisions
+#   of a URL.
+# ------------------------------------------------------------------------------
+
+sub cm_mkpatch {
+  my $usage = <<EOF;
+mkpatch: Create patches from specified revisions of a URL
+usage: fcm mkpatch [OPTIONS] URL [OUTDIR]
+
+  URL must be the URL of a branch in a FCM project. If the URL is a
+  sub-directory of a branch, it will use the root of the branch.
+
+  Create patches from specified revisions of the specified URL. If OUTDIR is
+  specified, the output is sent to OUTDIR. Otherwise, the output will be sent
+  to a default location in the current directory (\$PWD/fcm-mkpatch-out). The
+  output directory will contain the patch for each revision as well as a script
+  for importing the patch.
+
+  If a revision is specified with the --revision option, it will attempt to
+  create a patch based on the changes at that revision. If a revision is not
+  specified, it will attempt to create a patch based on the changes at the HEAD
+  revision. If a revision range is specified, it will attempt to create a patch
+  for each revision in that range (including the change in the lower range)
+  where changes have taken place in the URL. No output will be written if there
+  is no change in the given revision (range).
+
+  The --exclude option can be used to exclude a path in the URL. The specified
+  path must be a relative path of the URL. Glob patterns such as * and ? are
+  acceptable. Changes in an excluded path will not be considered in the patch.
+  A changeset containing changes only in the excluded path will not be
+  considered at all.
+
+  The --organisation option can be used to specify the name of your
+  organisation. The command will attempt to parse the commit log message for
+  each revision in the patch. It will remove all merge templates, replace links
+  to Trac tickets with a simple string, and add information about the original
+  changeset. If you specify the name of your organisation, it will replace Trac
+  ticket links such as "ticket:123" to "Original \$organisation ticket 123",
+  and report the orginal changeset with a message such as "Original
+  \$organisation changeset 1000". Otherwise, it will report without the
+  organisation name, e.g. "Original ticket 123" and "Original  changeset 1000".
+
+Valid options:
+  --exclude       arg : Exclude a path in the URL. Multiple paths can be
+                        specified by using a colon-separated list of paths, or
+                        by specifying this option multiple times.
+  --organisation  arg : Specify the name of your organisation.
+  -r [--revision] arg : Specify a revision number or a revision number range.
+EOF
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print $usage;
+    return 1;
+  }
+
+  # Process command line options and arguments
+  # ----------------------------------------------------------------------------
+  my (@exclude, $organisation, $revision);
+  GetOptions (
+    'exclude=s'      => \@exclude,
+    'organisation=s' => \$organisation,
+    'r|revision=s'   => \$revision,
+  );
+
+  # Excluded paths, convert glob into regular patterns
+  @exclude = split (/:/, join (':', @exclude));
+  for (@exclude) {
+    s#\*#[^/]*#; # match any number of non-slash character
+    s#\?#[^/]#;  # match a non-slash character
+    s#/*$##;     # remove trailing slash
+  }
+
+  # Organisation prefix
+  $organisation = $organisation ? $organisation : 'original';
+
+  # Make sure revision option is set correctly
+  my @revs = $revision ? split (/:/, $revision) : ();
+  @revs    = @revs [0, 1] if @revs > 2;
+
+  # Arguments
+  my ($u, $outdir) = @ARGV;
+
+  if (not $u) {
+    print $usage;
+    return 1;
+  }
+
+  my $url = Fcm::CmUrl->new (URL => $u);
+  e_report $u, ': URL is not a URL, abort.' if not $url->is_url;
+  e_report $u, ': URL does not exist, abort.' if not $url->url_exists;
+  e_report $u, ': URL is not a valid branch in a FCM project, abort.'
+    if not $url->branch;
+
+  $url->subdir ('');
+
+  if (@revs) {
+    # If HEAD revision is given, convert it into a number
+    # --------------------------------------------------------------------------
+    for my $rev (@revs) {
+      $rev = $url->svninfo (FLAG => 'Revision') if uc ($rev) eq 'HEAD';
+    }
+
+  } else {
+    # If no revision is given, use the HEAD
+    # --------------------------------------------------------------------------
+    $revs[0] = $url->svninfo (FLAG => 'Revision');
+  }
+
+  $revs[1] = $revs[0] if @revs == 1;
+
+  # Check that output directory is set
+  # ----------------------------------------------------------------------------
+  $outdir = File::Spec->catfile (cwd (), 'fcm-mkpatch-out') if not $outdir;
+
+  if (-e $outdir) {
+    # Ask user to confirm removal of old output directory if it exists
+    my $reply = &main::get_input (
+      TITLE   => 'fcm mkpatch',
+      MESSAGE => 'Output location ' . $outdir . ' exists. OK to overwrite?',
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+
+    if ($reply ne 'y') {
+      w_report 'fcm mkpatch: command aborted by user.';
+      return 1;
+    }
+
+    rmtree $outdir or die $outdir, ': cannot remove';
+  }
+
+  # (Re-)create output directory
+  mkpath $outdir or die $outdir, ': cannot create';
+  print 'Output directory: ', $outdir, "\n";
+
+  # Get and process log of URL
+  # ----------------------------------------------------------------------------
+  my @script     = (); # output script, from the log
+  my %log        = $url->svnlog (REV => \@revs);
+  my $url_path   = $url->path;
+  my $file_count = 0;
+
+  for my $rev (sort {$a <=> $b} keys %log) {
+    # Look at the changed paths for each revision
+    my @paths;
+
+    # Skip excluded paths if necessary
+    PATH: for my $path (sort keys %{ $log{$rev}{paths} }) {
+      for my $exclude (@exclude) {
+        (my $file = $path) =~ s#^$url_path/*##;
+
+        next PATH if $file =~ m#^$exclude(?:/*|$)#;
+      }
+
+      push @paths, $path;
+    }
+
+    next unless @paths;
+
+    # Parse commit log message
+    my @msg = split /\n/, $log{$rev}{msg};
+    for (@msg) {
+      # Re-instate line break
+      $_ .= "\n";
+
+      # Remove line if it matches a merge template
+      $_ = '' if /^Reversed r\d+(?::\d+)? of \S+$/;
+      $_ = '' if /^Custom merge into \S+:.+$/;
+      $_ = '' if /^Merged into \S+: \S+ cf\. \S+$/;
+
+      # Modify Trac ticket link
+      s/(?:#|ticket:)(\d+)/[$organisation ticket $1]/g;
+
+      # Modify Trac changeset link
+      s/(?:r|changeset:)(\d+)/[$organisation changeset $1]/g;
+      s/\[(\d+)\]/[$organisation changeset $1]/g;
+    }
+
+    push @msg, '[' . $organisation . ' changeset ' . $rev . ']' . "\n";
+
+    # Write commit log message in a file
+    my $f_revlog = File::Spec->catfile ($outdir, $rev . '-log');
+    open FILE, '>', $f_revlog or die $f_revlog, ': cannot open (', $!, ')';
+    print FILE @msg;
+    close FILE or die $f_revlog, ': cannot close (', $!, ')';
+
+    # Create a directory for this revision in the output directory
+    my $outdir_rev = File::Spec->catfile ($outdir, $rev);
+    mkpath $outdir_rev or die $outdir_rev, ': cannot create';
+
+    # Handle modified/copy/new path, export the path, + script to copy/add it
+    for my $path (@paths) {
+      next unless $log{$rev}{paths}{$path}{action} =~ /^[AMR]$/;
+
+      (my $file = $path) =~ s#^$url_path/*##;
+
+      # Download the file using "svn export"
+      my $patch    = File::Spec->catfile ($outdir_rev, $file_count++);
+      my $url_file = $url->url . '/' . $file . '@' . $rev;
+      &run_command ([qw/svn export -q -r/, $rev, $url_file, $patch]);
+
+      (my $patch_path = $patch) =~ s#^$outdir/*##;
+
+      # Script to copy the file, if required
+      my $is_newfile = 0;
+      if ($log{$rev}{paths}{$path}{action} eq 'A') {
+        if (exists $log{$rev}{paths}{$path}{'copyfrom-path'}) {
+          # History exists for this file
+          my $copyfrom_path = $log{$rev}{paths}{$path}{'copyfrom-path'};
+          my $copyfrom_rev  = $log{$rev}{paths}{$path}{'copyfrom-rev'};
+
+          # Check whether file is copied from a file under the specified URL
+          # It is likely to be a new file if it is copied from outside of the
+          # specified URL.
+          $is_newfile = not ($copyfrom_path =~ s#^$url_path/*##);
+
+          if ($is_newfile) {
+            # File copied from outside of the specified URL
+            # If it is copied from a branch, follow its history, stop on copy
+            my $cp_url = Fcm::CmUrl->new (
+              URL => $url->root . $copyfrom_path . '@' . $copyfrom_rev,
+            );
+
+            # Log of the copied file
+            my %cp_log = $cp_url->svnlog (STOP_ON_COPY => 1);
+
+            # "First" revision of the copied file
+            my $cp_rev = (sort {$a <=> $b} keys %cp_log) [0];
+            my %attrib = exists $cp_log{$cp_rev}{paths}{$cp_url->path}
+                         ? %{ $cp_log{$cp_rev}{paths}{$cp_url->path} } : ();
+
+            # Check whether the "first" revision is copied from elsewhere.
+            if (exists $attrib{'copyfrom-path'}) {
+              # Check whether source exists in the current branch
+              my $cp_cp_url = Fcm::CmUrl->new (
+                URL => $url->root . $attrib{'copyfrom-path'} . '@' .
+                       $attrib{'copyfrom-rev'},
+              );
+
+              $cp_cp_url->branch ($url->branch);
+
+              # If source exists in current branch, set up copy from the source
+              if ($cp_cp_url->url_exists ($rev - 1)) {
+                $is_newfile     = 0;
+                (my $cp_cp_path = $cp_cp_url->path) =~ s#^$url_path/*##;
+
+                push @script, 'svn copy ' . $cp_cp_path .  ' ' . $file;
+              }
+            }
+
+          } else {
+            # File copied from a location under the specified URL
+            # Script to copy file
+            push @script, 'svn copy ' . $copyfrom_path .  ' ' . $file;
+          }
+
+        } else {
+          # History does not exist, must be a new file
+          $is_newfile = 1;
+        }
+      }
+
+      # Copy the "patch" into the file
+      push @script, 'cp -r ${fcm_patch_dir}/' . $patch_path . ' ' . $file;
+
+      # Script to add the file, if required
+      push @script, 'svn add ' . $file
+        if $log{$rev}{paths}{$path}{action} eq 'A' and $is_newfile;
+    }
+
+    # Handle deleted path, script to delete it
+    for my $path (@paths) {
+      next unless $log{$rev}{paths}{$path}{action} eq 'D';
+
+      (my $file = $path) =~ s#^$url_path/*##;
+
+      push @script, 'svn delete ' . $file;
+    }
+
+    # Script to commit the change
+    push @script, 'svn commit -F ${fcm_patch_dir}/' . $rev . '-log';
+    push @script, '';
+  }
+
+  # Write the script if necessary. Otherwise remove output directory
+  # ----------------------------------------------------------------------------
+  if (@script) {
+    # Add line break to each line in @script
+    @script = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")} @script;
+
+    # Write script to output
+    my $out = File::Spec->catfile ($outdir, 'fcm-import-patch');
+    open FILE, '>', $out or die $out, ': cannot open (', $!, ')';
+
+    # Script header
+    print FILE <<EOF;
+#!/bin/sh
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm-import-patch
+#
+# SYNOPSIS
+#   fcm-import-patch TARGET
+#
+# DESCRIPTION
+#   This script is generated automatically by the "fcm mkpatch" command,
+#   together with the revision "patches" it creates. The script imports the
+#   patches into TARGET, which must either be a URL or a working copy of a
+#   valid project tree that can accept the import of the patches.
+#
+#   Patch created from $organisation URL: $u
+# ------------------------------------------------------------------------------
+
+this=`basename \$0`
+
+# Check argument
+target=\$1
+
+# First argument must be a URL or working copy
+if [[ -z \$target ]]; then
+  echo "\$this: the first argument must be a URL or a working copy, abort." >&2
+  exit 1
+fi
+
+if [[ \$target == svn://*  || \$target == svn+ssh://* || \\
+      \$target == http://* || \$target == https://*   || \\
+      \$target == file://* ]]; then
+  # A URL, checkout a working copy in a temporary location
+  fcm_tmp_dir=`mktemp -d \$TMPDIR/\$0.XXXXXX`
+  fcm_working_copy=\$fcm_tmp_dir
+  svn checkout -q \$target \$fcm_working_copy || exit 1
+
+else
+  # A working copy, check that it does not have local changes
+  status=`svn status \$target`
+
+  if [[ -n \$status ]]; then
+    echo "\$target: working copy contains changes, abort." >&2
+    exit 1
+  fi
+
+  fcm_working_copy=\$target
+fi
+
+# Location of the patches, base on the location of this script
+cd `dirname \$0` || exit 1
+fcm_patch_dir=\$PWD
+
+# Change directory to the working copy
+cd \$fcm_working_copy || exit 1
+
+# Commands to apply patches
+EOF
+
+    # Script content
+    print FILE @script;
+
+    # Script footer
+    print FILE <<EOF;
+# Remove temporary working copy, if necessary
+if [[ -d \$fcm_tmp_dir && -w \$fcm_tmp_dir ]]; then
+  rm -rf \$fcm_tmp_dir
+fi
+
+echo "\$this: finished normally."
+#EOF
+EOF
+
+    close FILE or die $out, ': cannot close (', $!, ')';
+
+    # Add executable permission
+    chmod 0755, $out;
+
+    # Diagnostic
+    print $outdir, ': patch generated.', "\n";
+
+  } else {
+    # Remove output directory
+    rmtree $outdir or die $outdir, ': cannot remove';
+
+    # Diagnostic
+    w_report 'No patch is required, abort.';
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_svn ();
+#
+# DESCRIPTION
+#   This is a generic wrapper for all "other" Subversion commands.
+# ------------------------------------------------------------------------------
+
+sub cm_svn {
+  &run_command (
+    ['svn', @_, @ARGV],
+    PRINT => ($_[0] ne 'cat' and not grep {$_ eq '--xml'} @ARGV),
+    METHOD => 'exec',
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_switch ();
+#
+# DESCRIPTION
+#   This is a wrapper for the Subversion "switch" command.
+# ------------------------------------------------------------------------------
+
+sub cm_switch {
+  if (grep {$_ eq '-h' or $_ eq '--help'} @ARGV or not @ARGV) {
+    # Print usage message if requested
+    print <<EOF;
+usage: 1. switch URL [PATH]
+       2. switch --relocate FROM TO [PATH...]
+
+Note: if --relocate is not specified, "fcm switch" will only support the
+      options --non-interactive, -r [--revision] and -q [--quiet].
+
+EOF
+
+    &run_command ([qw/svn switch --help/], PRINT => 1, METHOD => 'exec');
+
+  } elsif (grep {$_ eq '--relocate'} @ARGV) {
+    # If "--relocate" is specified, call the command "as is"
+    cm_svn ('switch');
+  }
+
+  # "--help" and "--relocate" not specified, implement custom switch command
+
+  # Get command line options
+  my ($non_interactive, $rev, $quiet);
+  GetOptions (
+    'non-interactive' => \$non_interactive,
+    'revision|r=s'    => \$rev,
+    'quiet|q'         => \$quiet,
+  );
+
+  # The remaining arguments
+  $rev = 'HEAD' if not $rev;
+
+  # The remaining arguments
+  my ($newurl_arg, $path) = @ARGV;
+
+  # Make sure we are in a working copy
+  if ($path) {
+    e_report $path, ': does not exist, abort.' if not -e $path;
+
+  } else {
+    $path = cwd ();
+  }
+
+  e_report $path, ': not a working copy, abort.' if not &is_wc ($path);
+
+  # Make sure we are at the top level of the working copy
+  my $dir = &get_wct ($path);
+
+  # Check for merge template in the commit log file in the working copy
+  my $ci_mesg = Fcm::CmCommitMessage->new (DIR => $dir);
+  $ci_mesg->read_file;
+  e_report (
+    (($path eq $dir) ? $ci_mesg->base : $ci_mesg->file),
+    ': merge template exists, please remove it before running switch, abort.',
+  ) if $ci_mesg->auto_mesg;
+
+  # Check for any local modifications
+  return if ! $non_interactive and &_abort_modified_wc ('fcm switch', $dir);
+
+  # Get current URL information associated with the working copy
+  my $oldurl = Fcm::CmBranch->new (URL => &get_url_of_wc ($dir));
+
+  # Analyse new URL
+  my $newurl = &_construct_branch_url ($newurl_arg, $oldurl);
+
+  # Construct the switch command
+  my @command = (
+    qw/svn switch/,
+    ($non_interactive ? '--non-interactive' : ()),
+    ($rev             ? ('-r', $rev)        : ()),
+    ($quiet           ? '--quiet'           : ()),
+    $newurl->url,
+    ($dir eq cwd () ? () : $dir),
+  );
+
+  # Execute the command
+  &run_command (\@command, METHOD => 'exec', PRINT => 1);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $source = &_construct_branch_url ($src_url, $target);
+#
+# DESCRIPTION
+#   The function takes a string $src_url, which is normally the SOURCE URL
+#   argument for "merge" and "switch", and a target, which is an instance of a
+#   Fcm::CmBranch object with a valid URL of a standard FCM branch. It returns
+#   an instance of a Fcm::CmBranch object that represents a valid URL for
+#   $src_url.
+# ------------------------------------------------------------------------------
+
+sub _construct_branch_url {
+  my ($src_url, $target) = @_;
+
+  my $source = Fcm::CmBranch->new (URL => $src_url);
+
+  if (not $source->is_url) {
+    # Not a full URL, construct full URL based on current URL
+    $source->url_peg ($target->url_peg);
+
+    my $path    = '';
+    my $project = $target->project;
+
+    # Construct the branch URL
+    if ($src_url =~ m#^/*$project/(?:trunk|branches|tags)$#) {
+      # Argument contains the full path under the repository root
+      $path = $src_url;
+
+    } elsif ($src_url =~ m#^/*trunk/*(?:@\d+)?$# or
+             $src_url =~ m#^/*(?:trunk|branches|tags)/+#) {
+      # Argument contains the full branch name
+      $src_url =~ s#^/*##;
+      $path    = $target->project_path . '/' . $src_url;
+
+    } else {
+      # Argument contains the shorter branch name
+      $src_url =~ s#^/*##;
+      $path    = $target->project_path . '/branches/' . $src_url;
+    }
+
+    $source->path_peg ($path);
+  }
+
+  # Replace source sub-directory with the target sub-directory
+  $source->subdir ($target->subdir);
+
+  # Ensure that the branch name exists
+  e_report $src_url, ': not a valid URL, abort.'
+    if not $source->url_exists;
+
+  # Ensure that the branch name is valid
+  e_report $src_url, ': not a standard branch in a FCM project, abort.'
+    if not $source->branch;
+
+  # Ensure that the source and target URLs are in the same project
+  e_report 'Source and target URLs are in different projects, abort.'
+    if $source->project_url ne $target->project_url;
+
+  return $source;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &_abort_modified_wc ($title, [$wc]);
+#
+# DESCRIPTION
+#   The function checks for any local modifications in a working copy and
+#   prompts the user whether he/she wants to continue with the command. $title
+#   is the title of the current command. If $wc is specified, it must be the
+#   path to a working copy. Otherwise, the current working directory is used.
+# ------------------------------------------------------------------------------
+
+sub _abort_modified_wc {
+  my ($title, $wc) = @_;
+
+  my @status = &run_command ([qw/svn status/, ($wc ? $wc : ())], METHOD => 'qx');
+
+  if (@status) {
+    print 'You have local modifications:', "\n", @status;
+    my $reply = &main::get_input (
+      TITLE   => $title,
+      MESSAGE => 'Are you sure you want to continue?',
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+
+    # Abort if user gives any reply other than "y"
+    if ($reply ne 'y') {
+      w_report $title, ': command aborted by user.';
+      return 1;
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/CmBranch.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/CmBranch.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/CmBranch.pm	(revision 6412)
@@ -0,0 +1,1199 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmBranch
+#
+# DESCRIPTION
+#   This class contains methods for manipulating a branch. It is a sub-class of
+#   Fcm::CmUrl, and inherits all methods from that class.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmBranch;
+@ISA = qw(Fcm::CmUrl);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+
+# FCM component modules
+use Fcm::CmCommitMessage;
+use Fcm::CmUrl;
+use Fcm::Util qw/run_command e_report w_report get_rev_keyword svn_date/;
+
+my @properties = (
+  'CREATE_REV',  # revision at which the branch is created
+  'DELETE_REV',  # revision at which the branch is deleted
+  'PARENT',      # reference to parent branch Fcm::CmBranch
+  'ANCESTOR',    # list of common ancestors with other branches
+                 # key = URL, value = ancestor Fcm::CmBranch
+  'LAST_MERGE',  # list of last merges from branches
+                 # key = URL@REV, value = [TARGET, UPPER, LOWER]
+  'AVAIL_MERGE', # list of available revisions for merging
+                 # key = URL@REV, value = [REV ...]
+  'CHILDREN',    # list of children of this branch
+  'SIBLINGS',    # list of siblings of this branch
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch = Fcm::CmBranch->new (
+#     CONFIG  => $config,
+#     URL     => $url,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmBranch class.
+#
+# ARGUMENTS
+#   CONFIG - reference to a Fcm::Config instance
+#   URL    - URL of a branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::CmUrl->new (%args);
+
+  $self->{$_} = undef for (@properties);
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_branch->url_peg;
+#   $cm_branch->url_peg ($url);
+#
+# DESCRIPTION
+#   This method returns/sets the current URL.
+# ------------------------------------------------------------------------------
+
+sub url_peg {
+  my $self = shift;
+
+  if (@_) {
+    if (! $self->{URL} or $_[0] ne $self->{URL}) {
+      # Re-set URL and other essential variables in the SUPER-class
+      $self->SUPER::url_peg (@_);
+
+      # Re-set essential variables
+      $self->{$_} = undef for (@properties);
+    }
+  }
+
+  return $self->{URL};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_branch->create_rev;
+#
+# DESCRIPTION
+#   This method returns the revision at which the branch was created.
+# ------------------------------------------------------------------------------
+
+sub create_rev {
+  my $self = shift;
+
+  if (not $self->{CREATE_REV}) {
+    return unless $self->url_exists ($self->pegrev);
+
+    # Use "svn log" to find out the first revision of the branch
+    my %log = $self->svnlog (STOP_ON_COPY => 1);
+
+    # Look at log in ascending order
+    my $rev   = (sort {$a <=> $b} keys %log) [0];
+    my $paths = $log{$rev}{paths};
+
+    # Get revision when URL is first added to the repository
+    if (exists $paths->{$self->branch_path}) {
+      $self->{CREATE_REV} = $rev if $paths->{$self->branch_path}{action} eq 'A';
+    }
+  }
+
+  return $self->{CREATE_REV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $parent = $cm_branch->parent;
+#
+# DESCRIPTION
+#   This method returns the parent (a Fcm::CmBranch object) of the current
+#   branch.
+# ------------------------------------------------------------------------------
+
+sub parent {
+  my $self = shift;
+
+  if (not $self->{PARENT}) {
+    # Use the log to find out the parent revision
+    my %log = $self->svnlog (REV => $self->create_rev);
+
+    if (exists $log{paths}{$self->branch_path}) {
+      my $path = $log{paths}{$self->branch_path};
+
+      if ($path->{action} eq 'A') {
+        if (exists $path->{'copyfrom-path'}) {
+          # Current branch is copied from somewhere, set the source as the parent
+          my $url = $self->root .  $path->{'copyfrom-path'};
+          my $rev = $path->{'copyfrom-rev'};
+          $self->{PARENT} = Fcm::CmBranch->new (URL => $url . '@' . $rev);
+
+        } else {
+          # Current branch is not copied from somewhere
+          $self->{PARENT} = $self;
+        }
+      }
+    }
+  }
+
+  return $self->{PARENT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_branch->delete_rev;
+#
+# DESCRIPTION
+#   This method returns the revision at which the branch was deleted.
+# ------------------------------------------------------------------------------
+
+sub delete_rev {
+  my $self = shift;
+
+  if (not $self->{DELETE_REV}) {
+    return if $self->url_exists ('HEAD');
+
+    # Container of the current URL
+    (my $dir_url = $self->branch_url) =~ s#/+[^/]+/*$##;
+
+    # Use "svn log" on the container between a revision where the branch exists
+    # and the HEAD
+    my $dir = Fcm::CmUrl->new (URL => $dir_url);
+    my %log = $dir->svnlog (
+      REV => ['HEAD', ($self->pegrev ? $self->pegrev : $self->create_rev)],
+    );
+
+    # Go through the log to see when branch no longer exists
+    for my $rev (sort {$a <=> $b} keys %log) {
+      next unless exists $log{$rev}{paths}{$self->branch_path} and
+                  $log{$rev}{paths}{$self->branch_path}{action} eq 'D';
+
+      $self->{DELETE_REV} = $rev;
+      last;
+    }
+  }
+
+  return $self->{DELETE_REV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->is_child_of ($branch);
+#
+# DESCRIPTION
+#   This method returns true if the current branch is a child of $branch.
+# ------------------------------------------------------------------------------
+
+sub is_child_of {
+  my ($self, $branch) = @_;
+
+  # The trunk cannot be a child branch
+  return if $self->is_trunk;
+
+  # If $branch is a branch, use name of $self to see when it is created
+  if ($branch->is_branch and $self->url =~ m#/r(\d+)_[^/]+/*$#) {
+    my $rev = $1;
+
+    # $self can only be a child if it is copied from a revision > the create
+    # revision of $branch
+    return if $rev < $branch->create_rev;
+  }
+
+  return if $self->parent->url ne $branch->url;
+
+  # If $branch is a branch, ensure that it is created before $self
+  return if $branch->is_branch and $self->create_rev <= $branch->create_rev;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->is_sibling_of ($branch);
+#
+# DESCRIPTION
+#   This method returns true if the current branch is a sibling of $branch.
+# ------------------------------------------------------------------------------
+
+sub is_sibling_of {
+  my ($self, $branch) = @_;
+
+  # The trunk cannot be a sibling branch
+  return if $branch->is_trunk;
+
+  return if $self->parent->url ne $branch->parent->url;
+
+  # If the parent is a branch, ensure they are actually the same branch
+  return if $branch->parent->is_branch and
+            $self->parent->create_rev != $branch->parent->create_rev;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_relatives ($relation);
+#
+# DESCRIPTION
+#   This method sets the $self->{$relation} variable by inspecting the list of
+#   branches at the current revision of the current branch. $relation can be
+#   either "CHILDREN" or "SIBLINGS".
+# ------------------------------------------------------------------------------
+
+sub _get_relatives {
+  my ($self, $relation) = @_;
+
+  my @branch_list = $self->branch_list;
+
+  $self->{$relation} = [];
+
+  # If we are searching for CHILDREN, get list of SIBLINGS, and vice versa
+  my $other = ($relation eq 'CHILDREN' ? 'SIBLINGS' : 'CHILDREN');
+  my %other_list;
+  if ($self->{$other}) {
+    %other_list = map {$_->url, 1} @{ $self->{$other} };
+  }
+
+  for my $u (@branch_list) {
+    # Ignore URL of current branch and its parent
+    next if $u eq $self->url;
+    next if $self->is_branch and $u eq $self->parent->url;
+
+    # Ignore if URL is a branch detected to be another type of relative
+    next if exists $other_list{$u};
+
+    # Construct new Fcm::CmBranch object from branch URL
+    my $url = $u . ($self->pegrev ? '@' . $self->pegrev : '');
+    my $branch = Fcm::CmBranch->new (URL => $url);
+
+    # Test whether $branch is a relative we are looking for
+    if ($relation eq 'CHILDREN') {
+      push @{ $self->{$relation} }, $branch if $branch->is_child_of ($self);
+
+    } else {
+      push @{ $self->{$relation} }, $branch if $branch->is_sibling_of ($self);
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @children = $cm_branch->children;
+#
+# DESCRIPTION
+#   This method returns a list of children (Fcm::CmBranch objects) of the
+#   current branch that exists in the current revision.
+# ------------------------------------------------------------------------------
+
+sub children {
+  my $self = shift;
+
+  $self->_get_relatives ('CHILDREN') if not $self->{CHILDREN};
+
+  return @{ $self->{CHILDREN} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @siblings = $cm_branch->siblings;
+#
+# DESCRIPTION
+#   This method returns a list of siblings (Fcm::CmBranch objects) of the
+#   current branch that exists in the current revision.
+# ------------------------------------------------------------------------------
+
+sub siblings {
+  my $self = shift;
+
+  $self->_get_relatives ('SIBLINGS') if not $self->{SIBLINGS};
+
+  return @{ $self->{SIBLINGS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ancestor = $cm_branch->ancestor ($branch);
+#
+# DESCRIPTION
+#   This method returns the common ancestor (a Fcm::CmBranch object) of a
+#   specified $branch and the current branch. The argument $branch must be a
+#   Fcm::CmBranch object. Both the current branch and $branch are assumed to be
+#   in the same project.
+# ------------------------------------------------------------------------------
+
+sub ancestor {
+  my ($self, $branch) = @_;
+
+  if (not exists $self->{ANCESTOR}{$branch->url_peg}) {
+    if ($self->url_peg eq $branch->url_peg) {
+      $self->{ANCESTOR}{$branch->url_peg} = $self;
+
+    } else {
+      # Get family tree of current branch, from trunk to current branch
+      my @this_family = ($self);
+      while (not $this_family [0]->is_trunk) {
+        unshift @this_family, $this_family [0]->parent;
+      }
+
+      # Get family tree of $branch, from trunk to $branch
+      my @that_family = ($branch);
+      while (not $that_family [0]->is_trunk) {
+        unshift @that_family, $that_family [0]->parent;
+      }
+
+      # Find common ancestor from list of parents
+      my $ancestor = undef;
+
+      while (not $ancestor) {
+        # $this and $that should both start as some revisions on the trunk.
+        # Walk down a generation each time it loops around.
+        my $this = shift @this_family;
+        my $that = shift @that_family;
+
+        if ($this->url eq $that->url) {
+          if ($this->is_trunk or $this->create_rev eq $that->create_rev) {
+            # $this and $that are the same branch
+            if (@this_family and @that_family) {
+              # More generations in both branches, try comparing the next
+              # generations.
+              next;
+
+            } else {
+              # End of lineage in one of the branches, ancestor is at the lower
+              # revision of the current URL.
+              if ($this->pegrev and $that->pegrev) {
+                $ancestor = $this->pegrev < $that->pegrev ? $this : $that;
+
+              } else {
+                $ancestor = $this->pegrev ? $this : $that;
+              }
+            }
+
+          } else {
+            # Despite the same URL, $this and $that are different branches as
+            # they are created at different revisions. The ancestor must be the
+            # parent with the lower revision. (This should not occur at the
+            # start.)
+            $ancestor = $this->parent->pegrev < $that->parent->pegrev
+                        ? $this->parent : $that->parent;
+          }
+
+        } else {
+          # Different URLs, ancestor must be the parent with the lower revision.
+          # (This should not occur at the start.)
+          $ancestor = $this->parent->pegrev < $that->parent->pegrev
+                      ? $this->parent : $that->parent;
+        }
+      }
+
+      $self->{ANCESTOR}{$branch->url_peg} = $ancestor;
+    }
+  }
+
+  return $self->{ANCESTOR}{$branch->url_peg};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($target, $upper, $lower) = $cm_branch->last_merge_from (
+#     $branch, $stop_on_copy,
+#   );
+#
+# DESCRIPTION
+#   This method returns a 3-element list with information of the last merge
+#   into the current branch from a specified $branch. The first element in the
+#   list $target (a Fcm::CmBranch object) is the target at which the merge was
+#   performed. (This can be the current branch or a parent branch up to the
+#   common ancestor with the specified $branch.) The second and third elements,
+#   $upper and $lower, (both Fcm::CmBranch objects), are the upper and lower
+#   ends of the source delta. If there is no merge from $branch into the
+#   current branch from their common ancestor to the current revision, this
+#   method will return an empty list. If $stop_on_copy is specified, it ignores
+#   merges from parents of $branch, and merges into parents of the current
+#   branch.
+# ------------------------------------------------------------------------------
+
+sub last_merge_from {
+  my ($self, $branch, $stop_on_copy) = @_;
+
+  if (not exists $self->{LAST_MERGE}{$branch->url_peg}) {
+    # Get "log" of current branch down to the common ancestor
+    my %log = $self->svnlog (
+      REV => [
+       ($self->pegrev ? $self->pegrev : 'HEAD'),
+       $self->ancestor ($branch)->pegrev,
+      ],
+
+      STOP_ON_COPY => $stop_on_copy,
+    );
+
+    my $cr = $self;
+
+    # Go down the revision log, checking for merge template messages
+    REV: for my $rev (sort {$b <=> $a} keys %log) {
+      # Loop each line of the log message at each revision
+      my @msg = split /\n/, $log{$rev}{msg};
+
+      # Also consider merges into parents of current branch
+      $cr = $cr->parent if ($cr->is_branch and $rev < $cr->create_rev);
+
+      for (@msg) {
+        # Ignore unless log message matches a merge template
+        next unless /Merged into \S+: (\S+) cf\. (\S+)/;
+
+        # Upper $1 and lower $2 ends of the source delta
+        my $u_path = $1;
+        my $l_path = $2;
+
+        # Add the root directory to the paths if necessary
+        $u_path = '/' . $u_path if substr ($u_path, 0, 1) ne '/';
+        $l_path = '/' . $l_path if substr ($l_path, 0, 1) ne '/';
+
+        # Only consider merges with specified branch (and its parent)
+        (my $path = $u_path) =~ s/@(\d+)$//;
+        my $u_rev = $1;
+
+        my $br = $branch;
+        $br    = $br->parent while (
+          $br->is_branch and $u_rev < $br->create_rev and not $stop_on_copy
+        );
+
+        next unless $br->branch_path eq $path;
+
+        # If $br is a parent of branch, ignore those merges with the parent
+        # above the branch point of the current branch
+        next if $br->pegrev and $br->pegrev < $u_rev;
+
+        # Set the return values
+        $self->{LAST_MERGE}{$branch->url_peg} = [
+          Fcm::CmBranch->new (URL => $cr->url . '@' . $rev), # target
+          Fcm::CmBranch->new (URL => $self->root . $u_path), # delta upper
+          Fcm::CmBranch->new (URL => $self->root . $l_path), # delta lower
+        ];
+
+        last REV;
+      }
+    }
+  }
+
+  return (exists $self->{LAST_MERGE}{$branch->url_peg}
+          ? @{ $self->{LAST_MERGE}{$branch->url_peg} } : ());
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @revs = $cm_branch->avail_merge_from ($branch[, $stop_on_copy]);
+#
+# DESCRIPTION
+#   This method returns a list of revisions of a specified $branch, which are
+#   available for merging into the current branch. If $stop_on_copy is
+#   specified, it will not list available merges from the parents of $branch.
+# ------------------------------------------------------------------------------
+
+sub avail_merge_from {
+  my ($self, $branch, $stop_on_copy) = @_;
+
+  if (not exists $self->{AVAIL_MERGE}{$branch->url_peg}) {
+    # Find out the revision of the upper delta at the last merge from $branch
+    # If no merge is found, use revision of common ancestor with $branch
+    my @last_merge = $self->last_merge_from ($branch);
+    my $rev        = $self->ancestor ($branch)->pegrev;
+    $rev           = $last_merge [1]->pegrev
+      if @last_merge and $last_merge [1]->pegrev > $rev;
+
+    # Get the "log" of the $branch down to $rev
+    my %log = $branch->svnlog (
+      REV          => [($branch->pegrev ? $branch->pegrev : 'HEAD'), $rev],
+      STOP_ON_COPY => $stop_on_copy,
+    );
+
+    # No need to include $rev itself, as it has already been merged
+    delete $log{$rev};
+
+    # No need to include the branch create revision
+    delete $log{$branch->create_rev}
+      if $branch->is_branch and exists $log{$branch->create_rev};
+
+    if (keys %log) {
+      # Check whether there is a latest merge from $self into $branch, if so,
+      # all revisions of $branch below that merge should become unavailable
+      my @last_merge_into = $branch->last_merge_from ($self);
+
+      if (@last_merge_into) {
+        for my $rev (keys %log) {
+          delete $log{$rev} if $rev < $last_merge_into [0]->pegrev;
+        }
+      }
+    }
+
+    # Available merges include all revisions above the branch creation revision
+    # or the revision of the last merge
+    $self->{AVAIL_MERGE}{$branch->url_peg} = [sort {$b <=> $a} keys %log];
+  }
+
+  return @{ $self->{AVAIL_MERGE}{$branch->url_peg} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $lower = $cm_branch->base_of_merge_from ($branch);
+#
+# DESCRIPTION
+#   This method returns the lower delta (a Fcm::CmBranch object) for the next
+#   merge from $branch.
+# ------------------------------------------------------------------------------
+
+sub base_of_merge_from {
+  my ($self, $branch) = @_;
+
+  # Base is the ancestor if there is no merge between $self and $branch
+  my $return = $self->ancestor ($branch);
+
+  # Get configuration for the last merge from $branch to $self
+  my @merge_from = $self->last_merge_from ($branch);
+
+  # Use the upper delta of the last merge from $branch, as all revisions below
+  # that have already been merged into the $self
+  $return = $merge_from [1]
+    if @merge_from and $merge_from [1]->pegrev > $return->pegrev;
+
+  # Get configuration for the last merge from $self to $branch
+  my @merge_into = $branch->last_merge_from ($self);
+
+  # Use the upper delta of the last merge from $self, as the current revision
+  # of $branch already contains changes of $self up to the peg revision of the
+  # upper delta
+  $return = $merge_into [1]
+    if @merge_into and $merge_into [0]->pegrev > $return->pegrev;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->allow_subdir_merge_from ($branch, $subdir);
+#
+# DESCRIPTION
+#   This method returns true if a merge from the sub-directory $subdir in
+#   $branch  is allowed - i.e. it does not result in losing changes made in
+#   $branch outside of $subdir.
+# ------------------------------------------------------------------------------
+
+sub allow_subdir_merge_from {
+  my ($self, $branch, $subdir) = @_;
+
+  # Get revision at last merge from $branch or ancestor
+  my @merge_from = $self->last_merge_from ($branch);
+  my $last       = @merge_from ? $merge_from [1] : $self->ancestor ($branch);
+  my $rev        = $last->pegrev;
+
+  if ($branch->pegrev > $rev) {
+    # Inspect log from revision at last merge/ancestor to current revision
+    my %log = $branch->svnlog (REV => [$branch->pegrev, $rev + 1]);
+    my $br  = $branch;
+
+    # Check whether there are changes outside of $subdir
+    for my $rev (sort {$b <=> $a} keys %log) {
+      $br = $br->parent if $br->is_branch and $rev < $br->create_rev;
+
+      for my $path (keys %{ $log{$rev}{paths} }) {
+        next if $path eq $br->branch_path; # Ignore branch creation
+
+        my $p_subdir = substr ($path, length ($br->branch_path) + 1);
+
+        return if $p_subdir !~ m#^$subdir(?:/|$)#;
+      }
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->create (
+#     SRC                  => $src,
+#     TYPE                 => $type,
+#     NAME                 => $name,
+#     [PASSWORD            => $password,]
+#     [REV_FLAG            => $rev_flag,]
+#     [TICKET              => \@tickets,]
+#     [REV                 => $rev,]
+#     [NON_INTERACTIVE     => 1,]
+#     [SVN_NON_INTERACTIVE => 1,]
+#   );
+#
+# DESCRIPTION
+#   This method creates a branch in a Subversion repository.
+#
+# OPTIONS
+#   SRC                 - reference to a Fcm::CmUrl object.
+#   TYPE                - Specify the branch type. See help in "fcm branch" for
+#                         further information.
+#   NAME                - specify the name of the branch.
+#   NON_INTERACTIVE     - Do no interactive prompting, set SVN_NON_INTERACTIVE
+#                         to true automatically.
+#   PASSWORD            - specify the password for commit access.
+#   REV                 - specify the operative revision of the source.
+#   REV_FLAG            - A flag to specify the behaviour of the prefix to the
+#                         branch name. See help in "fcm branch" for further
+#                         information.
+#   SVN_NON_INTERACTIVE - Do no interactive prompting when running svn commit,
+#                         etc. This option is implied by NON_INTERACTIVE.
+#   TICKET              - Specify one or more related tickets for the branch.
+# ------------------------------------------------------------------------------
+
+sub create {
+  my $self = shift;
+  my %args = @_;
+
+  # Options
+  # ----------------------------------------------------------------------------
+  # Compulsory options
+  my $src  = $args{SRC};
+  my $type = $args{TYPE};
+  my $name = $args{NAME};
+
+  # Other options
+  my $rev_flag        = $args{REV_FLAG}        ? $args{REV_FLAG}    : 'NORMAL';
+  my @tickets         = exists $args{TICKET}   ? @{ $args{TICKET} } : ();
+  my $password        = exists $args{PASSWORD} ? $args{PASSWORD}    : undef;
+  my $orev            = exists $args{REV}      ? $args{REV}         : 'HEAD';
+
+  my $non_interactive     = exists $args{NON_INTERACTIVE}
+                            ? $args{NON_INTERACTIVE} : 0;
+  my $svn_non_interactive = exists $args{SVN_NON_INTERACTIVE}
+                            ? $args{SVN_NON_INTERACTIVE} : 0;
+  $svn_non_interactive    = $non_interactive ? 1 : $svn_non_interactive;
+
+  # Analyse the source URL
+  # ----------------------------------------------------------------------------
+  # Create branch from the trunk by default
+  $src->branch ('trunk') if not $src->branch;
+
+  # Remove "sub-directory" part from source URL
+  $src->subdir ('')      if $src->subdir;
+
+  # Remove "peg revision" part because it does not work with "svn copy"
+  $src->pegrev ('')      if $src->pegrev;
+
+  # Find out the URL and the last changed revision of the specified URL at the
+  # specified operative revision
+  my $url = $src->svninfo (FLAG => 'URL', REV => $orev);
+  e_report $src->url, ': cannot determine the operative URL at revision ',
+           $orev, ', abort.' if not $url;
+
+  $src->url ($url) if $url ne $src->url;
+
+  my $rev = $src->svninfo (FLAG => 'Last Changed Rev', REV => $orev);
+  e_report $src->url, ': cannot determine the last changed rev at revision',
+           $orev, ', abort.' if not $rev;
+
+  # Warn user if last changed revision is not the specified revision
+  w_report 'Warning: branch will be created from revision ', $rev,
+           ', i.e. the last changed rev.'
+    unless $orev and $orev eq $rev;
+
+  # Determine the sub-directory names of the branch
+  # ----------------------------------------------------------------------------
+  my @branch_dirs = ('branches');
+
+  # Split branch type flags into a hash table
+  my %type_flags = ();
+  $type_flags{$_} = 1 for ((split /::/, $type));
+
+  # Branch sub-directory 1, development, test or package
+  for my $flag (qw/DEV TEST PKG/) {
+    if (exists $type_flags{$flag}) {
+      push @branch_dirs, lc ($flag);
+      last;
+    }
+  }
+
+  # Branch sub-directory 2, user, share, configuration or release
+  if (exists $type_flags{USER}) {
+    my $userid = getlogin;
+    $userid    = $ENV{LOGNAME} unless $userid;
+    $userid    = $ENV{USER}    unless $userid;
+    die 'Unable to determine your user ID, abort' unless $userid;
+
+    push @branch_dirs, $userid;
+
+  } else {
+    for my $flag (qw/SHARE CONFIG REL/) {
+      if (exists $type_flags{$flag}) {
+        push @branch_dirs, uc (substr $flag, 0, 1) . lc (substr $flag, 1);
+        last;
+      }
+    }
+  }
+
+  # Branch sub-directory 3, branch name
+  # Prefix branch name with revision number/keyword if necessary
+  my $prefix = '';
+  if ($rev_flag ne 'NONE') {
+    $prefix = $rev;
+
+    # Attempt to replace revision number with a revision keyword if necessary
+    $prefix = &get_rev_keyword (
+      REV => $rev,
+      URL => $src->url_peg,
+    ) if $rev_flag eq 'NORMAL';
+
+    # $prefix is still a revision number, add "r" in front of it
+    $prefix = 'r' . $prefix if $prefix eq $rev;
+
+    # Add an underscore before the branch name
+    $prefix.= '_';
+  }
+
+  # Branch name
+  push @branch_dirs, $prefix . $name;
+
+  # Check whether the branch already exists, fail if so
+  # ----------------------------------------------------------------------------
+  # Construct the URL of the branch
+  $self->project_url ($src->project_url);
+  $self->branch  (join ('/', @branch_dirs));
+
+  # Check that branch does not already exists
+  e_report $self->url, ': branch already exists, abort.' if $self->url_exists;
+
+  # Message for the commit log
+  # ----------------------------------------------------------------------------
+  my @message = ('Created ' . $self->branch_path .  ' from ' .
+                 $src->branch_path . '@' . $rev . '.' . "\n");
+
+  # Add related Trac ticket links to commit log if set
+  if (@tickets) {
+    my $ticket_mesg = 'Relates to ticket' . (@tickets > 1 ? 's' : '');
+
+    while (my $ticket = shift @tickets) {
+      $ticket_mesg .= ' #' . $ticket;
+      $ticket_mesg .= (@tickets > 1 ? ',' : ' and') if @tickets >= 1;
+    }
+
+    push @message, $ticket_mesg . ".\n";
+  }
+
+  # Create a temporary file for the commit log message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->auto_mesg (@message);
+  $ci_mesg->ignore_mesg ('A' . ' ' x 4 . $self->url . "\n");
+  my $logfile = $ci_mesg->edit_file (TEMP => 1, BATCH => $non_interactive);
+
+  # Check with the user to see if he/she wants to go ahead
+  # ----------------------------------------------------------------------------
+  if (not $non_interactive) {
+    my $reply = &main::get_input (
+      TITLE   => 'fcm branch',
+      MESSAGE => 'Would you like to go ahead and create this branch?',
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+
+    return unless $reply eq 'y';
+  }
+
+  # Ensure existence of container sub-directories of the branch
+  # ----------------------------------------------------------------------------
+  for my $i (0 .. $#branch_dirs - 1) {
+    my $subdir     = join ('/', @branch_dirs[0 .. $i]);
+    my $subdir_url = Fcm::CmUrl->new (URL => $src->project_url . '/' . $subdir);
+
+    # Check whether each sub-directory of the branch already exists,
+    # if sub-directory does not exist, create it
+    next if $subdir_url->url_exists;
+
+    print 'Creating sub-directory: ', $subdir, "\n";
+
+    my @command = (
+      qw/svn mkdir/,
+      '-m', 'Created ' . $subdir . ' directory.',
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+
+      $subdir_url->url,
+    );
+    &run_command (\@command);
+  }
+
+  # Create the branch
+  # ----------------------------------------------------------------------------
+  {
+    print 'Creating branch ', $self->url, ' ...', "\n";
+    my @command = (
+      qw/svn copy/,
+      '-r', $rev,
+      '-F', $logfile,
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+
+      $src->url, $self->url,
+    );
+    &run_command (\@command);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->delete (
+#     [NON_INTERACTIVE     => 1,]
+#     [PASSWORD            => $password,]
+#     [SVN_NON_INTERACTIVE => 1,]
+#   );
+#
+# DESCRIPTION
+#   This method deletes the current branch from the Subversion repository.
+#
+# OPTIONS
+#   NON_INTERACTIVE     - Do no interactive prompting, set SVN_NON_INTERACTIVE
+#                         to true automatically.
+#   PASSWORD            - specify the password for commit access.
+#   SVN_NON_INTERACTIVE - Do no interactive prompting when running svn commit,
+#                         etc. This option is implied by NON_INTERACTIVE.
+# ------------------------------------------------------------------------------
+
+sub del {
+  my $self = shift;
+  my %args = @_;
+
+  # Options
+  # ----------------------------------------------------------------------------
+  my $password            = exists $args{PASSWORD} ? $args{PASSWORD} : undef;
+  my $non_interactive     = exists $args{NON_INTERACTIVE}
+                            ? $args{NON_INTERACTIVE} : 0;
+  my $svn_non_interactive = exists $args{SVN_NON_INTERACTIVE}
+                            ? $args{SVN_NON_INTERACTIVE} : 0;
+  $svn_non_interactive    = $non_interactive ? 1 : $svn_non_interactive;
+
+  # Ensure URL is a branch
+  # ----------------------------------------------------------------------------
+  e_report $self->url_peg, ': not a branch, abort.' if not $self->is_branch;
+
+  # Message for the commit log
+  # ----------------------------------------------------------------------------
+  my @message = ('Deleted ' . $self->branch_path . '.' . "\n");
+
+  # Create a temporary file for the commit log message
+  my $ci_mesg = Fcm::CmCommitMessage->new ();
+  $ci_mesg->auto_mesg (@message);
+  $ci_mesg->ignore_mesg ('D' . ' ' x 4 . $self->url . "\n");
+  my $logfile = $ci_mesg->edit_file (TEMP => 1, BATCH => $non_interactive);
+
+  # Check with the user to see if he/she wants to go ahead
+  # ----------------------------------------------------------------------------
+  if (not $non_interactive) {
+    my $reply = &main::get_input (
+      TITLE   => 'fcm branch',
+      MESSAGE => 'Would you like to go ahead and delete this branch?',
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+
+    return unless $reply eq 'y';
+  }
+
+  # Delete branch if answer is "y" for "yes"
+  # ----------------------------------------------------------------------------
+  print 'Deleting branch ', $self->url, ' ...', "\n";
+  my @command = (
+    qw/svn delete/,
+    '-F', $logfile,
+    (defined $password    ? ('--password', $password) : ()),
+    ($svn_non_interactive ? '--non-interactive'       : ()),
+
+    $self->url,
+  );
+  &run_command (\@command);
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->display_info (
+#     [SHOW_CHILDREN => 1],
+#     [SHOW_OTHER    => 1]
+#     [SHOW_SIBLINGS => 1]
+#   );
+#
+# DESCRIPTION
+#   This method displays information of the current branch. If SHOW_CHILDREN is
+#   set, it shows information of all current children branches of the current
+#   branch. If SHOW_SIBLINGS is set, it shows information of siblings that have
+#   been merged recently with the current branch. If SHOW_OTHER is set, it shows
+#   information of custom/reverse merges.
+# ------------------------------------------------------------------------------
+
+sub display_info {
+  my $self = shift;
+  my %args = @_;
+
+  # Arguments
+  # ----------------------------------------------------------------------------
+  my $show_children = exists $args{SHOW_CHILDREN} ? $args{SHOW_CHILDREN} : 0;
+  my $show_other    = exists $args{SHOW_OTHER   } ? $args{SHOW_OTHER}    : 0;
+  my $show_siblings = exists $args{SHOW_SIBLINGS} ? $args{SHOW_SIBLINGS} : 0;
+
+  # Useful variables
+  # ----------------------------------------------------------------------------
+  my $separator  = '-' x 80 . "\n";
+  my $separator2 = '  ' . '-' x 78 . "\n";
+
+  # Print "info" as returned by "svn info"
+  # ----------------------------------------------------------------------------
+  for my $key ('URL', 'Repository Root', 'Revision', 'Last Changed Author',
+               'Last Changed Rev', 'Last Changed Date') {
+    print $key, ': ', $self->svninfo (FLAG => $key), "\n"
+      if $self->svninfo (FLAG => $key);
+  }
+
+  if ($self->config->verbose) {
+    # Verbose mode, print log message at last changed revision
+    my %log = $self->svnlog (REV => $self->svninfo (FLAG => 'Last Changed Rev'));
+    my @log = split /\n/, $log{msg};
+    print 'Last Changed Log:', "\n\n", map ({'  ' . $_ . "\n"} @log), "\n";
+  }
+
+  if ($self->is_branch) {
+    # Print create information
+    # --------------------------------------------------------------------------
+    my %log = $self->svnlog (REV => $self->create_rev);
+
+    print $separator;
+    print 'Branch Create Author: ', $log{author}, "\n" if $log{author};
+    print 'Branch Create Rev: ', $self->create_rev, "\n";
+    print 'Branch Create Date: ', &svn_date ($log{date}), "\n";
+
+    if ($self->config->verbose) {
+      # Verbose mode, print log message at last create revision
+      my @log = split /\n/, $log{msg};
+      print 'Branch Create Log:', "\n\n", map ({'  ' . $_ . "\n"} @log), "\n";
+    }
+
+    # Print delete information if branch no longer exists
+    # --------------------------------------------------------------------------
+    print 'Branch Delete Rev: ', $self->delete_rev, "\n" if $self->delete_rev;
+
+    # Report merges into/from the parent
+    # --------------------------------------------------------------------------
+    # Print the URL@REV of the parent branch
+    print $separator, 'Branch Parent: ', $self->parent->url_peg, "\n";
+
+    # Set up a new object for the parent at the current revision
+    # --------------------------------------------------------------------------
+    my $p_url  = $self->parent->url;
+    $p_url    .= '@' . $self->pegrev if $self->pegrev;
+    my $parent = Fcm::CmBranch->new (URL => $p_url);
+
+    if (not $parent->url_exists) {
+      print 'Branch parent deleted.', "\n";
+      return;
+    }
+
+    # Report merges into/from the parent
+    # --------------------------------------------------------------------------
+    print $self->_report_merges ($parent, 'Parent');
+  }
+
+  # Report merges with siblings
+  # ----------------------------------------------------------------------------
+  if ($show_siblings) {
+    # Report number of sibling branches found
+    print $separator, 'Seaching for siblings ... ';
+    my @siblings = $self->siblings;
+    print scalar (@siblings), ' ', (@siblings> 1 ? 'siblings' : 'sibling'),
+          ' found.', "\n";
+
+    # Report branch name and merge information only if there are recent merges
+    my $out = '';
+    for my $sibling (@siblings) {
+      my $string = $self->_report_merges ($sibling, 'Sibling');
+
+      $out .= $separator2 . '  ' . $sibling->url . "\n" . $string if $string;
+    }
+
+    if (@siblings) {
+      if ($out) {
+        print 'Merges with existing siblings:', "\n", $out;
+
+      } else {
+        print 'No merges with existing siblings.', "\n";
+      }
+    }
+  }
+
+  # Report children
+  # ----------------------------------------------------------------------------
+  if ($show_children) {
+    # Report number of child branches found
+    print $separator, 'Seaching for children ... ';
+    my @children = $self->children;
+    print scalar (@children), ' ', (@children > 1 ? 'children' : 'child'),
+          ' found.', "\n";
+
+    # Report children if they exist
+    print 'Current children:', "\n" if @children;
+
+    for my $child (@children) {
+      print $separator2, '  ', $child->url, "\n";
+      print '  Child Create Rev: ', $child->create_rev, "\n";
+      print $self->_report_merges ($child, 'Child');
+    }
+  }
+
+  # Report custom/reverse merges into the branch
+  # ----------------------------------------------------------------------------
+  if ($show_other) {
+    my %log = $self->svnlog (STOP_ON_COPY => 1);
+    my @out;
+
+    # Go down the revision log, checking for merge template messages
+    REV: for my $rev (sort {$b <=> $a} keys %log) {
+      # Loop each line of the log message at each revision
+      my @msg = split /\n/, $log{$rev}{msg};
+
+      for (@msg) {
+        # Ignore unless log message matches a merge template
+        if (/^Reversed r\d+(:\d+)? of \S+$/ or
+            s/^(Custom merge) into \S+(:.+)$/$1$2/) {
+          push @out, ('r' . $rev . ': ' . $_) . "\n";
+        }
+      }
+    }
+
+    print $separator, 'Other merges:', "\n", @out if @out;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_report_merges ($branch, $relation);
+#
+# DESCRIPTION
+#   This method returns a string for displaying merge information with a
+#   branch, the $relation of which can be a Parent, a Sibling or a Child.
+# ------------------------------------------------------------------------------
+
+sub _report_merges {
+  my ($self, $branch, $relation) = @_;
+
+  my $indent    = ($relation eq 'Parent') ? '' : '  ';
+  my $separator = ($relation eq 'Parent') ? ('-' x 80) : ('  ' . '-' x 78);
+  $separator   .= "\n";
+
+  my $return = '';
+
+  # Report last merges into/from the $branch
+  # ----------------------------------------------------------------------------
+  my %merge  = (
+    'Last Merge From ' . $relation . ':'
+    => [$self->last_merge_from ($branch, 1)],
+    'Last Merge Into ' . $relation . ':'
+    => [$branch->last_merge_from ($self, 1)],
+  );
+
+  if ($self->config->verbose) {
+    # Verbose mode, print the log of the merge
+    for my $key (keys %merge) {
+      next if not @{ $merge{$key} };
+
+      # From: target (0) is self, upper delta (1) is $branch
+      # Into: target (0) is $branch, upper delta (1) is self
+      my $t = ($key =~ /From/) ? $self : $branch;
+
+      $return .= $indent . $key . "\n";
+      $return .= $separator . $t->display_svnlog ($merge{$key}[0]->pegrev);
+    }
+
+  } else {
+    # Normal mode, print in simplified form (rREV Parent@REV)
+    for my $key (keys %merge) {
+      next if not @{ $merge{$key} };
+
+      # From: target (0) is self, upper delta (1) is $branch
+      # Into: target (0) is $branch, upper delta (1) is self
+      $return .= $indent . $key . ' r' . $merge{$key}[0]->pegrev . ' ' .
+                 $merge{$key}[1]->path_peg . ' cf. ' .
+                 $merge{$key}[2]->path_peg . "\n";
+    }
+  }
+
+  if ($relation eq 'Sibling') {
+    # For sibling, do not report further if there is no recent merge
+    my @values = values %merge;
+
+    return $return unless (@{ $values[0] } or @{ $values[1] });
+  }
+
+  # Report available merges into/from the $branch
+  # ----------------------------------------------------------------------------
+  my %avail = (
+    'Merges Avail From ' . $relation . ':'
+    => ($self->delete_rev ? [] : [$self->avail_merge_from ($branch, 1)]),
+    'Merges Avail Into ' . $relation . ':'
+    => [$branch->avail_merge_from ($self, 1)],
+  );
+
+  if ($self->config->verbose) {
+    # Verbose mode, print the log of each revision
+    for my $key (keys %avail) {
+      next unless @{ $avail{$key} };
+
+      $return .= $indent . $key . "\n";
+
+      my $s = ($key =~ /From/) ? $branch: $self;
+
+      for my $rev (@{ $avail{$key} }) {
+        $return .= $separator . $s->display_svnlog ($rev);
+      }
+    }
+
+  } else {
+    # Normal mode, print only the revisions
+    for my $key (keys %avail) {
+      next unless @{ $avail{$key} };
+
+      $return .= $indent . $key . ' ' . join (' ', @{ $avail{$key} }) . "\n";
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/CmCommitMessage.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/CmCommitMessage.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/CmCommitMessage.pm	(revision 6412)
@@ -0,0 +1,395 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmCommitMessage
+#
+# DESCRIPTION
+#   This class contains methods to read, write and edit the commit message file
+#   in a working copy.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmCommitMessage;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Spec;
+use File::Temp qw/tempfile/;
+
+# FCM component modules
+use Fcm::Util qw/e_report run_command/;
+
+# Commit log delimiter messages
+my $ignore_line = '--This line, and those below, will be ignored--';
+my $auto_line   = '--This line will be ignored and those below will be ' .
+                  'inserted automatically--';
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ci_mesg = Fcm::CmCommitMessage->new (
+#     CONFIG  => $config,
+#     DIR     => $dir,
+#     BASE    => $base,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmCommitMessageFile class.
+#
+# ARGUMENTS
+#   CONFIG - reference to a Fcm::Config instance
+#   DIR    - directory containing the commit message file
+#   BASE   - base name of the commit message file
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG => (exists $args{CONFIG} ? $args{CONFIG} : &main::cfg),
+    DIR    => (exists $args{DIR}    ? $args{DIR}    : cwd),
+    BASE   => (exists $args{BASE}   ? $args{BASE}   : '#commit_message#'),
+    USER_M => [],
+    AUTO_M => [],
+    IGNORE => [],
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $ci_mesg->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $ci_mesg->dir;
+#   $ci_mesg->dir ($dir);
+#
+# DESCRIPTION
+#   This method returns the directory container of the commit message file. If
+#   an argument is specified, the directory is reset using the value of the
+#   argument. (It does nothing is the directory does not already exist.)
+# ------------------------------------------------------------------------------
+
+sub dir {
+  my $self = shift;
+
+  if (@_) {
+    my $dir = shift;
+    $self->{DIR} = $dir if -d $dir;
+  }
+
+  return $self->{DIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $ci_mesg->base;
+#   $ci_mesg->base ($base);
+#
+# DESCRIPTION
+#   This method returns the base name of the commit message file. If an
+#   argument is specified, the file is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub base {
+  my $self = shift;
+
+  if (@_) {
+    $self->{BASE} = shift;
+  }
+
+  return $self->{BASE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $ci_mesg->file;
+#   $ci_mesg->file ($file);
+#
+# DESCRIPTION
+#   This method returns the full name of the commit message file. If an
+#   argument is specified, the file is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub file {
+  my $self = shift;
+
+  if (@_) {
+    my $file      = shift;
+    $self->{DIR}  = dirname  ($file);
+    $self->{BASE} = basename ($file);
+  }
+
+  return File::Spec->catfile ($self->{DIR}, $self->{BASE});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @mesg = $ci_mesg->user_mesg;
+#   $ci_mesg->user_mesg (@mesg);
+#
+# DESCRIPTION
+#   This method returns the user defined commit message. If an argument is
+#   specified, the message is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub user_mesg {
+  my $self = shift;
+
+  if (@_) {
+    @{ $self->{USER_M} } = @_;
+  }
+
+  return @{ $self->{USER_M} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @mesg = $ci_mesg->auto_mesg;
+#   $ci_mesg->auto_mesg (@mesg);
+#
+# DESCRIPTION
+#   This method returns the automatically inserted commit message. If an
+#   argument is specified, the message is reset using the value of the
+#   argument.
+# ------------------------------------------------------------------------------
+
+sub auto_mesg {
+  my $self = shift;
+
+  if (@_) {
+    @{ $self->{AUTO_M} } = @_;
+  }
+
+  return @{ $self->{AUTO_M} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @mesg = $ci_mesg->ignore_mesg;
+#   $ci_mesg->ignore_mesg (@mesg);
+#
+# DESCRIPTION
+#   This method returns the ignored part of a commit message. If an argument is
+#   specified, the message is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub ignore_mesg {
+  my $self = shift;
+
+  if (@_) {
+    @{ $self->{IGNORE} } = @_;
+  }
+
+  return @{ $self->{IGNORE} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($user, $auto) = $ci_mesg->read_file ();
+#
+# DESCRIPTION
+#   This function reads from the commit log message file. It resets the user
+#   and the automatic messages after reading the file. It returns the message
+#   back in two array references.
+# ------------------------------------------------------------------------------
+
+sub read_file {
+  my $self = shift;
+
+  my @user = ();
+  my @auto = ();
+  my $file = $self->file;
+
+  if (-r $file) {
+    open FILE, '<', $file or croak 'Cannot open ', $file, '(', $!, '), abort';
+
+    my $in_auto = 0;
+    while (<FILE>) {
+      last if index ($_, $ignore_line) == 0; # ignore after the ignore delimiter
+
+      if (index ($_, $auto_line) == 0) {
+        # Beginning of the automatically inserted message delimiter
+        $in_auto = 1;
+        next;
+      }
+
+      if ($in_auto) {
+        push @auto, $_;
+
+      } else {
+        push @user, $_;
+      }
+    }
+
+    close FILE;
+
+    $self->user_mesg (@user);
+    $self->auto_mesg (@auto);
+  }
+
+  return (\@user, \@auto);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ci_mesg->write_file ();
+#
+# DESCRIPTION
+#   This function writes to the commit log message file based on the content of
+#   the user defined message, and the automatically inserted message.
+# ------------------------------------------------------------------------------
+
+sub write_file {
+  my $self = shift;
+  my %args = @_;
+
+  my @user = $self->user_mesg;
+  my @auto = $self->auto_mesg;
+  my $file = $self->file;
+
+  open FILE, '>', $file or die 'Cannot open ', $file, '(', $!, '), abort';
+  print FILE @user;
+  print FILE $auto_line, "\n", @auto if @auto;
+  close FILE or croak 'Cannot close ', $file, '(', $!, '), abort';
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $ci_mesg->edit_file ([TEMP => 1,] [BATCH => 1,]);
+#
+# DESCRIPTION
+#   This function normally triggers an editor for editing the commit message.
+#   If TEMP is set, it edits a temporary file. Otherwise, it edits the current
+#   commit message file. It resets the user defined message on success. Returns
+#   the name of the commit log file. Do not start the editor if BATCH is set.
+# ------------------------------------------------------------------------------
+
+sub edit_file {
+  my $self  = shift;
+  my %args  = @_;
+  my $temp  = exists $args{TEMP}  ? $args{TEMP}  : 0;
+  my $batch = exists $args{BATCH} ? $args{BATCH} : 0;
+
+  my @user   = $self->user_mesg;
+  my @auto   = $self->auto_mesg;
+  my @ignore = $self->ignore_mesg;
+  my $file   = $self->file;
+
+  if ($temp) {
+    my $fh;
+    ($fh, $file) = tempfile (SUFFIX => ".fcm", UNLINK => 1);
+    close $fh;
+  }
+
+  # Add original or code driven message and status information to the file
+  my $select = select;
+  open FILE, '>', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  select FILE;
+
+  print @user;
+  print (@auto || @user ? '' : "\n");
+  print $auto_line, "\n", @auto, "\n" if @auto;
+  print $ignore_line, "\n\n";
+  print @ignore if @ignore;
+
+  close FILE or die 'Cannot close ', $file, ' (', $!, '), abort';
+  select $select;
+
+  if (not $batch) {
+    # Select editor
+    my $editor = 'nedit';
+    
+    if ($ENV{'SVN_EDITOR'}) {
+      $editor = $ENV{'SVN_EDITOR'};
+
+    } elsif ($ENV{'VISUAL'}) {
+      $editor = $ENV{'VISUAL'};
+
+    } elsif ($ENV{'EDITOR'}) {
+      $editor = $ENV{'EDITOR'};
+    }
+
+    # Execute command to start the editor
+    print 'Starting ', $editor, ' to edit commit message ...', "\n";
+    &run_command ([split (/\s+/, $editor), $file]);
+  }
+
+  # Read the edited file, and extract user log message from it
+  open FILE, '<', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  my (@log);
+  my $in_auto    = 0;
+  my $in_ignored = 0;
+
+  while (<FILE>) {
+    if (index ($_, $auto_line) == 0) {
+      $in_auto = 1;
+
+    } elsif (index ($_, $ignore_line) == 0) {
+      $in_ignored = 1;
+      last;
+
+    } else {
+      next if $in_auto;
+      push @log, $_;
+    }
+  }
+
+  close FILE;
+
+  # Ensure auto and ignored lines are not altered
+  e_report 'Error: the line "', $auto_line, '" has been altered, abort.'
+    if @auto and not $in_auto;
+
+  e_report 'Error: the line "', $ignore_line, '" has been altered, abort.'
+    if not $in_ignored;
+
+  # Check for empty commit log
+  e_report 'Error: log message unchanged or not specified, abort.'
+    if join (' ', (@log, @auto)) =~ /^\s*$/;
+
+  # Echo the commit message to standard output
+  my $separator = '-' x 80 . "\n";
+  print 'Commit message is as follows:', "\n";
+  print $separator, @log, @auto, $ignore_line, "\n", @ignore, $separator;
+
+  open FILE, '>', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  print FILE @log, @auto;
+  close FILE or croak 'Cannot close ', $file, ' (', $!, '), abort';
+
+  # Reset the array for the user specified log message
+  $self->user_mesg (@log);
+
+  return $file;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/CmUrl.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/CmUrl.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/CmUrl.pm	(revision 6412)
@@ -0,0 +1,1138 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmUrl
+#
+# DESCRIPTION
+#   This class contains methods for manipulating a Subversion URL in a standard
+#   FCM project.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmUrl;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+use HTTP::Date;
+use XML::DOM;
+
+# FCM component modules
+use Fcm::Util qw/run_command svn_date get_browser_url/;
+
+# Revision pattern
+my $rev_pattern = '\d+|HEAD|BASE|COMMITTED|PREV|\{.+\}';
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_url = Fcm::CmUrl->new (
+#     CONFIG  => $config,
+#     URL     => $url,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmUrl class.
+#
+# ARGUMENTS
+#   CONFIG - reference to a Fcm::Config instance
+#   URL    - URL of a branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG      => (exists $args{CONFIG} ? $args{CONFIG} : &main::cfg),
+    URL         => (exists $args{URL}    ? $args{URL}    : ''),
+    ANALYSED    => undef,
+    PROJECT     => undef,
+    BRANCH      => undef,
+    SUBDIR      => undef,
+    PEGREV      => undef,
+    LIST        => undef,
+    RLIST       => undef,
+    LOG         => undef,
+    LOG_RANGE   => undef,
+    INFO        => undef,
+    BRANCH_LIST => undef, # list of branches in current project
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $cm_url->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->url_peg;
+#   $cm_url->url_peg ($url);
+#
+# DESCRIPTION
+#   This method returns/sets the current URL@PEG.
+# ------------------------------------------------------------------------------
+
+sub url_peg {
+  my $self = shift;
+
+  if (@_) {
+    if (! $self->{URL} or $_[0] ne $self->{URL}) {
+      # Re-set URL
+      $self->{URL} = shift;
+
+      # Re-set essential variables
+      $self->{$_}  = undef for (qw/ANALYSED RLIST LIST INFO LOG LOG_RANGE/);
+    }
+  }
+
+  return $self->{URL};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_url ();
+#
+# DESCRIPTION
+#   Returns true if current url is a valid Subversion URL.
+# ------------------------------------------------------------------------------
+
+sub is_url {
+  my $self = shift;
+
+  # This should handle URL beginning with svn://, http:// and svn+ssh://
+  return ($self->url_peg =~ m#^[\+\w]+://#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->url_exists ([$rev]);
+#
+# DESCRIPTION
+#   Returns true if current url exists (at operative revision $rev) in a
+#   Subversion repository.
+# ------------------------------------------------------------------------------
+
+sub url_exists {
+  my ($self, $rev) = @_;
+
+  my $exists = $self->svnlist (REV => $rev);
+
+  return defined ($exists);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $cm_url->svninfo ([FLAG => $flag], [REV => $rev]);
+#
+# DESCRIPTION
+#   Returns the value of $flag, where $flag is a field returned by "svn info".
+#   (If $flag is not set, default to "URL".) Otherwise returns an empty string.
+#   If REV is specified, it will be used as the operative revision.
+# ------------------------------------------------------------------------------
+
+sub svninfo {
+  my $self = shift;
+  my %args = @_;
+
+  my $flag = exists $args{FLAG} ? $args{FLAG} : 'URL';
+  my $rev  = exists $args{REV}  ? $args{REV}  : undef;
+
+  $rev = ($self->pegrev ? $self->pegrev : 'HEAD') if not $rev;
+
+  return if not $self->is_url;
+
+  # Get "info" for the specified revision if necessary
+  if (not exists $self->{INFO}{$rev}) {
+    # Invoke "svn info" command
+    my @info = &run_command (
+      [qw/svn info -r/, $rev, $self->url_peg],
+      PRINT   => $self->config->verbose > 2,
+      METHOD  => 'qx',
+      DEVNULL => 1,
+      ERROR   => 'ignore',
+    );
+
+    # Store selected information
+    for (@info) {
+      chomp;
+
+      if (/^(.+?):\s*(.+)$/) {
+        $self->{INFO}{$rev}{$1} = $2;
+      }
+    }
+  }
+
+  my $return = exists $self->{INFO}{$rev}{$flag}
+               ? $self->{INFO}{$rev}{$flag} : undef;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %logs = $cm_url->svnlog (
+#     [REV          => $rev,]
+#     [REV          => \@revs,] # reference to a 2-element array
+#     [STOP_ON_COPY => 1,]
+#   );
+#
+# DESCRIPTION
+#   Returns the logs for the current URL. If REV is a range of revisions or not
+#   specified, return a hash where the keys are revision numbers and the values
+#   are the entries (which are hash references). If a single REV is specified,
+#   return the entry (a hash reference) at the specified REV. Each entry in the
+#   returned list is a hash reference, with the following structure:
+#
+#   $entry = {
+#     author => $author,              # the commit author
+#     date   => $date,                # the commit date (in seconds since epoch)
+#     msg    => $msg,                 # the log message
+#     paths  => {                     # list of changed paths
+#       $path1  => {                  # a changed path
+#         copyfrom-path => $frompath, # copy-from-path
+#         copyfrom-rev  => $fromrev,  # copy-from-revision
+#         action        => $action,   # action status code
+#       },
+#       ...     => { ... },           # ... more changed paths ...
+#     },
+#   }
+# ------------------------------------------------------------------------------
+
+sub svnlog {
+  my $self = shift;
+  my %args = @_;
+
+  my $stop_on_copy  = exists $args{STOP_ON_COPY} ? $args{STOP_ON_COPY} : 0;
+  my $rev_arg       = exists $args{REV}          ? $args{REV}          : 0;
+
+  my @revs;
+
+  # Get revision options
+  # ----------------------------------------------------------------------------
+  if ($rev_arg) {
+    if (ref ($rev_arg)) {
+      # Revsion option is an array, a range of revisions specified?
+      ($revs [0], $revs [1]) = @$rev_arg;
+
+    } else {
+      # A single revision specified
+      $revs [0] = $rev_arg;
+    }
+
+    # Expand 'HEAD' revision
+    for my $rev (@revs) {
+      next unless uc ($rev) eq 'HEAD';
+      $rev = $self->svninfo (FLAG => 'Revision', REV => 'HEAD');
+    }
+
+  } else {
+    # No revision option specified, get log for all revisions
+    $revs [0] = $self->svninfo (FLAG => 'Revision');
+    $revs [1] = 1;
+  }
+
+  $revs [1] = $revs [0] if not $revs [1];
+  @revs     = sort {$b <=> $a} @revs;
+
+  # Check whether a "svn log" run is necessary
+  # ----------------------------------------------------------------------------
+  my $need_update = ! ($revs [0] == $revs [1] and exists $self->{LOG}{$revs [0]});
+  my @ranges      = @revs;
+  if ($need_update and $self->{LOG_RANGE}) {
+    my %log_range = %{ $self->{LOG_RANGE} };
+
+    if ($stop_on_copy) {
+      $ranges [1] = $log_range{UPPER} if $ranges [1] >= $log_range{LOWER_SOC};
+
+    } else {
+      $ranges [1] = $log_range{UPPER} if $ranges [1] >= $log_range{LOWER};
+    }
+  }
+
+  $need_update = 0 if $ranges [0] < $ranges [1];
+
+  if ($need_update) {
+    # Invoke "svn log" command for all revisions of the current branch
+    # --------------------------------------------------------------------------
+    my @command = (
+      qw/svn log --xml -v/, ($stop_on_copy ? '--stop-on-copy' : ()),
+      '-r' . join (':', @ranges),
+      $self->url,
+    );
+
+    my $rc;
+    my @xml = &run_command (
+      \@command,
+      PRINT   => $self->config->verbose > 2,
+      METHOD  => 'qx',
+      DEVNULL => 1,
+      ERROR   => 'ignore',
+      RC      => \$rc,
+    );
+
+    # Parse the XML
+    # --------------------------------------------------------------------------
+    if (not $rc) {
+      my $parser = XML::DOM::Parser->new;
+      my $doc    = $parser->parse (join ('', @xml));
+
+      my $entry_list = $doc->getElementsByTagName ('logentry');
+
+      # Record the author, date, message and path change for each revision
+      for my $i (0 .. $entry_list->getLength - 1) {
+        # Select current entry from node list
+        my $entry = $entry_list->item ($i);
+        my %this = ();
+
+        # Revision is an attribute of the entry node
+        my $rev   = $entry->getAttributeNode ('revision')->getValue;
+
+        # Author, date and log message are children elements of the entry node
+        for my $key (qw/author date msg/) {
+          # Get data of each node, also convert date to seconds since epoch
+          my $node    = $entry->getElementsByTagName ($key)->item (0);
+          my $data    = ($node and $node->getFirstChild)
+                        ? $node->getFirstChild->getData : '';
+          $this{$key} = ($key eq 'date' ? str2time ($data) : $data);
+        }
+
+        # Path nodes are grand children elements of the entry node
+        my $paths = $entry->getElementsByTagName ('path');
+
+        for my $p (0 .. $paths->getLength - 1) {
+          # Select current path node from node list
+          my $node = $paths->item ($p);
+
+          # Get data from the path node
+          my $path = $node->getFirstChild->getData;
+          $this{paths}{$path} = {};
+
+          # Action, copyfrom-path and copyfrom-rev are attributes of path nodes
+          for my $key (qw/action copyfrom-path copyfrom-rev/) {
+            next unless $node->getAttributeNode ($key); # ensure attribute exists
+
+            $this{paths}{$path}{$key} = $node->getAttributeNode ($key)->getValue;
+          }
+        }
+
+        $self->{LOG}{$rev} = \%this;
+      }
+    }
+
+    # Update the range cache
+    # --------------------------------------------------------------------------
+    # Upper end of the range
+    $self->{LOG_RANGE}{UPPER} = $ranges [0]
+      if ! $self->{LOG_RANGE}{UPPER} or $ranges [0] > $self->{LOG_RANGE}{UPPER};
+
+    # Lower end of the range, need to take into account the stop-on-copy option
+    if ($stop_on_copy) {
+      # Lower end of the range with stop-on-copy option
+      $self->{LOG_RANGE}{LOWER_SOC} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER_SOC} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER_SOC};
+
+      my $low = (sort {$a <=> $b} keys %{ $self->{LOG} }) [0];
+      $self->{LOG_RANGE}{LOWER} = $low
+        if ! $self->{LOG_RANGE}{LOWER} or $low < $self->{LOG_RANGE}{LOWER};
+
+    } else {
+      # Lower end of the range without the stop-on-copy option
+      $self->{LOG_RANGE}{LOWER} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER};
+
+      $self->{LOG_RANGE}{LOWER_SOC} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER_SOC} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER_SOC};
+    }
+  }
+
+  my %return = ();
+
+  if (! $rev_arg or ref ($rev_arg)) {
+    # REV is an array, return log entries if they are within range
+    for my $rev (sort {$b <=> $a} keys %{ $self->{LOG} }) {
+      next if $rev > $revs [0] or $revs [1] > $rev;
+
+      $return{$rev} = $self->{LOG}{$rev};
+
+      if ($stop_on_copy) {
+        last if exists $self->{LOG}{$rev}{paths}{$self->branch_path} and
+           $self->{LOG}{$rev}{paths}{$self->branch_path}{action} eq 'A';
+      }
+    }
+
+  } else {
+    # REV is a scalar, return log of the specified revision if it exists
+    %return = %{ $self->{LOG}{$revs [0]} } if exists $self->{LOG}{$revs [0]};
+  }
+
+  return %return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $cm_branch->display_svnlog ($rev, [$wiki]);
+#
+# DESCRIPTION
+#   This method returns a string for displaying the log of the current branch
+#   at a $rev. If $wiki is set, returns a string for displaying in a Trac wiki
+#   table.  The value of $wiki should be the Subversion URL of a FCM project
+#   associated with the intended Trac system.
+# ------------------------------------------------------------------------------
+
+sub display_svnlog {
+  my ($self, $rev, $wiki) = @_;
+  my $return = '';
+
+  my %log = $self->svnlog (REV => $rev);
+
+  if ($wiki) {
+    # Output in Trac wiki format
+    # --------------------------------------------------------------------------
+    $return .= '|| ' . &svn_date ($log{date}) . ' || ' . $log{author} . ' || ';
+
+    my $trac_url = &get_browser_url (URL => $self->url);
+
+    # Get list of tickets from log
+    my @tickets;
+    while ($log{msg} =~ /(?:#|ticket:)(\d+)/g) {
+      push @tickets, $1;
+    }
+    @tickets = sort {$a <=> $b} @tickets;
+
+    if ($trac_url =~ m#^$wiki(?:/*|$)#) {
+      # URL is in the specified $wiki, use Trac link
+      $return .= '[' . $rev . '] ||';
+
+      for my $ticket (@tickets) {
+        $return .= ' #' . $ticket;
+      }
+
+      $return .= ' ||';
+
+    } else {
+      # URL is not in the specified $wiki, use full URL
+      my $rev_url = $trac_url;
+      $rev_url    =~ s#/browser/.*$##;
+      $rev_url   .= '/changeset/' . $rev;
+      $return    .= '[' . $rev_url . ' ' . $rev . '] ||';
+
+      my $ticket_url = $trac_url;
+      $ticket_url    =~ s#/browser/.*$#/ticket/#;
+
+      for my $ticket (@tickets) {
+        $return .= ' [' . $ticket_url . $ticket . ' ' . $ticket . ']';
+      }
+
+      $return .= ' ||';
+    }
+
+  } else {
+    # Output in plain text format
+    # --------------------------------------------------------------------------
+    my @msg  = split /\n/, $log{msg};
+    my $line = (@msg > 1 ? ' lines' : ' line');
+
+    $return .= join (
+      ' | ',
+      ('r' . $rev, $log{author}, &svn_date ($log{date}), scalar (@msg) . $line),
+    );
+    $return .= "\n\n";
+    $return .= $log{msg};
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @list = $cm_url->svnlist ([REV => $rev], [RECURSIVE => 1]);
+#
+# DESCRIPTION
+#   The method returns a list of paths as returned by "svn list". If RECURSIVE
+#   is set, "svn list" is invoked with the "-R" option.
+# ------------------------------------------------------------------------------
+
+sub svnlist {
+  my $self = shift;
+  my %args = @_;
+
+  my $recursive = exists $args{RECURSIVE} ? $args{RECURSIVE} : 0;
+  my $rev       = exists $args{REV}       ? $args{REV}       : undef;
+  my $key       = $recursive ? 'RLIST' : 'LIST';
+
+  # Find out last changed revision of the current URL
+  $rev = $self->svninfo (FLAG => 'Last Changed Rev', REV => $rev);
+  return () if not $rev;
+
+  # Get directory listing for the current URL at the last changed revision
+  if (not exists $self->{$key}{$rev}) {
+    my $rc;
+
+    my @list = map {chomp; $_} &run_command (
+      [qw/svn list -r/, $rev, ($recursive ? '-R' : ()), $self->url_peg],
+      METHOD => 'qx', ERROR => 'ignore', DEVNULL => 1, RC => \$rc,
+    );
+
+    $self->{$key}{$rev} = $rc ? undef : \@list;
+  }
+
+  return (defined ($self->{$key}{$rev}) ? @{ $self->{$key}{$rev} } : undef);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @list = $cm_url->branch_list ($rev);
+#
+# DESCRIPTION
+#   The method returns a list of branches in the current project, assuming the
+#   FCM naming convention. If $rev if specified, it returns the list of
+#   branches at $rev.
+# ------------------------------------------------------------------------------
+
+sub branch_list {
+  my ($self, $rev) = @_;
+
+  # Current URL must be a valid FCM project
+  return if not $self->project;
+
+  # Find out last changed revision of the current URL
+  $rev = $self->svninfo (FLAG => 'Revision', REV => $rev);
+  return () if not $rev;
+
+  if (not exists $self->{BRANCH_LIST}{$rev}) {
+    $self->{BRANCH_LIST}{$rev} = [];
+
+    # Get URL of the project "branches/" sub-directory
+    my $url = Fcm::CmUrl->new (URL => $self->project_url . '/branches');
+
+    # List three levels underneath "branches/"
+    # First level, i.e. dev, test, pkg, etc
+    my @list1 = map {$url->url . '/' . $_} $url->svnlist (REV => $rev);
+    @list1    = grep m#/$#, @list1;
+
+    # Second level, i.e. user name, Shared, Rel or Config
+    my @list2;
+    for (@list1) {
+      my $u    = Fcm::CmUrl->new (URL => $_);
+      my @list = $u->svnlist (REV => $rev);
+
+      push @list2, map {$u->url . $_} @list;
+    }
+
+    # Third level, branch name
+    for (@list2) {
+      my $u    = Fcm::CmUrl->new (URL => $_);
+      my @list = map {s#/*$##; $_} $u->svnlist (REV => $rev);
+
+      push @{ $self->{BRANCH_LIST}{$rev} }, map {$u->url . $_} @list;
+    }
+  }
+
+  return @{ $self->{BRANCH_LIST}{$rev} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_analyse_url ();
+#
+# DESCRIPTION
+#   The method analyses the current URL, breaking it up into the project
+#   (substring of URL up to the slash before "trunk", "branches" or "tags"),
+#   branch name ("trunk", "branches/<type>/<id>/<name>" or "tags/<name>") and
+#   the sub-directory below the top of the project sub-tree. It re-sets the
+#   corresponding interal variables.
+# ------------------------------------------------------------------------------
+
+sub _analyse_url {
+  my $self = shift;
+  my ($url, $project, $branch, $subdir, $pegrev);
+
+  # Check that URL is set
+  $url    = $self->url_peg;
+  return if not $url;
+  return if not $self->is_url;
+
+  # Extract from URL the peg revision
+  $pegrev = $1 if $url =~ s/@($rev_pattern)$//i;
+
+  if ($url =~ m#^(.*?)/+(trunk|branches|tags)(?:/+(.*))?/*$#) {
+    # URL is under the "trunk", a branch or a tag
+    $project                 = $1;
+    my ($branch_id, $remain) = ($2, $3);
+
+    $remain = '' if not defined $remain;
+
+    if ($branch_id eq 'trunk') {
+      # URL under the "trunk"
+      $branch = 'trunk';
+
+    } else {
+      # URL under a branch or a tag
+      $branch = $branch_id;
+
+      # Assume "3 sub-directories", FCM branch naming convention
+      for (1 .. 3) {
+        if ($remain =~ s#^([^/]+)(?:/+|$)##) {
+          $branch .=  '/' . $1;
+
+        } else {
+          $branch = undef;
+          last;
+        }
+      }
+    }
+
+    $subdir = $remain ? $remain : '' if $branch;
+
+  } else {
+    # URL is at some level above the "trunk", a branch or a tag
+    # Use "svn ls" to determine whether it is a project URL
+    my @list = $self->svnlist (REV => ($pegrev ? $pegrev : 'HEAD'));
+    my %lines = map {chomp $_; ($_, 1)} @list;
+
+    # A project URL should have the "trunk", "branches" and "tags" directories
+    ($project = $url) =~ s#/*$##
+      if $lines{'trunk/'} and $lines{'branches/'} and $lines{'tags/'};
+  }
+
+  $self->{PROJECT}  = $project;
+  $self->{BRANCH}   = $branch;
+  $self->{SUBDIR}   = $subdir;
+  $self->{PEGREV}   = $pegrev;
+  $self->{ANALYSED} = 1;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->root ();
+#
+# DESCRIPTION
+#   The method returns the repository root of the current URL.
+# ------------------------------------------------------------------------------
+
+sub root {
+  my $self = shift;
+
+  return $self->svninfo (FLAG => 'Repository Root');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->project_url_peg ();
+#   $cm_url->project_url_peg ($url);
+#
+# DESCRIPTION
+#   The method returns the URL@PEG of the "project" part of the current URL. If
+#   an argument is specified, the URL of the "project" part and the peg
+#   revision of the current URL are re-set.
+# ------------------------------------------------------------------------------
+
+sub project_url_peg {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project_url_peg or $url ne $self->project_url_peg) {
+      my $pegrev = ($url =~ s/@($rev_pattern)$//i) ? $1 : '';
+
+      $url .= '/' . $self->branch if $self->branch;
+      $url .= '/' . $self->subdir if $self->subdir;
+      $url .= '@' . $pegrev       if $pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PROJECT} . ($self->pegrev ? '@' . $self->pegrev : '');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->project_url ();
+#   $cm_url->project_url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL of the "project" part of the current URL. If an
+#   argument is specified, the URL of the "project" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub project_url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->project_url or $url ne $self->project_url) {
+      $url .= '/' . $self->branch if $self->branch;
+      $url .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PROJECT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->project_path ();
+#   $cm_url->project_path ($path);
+#
+# DESCRIPTION
+#   The method returns the path of the "project" part of the current URL. If an
+#   argument is specified, the path of the "project" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub project_path {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project_path or $path ne $self->project_path) {
+      $path .= '/' . $self->branch if $self->branch;
+      $path .= '/' . $self->subdir if $self->subdir;
+
+      $self->path ($path);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->{PROJECT}, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $cm_url->project ();
+#   $cm_url->project ($name);
+#
+# DESCRIPTION
+#   The method returns the basename of the "project" part of the current URL.
+#   If an argument is specified, the basename of the "project" part of the
+#   current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub project {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project or $name ne $self->project) {
+      my $url = '';
+      if ($self->project) {
+        $url =  $self->project;
+        $url =~ s#/[^/]+$##;
+
+      } else {
+        $url =  $self->root;
+      }
+
+      $url .=  '/' . $name;
+      $url .=  '/' . $self->branch if $self->branch;
+      $url .=  '/' . $self->subdir if $self->subdir;
+      $url .=  '@' . $self->pegrev if $self->pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  my $name = $self->{PROJECT};
+  $name =~ s#^.*/([^/]+)$#$1# if $name;
+
+  return $name;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->branch_url_peg ();
+#   $cm_url->branch_url_peg ($url);
+#
+# DESCRIPTION
+#   The method returns the URL@PEG of the "branch" part of the current URL. If
+#   an argument is specified, the URL@PEG of the "branch" part of the current
+#   URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_url_peg {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_url_peg or $url ne $self->branch_url_peg) {
+      my $pegrev = ($url =~ s/@($rev_pattern)$//i) ? $1 : '';
+
+      $url .= '/' . $self->subdir if $self->subdir;
+      $url .= '@' . $pegrev       if $pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->project_url . '/' . $self->branch .
+         ($self->pegrev ? '@' . $self->pegrev : '');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->branch_url ();
+#   $cm_url->branch_url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL of the "branch" part of the current URL. If an
+#   argument is specified, the URL of the "branch" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_url or $url ne $self->branch_url) {
+      $url .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->project_url . '/' . $self->branch;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->branch_path ();
+#   $cm_url->branch_path ($path);
+#
+# DESCRIPTION
+#   The method returns the path of the "branch" part of the current URL. If an
+#   argument is specified, the path of the "branch" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_path {
+  my $self = shift;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_path or $path ne $self->branch_path) {
+      $path .= '/' . $self->subdir if $self->subdir;
+
+      $self->path ($path);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->project_path . '/' . $self->branch;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch = $cm_url->branch ();
+#   $cm_url->branch ($branch);
+#
+# DESCRIPTION
+#   The method returns the "branch" part of the current URL. If an argument is
+#   specified, the "branch" part of the current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub branch {
+  my $self = shift;
+
+  if (@_) {
+    my $branch = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch or $branch ne $self->branch) {
+      my $url = $self->project_url;
+      $url   .= '/' . $branch;
+      $url   .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{BRANCH};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_trunk ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) the trunk.
+# ------------------------------------------------------------------------------
+
+sub is_trunk {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch eq 'trunk');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_branch ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) a branch.
+# ------------------------------------------------------------------------------
+
+sub is_branch {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch =~ m#^branches/#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_tag ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) a tag.
+# ------------------------------------------------------------------------------
+
+sub is_tag {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch =~ m#^tags/#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $subdir = $cm_url->subdir ();
+#   $cm_url->subdir ($subdir);
+#
+# DESCRIPTION
+#   The method returns the "subdir" part of the current URL. If an argument is
+#   specified, the "subdir" part of the current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub subdir {
+  my $self = shift;
+
+  if (@_) {
+    my $subdir = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->subdir or $subdir ne $self->subdir) {
+      my $url = $self->project_url;
+      $url   .= '/' . $self->branch if $self->branch;
+      $url   .= '/' . $subdir if $subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{SUBDIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->url ();
+#   $cm_url->url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL without the "peg revision" part. If an argument
+#   is specified, the URL is re-set without modifying the "peg revision" part.
+# ------------------------------------------------------------------------------
+
+sub url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url    =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL if necessary
+    if (! $self->url or $url ne $self->url) {
+      $self->url_peg ($url . ($self->pegrev ? '@' . $self->pegrev : ''));
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  (my $url = $self->url_peg) =~ s/@($rev_pattern)$//i;
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->path ();
+#   $cm_url->path ($path);
+#
+# DESCRIPTION
+#   The method returns the "path" part of the URL (i.e. URL without the
+#   "root" part). If an argument is specified, the "path" part of the URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub path {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+    $path    =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->path or $path ne $self->path) {
+      my $url = ($root . (substr ($path, 0, 1) eq '/' ? '' : '/') . $path);
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->url, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->path_peg ();
+#   $cm_url->path_peg ($path);
+#
+# DESCRIPTION
+#   The method returns the PATH@PEG part of the URL (i.e. URL without the
+#   "root" part). If an argument is specified, the PATH@PEG part of the URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub path_peg {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->path_peg or $path ne $self->path_peg) {
+      my $url = ($root . (substr ($path, 0, 1) eq '/' ? '' : '/') . $path);
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->url_peg, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_url->pegrev ();
+#   $cm_url->pegrev ($rev);
+#
+# DESCRIPTION
+#   The method returns the "peg revision" part of the current URL. If an
+#   argument is specified, the "peg revision" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub pegrev {
+  my $self = shift;
+
+  if (@_) {
+    my $pegrev = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->pegrev or $pegrev ne $self->pegrev) {
+      $self->url_peg ($self->url . ($pegrev ? '@' . $pegrev : ''));
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PEGREV};
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Config.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Config.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Config.pm	(revision 6412)
@@ -0,0 +1,735 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Config
+#
+# DESCRIPTION
+#   This is a class for reading and processing central and user configuration
+#   settings for FCM.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Config;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use File::Basename;
+use File::Spec::Functions;
+use FindBin;
+use POSIX qw/setlocale LC_ALL/;
+
+# FCM component modules
+use Fcm::CfgFile;
+
+# Other declarations:
+sub _get_hash_value;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = Fcm::Config->new (VERBOSE => $verbose);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Config class.
+#
+# ARGUMENTS
+#   VERBOSE - Set the verbose level of diagnostic output
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  # Ensure that all subsequent Subversion output is in UK English
+  if (setlocale (LC_ALL, 'en_GB')) {
+    $ENV{LANG} = 'en_GB';
+  }
+
+  # Location of the central/user configuration file
+  my $cntl_config = catfile (dirname ($FindBin::Bin), 'etc', 'fcm.cfg');
+  $cntl_config    = catfile $FindBin::Bin, 'fcm.cfg' unless -r $cntl_config;
+  my $user_config = exists $ENV{HOME} ? catfile $ENV{HOME}, '.fcm' : '';
+
+  # Verbose mode
+  my $verbose     = exists $ENV{FCM_VERBOSE} ? $ENV{FCM_VERBOSE} : 1;
+
+  my $self = {
+    CNTL_CONFIG => -r $cntl_config ? $cntl_config : '',
+    USER_CONFIG => -r $user_config ? $user_config : '',
+    VERBOSE     => exists $args{VERBOSE} ? $args{VERBOSE} : $verbose,
+    VARIABLE    => {},
+
+    # Primary settings
+    SETTING => {
+      # Release identifier/version
+      RELEASE  => '1.2',
+
+      # Location of file with the last changed revision of the FCM trunk
+      REV_FILE => catfile (dirname ($FindBin::Bin), 'etc', 'fcm_rev'),
+
+      # Default names of known FCM configuration files
+      CFG_NAME => {
+        BLD        => 'bld.cfg',      # bld cfg
+        EXT        => 'ext.cfg',      # ext cfg
+        SRCPACKAGE => '@PACKAGE.cfg', # source package cfg
+      },
+
+      # Latest version of known FCM configuration files
+      CFG_VERSION => {
+        BLD        => '1.0', # bld cfg
+        EXT        => '1.0', # ext cfg
+        SRCPACKAGE => '1.0', # source package cfg
+      },
+
+      # Labels for all types of FCM configuration files
+      CFG_LABEL => {
+        CFGFILE => {
+          TYPE    => 'CFG::TYPE',       # config file type
+          VERSION => 'CFG::VERSION',    # version of config file syntax
+        },
+
+        # Labels for central/user internal config setting
+        SETTING    => 'SET',
+
+        # Labels for ext and bld cfg
+        USE        => 'USE',            # use (inherit from) another ext/bld
+        SRCDIR     => 'SRC',            # prefix, source directory
+
+        # Labels for bld and pck cfg
+        TARGET     => 'TARGET',         # BLD: targets of current build
+                                        # PCK: target name of source file
+
+        # Labels for bld cfg
+        NAME        => 'NAME',          # build name
+        DIR         => 'DIR',           # prefix, build directory
+        PP          => 'PP',            # prefix, pre-process?
+        LIB         => 'LIB',           # declare name of a library
+        SEARCH_SRC  => 'SEARCH_SRC',    # search src/ sub-directory?
+        EXE_NAME    => 'EXE_NAME',      # rename a main program target
+        TOOL        => 'TOOL',          # prefix, build tool
+        INHERIT     => 'INHERIT',       # prefix, inheritance flag
+        EXCL_DEP    => 'EXCL_DEP',      # exclude these automatic dependencies
+        INFILE_EXT  => 'INFILE_EXT',    # input file name extension and type
+        OUTFILE_EXT => 'OUTFILE_EXT',   # output file type and name extension
+        EXE_DEP     => 'EXE_DEP',       # extra executable dependencies
+        BLOCKDATA   => 'BLOCKDATA',     # BLOCKDATA dependencies
+
+        # Labels for ext cfg
+        DEST       => {                 # local extract destinations
+          ROOTDIR  => 'DEST::ROOTDIR',  # top directory for this extract
+          SRCDIR   => 'DEST::SRCDIR',   # extracted source directory
+          CFGDIR   => 'DEST::CFGDIR',   # generated configuration directory
+          CACHEDIR => 'DEST::CACHEDIR', # cache directory for fast extract
+          BLD_CFG  => 'DEST::BLD_CFG',  # generated bld cfg file
+          EXT_CFG  => 'DEST::EXT_CFG',  # generated ext cfg file
+        },
+        RDEST      => {                 # remote extract destionations
+          MACHINE  => 'RDEST::MACHINE', # name of remote machine
+          LOGNAME  => 'RDEST::LOGNAME', # user logname on remote machine
+          ROOTDIR  => 'RDEST::ROOTDIR', # top directory for this extract
+          SRCDIR   => 'RDEST::SRCDIR',  # extracted source directory
+          CFGDIR   => 'RDEST::CFGDIR',  # generated configuration directory
+          BLD_CFG  => 'RDEST::BLD_CFG', # generated bld cfg file
+          EXT_CFG  => 'RDEST::EXT_CFG', # generated ext cfg file
+        },
+        INC        => 'INC',            # "include" settings in another cfg file
+        BDECLARE   => 'BLD',            # declare entries for build system
+        OVERRIDE   => 'OVERRIDE',       # set conflict override option
+        REPOS      => 'REPOS',          # set repos loc for a project branch
+        VERSION    => 'VERSION',        # set version for a project branch
+        EXPSRCDIR  => 'EXPSRC',         # prefix, expandable source directory
+        MIRROR     => 'MIRROR',         # mirror tool
+
+        # Labels for pck cfg
+        TYPE       => 'TYPE',           # type of source file/build task
+        SCAN       => 'SCAN',           # scan source file for dependency
+        INTNAME    => 'INTNAME',        # internal name of source file
+        DEP        => 'DEP',            # source file/build task dependencies
+      },
+
+      # Keywords in known FCM configuration files
+      CFG_KEYWORD => 'USE,INC,TARGET,EXCL_DEP',
+
+      # Types of "inc" statements expandable CFG files
+      CFG_EXP_INC => 'BLD,EXT,FCM',
+
+      # Standard sub-directories for extract/build
+      DIR => {
+        BIN    => 'bin',    # executable
+        BLD    => 'bld',    # build
+        CACHE  => '.cache', # cache
+        CFG    => 'cfg',    # configuration
+        DONE   => 'done',   # "done"
+        ETC    => 'etc',    # miscellaneous items
+        FLAGS  => 'flags',  # "flags"
+        INC    => 'inc',    # include
+        LIB    => 'lib',    # library
+        OBJ    => 'obj',    # object
+        PPSRC  => 'ppsrc',  # pre-processed source
+        SRC    => 'src',    # source
+        TMP    => 'tmp',    # temporary directory
+      },
+
+      # Build commands and options (i.e. tools)
+      TOOL => {
+        SHELL        => '/usr/bin/ksh',    # Default shell
+
+        CPP          => 'cpp',             # C pre-processor
+        CPPFLAGS     => '-C',              # CPP flags
+        CPP_INCLUDE  => '-I',              # CPP flag, specify "include" path
+        CPP_DEFINE   => '-D',              # CPP flag, define macro
+        CPPKEYS      => '',                # CPP keys (definition macro)
+
+        CC           => 'cc',              # C compiler
+        CFLAGS       => '',                # CC flags
+        CC_COMPILE   => '-c',              # CC flag, compile only
+        CC_OUTPUT    => '-o',              # CC flag, specify output file name
+        CC_INCLUDE   => '-I',              # CC flag, specify "include" path
+        CC_DEFINE    => '-D',              # CC flag, define macro
+
+        FPP          => 'cpp',             # Fortran pre-processor
+        FPPFLAGS     => '-P -traditional', # FPP flags
+        FPP_INCLUDE  => '-I',              # FPP flag, specify "include" path
+        FPP_DEFINE   => '-D',              # FPP flag, define macro
+        FPPKEYS      => '',                # FPP keys (definition macro)
+
+        FC           => 'f90',             # Fortran compiler
+        FFLAGS       => '',                # FC flags
+        FC_COMPILE   => '-c',              # FC flag, compile only
+        FC_OUTPUT    => '-o',              # FC flag, specify output file name
+        FC_INCLUDE   => '-I',              # FC flag, specify "include" path
+        FC_DEFINE    => '-D',              # FC flag, define macro
+
+        LD           => 'ld',              # linker
+        LDFLAGS      => '',                # LD flags
+        LD_OUTPUT    => '-o',              # LD flag, specify output file name
+        LD_LIBSEARCH => '-L',              # LD flag, specify "library" path
+        LD_LIBLINK   => '-l',              # LD flag, specify link library
+
+        AR           => 'ar',              # library archiver
+        ARFLAGS      => 'rs',              # AR flags
+
+        MAKE         => 'make',            # make command
+        MAKEFLAGS    => '',                # make flags
+        MAKE_SILENT  => '-s',              # make flag, silent diagnostic
+        MAKE_JOB     => '-j',              # make flag, number of jobs
+
+        INTERFACE    => 'file',            # name interface after file/program
+        GENINTERFACE => 'ECMWF',           # Fortran 9x interface generator
+
+        MIRROR       => 'rsync',           # extract mirroring tool
+        REMOTE_SHELL => 'remsh',           # command to invoke the remote shell
+        GRAPHIC_DIFF => 'xxdiff',          # graphical diff tool
+      },
+
+      # List of tools that are local to FCM, (will not be exported to a Makefile)
+      LOCALTOOL => 'CPP,CPPFLAGS,CPP_INCLUDE,CPP_DEFINE,FPP,FPPFLAGS,' .
+                   'FPP_INCLUDE,FPP_DEFINE,GRAPHIC_DIFF,MAKE,MAKEFLAGS,' .
+                   'MAKE_SILENT,MAKE_JOB,INTERFACE,GENINTERFACE,MIRROR,' .
+                   'REMOTE_SHELL',
+
+      # Supported tools for compilable source
+      SRC_TOOL => {
+        FORTRAN => {
+          COMPILER => 'FC',
+          FLAGS    => 'FFLAGS',
+          OUTPUT   => 'FC_OUTPUT',
+          INCLUDE  => 'FC_INCLUDE',
+        },
+
+        FPP     => {
+          COMPILER => 'FC',
+          FLAGS    => 'FFLAGS',
+          PPKEYS   => 'FPPKEYS',
+          OUTPUT   => 'FC_OUTPUT',
+          INCLUDE  => 'FC_INCLUDE',
+          DEFINE   => 'FC_DEFINE',
+        },
+
+        C       => {
+          COMPILER => 'CC',
+          FLAGS    => 'CFLAGS',
+          PPKEYS   => 'CPPKEYS',
+          OUTPUT   => 'CC_OUTPUT',
+          INCLUDE  => 'CC_INCLUDE',
+          DEFINE   => 'CC_DEFINE',
+        },
+      },
+
+      # Cache file names/extensions
+      CACHE => {
+        EXTCONFIG   => '.config',       # ext cache, commit version info
+        PCKFILE     => '.pck_file',     # bld cache, source package list
+        PCKPPDEPEND => '.pck_ppdepend', # bld cache, source package PP dependency
+        PCKDEPEND   => '.pck_depend',   # bld cache, source package dependency
+        BLDTOOL     => '.bld_tool',     # bld cache, build tool list
+        PPOPTION    => '.bld_pp',       # bld cache, PP option
+        EXE_DEP     => '.exe_dep',      # bld cache, executable extra dependency
+      },
+
+      # Input file name extension and type
+      # (may overlap with output and vpath, see below)
+      INFILE_EXT => {
+        # General extensions
+        'f'    => 'FORTRAN::SOURCE',
+        'for'  => 'FORTRAN::SOURCE',
+        'ftn'  => 'FORTRAN::SOURCE',
+        'f77'  => 'FORTRAN::SOURCE',
+        'f90'  => 'FORTRAN::FORTRAN9X::SOURCE',
+        'f95'  => 'FORTRAN::FORTRAN9X::SOURCE',
+        'F'    => 'FPP::SOURCE',
+        'FOR'  => 'FPP::SOURCE',
+        'FTN'  => 'FPP::SOURCE',
+        'F77'  => 'FPP::SOURCE',
+        'F90'  => 'FPP::FPP9X::SOURCE',
+        'F95'  => 'FPP::FPP9X::SOURCE',
+        'c'    => 'C::SOURCE',
+        'cpp'  => 'C::C++::SOURCE',
+        'h'    => 'CPP::INCLUDE',
+        'o'    => 'BINARY::OBJ',
+        'obj'  => 'BINARY::OBJ',
+        'exe'  => 'BINARY::EXE',
+        'a'    => 'BINARY::LIB',
+        'sh'   => 'SHELL::SCRIPT',
+        'ksh'  => 'SHELL::SCRIPT',
+        'bash' => 'SHELL::SCRIPT',
+        'csh'  => 'SHELL::SCRIPT',
+        'pl'   => 'PERL::SCRIPT',
+        'pm'   => 'PERL::SCRIPT',
+        'py'   => 'PYTHON::SCRIPT',
+        'tcl'  => 'TCL::SCRIPT',
+        'pro'  => 'PVWAVE::SCRIPT',
+
+        # Local extensions
+        'cfg'       => 'CFGFILE',
+        'h90'       => 'CPP::INCLUDE',
+        'inc'       => 'FORTRAN::FORTRAN9X::INCLUDE',
+        'interface' => 'FORTRAN::FORTRAN9X::INCLUDE::INTERFACE',
+      },
+
+      # Input file name pattern and type
+      INFILE_PAT => {
+        '\w+Scr_\w+'              => 'SHELL::SCRIPT',
+        '\w+Comp_\w+'             => 'SHELL::SCRIPT::GENTASK',
+        '\w+(?:IF|Interface)_\w+' => 'SHELL::SCRIPT::GENIF',
+        '\w+Suite_\w+'            => 'SHELL::SCRIPT::GENSUITE',
+        '\w+List_\w+'             => 'SHELL::SCRIPT::GENLIST',
+        '\w+Sql_\w+'              => 'SCRIPT::SQL',
+      },
+
+      # Input text file pattern and type
+      INFILE_TXT => {
+        '(?:[ck]|ba)?sh'  => 'SHELL::SCRIPT',
+        'perl'            => 'PERL::SCRIPT',
+        'python'          => 'PYTHON::SCRIPT',
+        'tcl(?:sh)?|wish' => 'TCL::SCRIPT',
+      },
+
+      # Ignore input files matching the following names (comma-separated list)
+      INFILE_IGNORE => 'fcm_env.ksh',
+
+      # Output file type and extension
+      # (may overlap with input (above) and vpath (below))
+      OUTFILE_EXT => {
+        CFG       => '.cfg',       # FCM configuration file
+        DONE      => '.done',      # "done" files for compiled source
+        ETC       => '.etc',       # "etc" dummy file
+        EXE       => '.exe',       # binary executables
+        FLAGS     => '.flags',     # "flags" files, compiler flags config
+        IDONE     => '.idone',     # "done" files for included source
+        INTERFACE => '.interface', # interface for F90 subroutines/functions
+        LIB       => '.a',         # archive object library
+        MK        => '.mk',        # dependency files, Makefile fragments
+        MOD       => '.mod',       # compiled Fortran module information files
+        OBJ       => '.o',         # compiled object files
+        PDONE     => '.pdone',     # "done" files for pre-processed files
+        TAR       => '.tar',       # TAR archive
+      },
+
+      # VPATH, each value must be a comma separate list
+      # EMPTY      translates to %
+      # IN:<FLAG>  translates to any key in {INFILE_EXT} if the value contains
+      #            the word in <FLAG>
+      # OUT:<FLAG> translates to {OUTFILE_EXT}{<FLAG>}
+      VPATH   => {
+        BIN   => 'EMPTY,OUT:EXE,IN:SCRIPT',
+        BLD   => 'OUT:MK',
+        DONE  => 'OUT:DONE,OUT:IDONE,OUT:ETC',
+        FLAGS => 'OUT:FLAGS',
+        INC   => 'IN:INCLUDE',
+        LIB   => 'OUT:LIB',
+        OBJ   => 'OUT:OBJ',
+      },
+
+      # Dependency scan types for pre-processing
+      PP_DEP_TYPE => {
+        FPP => 'H',
+        CPP => 'H',
+        C   => 'H',
+      },
+
+      # Dependency scan types
+      DEP_TYPE => {
+        FORTRAN => 'USE::INTERFACE::INC::OBJ',
+        FPP     => 'USE::INTERFACE::INC::H::OBJ',
+        CPP     => 'H::OBJ',
+        C       => 'H::OBJ',
+        SCRIPT  => 'EXE',
+      },
+
+      # Dependency pattern for each type
+      DEP_PATTERN => {
+        H         => q/^#\s*include\s*['"](\S+)['"]/,
+        USE       => q/^\s*use\s+(\w+)/,
+        INTERFACE => q/^#?\s*include\s+['"](\S+##OUTFILE_EXT::INTERFACE##)['"]/,
+        INC       => q/^\s*include\s+['"](\S+)['"]/,
+        OBJ       => q#^\s*(?:/\*|!)\s*depends\s*on\s*:\s*(\S+)#,
+        EXE       => q/^\s*(?:#|;)\s*(?:calls|list|if|interface)\s*:\s*(\S+)/,
+      },
+
+      # Types that always need to be built
+      ALWAYS_BUILD_TYPE => 'PVWAVE,GENLIST,SQL',
+
+      # Types that cannot have duplicated targets
+      NO_DUPLICATED_TARGET_TYPE => '',
+
+      # Excluded dependency
+      EXCL_DEP => {
+        # Fortran intrinsic modules
+        'USE::ISO_C_BINDING'            => {'' => 1},
+        'USE::IEEE_EXCEPTIONS'          => {'' => 1},
+        'USE::IEEE_ARITHMETIC'          => {'' => 1},
+        'USE::IEEE_FEATURES'            => {'' => 1},
+
+        # Fortran intrinsic subroutines
+        'OBJ::CPU_TIME'                 => {'' => 1},
+        'OBJ::GET_COMMAND'              => {'' => 1},
+        'OBJ::GET_COMMAND_ARGUMENT'     => {'' => 1},
+        'OBJ::GET_ENVIRONMENT_VARIABLE' => {'' => 1},
+        'OBJ::MOVE_ALLOC'               => {'' => 1},
+        'OBJ::MVBITS'                   => {'' => 1},
+        'OBJ::RANDOM_NUMBER'            => {'' => 1},
+        'OBJ::RANDOM_SEED'              => {'' => 1},
+        'OBJ::SYSTEM_CLOCK'             => {'' => 1},
+
+        # Dummy statements
+        'OBJ::NONE'                     => {'' => 1},
+        'EXE::NONE'                     => {'' => 1},
+      },
+
+      # Extra executable dependencies
+      EXE_DEP => {},
+
+      # Fortran BLOCKDATA dependencies
+      BLOCKDATA => {},
+
+      # Rename main program targets
+      EXE_NAME => {},
+
+      # Build sub-directories that can be archived by "tar"
+      TAR_DIRS => 'BLD,CACHE,DONE,FLAGS,INC,PPSRC,OBJ',
+
+      # Misc
+      MISC => {
+        CPDUMMY       => '$(FCM_DONEDIR)/FCM_CP.dummy',
+                                         # build system "copy" dummy target
+        DIR_SEPARATOR => '/',            # repository directory separator
+        EXPURL_PREFIX => 'fcm:',         # expandable URL keyword prefix
+        LOCK_BLD      => 'fcm.bld.lock', # build lock file
+        LOCK_EXT      => 'fcm.ext.lock', # extract lock file
+        MAKEFILE      => 'Makefile',     # name of Makefile
+        RUN_ENV_SH    => 'fcm_env.ksh',  # bld runtime environment shell script
+        WEB_BROWSER   => 'firefox',      # web browser
+      },
+
+      # URL, revision, and Trac URL keywords
+      URL      => {},
+      REVISION => {},
+      TRAC     => {},
+    },
+  };
+
+  # Backward compatibility: the REPOS setting is equivalent to the URL setting
+  $self->{SETTING}{REPOS} = $self->{SETTING}{URL};
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $config->central_config ();
+#   $config->central_config ($file);
+#
+# DESCRIPTION
+#   This method returns the path name of the central configuration file. If an
+#   argument $file is specified, the path name of the central configuration
+#   file is set to its value.
+# ------------------------------------------------------------------------------
+
+sub central_config {
+  my $self = shift;
+
+  if (@_) {
+    $self->{CNTL_CONFIG} = $_[0];
+  }
+
+  return $self->{CNTL_CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $config->user_config ();
+#   $config->user_config ($file);
+#
+# DESCRIPTION
+#   This method returns the path name of the user configuration file. If an
+#   argument $file is specified, the path name of the user configuration file
+#   is set to its value.
+# ------------------------------------------------------------------------------
+
+sub user_config {
+  my $self = shift;
+
+  if (@_) {
+    $self->{USER_CONFIG} = $_[0];
+  }
+
+  return $self->{USER_CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mode = $config->verbose ();
+#   $config->verbose ($mode);
+#
+# DESCRIPTION
+#   This method returns the diagnostic verbose level. If an argument $mode is
+#   specified, the diagnostic verbose level is set to its value.
+# ------------------------------------------------------------------------------
+
+sub verbose {
+  my $self = shift;
+
+  if (@_) {
+    $self->{VERBOSE} = $_[0];
+  }
+
+  return $self->{VERBOSE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $setting = $config->setting (arg, [...]);
+#
+# DESCRIPTION
+#   This method returns an item under the SETTING hash table. The depth within
+#   the hash table is given by the list of arguments, which should match with
+#   the keys in the multi-dimension SETTING hash table.
+# ------------------------------------------------------------------------------
+
+sub setting {
+  my $self = shift;
+
+  if (@_) {
+    my $label   = shift;
+    my $setting = $self->{SETTING};
+    return _get_hash_value ($setting->{$label}, @_) if exists $setting->{$label};
+  }
+
+  return undef;
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config->assign_setting (
+#     LABELS => \@labels, # setting labels
+#     VALUE  => $value,   # setting value
+#   );
+#
+# DESCRIPTION
+#   This method assigns a VALUE to a SETTING specified by the names in LABEL.
+# ------------------------------------------------------------------------------
+
+sub assign_setting {
+  my $self = shift;
+  my %args = @_;
+
+  my @labels = exists $args{LABELS} ? @{ $args{LABELS} } : ();
+  my $value  = exists $args{VALUE}  ? $args{VALUE}       : undef;
+
+  my $setting = $self->{SETTING};
+  while (defined (my $label = shift @labels)) {
+    if (exists $setting->{$label}) {
+      if (ref $setting->{$label}) {
+        $setting = $setting->{$label};
+
+      } else {
+        $setting->{$label} = $value;
+        last;
+      }
+
+    } else {
+      if (@labels) {
+        $setting->{$label} = {};
+        $setting           = $setting->{$label};
+
+      } else {
+        $setting->{$label} = $value;
+      }
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $variable = $config->variable ([arg]);
+#
+# DESCRIPTION
+#   If arg is set, this method returns the value of a variable named arg. If
+#   arg is not set, this method returns the VARIABLE hash.
+# ------------------------------------------------------------------------------
+
+sub variable {
+  my $self     = shift;
+
+  my $variable = $self->{VARIABLE};
+
+  if (@_) {
+    my $label   = shift;
+    return exists $variable->{$label} ? $variable->{$label} : undef;
+
+  } else {
+    return %{ $variable };
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config->assign_variable (
+#     LABEL => $label, # variable label
+#     VALUE => $value, # variable value
+#   );
+#
+# DESCRIPTION
+#   This method assigns a VALUE to a VARIABLE named by LABEL.
+# ------------------------------------------------------------------------------
+
+sub assign_variable {
+  my $self = shift;
+  my %args = @_;
+
+  my $label = exists $args{LABEL} ? $args{LABEL} : undef;
+  my $value = exists $args{VALUE} ? $args{VALUE} : undef;
+
+  if ($label) {
+    $self->{VARIABLE}{$label} = $value;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config->get_config ();
+#
+# DESCRIPTION
+#   This method reads the configuration settings from the central and the user
+#   configuration files.
+# ------------------------------------------------------------------------------
+
+sub get_config {
+  my $self = shift;
+
+  $self->_read_config_file ($self->{CNTL_CONFIG}) if $self->{CNTL_CONFIG};  
+  $self->_read_config_file ($self->{USER_CONFIG}) if $self->{USER_CONFIG};
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config->_read_config_file ();
+#
+# DESCRIPTION
+#   This internal method reads a configuration file and assign values to the
+#   attributes of the current instance.
+# ------------------------------------------------------------------------------
+
+sub _read_config_file {
+  my $self        = shift;
+  my $config_file = $_[0];
+
+  return undef unless -r $config_file;
+
+  my $cfgfile = Fcm::CfgFile->new (SRC => $config_file, TYPE => 'FCM');
+  $cfgfile->read_cfg ();
+  my @lines = $cfgfile->lines ();
+
+  LINE: for my $line (@lines) {
+    my $label = $line->{LABEL};
+    my $value = $line->{VALUE};
+
+    next unless $label;
+
+    # "Environment variables" start with $
+    if ($label =~ s/^\$([A-Za-z_]\w*)$/$1/) {
+      $ENV{$label} = $value;
+      next LINE;
+    }
+
+    # "Settings variables" start with "set::"
+    my @tags = map {uc $_} split (/::/, $label);
+    if ($tags[0] eq uc $self->{SETTING}{CFG_LABEL}{SETTING}) {
+      shift @tags;
+      $self->assign_setting (LABELS => \@tags, VALUE => $value);
+      next LINE;
+    }
+
+    # Not a standard setting variable, put in internal variable list
+    $label =~ s/^\%//;
+    $self->assign_variable (LABEL => $label, VALUE => $value);
+  }
+
+  1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ref = _get_hash_value (arg1, arg2, ...);
+#
+# DESCRIPTION
+#   This internal method recursively gets a value from a multi-dimensional
+#   hash.
+# ------------------------------------------------------------------------------
+
+sub _get_hash_value {
+  my $value = shift;
+
+  while (defined (my $arg = shift)) {
+    if (exists $value->{$arg}) {
+      $value = $value->{$arg};
+
+    } else {
+      return undef;
+    }
+  }
+
+  return $value;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Extract.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Extract.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Extract.pm	(revision 6412)
@@ -0,0 +1,1768 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Extract
+#
+# DESCRIPTION
+#   This class contains methods for carrying out the various tasks that are
+#   required to extract code from the FCM Subversion repository for feeding
+#   into the prototype build system. At the end of the extract, it writes a
+#   build configuration file for feeding into the build system.  If the code
+#   is to be built on a remote machine, it is mirrored to the remote machine
+#   using a "rdist" or "rsync" interface.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Extract;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+use File::Spec::Functions;
+use File::Basename;
+use File::Path;
+use File::Compare;
+
+# FCM component modules
+use Fcm::CfgFile;
+use Fcm::ReposBranch;
+use Fcm::SrcDirLayer;
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext = Fcm::Extract->new (
+#     CONFIG    => $config,
+#     CFG_SRC   => $cfg_src,
+#     EXTRACTED => $extracted,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Extract class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   CFG_SRC    - source path to the extract configuration file
+#   EXTRACTED  - is it a pre-extracted object?
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $cfg       = exists $args{CFG_SRC}   ? $args{CFG_SRC}   : undef;
+  my $extracted = exists $args{EXTRACTED} ? $args{EXTRACTED} : undef;
+  my $config    = exists $args{CONFIG}    ? $args{CONFIG}    : &main::cfg;
+
+  my $self = {
+    CONFIG     => $config,            # configuration settings
+    CFG        => Fcm::CfgFile->new ( # ext cfg for this extract
+      SRC      => $cfg,               # source path of the config file
+      TYPE     => 'ext',              # config file type
+      CONFIG   => $config,            # configuration settings
+    ),
+    DEST       => {                   # destination info for this extract
+      ROOTDIR  => undef,              # destination root directory
+      CACHEDIR => undef,              # extract cache directory
+      CFGDIR   => undef,              # destination configuration directory
+      SRCDIR   => undef,              # destination source directory
+      BLD_CFG  => undef,              # bld cfg for the build system
+      EXT_CFG  => undef,              # ext cfg for subsequent extract
+    },
+    RDEST      => {                   # remote destination information
+      MACHINE  => undef,              # destination machine
+      LOGNAME  => undef,              # remote login name
+      ROOTDIR  => undef,              # destination root directory
+      CFGDIR   => undef,              # destination configuration directory
+      SRCDIR   => undef,              # destination source directory
+      BLD_CFG  => undef,              # bld cfg for the build system
+      EXT_CFG  => undef,              # ext cfg for subsequent extract
+    },
+    BDECLARE   => [],                 # list of declared bld cfg entries
+    OVERRIDE   => 0,                  # override conflicting patches?
+    EXTRACTED  => $extracted,         # is the current object pre-extracted?
+    USE        => [],                 # list of re-used extracts
+    BRANCHES   => [],                 # list of repository branch info
+    SRCDIRS    => {},                 # list of source directory extract info
+    LOCK       => undef,              # lock file
+  };
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->DESTROY;
+#
+# DESCRIPTION
+#   This method is called automatically when a Fcm::Extract object is
+#   destroyed.
+# ------------------------------------------------------------------------------
+
+sub DESTROY {
+  my $self = shift;
+
+  # Remove the lock if it is set
+  unlink $self->{LOCK} if $self->{LOCK} and -e $self->{LOCK};
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $ext->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile = $ext->cfg;
+#   $ext->cfg ($cfgfile);
+#
+# DESCRIPTION
+#   This method returns a reference to a Fcm::CfgFile instance for the extract
+#   configuration file.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  my $self = shift;
+
+  return $self->{CFG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dest = $ext->dest ([$name]);
+#
+# DESCRIPTION
+#   This method returns a hash containing the extract destination information
+#   (local) if no argument is specified. If $name is specified, it returns the
+#   named hash element if it exists.
+# ------------------------------------------------------------------------------
+
+sub dest {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+    $name    = uc $name;
+
+    if (exists $self->{DEST}{$name}) {
+      return $self->{DEST}{$name};
+    }
+  }
+
+  return %{ $self->{DEST} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rdest = $ext->rdest ([$name]);
+#
+# DESCRIPTION
+#   This method returns a hash containing the extract destination information
+#   (remote) if no argument is specified. If $name is specified, it returns the
+#   named hash element if it exists.
+# ------------------------------------------------------------------------------
+
+sub rdest {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+    $name    = uc $name;
+
+    if (exists $self->{RDEST}{$name}) {
+      return $self->{RDEST}{$name};
+    }
+  }
+
+  return %{ $self->{RDEST} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @bdeclare = $ext->bdeclare ();
+#
+# DESCRIPTION
+#   This method returns a list containing the build configuration file entries.
+# ------------------------------------------------------------------------------
+
+sub bdeclare {
+  my $self = shift;
+
+  return @{ $self->{BDECLARE} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @branches = $ext->branches ([$index]);
+#
+# DESCRIPTION
+#   This method returns a list of references to Fcm::ReposBranch instances. If
+#   $index is specified, it returns the numbered item in the list.
+# ------------------------------------------------------------------------------
+
+sub branches {
+  my $self = shift;
+
+  if (@_) {
+    my $index = $_[0];
+    return exists $self->{BRANCHES}[$index] ? $self->{BRANCHES}[$index] : undef;
+  }
+
+  return @{ $self->{BRANCHES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %srcdirs = $ext->srcdirs ([$name]);
+#
+# DESCRIPTION
+#   This method returns a hash of source directories to be processed by this
+#   extract. If $name is specified, a named element of the hash is returned
+#   instead.
+# ------------------------------------------------------------------------------
+
+sub srcdirs {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+    $name    = uc $name;
+
+    return exists $self->{SRCDIRS}{$name} ? $self->{SRCDIRS}{$name} : undef;
+  }
+
+  return %{ $self->{SRCDIRS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $ext->extract ([FULL => 1], [IGNORE_LOCK => 1]);
+#
+# DESCRIPTION
+#   This is the main class method. It performs an extract using the current
+#   configuration. If FULL is set to true, it runs in full mode. Otherwise, it
+#   runs in incremental mode. If IGNORE_LOCK is set to true, it ignores any lock
+#   files that may exist in the extract destination root directory.
+# ------------------------------------------------------------------------------
+
+sub extract {
+  my $self = shift;
+  my %args = @_;
+
+  my $full        = exists $args{FULL}        ? $args{FULL}        : 0;
+  my $ignore_lock = exists $args{IGNORE_LOCK} ? $args{IGNORE_LOCK} : 0;
+
+  my $verbose = $self->config->verbose;
+
+  my $date = localtime;
+  print 'Extract started on ', $date, '.', "\n" if $verbose;
+  my $otime = time;
+
+  my $rc;
+  $rc = $self->decipher_cfg;
+
+  print '->Extract: start', "\n" if $verbose;
+  my $stime = time;
+
+  $rc = $self->check_dest               if $rc;
+  $rc = $self->check_lock               if $rc and not $ignore_lock;
+  $rc = $self->_set_lock                if $rc;
+  $rc = $self->expand_cfg               if $rc;
+  $rc = $self->_create_dest_dir ($full) if $rc;
+  $rc = $self->create_dir_stack         if $rc;
+  $rc = $self->_extract_src             if $rc;
+
+  $rc = $self->_sort_bdeclare if $rc;
+  $rc = $self->_write_ext_cfg if $rc;
+  $rc = $self->_write_bld_cfg if $rc;
+
+  my $ftime = time;
+  my $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+  print '->Extract: ', $ftime - $stime, ' ', $s_str, "\n";
+
+  if ($rc and $self->{RDEST}{MACHINE}) {
+    print '->Mirror : start', "\n" if $verbose;
+    $stime = time;
+    $rc = $self->_mirror_extract;
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Mirror : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  if ($verbose) {
+    $s_str = $ftime - $otime > 1 ? 'seconds' : 'second';
+    print '->TOTAL  : ', $ftime - $otime, ' ', $s_str, "\n";
+  }
+
+  $date = localtime;
+  if ($rc) {
+    print 'Extract command finished on ', $date, '.', "\n" if $verbose;
+
+  } else {
+    e_report 'Extract command failed on ', $date, '.';
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->decipher_cfg ();
+#
+# DESCRIPTION
+#   This method deciphers the extract configuration file.
+# ------------------------------------------------------------------------------
+
+sub decipher_cfg {
+  my $self = shift;
+
+  return unless $self->cfg->src;
+
+  # Read config file
+  my $read = $self->cfg->read_cfg;
+
+  # Check config file type
+  if ($read) {
+    if ($self->cfg->type ne 'ext') {
+      w_report 'Error: ', $self->cfg->src, ': not an extract config file';
+      return;
+    }
+
+  } else {
+    return;
+  }
+
+  my %cfg_labels = %{ $self->config->setting ('CFG_LABEL') };
+
+  # Extract information from each line of the config file
+  my @lines    = $self->cfg->lines;
+  LINE: for my $line (@lines) {
+    my $label = $line->{LABEL};
+    my $value = $line->{VALUE};
+
+    next LINE unless $label;
+
+    # Configuration file type/version, ignore
+    for my $my_label (keys %{ $cfg_labels{CFGFILE} }) {
+      next LINE if uc ($label) eq uc ($cfg_labels{CFGFILE}{$my_label});
+    }
+
+    # Include another file, processed already, ignore this line
+    next LINE if uc ($label) eq $cfg_labels{INC};
+
+    # User variable, ignore
+    next LINE if index (uc ($label), '%') == 0;
+
+    # Local destination directories, config file, etc
+    for my $my_label (keys %{ $cfg_labels{DEST} }) {
+      if (uc ($label) eq uc ($cfg_labels{DEST}{$my_label})) {
+        $self->{DEST}{$my_label} = &expand_tilde ($value);
+        next LINE;
+      }
+    }
+
+    # Remote machine, logname, destination directories, config file, etc
+    for my $my_label (keys %{ $cfg_labels{RDEST} }) {
+      if (uc ($label) eq uc ($cfg_labels{RDEST}{$my_label})) {
+        $self->{RDEST}{$my_label} = $value;
+        next LINE;
+      }
+    }
+
+    # "USE" statements
+    if (uc ($label) eq uc ($cfg_labels{USE})) {
+      my $exists = grep {$_->cfg->src eq $value} @{ $self->{USE} };
+
+      # Initialise new Fcm::Extract object if not already exists
+      unless ($exists) {
+        my $extract = Fcm::Extract->new (
+          CONFIG    => $self->config,
+          CFG_SRC   => expand_tilde ($value),
+          EXTRACTED => 1,
+        );
+
+        $extract->decipher_cfg;
+        $extract->check_dest;
+        $extract->expand_cfg ();
+        push @{ $self->{USE} }, $extract;
+      }
+      next LINE;
+    }
+
+    # "Override" setting
+    if (uc ($label) eq uc ($cfg_labels{OVERRIDE})) {
+      $self->{OVERRIDE} = $value;
+      next LINE;
+    }
+
+    # "Mirror" command
+    if (uc ($label) eq uc ($cfg_labels{MIRROR})) {
+      $self->config->assign_setting (
+        LABELS => [qw/TOOL MIRROR/],
+        VALUE  => $value,
+      );
+      next LINE;
+    }
+
+    # Declared bld cfg entries
+    {
+      my $prefix = $cfg_labels{BDECLARE} . '::';
+
+      if (index (uc ($label), $prefix) == 0) {
+        my $name = substr $label, length ($prefix);
+
+        if ($name) {
+          push @{ $self->{BDECLARE} }, {LABEL => $name, VALUE => $value,};
+          next LINE;
+        }
+      }
+    }
+
+    # Repository, version and source directories
+    for my $my_label (qw/REPOS VERSION SRCDIR EXPSRCDIR/) {
+      my $prefix  = $cfg_labels{$my_label} . '::';
+
+      if (index (uc ($label), $prefix) == 0) {
+        my $name    = substr $label, length ($prefix);
+
+        # Detemine package and tag
+        my @names   = split /::/, $name;
+        my $tag     = pop @names;
+        my $pckroot = $names[0];
+        my $pck     = join '::', @names;
+
+        # Check that $tag and $pckroot are defined
+        last if not $tag;
+        last if not $pckroot;
+
+        # Check whether branch already exists
+        my @branches = grep {
+          $_->package eq $pckroot and $_->tag eq $tag
+        } @{ $self->{BRANCHES} };
+
+        my $branch   = undef;
+
+        if (@branches) { # If so, set $branch to point to existing branch
+          $branch = shift @branches;
+
+        } else {         # If not, create new branch
+          $branch = Fcm::ReposBranch->new (
+            CONFIG  => $self->config,
+            PACKAGE => $pckroot,
+            TAG     => $tag,
+          );
+
+          push @{ $self->{BRANCHES} }, $branch;
+        }
+
+        # Check package name for source directory declarations
+        if ($my_label eq 'SRCDIR' or $my_label eq 'EXPSRCDIR') {
+          if ($pck eq $pckroot and $value !~ m#^/#) {
+            # Sub-package name not set and source directory quoted as a relative
+            # path, determine package name from path name
+            my @subpck = File::Spec->splitdir ($value);
+            $pck       = join '::', ($pckroot, @subpck);
+          }
+        }
+
+        # Assign the value accordingly
+        if ($my_label eq 'REPOS') {          # Repository location
+          $branch->repos ($value);
+
+        } elsif ($my_label eq 'VERSION') {   # Version used
+          $branch->version ($value);
+
+        } elsif ($my_label eq 'SRCDIR') {    # Source directory used
+          $branch->dir ($pck, $value);
+
+        } elsif ($my_label eq 'EXPSRCDIR') { # Expandable source directory
+          $branch->expdir ($pck, $value);
+        }
+
+        next LINE;
+      }
+    }
+
+    # Label not recognised
+    w_report 'ERROR: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
+             ': label "', $label, '" not recognised';
+    return;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->check_dest ();
+#
+# DESCRIPTION
+#   This method checks that the extract destionations are set correctly.
+# ------------------------------------------------------------------------------
+
+sub check_dest {
+  my $self = shift;
+
+  my %subdir  = %{ $self->config->setting ('DIR') };
+  my %cfgname = %{ $self->config->setting ('CFG_NAME') };
+
+  # Default destination settings
+  my $dest = $self->{DEST};
+  if ($dest->{ROOTDIR}) {
+    unless ($dest->{SRCDIR}) {   # Location of extracted source
+      $dest->{SRCDIR} = catfile $dest->{ROOTDIR}, $subdir{SRC};
+    }
+    unless ($dest->{CFGDIR}) {   # Location of configuration files
+      $dest->{CFGDIR} = catfile $dest->{ROOTDIR}, $subdir{CFG};
+    }
+    unless ($dest->{CACHEDIR}) { # Location of cache
+      $dest->{CACHEDIR} = catfile $dest->{ROOTDIR}, $subdir{CACHE};
+    }
+    unless ($dest->{BLD_CFG}) {  # Location of (output) bld cfg
+      $dest->{BLD_CFG} = catfile $dest->{CFGDIR}, $cfgname{BLD};
+    }
+    unless ($dest->{EXT_CFG}) {  # Location of (output) ext cfg
+      $dest->{EXT_CFG} = catfile $dest->{CFGDIR}, $cfgname{EXT};
+    }
+  } else {
+    w_report 'Error: ', $self->cfg->src,
+             ': destination root directory not set.';
+    return;
+  }
+
+  # Default remote destination settings
+  if ($self->{RDEST}{MACHINE}) {
+
+    # Use local logname as remote logname if it is not set
+    $self->{RDEST}{LOGNAME} = getlogin      unless $self->{RDEST}{LOGNAME};
+    $self->{RDEST}{LOGNAME} = $ENV{LOGNAME} unless $self->{RDEST}{LOGNAME};
+    $self->{RDEST}{LOGNAME} = $ENV{USER}    unless $self->{RDEST}{LOGNAME};
+
+    unless ($self->{RDEST}{LOGNAME}) {
+      w_report 'Error: ', $self->cfg->src,
+               ': cannot determine your remote logname.';
+      return;
+    }
+
+    # Make sure remote destination root directory is set
+    unless ($self->{RDEST}{ROOTDIR}) {
+      w_report 'Error: ', $self->cfg->src,
+               ': remote destination root directory not set.';
+      return;
+    }
+
+    # Make sure remote destination source directory is set
+    $self->{RDEST}{SRCDIR} = catfile $self->{RDEST}{ROOTDIR}, $subdir{SRC}
+      unless $self->{RDEST}{SRCDIR};
+
+    # Make sure remote destination configuration directory is set
+    $self->{RDEST}{CFGDIR} = catfile $self->{RDEST}{ROOTDIR}, $subdir{CFG}
+      unless $self->{RDEST}{CFGDIR};
+
+    # Make sure remote bld cfg is set
+    $self->{RDEST}{BLD_CFG} = catfile $self->{RDEST}{CFGDIR}, $cfgname{BLD}
+      unless $self->{RDEST}{BLD_CFG};
+
+    # Make sure remote ext cfg is set
+    $self->{RDEST}{EXT_CFG} = catfile $self->{RDEST}{CFGDIR}, $cfgname{EXT}
+      unless $self->{RDEST}{EXT_CFG};
+
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->check_lock ();
+#
+# DESCRIPTION
+#   This method checks whether a lock is set in the current extract.
+# ------------------------------------------------------------------------------
+
+sub check_lock {
+  my $self = shift;
+
+  my $rootdir  = $self->{DEST}{ROOTDIR};
+  my $lock_ext = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_EXT/));
+  my $lock_bld = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_BLD/));
+
+  # Always throw error if extract lock exists
+  if (-e $lock_ext) {
+    w_report 'ERROR: extract lock file exists: ', $lock_ext, ',';
+    w_report '       an extract may be running at ', $rootdir, ', abort.';
+    return;
+  }
+
+  # Throw error if current object is not a "used" pre-extracted object and
+  # a build lock exists
+  if ((not $self->{EXTRACTED}) and -e $lock_bld) {
+    w_report 'ERROR: build lock file exists: ', $lock_bld, ',';
+    w_report '       a build may be running at ', $rootdir, ', abort.';
+    return;
+  }
+
+  # Check locks in inherited extract
+  for my $use (@{ $self->{USE} }) {
+    return unless $use->check_lock;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_set_lock ();
+#
+# DESCRIPTION
+#   This method sets a lock is set in the current extract.
+# ------------------------------------------------------------------------------
+
+sub _set_lock {
+  my $self = shift;
+
+  $self->{LOCK} = catfile (
+    $self->{DEST}{ROOTDIR}, $self->config->setting (qw/MISC LOCK_EXT/),
+  );
+
+  &touch_file ($self->{LOCK});
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->expand_cfg ();
+#
+# DESCRIPTION
+#   This method expands the settings of the extract configuration.
+# ------------------------------------------------------------------------------
+
+sub expand_cfg {
+  my $self = shift;
+
+  # Establish a set of source directories from the "base repository"
+  my %base_branches = ();
+
+  # Inherit "base" set of source directories from re-used extracts
+  my @uses = @{ $self->{USE} };
+
+  for my $use (@uses) {
+    my @branches = $use->branches;
+
+    for my $branch (@branches) {
+      my $package              = $branch->package;
+      $base_branches{$package} = $branch unless exists $base_branches{$package};
+    }
+  }
+
+  for my $branch (@{ $self->{BRANCHES} }) {
+    # Expand URL keywords if necessary
+    if ($branch->repos) {
+      my $repos = expand_url_keyword (
+        URL => $branch->repos,
+        CFG => $self->config,
+      );
+      $branch->repos ($repos) if $repos ne $branch->repos;
+    }
+
+    # Check that repository type and version are set
+    if ($branch->repos and &is_url ($branch->repos)) {
+      $branch->type    ('svn')  unless $branch->type;
+      $branch->version ('head') unless $branch->version;
+
+    } else {
+      $branch->type    ('user') unless $branch->type;
+      $branch->version ('user') unless $branch->version;
+    }
+
+    $branch->expand_version_tag; # Work out revision number a version tag
+    $branch->expand_path;        # Expand relative path to full path
+    $branch->expand_all;         # Search sub-directories
+
+    my $package = $branch->package;
+
+    if (exists $base_branches{$package}) {
+      # A base branch for this package exists
+
+      # If current branch has no source directory, use the set provided by the
+      # base branch
+      my %dirs = $branch->dirs;
+      $branch->add_base_dirs ($base_branches{$package}) unless keys %dirs;
+
+    } else {
+      # This package does not yet have a base branch, set this branch as base
+      $base_branches{$package} = $branch;
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_create_dest_dir ($full);
+#
+# DESCRIPTION
+#   This internal method (re-)creates all the destination directories if
+#   necessary. If $full is set to true, it removes existing directories/files
+#   in the destination directories.
+# ------------------------------------------------------------------------------
+
+sub _create_dest_dir {
+  my ($self, $full) = @_;
+
+  my $verbose = $self->config->verbose;
+
+  # Remove previous extract if "FULL" flag is set
+  if ($full) {
+    # Remove extracted source
+    if (-d $self->{DEST}{SRCDIR} and -w $self->{DEST}{SRCDIR}) {
+      print 'Remove directory: ', $self->{DEST}{SRCDIR}, "\n" if $verbose;
+      my $removed = rmtree $self->{DEST}{SRCDIR};
+      w_report 'WARNING: ', $self->{DEST}{SRCDIR}, ': cannot remove.'
+        if not $removed;
+    }
+
+    # Remove cache
+    my @files;
+    if (-d $self->{DEST}{CACHEDIR} and opendir DIR, $self->{DEST}{CACHEDIR}) {
+      @files = grep {$_ ne '.' and $_ ne '..'} readdir 'DIR';
+      closedir DIR;
+    }
+
+    for my $file (@files) {
+      my $path = File::Spec->catfile ($self->{DEST}{CACHEDIR}, $file);
+
+      next unless $file eq $self->config->setting (qw/CACHE EXTCONFIG/) or
+                  -d $path;
+
+      print 'Remove: ', $path, "\n" if $verbose;
+      my $removed = rmtree $path;
+      w_report 'WARNING: ', $path, ': cannot remove.' if not $removed;
+    }
+  }
+
+  # Create extract destinations if necessary
+  for my $my_label (qw/ROOTDIR CACHEDIR CFGDIR SRCDIR/) {
+    my $dirname = $self->{DEST}{$my_label};
+
+    # Create directory if it does not already exist
+    if (not -d $dirname) {
+      print 'Make directory: ', $dirname, "\n" if $verbose > 1;
+      mkpath $dirname;
+    }
+
+    unless (-d $dirname and -w $dirname) {
+      w_report 'ERROR: ', $dirname, ': cannot write to destination.';
+      return;
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->create_dir_stack (
+#     USE => $use, # Is this a pre-extracted configuration?
+#   );
+#
+# DESCRIPTION
+#   This method creates a hash of source directories to be processed. If the
+#   flag USE is set to true, the source directories are assumed processed and
+#   extracted.
+# ------------------------------------------------------------------------------
+
+sub create_dir_stack {
+  my $self = shift;
+  my %args = @_;
+  my $extracted = exists $args{USE} ? $args{USE} : undef;
+
+  # Inherit from USE ext cfg
+  if (@{ $self->{USE} } > 0) {
+    for my $use (@{ $self->{USE} }) {
+      $use->create_dir_stack (USE => 1);
+      my %use_srcdirs = $use->srcdirs;
+
+      while (my ($key, $value) = each %use_srcdirs) {
+        $self->{SRCDIRS}{$key} = $value;
+
+        # Re-set destination to current destination
+        my @path = split (/::/, $key);
+        $self->{SRCDIRS}{$key}{DEST} = catfile ($self->{DEST}{SRCDIR}, @path);
+      }
+    }
+  }
+
+  # Build stack from current ext cfg
+  for my $branch (@{ $self->{BRANCHES} }) {
+    my %branch_dirs = $branch->dirs;
+
+    for my $dir (keys %branch_dirs) {
+      # Check whether source directory is already in the list
+      if (not exists $self->{SRCDIRS}{$dir}) { # if not, create it
+        $self->{SRCDIRS}{$dir} = {
+          DEST  => catfile ($self->{DEST}{SRCDIR}, split (/::/, $dir)),
+          STACK => [],
+          FILES => {},
+        };
+      }
+
+      my $stack = $self->{SRCDIRS}{$dir}{STACK}; # copy reference
+
+      # Create a new layer in the input stack
+      my $layer = Fcm::SrcDirLayer->new (
+        CONFIG    => $self->config,
+        NAME      => $dir,
+        PACKAGE   => $branch->package,
+        TAG       => $branch->tag,
+        LOCATION  => $branch->dir ($dir),
+        REPOSROOT => $branch->repos,
+        VERSION   => $branch->version,
+        TYPE      => $branch->type,
+        EXTRACTED => $extracted ? $self->{SRCDIRS}{$dir}{DEST} : undef,
+      );
+
+      # Check whether layer is already in the stack
+      my $exist = grep {
+        $_->location eq $layer->location and $_->version  eq $layer->version;
+      } @{ $stack };
+
+      if (not $exist) {
+        # If not already exist, put layer into stack
+
+        # Note: user stack always comes last
+        if (! $layer->user and exists $stack->[-1] and $stack->[-1]->user) {
+          my $lastlayer = pop @{ $stack };
+          push @{ $stack }, $layer;
+          $layer = $lastlayer;
+        }
+
+        push @{ $stack }, $layer;
+
+      } elsif ($layer->user) {
+
+        # User layer already exists, overwrite it
+        $stack->[-1] = $layer;
+
+      }
+    }
+  }
+
+  # Read content of "commit cache" file if it exists
+  my $cachedir = $self->{DEST}{CACHEDIR};
+  my $cfgbase  = $self->config->setting (qw/CACHE EXTCONFIG/);
+  my $cfgfile  = catfile $cachedir, $cfgbase;
+  my %config_lines = ();
+  if (-r $cfgfile) {
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $cfgfile,);
+    $cfg->read_cfg;
+    my @lines = $cfg->lines;
+
+    for my $line (@lines) {
+      $config_lines{$line->{LABEL}} = $line->{VALUE};
+    }
+  }
+
+  my %new_config_lines;
+
+  # Compare each layer to base layer, discard unnecessary layers
+  for my $srcdir (keys %{ $self->{SRCDIRS} }) {
+    my @stack = ();
+
+    while (my $layer = shift @{ $self->{SRCDIRS}{$srcdir}{STACK} }) {
+      if ($layer->user) {
+        # User directory, check that the declared location exists
+        if (not -d $layer->location) {
+          w_report 'Error: declared source directory ', $layer->location,
+                   ' does not exists ';
+          return;
+        }
+
+        # Always override repository code
+        push @stack, $layer;
+
+      } else {
+        unless ($layer->extracted and $layer->commit) {
+
+          my $key = join '::', ($srcdir, $layer->location, $layer->version);
+
+          # See if commit version information is cached
+          if (keys %config_lines) {
+            if (exists $config_lines{$key}) {
+              $layer->commit ($config_lines{$key});
+            }
+          }
+
+          # Check source directory for commit version, if necessary
+          $layer->get_commit unless $layer->commit;
+          if (not $layer->commit) {
+            w_report 'Error: cannot determine the last changed revision of ',
+                     $layer->location;
+            return;
+          }
+
+          # Set cache directory for layer
+          my $tag_ver = $layer->tag . '__' . $layer->commit;
+          $layer->cachedir (catfile $cachedir, split (/::/, $srcdir), $tag_ver);
+
+          # New line in cache config file
+          $new_config_lines{$key} = $layer->commit;
+        }
+
+        # Push this layer in the stack:
+        # 1. it has a different version compared to the top layer
+        # 2. it is the top layer (base line code)
+        if (@stack > 0) {
+          push @stack, $layer if $layer->commit != $stack[0]->commit;
+
+        } else {
+          push @stack, $layer;
+        }
+
+      }
+    }
+
+    $self->{SRCDIRS}{$srcdir}{STACK} = \@stack;
+
+  }
+
+  # Write "commit cache" file
+  if (not $extracted) {
+    mkpath $cachedir if not -d $cachedir;
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config,);
+
+    while ((my $label, my $value) = each %new_config_lines) {
+      $cfg->add_line (LABEL => $label, VALUE => $value,);
+    }
+
+    $cfg->print_cfg ($cfgfile);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_extract_src ();
+#
+# DESCRIPTION
+#   This internal method performs the extract of the source directories and
+#   files if necessary.
+# ------------------------------------------------------------------------------
+
+sub _extract_src {
+  my $self = shift;
+
+  my $verbose = $self->config->verbose;
+  my %v_count = (
+    CREATED_DIRS    => 0,
+    IGNORED_SUBDIRS => 0,
+    UPDATED_FILES   => 0,
+    REMOVED_FILES   => 0,
+  );
+
+  my $cachedir = $self->{DEST}{CACHEDIR};
+
+  # Go through the "stack" of each source directory
+  # Extract the source directories/files if required
+
+  for my $srcdir (values %{ $self->{SRCDIRS} }) {
+
+    # Check if destionation exists and is not a directory
+    if (-f $srcdir->{DEST}) {
+      w_report $srcdir->{DEST},
+               ': destination exists and is not a directory, abort.';
+      return;
+    }
+
+    my %base_files   = (); # list of files in the base layer
+    my %used_files   = (); # keys = file basenames, values = layer reference
+    $srcdir->{FILES} = \%used_files;
+    my @destpath     = (); # search path for source directory destinations
+ 
+    for my $layer (@{ $srcdir->{STACK} }) {
+      # Update the cache for each layer of the stack if necessary
+      $layer->update_cache unless $layer->extracted or -d $layer->localdir;
+
+      # Search path for extract destinations of this source directory
+      unshift @destpath, $layer->extracted
+        if $layer->extracted and not grep {$_ eq $layer->extracted} @destpath;
+ 
+      # Get list of files in the cache or local directory
+      for my $file (($layer->get_files)) {
+        if (exists $base_files{$file}) {
+          # File exists in the base, compare current version with base version,
+          # discard if not changed
+          my $base_file = catfile $base_files{$file}->localdir, $file;
+          my $used_file = catfile $used_files{$file}->localdir, $file;
+          my $this_file = catfile $layer->localdir, $file;
+
+          if (compare ($base_file, $this_file)) { # Differs
+            if ($base_files{$file} eq $used_files{$file}) {
+              # Base and used are the same layer, use current layer
+              $used_files{$file} = $layer;
+
+            } elsif (compare ($used_file, $this_file) == 0) {
+              # Changes in used and this are the same, no update required
+
+              # Print a message at verbose mode 2 or above
+              if ($verbose > 1) {
+                print &_print_override_mesg (
+                  FILE   => $file,
+                  LAYER0 => $base_files{$file},
+                  LAYER1 => $used_files{$file},
+                  LAYER2 => $layer,
+                );
+                print '  Same modifications, use the source in URL 1.', "\n";
+              }
+
+            } elsif ($self->{OVERRIDE}) {
+              # Base and used are different, and used is not the same as this
+              # Override mode, use current layer
+
+              # Print override mode message
+              if ($verbose) {
+                print &_print_override_mesg (
+                  FILE   => $file,
+                  LAYER0 => $base_files{$file},
+                  LAYER1 => $used_files{$file},
+                  LAYER2 => $layer,
+                );
+                print '  ', $file, ' in URL 2 overrides that in URL 1.', "\n";
+              }
+
+              $used_files{$file} = $layer;
+
+            } else {
+              # Base and used are different, and used is not the same as this
+              # Non-override mode, fail the extract
+              w_report &_print_override_mesg (
+                FILE   => $file,
+                LAYER0 => $base_files{$file},
+                LAYER1 => $used_files{$file},
+                LAYER2 => $layer,
+              );
+              w_report '  Override mode is false, file in URL 1 cannot ',
+                       'override file in URL 2, abort.';
+              return;
+            }
+          }
+ 
+        } else {
+          # The first time the file is found
+          $base_files{$file} = $layer;
+          $used_files{$file} = $layer;
+        }
+      }
+    }
+
+    # Add current destination to the beginning of the destination search path
+    unshift @destpath, $srcdir->{DEST} if -d $srcdir->{DEST};
+
+    for my $file (keys %used_files) {
+      # Ignore sub-directories
+      if (-d catfile $used_files{$file}->localdir, $file) {
+        # Print diagnostic
+        if ($verbose > 1) {
+          print 'Ignore subdirectory: ', $file, "\n";
+          print '                Src: ', $used_files{$file}->location;
+          print '@', $used_files{$file}->version unless $used_files{$file}->user;
+          print "\n";
+        }
+        $v_count{IGNORED_SUBDIRS}++;
+        next;
+      }
+
+      # Determine whether file has changed, compared with the destination
+      my $diff = 1;
+      for my $dir (@destpath) {
+        my $old = catfile ($dir, $file);
+
+        if (-f $old) {
+          my $new = catfile ($used_files{$file}->localdir, $file);
+          $diff   = compare $old, $new;
+          last;
+        }
+      }
+
+      if ($diff) { # copy if differs
+        # Create extract destination, if required
+        if (not -d $srcdir->{DEST}) {
+          print 'Create directory: ', $srcdir->{DEST}, "\n" if $verbose > 1;
+          my $mkdirs = mkpath $srcdir->{DEST};
+
+          if (! -d $srcdir->{DEST} or ! -w $srcdir->{DEST}) {
+            w_report $srcdir->{DEST}, ': not a writable directory, abort.';
+            return;
+          }
+
+          $v_count{CREATED_DIRS} += $mkdirs;
+        }
+
+        # Set up the copy command
+        my @cmd = (
+          'cp',
+          catfile ($used_files{$file}->localdir, $file),
+          $srcdir->{DEST},
+        );
+
+        my $dest_file = catfile ($srcdir->{DEST}, $file);
+
+        # Print diagnostic
+        if ($verbose > 1) {
+          print 'Update: ', $dest_file, "\n";
+          print '   Src: ', $used_files{$file}->location;
+          print '@', $used_files{$file}->version unless $used_files{$file}->user;
+          print "\n";
+        }
+
+        # Remove old file if it exists
+        unlink $dest_file if -f $dest_file;
+
+        # Execute the copy command
+        &run_command (\@cmd, TIME => $self->config->verbose > 2);
+
+        $v_count{UPDATED_FILES}++;
+      }
+
+    }
+
+    # Check that the destination directory does not contain any removed files
+    opendir DIR, $srcdir->{DEST};
+    my @dest_files = readdir DIR;
+    closedir DIR;
+
+    while (my $file = shift @dest_files) {
+      next if $file =~ /^\.\.?/;                   # ignore hidden files
+      next if -d catfile ($srcdir->{DEST}, $file); # ignore sub-directories
+
+      # Check if the file exists in any of the versions
+      my $exists = 0;
+      for my $layer (@{ $srcdir->{STACK} }) {
+        if (-f catfile ($layer->localdir, $file)) {
+          $exists = 1;
+          last;
+        }
+      }
+
+      # File exists in destination but not in any versions...
+      if (not $exists) {
+        my @cmd = (
+          qw/rm -f/,
+          catfile ($srcdir->{DEST}, $file),
+        );
+
+        # Print diagnostic
+        print 'Remove: ', catfile ($srcdir->{DEST}, $file), "\n"
+          if $verbose > 1;
+
+        # Execute the command
+        &run_command (\@cmd, TIME => $self->config->verbose > 2);
+
+        $v_count{REMOVED_FILES}++;
+      }
+    }
+  }
+
+  if ($verbose) {
+    my %v_label = (
+      CREATED_DIRS    => 'Number of directories created    : ',
+      IGNORED_SUBDIRS => 'Number of ignored sub-directories: ',
+      UPDATED_FILES   => 'Number of updated files          : ',
+      REMOVED_FILES   => 'Number of removed files          : ',
+    );
+    for my $key (qw/CREATED_DIRS IGNORED_SUBDIRS UPDATED_FILES REMOVED_FILES/) {
+      print $v_label{$key}, $v_count{$key}, "\n" if $v_count{$key};
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = _print_override_mesg (
+#     FILE => $file,
+#     LAYER0 => $layer0,
+#     LAYER1 => $layer1,
+#     LAYER2 => $layer2,
+#   );
+#
+# DESCRIPTION
+#   This internal method returns a string containing an override mode message.
+#
+# ARGUMENTS
+#   FILE   - name of the source file
+#   LAYER0 - base location
+#   LAYER1 - source location overridden by LOC2
+#   LAYER2 - source location overriding LOC1
+# ------------------------------------------------------------------------------
+
+sub _print_override_mesg {
+  my %args = @_;
+
+  my $string = $args{FILE};
+  $string .= ': modified in both URL 1 and URL 2, relative to BASE:';
+  $string .= "\n";
+  $string .= '  BASE : ' . $args{LAYER0}->location;
+  $string .= '@' . $args{LAYER0}->version unless $args{LAYER0}->user;
+  $string .= "\n";
+  $string .= '  URL 1: ' . $args{LAYER1}->location;
+  $string .= '@' . $args{LAYER1}->version unless $args{LAYER1}->user;
+  $string .= "\n";
+  $string .= '  URL 2: ' . $args{LAYER2}->location;
+  $string .= '@' . $args{LAYER2}->version unless $args{LAYER2}->user;
+  $string .= "\n";
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_sort_bdeclare ();
+#
+# DESCRIPTION
+#   This internal method sorts the declared build configuration entries,
+#   filtering out repeated entries.
+# ------------------------------------------------------------------------------
+
+sub _sort_bdeclare {
+  my $self = shift;
+
+  # Get list of build configuration labels that can be declared multiple times
+  my %cfg_labels   = %{ $self->config->setting ('CFG_LABEL') };
+  my @cfg_keywords = split /,/, $self->config->setting ('CFG_KEYWORD');
+  @cfg_keywords    = map {$cfg_labels{$_}} @cfg_keywords;
+
+  # Filter out repeated declarations
+  my @bdeclares = ();
+  for my $bdeclare (reverse @{ $self->{BDECLARE} }) {
+    my $label = $bdeclare->{LABEL};
+
+    # Do not filter any declarations that can be declared multiple times
+    my $unshift_ok = grep {
+      uc ($label) eq $_ or index (uc ($label), $_ . '::') == 0;
+    } @cfg_keywords;
+    # @bdeclare contains nothing, last entry
+    $unshift_ok    = 1 unless $unshift_ok or @bdeclares;
+    # Check if a later entry already exists
+    $unshift_ok    = 1
+      unless $unshift_ok or grep {$_->{LABEL} eq $label} @bdeclares;
+
+    # Reconstruct array from bottom up
+    unshift @bdeclares, $bdeclare if $unshift_ok;
+  }
+
+  $self->{BDECLARE} = \@bdeclares;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_write_ext_cfg ();
+#
+# DESCRIPTION
+#   This internal method writes the expanded extract configuration file.
+# ------------------------------------------------------------------------------
+
+sub _write_ext_cfg {
+  my $self = shift;
+
+  my %cfg_labels = %{ $self->config->setting ('CFG_LABEL') };
+  my %subdir     = %{ $self->config->setting ('DIR') };
+  my %cfgname    = %{ $self->config->setting ('CFG_NAME') };
+
+  # Create new config file object and assign lines to it
+  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, TYPE => 'ext',);
+
+  # Set up config file header
+  $cfg->add_header ();
+
+  # Re-use pre-extracted expanded ext cfg
+  if (@{ $self->{USE} }) {
+    $cfg->add_comment_block ('Other ext cfg');
+
+    for my $reuse (@{ $self->{USE} }) {
+      my $rootdir = $reuse->dest ('ROOTDIR');
+      my $ext_cfg = $reuse->cfg->src;
+
+      # Default location of build config file
+      my $def_ext_cfg = catfile $rootdir, $subdir{CFG}, $cfgname{EXT};
+
+      $cfg->add_line (
+        LABEL => $cfg_labels{USE},
+        VALUE => $ext_cfg eq $def_ext_cfg ? $rootdir : $ext_cfg,
+      );
+    }
+
+    # Blank line
+    $cfg->add_line;
+  }
+
+  # Destination directories, config file, etc
+  my $dest = $self->{DEST};
+
+  $cfg->add_comment_block ('Destination');
+
+  $cfg->add_line (
+    LABEL => $cfg_labels{DEST}{ROOTDIR},
+    VALUE => $dest->{ROOTDIR},
+  );
+
+  for my $label (qw/CFG SRC CACHE/) {
+    my $dir = $label . 'DIR';
+
+    if ($dest->{$dir} ne catfile $dest->{ROOTDIR}, $subdir{$label}) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{DEST}{$dir},
+        VALUE => $dest->{$dir},
+      );
+    }
+  }
+
+  for my $name (qw/BLD EXT/) {
+    my $label = $name . '_CFG';
+
+    if ($dest->{$label} ne catfile $dest->{CFGDIR}, $cfgname{$name}) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{DEST}{$label},
+        VALUE => $dest->{$label},
+      );
+    }
+  }
+
+  # Blank line
+  $cfg->add_line;
+
+  # Remote destination directories, config file, etc
+  if ($self->{RDEST}{MACHINE}) {
+    my $rdest = $self->{RDEST};
+
+    $cfg->add_comment_block ('Remote destination');
+
+    for my $label (qw/MACHINE LOGNAME ROOTDIR/) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{RDEST}{$label},
+        VALUE => $rdest->{$label},
+      );
+    }
+
+    for my $label (qw/CFG SRC/) {
+      my $dir = $label . 'DIR';
+      if ($rdest->{$dir} ne catfile $rdest->{ROOTDIR}, $subdir{$label}) {
+        $cfg->add_line (
+          LABEL => $cfg_labels{RDEST}{$dir},
+          VALUE => $rdest->{$dir},
+        );
+      }
+    }
+
+    for my $name (qw/BLD EXT/) {
+      my $label = $name . '_CFG';
+
+      if ($rdest->{$label} ne catfile $rdest->{CFGDIR}, $cfgname{$name}) {
+        $cfg->add_line (
+          LABEL => $cfg_labels{RDEST}{$label},
+          VALUE => $rdest->{$label},
+        );
+      }
+    }
+
+    $cfg->add_line (
+      LABEL => $cfg_labels{MIRROR},
+      VALUE => $self->config->setting (qw/TOOL MIRROR/),
+    );
+
+    # Blank line
+    $cfg->add_line;
+  }
+
+  if ($self->{OVERRIDE}) {
+    $cfg->add_line (
+      LABEL => $cfg_labels{OVERRIDE},
+      VALUE => $self->{OVERRIDE} ? 1 : 0,
+    );
+    $cfg->add_line;
+  }
+
+  # Source directories
+  $cfg->add_comment_block ('Source directories');
+
+  # Set up lines in the ext cfg
+  my @lines = ();
+  for my $my_label (keys %{ $self->{SRCDIRS} }) {
+    for my $layer (@{ $self->{SRCDIRS}{$my_label}{STACK} }) {
+      next if $layer->extracted;
+
+      my $tag = $layer->package . '::' . $layer->tag;
+
+      # Repository
+      my $exists = grep {
+        $_->{LABEL} eq $cfg_labels{REPOS} . '::' . $tag;
+      } @lines;
+      push @lines, {
+        LABEL   => $cfg_labels{REPOS} . '::' . $tag,
+        VALUE   => $layer->reposroot,
+      } if not $exists;
+
+      # Version
+      $exists = grep {
+        $_->{LABEL} eq $cfg_labels{VERSION} . '::' . $tag;
+      } @lines;
+      push @lines, {
+        LABEL   => $cfg_labels{VERSION} . '::' . $tag,
+        VALUE   => $layer->version,
+      } unless $layer->user or $exists;
+
+      # Source directory
+      my ($pcks, $path);
+
+      if ($layer->reposroot) {
+        # Repository root declaration exists, print relative path
+        if ($layer->location eq $layer->reposroot) {
+          $path  = '';
+
+        } else {
+          $path  = substr ($layer->location, length ($layer->reposroot) + 1);
+        }
+        my @pcks = split /::/, $my_label;
+        shift @pcks;
+
+        if (join ('::', @pcks) eq join ('::', File::Spec->splitdir ($path))) {
+          # Print top package name if relative path matches sub-package name
+          $pcks = $layer->package;
+
+        } else {
+          # Print full sub-package name otherwise
+          $pcks = $my_label;
+        }
+
+      } else {
+        # No repository root declaration
+        # Print full path and full sub-package name
+        $path = $layer->location;
+        $pcks = $my_label;
+      }
+
+      my $length = $layer->reposroot ? length ($layer->reposroot) + 1 : 0;
+      push @lines, {
+        LABEL   => join ('::', ($cfg_labels{SRCDIR}, $pcks, $layer->tag)),
+        VALUE   => $path,
+      };
+    }
+  }
+
+  # Sort lines for specifying repository, version and source directories
+  @lines = sort {
+    my $rep_label = $cfg_labels{REPOS};
+    my $ver_label = $cfg_labels{VERSION};
+
+    if ($a->{LABEL} =~ /^$rep_label/) {
+
+      # Repository labels
+      if ($b->{LABEL} =~ /^$rep_label/) {
+        $a->{LABEL} cmp $b->{LABEL} or $a->{VALUE} cmp $b->{VALUE};
+      } else {
+        -1;
+      }
+
+    } elsif ($a->{LABEL} =~ /^$ver_label/) {
+
+      # Version labels
+      if ($b->{LABEL} =~ /^$rep_label/) {
+        1;
+      } elsif ($b->{LABEL} =~ /^$ver_label/) {
+        $a->{LABEL} cmp $b->{LABEL} or $a->{VALUE} cmp $b->{VALUE};
+      } else {
+        -1;
+      }
+    } else {
+
+      # Source directories labels
+      if ($b->{LABEL} =~ /^(?:$rep_label|$ver_label)/) {
+        1;
+      } else {
+        $a->{LABEL} cmp $b->{LABEL} or $a->{VALUE} cmp $b->{VALUE};
+      }
+
+    }
+  } @lines;
+
+  # Add lines for specifying repository, version and source directories
+  while (my $line = shift @lines) {
+    $cfg->add_line (
+      LABEL => $line->{LABEL},
+      VALUE => $line->{VALUE},
+    );
+  }
+
+  # Add declared bld cfg entries
+  if (@{ $self->{BDECLARE} }) {
+    # Blank line
+    $cfg->add_line;
+
+    $cfg->add_comment_block ('Declared bld cfg entries');
+    for my $bdeclare (@{ $self->{BDECLARE} }) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{BDECLARE} . '::' . $bdeclare->{LABEL},
+        VALUE => $bdeclare->{VALUE},
+      );
+    }
+  }
+
+  # Print lines to config file
+  $cfg->print_cfg ($self->{DEST}{EXT_CFG});
+
+  return 1;
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_write_bld_cfg ();
+#
+# DESCRIPTION
+#   This internal method writes the build configuration file.
+# ------------------------------------------------------------------------------
+
+sub _write_bld_cfg {
+  my $self = shift;
+
+  my %cfg_labels = %{ $self->config->setting ('CFG_LABEL') };
+  my %subdir     = %{ $self->config->setting ('DIR') };
+  my %cfgname    = %{ $self->config->setting ('CFG_NAME') };
+
+  # Create new config file object and assign lines to it
+  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, TYPE => 'bld');
+
+  # Set up config file header
+  $cfg->add_header ();
+
+  # Pre-compile source
+  if (@{ $self->{USE} }) {
+    $cfg->add_comment_block ('Pre-compile source');
+
+    for my $reuse (@{ $self->{USE} }) {
+      my $rootdir;
+      my $bld_cfg;
+
+      if ($self->{RDEST}{MACHINE}) {
+        $rootdir = $reuse->rdest ('ROOTDIR');
+        $bld_cfg = $reuse->rdest ('BLD_CFG');
+      } else {
+        $rootdir = $reuse->dest ('ROOTDIR');
+        $bld_cfg = $reuse->dest ('BLD_CFG');
+      }
+
+      # Default location of build config file
+      my $def_bld_cfg = catfile $rootdir, $subdir{CFG}, $cfgname{BLD};
+
+      $cfg->add_line (
+        LABEL => $cfg_labels{USE},
+        VALUE => $bld_cfg eq $def_bld_cfg ? $rootdir : $bld_cfg,
+      );
+    }
+
+    # Blank line
+    $cfg->add_line;
+  }
+
+  # Add declared bld cfg entries
+  if (@{ $self->{BDECLARE} }) {
+    $cfg->add_comment_block ('Declared build options...');
+
+    my @bdeclares = sort {$a->{LABEL} cmp $b->{LABEL}} @{ $self->{BDECLARE} };
+    for my $bdeclare (@bdeclares) {
+      $cfg->add_line (
+        LABEL => $bdeclare->{LABEL},
+        VALUE => $bdeclare->{VALUE},
+      );
+    }
+
+    # Blank line
+    $cfg->add_line;
+  }
+
+  # Add source directories to config file
+  $cfg->add_comment_block ('Project directory tree');
+
+  my $dest = $self->{RDEST}{MACHINE} ? $self->{RDEST} : $self->{DEST};
+  $cfg->add_line (
+    LABEL => $cfg_labels{DIR} . '::ROOT',
+    VALUE => $dest->{ROOTDIR},
+  );
+  for my $label (qw/SRC CFG/) {
+    my $dir = $label . 'DIR';
+    if ($dest->{$dir} ne catfile $dest->{ROOTDIR}, $subdir{$label}) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{DIR} . '::' . $label,
+        VALUE => $dest->{$dir},
+      );
+    }
+  }
+
+  # Blank line
+  $cfg->add_line;
+
+  # Add source directories to config file
+  $cfg->add_comment_block ('Source directories');
+
+  $cfg->add_line (LABEL => $cfg_labels{SEARCH_SRC}, VALUE => '0',);
+  $cfg->add_line;
+
+  for my $srcdir (sort keys %{ $self->{SRCDIRS} }) {
+
+    if (-d $self->{SRCDIRS}{$srcdir}{DEST}) {
+      # Check whether pre-extracted source exists
+      my $pre_extracted = grep {
+        $_->extracted;
+      } @{ $self->{SRCDIRS}{$srcdir}{STACK} };
+
+      # Source directory
+      my $dest = undef;
+      if ($self->{RDEST}{MACHINE}) {
+        my $base = substr $self->{SRCDIRS}{$srcdir}{DEST},
+                          length ($self->{DEST}{SRCDIR}) + 1;
+        $dest    = catfile $self->{RDEST}{SRCDIR}, $base;
+      } else {
+        $dest = $self->{SRCDIRS}{$srcdir}{DEST}
+      }
+
+      # Source directory label
+      my $label = join '::', ($cfg_labels{SRCDIR}, $srcdir);
+
+      $cfg->add_line (LABEL => $label, VALUE => $dest,)
+    }
+
+  }
+
+  # Print lines to config file
+  $cfg->print_cfg ($self->{DEST}{BLD_CFG});
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_mirror_extract ();
+#
+# DESCRIPTION
+#   This internal method mirrors the current extract to a remote machine.
+# ------------------------------------------------------------------------------
+
+sub _mirror_extract {
+  my $self = shift;
+
+  # Needs mirroring only if remote machine is set
+  return unless $self->{RDEST}{MACHINE};
+
+  my $verbose = $self->config->verbose;
+
+  my $mirror = $self->config->setting (qw/TOOL MIRROR/);
+
+  if ($mirror eq 'rdist') {
+    # Use "rdist" to mirror extract
+
+    # Variable for "remote_logname@remote_machine"
+    my $rhost = $self->{RDEST}{LOGNAME} . '@' . $self->{RDEST}{MACHINE};
+
+    # Print distfile content to temporary file
+    my @distfile = ();
+    for my $my_label (qw/BLD_CFG EXT_CFG SRCDIR/) {
+      push @distfile, '( ' . $self->{DEST}{$my_label} . ' ) -> ' . $rhost . "\n";
+      push @distfile, '  install ' . $self->{RDEST}{$my_label} . ';' . "\n";
+    }
+
+    # Set up mirroring command (use "rdist" at the moment)
+    my $command = 'rdist -R';
+    $command   .= ' -q' unless $verbose > 1;
+    $command   .= ' -f - 1>/dev/null';
+
+    # Diagnostic
+    my $croak = 'Cannot execute "' . $command . '"';
+    if ($verbose > 2) {
+      print timestamp_command ($command, 'Start');
+      print '  ', $_ for (@distfile);
+    }
+
+    # Execute the mirroring command
+    open COMMAND, '|-', $command or croak $croak, ' (', $!, '), abort';
+    for my $line (@distfile) {
+      print COMMAND $line;
+    }
+    close COMMAND or croak $croak, ' (', $?, '), abort';
+
+    # Diagnostic
+    print timestamp_command ($command, 'End  ') if $verbose > 2;
+
+  } elsif ($mirror eq 'rsync') {
+    # Use "rsync" to mirror extract
+
+    my $rsh = $self->config->setting (qw/TOOL REMOTE_SHELL/);
+
+    # Variable for "remote_logname@remote_machine"
+    my $rhost = $self->{RDEST}{LOGNAME} . '@' . $self->{RDEST}{MACHINE};
+
+    for my $my_label (qw/BLD_CFG EXT_CFG SRCDIR/) {
+      my $rdir = dirname $self->{RDEST}{$my_label}; # remote container directory
+
+      {
+        # Create remote container directory with remote shell command
+        my @command = (
+          $rsh, $self->{RDEST}{MACHINE}, '-n', '-l', $self->{RDEST}{LOGNAME},
+          qw/mkdir -p/, $rdir,
+        );
+
+        # Execute command
+        &run_command (\@command, TIME => $verbose > 2);
+      }
+
+      {
+        # Build the rsync command
+        my @command = qw/rsync -a --exclude='.*' --delete-excluded/;
+        push @command, '-v' if $verbose > 2;
+        push @command, $self->{DEST}{$my_label};
+        push @command, $rhost . ':' . $rdir;
+
+        # Execute command
+        &run_command (\@command, TIME => $verbose > 2);
+      }
+    }
+
+  } else {
+    w_report $mirror, ': unknown mirroring tool, abort.';
+    return;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/ReposBranch.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/ReposBranch.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/ReposBranch.pm	(revision 6412)
@@ -0,0 +1,516 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::ReposBranch
+#
+# DESCRIPTION
+#   This class contains methods for gathering information for a repository
+#   branch. It currently supports Subversion repository and local user
+#   directory.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::ReposBranch;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+use File::Spec::Functions;
+use File::Basename;
+use File::Find;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch = Fcm::ReposBranch->new (
+#     CONFIG  => $config,
+#     PACKAGE => $package,
+#     TAG     => $tag,
+#     REPOS   => $repos,
+#     VERSION => $version,
+#     TYPE    => $type,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::ReposBranch class.
+#
+# ARGUMENTS
+#   CONFIG  - reference to a Fcm::Config instance
+#   PACKAGE - package name of which this repository belongs
+#   TAG     - "tag" name of this branch of the repository
+#   REPOS   - repository branch root URL/path
+#   VERSION - this version of the branch is used by the extract
+#   TYPE    - repository type
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG  => (exists $args{CONFIG}  ? $args{CONFIG}  : &main::cfg),
+    PACKAGE => (exists $args{PACKAGE} ? $args{PACKAGE} : undef),
+    TAG     => (exists $args{TAG}     ? $args{TAG}     : undef),
+    REPOS   => (exists $args{REPOS}   ? $args{REPOS}   : undef),
+    VERSION => (exists $args{VERSION} ? $args{VERSION} : undef),
+    TYPE    => (exists $args{TYPE}    ? $args{TYPE}    : undef),
+
+    # Use this list of directories in this branch
+    DIRS    => {},
+
+    # Expand this list of directories in this branch
+    EXPDIRS => {},
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $branch->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package = $branch->package;
+#   $branch->package ($package);
+#
+# DESCRIPTION
+#   This method returns the package name of this repository branch. If an
+#   argument is specified, the name is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub package {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PACKAGE} = shift;
+  }
+
+  return $self->{PACKAGE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $tag = $branch->tag;
+#   $branch->tag ($tag);
+#
+# DESCRIPTION
+#   This method returns the tag name of this repository branch. If an
+#   argument is specified, the name is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub tag {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TAG} = shift;
+  }
+
+  return $self->{TAG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $repos = $branch->repos;
+#   $branch->repos ($repos);
+#
+# DESCRIPTION
+#   This method returns the URL/path name of this repository branch. If an
+#   argument is specified, the URL/path is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub repos {
+  my $self = shift;
+
+  if (@_) {
+    $self->{REPOS} = shift;
+  }
+
+  return $self->{REPOS};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version= $branch->version;
+#   $branch->version ($version);
+#
+# DESCRIPTION
+#   This method returns the revision number of this repository branch. If an
+#   argument is specified, the revision is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub version {
+  my $self = shift;
+
+  if (@_) {
+    $self->{VERSION} = shift;
+  }
+
+  return $self->{VERSION};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $branch->type;
+#   $branch->type ($type);
+#
+# DESCRIPTION
+#   This method returns the repository type ("svn" or "user"). If an
+#   argument is specified, the type is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub type {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TYPE} = shift;
+  }
+
+  return $self->{TYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $branch->dir ($name);
+#   $branch->dir ($name, $dir);
+#
+# DESCRIPTION
+#   This method returns the path to the source directory with sub-package name
+#   $name. If $dir is specified, the path is set to its value.
+# ------------------------------------------------------------------------------
+
+sub dir {
+  my $self = shift;
+  my $name = shift;
+
+  if (@_) {
+    $self->{DIRS}{$name} = $_[0];
+  }
+
+  if (exists $self->{DIRS}{$name}) {
+    return $self->{DIRS}{$name};
+
+  } else {
+    return undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %dirs = $branch->dirs;
+#
+# DESCRIPTION
+#   This method returns a hash containing the source directories of this
+#   repository. The keys of the hash are the sub-package names, and the values
+#   of the hash are the URL/path to the source directories.
+# ------------------------------------------------------------------------------
+
+sub dirs {
+  my $self = shift;
+
+  return %{ $self->{DIRS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $branch->expdir ($name);
+#   $branch->expdir ($name, $dir);
+#
+# DESCRIPTION
+#   This method returns the path to the expandable source directory with
+#   sub-package name $name. If $dir is specified, the path is set to its
+#   value.
+# ------------------------------------------------------------------------------
+
+sub expdir {
+  my $self = shift;
+  my $name = shift;
+
+  if (@_) {
+    $self->{EXPDIRS}{$name} = $_[0];
+  }
+
+  if (exists $self->{EXPDIRS}{$name}) {
+    return $self->{EXPDIRS}{$name};
+
+  } else {
+    return undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %dirs = $branch->expdirs;
+#
+# DESCRIPTION
+#   This method returns a hash containing the expandable source directories of
+#   this repository. The keys of the hash are the sub-package names, and the
+#   values of the hash are the URL/path to the expandable source directories.
+# ------------------------------------------------------------------------------
+
+sub expdirs {
+  my $self = shift;
+
+  return %{ $self->{EXPDIRS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch->expand_version_tag;
+#
+# DESCRIPTION
+#   This method expands the VERSION of the current repository branch to a
+#   revision number.
+# ------------------------------------------------------------------------------
+
+sub expand_version_tag {
+  my $self = shift;
+
+  if ($self->type eq 'svn') {
+    # Expand revision keyword
+    my $rev = expand_rev_keyword (
+      REV  => $self->version,
+      URL  => $self->repos,
+      HEAD => 1,
+    );
+
+    # Find out whether the specified revision is current or not
+    if (uc ($self->version) ne 'HEAD' and $self->config->verbose > 1) {
+      # Get last commit revision
+      my $lc_rev = expand_rev_keyword (
+        REV => 'HEAD',
+        URL => $self->repos,
+      );
+
+      # Print information if used rev is less than the last commit rev
+      print 'Info: using rev ', $rev, ' of ', $self->repos,
+            ', last commit rev is ', $lc_rev, ".\n"
+        if $rev < $lc_rev;
+    }
+
+    $self->version ($rev) if $rev ne $self->version;
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    e_report $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch->expand_path;
+#
+# DESCRIPTION
+#   This method expands the relative path names of sub-directories to full
+#   path names. It returns 1 on success.
+# ------------------------------------------------------------------------------
+
+sub expand_path {
+  my $self = shift;
+
+  my $separator = $self->{CONFIG}->setting (qw/MISC DIR_SEPARATOR/);
+
+  if ($self->type eq 'svn') {
+    # SVN repository
+    # Do nothing unless there is a declared repository for this branch
+    return unless $self->{REPOS};
+
+    # Remove trailing /
+    $self->{REPOS} =~ s/$separator+$//;
+
+    # Consider all declared (expandable) sub-directories
+    for my $name (qw/DIRS EXPDIRS/) {
+      for my $dir (keys %{ $self->{$name} }) {
+        # Do nothing if declared sub-directory is quoted as a full URL
+        next if &is_url ($self->{$name}{$dir});
+
+        # Expand sub-directory to full URL
+        $self->{$name}{$dir} = $self->{REPOS} . (
+          $self->{$name}{$dir} ? ($separator . $self->{$name}{$dir}) : ''
+        );
+      }
+    }
+    # Note: "catfile" cannot be used in the above statement because it has
+    #       the tendency of removing a slash from double slashes.
+
+  } elsif ($self->type eq 'user') {
+    # Local user directories
+
+    # Expand leading ~ for all declared (expandable) sub-directories
+    for my $name (qw/DIRS EXPDIRS/) {
+      for my $dir (keys %{ $self->{$name} }) {
+        $self->{$name}{$dir} = expand_tilde $self->{$name}{$dir};
+      }
+    }
+
+    # A top directory for the source is declared
+    if ($self->{REPOS}) {
+      # Expand leading ~ for the top directory
+      $self->{REPOS} = expand_tilde $self->{REPOS};
+
+      # Get the root directory of the file system
+      my $rootdir = File::Spec->rootdir ();
+
+      # Expand top directory to absolute path, if necessary
+      $self->{REPOS} = File::Spec->rel2abs ($self->{REPOS})
+        if $self->{REPOS} !~ m/^$rootdir/;
+
+      # Remove trailing /
+      $self->{REPOS} =~ s/$separator+$//;
+
+      # Consider all declared (expandable) sub-directories
+      for my $name (qw/DIRS EXPDIRS/) {
+        for my $dir (keys %{ $self->{$name} }) {
+          # Do nothing if declared sub-directory is quoted as a full path
+          next if $self->{$name}{$dir} =~ m#^$rootdir#;
+
+          # Expand sub-directory to full path
+          $self->{$name}{$dir} = $self->{$name}{$dir}
+                               ? catfile ($self->{REPOS}, $self->{$name}{$dir})
+                               : $self->{REPOS};
+        }
+      }
+    }
+
+  } else {
+    e_report $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch->expand_all;
+#
+# DESCRIPTION
+#   This method searches the expandable source directories recursively for
+#   source directories containing regular files. These sub-directories are
+#   then added to the source directory list. The method returns total number
+#   of sub-directories to be extracted from the current repository.
+# ------------------------------------------------------------------------------
+
+sub expand_all {
+  my $self = shift;
+
+  my %dirs = ();
+
+  # Directory separator for SVN repository
+  my $separator = $self->{CONFIG}->setting (qw/MISC DIR_SEPARATOR/);
+
+  if ($self->type eq 'user') {
+    for my $rootname (keys %{ $self->{EXPDIRS} }) {
+      my %subdirs = find_srcdir $self->{EXPDIRS}{$rootname}, $rootname, '::';
+
+      for my $key (keys %subdirs) {
+        $dirs{$key} = $subdirs{$key};
+      }
+    }
+
+  } elsif  ($self->type eq 'svn') {
+    for my $rootname (keys %{ $self->{EXPDIRS} }) {
+      # Execute the "svn ls -R" command
+      my @lines   = &run_command (
+        [qw/svn ls -R/, $self->{EXPDIRS}{$rootname} . '@' . $self->{VERSION}],
+        METHOD => 'qx', TIME => $self->config->verbose > 2,
+      );
+
+      # Get list of sub-directories containing source files
+      for my $line (@lines) {
+        chomp $line;
+        next if $line =~ /$separator$/;
+
+        my $dir = dirname $line;
+
+        my @pck = split /::/, $rootname;
+        push @pck, (File::Spec->splitdir ($dir)) unless $dir eq '.';
+        my $pck = join '::', @pck;
+
+        my $val = $self->{EXPDIRS}{$rootname};
+        $val   .= $separator . $dir unless $dir eq '.';
+
+        $dirs{$pck} = $val;
+      }
+    }
+
+  } else {
+    e_report $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+  }
+
+  for my $key (keys %dirs) {
+    $self->{DIRS}{$key} = $dirs{$key};
+  }
+
+  return scalar keys %dirs;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch->add_base_dirs ($base);
+#
+# DESCRIPTION
+#   Add a list of source directories to the current branch based on the set
+#   provided by $base, which must be a reference to a Fcm::ReposBranch
+#   instance. It returns the total number of used sub-directories in the
+#   current repositories.
+# ------------------------------------------------------------------------------
+
+sub add_base_dirs {
+  my $self = shift;
+  my $base = shift;
+
+  my %base_dirs = $base->dirs;
+
+  for my $key (keys %base_dirs) {
+    # Remove repository root from base directories
+    if ($base_dirs{$key} eq $base->repos) {
+      $base_dirs{$key} = '';
+
+    } else {
+      $base_dirs{$key} = substr $base_dirs{$key}, length ($base->repos) + 1;
+    }
+
+    # Append base directories to current repository root
+    $self->dir ($key, $base_dirs{$key}); 
+  }
+
+  # Expand relative path names of sub-directories
+  $self->expand_path;
+
+  return scalar keys %{ $self->{DIRS} };
+  
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/SrcDirLayer.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/SrcDirLayer.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/SrcDirLayer.pm	(revision 6412)
@@ -0,0 +1,481 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::SrcDirLayer
+#
+# DESCRIPTION
+#   This class contains methods to manipulate the extract of a source
+#   directory from a branch of a (Subversion) repository.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::SrcDirLayer;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+use File::Spec::Functions;
+use File::Basename;
+use File::Path;
+use File::Compare;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $layer = Fcm::SrcDirLayer->new (
+#     CONFIG    => $config,
+#     NAME      => $dir,
+#     PACKAGE   => $package,
+#     TAG       => $tag,
+#     LOCATION  => $loc,
+#     REPOSROOT => $repos,
+#     VERSION   => $ver,
+#     TYPE      => $type,
+#     COMMIT    => $com,
+#     EXTRACTED => $ext,
+#     CACHEDIR  => $cac,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::SrcDirLayer class.
+#
+# ARGUMENTS
+#   CONFIG    - reference to a Fcm::Config instance
+#   NAME      - sub-package name of the source directory
+#   PACKAGE   - top level package name of which the current repository belongs
+#   TAG       - package/revision tag of the current repository branch
+#   LOCATION  - location of the source directory in the branch
+#   REPOSROOT - repository root URL
+#   VERSION   - revision of the repository branch
+#   TYPE      - type of the repository branch ("svn" or "user")
+#   COMMIT    - revision at which the source directory was changed
+#   EXTRACTED - is this branch already extracted?
+#   CACHEDIR  - cache directory for this directory branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG    => (exists $args{CONFIG}    ? $args{CONFIG}    : &main::cfg),
+    NAME      => (exists $args{NAME}      ? $args{NAME}      : undef),
+    PACKAGE   => (exists $args{PACKAGE}   ? $args{PACKAGE}   : undef),
+    TAG       => (exists $args{TAG}       ? $args{TAG}       : undef),
+    LOCATION  => (exists $args{LOCATION}  ? $args{LOCATION}  : undef),
+    REPOSROOT => (exists $args{REPOSROOT} ? $args{REPOSROOT} : undef),
+    VERSION   => (exists $args{VERSION}   ? $args{VERSION}   : undef),
+    TYPE      => (exists $args{TYPE}      ? $args{TYPE}      : undef),
+    COMMIT    => (exists $args{COMMIT}    ? $args{COMMIT}    : undef),
+    EXTRACTED => (exists $args{EXTRACTED} ? $args{EXTRACTED} : undef),
+    CACHEDIR  => (exists $args{CACHEDIR}  ? $args{CACHEDIR}  : undef),
+
+    # List of source files in this directory branch
+    FILES     => [],
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $layer->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $layer->name;
+#   $layer->name ($name);
+#
+# DESCRIPTION
+#   This method returns the sub-package name of the current source directory.
+#   If an argument is specified, the sub-package name is set to the value of
+#   the argument.
+# ------------------------------------------------------------------------------
+
+sub name {
+  my $self = shift;
+
+  if (@_) {
+    $self->{NAME} = shift;
+  }
+
+  return $self->{NAME};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package = $layer->package;
+#   $layer->package ($package);
+#
+# DESCRIPTION
+#   This method returns the top level package name in which the current source
+#   directory belongs. If an argument is specified, the package name is set to
+#   the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub package {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PACKAGE} = shift;
+  }
+
+  return $self->{PACKAGE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $tag = $layer->tag;
+#   $layer->tag ($tag);
+#
+# DESCRIPTION
+#   This method returns the branch/revision tag of the current repository
+#   branch. If an argument is specified, the tag is set to the value of the
+#   argument.
+# ------------------------------------------------------------------------------
+
+sub tag {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TAG} = shift;
+  }
+
+  return $self->{TAG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $location = $layer->location;
+#   $layer->location ($location);
+#
+# DESCRIPTION
+#   This method returns the URL/location of the source directory in the
+#   branch. If an argument is specified, the location is set to the value of
+#   the argument.
+# ------------------------------------------------------------------------------
+
+sub location {
+  my $self = shift;
+
+  if (@_) {
+    $self->{LOCATION} = shift;
+  }
+
+  return $self->{LOCATION};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $reposroot = $layer->reposroot;
+#   $layer->reposroot ($reposroot);
+#
+# DESCRIPTION
+#   This method returns the URL/location of the repository root of this
+#   branch. If an argument is specified, the location is set to the value of
+#   the argument.
+# ------------------------------------------------------------------------------
+
+sub reposroot {
+  my $self = shift;
+
+  if (@_) {
+    $self->{REPOSROOT} = shift;
+  }
+
+  return $self->{REPOSROOT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version = $layer->version;
+#   $layer->version ($version);
+#
+# DESCRIPTION
+#   This method returns the revision number of this branch. If an argument is
+#   specified, the revision number is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub version {
+  my $self = shift;
+
+  if (@_) {
+    $self->{VERSION} = shift;
+  }
+
+  return $self->{VERSION};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $layer->type;
+#   $layer->type ($type);
+#
+# DESCRIPTION
+#   This method returns the repository type ("svn" or "user"). If an argument is
+#   specified, the type is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub type {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TYPE} = shift;
+  }
+
+  return $self->{TYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version = $layer->commit;
+#   $layer->commit ($version);
+#
+# DESCRIPTION
+#   This method returns the last modified revision of the source directory in
+#   the branch. If an argument is specified, this revision is set to the value
+#   of the argument.
+# ------------------------------------------------------------------------------
+
+sub commit {
+  my $self = shift;
+
+  if (@_) {
+    $self->{COMMIT} = shift;
+  }
+
+  return $self->{COMMIT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $extracted = $layer->extracted;
+#   $layer->extracted ($extracted);
+#
+# DESCRIPTION
+#   This method returns the "extracted flag" of the source directory branch
+#   If an argument is specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub extracted {
+  my $self = shift;
+
+  if (@_) {
+    $self->{EXTRACTED} = shift;
+  }
+
+  return $self->{EXTRACTED};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $layer->cachedir;
+#   $layer->cachedir ($dir);
+#
+# DESCRIPTION
+#   This method returns the cache directory of the source directory branch
+#   If an argument is specified, the cache directory is set to the value of
+#   the argument.
+# ------------------------------------------------------------------------------
+
+sub cachedir {
+  my $self = shift;
+
+  if (@_) {
+    my $dir = shift;
+    $self->{CACHEDIR} = $dir;
+  }
+
+  return $self->{CACHEDIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $layer->localdir;
+#
+# DESCRIPTION
+#   This method returns the user or cache directory for the current revision
+#   of the repository branch.
+# ------------------------------------------------------------------------------
+
+sub localdir {
+  my $self = shift;
+
+  return $self->user ? $self->{LOCATION} : $self->{CACHEDIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @files = $layer->files;
+#
+# DESCRIPTION
+#   This method returns a list of regular files in this directory branch.
+#   This method should only be called after a successful operation of the
+#   get_files method that will be described below.
+# ------------------------------------------------------------------------------
+
+sub files {
+  my $self = shift;
+
+  return @{ $self->{FILES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $user = $layer->user;
+#
+# DESCRIPTION
+#   This method returns the string "user" if the current source directory
+#   branch is a local directory. Otherwise, it returns "undef".
+# ------------------------------------------------------------------------------
+
+sub user {
+  my $self = shift;
+
+  return $self->{TYPE} eq 'user' ? 'user' : undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version = $layer->get_commit;
+#
+# DESCRIPTION
+#   If the current repository type is "svn", this method attempts to obtain
+#   the revision in which the branch is last committed. On a successful
+#   operation, it returns this revision number. Otherwise, it returns
+#   "undef".
+# ------------------------------------------------------------------------------
+
+sub get_commit {
+  my $self = shift;
+
+  if ($self->type eq 'svn') {
+    # Execute the "svn info" command
+    my @lines   = &run_command (
+      [qw/svn info/, $self->{LOCATION} . '@' . $self->{VERSION}],
+      METHOD => 'qx', TIME => $self->config->verbose > 2,
+    );
+
+    my $rev;
+    for (@lines) {
+      if (/^Last\s+Changed\s+Rev\s*:\s*(\d+)/i) {
+        $rev = $1;
+        last;
+      }
+    }
+
+    # Commit version of this source directory
+    $self->{COMMIT} = $rev;
+
+    return $self->{COMMIT};
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    e_report 'Repository type "', $self->type, '" not supported.';
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $layer->update_cache;
+#
+# DESCRIPTION
+#   If the current repository type is "svn", this method attempts to extract
+#   the current version source directory from the current branch from the
+#   repository, sending the output to the cache directory. It returns true on
+#   a successful operation, or false if the repository is not of type "svn".
+# ------------------------------------------------------------------------------
+
+sub update_cache {
+  my $self = shift;
+
+  return unless $self->{CACHEDIR};
+
+  # Create cache extract destination, if necessary
+  my $dirname = dirname $self->{CACHEDIR};
+  mkpath $dirname if not -d $dirname;
+
+  e_report $dirname, ': cannot write to cache, abort.'
+    unless -d $dirname and -w $dirname;
+  
+  if ($self->type eq 'svn') {
+    # Set up the extract command, "svn export --force -q -N"
+    my @command = (
+      qw/svn export --force -q -N/,
+      $self->{LOCATION} . '@' . $self->{VERSION},
+      $self->{CACHEDIR},
+    );
+
+    &run_command (\@command, TIME => $self->config->verbose > 2);
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    e_report 'Repository type "', $self->type, '" not supported.';
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @files = $layer->get_files;
+#
+# DESCRIPTION
+#   This method returns a list of files in the cache or local user directory
+#   of the current version of the source directory in the current branch.
+# ------------------------------------------------------------------------------
+
+sub get_files {
+  my $self = shift;
+
+  # Get a list of files in the cache (or local user) directory
+  my @files = ();
+
+  opendir (DIR, $self->localdir)
+    or die $self->localdir, ': cannot read directory';
+
+  while (my $file = readdir DIR) {
+    next if $file =~ /^\.\.?/;                   # ignore . and .. and hidden
+    next if $file =~ /~$/;                       # ignore emacs swap files
+    next if -d catfile ($self->localdir, $file); # ignore sub-directories
+    push @files, $file;
+  }
+  closedir DIR;
+
+  # Return the (base name) of the list of files
+  $self->{FILES} = \@files;
+  return @files;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/SrcFile.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/SrcFile.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/SrcFile.pm	(revision 6412)
@@ -0,0 +1,1538 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::SrcFile
+#
+# DESCRIPTION
+#   This class contains methods to manipulate the build process of a source
+#   file of supported type.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::SrcFile;
+
+# Standard pragma
+
+use strict;
+use warnings;
+
+# Standard modules
+use Cwd;
+use Carp;
+use File::Basename;
+use File::Spec;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::Timer;
+
+# Other modules
+use Ecmwf::Fortran90_stuff ();
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcfile = Fcm::SrcFile->new (
+#     CONFIG     => $config,
+#     SRCPACKAGE => $srcpackage,
+#     SRC        => $src,
+#     PPSRC      => $ppsrc,
+#     TYPE       => $type,
+#     SCAN       => $scan,
+#     EXEBASE    => $exebase,
+#     PCKCFG     => $pckcfg,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::SrcFile class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   SRCPACKAGE - reference to the container Fcm::SrcPackage instance
+#   SRC        - source path of this file
+#   PPSRC      - pre-processed source path of this file
+#   TYPE       - type flag of this source file
+#   SCAN       - scan source file for dependency?
+#   EXEBASE    - name of executable
+#   PCKCFG     - this source file is modified by a package cfg?
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG     => exists $args{CONFIG}     ? $args{CONFIG}     : &main::cfg,
+    SRCPACKAGE => exists $args{SRCPACKAGE} ? $args{SRCPACKAGE} : undef,
+    SRC        => exists $args{SRC}        ? $args{SRC}        : undef,
+    PPSRC      => exists $args{PPSRC}      ? $args{PPSRC}      : undef,
+    TYPE       => exists $args{TYPE}       ? $args{TYPE}       : undef,
+    SCAN       => exists $args{SCAN}       ? $args{SCAN}       : 1,
+    EXEBASE    => exists $args{EXEBASE}    ? $args{EXEBASE}    : undef,
+    PCKCFG     => exists $args{PCKCFG}     ? $args{PCKCFG}     : undef,
+
+    PROGNAME   => undef,
+    LANG       => undef,
+    DEP        => {}, 
+    RULES      => {},
+  };
+  bless $self, $class;
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $srcfile->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcpackage = $srcfile->srcpackage;
+#   $srcfile->srcpackage ($srcpackage);
+#
+# DESCRIPTION
+#   This method returns the reference to the container Fcm::SrcPackage of this
+#   source file. If an argument is specified, the reference is set to the
+#   value of the argument.
+# ------------------------------------------------------------------------------
+
+sub srcpackage {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SRCPACKAGE} = shift;
+  }
+
+  return $self->{SRCPACKAGE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $src = $srcfile->src;
+#   $srcfile->src ($src);
+#
+# DESCRIPTION
+#   This method returns the reference to the location of this source file. If
+#   an argument is specified, the location is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub src {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SRC} = shift;
+  }
+
+  return $self->{SRC};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ppsrc = $srcfile->ppsrc;
+#   $srcfile->ppsrc ($ppsrc);
+#
+# DESCRIPTION
+#   This method returns the reference to the location of the pre-processed
+#   file of this source file. If an argument is specified, the location is set
+#   to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub ppsrc {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PPSRC} = shift;
+  }
+
+  return $self->{PPSRC};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $time = $srcfile->mtime;
+#
+# DESCRIPTION
+#   This method returns the last modified time of the source file. If a
+#   pre-processed version of the source file exists, it returns the last
+#   modified time of the pre-processed source file instead.
+# ------------------------------------------------------------------------------
+
+sub mtime {
+  my $self = shift;
+
+  return $self->{PPSRC} ? (stat $self->{PPSRC})[9] : (stat $self->{SRC})[9];
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $srcfile->base;
+#
+# DESCRIPTION
+#   This method returns the base name of the source file.
+# ------------------------------------------------------------------------------
+
+sub base {
+  my $self = shift;
+
+  return basename ($self->{SRC});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ppbase = $srcfile->ppbase;
+#
+# DESCRIPTION
+#   This method returns the base name of the pre-processed source file.
+# ------------------------------------------------------------------------------
+
+sub ppbase {
+  my $self = shift;
+
+  return basename ($self->{PPSRC});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $interfacebase = $srcfile->interfacebase;
+#
+# DESCRIPTION
+#   This method returns the base name of the F9X interface file.
+# ------------------------------------------------------------------------------
+
+sub interfacebase {
+  my $self   = shift;
+  my $return = undef;
+
+  if ($self->is_type_or (qw/FORTRAN FPP/) and
+      uc ($self->select_tool ('GENINTERFACE')) ne 'NONE' and
+      not $self->is_type_or (qw/PROGRAM MODULE/)) {
+
+    my $flag = lc ($self->select_tool ('INTERFACE'));
+    my $ext  = $self->config->setting (qw/OUTFILE_EXT INTERFACE/);
+
+    $return = ($flag eq 'program' ? $self->intname : $self->root) . $ext;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $root = $srcfile->root;
+#
+# DESCRIPTION
+#   This method returns the root name (i.e. base name without file extension)
+#   of the source file.
+# ------------------------------------------------------------------------------
+
+sub root {
+  my $self = shift;
+
+  (my $root = $self->base) =~ s/\.\w+$//;
+
+  return $root;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext = $srcfile->ext;
+#
+# DESCRIPTION
+#   This method returns the file extension of the source file.
+# ------------------------------------------------------------------------------
+
+sub ext {
+  my $self = shift;
+
+  return substr $self->base, length ($self->root);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ppext = $srcfile->ppext;
+#
+# DESCRIPTION
+#   This method returns the file extension of the pre-processed source file.
+# ------------------------------------------------------------------------------
+
+sub ppext {
+  my $self = shift;
+
+  return substr $self->ppbase, length ($self->root);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $srcfile->dir;
+#
+# DESCRIPTION
+#   This method returns the dir name of the source file.
+# ------------------------------------------------------------------------------
+
+sub dir {
+  my $self = shift;
+
+  return dirname ($self->{SRC});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ppdir = $srcfile->ppdir;
+#
+# DESCRIPTION
+#   This method returns the dir name of the pre-processed source file.
+# ------------------------------------------------------------------------------
+
+sub ppdir {
+  my $self = shift;
+
+  return dirname ($self->{PPSRC});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $progname = $srcfile->progname();
+#   $srcfile->progname ($progname);
+#
+# DESCRIPTION
+#   This method returns the name of the first program unit in a Fortran source
+#   file. If an argument is specified, the name is set to the value of the
+#   argument.
+# ------------------------------------------------------------------------------
+
+sub progname {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PROGNAME} = $_[0];
+  }
+
+  return $self->{PROGNAME};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $intname = $srcfile->intname ();
+#
+# DESCRIPTION
+#   This method returns the internal name of the source file.
+# ------------------------------------------------------------------------------
+
+sub intname {
+  my $self = shift;
+
+  return $self->progname ? $self->progname : lc ($self->root);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $objbase = $srcfile->objbase ();
+#
+# DESCRIPTION
+#   If the source file contains a compilable procedure, this method returns
+#   the name of the object file.
+# ------------------------------------------------------------------------------
+
+sub objbase {
+  my $self   = shift;
+  my $return = undef;
+
+  if ($self->is_type ('SOURCE')) {
+    my $ext = $self->config->setting (qw/OUTFILE_EXT OBJ/);
+
+    if ($self->is_type_or (qw/FORTRAN FPP/)) {
+      $return = $self->progname . $ext if $self->progname;
+
+    } else {
+      $return = $self->intname . $ext;
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $donebase = $srcfile->donebase ();
+#
+# DESCRIPTION
+#   This method returns the DONE file for a source file containing a compilable
+#   procedure, or the IDONE file for an include file.
+# ------------------------------------------------------------------------------
+
+sub donebase {
+  my $self   = shift;
+  my $return = undef;
+
+  if ($self->is_type ('SOURCE')) {
+    if ($self->objbase and not $self->is_type ('PROGRAM')) {
+      $return = $self->intname . $self->config->setting (qw/OUTFILE_EXT DONE/);
+    }
+
+  } elsif ($self->is_type ('INCLUDE')) {
+    $return = $self->base . $self->config->setting (qw/OUTFILE_EXT IDONE/);
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $exebase = $srcfile->exebase ();
+#   $srcfile->exebase ($exebase);
+#
+# DESCRIPTION
+#   If the source file contains a compilable main program, this method returns
+#   the executable name. If an argument is specified, the executable name is
+#   set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub exebase {
+  my $self = shift;
+
+  if (@_) {
+    $self->{EXEBASE} = $_[0];
+  }
+
+  my $return;
+
+  if ($self->objbase and $self->is_type ('PROGRAM')) {
+    if ($self->config->setting ('EXE_NAME', $self->root)) {
+      $return = $self->config->setting ('EXE_NAME', $self->root);
+
+    } elsif ($self->{EXEBASE}) {
+      $return = $self->{EXEBASE};
+
+    } else {
+      $return = $self->root . $self->config->setting (qw/OUTFILE_EXT EXE/);
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $srcfile->flagsbase ([$flag]);
+#
+# DESCRIPTION
+#   If the source file contains a compilable program unit, it returns the base
+#   name of the compiler flags-file. If $flag is set, it returns the base name
+#   of the flags file as specified by $flag. The value of $flag can be:
+#     FLAGS   - compiler flags flags-file (default)
+#     PPKEYS  - pre-processor keys (i.e. macro definitions) flags-file
+#     LD      - linker flags-file
+#     LDFLAGS - linker flags flags-file
+# ------------------------------------------------------------------------------
+
+sub flagsbase {
+  my ($self, $flag) = @_;
+  $flag             = 'FLAGS' if not $flag;
+  my $return        = undef;
+
+  if ($self->is_type ('SOURCE')) {
+    if ($flag eq 'FLAGS' or $flag eq 'PPKEYS') {
+      my %src_tool = %{ $self->config->setting ('SRC_TOOL') };
+
+      if ($self->lang and exists $src_tool{$self->lang}{$flag}) {
+        $return = join ('__', (
+          $src_tool{$self->lang}{$flag}, $self->srcpackage->name, $self->root,
+        )) . $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+      }
+
+    } elsif ($self->is_type ('PROGRAM')) {
+      $return = join ('__', ($flag, $self->srcpackage->name, $self->root)) .
+                $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %dep   = $srcfile->dep;
+#   @files = $srcfile->dep ($type);
+#   $srcfile->dep (\%dep);
+#
+# DESCRIPTION
+#   This method returns the dependencies of this source file. If no argument
+#   is set, the method returns the dependency hash of this source file. The
+#   keys of the hash are the names of the files this source files depends on
+#   and the values of the hash are the dependency types of the corresponding
+#   files. If an argument is specified and the argument is a normal string,
+#   the method returns the keys of the dependency hash, which have their
+#   corresponding values equal to $type. If an argument is specified and the
+#   argument is a reference to a hash, the reference to the dependency hash of
+#   the current source file is re-set to point to the reference of this new
+#   hash.
+# ------------------------------------------------------------------------------
+
+sub dep {
+  my $self = shift;
+
+  if (@_) {
+    if (ref $_[0] eq 'HASH') {
+      $self->{DEP} = $_[0];
+
+    } else {
+      my $type = $_[0];
+      return grep {
+        $self->{DEP}{$_} eq $type;
+      } keys %{ $self->{DEP} };
+    }
+  }
+
+  return %{ $self->{DEP} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcfile->add_dep ($target, $type);
+#
+# DESCRIPTION
+#   This method adds (or modifies) a dependency to the dependency hash of the
+#   source file. The argument $type is the type of the dependency and the
+#   argument $target is the dependency target.
+# ------------------------------------------------------------------------------
+
+sub add_dep {
+  my $self = shift;
+  my ($target, $type) = @_;
+
+  $self->{DEP}{$target} = $type;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @pklist = $self->get_package_list ();
+#
+# DESCRIPTION
+#   This method returns a list of package names associated with this source
+#   file. The list begins with the top level container package to the
+#   sub-package name of the current source file.
+# ------------------------------------------------------------------------------
+
+sub get_package_list {
+  my $self = shift;
+
+  my @pknames = ();
+
+  my @packages = split /__/, $self->srcpackage->name;
+  push @packages, $self->root;
+
+  for my $i (0 .. $#packages) {
+    push @pknames, join ('__', (@packages[0 .. $i]));
+  }
+
+  return @pknames;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $pckcfg = $srcfile->pckcfg ();
+#   $srcfile->pckcfg ($pckcfg);
+#
+# DESCRIPTION
+#   This method returns the name of the flag to indicate whether this source
+#   file is modified by a package level configuration file. If an argument is
+#   specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub pckcfg {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PCKCFG} = $_[0];
+  }
+
+  return $self->{PCKCFG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $srcfile->scan ();
+#   $srcfile->scan ($flag);
+#
+# DESCRIPTION
+#   This method returns the "scan" flag that determines whether the source
+#   file needs to be scanned for dependency. If an argument is specified, the
+#   flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub scan {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SCAN} = $_[0];
+  }
+
+  return $self->{SCAN};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $srcfile->type;
+#   $srcfile->type ($type);
+#
+# DESCRIPTION
+#   This method returns the type flag of the source file. If an argument is
+#   specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub type {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TYPE} = shift;
+  }
+
+  return $self->{TYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $srcfile->is_type ($type1[, $type2, ...]);
+#
+# DESCRIPTION
+#   This method returns true if current file is a known type matching all the
+#   arguments.
+# ------------------------------------------------------------------------------
+
+sub is_type {
+  my $self    = shift;
+  my @intypes = @_;
+  my $rc      = 0;
+
+  if ($self->{TYPE}) {
+    my @types = split /::/, $self->{TYPE};
+
+    for my $intype (@intypes) {
+      $rc = grep {uc $_ eq uc $intype} @types;
+      last unless $rc;
+    }
+
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $srcfile->is_type_or ($type1[, $type2, ...]);
+#
+# DESCRIPTION
+#   This method returns true if current file is a known type matching any of
+#   the arguments.
+# ------------------------------------------------------------------------------
+
+sub is_type_or {
+  my $self    = shift;
+  my @intypes = @_;
+  my $rc      = 0;
+
+  if ($self->{TYPE}) {
+    my @types = split /::/, $self->{TYPE};
+
+    for my $intype (@intypes) {
+      $rc = grep {uc $_ eq uc $intype} @types;
+      last if $rc;
+    }
+
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $lang = $srcfile->lang ();
+#
+# DESCRIPTION
+#   This method returns the language name of the source file if it contains
+#   compilable source of a supported language.
+# ------------------------------------------------------------------------------
+
+sub lang {
+  my $self = shift;
+
+  if ((not $self->{LANG}) and $self->is_type ('SOURCE')) {
+    my %src_tool = %{ $self->config->setting ('SRC_TOOL') };
+
+    for my $key (keys %src_tool) {
+      if ($self->is_type ($key)) {
+        $self->{LANG} = $key;
+        last;
+      }
+    }
+  }
+
+  return $self->{LANG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcfile->determine_type;
+#
+# DESCRIPTION
+#   This method determines whether the source file is a type known to the
+#   build system. If so, it sets the "type" flag.
+# ------------------------------------------------------------------------------
+
+sub determine_type {
+  my $self = shift;
+
+  if (not $self->{TYPE}) {
+    # Do not set a type if the file name matches the "ignore" list
+    my @ignore = split /,/, $self->config->setting ('INFILE_IGNORE');
+
+    for (@ignore) {
+      return if $self->base eq $_;
+    }
+  }
+
+  if (not $self->{TYPE}) {
+    # Determine file type by comparing its extension with supported ones
+    my %known_ext = %{ $self->config->setting ('INFILE_EXT') };
+    my $ext       = $self->ext ? substr ($self->ext, 1) : 0;
+    $self->{TYPE} = $known_ext{$ext} if $ext and exists $known_ext{$ext};
+  }
+
+  if (not $self->{TYPE}) {
+    # Determine file type by comparing its name with known patterns
+    my %known_pat = %{ $self->config->setting ('INFILE_PAT') };
+    for my $pat (keys %known_pat) {
+      if ($self->base =~ /$pat/) {
+        $self->{TYPE} = $known_pat{$pat};
+        last;
+      }
+    }
+  }
+
+  if (-s $self->{SRC} and -T $self->{SRC} and not $self->{TYPE}) {
+    # Determine file type by inspecting its first line (text file only)
+    if (open SRC, '<', $self->{SRC}) {
+      my $line = <SRC>;
+      close SRC;
+
+      my %known_txt = %{ $self->config->setting ('INFILE_TXT') };
+      for my $txt (keys %known_txt) {
+        if ($line =~ /^#!.*$txt/) {
+          $self->{TYPE} = $known_txt{$txt};
+          last;
+        }
+      }
+    }
+  }
+
+  if ($self->is_type_or (qw/FORTRAN FPP/)) {
+    # Determine whether source file is a main Fortran program or module
+    if (open SRC, '<', $self->{SRC}) {
+      while (my $line = <SRC>) {
+        if ($line =~ /^\s*(PROGRAM|MODULE)\b/i) {
+          $self->{TYPE} = $self->{TYPE} . '::' . uc ($1);
+          last;
+
+        } elsif ($line =~ /^\s*BLOCK\s*DATA\b/i) {
+          $self->{TYPE} = $self->{TYPE} . '::' . 'BLOCKDATA';
+          last;
+        }
+      }
+      close SRC;
+    }
+
+  } elsif ($self->is_type (qw/C/)) {
+    # Determine whether source file is a main C program
+    if (open SRC, '<', $self->{SRC}) {
+      while (my $line = <SRC>) {
+        next unless $line =~ /int\s*main\s*\(/i;
+        $self->{TYPE} = $self->{TYPE} . '::PROGRAM';
+        last;
+      }
+      close SRC;
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @pp_src = @{ $srcfile->pre_process () };
+#
+# DESCRIPTION
+#   This method invokes the pre-processor on the source file. It returns a
+#   reference to an array containing the lines of the pre-processed source if
+#   the pre-processor command succeeded.
+# ------------------------------------------------------------------------------
+
+sub pre_process {
+  my $self = shift;
+
+  # Support only Fortran and C source files
+  return unless $self->is_type_or (qw/FPP C/);
+
+  # List of include directories
+  my @inc = @{ $self->config->setting (qw/PATH INC/) };
+
+  # Build the pre-processor command according to file type
+  my $name    = $self->is_type ('FPP') ? 'FPP' : 'CPP';
+  my %tool    = %{ $self->config->setting ('TOOL') };
+
+  # The pre-processor command and its options
+  my @command = ($tool{$name});
+  my @ppflags = split /\s+/, $self->select_tool ($name . 'FLAGS');
+
+  # List of defined macros, add "-D" in front of each macro
+  my @ppkeys  = split /\s+/, $self->select_tool ($name . 'KEYS');
+  @ppkeys     = map {($tool{$name . '_DEFINE' }. $_)} @ppkeys;
+
+  # Add "-I" in front of each include directories
+  @inc        = map {($tool{$name . '_INCLUDE'}. $_)} @inc;
+
+  push @command, (@ppflags, @ppkeys, @inc, $self->base);
+
+  my $verbose = $self->config->verbose;
+  my $cwd     = cwd;
+
+  # Change to container directory of source file
+  print 'cd ', $self->dir, "\n" if $verbose > 1;
+  chdir $self->dir;
+
+  # Execute the command, getting the output lines
+  my @outlines = &run_command (
+    \@command, METHOD => 'qx', PRINT => $verbose > 1, TIME => $verbose > 2,
+  );
+
+  # Change back to original directory
+  print 'cd ', $cwd, "\n" if $self->config->verbose > 1;
+  chdir $cwd;
+
+  return \@outlines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @interface_block = @{ $srcfile->gen_interface () };
+#
+# DESCRIPTION
+#   This method invokes the Fortran 9x interface block generator to generate
+#   an interface block for the current source file. It returns a reference to
+#   an array containing the lines of the interface block.
+# ------------------------------------------------------------------------------
+
+sub gen_interface {
+  my $self = shift;
+
+  my $generator = $self->select_tool ('GENINTERFACE');
+
+  my $src      = $self->{PPSRC} ? $self->{PPSRC} : $self->{SRC};
+  my @outlines = ();
+
+  if ($generator eq 'f90aib') {
+    # Use F90AIB
+
+    # Open pipeline to interface file generator and read its output
+    my $devnull = File::Spec->devnull;
+    my $command = $generator;
+    $command   .= " <'" . $src . "'" . " 2>'" . $devnull . "'";
+    my $croak   = $command . ' failed';
+
+    print timestamp_command ($command, 'Start') if $self->config->verbose > 2;
+    open COMMAND, '-|', $command or croak $croak, ' (', $!, '), abort';
+    @outlines = readline 'COMMAND';
+    close COMMAND or croak $croak, ' (', $?, '), abort';
+    print timestamp_command ($command, 'End  ') if $self->config->verbose > 2;
+
+  } elsif ($generator eq 'ECMWF') {
+    # Use ECMWF interface generator
+  
+    # Read source file into an array
+    open FILE, '<', $src or croak 'Cannot open "', $src, '" (', $!, '), abort';
+    my @src_lines = <FILE>;
+    close FILE;
+  
+    # Process standalone subroutines and functions only
+    if (not grep /^\s*(?:program|module)\b/i, @src_lines) {
+      print timestamp_command ('Analyse: ' . $self->src, 'Start')
+        if $self->config->verbose > 2;
+
+      my @statements = ();
+      my %prog_info  = ();
+  
+      # Set name of source file
+      &Ecmwf::Fortran90_stuff::fname ($src);
+  
+      # Parse lines in source
+      &Ecmwf::Fortran90_stuff::setup_parse ();
+
+      # Expand continuation lines in source
+      &Ecmwf::Fortran90_stuff::expcont (\@src_lines, \@statements);
+  
+      # Analyse statements in source
+      $Ecmwf::Fortran90_stuff::study_called = 0;
+      &Ecmwf::Fortran90_stuff::study (\@statements, \%prog_info);
+  
+      # Source code is not a module
+      if (not $prog_info{is_module}) {
+        my @interface_block = ();
+        my @line_hash       = ();
+  
+        # Create an interface block for the program unit
+        &Ecmwf::Fortran90_stuff::create_interface_block (
+          \@statements,
+          \@interface_block,
+        );
+
+        # Put continuation lines back
+        &Ecmwf::Fortran90_stuff::cont_lines (
+          \@interface_block,
+          \@outlines,
+          \@line_hash,
+        );
+      }
+
+      print timestamp_command ('Analyse: ' . $self->src, 'End')
+        if $self->config->verbose > 2;
+    }
+
+  } elsif (uc ($generator) eq 'NONE') {
+    print $self->root, ': interface generation is switched off', "\n"
+      if $self->config->verbose > 2;
+
+  } else {
+    e_report 'Error: Unknown Fortran 9x interface generator: ', $generator, '.';
+  }
+
+  return \@outlines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $tool = $self->select_tool ($name);
+#
+# DESCRIPTION
+#   This method selects the correct "tool" for the current source file by
+#   following the name of its container package. The argument $name must be
+#   the generic name of the "tool" to be selected. The method returns the
+#   value of the selected tool.
+# ------------------------------------------------------------------------------
+
+sub select_tool {
+  my $self  = shift;
+  my $name  = shift;
+
+  return undef unless $name;
+
+  my @pknames = $self->get_package_list ();
+
+  my %tool    = %{ $self->config->setting ('TOOL') };
+
+  for my $pkname (reverse @pknames) {
+    my $cur_name = join '__', ($name, $pkname);
+    return $tool{$cur_name} if exists $tool{$cur_name};
+  }
+
+  return exists $tool{$name} ? $tool{$name} : '';
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $srcfile->scan_dependency ();
+#   $rc = $srcfile->scan_dependency (HEADER_ONLY => 1);
+#
+# DESCRIPTION
+#   This method scans the source file for dependencies. If no argument is
+#   specified, the method scans the pre-processed source file if it exists.
+#   Otherwise, the original source file is scanned. If HEADER_ONLY is
+#   specified, only pre-processing header dependencies are scanned from the
+#   source file. (The HEADER_ONLY flag should only be specified if "ppsrc" is
+#   not already specified.) This method returns the number of 1 on success.
+# ------------------------------------------------------------------------------
+
+sub scan_dependency {
+  my $self = shift;
+  my %args = @_;
+
+  my $header_only = exists $args{HEADER_ONLY} ? $args{HEADER_ONLY} : 0;
+
+  return 0 unless $self->{SCAN};
+  return 0 unless $self->{TYPE};
+
+  my $src = $self->{PPSRC} ? $self->{PPSRC} : $self->{SRC};
+  return 0 unless $src;
+
+  # Determine what dependencies are supported by this known type
+  my %types = $header_only
+              ? %{ $self->config->setting ('PP_DEP_TYPE') }
+              : %{ $self->config->setting ('DEP_TYPE') };
+
+  # List of excluded dependencies
+  my %excl_dep = %{ $self->config->setting ('EXCL_DEP') };
+
+  # Package list
+  my @pknames = $self->get_package_list ();
+
+  my @depends = ();
+  for my $key (keys %types) {
+    # Check if current file is a type of file requiring dependency scan
+    next unless $self->is_type ($key);
+    
+    # Get list of dependency type for this file
+    DEPEND: for my $depend ((split /::/, $types{$key})) {
+      # Ignore a dependency type if the dependency is in the exclude list
+      if (exists $excl_dep{$depend}) {
+        # Global exclude
+        next DEPEND if exists $excl_dep{$depend}{''};
+
+        # Sub-package exclude
+        for my $pkname (@pknames) {
+          next DEPEND if exists $excl_dep{$depend}{$pkname};
+        }
+      }
+
+      # Add to dependency list for current file
+      push @depends, $depend;
+    }
+  }
+
+  # Scan dependencies, if necessary ...
+  if (@depends) {
+    # Print diagnostic
+    print timestamp_command ('scan dependency in file: ' . $src, 'Start')
+      if $self->config->verbose > 2;
+
+    open FILE, '<', $src or croak 'Cannot open "', $src, '" (', $!, ')';
+    my @lines = readline 'FILE';
+    close FILE;
+
+    # List of dependency patterns
+    my %dep_pattern = %{ $self->config->setting ('DEP_PATTERN') };
+
+    LINE: for my $line (@lines) {
+      # Ignore empty lines
+      next LINE if $line =~ /^\s*$/;
+
+      # Fortran source, also scan for program unit name
+      if (! $header_only and ! $self->progname) {
+        if ($self->is_type ('SOURCE') and $self->is_type_or (qw/FPP FORTRAN/)) {
+          my $pfx_pttn = '(?:(?:ELEMENTAL|(?:RECURSIVE(?:\s+PURE)?|' .
+                         'PURE(?:\s+RECURSIVE)?))\s+)?';
+          my $spc_pttn = '(?:(?:CHARACTER|COMPLEX|DOUBLE\s*PRECISION|INTEGER|' .
+                         'LOGICAL|REAL|TYPE)(?:\s*\(.+\)|\s*\*\d+\s*)??\s+)?';
+
+          if ($line =~ /^\s*PROGRAM\s+(\w+)/i) {
+            # Matches the beginning of a named main program
+            $self->progname (lc $1);
+            next LINE;
+
+          } elsif ($line =~ /^\s*MODULE\s+(\w+)/i) {
+            my $keyword = $1;
+
+            if (uc ($keyword) ne 'PROCEDURE') {
+              # Matches the beginning of a module
+              $self->progname (lc $keyword);
+              next LINE;
+            }
+
+          } elsif ($line =~ /^\s*BLOCK\s*DATA\s+(\w+)/i) {
+            # Matches the beginning of a named block data program unit
+            $self->progname (lc $1);
+            next LINE;
+
+          } elsif ($line =~ /^\s*$pfx_pttn SUBROUTINE\s+(\w+)/ix) {
+            # Matches the beginning of a subroutine
+            $self->progname (lc $1);
+            next LINE;
+
+          } elsif ($line =~ /^\s*$pfx_pttn $spc_pttn FUNCTION\s+(\w+)/ix) {
+            # Matches the beginning of a function
+            $self->progname (lc $1);
+            next LINE;
+          }
+        }
+      }
+
+      # Scan known dependencies
+      for my $depend (@depends) {
+        # Check if a pattern exists for the current dependency
+        next unless exists $dep_pattern{$depend};
+
+        # Attempt to match the pattern
+        my $pattern = $dep_pattern{$depend};
+
+        if ($line =~ /$pattern/i) {
+          my $match = $1;
+
+          # $match may contain multiple items delimited by space
+          NAME: for my $name (split /\s+/, $match) {
+            # Skip dependency if it is in the exclusion list
+            my $key = uc ($depend . '::' . $name);
+
+            if (exists $excl_dep{$key}) {
+              # Exclude this dependency, in the global list
+              next NAME if exists $excl_dep{$key}{''};
+
+              # Exclude this dependency, current sub-package
+              for my $pkname (@pknames) {
+                next NAME if exists $excl_dep{$key}{$pkname};
+              }
+            }
+
+            # Add this dependency to the list
+            $self->add_dep ($name, $depend);
+          }
+
+          next LINE;
+        }
+      }
+    }
+
+    # Diagnostic messages
+    if ($self->config->verbose > 2) {
+      my $base = $self->ppsrc ? $self->ppbase : $self->base;
+
+      print $self->srcpackage->name, ': ', $base;
+      print ': scanned ', scalar (@lines), ' lines for ';
+      print 'header ' if $header_only;
+      print 'dependencies: ', scalar (keys %{ $self->{DEP} }), "\n";
+      print timestamp_command ('scan dependency in file: ' . $src, 'End');
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %rules = $srcfile->required_rules ();
+#
+# DESCRIPTION
+#   This method returns a hash in the following format:
+#     %rules = (
+#       target => {ACTION => action, DEP => [dependencies], ...},
+#       ...    => {...},
+#     );
+#   where the 1st rank keys are the available targets for building this source
+#   file, the second rank keys are ACTION and DEP. The value of ACTION is the
+#   action for building the target, which can be "COMPILE", "LOAD", "TOUCH",
+#   "CP" or "AR". The value of DEP is a refernce to an array containing a list
+#   of dependencies suitable for insertion into the Makefile.
+# ------------------------------------------------------------------------------
+
+sub required_rules {
+  my $self = shift;
+
+  if (not keys %{ $self->{RULES} }) {
+    my %outfile_ext = %{ $self->config->setting ('OUTFILE_EXT') };
+
+    if ($self->is_type (qw/SOURCE/)) {
+      # Source file
+      # ------------------------------------------------------------------------
+      # Determine the whether the language of the source file is supported
+      my %src_tool = %{ $self->config->setting ('SRC_TOOL') };
+
+      return () unless $self->lang;
+
+      # Compile object
+      # ------------------------------------------------------------------------
+      if ($self->objbase) {
+        # Depends on the source file
+        my @dep = ($self->_makerule_srcfile);
+
+        # Depends on the compiler flags flags-file
+        my @flags;
+        push @flags, ('FLAGS' )
+          if $self->flagsbase ('FLAGS' );
+        push @flags, ('PPKEYS')
+          if $self->flagsbase ('PPKEYS') and not $self->ppsrc;
+
+        push @dep, $self->flagsbase ($_) for (@flags);
+
+        # Source file dependencies
+        for my $name (sort keys %{ $self->{DEP} }) {
+          # A Fortran 9X module, lower case object file name
+          if ($self->{DEP}{$name} eq 'USE') {
+            (my $root = $name) =~ s/\.\w+$//;
+            push @dep, lc ($root) . $outfile_ext{OBJ};
+
+          # An include file
+          } elsif ($self->{DEP}{$name} =~ /^(?:INC|H|INTERFACE)$/) {
+            push @dep, $name;
+          }
+        }
+
+        $self->{RULES}{$self->objbase} = {ACTION => 'COMPILE', DEP => \@dep};
+
+        # Touch flags-files
+        # ----------------------------------------------------------------------
+        for my $flag (@flags) {
+          next unless $self->flagsbase ($flag);
+
+          $self->{RULES}{$self->flagsbase ($flag)} = {
+            ACTION => 'TOUCH',
+            DEP    => [
+              $self->srcpackage->flagsbase ($src_tool{$self->lang}{$flag}),
+            ],
+            DEST   => '$(FCM_FLAGSDIR)',
+          };
+        }
+      }
+
+      if ($self->exebase) {
+        # Link into an executable
+        # ----------------------------------------------------------------------
+        my @dep = ();
+        push @dep, $self->objbase               if $self->objbase;
+        push @dep, $self->flagsbase ('LD'     ) if $self->flagsbase ('LD'     );
+        push @dep, $self->flagsbase ('LDFLAGS') if $self->flagsbase ('LDFLAGS');
+
+        # Depends on BLOCKDATA program units, for Fortran programs
+        my %blockdata = %{ $self->config->setting ('BLOCKDATA') };
+        my @blkobj    = ();
+
+        if ($self->is_type_or (qw/FPP FORTRAN/) and keys %blockdata) {
+          # List of BLOCKDATA object files
+          if (exists $blockdata{$self->exebase}) {
+            @blkobj = keys (%{ $blockdata{$self->exebase} });
+
+          } elsif (exists $blockdata{''}) {
+            @blkobj = keys (%{ $blockdata{''} });
+          }
+
+          for my $name (@blkobj) {
+            (my $root = $name) =~ s/\.\w+$//;
+            $name = $root . $outfile_ext{OBJ};
+            push @dep, $root . $outfile_ext{DONE};
+          }
+        }
+
+        # Extra executable dependencies
+        my %exe_dep = %{ $self->config->setting ('EXE_DEP') };
+        if (keys %exe_dep) {
+          my @exe_deps;
+          if (exists $exe_dep{$self->exebase}) {
+            @exe_deps = keys (%{ $exe_dep{$self->exebase} });
+
+          } elsif (exists $exe_dep{''}) {
+            @exe_deps = keys (%{ $exe_dep{''} });
+          }
+
+          my $pattern = '\\' . $outfile_ext{OBJ} . '$';
+
+          for my $name (@exe_deps) {
+            if ($name =~ /$pattern/) {
+              # Extra dependency is an object
+              (my $root = $name) =~ s/\.\w+$//;
+              push @dep, $root . $outfile_ext{DONE};
+
+            } else {
+              # Extra dependency is a sub-package
+              my $var;
+              if ($self->config->setting ('FCM_PCK_OBJECTS', $name)) {
+                # sub-package name contains unusual characters
+                $var = $self->config->setting ('FCM_PCK_OBJECTS', $name);
+
+              } else {
+                # sub-package name contains normal characters
+                $var = $name ? join ('__', ('OBJECTS', $name)) : 'OBJECTS';
+              }
+
+              push @dep, '$(' . $var . ')';
+            }
+          }
+        }
+
+        # Source file dependencies
+        for my $name (sort keys %{ $self->{DEP} }) {
+          (my $root = $name) =~ s/\.\w+$//;
+
+          # Lowercase name for object dependency
+          $root = lc ($root) unless $self->{DEP}{$name} =~ /^(?:INC|H)$/;
+
+          # Select "done" file extension
+          if ($self->{DEP}{$name} =~ /^(?:INC|H)$/) {
+            push @dep, $name . $outfile_ext{IDONE};
+
+          } else {
+            push @dep, $root . $outfile_ext{DONE};
+          }
+        }
+
+        $self->{RULES}{$self->exebase} = {
+          ACTION => 'LOAD', DEP => \@dep, BLOCKDATA => \@blkobj,
+        };
+
+        # Touch Linker flags-file
+        # ----------------------------------------------------------------------
+        for my $flag (qw/LD LDFLAGS/) {
+          $self->{RULES}{$self->flagsbase ($flag)} = {
+            ACTION => 'TOUCH',
+            DEP    => [$self->srcpackage->flagsbase ($flag)],
+            DEST   => '$(FCM_FLAGSDIR)',
+          };
+        }
+
+      }
+
+      if ($self->donebase) {
+        # Touch done file
+        # ----------------------------------------------------------------------
+        my @dep = ($self->objbase);
+
+        for my $name (sort keys %{ $self->{DEP} }) {
+          (my $root = $name) =~ s/\.\w+$//;
+
+          # Lowercase name for object dependency
+          $root = lc ($root) unless $self->{DEP}{$name} =~ /^(?:INC|H)$/;
+
+          # Select "done" file extension
+          if ($self->{DEP}{$name} =~ /^(?:INC|H)$/) {
+            push @dep, $name . $outfile_ext{IDONE};
+
+          } else {
+            push @dep, $root . $outfile_ext{DONE};
+          }
+        }
+
+        $self->{RULES}{$self->donebase} = {
+          ACTION => 'TOUCH', DEP => \@dep, DEST => '$(FCM_DONEDIR)',
+        };
+      }
+      
+      if ($self->interfacebase) {
+        # Interface target
+        # ----------------------------------------------------------------------
+        # Source file dependencies
+        my @dep = ();
+        for my $name (sort keys %{ $self->{DEP} }) {
+          # Depends on Fortran 9X modules
+          push @dep, lc ($name) . $outfile_ext{OBJ}
+            if $self->{DEP}{$name} eq 'USE';
+        }
+
+        $self->{RULES}{$self->interfacebase} = {DEP => \@dep};
+      }
+
+    } elsif ($self->is_type ('INCLUDE')) {
+      # Copy include target
+      # ------------------------------------------------------------------------
+      my @dep = ($self->_makerule_srcfile);
+
+      for my $name (sort keys %{ $self->{DEP} }) {
+        # A Fortran 9X module, lower case object file name
+        if ($self->{DEP}{$name} eq 'USE') {
+          (my $root = $name) =~ s/\.\w+$//;
+          push @dep, lc ($root) . $outfile_ext{OBJ};
+
+        # An include file
+        } elsif ($self->{DEP}{$name} =~ /^(?:INC|H|INTERFACE)$/) {
+          push @dep, $name;
+        }
+      }
+
+      $self->{RULES}{$self->base} = {
+        ACTION => 'CP', DEP => \@dep, DEST => '$(FCM_INCDIR)',
+      };
+
+      # Touch IDONE file
+      # ------------------------------------------------------------------------
+      if ($self->donebase) {
+        my @dep = ($self->_makerule_srcfile);
+
+        for my $name (sort keys %{ $self->{DEP} }) {
+          (my $root = $name) =~ s/\.\w+$//;
+
+          # Lowercase name for object dependency
+          $root   = lc ($root) unless $self->{DEP}{$name} =~ /^(?:INC|H)$/;
+
+          # Select "done" file extension
+          if ($self->{DEP}{$name} =~ /^(?:INC|H)$/) {
+            push @dep, $name . $outfile_ext{IDONE};
+
+          } else {
+            push @dep, $root . $outfile_ext{DONE};
+          }
+        }
+
+        $self->{RULES}{$self->donebase} = {
+          ACTION => 'TOUCH', DEP => \@dep, DEST => '$(FCM_DONEDIR)',
+        };
+      }
+
+    } elsif ($self->is_type_or (qw/EXE SCRIPT/)) {
+      # Copy executable file
+      # ------------------------------------------------------------------------
+      my @dep = ($self->_makerule_srcfile);
+
+      # Depends on dummy copy file, if file is an "always build type"
+      push @dep, $self->config->setting (qw/MISC CPDUMMY/)
+        if $self->is_type_or (
+          split (/,/, $self->config->setting ('ALWAYS_BUILD_TYPE'))
+        );
+
+      # Depends on other executable files
+      for my $name (sort keys %{ $self->{DEP} }) {
+        push @dep, $name if $self->{DEP}{$name} eq 'EXE';
+      }
+
+      $self->{RULES}{$self->base} = {
+        ACTION => 'CP', DEP => \@dep, DEST => '$(FCM_BINDIR)',
+      };
+
+    } elsif ($self->is_type ('LIB')) {
+      # Archive object library
+      # ------------------------------------------------------------------------
+      my @dep;
+      for my $name (sort keys %{ $self->{DEP} }) {
+        next unless $self->{DEP}{$name} eq 'OBJ';
+
+        if ($name =~ /^\$\(\w+\)$/) {
+          # Dependency is a Makefile variable
+          push @dep, $name;
+
+        } else {
+          # Dependency is an object
+          (my $root = $name) =~ s/\.\w+$//;
+          push @dep, lc ($root) . $outfile_ext{OBJ};
+        }
+      }
+
+      $self->{RULES}{$self->base} = {ACTION => 'AR', DEP => \@dep};
+    }
+  }
+
+  return %{ $self->{RULES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $srcfile->write_makerules ();
+#
+# DESCRIPTION
+#   This method returns a string containing the "Make" rules for building the
+#   source file.
+# ------------------------------------------------------------------------------
+
+sub write_makerules {
+  my $self  = shift;
+  my $mk    = '';
+  my %rules = $self->required_rules;
+  my $nl    = " \\\n" . ' ' x 10;
+
+  for my $target (sort keys %rules) {
+    $mk .= $target . ':';
+    
+    for my $dep (@{ $rules{$target}{DEP} }) {
+      $mk .= $nl . $dep;
+    }
+
+    $mk .= "\n";
+
+    if (exists $rules{$target}{ACTION}) {
+      if ($rules{$target}{ACTION} eq 'COMPILE') {
+        if ($self->lang) {
+          $mk .= "\t" . 'fcm_internal compile:' . substr ($self->lang, 0, 1) .
+                 ' ' . $self->srcpackage->name . ' $< $@';
+          $mk .= ' 1' if ($self->flagsbase ('PPKEYS') and not $self->ppsrc);
+          $mk .= "\n";
+        }
+
+      } elsif ($rules{$target}{ACTION} eq 'LOAD') {
+        $mk .= "\t" . 'fcm_internal load ' . $self->srcpackage->name . ' $< $@';
+        $mk .= ' ' . join (' ', @{ $rules{$target}{BLOCKDATA} })
+          if @{ $rules{$target}{BLOCKDATA} };
+        $mk .= "\n";
+
+      } elsif ($rules{$target}{ACTION} eq 'TOUCH') {
+        $mk .= "\t" . 'touch ' . catfile ($rules{$target}{DEST}, '$@') . "\n";
+
+      } elsif ($rules{$target}{ACTION} eq 'CP') {
+        $mk .= "\t" . 'cp $< ' . $rules{$target}{DEST} . "\n";
+        $mk .= "\t" . 'chmod u+w ' . catfile ($rules{$target}{DEST}, '$@') . "\n";
+
+      } elsif ($rules{$target}{ACTION} eq 'AR') {
+        $mk .= "\t" . 'fcm_internal archive $@ $(^F)' . "\n";
+      }
+    }
+
+    $mk .= "\n";
+  }
+
+  return $mk;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $srcfile->_makerule_srcfile ();
+#
+# DESCRIPTION
+#   This internal method returns a string containing the location of the
+#   source file relative to a package source path. This string will be
+#   suitable for use in a "Make" rule file for FCM.
+# ------------------------------------------------------------------------------
+
+sub _makerule_srcfile {
+  my $self = shift;
+
+  my $return;
+  my @searchpath;
+  my $label;
+  my $dir;
+  my $base;
+
+  if ($self->ppsrc) {
+    $return     = $self->ppsrc;
+    @searchpath = $self->srcpackage->ppsearchpath;
+    $label      = 'PPSRCDIR';
+    $dir        = $self->ppdir;
+    $base       = $self->ppbase;
+
+  } else {
+    $return     = $self->src;
+    @searchpath = $self->srcpackage->searchpath;
+    $label      = 'SRCDIR';
+    $dir        = $self->dir;
+    $base       = $self->base;
+  }
+
+  $return = catfile $dir, $base;
+
+  # Use variable for directory name
+  # if container package name contains word characters only
+  if ($self->srcpackage->name =~ /^\w+$/) {
+    for my $i (0 .. $#searchpath) {
+      if ($dir eq $searchpath[$i]) {
+        my $returndir = '$(' . $label . $i . '__' . $self->srcpackage->name .
+                        ')';
+        $return = catfile $returndir, $base;
+        last;
+      }
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/SrcPackage.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/SrcPackage.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/SrcPackage.pm	(revision 6412)
@@ -0,0 +1,895 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::SrcPackage
+#
+# DESCRIPTION
+#   This is a class to process a source directory package. It uses the
+#   supplied inheritance hierarchy to obtain a list of source files of this
+#   package.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::SrcPackage;
+
+# Standard pragma
+use strict;
+use warnings;
+
+# Standard modules
+use Carp;
+use File::Spec::Functions;
+use File::Basename;
+use File::Path;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::SrcFile;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package = Fcm::SrcPackage->new (
+#     CONFIG     => $config,
+#     NAME       => $name,
+#     CURRENT    => $current,
+#     REQUIREPP  => $requirepp,
+#     NEWPP      => $newpp,
+#     SEARCHPATH => \@path,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::SrcPackage class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   NAME       - name of the source directory package
+#   CURRENT    - package declared in current build?
+#   REQUIREPP  - require pre-processing?
+#   NEWPP      - pre-process option has changed?
+#   SEARCHPATH - search path of files in the source package
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self  = {
+    CONFIG     => exists $args{CONFIG}     ? $args{CONFIG}     : &main::cfg,
+    NAME       => exists $args{NAME}       ? $args{NAME}       : undef,
+    CURRENT    => exists $args{CURRENT}    ? $args{CURRENT}    : undef,
+    REQUIREPP  => exists $args{REQUIREPP}  ? $args{REQUIREPP}  : undef,
+    NEWPP      => exists $args{NEWPP}      ? $args{NEWPP}      : undef,
+    SEARCHPATH => exists $args{SEARCHPATH} ? $args{SEARCHPATH} : [],
+
+    # Reference to Fcm::CfgFile, source package configuration file
+    CFG       => undef,
+
+    # References to Fcm::SrcFile, list of source files
+    SRCFILE   => [],
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $package->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $package->name;
+#   $package->name ($name);
+#
+# DESCRIPTION
+#   This method returns the name of this package. If an argument is specified,
+#   the name is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub name {
+  my $self = shift;
+
+  if (@_) {
+    $self->{NAME} = shift;
+  }
+
+  return $self->{NAME};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $package->current;
+#   $package->current ($flag);
+#
+# DESCRIPTION
+#   This method returns the "current" flag of the source package. If an
+#   argument is specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub current {
+  my $self = shift;
+
+  if (@_) {
+    $self->{CURRENT} = shift;
+  }
+
+  return $self->{CURRENT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $package->requirepp;
+#   $package->requirepp ($flag);
+#
+# DESCRIPTION
+#   This method returns the "require PP" flag of the source package. If an
+#   argument is specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub requirepp {
+  my $self = shift;
+
+  if (@_) {
+    $self->{REQUIREPP} = shift;
+  }
+
+  return $self->{REQUIREPP};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $package->newpp;
+#   $package->newpp ($flag);
+#
+# DESCRIPTION
+#   This method returns the flag to denote whether pre-processor option for
+#   this source package has changed. If an argument is specified, the flag is
+#   set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub newpp {
+  my $self = shift;
+
+  if (@_) {
+    $self->{NEWPP} = shift;
+  }
+
+  return $self->{NEWPP};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile = $package->cfg;
+#   $package->cfg ($cfgfile);
+#
+# DESCRIPTION
+#   This method returns a reference to a Fcm::CfgFile instance for the source
+#   package configuration file. If an argument is specified, the reference is
+#   set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  my $self = shift;
+
+  if (@_) {
+    $self->{CFG} = $_[0];
+  }
+
+  return $self->{CFG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @path = $package->searchpath;
+#   $package->searchpath (@path);
+#
+# DESCRIPTION
+#   This method returns the source file search path associated with this
+#   source package in the current build. If arguments are specified, the
+#   search path is replaced by the array in the argument list.
+# ------------------------------------------------------------------------------
+
+sub searchpath {
+  my $self = shift;
+
+  @{ $self->{SEARCHPATH} } = @_ if @_; 
+
+  return @{ $self->{SEARCHPATH} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @path = $package->ppsearchpath;
+#
+# DESCRIPTION
+#   This method returns the pre-processed source file search path associated
+#   with this source package in the current build.
+# ------------------------------------------------------------------------------
+
+sub ppsearchpath {
+  my $self = shift;
+
+  my @path = ();
+  my @name = split /__/, $self->name;
+
+  for my $ppsrcdir (@{ $self->config->setting (qw/PATH PPSRC/) }) {
+    push @path, catfile ($ppsrcdir, @name);
+  }
+
+  return @path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $package->flagsbase ($flag);
+#
+# DESCRIPTION
+#   Returns the base name of a flags-file, determined by $flag.
+# ------------------------------------------------------------------------------
+
+sub flagsbase {
+  my ($self, $flag) = @_;
+
+  return join ('__', ($flag, $self->name)) .
+         $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @srcfile = $package->srcfile;
+#
+# DESCRIPTION
+#   This method returns a list of references to Fcm::SrcFile instances
+#   associated with this package.
+# ------------------------------------------------------------------------------
+
+sub srcfile {
+  my $self = shift;
+
+  return @{ $self->{SRCFILE} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package->update_file_info ();
+#
+# DESCRIPTION
+#   This method updates the source file information of this package. Please
+#   note that information is only updated if the cache file for this package
+#   does not exist. For a package declared in the current build, the
+#   information is also updated if the cache file is out of date.
+# ------------------------------------------------------------------------------
+
+sub update_file_info {
+  my $self      = shift;
+
+  # Check if the cache file exists and up to date
+  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
+  my $cachefile = find_file_in_path ($self->_cache_basename, \@cachepath);
+
+  my $uptodate  = $cachefile ? 1 : 0;
+  if ($uptodate and $self->{CURRENT}) {
+    # Is cache file up to date compared with directory?
+    $uptodate = (stat $cachefile) [9] > (stat $self->{SEARCHPATH}[0]) [9];
+
+    # Is cache file up to date compared with each file?
+    if ($uptodate) {
+      my $dir = $self->{SEARCHPATH}[0];
+
+      if (opendir DIR, $dir) {
+        my @files = map {catfile $dir, $_} grep {!/^\.\.?/} readdir 'DIR';
+        closedir DIR;
+        $uptodate = (grep {(stat $cachefile) [9] > (stat) [9]} @files) ? 1 : 0;
+      }
+    }
+  }
+
+  # Read package source file information if it appears to be up to date
+  $uptodate = $self->_read_file_list_cache ($cachefile) if ($uptodate);
+
+  # Update package source file information if necessary
+  if (not $uptodate) {
+    # Get list of files by searching through the search path
+    my @files = ();
+    for my $dir (@{ $self->{SEARCHPATH} }) {
+      opendir DIR, $dir;
+      while (my $base = readdir 'DIR') {
+        next if $base =~ /^\./;
+
+        my $file = catfile $dir, $base;
+        next if -d $file;
+
+        push @files, $file unless grep {basename ($_) eq $base} @files;
+      }
+      closedir DIR;
+    }
+
+    # Declare new instances of source file objects
+    my @srcfile = ();
+    for my $file (@files) {
+      if (basename ($file) eq $self->config->setting (qw/CFG_NAME SRCPACKAGE/)) {
+        $self->{CFG} = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
+
+      } else {
+        my $srcfile = Fcm::SrcFile->new (
+          CONFIG     => $self->config,
+          SRC        => $file,
+          SRCPACKAGE => $self,
+        );
+
+        # Determine source file types
+        $srcfile->determine_type;
+
+        # Record files of known types
+        push @srcfile, $srcfile;
+      }
+    }
+
+    # Set each SRCFILE to reference the source file instances
+    $self->{SRCFILE} = \@srcfile;
+
+    # Decipher configuration file if necessary
+    $self->_decipher_cfg if $self->cfg;
+
+    # Write to a new cache file
+    $self->_update_file_list_cache ();
+
+    # Source package info updated. Make sure the "current" flag is set to true
+    $self->current (1);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $up_to_date = $self->_read_file_list_cache ($file);
+#
+# DESCRIPTION
+#   This internal method reads the cache $file of this package and assigns the
+#   information to the SRCFILE list. It returns true if the cache appears to
+#   be up to date.
+# ------------------------------------------------------------------------------
+
+sub _read_file_list_cache {
+  my $self = shift;
+  my $file = shift;
+
+  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
+
+  # Read from config file
+  $cfg->read_cfg;
+  my @lines = $cfg->lines;
+
+  my %filetype = ();
+  my $uptodate = 1;
+  for my $line (@lines) {
+    next unless $line->{LABEL};
+
+    # On package declared in the current build, check that file is not deleted
+    if (not -f $line->{LABEL}) {
+      $uptodate = 0;
+      last;
+    }
+
+    $filetype{$line->{LABEL}} = $line->{VALUE};
+  }
+
+  # Assign to SRCFILE list if cache file is up to date
+  if ($uptodate) {
+    my @srcfiles = ();
+
+    for my $file (sort keys %filetype) {
+      if ($filetype{$file} eq 'SRCPACKAGECFG') {
+        $self->{CFG} = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
+
+      } else {
+        my $srcfile = Fcm::SrcFile->new (
+          CONFIG     => $self->config,
+          SRC        => $file,
+          TYPE       => $filetype{$file},
+          SRCPACKAGE => $self,
+        );
+
+        push @srcfiles, $srcfile;
+      }
+    }
+
+    $self->{SRCFILE} = [@srcfiles];
+
+    $self->_decipher_cfg if $self->cfg;
+  }
+
+  return $uptodate;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_file_list_cache (\@cachepath);
+#
+# DESCRIPTION
+#   This internal method updates the cache file of this package by writing
+#   current SRCFILE information to it. The argument @cachepath must be the
+#   search path of the build cache directory.
+# ------------------------------------------------------------------------------
+
+sub _update_file_list_cache {
+  my $self      = shift;
+  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
+
+  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+  if ($self->{CFG}) {
+    $cfg->add_line (LABEL => $self->cfg->src, VALUE => 'SRCPACKAGECFG')
+  }
+
+  for my $file (@{ $self->{SRCFILE} }) {
+    $cfg->add_line (LABEL => $file->src, VALUE => $file->type);
+  }
+
+  my $cachefile = catfile $cachepath[0], $self->_cache_basename;
+  $cfg->print_cfg ($cachefile);
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $basename = $self->_cache_basename ($type);
+#
+# DESCRIPTION
+#   This internal method returns the basename of a cache file for this
+#   package. If no argument is specified, it returns the package file list
+#   cache name. Otherwise, it returns the package file dependency cache name.
+# ------------------------------------------------------------------------------
+
+sub _cache_basename {
+  my $self = shift;
+  my $type = $_[0] ? $_[0] : 'PCKFILE';
+
+  return $self->{NAME} . $self->config->setting ('CACHE', $type);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_decipher_cfg ();
+#
+# DESCRIPTION
+#   This internal method deciphers the CFG file associated with this source
+#   package.
+# ------------------------------------------------------------------------------
+
+sub _decipher_cfg {
+  my $self = shift;
+
+  $self->cfg->read_cfg;
+  my @lines = $self->cfg->lines;
+
+  my %cfg_label = %{ $self->config->setting ('CFG_LABEL') };
+
+  LINE: for my $line (@lines) {
+    my $label = $line->{LABEL};
+    my $value = $line->{VALUE};
+
+    next unless $label;
+    next if uc $label eq $cfg_label{CFGFILE}{TYPE};
+    next if uc $label eq $cfg_label{CFGFILE}{VERSION};
+
+    my ($prefix, $name) = split /::/, $label;
+
+    # Get name of file from the package cfg
+    my $srcfile;
+    if ($name) {
+      ($srcfile) = grep {$_->base eq $name} @{ $self->{SRCFILE} };
+
+      # Create new instance of Fcm::SrcFile if not already in package
+      if (not $srcfile) {
+        my $src    = find_file_in_path ($name, $self->{SEARCHPATH});
+        my $target = $name unless $src;
+
+        $srcfile   = Fcm::SrcFile->new (
+          CONFIG     => $self->config,
+          SRCPACKAGE => $self,
+          SRC        => $src ? $src : $name,
+          TARGET     => $target,
+          PCKCFG     => 1,
+        );
+        push @{ $self->{SRCFILE} }, $srcfile;
+
+      } else {
+        $srcfile->pckcfg (1);
+      }
+
+    } else {
+      w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
+               ': label "', $label, '" not recognised.';
+      next LINE;
+    }
+
+    $prefix = uc $prefix;
+    if ($prefix eq $cfg_label{TYPE}) {
+      # Type label of source file
+      $srcfile->type (uc $value);
+      $srcfile->scan (0) if $srcfile->is_type (qw/BINARY LIB/);
+      next LINE;
+
+    } elsif ($prefix eq $cfg_label{SCAN}) {
+      # Scan original file for dependency?
+      $srcfile->scan ($value);
+      next LINE;
+
+    } elsif ($prefix eq $cfg_label{TARGET}) {
+      # Name of build target for this source file
+      $srcfile->exebase ($value);
+      next LINE;
+
+    } elsif ($prefix eq $cfg_label{INTNAME}) {
+      # Program unit name of this source file
+      $srcfile->progname ($value);
+      next LINE;
+
+    } elsif ($prefix eq $cfg_label{DEP}) {
+      # Dependency of this source file
+      my ($type, $target) = split /::/, $value;
+      $srcfile->add_dep ($target, uc $type);
+      next LINE;
+
+    } else {
+      w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
+               ': label "', $label, '" not recognised.';
+      next LINE;
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package->scan_dependency ();
+#   $package->scan_dependency (HEADER_ONLY => 1);
+#
+# DESCRIPTION
+#   This method scans the dependency in each source file in this source
+#   package and updates the package dependency cache. If HEADER_ONLY is
+#   specified, it performs dependency scan for pre-processor headers only if
+#   this source package requires pre-processing.
+# ------------------------------------------------------------------------------
+
+sub scan_dependency {
+  my $self = shift;
+  my %args = @_;
+
+  # Search for include header dependencies only
+  my $header_only = exists $args{HEADER_ONLY} ? $args{HEADER_ONLY} : 0;
+
+  # Get list of source files
+  # If header dependencies only, only consider FPP, C and CPP files
+  my @srcfiles = $header_only
+                 ? grep {$_->is_type_or (qw/FPP C CPP/)} $self->srcfile
+                 : grep {$_->type} $self->srcfile;
+  return unless @srcfiles;
+
+  # Location of the cache
+  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
+  my $cachebase = $header_only
+                  ? $self->_cache_basename ('PCKPPDEPEND')
+                  : $self->_cache_basename ('PCKDEPEND');
+  my $cachefile = find_file_in_path ($cachebase, \@cachepath);
+
+  # Obtain old dependency information from cache file if it exists
+  my %dep     = ();
+  my %intname = ();
+
+  if ($cachefile) {
+    # Read the cache
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $cachefile);
+    $cfg->read_cfg;
+    my @lines = $cfg->lines;
+
+    # Get list of source file base names
+    my %srcfilebase;
+    for (@srcfiles) {
+      my $base = $_->ppsrc ? $_->ppbase : $_->base;
+      $srcfilebase{$base} = 1;
+    }
+
+    for my $line (@lines) {
+      next unless $line->{LABEL};
+
+      # Label is either INTNAME or a dependency type name
+      # For INTNAME, value is the program unit name
+      # Otherwise, value is file::dependency
+      my $type = $line->{LABEL};
+      (my $file, my $depend) = split /::/, $line->{VALUE};
+
+      # Make sure $file exists in the list of source file base names
+      next unless exists $srcfilebase{$file};
+
+      if ($type eq 'INTNAME') {
+        $intname{$file} = $depend;
+
+      } else {
+        $dep{$file}{$depend} = $type;
+      }
+    }
+  }
+
+  # If a source file is newer than the cache file, re-scan dependency for that
+  # source file.
+  my $uptodate        = $cachefile ? 1 : 0;
+  my $cachefile_mtime = $cachefile ? (stat $cachefile) [9] : undef;
+  my $count           = 0;
+
+  for my $srcfile (@srcfiles) {
+    # Check modified time of source file
+    my $srcfile_mtime = $srcfile->mtime;
+
+    # If a package config file exists and it affects the source file,
+    # compare its timestamp with that of the source file
+    if ($srcfile->pckcfg) {
+      $srcfile_mtime = $self->cfg->mtime if not defined $srcfile_mtime;
+      $srcfile_mtime = ($self->cfg->mtime > $srcfile_mtime) ? $self->cfg->mtime
+                                                            : $srcfile_mtime;
+    }
+
+    # For files requiring PP, must re-scan if PP option has changed
+    my $rescan = ($self->newpp and $srcfile->is_type_or (qw/FPP C/)) ? 1 : 0;
+
+    if ($cachefile_mtime and $cachefile_mtime > $srcfile_mtime and ! $rescan) {
+      # No need to re-scan dependency, read dependency from cache
+      my $base = ($srcfile->ppsrc ? $srcfile->ppbase : $srcfile->base);
+
+      $srcfile->progname ($intname{$base}) if $intname{$base};
+      $srcfile->dep ($dep{$base})          if $dep{$base};
+
+    } else {
+      # Rescan dependency
+      $srcfile->progname (undef);
+      my $rc = $srcfile->scan_dependency (HEADER_ONLY => $header_only);
+      my %dp = $srcfile->dep;
+
+      # Get list of dependencies for updating the cache
+      my $base = ($srcfile->ppsrc ? $srcfile->ppbase : $srcfile->base);
+
+      $intname{$base} = $srcfile->progname;
+      $dep    {$base} = \%dp;
+
+      $uptodate = 0;
+      $count++ if $rc;
+    }
+  }
+
+  # Output diagnostic, if necessary
+  if ($self->config->verbose > 1 and $count) {
+    my $out =  $self->name . ': scanned ' . $count . ' file(s) for';
+    $out   .= ' header' if $header_only;
+    $out   .= ' dependency' . "\n";
+    print $out;
+  }
+
+  # Check whether package config file is newer than the dependency cache
+  if ($uptodate and $self->cfg) {
+    $uptodate = $cachefile_mtime > $self->cfg->mtime ? 1 : 0;
+  }
+
+  if (not $uptodate) {
+    # Update dependency cache file
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+    # Program unit name of source files
+    for my $file (keys %intname) {
+      next unless $intname{$file};
+
+      $cfg->add_line (
+        LABEL => 'INTNAME',
+        VALUE => $file . '::' . $intname{$file},
+      );
+    }
+
+    # Dependencies of source files
+    for my $file (keys %dep) {
+      for my $depend (keys %{ $dep{$file} }) {
+        $cfg->add_line (
+          LABEL => $dep{$file}{$depend},
+          VALUE => $file . '::' . $depend,
+        );
+      }
+    }
+
+    # Create an empty config file if no dependency in this source package
+    $cfg->add_line unless $cfg->lines;
+
+    # Write to config file
+    my $outfile = catfile $cachepath[0], $cachebase;
+    $cfg->print_cfg ($outfile);
+  }
+
+  return not $uptodate;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $package->makerule_uptodate ();
+#
+# DESCRIPTION
+#   This method returns true if the make rule file for this source package
+#   is up to date.
+# ------------------------------------------------------------------------------
+
+sub makerule_uptodate {
+  my $self = shift;
+
+  my $return = 0;
+
+  if (not $self->newpp) {
+    # Check whether a Make rule file already exists
+    my $mkbase = $self->name . $self->config->setting (qw/OUTFILE_EXT MK/);
+    my $mkfile = find_file_in_path (
+      $mkbase,
+      $self->config->setting (qw/PATH BLD/),
+    );
+
+    # Check location of source package file type cache
+    my $pckfile = find_file_in_path (
+      $self->_cache_basename ('PCKFILE'),
+      $self->config->setting (qw/PATH CACHE/),
+    );
+
+    # Check location of source package dependency cache
+    my $pckdepend = find_file_in_path (
+      $self->_cache_basename ('PCKDEPEND'),
+      $self->config->setting (qw/PATH CACHE/),
+    );
+
+    # If make rule file exists, determine whether it is out of date
+    if ($pckdepend) {
+      if ($mkfile) {
+        my $pckfile_mt   = (stat $pckfile)  [9];
+        my $pckdepend_mt = (stat $pckdepend)[9];
+        my $mkfile_mt    = (stat $mkfile)   [9];
+
+        $return = 1 if $mkfile_mt >= $pckdepend_mt and $mkfile_mt >= $pckfile_mt;
+      }
+
+    } else {
+      $return = 1; # No cache file, no need to have a make rule
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package->write_makerule ();
+#
+# DESCRIPTION
+#   This method writes to the I<Make> rule file of the current source package.
+# ------------------------------------------------------------------------------
+
+sub write_makerule {
+  my $self = shift;
+
+  # Package Make rule header
+  my $mk = '# Automatic Make rule for ' . $self->name . "\n\n";
+
+  # Set up variable for directory name
+  # if package name contains only word characters
+  my @searchpath   = $self->searchpath;
+  my @ppsearchpath = $self->ppsearchpath;
+
+  if ($self->name =~ /^\w+$/) {
+    # Package search path
+    my %path = (SRCDIR => \@searchpath, PPSRCDIR => \@ppsearchpath);
+
+    for my $key (keys %path) {
+      my $count = 0;
+      my @dirs  = @{ $path{$key} };
+
+      for my $i (0 .. $#dirs) {
+        next unless -d $dirs[$i];
+        $mk .= $key . $i . '__' . $self->name . ' = ' . $dirs[$i] . "\n";
+        $count++;
+      }
+
+      $mk .= "\n" if $count;
+    }
+  }
+
+  my $mk_out;
+
+  # Make rules for copying data files, if necessary
+  {
+    # Get a list of files with no associated type
+    my @files = grep {not $_->type} @{ $self->{SRCFILE} };
+
+    if (@files) {
+      my $target = $self->name . $self->config->setting (qw/OUTFILE_EXT ETC/);
+      $mk_out .= $target . ' :';
+
+      # Depends on all un-typed source files
+      my $nl = " \\\n" . ' ' x 10;
+      for my $file (@files) {
+        my $dir = $file->dir;
+
+        # Use variable for directory name
+        # if package name contains only word characters
+        if ($self->name =~ /^\w+$/) {
+          for my $i (0 .. $#searchpath) {
+            if ($dir eq $searchpath[$i]) {
+              $dir = '$(SRCDIR' . $i . '__' . $self->name . ')';
+              last;
+            }
+          }
+        }
+
+        $mk_out .= $nl . catfile ($dir, $file->base);
+      }
+
+      # Depends on dummy copy file, so there will be no dependency inheritance
+      $mk_out .= $nl . $self->config->setting (qw/MISC CPDUMMY/);
+
+      # Actions for target
+      $mk_out .= "\n";
+      $mk_out .= "\t" . 'cp $^ $(FCM_ETCDIR)' . "\n";
+      $mk_out .= "\t" . 'touch ' . catfile ('$(FCM_DONEDIR)', '$@') . "\n";
+
+      $mk_out .= "\n";
+    }
+  }
+
+  # Make rules for source files
+  my @srcfiles = grep {$_->type} @{ $self->{SRCFILE} };
+  for my $srcfile (@srcfiles) {
+    $mk_out .= $srcfile->write_makerules;
+  }
+
+  # Write make rule file only if necessary
+  if ($mk_out) {
+    $mk .= $mk_out;
+
+    # Write to output file
+    my $mkbase = $self->name . $self->config->setting (qw/OUTFILE_EXT MK/);
+    my $blddir = ${ $self->config->setting (qw/PATH BLD/) }[0];
+    my $mkfile = catfile $blddir, $mkbase;
+
+    if (not -d $blddir) {
+      print 'Make directory: ', $blddir, "\n" if $self->config->verbose > 1;
+      mkpath $blddir or croak $blddir, ': cannot create directory, abort';
+    }
+
+    open OUT, '>', $mkfile
+      or croak 'Cannot open "', $mkfile, '" (', $!, '), abort';
+    print OUT $mk;
+    close OUT or croak 'Cannot close "', $mkfile, '" (', $!, '), abort';
+
+    print 'Generated: ', $mkfile, "\n" if $self->config->verbose > 1;
+
+    return 1;
+
+  } else {
+    return 0;
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Timer.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Timer.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Timer.pm	(revision 6412)
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Timer
+#
+# DESCRIPTION
+#   This is a package of timer utility used by the FCM command.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Timer;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Exports
+our (@ISA, @EXPORT, @EXPORT_OK);
+
+sub timestamp_command;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(timestamp_command);
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %cmd_start_time = (); # Command start time, (key = command, value = time)
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &Fcm::Timer::timestamp_command ($command[, $status]);
+#
+# DESCRIPTION
+#   This function returns a string adding to $command a prefix according the
+#   value of $status. If $status is not specified or does not match the word
+#   "end", the status is assumed to be "start". At "start", the prefix will
+#   contain the current timestamp. If $status is the word "end", the prefix
+#   will contain the total time taken since this function was called with the
+#   same $command at the "start" status.
+# ------------------------------------------------------------------------------
+
+sub timestamp_command {
+  (my $command, my $status) = @_;
+
+  my $prefix;
+  if ($status and $status =~ /end/i) {
+    # Status is "end", insert time taken
+    my $lapse = time () - $cmd_start_time{$command};
+    $prefix = sprintf "# Time taken: %12d s=> ", $lapse;
+
+  } else {
+    # Status is "start", insert time stamp
+    $cmd_start_time{$command} = time;
+
+    (my $sec, my $min, my $hour, my $mday, my $mon, my $year) = localtime;
+    $prefix = sprintf "# Start: %04d-%02d-%02d %02d:%02d:%02d=> ",
+              $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
+  }
+
+  return $prefix . $command . "\n";
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Util.pm
===================================================================
--- branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Util.pm	(revision 6412)
+++ branches/publications/ORCHIDEE_CN_CAN_r5698/tools/FCM_V1.2/lib/Fcm/Util.pm	(revision 6412)
@@ -0,0 +1,848 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Util
+#
+# DESCRIPTION
+#   This is a package of misc utilities used by the FCM command.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Util;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Exports
+our (@ISA, @EXPORT, @EXPORT_OK);
+
+sub expand_rev_keyword;
+sub expand_tilde;
+sub expand_url_keyword;
+sub e_report;
+sub find_srcdir;
+sub find_file_in_path;
+sub get_browser_url;
+sub get_command_string;
+sub get_rev_of_wc;
+sub get_rev_keyword;
+sub get_url_of_wc;
+sub get_url_keyword;
+sub get_wct;
+sub is_url;
+sub is_wc;
+sub print_command;
+sub run_command;
+sub svn_date;
+sub touch_file;
+sub w_report;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(
+  expand_rev_keyword
+  expand_tilde
+  expand_url_keyword
+  e_report
+  find_srcdir
+  find_file_in_path
+  get_browser_url
+  get_command_string
+  get_rev_of_wc
+  get_rev_keyword
+  get_url_of_wc
+  get_url_keyword
+  get_wct
+  is_url
+  is_wc
+  print_command
+  run_command
+  svn_date
+  touch_file
+  w_report
+);
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Basename;
+use File::Find;
+use File::Path;
+use File::Spec;
+use POSIX qw/strftime/;
+
+# FCM component modules
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %svn_info       = (); # "svn info" log, (key1 = path,
+                         # key2 = URL, Revision, Last Changed Rev)
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %srcdir = &Fcm::Util::find_srcdir ($topdir, $toppck, $join);
+#
+# DESCRIPTION
+#   Search $topdir for sub-directories containing regular files. Returns a hash
+#   with each key/value pair assigned to a unique name of the source directory
+#   and the location of the source directory. If $toppck is set the name of
+#   each source directory will be prefixed with this package name, and the
+#   search may include the $topdir in the result. If $join is set, the name of
+#   the sub-package will use $join as the delimiter of packages. Otherwise, the
+#   default double underscore '__' will be used.  Please note that all
+#   directories beginning with a ".", i.e. hidden directories, are ignored.
+# ------------------------------------------------------------------------------
+
+sub find_srcdir {
+  (my $topdir, my $toppck, my $join) = @_;
+  $join = defined ($join) ? $join : '__';
+
+  my @dirs = ();
+
+  # Locate all source directories containing regular files
+  if (-d $topdir) {
+    find (
+      sub {
+        my $dir = $File::Find::name;
+        return 0 if $dir eq $topdir and not $toppck;
+
+        if (-d $dir) {
+          # Ignore sub-directories with names beginning with .
+          if ($dir ne $topdir) {
+            my $subdir = substr ($dir, length ($topdir) + 1);
+            return 0 if grep {m/^\./} File::Spec->splitdir ($subdir);
+          }
+
+          # Read contents of directory
+          opendir DIR, $dir;
+          my @files = readdir 'DIR';
+          closedir DIR;
+
+          # Check if the directory contains one or more source file
+          my $contain_src;
+          for my $file (@files) {
+            next if $file =~ /^\./; # ignore hidden file
+
+            if (-f File::Spec->catfile ($dir, $file)) {
+              $contain_src = 1;
+              last;
+            }
+          }
+
+          push @dirs, $dir if $contain_src;
+          return 1;
+
+        } else {
+          return 0;
+        }
+      },
+
+      $topdir,
+    );
+  }
+
+  # String length of src directory name
+  my $topdir_len = length $topdir;
+
+  # Assign new source directories to current build
+  my @pck    = $toppck ? split (/$join/, $toppck) : ();
+  my %srcdir = ();
+  for my $dir (@dirs) {
+    my $name = ($dir eq $topdir) ? '' : substr $dir, $topdir_len + 1;
+    my @path = File::Spec->splitdir ($name);
+    my $key  = join $join, (@pck, @path);
+
+    $srcdir{$key} = $dir;
+  }
+
+  return %srcdir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %srcdir = &Fcm::Util::find_file_in_path ($file, \@path);
+#
+# DESCRIPTION
+#   Search $file in @path. Returns the full path of the $file if it is found
+#   in @path. Returns "undef" if $file is not found in @path.
+# ------------------------------------------------------------------------------
+
+sub find_file_in_path {
+  my ($file, $path) = @_;
+
+  for my $dir (@$path) {
+    my $full_file = File::Spec->catfile ($dir, $file);
+    return $full_file if -e $full_file;
+  }
+
+  return undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $expanded_path = &Fcm::Util::expand_tilde ($path);
+#
+# DESCRIPTION
+#   Returns an expanded path if $path is a path that begins with a tilde (~).
+# ------------------------------------------------------------------------------
+
+sub expand_tilde {
+  my $file = $_[0];
+
+  $file =~ s#^~([^/]*)#$1 ? (getpwnam $1)[7] : ($ENV{HOME} || $ENV{LOGDIR})#ex;
+
+  return $file;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &Fcm::Util::touch_file ($file);
+#
+# DESCRIPTION
+#   Touch $file if it exists. Create $file if it does not exist. Return 1 for
+#   success or 0 otherwise.
+# ------------------------------------------------------------------------------
+
+sub touch_file {
+  my $file = $_[0];
+  my $rc   = 1;
+
+  if (-e $file) {
+    my $now = time;
+    $rc = utime $now, $now, $file;
+
+  } else {
+    mkpath dirname ($file) unless -d dirname ($file);
+
+    $rc = open FILE, '>', $file;
+    $rc = close FILE if $rc;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $new_url = &Fcm::Util::expand_url_keyword (URL => $url[, CFG => $cfg]);
+#
+# DESCRIPTION
+#   Expand URL if its begins with a pre-defined pattern followed by a keyword
+#   that can be found in the setting of CFG. If URL is a genuine URL, the
+#   function also attempts to expand any . or .. in the path. If CFG is not
+#   set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub expand_url_keyword {
+  my %args = @_;
+  my $url  = $args{URL};
+  my $cfg  = exists $args{CFG} ? $args{CFG} : &main::cfg;
+
+  # Prefix for URL keyword
+  my $prefix = $cfg->setting (qw/MISC EXPURL_PREFIX/);
+
+  # Pattern for URL keyword
+  my $pattern = '^' . $prefix . '([^/]+)';
+
+  # Standard suffix for URL keyword
+  my %suffix_value = (tr => 'trunk', br => 'branches', tg => 'tags');
+
+  # URL matches pattern?
+  if ($url =~ /$pattern/) {
+    my $keyword = $1;
+
+    # Determine whether keyword is registered.
+    my $keyval = $cfg->setting ('URL', uc ($keyword));
+
+    if ((not $keyval) and $keyword =~ s/[-_](tr|br|tg)$//) {
+      # Keyword is not registered, but it matches a standard suffix
+      my $suffix = $suffix_value{$1};
+
+      $keyval = $cfg->setting ('URL', uc ($keyword)) . '/' . $suffix
+        if $cfg->setting ('URL', uc ($keyword));
+    }
+
+    # Expand if keyword is registered
+    $url =~ s/$pattern/$keyval/ if $keyval;
+  }
+
+  # Expand . and ..
+  if (&is_url ($url)) {
+    while ($url =~ s#/+\.(?:/+|$)#/#g) {next}
+    while ($url =~ s#/+[^/]+/+\.\.(?:/+|$)#/#g) {next}
+  }
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &Fcm::Util::get_url_keyword (URL => $url[, CFG => $cfg]);
+#
+# DESCRIPTION
+#   Return a FCM URL keyword if URL matches a registered project URL or undef
+#   otherwise. If CFG is not set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub get_url_keyword {
+  my %args = @_;
+  my $url  = $args{URL};
+  my $cfg  = exists $args{CFG} ? $args{CFG} : &main::cfg;
+
+  my $return;
+
+  for my $key (%{ $cfg->setting ('URL') }) {
+    my $value = $cfg->setting ('URL', $key);
+    next unless defined $value;
+    next unless $url =~ s#^$value(?:/+|$)##;
+
+    $return = $cfg->setting (qw/MISC EXPURL_PREFIX/) . $key .
+              ($url ? '/' . $url : '');
+    last;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $new_rev = &Fcm::Util::expand_rev_keyword (
+#     REV  => $rev,
+#     URL  => $url,
+#    [HEAD => $flag,]
+#    [CFG  => $cfg,]
+#  );
+#
+# DESCRIPTION
+#   Expand REV if URL is a known URL in CFG setting and REV matches a revision
+#   keyword of this URL, or if REV is "HEAD". SVN revision numbers, date and
+#   other keywords are ignored. HEAD should only be specified if REV has the
+#   value "HEAD". If HEAD is specified and is true, the return value of the
+#   function will be the operative revision number of the HEAD revision.
+#   Otherwise, the last commit revision will be returned. If CFG is not set,
+#   it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub expand_rev_keyword {
+  my %args = @_;
+  my $rev  = $args{REV};
+  my $url  = $args{URL};
+  my $head = exists $args{HEAD} ? $args{HEAD} : undef;
+  my $cfg  = exists $args{CFG } ? $args{CFG } : &main::cfg;
+
+  if (uc ($rev) eq 'HEAD') {
+    # Expand HEAD revision
+    &_invoke_svn_info (PATH => $url, CFG => $cfg) unless exists $svn_info{$url};
+    my $expanded_rev = $head
+                     ? $svn_info{$url}{Revision}
+                     : $svn_info{$url}{'Last Changed Rev'};
+
+    &w_report ($url, ': cannot determine HEAD revision.')
+      if $cfg->verbose > 1 and not $expanded_rev;
+
+    $rev = $expanded_rev if $expanded_rev;
+
+  } elsif ($rev !~ /^(?:\d+|BASE|COMMITTED|PREV|\{.+\})$/i) {
+    # Expand revision keyword, if required
+
+    # Get configuration settings
+    my %keywords  = %{ $cfg->setting (qw/REVISION/) };
+    my $separator = $cfg->setting (qw/MISC DIR_SEPARATOR/);
+
+    my $name      = '';
+
+    # Find out whether URL matches a registered repository
+    for my $keyword (keys %keywords) {
+      my $repos = $cfg->setting ('URL', uc ($keyword));
+      next unless $repos;
+
+      if ($url =~ m#^$repos(?:$separator|$)#) {
+        $name = $keyword;
+        last;
+      }
+    }
+
+    # If revision keyword exists for the registered repository, expand it
+    if ($name and exists $keywords{$name}{uc ($rev)}) {
+      $rev = $keywords{$name}{uc ($rev)};
+
+    } else {
+      &e_report (
+        $rev, ': revision keyword not found for ', $url,
+        ' in FCM configuration file, abort.',
+      );
+    }
+  }
+
+  return $rev;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $keyword = Fcm::Util::get_rev_keyword (
+#     REV => $rev,
+#     URL => $url,
+#    [CFG => $cfg,]
+#  );
+#
+# DESCRIPTION
+#   Returns a revision keyword if URL is a known URL in CFG setting and REV is
+#   a revision number that matches a revision keyword of this URL. Otherwise,
+#   it returns REV unchanged. If CFG is not set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub get_rev_keyword {
+  my %args = @_;
+  my $rev  = $args{REV};
+  my $url  = $args{URL};
+  my $cfg  = exists $args{CFG} ? $args{CFG} : &main::cfg;
+
+  if ($rev =~ /^\d+$/) {
+    # Get revision keyword, if REV is a revision number
+
+    # Get configuration settings
+    my %keywords  = %{ $cfg->setting (qw/REVISION/) };
+    my $separator = $cfg->setting (qw/MISC DIR_SEPARATOR/);
+
+    my $name      = '';
+
+    # Find out whether URL matches a registered repository
+    for my $keyword (keys %keywords) {
+      my $repos = $cfg->setting ('URL', uc ($keyword));
+      next unless $repos;
+
+      if ($url =~ m#^$repos(?:$separator|$)#) {
+        $name = $keyword;
+        last;
+      }
+    }
+
+    # If revision keyword for REV exists for the registered repository, get it
+    if ($name and exists $keywords{$name} and ref $keywords{$name} eq 'HASH') {
+      for my $key (keys %{ $keywords{$name} }) {
+        if ($rev eq $keywords{$name}{$key}) {
+          $rev = $key;
+          last;
+        }
+      }
+    }
+  }
+
+  return $rev;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $browser_url = Fcm::Util::get_browser_url (
+#     URL => $url,
+#    [CFG => $cfg,]
+#  );
+#
+# DESCRIPTION
+#   Returns a web address for browsing URL from Trac if URL is a known URL in
+#   CFG setting, and that it is a matching web address. Otherwise, it returns
+#   "undef". If CFG is not set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub get_browser_url {
+  my %args        = @_;
+  my $url         = $args{URL};
+  my $cfg         = exists $args{CFG} ? $args{CFG} : &main::cfg;
+  my $browser_url = undef;
+
+  # Get configuration settings
+  my %keywords  = %{ $cfg->setting (qw/TRAC/) };
+  my $separator = $cfg->setting (qw/MISC DIR_SEPARATOR/);
+
+  my $name  = '';
+  my $trail = '';
+
+  # Find out whether URL matches a registered repository
+  for my $keyword (keys %keywords) {
+    my $repos = $cfg->setting ('URL', uc ($keyword));
+    next unless $repos;
+
+    if ($url =~ m#^$repos(?:$separator(.*$)|$)#) {
+      $name  = $keyword;
+      $trail = $1 if $1;
+      last;
+    }
+  }
+
+  # If TRAC web address exists for the registered repository, get it
+  if ($name and exists $keywords{$name}) {
+    $browser_url  = $keywords{$name};
+    $browser_url .= $separator . $trail if $trail;
+  }
+
+  return $browser_url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = &is_wc ([$path]);
+#
+# DESCRIPTION
+#   Returns true if current working directory (or $path) is a Subversion
+#   working copy.
+# ------------------------------------------------------------------------------
+
+sub is_wc {
+  my $path = @_ ? $_[0] : cwd ();
+
+  if (-d $path) {
+    return (-e File::Spec->catfile ($path, qw/.svn format/)) ? 1 : 0;
+
+  } elsif (-f $path) {
+    return (-e File::Spec->catfile (dirname ($path), qw/.svn format/)) ? 1 : 0;
+
+  } else {
+    return 0;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = &is_url ($url);
+#
+# DESCRIPTION
+#   Returns true if $url is a URL.
+# ------------------------------------------------------------------------------
+
+sub is_url {
+  # This should handle URL beginning with svn://, http:// and svn+ssh://
+  return ($_[0] =~ m#^[\+\w]+://#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_wct ([$dir]);
+#
+# DESCRIPTION
+#   If current working directory (or $dir) is a Subversion working copy,
+#   returns the top directory of this working copy; otherwise returns an empty
+#   string.
+# ------------------------------------------------------------------------------
+
+sub get_wct {
+  my $dir = @_ ? $_[0] : cwd ();
+
+  return '' if not &is_wc ($dir);
+
+  my $updir = dirname $dir;
+  while (&is_wc ($updir)) {
+    $dir   = $updir;
+    $updir = dirname $dir;
+    last if $updir eq $dir;
+  }
+
+  return $dir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_url_of_wc ([$path[, $refresh]]);
+#
+# DESCRIPTION
+#   If current working directory (or $path) is a Subversion working copy,
+#   returns the URL of the associated Subversion repository; otherwise returns
+#   an empty string. If $refresh is specified, do not use the cached
+#   information.
+# ------------------------------------------------------------------------------
+
+sub get_url_of_wc {
+  my $path    = @_ ? $_[0] : cwd ();
+  my $refresh = exists $_[1] ? $_[1] : 0;
+  my $url  = '';
+
+  if (&is_wc ($path)) {
+    delete $svn_info{$path} if $refresh;
+    &_invoke_svn_info (PATH => $path) unless exists $svn_info{$path};
+    $url = $svn_info{$path}{URL};
+  }
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &_invoke_svn_info (PATH => $path, [CFG => $cfg]);
+#
+# DESCRIPTION
+#   The function is internal to this module. It invokes "svn info" on $path to
+#   gather information on URL, Revision and Last Changed Rev. The information
+#   is stored in a hash table at the module level, so that the information can
+#   be re-used. If CFG is not set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub _invoke_svn_info {
+  my %args = @_;
+  my $path = $args{PATH};
+  my $cfg  = exists $args{CFG} ? $args{CFG} : &main::cfg;
+
+  return if exists $svn_info{$path};
+
+  # Invoke "svn info" command
+  my @info = &run_command (
+    [qw/svn info/, $path],
+    PRINT => $cfg->verbose > 2, METHOD => 'qx', DEVNULL => 1, ERROR => 'ignore',
+  );
+  for (@info) {
+    chomp;
+
+    if (/^(URL|Revision|Last Changed Rev):\s*(.+)$/) {
+      $svn_info{$path}{$1} = $2;
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_command_string ($cmd);
+#   $string = &get_command_string (\@cmd);
+#
+# DESCRIPTION
+#   The function returns a string by converting the list in @cmd or the scalar
+#   $cmd to a form, where it can be executed as a shell command.
+# ------------------------------------------------------------------------------
+
+sub get_command_string {
+  my $cmd    = $_[0];
+  my $return = '';
+
+  if (ref ($cmd) and ref ($cmd) eq 'ARRAY') {
+    # $cmd is a reference to an array
+
+    # Print each argument
+    for my $i (0 .. @{ $cmd } - 1) {
+      my $arg = $cmd->[$i];
+
+      $arg =~ s/./*/g if $i > 0 and $cmd->[$i - 1] eq '--password';
+
+      if ($arg =~ /[\s'"*?]/) {
+        # Argument contains a space, quote it
+        if (index ($arg, "'") >= 0) {
+          # Argument contains an apostrophe, quote it with double quotes
+          $return .= ($i > 0 ? ' ' : '') . '"' . $arg . '"';
+
+        } else {
+          # Otherwise, quote argument with apostrophes
+          $return .= ($i > 0 ? ' ' : '') . "'" . $arg . "'";
+        }
+
+      } else {
+        # Argument does not contain a space, just print it
+        $return .= ($i > 0 ? ' ' : '') . ($arg eq '' ? "''" : $arg);
+      }
+    }
+
+  } else {
+    # $cmd is a scalar, just print it "as is"
+    $return = $cmd;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &print_command ($cmd);
+#   &print_command (\@cmd);
+#
+# DESCRIPTION
+#   The function prints the list in @cmd or the scalar $cmd, as it would be
+#   executed by the shell.
+# ------------------------------------------------------------------------------
+
+sub print_command {
+  my $cmd = $_[0];
+
+  print '=> ', &get_command_string ($cmd) , "\n";
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @return = &run_command (\@cmd, <OPTIONS>);
+#   @return = &run_command ($cmd , <OPTIONS>);
+#
+# DESCRIPTION
+#   This function executes the command in the list @cmd or in the scalar $cmd.
+#   The remaining are optional arguments in a hash table. Valid options are
+#   listed below. If the command is run using "qx", the function returns the
+#   standard output from the command. If the command is run using "system", the
+#   function returns true on success. By default, the function dies on failure.
+#
+# OPTIONS
+#   METHOD  => $method - this can be "system", "exec" or "qx". This determines
+#                        how the command will be executed. If not set, the
+#                        default is to run the command with "system".
+#   PRINT   => 1       - if set, print the command before executing it.
+#   ERROR   => $flag   - this should only be set if METHOD is set to "system"
+#                        or "qx". The $flag can be "die" (default), "warn" or
+#                        "ignore". If set to "die", the function dies on error.
+#                        If set to "warn", the function issues a warning on
+#                        error, and the function returns false. If set to
+#                        "ignore", the function returns false on error.
+#   RC      => 1       - if set, must be a reference to a scalar, which will be
+#                        set to the return code of the command.
+#   DEVNULL => 1       - if set, re-direct STDERR to /dev/null before running
+#                        the command.
+#   TIME    => 1       - if set, print the command with a timestamp before
+#                        executing it, and print the time taken when it
+#                        completes. This option supersedes the PRINT option.
+# ------------------------------------------------------------------------------
+
+sub run_command {
+  my $cmd     = shift;
+  my %options = @_;
+  my $method  = exists $options{METHOD}  ? $options{METHOD}  : 'system';
+  my $print   = exists $options{PRINT}   ? $options{PRINT}   : undef;
+  my $error   = exists $options{ERROR}   ? $options{ERROR}   : 'die';
+  my $rc      = exists $options{RC}      ? $options{RC}      : undef;
+  my $devnull = exists $options{DEVNULL} ? $options{DEVNULL} : undef;
+  my $time    = exists $options{TIME}    ? $options{TIME}    : undef;
+  my @return  = ();
+
+  # Check that the $error flag is set correctly
+  $error = 'die' unless $error =~ /^(?:die|warn|ignore)$/i;
+
+  # Print the command before execution, if necessary
+  if ($time) {
+    print &timestamp_command (&get_command_string ($cmd));
+
+  } elsif ($print) {
+    &print_command ($cmd);
+  }
+
+  # Re-direct to /dev/null if necessary
+  if ($devnull) {
+    $devnull = File::Spec->devnull;
+
+    # Save current STDERR
+    no warnings;
+    open OLDERR, ">&STDERR" or croak 'Cannot dup STDERR (', $!, '), abort';
+    use warnings;
+
+    # Redirect STDERR to /dev/null
+    open STDERR, '>', $devnull
+      or croak 'Cannot redirect STDERR (', $!, '), abort';
+
+    # Make sure the channels are unbuffered
+    my $select = select;
+    select STDERR; $| = 1;
+    select $select;
+  }
+
+  if (ref ($cmd) and ref ($cmd) eq 'ARRAY') {
+    # $cmd is an array
+    my @command = @{ $cmd };
+
+    if ($method eq 'qx') {
+      @return = qx(@command);
+
+    } elsif ($method eq 'exec') {
+      exec (@command);
+
+    } else {
+      system (@command);
+      @return = $? ? () : (1);
+    }
+
+  } else {
+    # $cmd is an scalar
+    if ($method eq 'qx') {
+      @return = qx($cmd);
+
+    } elsif ($method eq 'exec') {
+      exec ($cmd);
+
+    } else {
+      system ($cmd);
+      @return = $? ? () : (1);
+    }
+  }
+
+  # Put STDERR back to normal, if redirected previously
+  if ($devnull) {
+    close STDERR;
+
+    open STDERR, ">&OLDERR" or croak 'Cannot dup STDERR (', $!, '), abort';
+  }
+
+  # Print the time taken for command after execution, if necessary
+  print &timestamp_command (&get_command_string ($cmd), 'end') if $time;
+
+  if ($?) {
+    # The command has failed
+    if ($error eq 'die') {
+      # Throw fatal error if ERROR is set to "die"
+      croak &get_command_string ($cmd), ' failed (', $?, ')';
+
+    } elsif ($error eq 'warn') {
+      # Issue warning if ERROR is set to "warn"
+      carp  &get_command_string ($cmd), ' failed (', $?, ')';
+    }
+  }
+
+  # Set the return code if necessary
+  $$rc = $? if $rc;
+
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &e_report (@message);
+#
+# DESCRIPTION
+#   The function prints @message to STDERR and aborts with a error.
+# ------------------------------------------------------------------------------
+
+sub e_report {
+  print STDERR @_, "\n" if @_;
+
+  exit 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &w_report (@message);
+#
+# DESCRIPTION
+#   The function prints @message to STDERR and returns.
+# ------------------------------------------------------------------------------
+
+sub w_report {
+  print STDERR @_, "\n" if @_;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $date = &svn_date ($time);
+#
+# DESCRIPTION
+#   The function returns a date, formatted as by Subversion. The argument $time
+#   is the number of seconds since epoch.
+# ------------------------------------------------------------------------------
+
+sub svn_date {
+  my $time = shift;
+
+  return strftime ('%Y-%m-%d %H:%M:%S %z (%a, %d %b %Y)', localtime ($time));
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
